diff --git a/.gitignore b/.gitignore index b7055155..dfcd8c9b 100644 --- a/.gitignore +++ b/.gitignore @@ -23,9 +23,12 @@ hol.sh hol.sosa hol.sosa.ckpt hol_lib_inlined.ml -unit_tests_inlined.ml -unit_tests.byte -unit_tests.native +UnitTests/basic_tests_inlined.ml +UnitTests/basic_tests.byte +UnitTests/basic_tests.native +UnitTests/printer_tests_inlined.ml +UnitTests/printer_tests.byte +UnitTests/printer_tests.native hol-*.ckpt __pycache__/ diff --git a/100/fourier.ml b/100/fourier.ml index 46832630..e981a23f 100644 --- a/100/fourier.ml +++ b/100/fourier.ml @@ -3138,6 +3138,51 @@ let REAL_INTEGRABLE_DIRICHLET_KERNEL_MUL_EXPAND = prove EXISTS_TAC `{&0}` THEN REWRITE_TAC[REAL_NEGLIGIBLE_SING] THEN SIMP_TAC[IN_DIFF; IN_SING; dirichlet_kernel]);; +let SIN_SUB_X_BOUND = prove + (`!x. abs(sin(x) - x) <= abs(x) pow 3`, + GEN_TAC THEN MP_TAC(ISPECL [`0`; `Cx x`] TAYLOR_CSIN) THEN + REWRITE_TAC[VSUM_CLAUSES_NUMSEG; GSYM CX_SIN] THEN + CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[complex_pow; COMPLEX_POW_1; COMPLEX_DIV_1; IM_CX] THEN + REWRITE_TAC[GSYM CX_MUL; GSYM CX_SUB; COMPLEX_NORM_CX; REAL_ABS_0] THEN + REWRITE_TAC[REAL_EXP_0; REAL_MUL_LID] THEN REAL_ARITH_TAC);; + +let SIN_OVER_X_SUB1_BOUND = prove + (`!x. ~(x = &0) ==> abs(sin(x) / x - &1) <= x pow 2`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN + MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN EXISTS_TAC `abs x` THEN + REWRITE_TAC[GSYM REAL_ABS_MUL; GSYM(CONJUNCT2 real_pow)] THEN + ASM_REWRITE_TAC[GSYM REAL_ABS_NZ; ARITH] THEN + ASM_SIMP_TAC[REAL_SUB_LDISTRIB; REAL_DIV_LMUL; REAL_MUL_RID] THEN + REWRITE_TAC[SIN_SUB_X_BOUND]);; + +let SIN_LOWER_BOUND_HALF = prove + (`!x. abs(x) <= &1 / &2 ==> abs(x) / &2 <= abs(sin x)`, + REPEAT STRIP_TAC THEN MP_TAC(SPEC `x:real` SIN_SUB_X_BOUND) THEN + MATCH_MP_TAC(REAL_ARITH + `&4 * x3 <= abs x ==> abs(s - x) <= x3 ==> abs(x) / &2 <= abs s`) THEN + REWRITE_TAC[REAL_ARITH + `&4 * x pow 3 <= x <=> x * x pow 2 <= x * (&1 / &2) pow 2`] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[GSYM REAL_LE_SQUARE_ABS] THEN + ASM_REAL_ARITH_TAC);; + +let INV_SIN_SUB_INV_BOUND = prove + (`!x. ~(x = &0) /\ abs x <= &1 / &2 + ==> abs(inv(sin x) - inv x) <= &2 * abs x`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN EXISTS_TAC `abs(sin x)` THEN + REWRITE_TAC[GSYM REAL_ABS_MUL] THEN ASM_CASES_TAC `sin x = &0` THENL + [MP_TAC(SPEC `x:real` SIN_EQ_0_PI) THEN + MP_TAC PI_APPROX_32 THEN ASM_REAL_ARITH_TAC; + ASM_SIMP_TAC[GSYM REAL_ABS_NZ; REAL_SUB_LDISTRIB; REAL_MUL_RINV] THEN + REWRITE_TAC[REAL_ARITH `abs(&1 - s * inv x) = abs(s / x - &1)`] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(x:real) pow 2` THEN + ASM_SIMP_TAC[SIN_OVER_X_SUB1_BOUND] THEN + ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN + REWRITE_TAC[REAL_POW_2; REAL_MUL_ASSOC] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN + MP_TAC(ISPEC `x:real` SIN_LOWER_BOUND_HALF) THEN ASM_REAL_ARITH_TAC]);; + let FOURIER_SUM_LIMIT_SINE_PART = prove (`!f t l d. f absolutely_real_integrable_on real_interval[--pi,pi] /\ @@ -3149,46 +3194,6 @@ let FOURIER_SUM_LIMIT_SINE_PART = prove (\x. sin((&n + &1 / &2) * x) * ((f(t + x) + f(t - x)) - &2 * l) / x)) ---> &0) sequentially)`, - let lemma0 = prove - (`!x. abs(sin(x) - x) <= abs(x) pow 3`, - GEN_TAC THEN MP_TAC(ISPECL [`0`; `Cx x`] TAYLOR_CSIN) THEN - REWRITE_TAC[VSUM_CLAUSES_NUMSEG; GSYM CX_SIN] THEN - CONV_TAC NUM_REDUCE_CONV THEN - REWRITE_TAC[complex_pow; COMPLEX_POW_1; COMPLEX_DIV_1; IM_CX] THEN - REWRITE_TAC[GSYM CX_MUL; GSYM CX_SUB; COMPLEX_NORM_CX; REAL_ABS_0] THEN - REWRITE_TAC[REAL_EXP_0; REAL_MUL_LID] THEN REAL_ARITH_TAC) in - let lemma1 = prove - (`!x. ~(x = &0) ==> abs(sin(x) / x - &1) <= x pow 2`, - REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN - MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN EXISTS_TAC `abs x` THEN - REWRITE_TAC[GSYM REAL_ABS_MUL; GSYM(CONJUNCT2 real_pow)] THEN - ASM_REWRITE_TAC[GSYM REAL_ABS_NZ; ARITH] THEN - ASM_SIMP_TAC[REAL_SUB_LDISTRIB; REAL_DIV_LMUL; REAL_MUL_RID] THEN - REWRITE_TAC[lemma0]) in - let lemma2 = prove - (`!x. abs(x) <= &1 / &2 ==> abs(x) / &2 <= abs(sin x)`, - REPEAT STRIP_TAC THEN MP_TAC(SPEC `x:real` lemma0) THEN - MATCH_MP_TAC(REAL_ARITH - `&4 * x3 <= abs x ==> abs(s - x) <= x3 ==> abs(x) / &2 <= abs s`) THEN - REWRITE_TAC[REAL_ARITH - `&4 * x pow 3 <= x <=> x * x pow 2 <= x * (&1 / &2) pow 2`] THEN - MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[GSYM REAL_LE_SQUARE_ABS] THEN - ASM_REAL_ARITH_TAC) in - let lemma3 = prove - (`!x. ~(x = &0) /\ abs x <= &1 / &2 - ==> abs(inv(sin x) - inv x) <= &2 * abs x`, - REPEAT STRIP_TAC THEN - MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN EXISTS_TAC `abs(sin x)` THEN - REWRITE_TAC[GSYM REAL_ABS_MUL] THEN ASM_CASES_TAC `sin x = &0` THENL - [MP_TAC(SPEC `x:real` SIN_EQ_0_PI) THEN - MP_TAC PI_APPROX_32 THEN ASM_REAL_ARITH_TAC; - ASM_SIMP_TAC[GSYM REAL_ABS_NZ; REAL_SUB_LDISTRIB; REAL_MUL_RINV] THEN - REWRITE_TAC[REAL_ARITH `abs(&1 - s * inv x) = abs(s / x - &1)`] THEN - MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(x:real) pow 2` THEN - ASM_SIMP_TAC[lemma1] THEN ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN - REWRITE_TAC[REAL_POW_2; REAL_MUL_ASSOC] THEN - MATCH_MP_TAC REAL_LE_RMUL THEN - MP_TAC(ISPEC `x:real` lemma2) THEN ASM_REAL_ARITH_TAC]) in REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`f:real->real`; `t:real`; `l:real`; `d:real`] FOURIER_SUM_LIMIT_DIRICHLET_KERNEL_PART) THEN @@ -3282,7 +3287,7 @@ let FOURIER_SUM_LIMIT_SINE_PART = prove `abs(z - &1) <= y ==> abs(&1 + y) <= B ==> abs(z) <= B`) THEN ASM_SIMP_TAC[REAL_FIELD `~(x = &0) ==> (&2 * y) / x = y / (x / &2)`] THEN - MATCH_MP_TAC lemma1 THEN ASM_REAL_ARITH_TAC]]; + MATCH_MP_TAC SIN_OVER_X_SUB1_BOUND THEN ASM_REAL_ARITH_TAC]]; SUBGOAL_THEN `real_interval[&0,d] SUBSET real_interval[--pi,pi]` MP_TAC THENL @@ -3358,7 +3363,7 @@ let FOURIER_SUM_LIMIT_SINE_PART = prove GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o RAND_CONV) [GSYM REAL_INV_DIV] THEN MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&2 * abs(x / &2)` THEN - CONJ_TAC THENL [MATCH_MP_TAC lemma3; ASM_REAL_ARITH_TAC] THEN + CONJ_TAC THENL [MATCH_MP_TAC INV_SIN_SUB_INV_BOUND; ASM_REAL_ARITH_TAC] THEN ASM_REAL_ARITH_TAC]);; (* ------------------------------------------------------------------------- *) diff --git a/100/transcendence.ml b/100/transcendence.ml index 3929849b..9261175b 100644 --- a/100/transcendence.ml +++ b/100/transcendence.ml @@ -2042,17 +2042,7 @@ let ring_sum_const = prove(` ring_sum r S (\s:X. c) = ring_mul r (ring_of_num r (CARD S)) c `, - GEN_TAC THEN GEN_TAC THEN - sufficesby FINITE_INDUCT_STRONG THEN - intro THENL [ - rw[RING_SUM_CLAUSES;CARD_CLAUSES;RING_OF_NUM_0] THEN - qed[RING_MUL_LZERO] - ; - set_fact `!s:X. s IN S ==> s IN x INSERT S` THEN - set_fact `(x:X) IN x INSERT S` THEN - simp[RING_SUM_CLAUSES;CARD_CLAUSES;ring_of_num] THEN - RING_TAC - ] + qed[RING_SUM_CONST] );; let ring_product_const = prove(` @@ -2061,15 +2051,7 @@ let ring_product_const = prove(` c IN ring_carrier r ==> ring_product r S (\s:X. c) = ring_pow r c (CARD S) `, - GEN_TAC THEN GEN_TAC THEN - sufficesby FINITE_INDUCT_STRONG THEN - intro THENL [ - rw[RING_PRODUCT_CLAUSES;CARD_CLAUSES;RING_POW_0] - ; - set_fact `!s:X. s IN S ==> s IN x INSERT S` THEN - set_fact `(x:X) IN x INSERT S` THEN - simp[RING_PRODUCT_CLAUSES;CARD_CLAUSES;ring_pow] - ] + qed[RING_PRODUCT_CONST] );; let ring_of_num_injective_lemma = prove(` @@ -2377,30 +2359,6 @@ let ring_coprime_1 = prove(` qed[RING_1;RING_UNIT_DIVIDES] );; -let ring_coprime_product_waterfall = prove(` - !(r:R ring) f:X->R a. - (UFD r \/ integral_domain r /\ bezout_ring r) ==> - a IN ring_carrier r ==> - !S. - FINITE S ==> - (!s. s IN S ==> ring_coprime r (a,f s)) ==> - ring_coprime r (a,ring_product r S f) -`, - intro_gendisch THEN - sufficesby FINITE_INDUCT_STRONG THEN - intro THENL [ - simp[RING_PRODUCT_CLAUSES] THEN - qed[ring_coprime_1] - ; - have `x:X IN x INSERT S` [IN_INSERT] THEN - have `f(x:X):R IN ring_carrier r` [SUBSET;ring_coprime] THEN - simp[RING_PRODUCT_CLAUSES] THEN - have `!s:X. s IN S ==> s IN x INSERT S` [IN_INSERT] THEN - have `ring_coprime r (a,ring_product r S (f:X->R))` [] THEN - qed[RING_COPRIME_RMUL;RING_PRODUCT;ring_coprime] - ] -);; - let ring_coprime_product = prove(` !(r:R ring) f:X->R a S. (UFD r \/ integral_domain r /\ bezout_ring r) ==> @@ -2409,42 +2367,7 @@ let ring_coprime_product = prove(` (!s. s IN S ==> ring_coprime r (a,f s)) ==> ring_coprime r (a,ring_product r S f) `, - simp[ring_coprime_product_waterfall] -);; - -let ring_product_divides_if_coprime_waterfall = prove(` - !(r:R ring) f:X->R a. - (UFD r \/ integral_domain r /\ bezout_ring r) ==> - a IN ring_carrier r ==> - !S. - FINITE S ==> - (!s t. s IN S ==> t IN S ==> ~(s = t) ==> ring_coprime r (f s,f t)) ==> - (!s. s IN S ==> ring_divides r (f s) a) ==> - ring_divides r (ring_product r S f) a -`, - intro_gendisch THEN - sufficesby FINITE_INDUCT_STRONG THEN - intro THENL [ - simp[RING_PRODUCT_CLAUSES] THEN - qed[RING_DIVIDES_1] - ; - have `x:X IN x INSERT S` [IN_INSERT] THEN - have `f(x:X):R IN ring_carrier r` [SUBSET;ring_divides] THEN - simp[RING_PRODUCT_CLAUSES] THEN - have `!s:X. s IN S ==> s IN x INSERT S` [IN_INSERT] THEN - have `ring_divides r (ring_product r S (f:X->R)) a` [] THEN - subgoal `ring_coprime r (f x,ring_product r S (f:X->R))` THENL [ - specialize_assuming[ - `r:R ring`; - `f:X->R`; - `f(x:X):R`; - `S:X->bool` - ]ring_coprime_product THEN - qed[] - ; pass - ] THEN - qed[RING_DIVIDES_MUL] - ] + simp[RING_COPRIME_PRODUCT] );; (* compare product_coprime_primes_divides below *) @@ -2457,7 +2380,10 @@ let ring_product_divides_if_coprime = prove(` (!s t. s IN S ==> t IN S ==> ~(s = t) ==> ring_coprime r (f s,f t)) ==> ring_divides r (ring_product r S f) a `, - simp[ring_product_divides_if_coprime_waterfall] +intro_gendisch THEN +W(MP_TAC o PART_MATCH (lhand o rand) RING_COPRIME_PRODUCT_DIVIDES o snd) THEN +rw[pairwise] THEN +qed[RING_DIVIDES_IN_CARRIER] );; let ring_coprime_lpow = prove(` @@ -2918,87 +2844,15 @@ let ring_product_o_v2 = prove(` (* ===== squarefree elements of rings *) -(* XXX: maybe should include a IN ring_carrier r *) -(* XXX: maybe should exclude 0, or exclude non-injective *) -let ring_squarefree = new_definition ` - ring_squarefree(r:R ring) a - <=> - (!b. b IN ring_carrier r ==> - ring_divides r a (ring_mul r b b) ==> - ring_divides r a b - ) -`;; - -let not_squarefree_if_divisible_by_square = prove(` - !(r:R ring) a b. - integral_domain r ==> - ~(a = ring_0 r) ==> - b IN ring_carrier r ==> - ~(ring_unit r b) ==> - ring_divides r (ring_mul r b b) a ==> - ~(ring_squarefree r a) -`, - intro THEN - have `a IN ring_carrier(r:R ring)` [ring_divides] THEN - have `b IN ring_carrier(r:R ring)` [ring_unit] THEN - choose `q:R` `q IN ring_carrier(r:R ring) /\ a = ring_mul r (ring_mul r b b) q` [ring_divides] THEN - have `q IN ring_carrier(r:R ring)` [] THEN - have `a = ring_mul(r:R ring) (ring_mul r b b) q` [] THEN - recall(RING_RULE `a = ring_mul(r:R ring) (ring_mul r b b) q ==> ring_mul r (ring_mul r b q) (ring_mul r b q) = ring_mul r a q`) THEN - have `ring_divides(r:R ring) a (ring_mul r (ring_mul r b q) (ring_mul r b q))` [ring_divides;RING_MUL] THEN - have `ring_divides(r:R ring) a (ring_mul r b q)` [ring_squarefree;RING_MUL] THEN - choose `u:R` `u IN ring_carrier(r:R ring) /\ ring_mul r b q = ring_mul r a u` [ring_divides] THEN - have `u IN ring_carrier(r:R ring)` [] THEN - have `ring_mul(r:R ring) b q = ring_mul r a u` [] THEN - recall(RING_RULE `a = ring_mul(r:R ring) (ring_mul r b b) q /\ ring_mul r b q = ring_mul r a u ==> ring_mul r a (ring_1 r) = ring_mul r a (ring_mul r b u)`) THEN - have `ring_1(r:R ring) = ring_mul r b u` [INTEGRAL_DOMAIN_MUL_LCANCEL;RING_1;RING_MUL] THEN - qed[ring_unit] -);; - -let product_coprime_primes_divides_waterfall = prove(` - !(r:R ring). - !P. - FINITE P ==> - P SUBSET ring_carrier r ==> - !b. - b IN ring_carrier r ==> - (!p. p IN P ==> ring_prime r p) ==> - (!p q. p IN P ==> q IN P ==> ring_divides r p q ==> p = q) ==> - (!p. p IN P ==> ring_divides r p b) ==> - ring_divides r (ring_product r P I) b -`, - GEN_TAC THEN - sufficesby FINITE_INDUCT_STRONG THEN - intro THENL [ - simp[RING_PRODUCT_CLAUSES] THEN - qed[RING_DIVIDES_1] - ; - have `(x:R) IN x INSERT P` [IN_INSERT] THEN - have `(x:R) IN ring_carrier r` [SUBSET] THEN - have `I (x:R) = x` [I_THM] THEN - have `I (x:R) IN ring_carrier r` [] THEN - have `ring_product(r:R ring) (x INSERT P) I = ring_mul r x (ring_product r P I)` [RING_PRODUCT_CLAUSES] THEN - simp[RING_PRODUCT_CLAUSES] THEN - have `ring_divides r (x:R) b` [] THEN - choose `c:R` `c IN ring_carrier r /\ (b:R) = ring_mul r x c` [ring_divides] THEN - subgoal `!q:R. q IN P ==> ring_divides r q c` THENL [ - intro THEN - have `q:R IN x INSERT P` [IN_INSERT] THEN - have `q:R IN ring_carrier r` [SUBSET] THEN - have `ring_divides r (q:R) b` [] THEN - have `ring_divides r (q:R) (ring_mul r x c)` [] THEN - have `~(ring_divides r (q:R) x)` [] THEN - qed[ring_prime] - ; pass - ] THEN - have `!q:R. q IN P ==> ring_prime r q` [IN_INSERT] THEN - have `!p q:R. p IN P ==> q IN P ==> ring_divides r p q ==> p = q` [IN_INSERT] THEN - have `P SUBSET (P:R->bool)` [SUBSET_REFL] THEN - have `P SUBSET ring_carrier(r:R ring)` [SUBSET_INSERT;SUBSET_TRANS] THEN - have `c:R IN ring_carrier r` [] THEN - specialize[`c:R`](UNDISCH(know `P SUBSET ring_carrier(r:R ring) ==> (!b. b IN ring_carrier r ==> (!p. p IN P ==> ring_prime r p) ==> (!p q. p IN P ==> q IN P ==> ring_divides r p q ==> p = q) ==> (!p. p IN P ==> ring_divides r p b) ==> ring_divides r (ring_product r P I) b)`)) THEN - qed[RING_DIVIDES_REFL;RING_DIVIDES_MUL2] - ] +let not_squarefree_if_divisible_by_square = prove + (`!(r:R ring) a b. + integral_domain r ==> + ~(a = ring_0 r) ==> + b IN ring_carrier r ==> + ~(ring_unit r b) ==> + ring_divides r (ring_mul r b b) a ==> + ~(ring_squarefree r a)`, + qed[ring_squarefree; RING_POW_2; ring_divides] );; let product_coprime_primes_divides = prove(` @@ -3012,81 +2866,48 @@ let product_coprime_primes_divides = prove(` ring_divides r (ring_product r P I) b `, intro THEN - ASSUME_TAC(ISPECL[`b:R`](UNDISCH_ALL(ISPECL[`r:R ring`;`P:R->bool`]product_coprime_primes_divides_waterfall))) THEN + W(MP_TAC o PART_MATCH (lhand o rand) RING_PRIME_PRODUCT_DIVIDES o snd) THEN + rw[pairwise; I_THM] THEN qed[] );; -let ring_squarefree_if_product_coprime_primes = prove(` - !(r:R ring) P. - P SUBSET ring_carrier r ==> - FINITE P ==> - (!p. p IN P ==> ring_prime r p) ==> - (!p q. p IN P ==> q IN P ==> ring_divides r p q ==> p = q) ==> - ring_squarefree r (ring_product r P I) -`, - rw[ring_squarefree] THEN +(* ring_squarefree_if_product_coprime_primes: now needs UFD hypothesis *) +let ring_squarefree_if_product_coprime_primes_indexed = prove + (`!(r:R ring) S (f:X->R). + UFD r ==> + FINITE S ==> + (!s. s IN S ==> f s IN ring_carrier r) ==> + (!s. s IN S ==> ring_prime r (f s)) ==> + (!s t. s IN S ==> t IN S ==> ring_divides r (f s) (f t) ==> s = t) ==> + ring_squarefree r (ring_product r S f)`, intro THEN - subgoal `!p:R. p IN P ==> ring_divides r p (ring_product r P I)` THENL [ - intro THEN - have `(p:R) IN ring_carrier r` [SUBSET] THEN - have `I (p:R) = p` [I_THM] THEN - have `I (p:R) IN ring_carrier r` [] THEN - have `ring_product(r:R ring) {p} I = p` [RING_PRODUCT_SING] THEN - have `FINITE {p:R}` [FINITE_SING] THEN - have `{p:R} SUBSET P` [SUBSET;IN_SING] THEN - qed[RING_DIVIDES_PRODUCT_SUBSET] - ; pass - ] THEN - have `!p:R. p IN P ==> ring_divides r p (ring_mul r b b)` [RING_DIVIDES_TRANS;RING_MUL] THEN - have `!p:R. p IN P ==> ring_divides r p b` [ring_prime] THEN - specialize[`r:R ring`;`P:R->bool`;`b:R`]product_coprime_primes_divides THEN - qed[] + have `~(ring_product r S (f:X->R) = ring_0 r)` + [INTEGRAL_DOMAIN_PRODUCT_EQ_0; ring_prime; UFD; + INTEGRAL_DOMAIN_IMP_NONTRIVIAL_RING] THEN + simp[RING_SQUAREFREE_PRODUCT; pairwise] THEN + qed[INTEGRAL_DOMAIN_PRIME_COPRIME_EQ; RING_PRIME_IMP_SQUAREFREE; UFD] );; -let ring_squarefree_if_product_coprime_primes_indexed = prove(` - !(r:R ring) S (f:X->R). - FINITE S ==> - (!s:X. s IN S ==> f s IN ring_carrier r) ==> - (!s:X. s IN S ==> ring_prime r (f s)) ==> - (!s t. s IN S ==> t IN S ==> ring_divides r (f s) (f t) ==> s = t) ==> - ring_squarefree r (ring_product r S f) -`, - intro THEN - def `P:R->bool` `IMAGE (f:X->R) S` THEN - have `FINITE (P:R->bool)` [FINITE_IMAGE] THEN - havetac `(P:R->bool) SUBSET ring_carrier r` - (rw[SUBSET;EXTENSION] THEN qed[IN_IMAGE]) THEN - havetac `!p:R. p IN P ==> ring_prime r p` - (rw[SUBSET;EXTENSION] THEN qed[IN_IMAGE]) THEN - havetac `!p q:R. p IN P ==> q IN P ==> ring_divides r p q ==> p = q` - (rw[SUBSET;EXTENSION] THEN qed[IN_IMAGE]) THEN - specialize[`r:R ring`;`P:R->bool`]ring_squarefree_if_product_coprime_primes THEN - have `!s t:X. s IN S ==> t IN S ==> f s = f t:R ==> s = t` [RING_DIVIDES_REFL] THEN - specialize[`r:R ring`;`f:X->R`;`I:R->R`;`S:X->bool`]RING_PRODUCT_IMAGE THEN - qed[I_O_ID] +let ring_squarefree_if_product_coprime_primes = prove + (`!(r:R ring) P. + UFD r ==> + P SUBSET ring_carrier r ==> + FINITE P ==> + (!p. p IN P ==> ring_prime r p) ==> + (!p q. p IN P ==> q IN P ==> ring_divides r p q ==> p = q) ==> + ring_squarefree r (ring_product r P I)`, + intro THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] + ring_squarefree_if_product_coprime_primes_indexed) THEN + qed[I_THM; RING_PRIME_IN_CARRIER] );; -let ring_squarefree_if_unit = prove(` - !(r:R ring) p. - ring_unit r p ==> ring_squarefree r p -`, - rw[ring_squarefree] THEN - qed[RING_UNIT_DIVIDES_ANY] -);; +let ring_squarefree_if_unit = RING_UNIT_IMP_SQUAREFREE;; -let ring_squarefree_if_prime = prove(` - !(r:R ring) p. - ring_prime r p ==> ring_squarefree r p -`, - intro THEN - have `p:R IN ring_carrier r` [ring_prime] THEN - have `{p:R} SUBSET ring_carrier r` [SUBSET;IN_SING] THEN - have `FINITE {p:R}` [FINITE_SING] THEN - have `!q:R. q IN {p} ==> ring_prime r q` [IN_SING] THEN - have `!q x:R. q IN {p} ==> x IN {p} ==> ring_divides r q x ==> q = x` [IN_SING] THEN - specialize[`r:R ring`;`{p:R}`]ring_squarefree_if_product_coprime_primes THEN - qed[RING_PRODUCT_SING;I_THM] -);; +let ring_squarefree_if_prime = prove + (`!(r:R ring) p. + integral_domain r ==> ring_prime r p ==> ring_squarefree r p`, + MESON_TAC[RING_PRIME_IMP_SQUAREFREE]);; let ring_coprime_if_unit = prove(` !(r:R ring) a b. @@ -3104,21 +2925,7 @@ let ring_product_divides_factor_by_factor = prove(` (!s:X. s IN S ==> ring_divides r (f s) (g s)) ==> ring_divides r (ring_product r S f) (ring_product r S g) `, - GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN - sufficesby FINITE_INDUCT_STRONG THEN - simp[RING_PRODUCT_CLAUSES] THEN - intro THENL [ - qed[RING_DIVIDES_1;RING_1] - ; - set_fact `!s:X. s IN S ==> s IN x INSERT S` THEN - set_fact `(x:X) IN x INSERT S` THEN - have `!s:X. s IN S ==> f s IN ring_carrier(r:R ring)` [ring_divides] THEN - have `!s:X. s IN S ==> g s IN ring_carrier(r:R ring)` [ring_divides] THEN - have `f(x:X) IN ring_carrier(r:R ring)` [ring_divides] THEN - have `g(x:X) IN ring_carrier(r:R ring)` [ring_divides] THEN - have `ring_divides (r:R ring) (f(x:X)) (g(x:X))` [] THEN - qed[RING_DIVIDES_MUL2] - ] + qed[RING_DIVIDES_PRODUCTS] );; let ring_sum_delta_delta = prove(` @@ -3271,15 +3078,12 @@ let prime_divides_prime_and = prove(` qed[RING_DIVIDES_TRANS] );; -let ring_squarefree_associates = prove(` - !(r:R ring) f g. - ring_associates r f g ==> - ring_squarefree r f ==> - ring_squarefree r g -`, - rw[ring_squarefree] THEN - qed[RING_ASSOCIATES_DIVIDES;RING_ASSOCIATES_REFL;RING_MUL] -);; +let ring_squarefree_associates = prove + (`!(r:R ring) f g. + ring_associates r f g ==> + ring_squarefree r f ==> + ring_squarefree r g`, + MESON_TAC[RING_SQUAREFREE_ASSOCIATES]);; (* ===== power series and polynomials *) @@ -4537,7 +4341,7 @@ let coeff_poly_const_times = prove(` coeff d (poly_mul r (poly_const r c) p) = ring_mul r c (coeff d p) `, - qed[COEFF_POLY_CONST_MUL] + qed[COEFF_POLY_LMUL] );; let coeff_times_poly_const = prove(` @@ -4547,7 +4351,7 @@ let coeff_times_poly_const = prove(` coeff d (poly_mul r p (poly_const r c)) = ring_mul r c (coeff d p) `, - qed[COEFF_POLY_MUL_CONST] + qed[COEFF_POLY_RMUL; RING_MUL_SYM; COEFF_IN_CARRIER] );; let polynomial_if_coeff = prove(` @@ -4629,7 +4433,7 @@ let deg_coeff_from_le = prove(` ~(coeff n p = ring_0 r) ==> poly_deg r p = n `, - qed[POLY_DEG_EQ_COEFF_FROM_LE] + qed[POLY_DEG_EQ_FROM_LE] );; let poly_eval_expand_coeff = prove(` @@ -5752,47 +5556,33 @@ let x_derivative = new_definition ` (p (x_monomial_shift m))) `;; +let X_DERIVATIVE_EQ_POLY_DERIV = prove(` + !(r:R ring) p. x_derivative r p = poly_deriv r p`, + rw[x_derivative; poly_deriv; COEFF; ADD1; x_monomial_shift] THEN + once_rw[one] THEN + qed[] +);; + let x_derivative_series = prove(` !(r:R ring) p. ring_powerseries r p ==> ring_powerseries r (x_derivative r p) `, - rw[ring_powerseries;x_derivative] THEN - qed[RING_OF_NUM;RING_MUL;FINITE_MONOMIAL_VARS_1;INFINITE] -);; + rw[X_DERIVATIVE_EQ_POLY_DERIV; RING_POWERSERIES_POLY_DERIV]);; let x_derivative_polynomial = prove(` !(r:R ring) p. ring_polynomial r p ==> ring_polynomial r (x_derivative r p) `, - rw[ring_polynomial] THEN - intro THENL [ - qed[x_derivative_series] - ; - rw[x_derivative] THEN - have `!m. ~(ring_mul(r:R ring) (ring_of_num r (m one + 1)) (p (x_monomial_shift m)) = ring_0 r) ==> ~(p (x_monomial_shift m) = ring_0 r)` [RING_MUL_RZERO;RING_OF_NUM] THEN - set_fact `(!m. ~(ring_mul(r:R ring) (ring_of_num r (m one + 1)) (p (x_monomial_shift m)) = ring_0 r) ==> ~(p (x_monomial_shift m) = ring_0 r)) ==> {m | ~(ring_mul(r:R ring) (ring_of_num r (m one + 1)) (p (x_monomial_shift m)) = ring_0 r)} SUBSET {m | ~(p (x_monomial_shift m) = ring_0 r)}` THEN - have `{m | ~(ring_mul(r:R ring) (ring_of_num r (m one + 1)) (p (x_monomial_shift m)) = ring_0 r)} SUBSET {m | ~(p (x_monomial_shift m) = ring_0 r)}` [] THEN - specialize_assuming[`x_monomial_shift`;`{m:1->num | ~(p m = ring_0(r:R ring))}`]FINITE_IMAGE_INJ THEN - have `FINITE {m | x_monomial_shift m IN {m | ~(p m = ring_0(r:R ring))}}` [x_monomial_shift_injective] THEN - set_fact `{m | x_monomial_shift m IN {m | ~(p m = ring_0(r:R ring))}} = {m | ~(p (x_monomial_shift m) = ring_0(r:R ring))}` THEN - have `FINITE {m | ~(p (x_monomial_shift m) = ring_0(r:R ring))}` [] THEN - qed[FINITE_SUBSET] - ] -);; + rw[X_DERIVATIVE_EQ_POLY_DERIV; RING_POLYNOMIAL_POLY_DERIV]);; let coeff_x_derivative = prove(` !(r:R ring) p d. coeff d (x_derivative r p) = ring_mul r (ring_of_num r (d+1)) (coeff (d+1) p) `, - intro THEN - rw[x_derivative;coeff_x_monomial] THEN - have `x_monomial_shift (x_monomial d) = x_monomial (d+1)` [x_monomial_shift_eq_x_monomial] THEN - simp[] THEN - rw[x_monomial] -);; + rw[X_DERIVATIVE_EQ_POLY_DERIV; GSYM ADD1; COEFF_POLY_DERIV]);; let x_derivative_add_series = prove(` !(r:R ring) p q. @@ -5801,13 +5591,7 @@ let x_derivative_add_series = prove(` x_derivative r (poly_add r p q) = poly_add r (x_derivative r p) (x_derivative r q) `, - intro THEN - have `!m:1->num. p m IN ring_carrier(r:R ring)` [ring_powerseries] THEN - have `!m:1->num. q m IN ring_carrier(r:R ring)` [ring_powerseries] THEN - rw[x_derivative;poly_add] THEN - once_rw[FUN_EQ_THM] THEN - simp[RING_ADD_LDISTRIB;RING_OF_NUM] -);; + simp[X_DERIVATIVE_EQ_POLY_DERIV; POLY_DERIV_ADD]);; let x_derivative_neg_series = prove(` !(r:R ring) p. @@ -5815,12 +5599,7 @@ let x_derivative_neg_series = prove(` x_derivative r (poly_neg r p) = poly_neg r (x_derivative r p) `, - intro THEN - have `!m:1->num. p m IN ring_carrier(r:R ring)` [ring_powerseries] THEN - rw[x_derivative;poly_neg] THEN - once_rw[FUN_EQ_THM] THEN - simp[RING_MUL_RNEG;RING_OF_NUM] -);; + simp[X_DERIVATIVE_EQ_POLY_DERIV; POLY_DERIV_NEG]);; let x_derivative_sub_series = prove(` !(r:R ring) p q. @@ -5829,32 +5608,26 @@ let x_derivative_sub_series = prove(` x_derivative r (poly_sub r p q) = poly_sub r (x_derivative r p) (x_derivative r q) `, - rw[POLY_SUB] THEN - qed[RING_POWERSERIES_NEG;x_derivative_add_series;x_derivative_neg_series] -);; + simp[X_DERIVATIVE_EQ_POLY_DERIV; POLY_DERIV_SUB]);; let x_derivative_poly_const = prove(` !(r:R ring) c. x_derivative r (poly_const r c) = poly_0 r `, - rw[x_derivative;poly_0;poly_const;x_monomial_shift_is_not_monomial_1;COND_ID] THEN - once_rw[FUN_EQ_THM] THEN - qed[FUN_EQ_THM;RING_OF_NUM;RING_MUL_RZERO] + rw[X_DERIVATIVE_EQ_POLY_DERIV; POLY_DERIV_CONST] );; let x_derivative_poly_0 = prove(` !(r:R ring). x_derivative r (poly_0 r) = poly_0 r `, - qed[poly_0;x_derivative_poly_const] -);; + rw[X_DERIVATIVE_EQ_POLY_DERIV; POLY_DERIV_0]);; let x_derivative_poly_1 = prove(` !(r:R ring). x_derivative r (poly_1 r) = poly_0 r `, - qed[poly_1;x_derivative_poly_const] -);; + rw[X_DERIVATIVE_EQ_POLY_DERIV; POLY_DERIV_1]);; let x_derivative_poly_const_mul_series = prove(` !(r:R ring) c p. @@ -5863,17 +5636,7 @@ let x_derivative_poly_const_mul_series = prove(` x_derivative r (poly_mul r (poly_const r c) p) = poly_mul r (poly_const r c) (x_derivative r p) `, - intro THEN - sufficesby eq_coeff THEN - intro THEN - rw[coeff_x_derivative] THEN - have `ring_powerseries(r:R ring) (x_derivative r p)` [x_derivative_series] THEN - simp[coeff_poly_const_times] THEN - rw[coeff_x_derivative] THEN - have `coeff (d+1) p IN ring_carrier(r:R ring)` [coeff_series_in_ring] THEN - have `ring_of_num r (d+1) IN ring_carrier(r:R ring)` [RING_OF_NUM] THEN - RING_TAC -);; + simp[X_DERIVATIVE_EQ_POLY_DERIV; POLY_DERIV_CMUL]);; let x_derivative_const_x_pow = prove(` !(r:R ring) e. @@ -5912,45 +5675,6 @@ let x_derivative_x_pow = prove(` qed[x_derivative_const_x_pow;RING_MUL_RID;RING_OF_NUM] );; -let coeff_x_derivative_poly_mul = prove(` - !(r:R ring) p q d. - ring_powerseries r p ==> - ring_powerseries r q ==> - coeff d (x_derivative r (poly_mul r p q)) - = ring_add r - (coeff d (poly_mul r (x_derivative r p) q)) - (coeff d (poly_mul r p (x_derivative r q))) -`, - rw[coeff_x_derivative;coeff_poly_mul_oneindex] THEN - intro THEN - have `!i. coeff i p IN ring_carrier(r:R ring)` [coeff_series_in_ring] THEN - have `!i. coeff i q IN ring_carrier(r:R ring)` [coeff_series_in_ring] THEN - have `ring_0(r:R ring) = ring_mul r (ring_mul r (ring_of_num r 0) (coeff 0 p)) (coeff ((d + 1) - 0) q)` [RING_OF_NUM_0;RING_MUL_LZERO] THEN - specialize[`r:R ring`;`\a. ring_mul(r:R ring) (ring_mul r (ring_of_num r a) (coeff a p)) (coeff ((d+1)-a) q)`;`d:num`](GSYM ring_sum_shift1) THEN - specialize[`0`;`d+1`]FINITE_NUMSEG THEN - have `ring_of_num(r:R ring) (d+1) IN ring_carrier r` [RING_OF_NUM] THEN - have `!a. a IN (0..d+1) ==> ring_mul r (coeff a p) (coeff ((d + 1) - a) q) IN ring_carrier(r:R ring)` [RING_MUL] THEN - set_fact_using `!a:num. a IN (0..d) ==> a <= d` [NUMSEG_LE] THEN - num_linear_fact `!a:num. a <= d ==> d - a = (d+1)-(a+1)` THEN - have `!a:num. a IN (0..d) ==> d - a = (d+1)-(a+1)` [] THEN - specialize[`r:R ring`;`\a. ring_mul (r:R ring) (coeff a p) (coeff ((d+1)-a) q)`;`ring_of_num(r:R ring) (d+1)`;`0..d+1`](GSYM RING_SUM_LMUL) THEN - num_linear_fact `!a:num. a <= d ==> d-a+1 = (d+1)-a` THEN - have `!a:num. a IN (0..d) ==> d-a+1 = (d+1)-a` [] THEN - have `ring_of_num r ((d+1)-(d+1)) = ring_0(r:R ring)` [RING_OF_NUM_0;ARITH_RULE `(d+1)-(d+1)=0`] THEN - have `ring_0(r:R ring) = ring_mul r (coeff (d+1) p) (ring_mul r (ring_of_num r ((d+1)-(d+1))) (coeff ((d+1)-(d+1)) q))` [RING_OF_NUM;RING_MUL_LZERO;RING_MUL_RZERO] THEN - specialize[`r:R ring`;`\a. ring_mul(r:R ring) (coeff a p) (ring_mul r (ring_of_num r ((d+1)-a)) (coeff ((d+1)-a) q))`;`d:num`](GSYM ring_sum_insert_top) THEN - simp[] THEN - have `!a. ring_mul r (ring_mul r (ring_of_num r a) (coeff a p)) (coeff ((d + 1) - a) q) IN ring_carrier(r:R ring)` [RING_OF_NUM;RING_MUL] THEN - have `!a. ring_mul r (coeff a p) (ring_mul r (ring_of_num r ((d + 1) - a)) (coeff ((d + 1) - a) q)) IN ring_carrier(r:R ring)` [RING_OF_NUM;RING_MUL] THEN - simp[GSYM RING_SUM_ADD] THEN - have `!a. ring_add(r:R ring) (ring_mul r (ring_mul r (ring_of_num r a) (coeff a p)) (coeff ((d+1)-a) q)) (ring_mul r (coeff a p) (ring_mul r (ring_of_num r ((d+1)-a)) (coeff ((d+1)-a) q))) = ring_mul r (ring_add r (ring_of_num r a) (ring_of_num r ((d+1)-a))) (ring_mul r (coeff a p) (coeff ((d+1)-a) q))` [RING_RULE `ring_add(r:R ring) (ring_mul r (ring_mul r (ring_of_num r a) (coeff a p)) (coeff ((d+1)-a) q)) (ring_mul r (coeff a p) (ring_mul r (ring_of_num r ((d+1)-a)) (coeff ((d+1)-a) q))) = ring_mul r (ring_add r (ring_of_num r a) (ring_of_num r ((d+1)-a))) (ring_mul r (coeff a p) (coeff ((d+1)-a) q))`] THEN - simp[GSYM RING_OF_NUM_ADD] THEN - num_linear_fact `!a. a <= d + 1 ==> a + (d+1) - a = d+1` THEN - set_fact_using `!a. a IN (0..d+1) ==> a <= d+1` [NUMSEG_LE] THEN - have `!a. a IN (0..d+1) ==> a+(d+1)-a = d+1` [NUMSEG_LE] THEN - simp[] -);; - let x_derivative_mul = prove(` !(r:R ring) p q. ring_powerseries r p ==> @@ -5960,12 +5684,7 @@ let x_derivative_mul = prove(` (poly_mul r (x_derivative r p) q) (poly_mul r p (x_derivative r q)) `, - intro THEN - sufficesby eq_coeff THEN - intro THEN - simp[coeff_x_derivative_poly_mul] THEN - rw[coeff_poly_add] -);; + simp[X_DERIVATIVE_EQ_POLY_DERIV; POLY_DERIV_MUL]);; let x_derivative_mul_const = prove(` !(r:R ring) c q. @@ -5974,16 +5693,7 @@ let x_derivative_mul_const = prove(` x_derivative r (poly_mul r (poly_const r c) q) = poly_mul r (poly_const r c) (x_derivative r q) `, - intro THEN - have `ring_powerseries(r:R ring) ((poly_const r c):(1->num)->R)` [RING_POWERSERIES_CONST] THEN - have `ring_powerseries(r:R ring) (x_derivative r q)` [x_derivative_series] THEN - have `ring_powerseries(r:R ring) (poly_mul r (poly_const r c) (x_derivative r q))` [RING_POWERSERIES_MUL] THEN - simp[x_derivative_mul] THEN - simp[x_derivative_poly_const] THEN - simp[POLY_MUL_0;RING_MUL_LZERO] THEN - simp[POWSER_MUL_0] THEN - qed[POLY_ADD_LZERO] -);; + simp[X_DERIVATIVE_EQ_POLY_DERIV; POLY_DERIV_CMUL]);; let x_derivative_x_minus_const = prove(` !(r:R ring) c. @@ -6031,13 +5741,7 @@ let x_derivative_subring = prove(` x_derivative (subring_generated r G) p = x_derivative r p `, - intro THEN - sufficesby eq_coeff THEN - intro THEN - rw[coeff_x_derivative] THEN - rw[SUBRING_GENERATED] THEN - rw[RING_OF_NUM_SUBRING_GENERATED] -);; + rw[X_DERIVATIVE_EQ_POLY_DERIV; POLY_DERIV_SUBRING_GENERATED]);; (* basically: derivative of sp/sq is derivative of p/q *) let x_derivative_ratio_scaling = prove(` @@ -6251,17 +5955,7 @@ let x_derivative_sum = prove(` x_derivative r (poly_sum r S p) = poly_sum r S (\s. x_derivative r (p s)) `, - intro THEN - sufficesby eq_coeff THEN - intro THEN - have `!s:X. s IN S ==> ring_powerseries(r:R ring) (x_derivative r (p s))` [x_derivative_series] THEN - simp[coeff_poly_sum] THEN - rw[coeff_x_derivative] THEN - simp[coeff_poly_sum] THEN - have `ring_of_num(r:R ring) (d+1) IN ring_carrier r` [RING_OF_NUM] THEN - have `!s:X. s IN S ==> coeff (d+1) (p s) IN ring_carrier(r:R ring)` [coeff_series_in_ring] THEN - simp[RING_SUM_LMUL] -);; + simp[X_DERIVATIVE_EQ_POLY_DERIV; poly_sum; x_series; POLY_DERIV_SUM]);; let poly_deg_sum_le = prove(` !(r:R ring) (p:X->(1->num)->R) n S. @@ -6614,30 +6308,8 @@ let x_derivative_product = prove(` (x_derivative r (p s)) (poly_product r (S DELETE s) p)) `, - GEN_TAC THEN GEN_TAC THEN - sufficesby FINITE_INDUCT_STRONG THEN - intro THENL [ - rw[poly_product_empty;poly_sum_empty] THEN - rw[x_derivative_poly_1] - ; - set_fact `(x:X) IN x INSERT S` THEN - set_fact `!s:X. s IN S ==> s IN x INSERT S` THEN - set_fact `~(x IN S) ==> ((x:X) INSERT S) DELETE x = S` THEN - have `((x:X) INSERT S) DELETE x = S` [] THEN - have `ring_powerseries(r:R ring) (x_derivative r (p(x:X)))` [x_derivative_series] THEN - have `ring_powerseries(r:R ring) (poly_product r (S:X->bool) p)` [poly_product_series] THEN - have `ring_powerseries(r:R ring) (poly_mul r (x_derivative r (p(x:X))) (poly_product r (S:X->bool) p))` [RING_POWERSERIES_MUL] THEN - simp[poly_product_insert;poly_sum_insert] THEN - simp[x_derivative_mul] THEN - set_fact `!s:X. s IN S ==> ~(x IN S) ==> (x INSERT S) DELETE s = x INSERT (S DELETE s)` THEN - have `!s:X. s IN S ==> ring_powerseries (r:R ring) ((p:X->(1->num)->R) s)` [IN_INSERT] THEN - have `!s:X. FINITE(S DELETE s)` [FINITE_DELETE] THEN - have `!s:X. s IN S ==> ring_powerseries(r:R ring) ((\s. x_derivative r (p s)) s)` [x_derivative_series] THEN - have `ring_powerseries(r:R ring) (p(x:X):(1->num)->R)` [] THEN - specialize_assuming[`r:R ring`;`S:X->bool`;`\s:X. x_derivative(r:R ring) (p s)`;`p:X->(1->num)->R`;`x:X`]poly_mul_sum_mul_delete THEN - qed[] - ] -);; + simp[X_DERIVATIVE_EQ_POLY_DERIV; poly_sum; poly_product; + x_series; POLY_DERIV_PRODUCT]);; let poly_product_const = prove(` !(r:R ring) (p:(1->num)->R) S. @@ -6677,35 +6349,7 @@ let x_derivative_pow = prove(` ) ) `, - intro THEN - case `n = 0` THENL [ - simp[poly_pow_0;RING_OF_NUM_0] THEN - rw[poly_1;x_derivative_poly_const] THEN - rw[GSYM poly_0] THEN - qed[POWSER_MUL_0;x_derivative_series;poly_pow_series;RING_POWERSERIES_MUL] - ; pass - ] THEN - simp[poly_pow_is_product] THEN - have `FINITE (1..n)` [FINITE_NUMSEG] THEN - have `!i. i IN 1..n ==> ring_powerseries r (p:(1->num)->R)` [] THEN - specialize[`r:R ring`;`\i:num. p:(1->num)->R`;`1..n`]x_derivative_product THEN - subgoal `poly_sum(r:R ring) (1..n) (\s. poly_mul r (x_derivative r p) (poly_product r ((1..n) DELETE s) (\i. p))) = poly_sum r (1..n) (\s. poly_mul r (x_derivative r p) (poly_pow r p (n-1)))` THENL [ - sufficesby poly_sum_eq THEN - intro THEN - rw[BETA_THM] THEN - have `CARD(1..n) = n` [CARD_NUMSEG_1] THEN - have `CARD((1..n) DELETE s) = CARD(1..n) - 1` [CARD_DELETE] THEN - have `CARD((1..n) DELETE s) = n - 1` [] THEN - have `FINITE((1..n) DELETE s)` [FINITE_DELETE] THEN - simp[poly_product_const] - ; pass - ] THEN - simp[poly_product_const;FINITE_NUMSEG;CARD_NUMSEG_1] THEN - have `ring_powerseries(r:R ring) (poly_mul r (x_derivative r p) (poly_pow r p (n - 1)))` [RING_POWERSERIES_MUL;x_derivative_series;poly_pow_series] THEN - specialize[`r:R ring`;`poly_mul(r:R ring) (x_derivative r p) (poly_pow r p (n - 1))`;`1..n`]poly_sum_const THEN - have `CARD(1..n) = n` [CARD_NUMSEG_1] THEN - qed[] -);; + simp[X_DERIVATIVE_EQ_POLY_DERIV; POLY_DERIV_POW]);; let eval_poly_product = prove(` !(r:R ring) p:(X->(1->num)->R) z S. @@ -7291,11 +6935,6 @@ let monic_vanishing_at_image = prove(` (* ===== monic polynomials *) -let monic = new_definition ` - monic (r:R ring) (p:(1->num)->R) - <=> coeff (poly_deg r p) p = ring_1 r -`;; - let monic_zero_ring = prove(` !(r:R ring) p. ring_1 r = ring_0 r ==> @@ -7314,16 +6953,13 @@ let monic_poly_0 = prove(` !(r:R ring). monic r (poly_0 r) <=> ring_1 r = ring_0 r `, - rw[monic;POLY_DEG_0;coeff_poly_0] THEN - qed[] -);; + rw[MONIC_POLY_0; TRIVIAL_RING_10]);; let monic_poly_1 = prove(` !(r:R ring). monic r (poly_1 r) `, - rw[monic;POLY_DEG_1;coeff_poly_1] -);; + rw[MONIC_POLY_1]);; let poly_1_if_monic_deg_0 = prove(` !(r:R ring) p. @@ -7332,12 +6968,7 @@ let poly_1_if_monic_deg_0 = prove(` monic r p ==> p = poly_1 r `, - intro THEN - choose `c:R` `c IN ring_carrier r /\ p = poly_const r c:(1->num)->R` [POLY_DEG_EQ_0] THEN - have `coeff 0 p = c:R` [coeff_poly_const] THEN - have `coeff 0 p = ring_1(r:R ring)` [monic] THEN - qed[poly_1] -);; + qed[MONIC_DEG_0]);; let monic_x_pow = prove(` !(r:R ring) n. @@ -7366,43 +6997,6 @@ let monic_x_minus_const = prove(` ] );; -let topcoeff_monic_poly_mul = prove(` - !(r:R ring) p q. - ring_polynomial r p ==> - ring_polynomial r q ==> - monic r p ==> - monic r q ==> - coeff (poly_deg r p + poly_deg r q) (poly_mul r p q) - = ring_1 r -`, - rw[monic] THEN - intro THEN - rw[coeff_poly_mul_oneindex] THEN - subgoal `ring_sum(r:R ring) (0..poly_deg r p + poly_deg r q) (\a. ring_mul r (coeff a p) (coeff ((poly_deg r p + poly_deg r q) - a) q)) = ring_sum r (0..poly_deg r p + poly_deg r q) (\a. if a = poly_deg r p then ring_mul r (coeff a p) (coeff ((poly_deg r p + poly_deg r q) - a) q) else ring_0 r)` THENL [ - sufficesby RING_SUM_EQ THEN - intro THEN - simp[] THEN - case `a = poly_deg r (p:(1->num)->R)` THENL [ - simp[] - ; pass - ] THEN - simp[] THEN - case `a < poly_deg r (p:(1->num)->R)` THENL [ - num_linear_fact `a < poly_deg r (p:(1->num)->R) ==> ~((poly_deg r p + poly_deg r (q:(1->num)->R)) - a <= poly_deg r q)` THEN - num_linear_fact `poly_deg r (q:(1->num)->R) <= poly_deg r q` THEN - have `coeff ((poly_deg r (p:(1->num)->R) + poly_deg r (q:(1->num)->R)) - a) q = ring_0 r` [coeff_deg_le] THEN - qed[RING_MUL_RZERO;coeff_poly_in_ring] - ; - num_linear_fact `~(a = poly_deg r (p:(1->num)->R)) /\ ~(a < poly_deg r p) ==> ~(a <= poly_deg r p)` THEN - num_linear_fact `poly_deg r (p:(1->num)->R) <= poly_deg r p` THEN - have `coeff a (p:(1->num)->R) = ring_0 r` [coeff_deg_le] THEN - qed[RING_MUL_LZERO;coeff_poly_in_ring] - ] - ; pass - ] THEN - have `poly_deg r (p:(1->num)->R) IN 0..poly_deg r p + poly_deg r (q:(1->num)->R)` [IN_NUMSEG_0;ARITH_RULE `poly_deg r (p:(1->num)->R) <= poly_deg r p + poly_deg r (q:(1->num)->R)`] THEN - simp[RING_SUM_DELTA;RING_MUL_LID;RING_1;RING_MUL;coeff_poly_in_ring;ARITH_RULE `(poly_deg r (p:(1->num)->R) + poly_deg r (q:(1->num)->R)) - poly_deg r p = poly_deg r q`] -);; let deg_monic_poly_mul = prove(` !(r:R ring) p q. @@ -7412,21 +7006,7 @@ let deg_monic_poly_mul = prove(` monic r q ==> poly_deg r (poly_mul r p q) = poly_deg r p + poly_deg r q `, - intro THEN - case `ring_1(r:R ring) = ring_0 r` THENL [ - have `ring_powerseries r (p:(1->num)->R)` [ring_polynomial] THEN - have `ring_powerseries r (q:(1->num)->R)` [ring_polynomial] THEN - have `ring_powerseries r (poly_mul r (p:(1->num)->R) (q:(1->num)->R))` [RING_POWERSERIES_MUL] THEN - simp[deg_zero_ring] THEN - qed[ARITH_RULE `0+0 = 0`] - ; pass - ] THEN - have `ring_polynomial r (poly_mul r (p:(1->num)->R) (q:(1->num)->R))` [RING_POLYNOMIAL_MUL] THEN - have `poly_deg r (poly_mul r p q) <= poly_deg r (p:(1->num)->R) + poly_deg r (q:(1->num)->R)` [POLY_DEG_MUL_LE] THEN - have `coeff (poly_deg r (p:(1->num)->R) + poly_deg r (q:(1->num)->R)) (poly_mul r p q) = ring_1 r` [topcoeff_monic_poly_mul] THEN - have `~(coeff (poly_deg r (p:(1->num)->R) + poly_deg r (q:(1->num)->R)) (poly_mul r p q) = ring_0 r)` [] THEN - qed[deg_coeff_from_le] -);; + qed[POLY_DEG_MUL_MONIC]);; let monic_poly_mul = prove(` !(r:R ring) p q. @@ -7436,11 +7016,7 @@ let monic_poly_mul = prove(` monic r q ==> monic r (poly_mul r p q) `, - intro THEN - have `poly_deg r (poly_mul r (p:(1->num)->R) (q:(1->num)->R)) = poly_deg r p + poly_deg r q` [deg_monic_poly_mul] THEN - simp[monic] THEN - qed[topcoeff_monic_poly_mul] -);; + qed[MONIC_POLY_MUL]);; let monic_poly_product = prove(` !(r:R ring) p (S:X->bool). @@ -7449,24 +7025,11 @@ let monic_poly_product = prove(` (!s. s IN S ==> monic r (p s)) ==> monic r (poly_product r S p) `, - GEN_TAC THEN GEN_TAC THEN - sufficesby FINITE_INDUCT_STRONG THEN - intro THENL [ - rw[poly_product_empty] THEN - qed[monic_poly_1] - ; - set_fact `(x:X) IN x INSERT S` THEN - set_fact `!s:X. s IN S ==> s IN x INSERT S` THEN - have `!s:X. s IN S ==> ring_polynomial r (p(s:X):(1->num)->R)` [] THEN - have `ring_powerseries r (p(x:X):(1->num)->R)` [ring_polynomial] THEN - have `ring_polynomial r (p(x:X):(1->num)->R)` [] THEN - have `ring_polynomial (r:R ring) (poly_product r (S:X->bool) p)` [poly_product_poly] THEN - have `monic (r:R ring) (poly_product r (S:X->bool) p)` [] THEN - have `monic r (p(x:X):(1->num)->R)` [] THEN - simp[poly_product_insert] THEN - qed[monic_poly_mul] - ] -);; + intro THEN + SUBGOAL_THEN `poly_product (r:R ring) (S:X->bool) p = + ring_product(x_poly r) S p` SUBST1_TAC THENL + [qed[poly_product_ring_product_x_poly]; pass] THEN + rw[x_poly] THEN qed[MONIC_POLY_PRODUCT]);; let monic_vanishing_at_monic = prove(` !(r:R ring) S:X->bool c. @@ -7486,8 +7049,7 @@ let monic_subring = prove(` monic (subring_generated r G) p <=> monic r p `, - rw[monic;SUBRING_GENERATED;POLY_DEG_SUBRING_GENERATED] -);; + rw[MONIC_SUBRING_GENERATED]);; (* ===== r[x] when r is a field *) @@ -7526,7 +7088,7 @@ let squarefree_if_irreducible_over_field = prove(` ring_irreducible(x_poly r) p ==> ring_squarefree(x_poly r) p `, - qed[prime_iff_irreducible_over_field;ring_squarefree_if_prime] + qed[RING_IRREDUCIBLE_IMP_SQUAREFREE] );; let x_poly_field_monic_associate = prove(` @@ -7538,29 +7100,7 @@ let x_poly_field_monic_associate = prove(` monic r q /\ ring_associates(x_poly r) p q) `, - intro THEN - def `n:num` `poly_deg r (p:(1->num)->R)` THEN - def `pn:R` `coeff n (p:(1->num)->R)` THEN - have `pn IN ring_carrier(r:R ring)` [coeff_poly_in_ring] THEN - have `~(pn = ring_0(r:R ring))` [topcoeff_nonzero] THEN - have `ring_unit(r:R ring) pn` [FIELD_UNIT] THEN - have `ring_inv(r:R ring) pn IN ring_carrier r` [RING_INV] THEN - have `ring_mul(r:R ring) pn (ring_inv r pn) = ring_1 r` [ring_div_refl;ring_div] THEN - have `ring_mul(r:R ring) (ring_inv r pn) pn = ring_1 r` [RING_MUL_SYM] THEN - def `q:(1->num)->R` `poly_mul r (p:(1->num)->R) (poly_const r (ring_inv r pn))` THEN - have `poly_deg r (q:(1->num)->R) = poly_deg r (p:(1->num)->R)` [deg_mul_const_const_1] THEN - witness `q:(1->num)->R` THEN - rw[monic] THEN - have `ring_powerseries r (p:(1->num)->R)` [ring_polynomial] THEN - have `ring_polynomial r (q:(1->num)->R)` [RING_POLYNOMIAL_MUL;RING_POLYNOMIAL_CONST] THEN - have `ring_powerseries r (q:(1->num)->R)` [ring_polynomial] THEN - specialize[`r:R ring`;`ring_inv(r:R ring) pn`;`p:(1->num)->R`;`poly_deg r (p:(1->num)->R)`]coeff_times_poly_const THEN - have `coeff (poly_deg r (p:(1->num)->R)) (q:(1->num)->R) = ring_1 r` [coeff_times_poly_const] THEN - have `coeff (poly_deg r (q:(1->num)->R)) (q:(1->num)->R) = ring_1 r` [] THEN - rw[x_poly] THEN - have `ring_unit(r:R ring) (ring_inv r pn)` [RING_UNIT_INV] THEN - qed[associates_if_mul_unit_const;x_poly] -);; + rw[x_poly] THEN qed[FIELD_MONIC_ASSOCIATE]);; let mul_unit_const_if_associates = prove(` !(r:R ring) (p:(V->num)->R) q. @@ -7585,130 +7125,20 @@ let monic_associates = prove(` ring_associates(x_poly r) p q ==> p = q `, - intro THEN - choose `c:R` `ring_unit(r:R ring) c /\ q = poly_mul r p (poly_const r c:(1->num)->R)` [mul_unit_const_if_associates;x_poly] THEN - have `integral_domain(x_poly(r:R ring))` [integral_domain_x_poly_field] THEN - have `p IN ring_carrier(x_poly(r:R ring))` [INTEGRAL_DOMAIN_ASSOCIATES] THEN - have `q IN ring_carrier(x_poly(r:R ring))` [INTEGRAL_DOMAIN_ASSOCIATES] THEN - have `ring_polynomial r (p:(1->num)->R)` [x_poly_use] THEN - have `ring_polynomial r (q:(1->num)->R)` [x_poly_use] THEN - have `ring_unit(r:R ring) c` [] THEN - specialize[`r:R ring`;`p:(1->num)->R`;`c:R`]deg_mul_unit_const THEN - have `poly_deg r (q:(1->num)->R) = poly_deg r (p:(1->num)->R)` [deg_mul_unit_const;x_poly_use] THEN - have `ring_powerseries r (p:(1->num)->R)` [ring_polynomial] THEN - have `c IN ring_carrier(r:R ring)` [ring_unit] THEN - specialize[`r:R ring`;`c:R`;`p:(1->num)->R`;`poly_deg r (p:(1->num)->R)`]coeff_times_poly_const THEN - have `coeff (poly_deg r (p:(1->num)->R)) p = ring_1 r` [monic] THEN - have `coeff (poly_deg r (p:(1->num)->R)) q = ring_1 r` [monic] THEN - have `ring_1 r = ring_mul r c (ring_1(r:R ring))` [] THEN - have `c = ring_1(r:R ring)` [RING_MUL_RID] THEN - have `poly_const r c = ring_1 (x_poly(r:R ring))` [poly_1;x_poly_use] THEN - qed[RING_MUL_RID;x_poly_use] -);; - -let no_square_divisor_if_coprime_derivative_lemma1 = prove(` - !(r:R ring) q (u:(V->num)->R). - ring_polynomial r q ==> - ring_polynomial r u ==> - poly_mul r (poly_mul r q q) u - = poly_mul r q (poly_mul r q u) -`, - intro THEN - have `ring_powerseries(r:R ring) (q:(V->num)->R)` [ring_polynomial] THEN - have `ring_powerseries(r:R ring) (u:(V->num)->R)` [ring_polynomial] THEN - qed[POLY_MUL_ASSOC] -);; - -let no_square_divisor_if_coprime_derivative_lemma2 = prove(` - !(r:R ring) q u. - ring_polynomial r q ==> - ring_polynomial r u ==> - poly_add r - (poly_mul r - (poly_add r (poly_mul r (x_derivative r q) q) - (poly_mul r q (x_derivative r q))) - u) - (poly_mul r (poly_mul r q q) (x_derivative r u)) = - poly_mul r q - (poly_add r - (poly_mul r (poly_add r (x_derivative r q) (x_derivative r q)) u) - (poly_mul r q (x_derivative r u))) -`, - intro THEN - have `ring_polynomial(r:R ring) (x_derivative r q)` [x_derivative_polynomial] THEN - have `ring_polynomial(r:R ring) (x_derivative r u)` [x_derivative_polynomial] THEN - have `q IN ring_carrier(x_poly(r:R ring))` [x_poly_use] THEN - have `u IN ring_carrier(x_poly(r:R ring))` [x_poly_use] THEN - have `x_derivative r q IN ring_carrier(x_poly(r:R ring))` [x_poly_use] THEN - have `x_derivative r u IN ring_carrier(x_poly(r:R ring))` [x_poly_use] THEN - rw[x_poly_use] THEN - specialize[ - `x_poly(r:R ring)`;`q:(1->num)->R` - ;`x_derivative r q:(1->num)->R` - ;`u:(1->num)->R` - ;`x_derivative r u:(1->num)->R`] - (GENL[`r:R ring`;`q:R`;`Q:R`;`u:R`;`U:R`]( - RING_RULE `ring_add(r:R ring) (ring_mul r (ring_add r (ring_mul r Q q) (ring_mul r q Q)) u) (ring_mul r (ring_mul r q q) U) = ring_mul r q (ring_add r (ring_mul r (ring_add r Q Q) u) (ring_mul r q U))` - )) THEN - qed[] -);; + rw[x_poly] THEN + qed[MONIC_ASSOCIATES_EQ; FIELD_IMP_INTEGRAL_DOMAIN; + RING_ASSOCIATES_IN_CARRIER; IN_POLY_RING_CARRIER; POLY_RING]);; -let no_square_divisor_if_coprime_derivative = prove(` - !(r:R ring) p q. - field r ==> - ring_polynomial r q ==> - ring_coprime(x_poly r) (p,x_derivative r p) ==> - ring_divides(x_poly r) (poly_mul r q q) p ==> - ring_unit(x_poly r) q -`, - intro THEN - choose `u:(1->num)->R` `u IN ring_carrier(x_poly r) /\ p:(1->num)->R = ring_mul(x_poly r) (poly_mul r q q) u` [ring_divides] THEN - have `p:(1->num)->R = poly_mul r (poly_mul r q q) u` [x_poly_use] THEN - have `(p:(1->num)->R) IN ring_carrier(x_poly r)` [ring_coprime] THEN - have `ring_polynomial r (p:(1->num)->R)` [x_poly_use] THEN - have `ring_powerseries r (p:(1->num)->R)` [ring_polynomial] THEN - have `ring_powerseries r (q:(1->num)->R)` [ring_polynomial] THEN - specialize[`r:R ring`;`q:(1->num)->R`;`q:(1->num)->R`]x_derivative_mul THEN - have `ring_polynomial r (u:(1->num)->R)` [x_poly_use] THEN - have `ring_powerseries r (u:(1->num)->R)` [ring_polynomial] THEN - have `ring_powerseries r (poly_mul r q (q:(1->num)->R))` [RING_POWERSERIES_MUL] THEN - specialize[`r:R ring`;`poly_mul r q (q:(1->num)->R)`;`u:(1->num)->R`]x_derivative_mul THEN - have `x_derivative(r:R ring) p = poly_add r (poly_mul r (poly_add r (poly_mul r (x_derivative r q) q) (poly_mul r q (x_derivative r q))) u) (poly_mul r (poly_mul r q q) (x_derivative r u))` [] THEN - have `x_derivative(r:R ring) p = poly_mul r q (poly_add r (poly_mul r (poly_add r (x_derivative r q) (x_derivative r q)) u) (poly_mul r q (x_derivative r u)))` [no_square_divisor_if_coprime_derivative_lemma2] THEN - have `ring_polynomial r (x_derivative r (p:(1->num)->R))` [x_derivative_polynomial] THEN - have `ring_polynomial r (x_derivative r (q:(1->num)->R))` [x_derivative_polynomial] THEN - have `ring_polynomial r (x_derivative r (u:(1->num)->R))` [x_derivative_polynomial] THEN - have `ring_polynomial r (poly_add r (x_derivative r (q:(1->num)->R)) (x_derivative r q))` [RING_POLYNOMIAL_ADD] THEN - have `ring_polynomial r (poly_mul r (poly_add r (x_derivative r (q:(1->num)->R)) (x_derivative r q)) u)` [RING_POLYNOMIAL_MUL] THEN - have `ring_polynomial r (poly_mul r (q:(1->num)->R) (x_derivative r u))` [RING_POLYNOMIAL_MUL] THEN - have `ring_polynomial r (poly_add r (poly_mul r (poly_add r (x_derivative r (q:(1->num)->R)) (x_derivative r q)) u) (poly_mul r q (x_derivative r u)))` [RING_POLYNOMIAL_ADD] THEN - have `poly_add r (poly_mul r (poly_add r (x_derivative r (q:(1->num)->R)) (x_derivative r q)) u) (poly_mul r q (x_derivative r u)) IN ring_carrier(x_poly r)` [x_poly_use] THEN - have `(q:(1->num)->R) IN ring_carrier(x_poly r)` [x_poly_use] THEN - have `(p:(1->num)->R) IN ring_carrier(x_poly r)` [x_poly_use] THEN - have `x_derivative r (p:(1->num)->R) IN ring_carrier(x_poly r)` [x_poly_use] THEN - subgoal `ring_divides(x_poly(r:R ring)) q (x_derivative r p)` THENL [ - rw[ring_divides] THEN - intro THENL [qed[]; qed[]; pass] THEN - witness `poly_add r (poly_mul r (poly_add r (x_derivative r (q:(1->num)->R)) (x_derivative r q)) u) (poly_mul r q (x_derivative r u))` THEN - intro THENL [ - qed[] - ; - rw[GSYM x_poly_use] THEN - qed[] - ] - ; pass - ] THEN - subgoal `ring_divides(x_poly(r:R ring)) q p` THENL [ - rw[ring_divides] THEN - intro THENL [qed[]; qed[]; pass] THEN - witness `poly_mul r q u:(1->num)->R` THEN - have `ring_polynomial r (poly_mul r q u:(1->num)->R)` [RING_POLYNOMIAL_MUL] THEN - have `(poly_mul r q u:(1->num)->R) IN ring_carrier(x_poly r)` [x_poly_use] THEN - have `p:(1->num)->R = poly_mul r q (poly_mul r q u)` [no_square_divisor_if_coprime_derivative_lemma1] THEN - qed[x_poly_use] - ; pass - ] THEN - qed[ring_coprime] +let no_square_divisor_if_coprime_derivative = prove + (`!(r:R ring) p q. + field r ==> + ring_polynomial r q ==> + ring_coprime(x_poly r) (p,x_derivative r p) ==> + ring_divides(x_poly r) (poly_mul r q q) p ==> + ring_unit(x_poly r) q`, + rw[x_poly; X_DERIVATIVE_EQ_POLY_DERIV] THEN + qed[ring_squarefree; RING_POW_2; POLY_RING_CLAUSES; + RING_POLYNOMIAL; POLY_SEPARABLE_IMP_SQUAREFREE] );; let nonzero_if_coprime_derivative = prove(` @@ -7717,16 +7147,9 @@ let nonzero_if_coprime_derivative = prove(` ring_coprime(x_poly r) (p,x_derivative r p) ==> ~(p = poly_0 r) `, - intro THEN - have `PID (x_poly(r:R ring))` [PID_x_poly_field] THEN - have `ring_0(x_poly r):(1->num)->R = poly_0 r` [x_poly_use] THEN - have `p IN ring_carrier(x_poly(r:R ring))` [ring_coprime] THEN - have `x_derivative r p = ring_0(x_poly r):(1->num)->R` [x_derivative_poly_0] THEN - have `ring_gcd(x_poly r) (p,x_derivative r p) = ring_0(x_poly r):(1->num)->R` [RING_GCD_00] THEN - have `x_derivative r p IN ring_carrier(x_poly(r:R ring))` [ring_coprime] THEN - specialize[`x_poly(r:R ring)`;`p:(1->num)->R`;`x_derivative (r:R ring) p`]RING_GCD_EQ_1 THEN - have `ring_gcd(x_poly r) (p,x_derivative r p) = ring_1(x_poly r):(1->num)->R` [RING_GCD_EQ_1] THEN - qed[PID_IMP_INTEGRAL_DOMAIN;integral_domain] +rw[x_poly; X_DERIVATIVE_EQ_POLY_DERIV] THEN +qed[POLY_SEPARABLE_IMP_SQUAREFREE; RING_SQUAREFREE_IMP_NONZERO; + FIELD_IMP_NONTRIVIAL_RING; TRIVIAL_POLY_RING; POLY_RING] );; let squarefree_if_coprime_derivative = prove(` @@ -7735,60 +7158,17 @@ let squarefree_if_coprime_derivative = prove(` ring_coprime(x_poly r) (p,x_derivative r p) ==> ring_squarefree(x_poly r) p `, - intro THEN - have `p IN ring_carrier(x_poly(r:R ring))` [ring_coprime] THEN - have `~(p = ring_0(x_poly(r:R ring)))` [nonzero_if_coprime_derivative;x_poly_use] THEN - proven_if `ring_unit(x_poly(r:R ring)) p` [ring_squarefree_if_unit] THEN - have `PID (x_poly(r:R ring))` [PID_x_poly_field] THEN - have `UFD (x_poly(r:R ring))` [PID_IMP_UFD] THEN - ASSUME_TAC(UNDISCH_ALL (ISPECL[`p:(1->num)->R`] (CONJUNCT2 (UNDISCH_ALL (fst (EQ_IMP_RULE (UNDISCH_ALL (REWRITE_RULE [IMP_CONJ] (ISPECL [`x_poly(r:R ring)`]UFD_EQ_PRIMEFACT_NONUNIT))))))))) THEN - choose2 `n:num` `q:num->(1->num)->R` `1 <= n /\ (!i. 1 <= i /\ i <= n ==> ring_prime(x_poly(r:R ring)) (q i)) /\ ring_product(x_poly r) (1..n) q = p` [] THEN - subgoal `!i j. 1 <= i /\ i <= n /\ 1 <= j /\ j <= n /\ ring_divides(x_poly(r:R ring)) (q i) (q j) /\ ~(i = j) ==> F` THENL [ - intro THEN - have `FINITE (1..n)` [FINITE_NUMSEG] THEN - have `!i:num. i IN (1..n) ==> q i IN ring_carrier(x_poly(r:R ring))` [ring_prime;IN_NUMSEG] THEN - have `i IN (1..n)` [IN_NUMSEG] THEN - have `j IN (1..n)` [IN_NUMSEG] THEN - specialize[`x_poly(r:R ring)`;`1..n`;`q:num->(1->num)->R`;`i:num`;`j:num`]square_divides_product_if_factor_divides_factor THEN - have `ring_divides(x_poly(r:R ring)) (poly_mul r (q(i:num)) (q(i))) p` [x_poly_use] THEN - have `ring_polynomial r (q(i:num):(1->num)->R)` [ring_prime;x_poly_use] THEN - specialize[`r:R ring`;`p:(1->num)->R`;`q(i:num):(1->num)->R`]no_square_divisor_if_coprime_derivative THEN - qed[ring_prime] - ; pass - ] THEN - have `FINITE (1..n)` [FINITE_NUMSEG] THEN - have `!i. i IN 1..n ==> ring_prime(x_poly(r:R ring)) (q i)` [IN_NUMSEG] THEN - have `!i. i IN 1..n ==> q i IN ring_carrier(x_poly(r:R ring))` [ring_prime] THEN - have `!i j. i IN 1..n ==> j IN 1..n ==> ring_divides(x_poly(r:R ring)) (q i) (q j) ==> i = j` [IN_NUMSEG] THEN - specialize[`x_poly(r:R ring)`;`1..n`;`q:num->(1->num)->R`]ring_squarefree_if_product_coprime_primes_indexed THEN - qed[] + rw[x_poly; X_DERIVATIVE_EQ_POLY_DERIV] THEN + qed[POLY_SEPARABLE_IMP_SQUAREFREE] );; -let deg_x_derivative_lemma = prove(` - !(r:R ring) p d. - ring_polynomial r p ==> - ~(coeff d (x_derivative r p) = ring_0(r:R ring)) ==> - d <= poly_deg r p - 1 -`, - rw[coeff_x_derivative] THEN - intro THEN - have `~(coeff (d+1) p = ring_0(r:R ring))` [RING_MUL_RZERO;RING_OF_NUM] THEN - have `d+1 <= poly_deg r (p:(1->num)->R)` [coeff_le_deg] THEN - num_linear_fact `d+1 <= poly_deg r (p:(1->num)->R) ==> d <= poly_deg r p - 1` THEN - qed[] -);; let deg_x_derivative_le = prove(` !(r:R ring) p. ring_polynomial r p ==> poly_deg r (x_derivative r p) <= poly_deg r p - 1 `, - intro THEN - have `!d. ~(coeff d (x_derivative r p) = ring_0(r:R ring)) ==> d <= poly_deg r p - 1` [deg_x_derivative_lemma] THEN - have `ring_powerseries r (p:(1->num)->R)` [ring_polynomial] THEN - have `ring_polynomial r (x_derivative r (p:(1->num)->R))` [x_derivative_polynomial] THEN - qed[deg_le_coeff;ring_polynomial] -);; + rw[X_DERIVATIVE_EQ_POLY_DERIV; POLY_DEG_DERIV_LE]);; (* warning: 0 - 1 = 0 *) let deg_x_derivative = prove(` @@ -7798,28 +7178,7 @@ let deg_x_derivative = prove(` ring_polynomial r p ==> poly_deg r (x_derivative r p) = poly_deg r p - 1 `, - intro THEN - have `!d. ~(coeff d (x_derivative r p) = ring_0(r:R ring)) ==> d <= poly_deg r p - 1` [deg_x_derivative_lemma] THEN - case `poly_deg r (p:(1->num)->R) = 0` THENL [ - choose `c:R` `c IN ring_carrier r /\ (p:(1->num)->R) = poly_const r c` [POLY_DEG_EQ_0] THEN - have `x_derivative r (p:(1->num)->R) = poly_0 r` [x_derivative_poly_const] THEN - qed[POLY_DEG_0;ARITH_RULE `0 - 1 = 0`] - ; pass - ] THEN - subgoal `~(coeff (poly_deg r p - 1) (x_derivative r p) = ring_0(r:R ring))` THENL [ - have `ring_powerseries r (p:(1->num)->R)` [ring_polynomial] THEN - rw[coeff_x_derivative] THEN - num_linear_fact `~(poly_deg r (p:(1->num)->R) - 1 + 1 = 0)` THEN - have `~(ring_of_num r (poly_deg r (p:(1->num)->R) - 1 + 1) = ring_0 r)` [RING_CHAR_EQ_0] THEN - num_linear_fact `~(poly_deg r (p:(1->num)->R) = 0) ==> poly_deg r p - 1 + 1 = poly_deg r p` THEN - have `~((p:(1->num)->R) = poly_0 r)` [POLY_DEG_0;x_poly_use] THEN - have `~(coeff (poly_deg r p - 1 + 1) (p:(1->num)->R) = ring_0 r)` [topcoeff_nonzero] THEN - qed[integral_domain;RING_OF_NUM;coeff_poly_in_ring] - ; pass - ] THEN - have `ring_polynomial r (x_derivative r (p:(1->num)->R))` [x_derivative_polynomial] THEN - qed[deg_coeff;ring_polynomial] -);; + rw[X_DERIVATIVE_EQ_POLY_DERIV] THEN qed[POLY_DEG_DERIV]);; let x_derivative_nonzero = prove(` !(r:R ring) p. @@ -7829,27 +7188,8 @@ let x_derivative_nonzero = prove(` ~(poly_deg r p = 0) ==> ~(x_derivative r p = poly_0 r) `, - intro THEN - num_linear_fact `~(poly_deg r (p:(1->num)->R) = 0) ==> poly_deg r p - 1 + 1 = poly_deg r p` THEN - subgoal `~(coeff (poly_deg r p - 1) (x_derivative r p) = ring_0(r:R ring))` THENL [ - have `ring_powerseries r (p:(1->num)->R)` [ring_polynomial] THEN - rw[coeff_x_derivative] THEN - num_linear_fact `~(poly_deg r (p:(1->num)->R) - 1 + 1 = 0)` THEN - have `~(ring_of_num r (poly_deg r (p:(1->num)->R) - 1 + 1) = ring_0 r)` [RING_CHAR_EQ_0] THEN - have `~((p:(1->num)->R) = poly_0 r)` [POLY_DEG_0;x_poly_use] THEN - have `~(coeff (poly_deg r p - 1 + 1) (p:(1->num)->R) = ring_0 r)` [topcoeff_nonzero] THEN - qed[integral_domain;RING_OF_NUM;coeff_poly_in_ring] - ; pass - ] THEN - have `ring_powerseries r (p:(1->num)->R)` [ring_polynomial] THEN - have `coeff (poly_deg r (p:(1->num)->R) - 1) (x_derivative r p) = ring_mul r (ring_of_num r (poly_deg r p - 1 + 1)) (coeff (poly_deg r p - 1 + 1) p)` [coeff_x_derivative] THEN - have `coeff (poly_deg r (p:(1->num)->R) - 1) (x_derivative r p) = ring_mul r (ring_of_num r (poly_deg r p)) (coeff (poly_deg r p) p)` [coeff_x_derivative] THEN - have `~((p:(1->num)->R) = poly_0 r)` [POLY_DEG_0;x_poly_use] THEN - have `~(coeff (poly_deg r p) (p:(1->num)->R) = ring_0 r)` [topcoeff_nonzero] THEN - have `~(ring_of_num r (poly_deg r (p:(1->num)->R)) = ring_0 r)` [RING_CHAR_EQ_0] THEN - have `~(coeff (poly_deg r (p:(1->num)->R) - 1) (x_derivative r p) = ring_0 r)` [integral_domain;RING_OF_NUM;coeff_poly_in_ring] THEN - qed[coeff_poly_0] -);; + rw[X_DERIVATIVE_EQ_POLY_DERIV] THEN + qed[POLY_DERIV_NONZERO_CHAR0; ARITH_RULE `1 <= n <=> ~(n = 0)`]);; let deg_divides = prove(` !(r:R ring) (S:V->bool) p q. @@ -7996,30 +7336,9 @@ let coprime_prime_derivative = prove(` ring_prime(x_poly r) p ==> ring_coprime(x_poly r) (p,x_derivative r p) `, - rw[ring_coprime] THEN - intro THENL [ - qed[ring_prime] - ; - qed[ring_prime;x_poly_use;x_derivative_polynomial] - ; - have `integral_domain(x_poly(r:R ring))` [integral_domain_x_poly_field] THEN - have `ring_irreducible(x_poly(r:R ring)) p` [INTEGRAL_DOMAIN_PRIME_IMP_IRREDUCIBLE] THEN - proven_if `ring_unit (x_poly(r:R ring)) d` [] THEN - have `p IN ring_carrier(x_poly(r:R ring))` [ring_prime] THEN - have `ring_polynomial r (p:(1->num)->R)` [x_poly_use] THEN - have `ring_polynomial r (x_derivative r (p:(1->num)->R))` [x_derivative_polynomial] THEN - have `x_derivative r p IN ring_carrier(x_poly(r:R ring))` [x_poly_use] THEN - have `ring_associates(x_poly(r:R ring)) d p` [RING_NONUNIT_DIVIDES_IRREDUCIBLE] THEN - have `ring_divides(x_poly(r:R ring)) p (x_derivative r p)` [RING_ASSOCIATES_REFL;RING_ASSOCIATES_DIVIDES] THEN - have `integral_domain(r:R ring)` [FIELD_IMP_INTEGRAL_DOMAIN] THEN - have `~(poly_deg r (p:(1->num)->R) = 0)` [deg_prime] THEN - have `~(x_derivative r p = poly_0(r:R ring))` [x_derivative_nonzero] THEN - have `poly_deg r (p:(1->num)->R) <= poly_deg r (x_derivative r p)` [deg_divides;x_poly] THEN - have `poly_deg r (x_derivative r p) = poly_deg r (p:(1->num)->R) - 1` [deg_x_derivative] THEN - num_linear_fact `poly_deg r (p:(1->num)->R) <= poly_deg r (x_derivative r p) /\ poly_deg r (x_derivative r p) = poly_deg r (p:(1->num)->R) - 1 ==> poly_deg r p = 0` THEN - qed[] - ] -);; + rw[x_poly; X_DERIVATIVE_EQ_POLY_DERIV] THEN + qed[POLY_IRREDUCIBLE_IMP_SEPARABLE; INTEGRAL_DOMAIN_PRIME_IMP_IRREDUCIBLE; + INTEGRAL_DOMAIN_POLY_RING; FIELD_IMP_INTEGRAL_DOMAIN]);; let square_divides_if_also_divides_derivative = prove(` !(r:R ring) p f. @@ -8261,64 +7580,8 @@ let coprime_derivative_if_squarefree = prove(` ring_squarefree(x_poly r) f ==> ring_coprime(x_poly r) (f,x_derivative r f) `, - intro THEN - have `PID (x_poly(r:R ring))` [PID_x_poly_field] THEN - have `integral_domain(x_poly(r:R ring))` [PID_IMP_INTEGRAL_DOMAIN] THEN - have `f IN ring_carrier(x_poly(r:R ring))` [x_poly_use] THEN - have `~(f = ring_0(x_poly(r:R ring)))` [x_poly_use] THEN - proven_if `ring_unit(x_poly(r:R ring)) f` [ring_coprime_if_unit;x_derivative_polynomial;x_poly_use] THEN - have `UFD (x_poly(r:R ring))` [PID_IMP_UFD] THEN - ASSUME_TAC(UNDISCH_ALL (ISPECL[`f:(1->num)->R`] (CONJUNCT2 (UNDISCH_ALL (fst (EQ_IMP_RULE (UNDISCH_ALL (REWRITE_RULE [IMP_CONJ] (ISPECL [`x_poly(r:R ring)`]UFD_EQ_PRIMEFACT_NONUNIT))))))))) THEN - choose2 `n:num` `q:num->(1->num)->R` `1 <= n /\ (!i. 1 <= i /\ i <= n ==> ring_prime(x_poly(r:R ring)) (q i)) /\ ring_product(x_poly r) (1..n) q = f` [] THEN - have `FINITE (1..n)` [FINITE_NUMSEG] THEN - have `!i:num. i IN (1..n) ==> q i IN ring_carrier(x_poly(r:R ring))` [ring_prime;IN_NUMSEG] THEN - subgoal `!i j. 1 <= i /\ i <= n /\ 1 <= j /\ j <= n /\ ring_divides(x_poly(r:R ring)) (q i) (q j) /\ ~(i = j) ==> F` THENL [ - intro THEN - have `i IN (1..n)` [IN_NUMSEG] THEN - have `j IN (1..n)` [IN_NUMSEG] THEN - specialize[`x_poly(r:R ring)`;`1..n`;`q:num->(1->num)->R`;`i:num`;`j:num`]square_divides_product_if_factor_divides_factor THEN - have `ring_divides(x_poly(r:R ring)) (poly_mul r (q(i:num)) (q(i))) f` [x_poly_use] THEN - have `q(i:num):(1->num)->R IN ring_carrier(x_poly r)` [] THEN - have `~(ring_unit(x_poly r) (q(i:num):(1->num)->R))` [ring_prime] THEN - have `ring_divides(x_poly r) (ring_mul(x_poly r) (q(i:num)) (q(i))) (f:(1->num)->R)` [x_poly_use] THEN - specialize[`x_poly(r:R ring)`;`f:(1->num)->R`;`q(i:num):(1->num)->R`]not_squarefree_if_divisible_by_square THEN - qed[] - ; pass - ] THEN - simp[UFD_COPRIME] THEN - intro THENL [ - qed[x_poly_use;x_derivative_polynomial] - ; pass - ] THEN - have `FINITE (1..n)` [FINITE_NUMSEG] THEN - specialize[`x_poly(r:R ring)`;`p:(1->num)->R`;`1..n`;`q:num->(1->num)->R`]RING_PRIME_DIVIDES_PRODUCT THEN - choose `i:num` `i IN 1..n /\ ring_divides(x_poly(r:R ring)) p (q i)` [] THEN - have `i IN 1..n` [] THEN - have `ring_divides(x_poly(r:R ring)) p (q(i:num))` [] THEN - have `!i:num. i IN 1..n ==> ring_polynomial(r:R ring) (q i:(1->num)->R)` [x_poly_use] THEN - specialize[`r:R ring`;`q:num->(1->num)->R`;`1..n`]poly_product_ring_product_x_poly THEN - have `ring_divides(x_poly(r:R ring)) p (x_derivative r (poly_product r (1..n) q))` [] THEN - subgoal `!j:num. j IN (1..n) DELETE i ==> ring_coprime(x_poly(r:R ring)) (p,q j)` THENL [ - intro THEN - have `j IN (1..n)` [IN_DELETE] THEN - have `q(j:num) IN ring_carrier(x_poly(r:R ring))` [] THEN - specialize[`x_poly(r:R ring)`;`p:(1->num)->R`;`q(j:num):(1->num)->R`]INTEGRAL_DOMAIN_PRIME_DIVIDES_OR_COPRIME THEN - case `ring_divides(x_poly(r:R ring)) p (q(j:num))` THENL [ - have `1 <= i /\ i <= n` [IN_NUMSEG] THEN - have `1 <= j /\ j <= n` [IN_NUMSEG] THEN - have `~(i = j:num)` [IN_DELETE] THEN - have `ring_divides(x_poly(r:R ring)) (q(i:num)) (q j)` [prime_divides_prime_and;PID_IMP_UFD] THEN - qed[] - ; pass - ] THEN - qed[] - ; pass - ] THEN - specialize[`r:R ring`;`1..n`;`i:num`;`p:(1->num)->R`;`q:num->(1->num)->R`]divides_factor_and_derivative_product THEN - have `1 <= i /\ i <= n` [IN_NUMSEG] THEN - have `ring_prime(x_poly(r:R ring)) (q(i:num))` [] THEN - specialize[`r:R ring`;`q(i:num):(1->num)->R`]coprime_prime_derivative THEN - qed[ring_coprime;ring_prime] + rw[x_poly; X_DERIVATIVE_EQ_POLY_DERIV] THEN + qed[POLY_SQUAREFREE_IMP_SEPARABLE] );; let gcd_poly_linear_combination = prove(` @@ -12406,6 +11669,7 @@ let QinC_monic_irreducible_complex_roots = prove(` intro THEN have `UFD(x_poly QinC_ring)` [UFD_x_poly_QinC] THEN have `ring_prime(x_poly QinC_ring) p` [UFD_IRREDUCIBLE_EQ_PRIME] THEN + have `integral_domain(x_poly QinC_ring)` [UFD_IMP_INTEGRAL_DOMAIN] THEN have `ring_squarefree(x_poly QinC_ring) p` [ring_squarefree_if_prime] THEN have `ring_squarefree(x_poly complex_ring) p` [monic_QinC_squarefree_complex_squarefree] THEN have `ring_polynomial complex_ring (p:(1->num)->complex)` [poly_complex_if_poly_QinC] THEN diff --git a/Autoformalization/carleson.ml b/Autoformalization/carleson.ml new file mode 100644 index 00000000..0a6bba02 --- /dev/null +++ b/Autoformalization/carleson.ml @@ -0,0 +1,54474 @@ +(* ========================================================================= *) +(* Carleson's theorem: the Fourier series of an L^2 function on the circle *) +(* converges pointwise almost everywhere. *) +(* *) +(* Proof route: the concrete Lacey-Thiele time-frequency (tile) proof on R *) +(* as presented in Fremlin, Measure Theory vol 2, section 286 (286A-286V). *) +(* ========================================================================= *) + +needs "Autoformalization/fourier_transform.ml";; + +(* ========================================================================= *) +(* Fremlin 256M: the directed-supremum-integral identity. *) +(* *) +(* For a family {v_z : z in R} of x-continuous functions with pointwise sup *) +(* Ah(x) = sup_z |v_z(x)| and F of finite measure, *) +(* int_F Ah = sup { int_F (max_{i<=n} |v_{z i}|) : z:num->real, n:num }. *) +(* Absent from HOL Light; the entry point of Fremlin 286P. Built from the *) +(* sequence-form monotone convergence (finite maxima cmaxseq increase to the *) +(* countable sup; a Lindelof reduction recovers the uncountable sup). *) +(* Self-contained: depends only on the measure/realanalysis base. *) +(* ========================================================================= *) + +(* The recursive finite maximum of |u 0|,...,|u n| (a sequence u:num->real-> *) +(* real of functions). cmaxseq u n x = max_{i<=n} |u i x|. *) +let cmaxseq = define + `(cmaxseq (u:num->real->real) 0 x = abs(u 0 x)) /\ + (cmaxseq u (SUC n) x = max (cmaxseq u n x) (abs(u (SUC n) x)))`;; + +(* cmaxseq is increasing in n. *) +let CMAXSEQ_INCREASING = prove + (`!(u:num->real->real) n x. cmaxseq u n x <= cmaxseq u (SUC n) x`, + REWRITE_TAC[cmaxseq] THEN REAL_ARITH_TAC);; + +(* cmaxseq is nonnegative. *) +let CMAXSEQ_POS = prove + (`!(u:num->real->real) n x. &0 <= cmaxseq u n x`, + GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[cmaxseq] THEN REAL_ARITH_TAC);; + +(* cmaxseq u n dominates each |u i x| for i <= n. *) +let CMAXSEQ_GE = prove + (`!(u:num->real->real) n i x. i <= n ==> abs(u i x) <= cmaxseq u n x`, + GEN_TAC THEN INDUCT_TAC THEN REWRITE_TAC[cmaxseq] THENL + [SIMP_TAC[LE] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL]; + REWRITE_TAC[LE] THEN REPEAT STRIP_TAC THENL + [ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + MATCH_MP_TAC(REAL_ARITH `a <= b ==> a <= max b c`) THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]]);; + +(* cmaxseq preserves real-continuity-on (finite max of continuous). *) +let CMAXSEQ_CONTINUOUS = prove + (`!(u:num->real->real) s n. + (!i. (u i) real_continuous_on s) ==> (cmaxseq u n) real_continuous_on s`, + GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN DISCH_TAC THENL + [SUBGOAL_THEN + `cmaxseq (u:num->real->real) 0 = (\x. abs(u 0 x))` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; cmaxseq]; ALL_TAC] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_ABS THEN REWRITE_TAC[ETA_AX] THEN + ASM_SIMP_TAC[]; + SUBGOAL_THEN + `cmaxseq (u:num->real->real) (SUC n) = (\x. max (cmaxseq u n x) (abs(u + (SUC n) x)))` + SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM; cmaxseq]; ALL_TAC] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_MAX THEN CONJ_TAC THENL + [REWRITE_TAC[ETA_AX] THEN ASM_SIMP_TAC[]; + MATCH_MP_TAC REAL_CONTINUOUS_ON_ABS THEN REWRITE_TAC[ETA_AX] THEN + ASM_SIMP_TAC[]]]);; + +(* Each |u i x| is <= the sup of the family (given a uniform bound B). *) +let CMAXSEQ_TERM_LE_SUP = prove + (`!(u:num->real->real) x B i. + (!j. abs(u j x) <= B) + ==> abs(u i x) <= sup {abs(u j x) | j IN (:num)}`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_SUP THEN + MAP_EVERY EXISTS_TAC [`B:real`; `abs((u:num->real->real) i x)`] THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `i:num` THEN REWRITE_TAC[IN_UNIV]; + REWRITE_TAC[REAL_LE_REFL]; + REWRITE_TAC[IN_ELIM_THM] THEN X_GEN_TAC `w:real` THEN + DISCH_THEN(X_CHOOSE_THEN + `j:num` (CONJUNCTS_THEN2 (K ALL_TAC) SUBST1_TAC)) THEN + ASM_REWRITE_TAC[]]);; + +(* sup-approximation: for e>0 some term |u j x| exceeds sup - e. *) +let CMAXSEQ_SUP_APPROX = prove + (`!(u:num->real->real) x S e. + (!i. abs(u i x) <= S) /\ &0 < e /\ S = sup {abs(u j x) | j IN (:num)} + ==> ?j. S - e < abs((u:num->real->real) j x)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[GSYM REAL_NOT_LE] THEN + REWRITE_TAC[MESON[] `(?j. ~P j) <=> ~(!j. P j)`] THEN DISCH_TAC THEN + SUBGOAL_THEN `S <= S - e` MP_TAC THENL + [GEN_REWRITE_TAC LAND_CONV + [ASSUME `S = sup {abs((u:num->real->real) j x) | j IN (:num)}`] THEN + MATCH_MP_TAC REAL_SUP_LE THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN CONJ_TAC THENL + [MAP_EVERY EXISTS_TAC [`abs((u:num->real->real) 0 x)`; `0`] THEN + REWRITE_TAC[IN_UNIV]; + X_GEN_TAC `w:real` THEN + DISCH_THEN(X_CHOOSE_THEN + `j:num` (CONJUNCTS_THEN2 (K ALL_TAC) SUBST1_TAC)) THEN + ASM_REWRITE_TAC[]]; + ASM_REAL_ARITH_TAC]);; + +(* cmaxseq converges pointwise to the sup of the (bounded) family. *) +let CMAXSEQ_LIMIT_SUP = prove + (`!(u:num->real->real) x B. + (!i. abs(u i x) <= B) + ==> ((\n. cmaxseq u n x) ---> sup {abs(u j x) | j IN (:num)}) + sequentially`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `!i. abs((u:num->real->real) i x) <= + sup {abs(u j x) | j IN (:num)}` ASSUME_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC CMAXSEQ_TERM_LE_SUP THEN + EXISTS_TAC `B:real` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + ABBREV_TAC `S = sup {abs((u:num->real->real) j x) | j IN (:num)}` THEN + SUBGOAL_THEN `!n. cmaxseq (u:num->real->real) n x <= S` ASSUME_TAC THENL + [INDUCT_TAC THEN REWRITE_TAC[cmaxseq] THEN + ASM_REWRITE_TAC[REAL_MAX_LE]; ALL_TAC] THEN + REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(ISPECL [`u:num->real->real`; `x:real`; `S:real`; + `e:real`] CMAXSEQ_SUP_APPROX) THEN + ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN STRIP_TAC THEN + EXISTS_TAC `j:num` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + SUBGOAL_THEN `abs((u:num->real->real) j x) <= cmaxseq u n x` ASSUME_TAC THENL + [MATCH_MP_TAC CMAXSEQ_GE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n:num` o check (is_forall o concl)) THEN + ASM_REAL_ARITH_TAC);; + +(* cmaxseq is absolutely integrable on s if each u i is (finite max + abs). *) +let CMAXSEQ_ABSINT = prove + (`!(u:num->real->real) s n. + (!i. (u i) absolutely_real_integrable_on s) + ==> (cmaxseq u n) absolutely_real_integrable_on s`, + GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN DISCH_TAC THENL + [SUBGOAL_THEN + `cmaxseq (u:num->real->real) 0 = (\x. abs(u 0 x))` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; cmaxseq]; ALL_TAC] THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_ABS THEN ASM_REWRITE_TAC[ETA_AX]; + SUBGOAL_THEN + `cmaxseq (u:num->real->real) (SUC n) = (\x. max (cmaxseq u n x) (abs(u + (SUC n) x)))` + SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM; cmaxseq]; ALL_TAC] THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_MAX THEN CONJ_TAC THENL + [REWRITE_TAC[ETA_AX] THEN ASM_SIMP_TAC[]; + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_ABS THEN + ASM_REWRITE_TAC[ETA_AX]]]);; + +(* Monotone convergence for the finite maxima: if each u i is absolutely *) +(* integrable on s, |u i| is bounded by B on s, and the integrals of cmaxseq *) +(* are bounded by C, then the pointwise sup sup_j |u j x| is integrable and *) +(* int_s (cmaxseq u n) --> int_s (sup). *) +(* (REAL_MONOTONE_CONVERGENCE_INCREASING) *) +let CMAXSEQ_MCT = prove + (`!(u:num->real->real) s B C. + (!i. (u i) absolutely_real_integrable_on s) /\ + (!i x. x IN s ==> abs(u i x) <= B) /\ + (!n. real_integral s (cmaxseq u n) <= C) + ==> (\x. sup {abs(u j x) | j IN (:num)}) real_integrable_on s /\ + ((\n. real_integral s (cmaxseq u n)) ---> + real_integral s (\x. sup {abs(u j x) | j IN (:num)})) sequentially`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC REAL_MONOTONE_CONVERGENCE_INCREASING THEN + REPEAT CONJ_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE THEN + ASM_SIMP_TAC[CMAXSEQ_ABSINT]; + REPEAT STRIP_TAC THEN MATCH_ACCEPT_TAC CMAXSEQ_INCREASING; + REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN + MATCH_MP_TAC CMAXSEQ_LIMIT_SUP THEN + EXISTS_TAC `B:real` THEN ASM_SIMP_TAC[]; + REWRITE_TAC[real_bounded; FORALL_IN_GSPEC; IN_UNIV] THEN + EXISTS_TAC `C:real` THEN X_GEN_TAC `k:num` THEN + SUBGOAL_THEN + `&0 <= real_integral s (cmaxseq (u:num->real->real) k)` MP_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_POS THEN CONJ_TAC THENL + [MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE THEN + ASM_SIMP_TAC[CMAXSEQ_ABSINT]; + REPEAT STRIP_TAC THEN REWRITE_TAC[CMAXSEQ_POS]]; + FIRST_X_ASSUM(MP_TAC o SPEC `k:num` o check(is_forall o concl)) THEN + REAL_ARITH_TAC]]);; + +(* The usable 256Mb bound: if every finite-max integral is <= C, then the *) +(* integral of the pointwise sup (the maximal function) is <= C. This is *) +(* what *) +(* 286P consumes -- bound each finite max via 286N, conclude int_F Ah <= C. *) +let CMAXSEQ_SUP_INTEGRAL_LE = prove + (`!(u:num->real->real) s B C. + (!i. (u i) absolutely_real_integrable_on s) /\ + (!i x. x IN s ==> abs(u i x) <= B) /\ + (!n. real_integral s (cmaxseq u n) <= C) + ==> real_integral s (\x. sup {abs(u j x) | j IN (:num)}) <= C`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(ISPECL [`u:num->real->real`; `s:real->bool`; `B:real`; + `C:real`] CMAXSEQ_MCT) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + MATCH_MP_TAC(ISPEC `sequentially` REALLIM_LE) THEN + MAP_EVERY EXISTS_TAC + [`\n. real_integral s (cmaxseq (u:num->real->real) n)`; + `\n:num. C:real`] THEN + ASM_REWRITE_TAC[REALLIM_CONST; TRIVIAL_LIMIT_SEQUENTIALLY] THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `0` THEN + ASM_SIMP_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Fremlin 256M countable reduction: for a family {g i | i IN t} of *) +(* x-continuous functions, *) +(* pointwise bounded above, the uncountable pointwise sup sup_{i in t} g i x *) +(* equals sup_{i in j} g i x for a COUNTABLE j SUBSET t. This is exactly *) +(* Fremlin's step "there is a countable Psi SUBSET Phi with g = sup Psi": *) +(* continuity makes each superlevel {g i > a} open, so {sup > a} is an open *) +(* union that a countable subcover (LINDELOF = 2nd-countability of R, the *) +(* abstract form of Fremlin's rational boxes) captures; collecting over the *) +(* countable rational thresholds yields the single countable index set. *) +(* Combined with CMAXSEQ_SUP_INTEGRAL_LE (which supplies *) +(* Fremlin's running-max B.Levi step), this gives the 256Mb integral bound *) +(* WITHOUT any upper-integral machinery. *) +(* ------------------------------------------------------------------------- *) + +(* Real-line Lindelof: any family of real_open sets has a countable *) +(* subfamily with the same union (transported from the R^1 topological *) +(* LINDELOF). *) +let CM_REAL_LINDELOF = prove + (`!f:(real->bool)->bool. + (!s. s IN f ==> real_open s) + ==> ?f'. f' SUBSET f /\ COUNTABLE f' /\ UNIONS f' = UNIONS f`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `IMAGE (IMAGE lift) (f:(real->bool)->bool)` LINDELOF) THEN + ANTS_TAC THENL + [REWRITE_TAC[FORALL_IN_IMAGE] THEN X_GEN_TAC `s:real->bool` THEN + DISCH_TAC THEN REWRITE_TAC[GSYM REAL_OPEN] THEN ASM_SIMP_TAC[]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `g:(real^1->bool)->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `IMAGE (IMAGE drop) (g:(real^1->bool)->bool)` THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN X_GEN_TAC `t:real^1->bool` THEN + DISCH_TAC THEN + SUBGOAL_THEN + `(t:real^1->bool) IN IMAGE (IMAGE lift) (f:(real->bool)->bool)` + MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + REWRITE_TAC[IN_IMAGE] THEN + DISCH_THEN(X_CHOOSE_THEN `s:real->bool` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `IMAGE drop (t:real^1->bool) = s` (fun th -> ASM_REWRITE_TAC[th]) THEN + ASM_REWRITE_TAC[GSYM IMAGE_o; o_DEF; LIFT_DROP; IMAGE_ID]; + MATCH_MP_TAC COUNTABLE_IMAGE THEN ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[GSYM IMAGE_UNIONS] THEN + REWRITE_TAC[GSYM IMAGE_o; o_DEF; LIFT_DROP; IMAGE_ID] THEN + REWRITE_TAC[GSYM IMAGE_o; o_DEF; LIFT_DROP; IMAGE_ID]]);; + +(* Superlevel set of an everywhere-continuous real function is real_open. *) +let CM_REAL_OPEN_SUPERLEVEL_CONTINUOUS = prove + (`!g:real->real a. (!x. g real_continuous atreal x) ==> real_open {y | g y > + a}`, + REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_OPEN; OPEN_CONTAINS_BALL] THEN + REWRITE_TAC[FORALL_IN_IMAGE; IN_ELIM_THM] THEN X_GEN_TAC `y:real` THEN + DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `y:real`) THEN + REWRITE_TAC[real_continuous_atreal] THEN + DISCH_THEN(fun th -> MP_TAC(SPEC `(g:real->real) y - a` th)) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[SUBSET; IN_BALL] THEN + REWRITE_TAC[IN_IMAGE; IN_ELIM_THM] THEN + X_GEN_TAC `z:real^1` THEN DISCH_TAC THEN EXISTS_TAC `drop z` THEN + REWRITE_TAC[LIFT_DROP] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `drop z`) THEN + SUBGOAL_THEN `abs(drop z - y) < d` (fun th -> SIMP_TAC[th]) THENL + [FIRST_X_ASSUM MP_TAC THEN REWRITE_TAC[DIST_1; LIFT_DROP] THEN + REAL_ARITH_TAC; + REWRITE_TAC[real_gt] THEN ASM_REAL_ARITH_TAC]);; + +(* Indexed Lindelof: an index set t of real_open sets u i has a countable *) +(* sub-index set j with the same union. *) +let CM_LINDELOF_INDEXED = prove + (`!(u:A->real->bool) t. + (!i. i IN t ==> real_open (u i)) + ==> ?j. j SUBSET t /\ COUNTABLE j /\ + UNIONS {u i | i IN j} = UNIONS {u i | i IN t}`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `{(u:A->real->bool) i | i IN t}` CM_REAL_LINDELOF) THEN + ANTS_TAC THENL + [REWRITE_TAC[FORALL_IN_GSPEC] THEN ASM_SIMP_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `f':(real->bool)->bool` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `?pick. !s. s IN f' ==> pick s IN t /\ (u:A->real->bool)(pick s) = s` + STRIP_ASSUME_TAC THENL + [REWRITE_TAC[GSYM SKOLEM_THM] THEN X_GEN_TAC `s:real->bool` THEN + ASM_CASES_TAC `(s:real->bool) IN f'` THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `s:real->bool` o + GEN_REWRITE_RULE I [SUBSET]) THEN + ASM_REWRITE_TAC[IN_ELIM_THM] THEN MESON_TAC[]; + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + EXISTS_TAC `IMAGE (pick:(real->bool)->A) f'` THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN ASM_SIMP_TAC[]; + MATCH_MP_TAC COUNTABLE_IMAGE THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `{(u:A->real->bool) i | i IN IMAGE pick f'} = f'` + (fun th -> ASM_REWRITE_TAC[th]) THEN + REWRITE_TAC[SIMPLE_IMAGE; GSYM IMAGE_o] THEN + SUBGOAL_THEN + `IMAGE ((u:A->real->bool) o (pick:(real->bool)->A)) f' = IMAGE (\s. s) f'` + (fun th -> REWRITE_TAC[th; IMAGE_ID]) THEN + MATCH_MP_TAC IMAGE_EQ THEN X_GEN_TAC `s:real->bool` THEN DISCH_TAC THEN + REWRITE_TAC[o_THM] THEN ASM_SIMP_TAC[]);; + +(* Cover-to-sup bridge (rational thresholds): if j SUBSET t is nonempty, the *) +(* family is pointwise bounded above at x, and for every RATIONAL a the *) +(* superlevels {g i > a} over j and over t have equal union, then the sups *) +(* at x *) +(* agree. (Rational a suffices: the refutation uses a rational strictly *) +(* between sup_j and g i x from RATIONAL_BETWEEN.) *) +let CM_COVER_SUP_EQ_RAT = prove + (`!(g:A->real->real) t j x. + j SUBSET t /\ ~(j = {}) /\ + (?B. !i. i IN t ==> g i x <= B) /\ + (!a. rational a + ==> UNIONS {{y | (g:A->real->real) i y > a} | i IN j} = + UNIONS {{y | g i y > a} | i IN t}) + ==> sup {g i x | i IN t} = sup {g i x | i IN j}`, + REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN + FIRST_X_ASSUM(LABEL_TAC "cover" o + check(fun th -> is_forall(concl th) && + (let b = snd(dest_forall(concl th)) in is_imp b && + (is_eq(snd(dest_imp b)))))) THEN + CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC REAL_SUP_LE_SUBSET THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + FIRST_X_ASSUM(X_CHOOSE_TAC `i0:A` o REWRITE_RULE[GSYM MEMBER_NOT_EMPTY]) + THEN + REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[]; + REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; IN_ELIM_THM] THEN + X_GEN_TAC `i:A` THEN DISCH_TAC THEN EXISTS_TAC `i:A` THEN ASM SET_TAC[]; + EXISTS_TAC `B:real` THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN + ASM_SIMP_TAC[]]] THEN + MATCH_MP_TAC REAL_SUP_LE THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + ASM SET_TAC[]; ALL_TAC] THEN + ABBREV_TAC `S = sup {(g:A->real->real) i x | i IN j}` THEN + SUBGOAL_THEN `!i'. i' IN j ==> (g:A->real->real) i' x <= S` + (LABEL_TAC "bnd") THENL + [EXPAND_TAC "S" THEN + X_GEN_TAC `i':A` THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LE_SUP THEN + MAP_EVERY EXISTS_TAC [`B:real`; `(g:A->real->real) i' x`] THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `i':A` THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_LE_REFL]; + REWRITE_TAC[FORALL_IN_GSPEC] THEN X_GEN_TAC `i'':A` THEN DISCH_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[]]; + ALL_TAC] THEN + REWRITE_TAC[FORALL_IN_GSPEC] THEN + X_GEN_TAC `i:A` THEN DISCH_TAC THEN + GEN_REWRITE_TAC I [GSYM REAL_NOT_LT] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`S:real`; `(g:A->real->real) i x`] RATIONAL_BETWEEN) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `a:real` STRIP_ASSUME_TAC) THEN + REMOVE_THEN "cover" (MP_TAC o SPEC `a:real`) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[EXTENSION] THEN DISCH_THEN(MP_TAC o SPEC `x:real`) THEN + REWRITE_TAC[IN_UNIONS; EXISTS_IN_GSPEC; IN_ELIM_THM] THEN + MATCH_MP_TAC(TAUT `(q /\ ~p) ==> ~(p <=> q)`) THEN CONJ_TAC THENL + [EXISTS_TAC `i:A` THEN ASM_REWRITE_TAC[real_gt]; + REWRITE_TAC[NOT_EXISTS_THM] THEN X_GEN_TAC `i'':A` THEN + REWRITE_TAC[DE_MORGAN_THM; real_gt; REAL_NOT_LT] THEN + ASM_CASES_TAC `(i'':A) IN j` THENL + [DISJ2_TAC THEN + SUBGOAL_THEN `(g:A->real->real) i'' x <= S` + (fun th -> MP_TAC th THEN ASM_REAL_ARITH_TAC) THEN + USE_THEN "bnd" MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]]]);; + +(* MAIN 256M countable reduction: a pointwise-bounded family of x-continuous *) +(* functions has a COUNTABLE sub-index set realising the same pointwise sup *) +(* everywhere. *) +let CM_MEASURABLE_SUP_COUNTABLE_REDUCTION = prove + (`!(g:A->real->real) t. + (!i. i IN t ==> (!x. (g i) real_continuous atreal x)) /\ + (!x. ?B. !i. i IN t ==> g i x <= B) /\ ~(t = {}) + ==> ?j. j SUBSET t /\ COUNTABLE j /\ ~(j = {}) /\ + (!x. sup {g i x | i IN t} = sup {g i x | i IN j})`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `!a:real. ?ja. ja SUBSET t /\ COUNTABLE ja /\ + UNIONS {{y | (g:A->real->real) i y > a} | i IN ja} = + UNIONS {{y | g i y > a} | i IN t}` + (fun th -> MP_TAC(REWRITE_RULE[SKOLEM_THM] th)) THENL + [X_GEN_TAC `a:real` THEN + MP_TAC(ISPECL [`\i:A. {x | (g:A->real->real) i x > a}`; `t:A->bool`] + CM_LINDELOF_INDEXED) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [X_GEN_TAC `i:A` THEN DISCH_TAC THEN + MATCH_MP_TAC CM_REAL_OPEN_SUPERLEVEL_CONTINUOUS THEN + GEN_TAC THEN REWRITE_TAC[ETA_AX] THEN ASM_SIMP_TAC[]; + DISCH_THEN(X_CHOOSE_THEN `ja:A->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `ja:A->bool` THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `J:real->A->bool` (LABEL_TAC "J")) THEN + FIRST_X_ASSUM(X_CHOOSE_TAC `i0:A` o REWRITE_RULE[GSYM MEMBER_NOT_EMPTY]) THEN + ABBREV_TAC `j = (i0:A) INSERT (UNIONS {(J:real->A->bool) q | rational q})` + THEN + SUBGOAL_THEN `(j:A->bool) SUBSET t` (LABEL_TAC "jsub") THENL + [EXPAND_TAC "j" THEN REWRITE_TAC[INSERT_SUBSET] THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_GSPEC] THEN + X_GEN_TAC `q:real` THEN DISCH_TAC THEN + USE_THEN "J" (MP_TAC o SPEC `q:real`) THEN SIMP_TAC[]]; + ALL_TAC] THEN + EXISTS_TAC `j:A->bool` THEN ASM_REWRITE_TAC[] THEN + REPEAT(CONJ_TAC THENL + [EXPAND_TAC "j" THEN REWRITE_TAC[COUNTABLE_INSERT] THEN + MATCH_MP_TAC COUNTABLE_UNIONS THEN CONJ_TAC THENL + [SUBGOAL_THEN + `{(J:real->A->bool) q | rational q} = IMAGE J {q | rational q}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE] THEN + MESON_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC COUNTABLE_IMAGE THEN + MP_TAC COUNTABLE_RATIONAL THEN MATCH_MP_TAC EQ_IMP THEN + AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN]; + REWRITE_TAC[FORALL_IN_GSPEC] THEN X_GEN_TAC `q:real` THEN DISCH_TAC THEN + USE_THEN "J" (MP_TAC o SPEC `q:real`) THEN SIMP_TAC[]]; + ALL_TAC]) THEN + CONJ_TAC THENL + [EXPAND_TAC "j" THEN REWRITE_TAC[NOT_INSERT_EMPTY]; ALL_TAC] THEN + X_GEN_TAC `x:real` THEN + MATCH_MP_TAC CM_COVER_SUP_EQ_RAT THEN + REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + EXPAND_TAC "j" THEN REWRITE_TAC[NOT_INSERT_EMPTY]; + ASM_SIMP_TAC[]; + ALL_TAC] THEN + X_GEN_TAC `a:real` THEN DISCH_TAC THEN + REWRITE_TAC[EXTENSION; IN_UNIONS; EXISTS_IN_GSPEC; IN_ELIM_THM] THEN + X_GEN_TAC `x':real` THEN EQ_TAC THENL + [DISCH_THEN(X_CHOOSE_THEN `i:A` STRIP_ASSUME_TAC) THEN EXISTS_TAC `i:A` THEN + ASM_REWRITE_TAC[] THEN + RULE_ASSUM_TAC(REWRITE_RULE[SUBSET]) THEN ASM_MESON_TAC[]; + DISCH_TAC THEN + USE_THEN "J" (MP_TAC o SPEC `a:real`) THEN + DISCH_THEN(MP_TAC o CONJUNCT2 o CONJUNCT2) THEN + REWRITE_TAC[EXTENSION; IN_UNIONS; EXISTS_IN_GSPEC; IN_ELIM_THM] THEN + DISCH_THEN(MP_TAC o SPEC `x':real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `i:A` STRIP_ASSUME_TAC) THEN EXISTS_TAC `i:A` THEN + ASM_REWRITE_TAC[] THEN EXPAND_TAC "j" THEN + REWRITE_TAC[IN_INSERT; IN_UNIONS; IN_ELIM_THM] THEN DISJ2_TAC THEN + EXISTS_TAC `(J:real->A->bool) a` THEN ASM_REWRITE_TAC[] THEN + EXISTS_TAC `a:real` THEN ASM_REWRITE_TAC[]]);; + + +(* ========================================================================= *) +(* Fremlin 282: complex-exponential Fourier series on the circle. This *) +(* supplies the two facts *) +(* Fremlin 286O(b) consumes: 282Rb (absolute summability sum_n |c_n(g)| < *) +(* inf for C^2 periodic g) and 282L (pointwise inversion *) +(* sum c_n e^{int} --> g). *) +(* Here c_n(g) = (1/2pi) int_{-pi}^{pi} g e^{-int}, complex-valued. *) +(* *) +(* This layer uses complex cfourier_coeff / cfourier_partial / periodize, *) +(* specialized to the tile theory. *) +(* ========================================================================= *) + +(* Complex Fourier coefficient of g on [-pi,pi]: c_n = (1/2pi) int g *) +(* e^{-int}. *) +let cfourier_coeff = new_definition + `cfourier_coeff (g:real->complex) (n:int) = + Cx(inv(&2 * pi)) * integral (IMAGE lift (real_interval[--pi,pi])) + (\t. g(drop t) * cexp(--(ii * Cx(real_of_int n) * Cx(drop t))))`;; + +(* Two-sided symmetric partial sum S_N g (t) = sum over abs n <= N of c_n *) +(* e^int. *) +let cfourier_partial = new_definition + `cfourier_partial (g:real->complex) (N:num) (t:real) = + vsum {n:int | abs n <= &N} + (\n. cfourier_coeff g n * cexp(ii * Cx(real_of_int n) * Cx t))`;; + +(* The symmetric index set {n : |n| <= N} is finite. *) +let CFOURIER_INDEX_FINITE = prove + (`!N:num. FINITE {n:int | abs n <= &N}`, + GEN_TAC THEN REWRITE_TAC[INT_ABS_LE; GSYM CONJ_ASSOC] THEN + MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `{n:int | --(&N) <= n /\ n <= &N}` THEN + REWRITE_TAC[FINITE_INT_SEG] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN + INT_ARITH_TAC);; + +(* Boundary values of the kernel agree at +-pi (both are (-1)^n), because *) +(* the difference of exponents is 2 pi n i with n an integer *) +(* (CEXP_INTEGER_2PI). *) +let CEXP_BOUNDARY_PERIODIC = prove + (`!n:int. cexp(--(ii * Cx(real_of_int n) * Cx pi)) = + cexp(--(ii * Cx(real_of_int n) * Cx(--pi)))`, + GEN_TAC THEN + MP_TAC(ISPEC `real_of_int n` CEXP_INTEGER_2PI) THEN + REWRITE_TAC[INTEGER_REAL_OF_INT] THEN DISCH_TAC THEN + SUBGOAL_THEN + `--(ii * Cx(real_of_int n) * Cx(--pi)) = + --(ii * Cx(real_of_int n) * Cx pi) + Cx(&2 * real_of_int n * pi) * ii` + SUBST1_TAC THENL + [REWRITE_TAC[CX_NEG; CX_MUL] THEN CONV_TAC COMPLEX_RING; ALL_TAC] THEN + REWRITE_TAC[CEXP_ADD] THEN ASM_REWRITE_TAC[] THEN CONV_TAC COMPLEX_RING);; + +(* 282(deriv): for a C^1 periodic g, the Fourier coefficient of g' is *) +(* i n c_n(g). Integration by parts (FOURIER_IBP_FINITE); the boundary term *) +(* g(pi)e^{-in pi} - g(-pi)e^{in pi} vanishes by periodicity + *) +(* CEXP_BOUNDARY_ *) +(* PERIODIC. Iterating this twice gives c_n(g'') = -n^2 c_n(g), the decay *) +(* estimate behind absolute summability (282Rb). *) +let CFOURIER_COEFF_DERIV = prove + (`!(g:real->complex) g' n. + (!x. ((\z. g(drop z)) has_vector_derivative (g' x)) (at(lift x))) /\ + (\z. cexp(--(ii * Cx(real_of_int n) * Cx(drop z))) * g'(drop z)) + integrable_on interval[lift(--pi),lift pi] /\ + g(pi) = g(--pi) + ==> cfourier_coeff g' n = ii * Cx(real_of_int n) * cfourier_coeff g n`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[cfourier_coeff; IMAGE_LIFT_REAL_INTERVAL] THEN + SUBGOAL_THEN + `integral (interval[lift(--pi),lift pi]) + (\t. (g':real->complex)(drop t) * cexp(--(ii * Cx(real_of_int n) * + Cx(drop t)))) = + integral (interval[lift(--pi),lift pi]) + (\t. cexp(--(ii * Cx(real_of_int n) * Cx(drop t))) * + (g':real->complex)(drop t)) /\ + integral (interval[lift(--pi),lift pi]) + (\t. (g:real->complex)(drop t) * cexp(--(ii * Cx(real_of_int n) * Cx(drop + t)))) = + integral (interval[lift(--pi),lift pi]) + (\t. cexp(--(ii * Cx(real_of_int n) * Cx(drop t))) * + (g:real->complex)(drop t))` + (CONJUNCTS_THEN SUBST1_TAC) THENL + [CONJ_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN + GEN_TAC THEN CONV_TAC COMPLEX_RING; ALL_TAC] THEN + MP_TAC(ISPECL [`g:real->complex`; `g':real->complex`; `real_of_int n`; `pi`] + FOURIER_IBP_FINITE) THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; PI_POS] THEN DISCH_THEN SUBST1_TAC THEN + ASM_REWRITE_TAC[CEXP_BOUNDARY_PERIODIC] THEN CONV_TAC COMPLEX_RING);; + +(* 282(deriv2): c_n(g'') = -n^2 c_n(g), iterating CFOURIER_COEFF_DERIV *) +(* twice. *) +let CFOURIER_COEFF_DERIV2 = prove + (`!(g:real->complex) g' g'' n. + (!x. ((\z. g(drop z)) has_vector_derivative (g' x)) (at(lift x))) /\ + (!x. ((\z. g'(drop z)) has_vector_derivative (g'' x)) (at(lift x))) /\ + (\z. cexp(--(ii * Cx(real_of_int n) * Cx(drop z))) * g'(drop z)) + integrable_on interval[lift(--pi),lift pi] /\ + (\z. cexp(--(ii * Cx(real_of_int n) * Cx(drop z))) * g''(drop z)) + integrable_on interval[lift(--pi),lift pi] /\ + g(pi) = g(--pi) /\ g'(pi) = g'(--pi) + ==> cfourier_coeff g'' n = + --(Cx(real_of_int n) pow 2) * cfourier_coeff g n`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`g':real->complex`; `g'':real->complex`; + `n:int`] CFOURIER_COEFF_DERIV) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + MP_TAC(ISPECL [`g:real->complex`; `g':real->complex`; + `n:int`] CFOURIER_COEFF_DERIV) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[COMPLEX_RING `ii * n * ii * n * c = --(n pow 2) * c`]);; + +(* The modulation kernel e^{-int} is measurable on [-pi,pi] (continuous). *) +let CEXP_KERNEL_MEASURABLE_INTERVAL = prove + (`!n. (\t:real^1. cexp(--(ii * Cx(real_of_int n) * Cx(drop t)))) + measurable_on interval[lift(--pi),lift pi]`, + GEN_TAC THEN MATCH_MP_TAC MEASURABLE_ON_MEASURABLE_SUBSET THEN + EXISTS_TAC `(:real^1)` THEN REWRITE_TAC[SUBSET_UNIV] THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_IMP_MEASURABLE_ON THEN + SUBGOAL_THEN + `(\t:real^1. cexp(--(ii * Cx(real_of_int n) * Cx(drop t)))) = + cexp o (\t. --((ii * Cx(real_of_int n)) * Cx(drop t)))` + SUBST1_TAC THENL [REWRITE_TAC[o_DEF; COMPLEX_MUL_ASSOC]; ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + REWRITE_TAC[CONTINUOUS_ON_CEXP] THEN + MATCH_MP_TAC CONTINUOUS_ON_NEG THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN + REWRITE_TAC[CONTINUOUS_ON_CONST] THEN + MATCH_MP_TAC CONTINUOUS_ON_CX_DROP THEN + REWRITE_TAC[CONTINUOUS_ON_ID]; + REWRITE_TAC[MEASURABLE_INTERVAL]]);; + +(* The modulation kernel has modulus 1. *) +let CFOURIER_KERNEL_NORM = prove + (`!n:int t. norm(cexp(--(ii * Cx(real_of_int n) * Cx t))) = &1`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN + `--(ii * Cx(real_of_int n) * Cx t) = ii * Cx(--(real_of_int n * t))` + SUBST1_TAC THENL + [REWRITE_TAC[CX_NEG; CX_MUL] THEN CONV_TAC COMPLEX_RING; ALL_TAC] THEN + REWRITE_TAC[NORM_CEXP_II]);; + +(* g absolutely integrable ==> g * (modulation kernel) absolutely integrable *) +(* (bounded-measurable x abs-integrable, *) +(* ABSOLUTELY_INTEGRABLE_BOUNDED_MEASURABLE_ PRODUCT after commuting to *) +(* kernel-first order). *) +let CFOURIER_INTEGRAND_ABSINT = prove + (`!(g:real->complex) n. + (\t. g(drop t)) absolutely_integrable_on interval[lift(--pi),lift pi] + ==> (\t:real^1. g(drop t) * cexp(--(ii * Cx(real_of_int n) * Cx(drop t)))) + absolutely_integrable_on interval[lift(--pi),lift pi]`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\t:real^1. g(drop t) * cexp(--(ii * Cx(real_of_int n) * Cx(drop t)))) = + (\t:real^1. cexp(--(ii * Cx(real_of_int n) * Cx(drop t))) * g(drop t))` + SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + CONV_TAC COMPLEX_RING; ALL_TAC] THEN + MP_TAC(ISPECL [`( * ):complex->complex->complex`; + `\t:real^1. cexp(--(ii * Cx(real_of_int n) * Cx(drop t)))`; + `\t:real^1. (g:real->complex)(drop t)`; + `interval[lift(--pi),lift pi]`] + ABSOLUTELY_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT) THEN + REWRITE_TAC[BILINEAR_COMPLEX_MUL] THEN + DISCH_THEN MATCH_MP_TAC THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[CEXP_KERNEL_MEASURABLE_INTERVAL]; + REWRITE_TAC[bounded; FORALL_IN_IMAGE] THEN EXISTS_TAC `&1` THEN + X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN + REWRITE_TAC[CFOURIER_KERNEL_NORM; REAL_LE_REFL]; + ASM_REWRITE_TAC[]]);; + +(* 282(bound): |c_n(g)| <= (1/2pi) int_{-pi}^{pi} |g|, uniformly in n. The *) +(* kernel *) +(* has modulus 1, so norm-of-integral <= integral-of-norm = int|g|. *) +let CFOURIER_COEFF_L1_BOUND = prove + (`!(g:real->complex) n. + (\t. g(drop t)) absolutely_integrable_on interval[lift(--pi),lift pi] + ==> norm(cfourier_coeff g n) + <= inv(&2 * pi) * drop(integral (interval[lift(--pi),lift pi]) (\t. + lift(norm(g(drop t)))))`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[cfourier_coeff; IMAGE_LIFT_REAL_INTERVAL] THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX] THEN + SUBGOAL_THEN `abs(inv(&2 * pi)) = inv(&2 * pi)` SUBST1_TAC THENL + [REWRITE_TAC[REAL_ABS_INV; REAL_ABS_REFL] THEN + MATCH_MP_TAC REAL_LE_INV THEN MP_TAC PI_POS THEN + REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INV THEN MP_TAC PI_POS THEN + REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPECL + [`\t:real^1. g(drop t) * cexp(--(ii * Cx(real_of_int n) * Cx(drop t)))`; + `interval[lift(--pi),lift pi]`] ABSOLUTELY_INTEGRABLE_LE) THEN + ASM_SIMP_TAC[CFOURIER_INTEGRAND_ABSINT] THEN + MATCH_MP_TAC(REAL_ARITH `a = b ==> x <= a ==> x <= b`) THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + AP_TERM_TAC THEN REWRITE_TAC[COMPLEX_NORM_MUL; CFOURIER_KERNEL_NORM] THEN + REAL_ARITH_TAC);; + +(* 282Rb(decay): n^2 |c_n(g)| <= (1/2pi) int|g''|, for C^2 periodic g. From *) +(* c_n(g'') = -n^2 c_n(g) (DERIV2) + the uniform L^1 bound at g'' *) +(* (L1_BOUND). This *) +(* is the O(1/n^2) decay that yields absolute summability of the *) +(* coefficients. *) +let CFOURIER_COEFF_DECAY = prove + (`!(g:real->complex) g' g'' n. + (!x. ((\z. g(drop z)) has_vector_derivative (g' x)) (at(lift x))) /\ + (!x. ((\z. g'(drop z)) has_vector_derivative (g'' x)) (at(lift x))) /\ + (\z. cexp(--(ii * Cx(real_of_int n) * Cx(drop z))) * g'(drop z)) + integrable_on interval[lift(--pi),lift pi] /\ + (\z. cexp(--(ii * Cx(real_of_int n) * Cx(drop z))) * g''(drop z)) + integrable_on interval[lift(--pi),lift pi] /\ + (\t. g''(drop t)) absolutely_integrable_on interval[lift(--pi),lift pi] /\ + g(pi) = g(--pi) /\ g'(pi) = g'(--pi) + ==> (real_of_int n) pow 2 * norm(cfourier_coeff g n) + <= inv(&2 * pi) * drop(integral (interval[lift(--pi),lift pi]) (\t. + lift(norm(g''(drop t)))))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`g:real->complex`; `g':real->complex`; `g'':real->complex`; + `n:int`] + CFOURIER_COEFF_DERIV2) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`g'':real->complex`; `n:int`] CFOURIER_COEFF_L1_BOUND) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REAL_ARITH `a = b ==> b <= c ==> a <= c`) THEN + ASM_REWRITE_TAC[COMPLEX_NORM_MUL; NORM_NEG; COMPLEX_NORM_POW; + COMPLEX_NORM_CX] THEN + REWRITE_TAC[REAL_POW2_ABS]);; + +(* Arithmetic helper: kk>0 /\ kk*N<=M ==> N<=M/kk. Applied via MATCH_MP_TAC *) +(* so *) +(* the concrete M is inferred from the goal, dodging any type-annotation *) +(* mismatch. *) +let CFOURIER_DECAY_ARITH = prove + (`!(N:real) M kk. &0 < kk /\ kk * N <= M ==> N <= M * inv kk`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[GSYM real_div; REAL_LE_RDIV_EQ] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_REWRITE_TAC[]);; + +(* 282Rb: for C^2 periodic g, the Fourier-coefficient tail sum_{k>=1} *) +(* |c_{idx k}(g)| converges, for any integer index family idx with *) +(* |idx k| = k (covers both the k and -k tails). Comparison of *) +(* |c_n| <= (M/n^2) [DECAY, M = (1/2pi)int|g''|] to the zeta sum sum 1/k^2 *) +(* (REAL_SUMMABLE_ZETA_INTEGER, m=2); the index enters only through n^2 = *) +(* k^2. *) +let CFOURIER_COEFF_SUMMABLE_GEN = prove + (`!(g:real->complex) (g':real->complex) (g'':real->complex) (idx:num->int). + (!x. ((\z. g(drop z)) has_vector_derivative (g' x)) (at(lift x))) /\ + (!x. ((\z. g'(drop z)) has_vector_derivative (g'' x)) (at(lift x))) /\ + (!n. (\z. cexp(--(ii * Cx(real_of_int n) * Cx(drop z))) * g'(drop z)) + integrable_on interval[lift(--pi),lift pi]) /\ + (!n. (\z. cexp(--(ii * Cx(real_of_int n) * Cx(drop z))) * g''(drop z)) + integrable_on interval[lift(--pi),lift pi]) /\ + (\t. g''(drop t)) absolutely_integrable_on interval[lift(--pi),lift pi] /\ + g(pi) = g(--pi) /\ g'(pi) = g'(--pi) /\ + (!k. (real_of_int(idx k)) pow 2 = (&k:real) pow 2) + ==> real_summable (from 1) (\k. norm(cfourier_coeff g (idx k)))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC REAL_SUMMABLE_COMPARISON THEN + EXISTS_TAC `\k. (inv(&2 * pi) * drop(integral (interval[lift(--pi),lift pi]) + (\t. lift(norm((g'':real->complex)(drop t)))))) * inv(&k pow 2)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_SUMMABLE_LMUL THEN + MP_TAC(ISPECL [`1`; `2`] REAL_SUMMABLE_ZETA_INTEGER) THEN + REWRITE_TAC[ARITH]; + EXISTS_TAC `1` THEN X_GEN_TAC `k:num` THEN REWRITE_TAC[IN_FROM] THEN + STRIP_TAC THEN + REWRITE_TAC[REAL_ABS_NORM] THEN + MATCH_MP_TAC CFOURIER_DECAY_ARITH THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_POW_LT THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN + ASM_ARITH_TAC; + MP_TAC(ISPECL [`g:real->complex`; `g':real->complex`; + `g'':real->complex`; + `(idx:num->int) k`] CFOURIER_COEFF_DECAY) THEN + ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(fun th -> REWRITE_TAC[SPEC `k:num` th])]]);; + +(* ========================================================================= *) +(* Schwartz + compact support => both Fourier coefficient tails summable. *) +(* This packages 282Rb (CFOURIER_COEFF_SUMMABLE_GEN) for the common case *) +(* of a Schwartz function supported inside (-pi,pi): the C^2 chain, the *) +(* integrability of the modulated derivatives, and the periodicity *) +(* g(pi)=g(-pi), g'(pi)=g'(-pi) (both = 0 since g vanishes on R < |x| with *) +(* R < pi) are all automatic. Used for the tile base g of 286O(b). *) +(* ========================================================================= *) + +(* The modulation e^{-int} times a Schwartz function is integrable on any *) +(* compact interval, being continuous there (product of the continuous *) +(* kernel e^{-int} and the continuous Schwartz factor). *) +let CEXP_SCHWARTZ_INTEGRABLE_INTERVAL = prove + (`!(w:real->complex) (n:int). + schwartz w + ==> (\z. cexp(--(ii * Cx(real_of_int n) * Cx(drop z))) * w(drop z)) + integrable_on interval[lift(--pi),lift pi]`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRABLE_CONTINUOUS THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN CONJ_TAC THENL + [SUBGOAL_THEN + `(\z:real^1. cexp(--(ii * Cx(real_of_int n) * Cx(drop z)))) = + cexp o (\t. --((ii * Cx(real_of_int n)) * Cx(drop t)))` + SUBST1_TAC THENL [REWRITE_TAC[o_DEF; COMPLEX_MUL_ASSOC]; ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + REWRITE_TAC[CONTINUOUS_ON_CEXP] THEN + MATCH_MP_TAC CONTINUOUS_ON_NEG THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN + REWRITE_TAC[CONTINUOUS_ON_CONST] THEN + MATCH_MP_TAC CONTINUOUS_ON_CX_DROP THEN + REWRITE_TAC[CONTINUOUS_ON_ID]; + MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `(:real^1)` THEN + REWRITE_TAC[SUBSET_UNIV] THEN MATCH_MP_TAC SCHWARTZ_CONT THEN + ASM_REWRITE_TAC[]]);; + +(* 282Rb for a compactly-supported Schwartz function, index-agnostic core: *) +(* the C^2 chain, modulated-derivative integrability, and periodicity *) +(* g(pi)=g(-pi), g'(pi)=g'(-pi) (both 0, as g vanishes for |x| > R, R < pi) *) +(* are all automatic; feed them + the |idx k| = k side condition to *) +(* CFOURIER_COEFF_SUMMABLE_GEN. *) +let SCHWARTZ_CSUPP_SUMMABLE_GEN = prove + (`!(g:real->complex) R (idx:num->int). + schwartz g /\ &0 <= R /\ R < pi /\ (!x. R < abs x ==> g x = Cx(&0)) /\ + (!k. (real_of_int(idx k)) pow 2 = (&k:real) pow 2) + ==> real_summable (from 1) (\k. norm(cfourier_coeff g (idx k)))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + FIRST_ASSUM(X_CHOOSE_THEN `d:num->real->complex` STRIP_ASSUME_TAC o + MATCH_MP SCHWARTZ_CHAIN_ALL) THEN + FIRST_ASSUM(LABEL_TAC "der" o check (fun th -> + can (term_match [] `!n x. ((\z. (dd:num->real->complex) n (drop z)) + has_vector_derivative dd (SUC n) x)(at(lift x))`) (concl th))) THEN + SUBGOAL_THEN + `!n x. R < abs x ==> (d:num->real->complex) n x = Cx(&0)` ASSUME_TAC THENL + [MATCH_MP_TAC CHAIN_SUPPORT THEN ASM_REWRITE_TAC[real_gt] THEN + X_GEN_TAC `x:real` THEN DISCH_TAC THEN ASM_MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `abs pi = pi /\ abs(--pi) = pi` STRIP_ASSUME_TAC THENL + [MP_TAC PI_POS THEN REWRITE_TAC[REAL_ABS_NEG] THEN + REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `(!n. (d:num->real->complex) n pi = Cx(&0)) /\ + (!n. (d:num->real->complex) n (--pi) = Cx(&0))` + STRIP_ASSUME_TAC THENL + [CONJ_TAC THEN GEN_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC CFOURIER_COEFF_SUMMABLE_GEN THEN + MAP_EVERY EXISTS_TAC [`(d:num->real->complex) 1`; + `(d:num->real->complex) 2`] THEN + FIRST_X_ASSUM(fun th -> if concl th = `(d:num->real->complex) 0 = g` then + SUBST1_TAC(SYM th) else NO_TAC) THEN + ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [USE_THEN "der" (fun th -> GEN_TAC THEN + MP_TAC(SPECL [`0`; `x:real`] th)) THEN + REWRITE_TAC[ARITH_RULE `SUC 0 = 1`]; + USE_THEN "der" (fun th -> GEN_TAC THEN + MP_TAC(SPECL [`1`; `x:real`] th)) THEN + REWRITE_TAC[ARITH_RULE `SUC 1 = 2`]; + GEN_TAC THEN MATCH_MP_TAC CEXP_SCHWARTZ_INTEGRABLE_INTERVAL THEN + REWRITE_TAC[ETA_AX] THEN ASM_REWRITE_TAC[]; + GEN_TAC THEN MATCH_MP_TAC CEXP_SCHWARTZ_INTEGRABLE_INTERVAL THEN + REWRITE_TAC[ETA_AX] THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `(:real^1)` THEN REWRITE_TAC[SUBSET_UNIV] THEN + MATCH_MP_TAC SCHWARTZ_ABSINT THEN REWRITE_TAC[ETA_AX] THEN + ASM_REWRITE_TAC[]]);; + +(* The two tails as named corollaries (idx = &k and idx = -- &k). *) +let SCHWARTZ_CSUPP_SUMMABLE_POS = prove + (`!(g:real->complex) R. + schwartz g /\ &0 <= R /\ R < pi /\ (!x. R < abs x ==> g x = Cx(&0)) + ==> real_summable (from 1) (\k. norm(cfourier_coeff g (&k)))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(ISPECL [`g:real->complex`; `R:real`; `\k:num. &k:int`] + SCHWARTZ_CSUPP_SUMMABLE_GEN) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + GEN_TAC THEN REWRITE_TAC[int_of_num_th]);; + +let SCHWARTZ_CSUPP_SUMMABLE_NEG = prove + (`!(g:real->complex) R. + schwartz g /\ &0 <= R /\ R < pi /\ (!x. R < abs x ==> g x = Cx(&0)) + ==> real_summable (from 1) (\k. norm(cfourier_coeff g (-- &k)))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(ISPECL [`g:real->complex`; `R:real`; `\k:num. -- &k:int`] + SCHWARTZ_CSUPP_SUMMABLE_GEN) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + GEN_TAC THEN + REWRITE_TAC[GSYM REAL_OF_INT_CLAUSES; int_neg_th; int_of_num_th] THEN + REWRITE_TAC[REAL_POW2_ABS; REAL_ABS_NEG; REAL_ABS_NUM] THEN + CONV_TAC REAL_RING);; + +(* ========================================================================= *) +(* 282L pointwise inversion, part 1: the complex symmetric Dirichlet sum. *) +(* sum over abs n <= N of e^{inu} = 2 D_N(u), D_N = 100/fourier.ml's *) +(* Dirichlet *) +(* kernel. Route: split the symmetric integer segment, pair e^{iku}+e^{-iku} *) +(* = 2 cos(ku), and match DIRICHLET_KERNEL_COSINE_SUM (1/2 + sum cos). *) +(* ========================================================================= *) + +(* The symmetric integer segment splits as {0} together with the images of *) +(* 1..N under k|->k and k|->-k. *) +let INT_ABS_SEG_SPLIT = prove + (`!N:num. {j:int | abs j <= &N} = + (&0) INSERT (IMAGE (\k. &k) (1..N) UNION IMAGE (\k. -- &k) (1..N))`, + GEN_TAC THEN + REWRITE_TAC[EXTENSION; IN_INSERT; IN_UNION; IN_IMAGE; IN_ELIM_THM; + IN_NUMSEG] THEN + X_GEN_TAC `j:int` THEN EQ_TAC THENL + [DISCH_TAC THEN + DISJ_CASES_TAC(SPEC `j:int` INT_IMAGE) THEN + POP_ASSUM(X_CHOOSE_THEN `m:num` ASSUME_TAC) THEN + ASM_CASES_TAC `m = 0` THEN + TRY(FIRST_X_ASSUM SUBST_ALL_TAC) THENL + [DISJ1_TAC THEN ASM_REWRITE_TAC[INT_NEG_0]; + DISJ2_TAC THEN DISJ1_TAC THEN EXISTS_TAC `m:num` THEN + REPEAT(POP_ASSUM MP_TAC) THEN + REWRITE_TAC[INT_ABS_NUM; INT_OF_NUM_LE] THEN ASM_ARITH_TAC; + DISJ1_TAC THEN ASM_REWRITE_TAC[INT_NEG_0]; + DISJ2_TAC THEN DISJ2_TAC THEN EXISTS_TAC `m:num` THEN + REPEAT(POP_ASSUM MP_TAC) THEN + REWRITE_TAC[INT_ABS_NEG; INT_ABS_NUM; INT_OF_NUM_LE] THEN ASM_ARITH_TAC]; + STRIP_TAC THEN ASM_REWRITE_TAC[] THENL + [INT_ARITH_TAC; + REWRITE_TAC[INT_ABS_NUM; INT_OF_NUM_LE] THEN ASM_ARITH_TAC; + REWRITE_TAC[INT_ABS_NEG; INT_ABS_NUM; INT_OF_NUM_LE] THEN + ASM_ARITH_TAC]]);; + +(* Reindex a real sum over the image of 1..N under k|->&k / k|->-&k to a nat *) +(* sum. *) +let SUM_IMAGE_POS = prove + (`!(ff:int->real) N. sum (IMAGE (\k. &k) (1..N)) ff = sum (1..N) (\k. + ff(&k))`, + REPEAT GEN_TAC THEN + MP_TAC(ISPECL [`\k:num. &k:int`; `ff:int->real`; `1..N`] SUM_IMAGE) THEN + ANTS_TAC THENL + [REWRITE_TAC[INT_OF_NUM_EQ] THEN SIMP_TAC[]; + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[o_DEF]]);; + +let SUM_IMAGE_NEG = prove + (`!(ff:int->real) N. sum (IMAGE (\k. -- &k) (1..N)) ff = sum (1..N) (\k. ff(-- + &k))`, + REPEAT GEN_TAC THEN + MP_TAC(ISPECL [`\k:num. -- &k:int`; `ff:int->real`; `1..N`] SUM_IMAGE) THEN + ANTS_TAC THENL + [REPEAT GEN_TAC THEN CONV_TAC(DEPTH_CONV BETA_CONV) THEN STRIP_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[INT_NEG_EQ; INT_NEG_NEG; INT_OF_NUM_EQ]) THEN + ASM_REWRITE_TAC[]; + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[o_DEF]]);; + +(* The sum of |c_n| over abs n <= N split into the 0 term and two nat tails *) +(* 1..N. *) +let CFOURIER_ABSSEG_SUM_SPLIT = prove + (`!(g:real->complex) N. + sum {n:int | abs n <= &N} (\n. norm(cfourier_coeff g n)) = + norm(cfourier_coeff g (&0)) + + sum (1..N) (\k. norm(cfourier_coeff g (&k))) + + sum (1..N) (\k. norm(cfourier_coeff g (-- &k)))`, + REPEAT GEN_TAC THEN REWRITE_TAC[INT_ABS_SEG_SPLIT] THEN + SIMP_TAC[SUM_CLAUSES; FINITE_INSERT; FINITE_UNION; FINITE_IMAGE; + FINITE_NUMSEG] THEN + COND_CASES_TAC THENL + [FIRST_X_ASSUM(MP_TAC) THEN + REWRITE_TAC[IN_UNION; IN_IMAGE; IN_NUMSEG] THEN + REWRITE_TAC[INT_ARITH `&0 = &x <=> &x = &0`; + INT_ARITH `&0 = -- &x <=> &x = &0`] THEN + REWRITE_TAC[INT_OF_NUM_EQ] THEN + DISCH_THEN(DISJ_CASES_THEN (X_CHOOSE_THEN `x:num` STRIP_ASSUME_TAC)) THEN + ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `DISJOINT (IMAGE (\k. &k) (1..N):int->bool) (IMAGE (\k. -- &k) (1..N))` + ASSUME_TAC THENL + [REWRITE_TAC[SET_RULE `DISJOINT s t <=> !x. x IN s ==> ~(x IN t)`] THEN + REWRITE_TAC[FORALL_IN_IMAGE; IN_IMAGE; IN_NUMSEG] THEN + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(&1:int) <= &x /\ (&0:int) <= &x''` MP_TAC THENL + [REWRITE_TAC[INT_OF_NUM_LE] THEN ASM_ARITH_TAC; ASM_INT_ARITH_TAC]; + ALL_TAC] THEN + ASM_SIMP_TAC[SUM_UNION; FINITE_IMAGE; FINITE_NUMSEG] THEN + REWRITE_TAC[SUM_IMAGE_POS; SUM_IMAGE_NEG] THEN REAL_ARITH_TAC);; + +(* For a nonnegative summable nat-series, every finite initial sum <= the *) +(* infsum. *) +let SUM_NUMSEG_LE_INFSUM = prove + (`!f:num->real N. real_summable (from 1) f /\ (!i. &0 <= f i) + ==> sum (1..N) f <= real_infsum (from 1) f`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:num->real`; `from 1`; + `N:num`] REAL_PARTIAL_SUMS_LE_INFSUM) THEN + ASM_REWRITE_TAC[FROM_INTER_NUMSEG]);; + +(* Uniform (in N and t) bound on the Fourier partial sum, given both *) +(* coefficient *) +(* tails absolutely summable: |cfourier_partial g N t| <= |c_0| + *) +(* sum_{k>=1}|c_k| *) +(* + sum_{k>=1}|c_{-k}|. This fixed bound is the dominator for the L^2 *) +(* dominated *) +(* convergence of the tile partial sums in the 286O(b) spatial identity. *) +let CFOURIER_PARTIAL_UNIF_BOUND = prove + (`!(g:real->complex). + real_summable (from 1) (\k. norm(cfourier_coeff g (&k))) /\ + real_summable (from 1) (\k. norm(cfourier_coeff g (-- &k))) + ==> !N t. norm(cfourier_partial g N t) <= + norm(cfourier_coeff g (&0)) + + real_infsum (from 1) (\k. norm(cfourier_coeff g (&k))) + + real_infsum (from 1) (\k. norm(cfourier_coeff g (-- &k)))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[cfourier_partial] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum {n:int | abs n <= &N} (\n. norm(cfourier_coeff g n))` THEN + CONJ_TAC THENL + [MP_TAC(ISPECL [`\n:int. cfourier_coeff g n * cexp(ii * Cx(real_of_int n) * + Cx t)`; + `{n:int | abs n <= &N}`] VSUM_NORM) THEN + REWRITE_TAC[CFOURIER_INDEX_FINITE] THEN + MATCH_MP_TAC(REAL_ARITH `s = s2 ==> x <= s ==> x <= s2`) THEN + MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `n:int` THEN DISCH_TAC THEN + REWRITE_TAC[COMPLEX_NORM_MUL] THEN + SUBGOAL_THEN + `cexp(ii * Cx(real_of_int n) * Cx t) = cexp(ii * Cx(real_of_int n * t))` + SUBST1_TAC THENL + [AP_TERM_TAC THEN REWRITE_TAC[CX_MUL] THEN + CONV_TAC COMPLEX_RING; ALL_TAC] THEN + REWRITE_TAC[NORM_CEXP_II; REAL_MUL_RID]; + ALL_TAC] THEN + REWRITE_TAC[CFOURIER_ABSSEG_SUM_SPLIT] THEN + MATCH_MP_TAC REAL_LE_ADD2 THEN REWRITE_TAC[REAL_LE_REFL] THEN + MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THEN + MATCH_MP_TAC SUM_NUMSEG_LE_INFSUM THEN ASM_REWRITE_TAC[NORM_POS_LE]);; + +(* e^{iz} + e^{-iz} = 2 cos z (complex form). *) +let CEXP_PAIR_COS = prove + (`!z. cexp(ii * z) + cexp(--(ii * z)) = Cx(&2) * ccos z`, + GEN_TAC THEN REWRITE_TAC[CEXP_EULER] THEN + REWRITE_TAC[COMPLEX_RING `--(ii * z) = ii * (--z)`] THEN + REWRITE_TAC[CEXP_EULER; CCOS_NEG; CSIN_NEG] THEN CONV_TAC COMPLEX_RING);; + +(* 282L(a): the symmetric complex Dirichlet sum equals 2 D_N (sin(u/2)<>0, *) +(* abs u < 2 pi -- both hold at the interior points |u|<=1/4 where 286O(b) *) +(* applies it). *) +let CFOURIER_DIRICHLET_SUM = prove + (`!N u. ~(sin(u / &2) = &0) /\ abs u < &2 * pi + ==> vsum {n:int | abs n <= &N} (\n. cexp(ii * Cx(real_of_int n) * Cx + u)) = + Cx(&2 * dirichlet_kernel N u)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[INT_ABS_SEG_SPLIT] THEN + SUBGOAL_THEN + `~((&0:int) IN (IMAGE (\k. &k:int) (1..N) UNION IMAGE (\k:num. -- &k:int) + (1..N)))` + ASSUME_TAC THENL + [REWRITE_TAC[IN_UNION; IN_IMAGE; IN_NUMSEG] THEN + REWRITE_TAC[INT_ARITH `(&0:int) = &k <=> &k:int = &0`; + INT_ARITH `(&0:int) = -- &k <=> &k:int = &0`] THEN + REWRITE_TAC[INT_OF_NUM_EQ; NOT_EXISTS_THM] THEN GEN_TAC THEN + ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[VSUM_CLAUSES; FINITE_UNION; FINITE_IMAGE; FINITE_NUMSEG] THEN + SUBGOAL_THEN `cexp(ii * Cx(real_of_int(&0)) * Cx u) = Cx(&1)` + (fun th -> REWRITE_TAC[th]) THENL + [REWRITE_TAC[int_of_num_th; COMPLEX_RING `ii * Cx(&0) * Cx u = Cx(&0)`; + CEXP_0]; ALL_TAC] THEN + SUBGOAL_THEN + `DISJOINT (IMAGE (\k. &k:int) (1..N)) (IMAGE (\k:num. -- &k:int) (1..N))` + ASSUME_TAC THENL + [REWRITE_TAC[SET_RULE `DISJOINT s t <=> !x. x IN s ==> ~(x IN t)`] THEN + REWRITE_TAC[IN_IMAGE; IN_NUMSEG] THEN + X_GEN_TAC `j:int` THEN DISCH_THEN(X_CHOOSE_THEN + `a:num` STRIP_ASSUME_TAC) THEN + REWRITE_TAC[NOT_EXISTS_THM] THEN X_GEN_TAC `b:num` THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[DE_MORGAN_THM] THEN DISJ1_TAC THEN + UNDISCH_TAC `1 <= a` THEN REWRITE_TAC[GSYM INT_OF_NUM_LE] THEN + INT_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[VSUM_UNION; FINITE_IMAGE; FINITE_NUMSEG] THEN + MP_TAC(ISPECL [`\k. &k:int`; `\n:int. cexp(ii * Cx(real_of_int n) * Cx u)`; + `1..N`] VSUM_IMAGE) THEN + ANTS_TAC THENL + [REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o AP_TERM `real_of_int`) THEN + REWRITE_TAC[int_of_num_th; REAL_OF_NUM_EQ] THEN SIMP_TAC[]; ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN + MP_TAC(ISPECL [`\k:num. -- &k:int`; + `\n:int. cexp(ii * Cx(real_of_int n) * Cx u)`; `1..N`] VSUM_IMAGE) THEN + ANTS_TAC THENL + [REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o AP_TERM `(--):int->int`) THEN + REWRITE_TAC[INT_NEG_NEG] THEN + DISCH_THEN(MP_TAC o AP_TERM `real_of_int`) THEN + REWRITE_TAC[int_of_num_th; REAL_OF_NUM_EQ] THEN SIMP_TAC[]; ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[o_DEF; int_of_num_th; int_neg_th] THEN + SUBGOAL_THEN + `vsum (1..N) (\k. cexp(ii * Cx(&k) * Cx u)) + + vsum (1..N) (\x. cexp(ii * Cx(--(&x)) * Cx u)) = + vsum (1..N) (\k. Cx(&2 * cos(&k * u)))` + SUBST1_TAC THENL + [REWRITE_TAC[GSYM VSUM_ADD_NUMSEG] THEN MATCH_MP_TAC VSUM_EQ_NUMSEG THEN + X_GEN_TAC `k:num` THEN STRIP_TAC THEN REWRITE_TAC[] THEN + SUBGOAL_THEN + `ii * Cx(--(&k)) * Cx u = --(ii * Cx(&k * u))` SUBST1_TAC THENL + [REWRITE_TAC[CX_NEG; CX_MUL] THEN CONV_TAC COMPLEX_RING; ALL_TAC] THEN + SUBGOAL_THEN `ii * Cx(&k) * Cx u = ii * Cx(&k * u)` SUBST1_TAC THENL + [REWRITE_TAC[CX_MUL] THEN CONV_TAC COMPLEX_RING; ALL_TAC] THEN + REWRITE_TAC[CEXP_PAIR_COS; GSYM CX_COS; CX_MUL]; ALL_TAC] THEN + SUBGOAL_THEN `dirichlet_kernel N u = &1 / &2 + sum(1..N) (\k. cos(&k * u))` + ASSUME_TAC THENL + [MATCH_MP_TAC DIRICHLET_KERNEL_COSINE_SUM THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN UNDISCH_TAC `~(sin(u / &2) = &0)` THEN + ASM_REWRITE_TAC[REAL_ARITH `&0 / &2 = &0`; SIN_0]; ALL_TAC] THEN + ASM_REWRITE_TAC[VSUM_CX_NUMSEG; GSYM CX_ADD; CX_INJ; SUM_LMUL] THEN + REAL_ARITH_TAC);; + +(* ========================================================================= *) +(* 282L part 2: the partial sum as a Dirichlet-kernel convolution. *) +(* ========================================================================= *) + +(* Per-term: c_n(g) e^{int} = (1/2pi) int_{-pi}^{pi} g(z) e^{in(t-z)} dz. *) +let CFOURIER_TERM_CONV = prove + (`!(g:real->complex) n t. + (\z. g(drop z)) absolutely_integrable_on interval[lift(--pi),lift pi] + ==> cfourier_coeff g n * cexp(ii * Cx(real_of_int n) * Cx t) = + Cx(inv(&2 * pi)) * + integral (interval[lift(--pi),lift pi]) + (\z. g(drop z) * cexp(ii * Cx(real_of_int n) * Cx(t - drop z)))`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[cfourier_coeff; IMAGE_LIFT_REAL_INTERVAL] THEN + REWRITE_TAC[GSYM COMPLEX_MUL_ASSOC] THEN AP_TERM_TAC THEN + ONCE_REWRITE_TAC[COMPLEX_MUL_SYM] THEN + SUBGOAL_THEN + `(\z. g(drop z) * cexp(--(ii * Cx(real_of_int n) * Cx(drop z)))) + integrable_on + interval[lift(--pi),lift pi]` + ASSUME_TAC THENL + [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC CFOURIER_INTEGRAND_ABSINT THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_SIMP_TAC[GSYM INTEGRAL_COMPLEX_LMUL] THEN + MATCH_MP_TAC INTEGRAL_EQ THEN X_GEN_TAC `z:real^1` THEN DISCH_TAC THEN + REWRITE_TAC[] THEN + REWRITE_TAC[COMPLEX_RING `e * (g * f) = g * (e * f)`] THEN + GEN_REWRITE_TAC RAND_CONV [COMPLEX_MUL_SYM] THEN + AP_TERM_TAC THEN + REWRITE_TAC[GSYM CEXP_ADD] THEN AP_TERM_TAC THEN + REWRITE_TAC[CX_SUB] THEN CONV_TAC COMPLEX_RING);; + +(* Integrability of the convolution integrand g(z) e^{in(t-z)} = e^{int}(g *) +(* e^{-inz}). *) +let CFOURIER_CONV_INTEGRAND = prove + (`!(g:real->complex) n t. + (\z. g(drop z)) absolutely_integrable_on interval[lift(--pi),lift pi] + ==> (\z. g(drop z) * cexp(ii * Cx(real_of_int n) * Cx(t - drop z))) + integrable_on + interval[lift(--pi),lift pi]`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\z. g(drop z) * cexp(ii * Cx(real_of_int n) * Cx(t - drop z))) = + (\z. cexp(ii * Cx(real_of_int n) * Cx t) * + (g(drop z) * cexp(--(ii * Cx(real_of_int n) * Cx(drop z)))))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + REWRITE_TAC[COMPLEX_RING `e * (g * f) = g * (e * f)`] THEN + AP_TERM_TAC THEN REWRITE_TAC[GSYM CEXP_ADD] THEN AP_TERM_TAC THEN + REWRITE_TAC[CX_SUB] THEN CONV_TAC COMPLEX_RING; ALL_TAC] THEN + MATCH_MP_TAC INTEGRABLE_COMPLEX_LMUL THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC CFOURIER_INTEGRAND_ABSINT THEN ASM_REWRITE_TAC[]);; + +(* 282L(b): cfourier_partial g N t = (1/2pi) int g(z) (sum_{abs n<=N} *) +(* e^{in(t-z)}) dz. *) +let CFOURIER_PARTIAL_CONV = prove + (`!(g:real->complex) N t. + (\z. g(drop z)) absolutely_integrable_on interval[lift(--pi),lift pi] + ==> cfourier_partial g N t = + Cx(inv(&2 * pi)) * + integral (interval[lift(--pi),lift pi]) + (\z. g(drop z) * + vsum {n:int | abs n <= &N} (\n. cexp(ii * Cx(real_of_int n) * + Cx(t - drop z))))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[cfourier_partial] THEN + SUBGOAL_THEN + `vsum {n:int | abs n <= &N} (\n. cfourier_coeff g n * cexp(ii * + Cx(real_of_int n) * Cx t)) = + vsum {n:int | abs n <= &N} + (\n. Cx(inv(&2 * pi)) * + integral (interval[lift(--pi),lift pi]) + (\z. g(drop z) * cexp(ii * Cx(real_of_int n) * Cx(t - drop z))))` + SUBST1_TAC THENL + [MATCH_MP_TAC VSUM_EQ THEN X_GEN_TAC `n:int` THEN DISCH_TAC THEN + REWRITE_TAC[] THEN + MATCH_MP_TAC CFOURIER_TERM_CONV THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SIMP_TAC[VSUM_COMPLEX_LMUL; CFOURIER_INDEX_FINITE] THEN AP_TERM_TAC THEN + SUBGOAL_THEN + `!z. g(drop z) * + vsum {n:int | abs n <= &N} (\n. cexp(ii * Cx(real_of_int n) * Cx(t - + drop z))) = + vsum {n:int | abs n <= &N} (\n. g(drop z) * cexp(ii * Cx(real_of_int n) + * Cx(t - drop z)))` + (fun th -> REWRITE_TAC[th]) THENL + [GEN_TAC THEN + SIMP_TAC[VSUM_COMPLEX_LMUL; CFOURIER_INDEX_FINITE]; ALL_TAC] THEN + CONV_TAC SYM_CONV THEN + MP_TAC(ISPECL + [`\n:int z:real^1. g(drop z) * cexp(ii * Cx(real_of_int n) * Cx(t - drop + z))`; + `interval[lift(--pi),lift pi]`; + `{n:int | abs n <= &N}`] INTEGRAL_VSUM) THEN + REWRITE_TAC[CFOURIER_INDEX_FINITE] THEN + ANTS_TAC THENL + [X_GEN_TAC `n:int` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + MATCH_MP_TAC CFOURIER_CONV_INTEGRAND THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]));; + +(* ========================================================================= *) +(* 282L part 3a: collapse the convolution to the Dirichlet kernel. *) +(* ========================================================================= *) + +(* z |-> D_N(t - z) is real-continuous on [-pi,pi] (image in (-2pi,2pi), *) +(* where dirichlet_kernel is continuous), provided abs t < pi. *) +let DN_SHIFT_CONTINUOUS = prove + (`!N t. abs t < pi + ==> (\z. dirichlet_kernel N (t - z)) real_continuous_on + real_interval[--pi,pi]`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\z. dirichlet_kernel N (t - z)) = (dirichlet_kernel N) o (\z. t - z)` + SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_ON_SUB THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_CONST; REAL_CONTINUOUS_ON_ID]; + MATCH_MP_TAC REAL_CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `real_interval(--(&2 * pi), &2 * pi)` THEN + REWRITE_TAC[DIRICHLET_KERNEL_CONTINUOUS_STRONG] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_REAL_INTERVAL] THEN + GEN_TAC THEN STRIP_TAC THEN MP_TAC PI_POS THEN ASM_REAL_ARITH_TAC]);; + +(* g absint /\ abs t < pi ==> g(z) Cx(D_N(t-z)) integrable on [-pi,pi]. *) +(* (Cx(D_N(t-.)) continuous hence bounded-measurable; g absint; product *) +(* absint.) *) +let CFOURIER_DN_INTEGRAND = prove + (`!(g:real->complex) N t. + (\z. g(drop z)) absolutely_integrable_on interval[lift(--pi),lift pi] /\ + abs t < pi + ==> (\z. g(drop z) * Cx(dirichlet_kernel N (t - drop z))) integrable_on + interval[lift(--pi),lift pi]`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + SUBGOAL_THEN + `(\z. g(drop z) * Cx(dirichlet_kernel N (t - drop z))) = + (\z. Cx(dirichlet_kernel N (t - drop z)) * g(drop z))` + SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + CONV_TAC COMPLEX_RING; ALL_TAC] THEN + SUBGOAL_THEN + `(\z:real^1. Cx(dirichlet_kernel N (t - drop z))) continuous_on + interval[lift(--pi),lift pi]` + ASSUME_TAC THENL + [REWRITE_TAC[CONTINUOUS_ON_CX_LIFT] THEN + MP_TAC(ISPECL [`N:num`; `t:real`] DN_SHIFT_CONTINUOUS) THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[REAL_CONTINUOUS_ON; IMAGE_LIFT_REAL_INTERVAL; o_DEF]; + ALL_TAC] THEN + MP_TAC(ISPECL [`( * ):complex->complex->complex`; + `\z:real^1. Cx(dirichlet_kernel N (t - drop z))`; + `\z:real^1. (g:real->complex)(drop z)`; + `interval[lift(--pi),lift pi]`] + ABSOLUTELY_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT) THEN + REWRITE_TAC[BILINEAR_COMPLEX_MUL] THEN DISCH_THEN MATCH_MP_TAC THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN + ASM_REWRITE_TAC[LEBESGUE_MEASURABLE_INTERVAL]; + MATCH_MP_TAC COMPACT_IMP_BOUNDED THEN + MATCH_MP_TAC COMPACT_CONTINUOUS_IMAGE THEN + ASM_REWRITE_TAC[COMPACT_INTERVAL]; + ASM_REWRITE_TAC[]]);; + +(* 282L(c): cfourier_partial g N t = (1/pi) int_{-pi}^{pi} g(z) D_N(t-z) dz, *) +(* the classical Dirichlet convolution (abs t < pi). Combine PARTIAL_CONV + *) +(* the keystone (inner sum = 2 D_N off the measure-zero point z=t) + *) +(* inv2pi*2 = *) +(* inv pi. *) +let CFOURIER_PARTIAL_DIRICHLET = prove + (`!(g:real->complex) N t. + (\z. g(drop z)) absolutely_integrable_on interval[lift(--pi),lift pi] /\ + abs t < pi + ==> cfourier_partial g N t = + Cx(inv pi) * + integral (interval[lift(--pi),lift pi]) + (\z. g(drop z) * Cx(dirichlet_kernel N (t - drop z)))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`g:real->complex`; `N:num`; + `t:real`] CFOURIER_PARTIAL_CONV) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + SUBGOAL_THEN + `integral (interval[lift(--pi),lift pi]) + (\z. g(drop z) * + vsum {n:int | abs n <= &N} (\n. cexp(ii * Cx(real_of_int n) * Cx(t - + drop z)))) = + integral (interval[lift(--pi),lift pi]) + (\z. g(drop z) * Cx(&2 * dirichlet_kernel N (t - drop z)))` + SUBST1_TAC THENL + [MATCH_MP_TAC INTEGRAL_SPIKE THEN EXISTS_TAC `{lift t}` THEN + REWRITE_TAC[NEGLIGIBLE_SING] THEN X_GEN_TAC `z:real^1` THEN + REWRITE_TAC[IN_DIFF; IN_SING; IN_INTERVAL_1; LIFT_DROP] THEN STRIP_TAC THEN + AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC CFOURIER_DIRICHLET_SUM THEN + CONJ_TAC THENL + [DISCH_TAC THEN + SUBGOAL_THEN `drop(z:real^1) = t` ASSUME_TAC THENL + [MP_TAC(ISPEC `(t - drop z) / &2` SIN_EQ_0_PI) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_REAL_ARITH_TAC; + UNDISCH_TAC `~(z = lift t)` THEN REWRITE_TAC[] THEN + ASM_MESON_TAC[LIFT_DROP]]; + ASM_REAL_ARITH_TAC]; ALL_TAC] THEN + SUBGOAL_THEN + `integral (interval[lift(--pi),lift pi]) + (\z. g(drop z) * Cx(&2 * dirichlet_kernel N (t - drop z))) = + Cx(&2) * integral (interval[lift(--pi),lift pi]) + (\z. g(drop z) * Cx(dirichlet_kernel N (t - drop z)))` + SUBST1_TAC THENL + [SUBGOAL_THEN + `(\z:real^1. g(drop z) * Cx(&2 * dirichlet_kernel N (t - drop z))) = + (\z. Cx(&2) * (g(drop z) * Cx(dirichlet_kernel N (t - drop z))))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN REWRITE_TAC[CX_MUL] THEN + CONV_TAC COMPLEX_RING; + ALL_TAC] THEN + MATCH_MP_TAC INTEGRAL_COMPLEX_LMUL THEN + MATCH_MP_TAC CFOURIER_DN_INTEGRAND THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[COMPLEX_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[GSYM CX_MUL] THEN AP_TERM_TAC THEN + MP_TAC PI_POS THEN CONV_TAC REAL_FIELD);; + +(* ========================================================================= *) +(* 282L part 3b: reflection helpers toward the convergence limit. *) +(* (The full convergence cfourier_partial g N t -> g(t) is the remaining *) +(* step; these symmetric-interval reflections are reusable building blocks.) *) +(* ========================================================================= *) + +(* Reflection on the symmetric interval [-pi,pi] (real-valued). *) +let REAL_INTEGRAL_REFLECT_SYM = prove + (`!(ff:real->real). real_integral (real_interval[--pi,pi]) (\z. ff(--z)) = + real_integral (real_interval[--pi,pi]) ff`, + GEN_TAC THEN + MP_TAC(ISPECL [`ff:real->real`; `--pi`; `pi`] REAL_INTEGRAL_REFLECT) THEN + REWRITE_TAC[REAL_NEG_NEG] THEN DISCH_THEN(fun th -> REWRITE_TAC[th]));; + +(* Reflection on the symmetric real^1 interval [lift(-pi),lift pi] *) +(* (complex-valued). *) +let INTEGRAL_REFLECT_SYM_1 = prove + (`!(ff:real^1->complex). + integral (interval[lift(--pi),lift pi]) (\z. ff(--z)) = + integral (interval[lift(--pi),lift pi]) ff`, + GEN_TAC THEN + MP_TAC(ISPECL [`ff:real^1->complex`; `lift(--pi)`; + `lift pi`] INTEGRAL_REFLECT) THEN + REWRITE_TAC[VECTOR_NEG_NEG; LIFT_NEG]);; + +(* ========================================================================= *) +(* 282L part 3b (coefficient-bridge route): toward cfourier_partial -> g. *) +(* ========================================================================= *) + +(* cnj commutes with a complex integral (cnj is linear). *) +let CNJ_INTEGRAL = prove + (`!(f:real^N->complex) s. f integrable_on s + ==> cnj(integral s f) = integral s (\x. cnj(f x))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:real^N->complex`; `s:real^N->bool`; + `cnj`] INTEGRAL_LINEAR) THEN + ASM_REWRITE_TAC[LINEAR_CNJ; o_DEF] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[]);; + +(* For a real function phi, c_{-n} = conj(c_n): the Fourier coefficients are *) +(* conjugate-symmetric. (This makes the +-n pairing real, matching the real *) +(* trigonometric partial sum.) *) +let CFOURIER_COEFF_CONJ = prove + (`!(phi:real->real) n. + (\t. Cx(phi(drop t))) absolutely_integrable_on interval[lift(--pi),lift + pi] + ==> cnj(cfourier_coeff (\x. Cx(phi x)) n) = cfourier_coeff (\x. Cx(phi x)) + (--n)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[cfourier_coeff] THEN + REWRITE_TAC[CNJ_MUL; CNJ_CX] THEN + REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL] THEN + MP_TAC(ISPECL + [`\t:real^1. Cx(phi(drop t)) * cexp(--(ii * Cx(real_of_int n) * Cx(drop + t)))`; + `interval[lift(--pi),lift pi]`] CNJ_INTEGRAL) THEN + ANTS_TAC THENL + [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MP_TAC(ISPEC `(\x. Cx(phi x)):real->complex` CFOURIER_INTEGRAND_ABSINT) + THEN + DISCH_THEN(MP_TAC o SPEC `n:int`) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + REWRITE_TAC[CNJ_MUL; CNJ_CX; CNJ_CEXP] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[CNJ_NEG; CNJ_MUL; CNJ_II; CNJ_CX; int_neg_th; CX_NEG] THEN + CONV_TAC COMPLEX_RING);; + +(* Symmetric-sum reorganization: cfourier_partial g N t = c_0 term + the *) +(* paired *) +(* +-k terms for k=1..N. (Same INT_ABS_SEG_SPLIT decomposition as the *) +(* Dirichlet *) +(* sum keystone.) Feeds the real-trigonometric bridge for real g. *) +let CFOURIER_PARTIAL_SPLIT = prove + (`!(g:real->complex) N t. + cfourier_partial g N t = + cfourier_coeff g (&0) + + vsum (1..N) (\k. cfourier_coeff g (&k) * cexp(ii * Cx(&k) * Cx t) + + cfourier_coeff g (-- &k) * cexp(ii * Cx(-- &k) * Cx t))`, + REPEAT GEN_TAC THEN REWRITE_TAC[cfourier_partial; INT_ABS_SEG_SPLIT] THEN + SUBGOAL_THEN + `~((&0:int) IN (IMAGE (\k. &k:int) (1..N) UNION IMAGE (\k:num. -- &k:int) + (1..N)))` + ASSUME_TAC THENL + [REWRITE_TAC[IN_UNION; IN_IMAGE; IN_NUMSEG] THEN + REWRITE_TAC[INT_ARITH `(&0:int) = &k <=> &k:int = &0`; + INT_ARITH `(&0:int) = -- &k <=> &k:int = &0`] THEN + REWRITE_TAC[INT_OF_NUM_EQ; NOT_EXISTS_THM] THEN GEN_TAC THEN + ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[VSUM_CLAUSES; FINITE_UNION; FINITE_IMAGE; FINITE_NUMSEG] THEN + BINOP_TAC THENL + [REWRITE_TAC[int_of_num_th; COMPLEX_RING `ii * Cx(&0) * Cx t = Cx(&0)`; + CEXP_0] THEN + REWRITE_TAC[COMPLEX_MUL_RID]; ALL_TAC] THEN + SUBGOAL_THEN + `DISJOINT (IMAGE (\k. &k:int) (1..N)) (IMAGE (\k:num. -- &k:int) (1..N))` + ASSUME_TAC THENL + [REWRITE_TAC[SET_RULE `DISJOINT s t <=> !x. x IN s ==> ~(x IN t)`] THEN + REWRITE_TAC[IN_IMAGE; IN_NUMSEG] THEN + X_GEN_TAC `j:int` THEN DISCH_THEN(X_CHOOSE_THEN + `a:num` STRIP_ASSUME_TAC) THEN + REWRITE_TAC[NOT_EXISTS_THM] THEN X_GEN_TAC `b:num` THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[DE_MORGAN_THM] THEN DISJ1_TAC THEN + UNDISCH_TAC `1 <= a` THEN REWRITE_TAC[GSYM INT_OF_NUM_LE] THEN + INT_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[VSUM_UNION; FINITE_IMAGE; FINITE_NUMSEG] THEN + MP_TAC(ISPECL [`\k. &k:int`; + `\n:int. cfourier_coeff g n * cexp(ii * Cx(real_of_int n) * Cx t)`; + `1..N`] VSUM_IMAGE) THEN + ANTS_TAC THENL + [REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o AP_TERM `real_of_int`) THEN + REWRITE_TAC[int_of_num_th; REAL_OF_NUM_EQ] THEN SIMP_TAC[]; ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN + MP_TAC(ISPECL [`\k:num. -- &k:int`; + `\n:int. cfourier_coeff g n * cexp(ii * Cx(real_of_int n) * Cx t)`; + `1..N`] VSUM_IMAGE) THEN + ANTS_TAC THENL + [REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o AP_TERM `(--):int->int`) THEN + REWRITE_TAC[INT_NEG_NEG] THEN + DISCH_THEN(MP_TAC o AP_TERM `real_of_int`) THEN + REWRITE_TAC[int_of_num_th; REAL_OF_NUM_EQ] THEN SIMP_TAC[]; ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[o_DEF; int_of_num_th; int_neg_th] THEN + REWRITE_TAC[GSYM VSUM_ADD_NUMSEG]);; + +(* Re commutes with a complex integral (component 1). *) +let RE_INTEGRAL = prove + (`!(ff:real^1->complex) s. ff integrable_on s + ==> Re(integral s ff) = drop(integral s (\z. lift(Re(ff z))))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[RE_DEF] THEN + ASM_SIMP_TAC[INTEGRAL_COMPONENT]);; + +(* Paired +-k terms collapse to twice the real part (conjugate symmetry for *) +(* real phi): c_k e^{ikt} + c_{-k} e^{-ikt} = Cx(2 Re(c_k e^{ikt})). *) +let CFOURIER_PAIR_RE = prove + (`!(phi:real->real) k t. + (\z. Cx(phi(drop z))) absolutely_integrable_on interval[lift(--pi),lift + pi] + ==> cfourier_coeff (\x. Cx(phi x)) (&k) * cexp(ii * Cx(&k) * Cx t) + + cfourier_coeff (\x. Cx(phi x)) (-- &k) * cexp(ii * Cx(-- &k) * Cx t) = + Cx(&2 * Re(cfourier_coeff (\x. Cx(phi x)) (&k) * cexp(ii * Cx(&k) * Cx + t)))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`phi:real->real`; `&k:int`] CFOURIER_COEFF_CONJ) THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[INT_NEG_NEG] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + SUBGOAL_THEN + `cexp(ii * Cx(-- &k) * Cx t) = cnj(cexp(ii * Cx(&k) * Cx t))` + SUBST1_TAC THENL + [REWRITE_TAC[CNJ_CEXP] THEN AP_TERM_TAC THEN + REWRITE_TAC[CNJ_MUL; CNJ_II; CNJ_CX; int_neg_th; CX_NEG] THEN + CONV_TAC COMPLEX_RING; + ALL_TAC] THEN + REWRITE_TAC[GSYM CNJ_MUL] THEN + REWRITE_TAC[COMPLEX_ADD_CNJ; GSYM CX_MUL] THEN + REWRITE_TAC[COMPLEX_MUL_SYM]);; + +(* ------------------------------------------------------------------------- *) +(* 282L convergence via ROUTE B (coefficient bridge to the classical *) +(* real-trigonometric Fourier convergence in 100/fourier.ml). *) +(* *) +(* We show the complex-exponential partial sum of Cx o phi equals Cx of the *) +(* real-trigonometric partial sum sum(0..2N) fc phi k * ts k t, then invoke *) +(* DIFFERENTIABLE_FOURIER_CONVERGENCE_PERIODIC. This avoids the *) +(* dirichlet_kernel-periodicity wall (D_N is NOT exactly 2pi-periodic at *) +(* sin(x/2)=0 points), which blocks the direct kernel-substitution route. *) +(* ------------------------------------------------------------------------- *) + +(* Re(cexp(ii r)) = cos r. *) +let RE_CEXP_II = prove + (`!r. Re(cexp(ii * Cx r)) = cos r`, + GEN_TAC THEN REWRITE_TAC[RE_CEXP; RE_MUL_II; IM_MUL_II; RE_CX; IM_CX] THEN + REWRITE_TAC[REAL_NEG_0; REAL_EXP_0; REAL_MUL_LID]);; + +(* c_k(phi) e^{ikt} = Cx(inv 2pi) * int(phi(z) cexp(ii k (t - z))): push the *) +(* modulation e^{ikt} into the coefficient integral (companion of *) +(* CFOURIER_TERM_CONV but with a +ii exponent). *) +let CFOURIER_TERM_CONV_POS = prove + (`!(phi:real->real) k t. + (\z. Cx(phi(drop z))) absolutely_integrable_on interval[lift(--pi),lift + pi] + ==> cfourier_coeff (\x. Cx(phi x)) (&k) * cexp(ii * Cx(&k) * Cx t) = + Cx(inv(&2 * pi)) * + integral (interval[lift(--pi),lift pi]) + (\z. Cx(phi(drop z)) * cexp(ii * Cx(&k) * Cx(t - drop z)))`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[cfourier_coeff; IMAGE_LIFT_REAL_INTERVAL] THEN + REWRITE_TAC[GSYM COMPLEX_MUL_ASSOC] THEN AP_TERM_TAC THEN + ONCE_REWRITE_TAC[COMPLEX_MUL_SYM] THEN + SUBGOAL_THEN + `(\z. Cx(phi(drop z)) * cexp(--(ii * Cx(real_of_int(&k)) * Cx(drop z)))) + integrable_on + interval[lift(--pi),lift pi]` + ASSUME_TAC THENL + [MP_TAC(ISPEC `(\x. Cx(phi x)):real->complex` CFOURIER_INTEGRAND_ABSINT) + THEN + DISCH_THEN(MP_TAC o SPEC `&k:int`) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE]; ALL_TAC] THEN + ASM_SIMP_TAC[GSYM INTEGRAL_COMPLEX_LMUL] THEN + MATCH_MP_TAC INTEGRAL_EQ THEN X_GEN_TAC `z:real^1` THEN DISCH_TAC THEN + REWRITE_TAC[int_of_num_th] THEN + REWRITE_TAC[COMPLEX_RING `e * (p * f) = p * (e * f)`] THEN + GEN_REWRITE_TAC RAND_CONV [COMPLEX_MUL_SYM] THEN AP_TERM_TAC THEN + REWRITE_TAC[GSYM CEXP_ADD] THEN AP_TERM_TAC THEN + REWRITE_TAC[CX_SUB] THEN CONV_TAC COMPLEX_RING);; + +(* 2 Re(c_k e^{ikt}) = inv pi * int_{-pi}^{pi} phi(z) cos(k(t-z)) dz. *) +let CFOURIER_PAIR_RE_COS = prove + (`!(phi:real->real) k t. + (\z. Cx(phi(drop z))) absolutely_integrable_on interval[lift(--pi),lift + pi] + ==> &2 * Re(cfourier_coeff (\x. Cx(phi x)) (&k) * cexp(ii * Cx(&k) * Cx + t)) = + inv pi * + drop(integral (interval[lift(--pi),lift pi]) + (\z. lift(phi(drop z) * cos(&k * (t - drop z)))))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`phi:real->real`; `k:num`; + `t:real`] CFOURIER_TERM_CONV_POS) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[RE_MUL_CX; RE_CX] THEN + SUBGOAL_THEN + `(\z. Cx(phi(drop z)) * cexp(ii * Cx(&k) * Cx(t - drop z))) integrable_on + interval[lift(--pi),lift pi]` + ASSUME_TAC THENL + [SUBGOAL_THEN + `(\z. Cx(phi(drop z)) * cexp(ii * Cx(&k) * Cx(t - drop z))) = + (\z. cexp(ii * Cx(&k) * Cx t) * + (Cx(phi(drop z)) * cexp(--(ii * Cx(real_of_int(&k)) * Cx(drop + z)))))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; int_of_num_th] THEN GEN_TAC THEN + REWRITE_TAC[COMPLEX_RING `e * (p * f) = p * (e * f)`] THEN + AP_TERM_TAC THEN + REWRITE_TAC[GSYM CEXP_ADD] THEN AP_TERM_TAC THEN + REWRITE_TAC[CX_SUB] THEN CONV_TAC COMPLEX_RING; ALL_TAC] THEN + MATCH_MP_TAC INTEGRABLE_COMPLEX_LMUL THEN + MP_TAC(ISPEC `(\x. Cx(phi x)):real->complex` CFOURIER_INTEGRAND_ABSINT) + THEN + DISCH_THEN(MP_TAC o SPEC `&k:int`) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE]; ALL_TAC] THEN + ASM_SIMP_TAC[RE_INTEGRAL] THEN + SUBGOAL_THEN `&2 * inv(&2 * pi) * + drop(integral (interval[lift(--pi),lift pi]) + (\z. lift(Re(Cx(phi(drop z)) * cexp(ii * Cx(&k) * Cx(t - drop z)))))) = + inv pi * + drop(integral (interval[lift(--pi),lift pi]) + (\z. lift(Re(Cx(phi(drop z)) * cexp(ii * Cx(&k) * Cx(t - drop z))))))` + SUBST1_TAC THENL + [MP_TAC PI_POS THEN CONV_TAC REAL_FIELD; ALL_TAC] THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN + MATCH_MP_TAC INTEGRAL_EQ THEN X_GEN_TAC `z:real^1` THEN DISCH_TAC THEN + REWRITE_TAC[] THEN AP_TERM_TAC THEN + REWRITE_TAC[RE_MUL_CX] THEN + SUBGOAL_THEN + `ii * Cx(&k) * Cx(t - drop z) = + ii * Cx(&k * (t - drop z))` SUBST1_TAC THENL + [REWRITE_TAC[CX_MUL] THEN CONV_TAC COMPLEX_RING; ALL_TAC] THEN + REWRITE_TAC[RE_CEXP_II]);; + +(* phi abs-real-integrable ==> Cx o phi abs-integrable (linear embedding). *) +let CX_PHI_ABSINT = prove + (`!(phi:real->real). phi absolutely_real_integrable_on real_interval[--pi,pi] + ==> (\z. Cx(phi(drop z))) absolutely_integrable_on + interval[lift(--pi),lift pi]`, + GEN_TAC THEN REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_ON] THEN + REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL] THEN DISCH_TAC THEN + SUBGOAL_THEN + `(\z. Cx(phi(drop z))) = (\z:real^1. Cx(drop z)) o (lift o phi o drop)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; o_THM; LIFT_DROP]; ALL_TAC] THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_LINEAR THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[linear; DROP_ADD; DROP_CMUL; CX_ADD; CX_MUL] THEN + REWRITE_TAC[COMPLEX_CMUL; CX_MUL] THEN CONV_TAC COMPLEX_RING);; + +(* real_integral over [a,b] as the drop of the vector integral over *) +(* lift[a,b]. *) +let REAL_INTEGRAL_DROP_BRIDGE = prove + (`!f a b. f real_integrable_on real_interval[a,b] + ==> real_integral (real_interval[a,b]) f = + drop(integral (interval[lift a,lift b]) (\z. lift(f(drop z))))`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[REAL_INTEGRAL] THEN + REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL; o_DEF]);; + +(* The real-trigonometric pair term: for k>=1, *) +(* fc(2k-1) ts(2k-1)t + fc(2k) ts(2k)t = inv pi int phi(x) cos(k(t-x)) dx. *) +let CFOURIER_TRIG_PAIR_MATCH = prove + (`!(phi:real->real) k t. 1 <= k /\ + phi absolutely_real_integrable_on real_interval[--pi,pi] + ==> fourier_coefficient phi (2*k-1) * trigonometric_set (2*k-1) t + + fourier_coefficient phi (2*k) * trigonometric_set (2*k) t = + inv pi * real_integral (real_interval[--pi,pi]) (\x. phi x * cos(&k*(t + - x)))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `2 * k - 1 = 2 * (k - 1) + 1` SUBST1_TAC THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `2 * k = 2 * (k - 1) + 2` SUBST1_TAC THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[fourier_coefficient; orthonormal_coefficient; l2product] THEN + REWRITE_TAC[trigonometric_set] THEN + SUBGOAL_THEN `(k - 1) + 1 = k` SUBST1_TAC THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `(\x. sin(&k * x) / sqrt pi * phi x) absolutely_real_integrable_on + real_interval[--pi,pi] /\ + (\x. cos(&k * x) / sqrt pi * phi x) absolutely_real_integrable_on + real_interval[--pi,pi]` + STRIP_ASSUME_TAC THENL + [CONJ_TAC THEN + ONCE_REWRITE_TAC[REAL_ARITH `s / sqrt pi * ph = inv(sqrt pi) * (s * ph)`] + THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_LMUL THEN + ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_SIN_PRODUCT; + ABSOLUTELY_INTEGRABLE_COS_PRODUCT]; ALL_TAC] THEN + SUBGOAL_THEN + `(\x. phi x * cos(&k * (t - x))) real_integrable_on real_interval[--pi,pi]` + ASSUME_TAC THENL + [MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE THEN + SUBGOAL_THEN + `(\x. phi x * cos(&k * (t - x))) = + (\x. cos(&k * t) * (cos(&k * x) * phi x) + + sin(&k * t) * (sin(&k * x) * phi x))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + REWRITE_TAC[REAL_ARITH `&k * (t - x) = &k * t - &k * x`; COS_SUB] THEN + REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_ADD THEN CONJ_TAC THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_LMUL THEN + ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_SIN_PRODUCT; + ABSOLUTELY_INTEGRABLE_COS_PRODUCT]; ALL_TAC] THEN + ASM_SIMP_TAC[GSYM REAL_INTEGRAL_RMUL; + ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE] THEN + ASM_SIMP_TAC[GSYM REAL_INTEGRAL_ADD; + ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE; + REAL_INTEGRABLE_RMUL] THEN + ASM_SIMP_TAC[GSYM REAL_INTEGRAL_LMUL] THEN + MATCH_MP_TAC REAL_INTEGRAL_EQ THEN X_GEN_TAC `x:real` THEN DISCH_TAC THEN + REWRITE_TAC[REAL_ARITH `&k * (t - x) = &k * t - &k * x`; COS_SUB] THEN + MP_TAC(ISPEC `pi` SQRT_POW_2) THEN REWRITE_TAC[PI_POS_LE] THEN + REWRITE_TAC[REAL_POW_2] THEN + MP_TAC PI_POS THEN MP_TAC(ISPEC `pi` SQRT_POS_LT) THEN + REWRITE_TAC[real_div] THEN CONV_TAC REAL_FIELD);; + +(* Connector: the +-k complex pair equals the real-trig pair term (k>=1). *) +let CFOURIER_PAIR_TRIG = prove + (`!(phi:real->real) k t. 1 <= k /\ + phi absolutely_real_integrable_on real_interval[--pi,pi] + ==> &2 * Re(cfourier_coeff (\x. Cx(phi x)) (&k) * cexp(ii * Cx(&k) * Cx + t)) = + fourier_coefficient phi (2*k-1) * trigonometric_set (2*k-1) t + + fourier_coefficient phi (2*k) * trigonometric_set (2*k) t`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`phi:real->real`; `k:num`; + `t:real`] CFOURIER_PAIR_RE_COS) THEN + ASM_SIMP_TAC[CX_PHI_ABSINT] THEN DISCH_THEN SUBST1_TAC THEN + ASM_SIMP_TAC[CFOURIER_TRIG_PAIR_MATCH] THEN + AP_TERM_TAC THEN + SUBGOAL_THEN + `(\x. phi x * cos(&k * (t - x))) real_integrable_on real_interval[--pi,pi]` + ASSUME_TAC THENL + [MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE THEN + SUBGOAL_THEN + `(\x. phi x * cos(&k * (t - x))) = + (\x. cos(&k * t) * (cos(&k * x) * phi x) + + sin(&k * t) * (sin(&k * x) * phi x))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + REWRITE_TAC[REAL_ARITH `&k * (t - x) = &k * t - &k * x`; COS_SUB] THEN + REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_ADD THEN CONJ_TAC THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_LMUL THEN + ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_SIN_PRODUCT; + ABSOLUTELY_INTEGRABLE_COS_PRODUCT]; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_INTEGRAL_DROP_BRIDGE]);; + +(* The n=0 coefficient: c_0(Cx o phi) = Cx(fc phi 0 * ts 0 t). *) +let CFOURIER_COEFF_ZERO_TRIG = prove + (`!(phi:real->real) t. phi absolutely_real_integrable_on + real_interval[--pi,pi] + ==> cfourier_coeff (\x. Cx(phi x)) (&0) = + Cx(fourier_coefficient phi 0 * trigonometric_set 0 t)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[cfourier_coeff; IMAGE_LIFT_REAL_INTERVAL] THEN + REWRITE_TAC[int_of_num_th; COMPLEX_MUL_LZERO; COMPLEX_MUL_RZERO; + COMPLEX_NEG_0; CEXP_0; COMPLEX_MUL_RID] THEN + REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL] THEN + ASM_SIMP_TAC[CX_REAL_INTEGRAL_BRIDGE; + ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE] THEN + REWRITE_TAC[fourier_coefficient; orthonormal_coefficient; l2product; + trigonometric_set; REAL_MUL_LZERO; COS_0] THEN + REWRITE_TAC[GSYM CX_MUL] THEN AP_TERM_TAC THEN + ASM_SIMP_TAC[REAL_INTEGRAL_LMUL; + ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE] THEN + MP_TAC(ISPEC `&2 * pi` SQRT_POW_2) THEN + SIMP_TAC[REAL_LE_MUL; REAL_POS; PI_POS_LE; REAL_ARITH `&0 <= &2`] THEN + REWRITE_TAC[REAL_POW_2] THEN + MP_TAC PI_POS THEN MP_TAC(ISPEC `&2 * pi` SQRT_POS_LT) THEN + ASM_SIMP_TAC[REAL_LT_MUL; REAL_ARITH `&0 < &2`] THEN + CONV_TAC REAL_FIELD);; + +(* Grouping a 0..2N sum into the head plus paired (2k-1,2k) terms. *) +let SUM_GROUP_PAIRS = prove + (`!(g:num->real) N. sum(0..2*N) g = g 0 + sum(1..N)(\k. g(2*k-1) + g(2*k))`, + GEN_TAC THEN INDUCT_TAC THENL + [REWRITE_TAC[MULT_CLAUSES; SUM_CLAUSES_NUMSEG; ARITH; REAL_ADD_RID]; + ALL_TAC] THEN + SUBGOAL_THEN + `sum(0..2 * SUC N) g = sum(0..2 * N) g + g(2 * N + 1) + g(2 * N + 2)` + SUBST1_TAC THENL + [SUBGOAL_THEN `2 * SUC N = SUC(SUC(2 * N))` SUBST1_TAC THENL + [ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[SUM_CLAUSES_NUMSEG; LE_0] THEN + REWRITE_TAC[ADD1; ARITH_RULE `(2 * N + 1) + 1 = 2 * N + 2`] THEN + REAL_ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[SUM_CLAUSES_NUMSEG; ARITH_RULE `1 <= SUC N`] THEN + REWRITE_TAC[ARITH_RULE `2 * SUC N - 1 = 2 * N + 1`; + ARITH_RULE `2 * SUC N = 2 * N + 2`] THEN + REAL_ARITH_TAC);; + +(* KEYSTONE 282L(a): the complex-exponential partial sum of Cx o phi is Cx *) +(* of the classical real-trigonometric partial sum sum(0..2N) fc phi k * ts *) +(* k t. *) +let CFOURIER_PARTIAL_REAL_TRIG = prove + (`!(phi:real->real) N t. phi absolutely_real_integrable_on + real_interval[--pi,pi] + ==> cfourier_partial (\x. Cx(phi x)) N t = + Cx(sum(0..2*N)(\k. fourier_coefficient phi k * trigonometric_set k + t))`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[SUM_GROUP_PAIRS] THEN + ONCE_REWRITE_TAC[CFOURIER_PARTIAL_SPLIT] THEN + ASM_SIMP_TAC[CFOURIER_COEFF_ZERO_TRIG] THEN + REWRITE_TAC[CX_ADD] THEN AP_TERM_TAC THEN + W(fun (asl,w) -> MP_TAC(ISPECL [`\k. fourier_coefficient phi (2*k-1) * + trigonometric_set (2*k-1) t + fourier_coefficient phi (2*k) * + trigonometric_set (2*k) t`; `1..N`] VSUM_CX)) THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC VSUM_EQ THEN X_GEN_TAC `k:num` THEN + REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN + REWRITE_TAC[GSYM CX_ADD] THEN + ASM_SIMP_TAC[GSYM CFOURIER_PAIR_TRIG] THEN + MP_TAC(ISPECL [`phi:real->real`; `k:num`; `t:real`] CFOURIER_PAIR_RE) THEN + ASM_SIMP_TAC[CX_PHI_ABSINT]);; + +(* 282L: pointwise Fourier inversion for a differentiable 2pi-periodic phi. *) +(* The complex-exponential partial sum converges to Cx(phi t). *) +let CFOURIER_CONVERGENCE_DIFFERENTIABLE = prove + (`!(phi:real->real) t. + phi absolutely_real_integrable_on real_interval[--pi,pi] /\ + (!x. phi(x + &2 * pi) = phi x) /\ + phi real_differentiable atreal t + ==> ((\N. cfourier_partial (\x. Cx(phi x)) N t) --> Cx(phi t)) + sequentially`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[CFOURIER_PARTIAL_REAL_TRIG] THEN + REWRITE_TAC[GSYM o_DEF] THEN + ONCE_REWRITE_TAC[GSYM REALLIM_COMPLEX] THEN + MP_TAC(ISPECL + [`phi:real->real`; `0`; `t:real`; + `phi(t:real):real`] FOURIER_SUM_LIMIT_PAIR) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + MATCH_MP_TAC DIFFERENTIABLE_FOURIER_CONVERGENCE_PERIODIC THEN + ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* 282L(i) in Fremlin's FAITHFUL form: pointwise Fourier inversion at an *) +(* INTERIOR point, with NO global-periodicity hypothesis (only integrability *) +(* on [-pi,pi] and differentiability at the one interior point t). Fremlin's *) +(* proof uses the periodic extension internally; at an interior point that *) +(* extension agrees with phi on a neighbourhood, so differentiability *) +(* transfers *) +(* and the Fourier coefficients are unchanged. We realise this with an *) +(* explicit 2pi-periodisation and reduce to *) +(* CFOURIER_CONVERGENCE_DIFFERENTIABLE. *) +(* This removes the spurious periodicity assumption the tile function g of *) +(* 286O(b) does not satisfy (g is a compactly-supported bump). *) +(* ------------------------------------------------------------------------- *) + +(* The 2pi-periodisation: fold x into [-pi,pi) by subtracting the right *) +(* multiple of 2pi (floor of (x+pi)/2pi). *) +let periodize = new_definition + `periodize (phi:real->real) x = phi(x - &2 * pi * floor((x + pi)/(&2 * + pi)))`;; + +(* periodize phi is 2pi-periodic: the +2pi shift bumps the floor by 1. *) +let PERIODIZE_PERIODIC = prove + (`!(phi:real->real) x. periodize phi (x + &2 * pi) = periodize phi x`, + REPEAT GEN_TAC THEN REWRITE_TAC[periodize] THEN AP_TERM_TAC THEN + SUBGOAL_THEN + `((x + &2 * pi) + pi)/(&2 * pi) = (x + pi)/(&2 * pi) + &1` SUBST1_TAC THENL + [MP_TAC PI_POS THEN CONV_TAC REAL_FIELD; ALL_TAC] THEN + SUBGOAL_THEN + `floor((x + pi)/(&2 * pi) + &1) = floor((x + pi)/(&2 * pi)) + &1` + SUBST1_TAC THENL + [REWRITE_TAC[GSYM FLOOR_UNIQUE] THEN + MP_TAC(SPEC `(x + pi)/(&2 * pi)` FLOOR) THEN + SIMP_TAC[INTEGER_CLOSED] THEN REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_ADD_RDISTRIB; REAL_MUL_RID] THEN REAL_ARITH_TAC);; + +(* On the open interval (-pi,pi) the floor is 0, so periodize phi = phi. *) +let PERIODIZE_INTERIOR = prove + (`!(phi:real->real) x. --pi < x /\ x < pi ==> periodize phi x = phi x`, + REPEAT STRIP_TAC THEN REWRITE_TAC[periodize] THEN + SUBGOAL_THEN `floor((x + pi)/(&2 * pi)) = &0` SUBST1_TAC THENL + [REWRITE_TAC[GSYM FLOOR_UNIQUE; INTEGER_CLOSED] THEN + SUBGOAL_THEN `&0 < &2 * pi` ASSUME_TAC THENL + [MP_TAC PI_POS THEN REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_LT_LDIV_EQ] THEN + ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_MUL_RZERO; REAL_SUB_RZERO]);; + +(* The Fourier coefficients are unchanged by periodisation (integrands agree *) +(* on [-pi,pi] off the two endpoints, a negligible set). *) +let CFOURIER_COEFF_PERIODIZE = prove + (`!(phi:real->real) n. + cfourier_coeff (\x. Cx(periodize phi x)) n = cfourier_coeff (\x. Cx(phi + x)) n`, + REPEAT GEN_TAC THEN REWRITE_TAC[cfourier_coeff] THEN AP_TERM_TAC THEN + MATCH_MP_TAC INTEGRAL_SPIKE THEN + EXISTS_TAC `{lift(--pi), lift pi}` THEN + REWRITE_TAC[NEGLIGIBLE_INSERT; NEGLIGIBLE_EMPTY] THEN + X_GEN_TAC `x:real^1` THEN + REWRITE_TAC[IN_DIFF; IMAGE_LIFT_REAL_INTERVAL; IN_INTERVAL_1; LIFT_DROP] THEN + REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY; DE_MORGAN_THM] THEN STRIP_TAC THEN + AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC PERIODIZE_INTERIOR THEN + SUBGOAL_THEN `~(drop x = --pi) /\ ~(drop (x:real^1) = pi)` MP_TAC THENL + [REWRITE_TAC[GSYM LIFT_EQ; LIFT_DROP] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + REPEAT(POP_ASSUM MP_TAC) THEN REAL_ARITH_TAC);; + +(* Hence the partial sums agree too. *) +let CFOURIER_PARTIAL_PERIODIZE = prove + (`!(phi:real->real) N t. + cfourier_partial (\x. Cx(periodize phi x)) N t = cfourier_partial (\x. + Cx(phi x)) N t`, + REPEAT GEN_TAC THEN REWRITE_TAC[cfourier_partial] THEN + MATCH_MP_TAC VSUM_EQ THEN X_GEN_TAC `n:int` THEN DISCH_TAC THEN + REWRITE_TAC[CFOURIER_COEFF_PERIODIZE]);; + +(* periodize phi is absolutely integrable when phi is (spike on the *) +(* endpoints). *) +let PERIODIZE_ABSINT = prove + (`!(phi:real->real). phi absolutely_real_integrable_on real_interval[--pi,pi] + ==> periodize phi absolutely_real_integrable_on real_interval[--pi,pi]`, + GEN_TAC THEN REWRITE_TAC[absolutely_real_integrable_on] THEN STRIP_TAC THEN + SUBGOAL_THEN + `!x. x IN real_interval[--pi,pi] DIFF {--pi, pi} ==> periodize phi x = + phi x` + ASSUME_TAC THENL + [X_GEN_TAC `x:real` THEN + REWRITE_TAC[IN_DIFF; IN_REAL_INTERVAL; IN_INSERT; NOT_IN_EMPTY; + DE_MORGAN_THM] THEN + STRIP_TAC THEN MATCH_MP_TAC PERIODIZE_INTERIOR THEN + ASM_REAL_ARITH_TAC; ALL_TAC] THEN + CONJ_TAC THENL + [MP_TAC(ISPECL [`phi:real->real`; `periodize phi`; `{--pi, pi}`; + `real_interval[--pi,pi]`] REAL_INTEGRABLE_SPIKE_EQ) THEN + ASM_SIMP_TAC[REAL_NEGLIGIBLE_INSERT; REAL_NEGLIGIBLE_EMPTY]; + MP_TAC(ISPECL [`\x. abs((phi:real->real) x)`; `\x. abs(periodize phi x)`; + `{--pi, pi}`; + `real_interval[--pi,pi]`] REAL_INTEGRABLE_SPIKE_EQ) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[REAL_NEGLIGIBLE_INSERT; REAL_NEGLIGIBLE_EMPTY] THEN + REPEAT STRIP_TAC THEN AP_TERM_TAC THEN ASM_SIMP_TAC[]; + DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC[]]]);; + +(* Interior differentiability transfers to periodize (local agreement on a *) +(* neighbourhood of t contained in (-pi,pi)). *) +let PERIODIZE_DIFFERENTIABLE = prove + (`!(phi:real->real) t. --pi < t /\ t < pi /\ phi real_differentiable atreal t + ==> periodize phi real_differentiable atreal t`, + REPEAT GEN_TAC THEN REWRITE_TAC[real_differentiable] THEN STRIP_TAC THEN + EXISTS_TAC `f':real` THEN + MATCH_MP_TAC HAS_REAL_DERIVATIVE_TRANSFORM_ATREAL THEN + MAP_EVERY EXISTS_TAC [`phi:real->real`; `min (t + pi) (pi - t)`] THEN + ASM_REWRITE_TAC[REAL_LT_MIN] THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + X_GEN_TAC `x':real` THEN STRIP_TAC THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC PERIODIZE_INTERIOR THEN ASM_REAL_ARITH_TAC);; + +(* 282L(i): pointwise Fourier inversion at an interior point, NO periodicity *) +(* hypothesis -- Fremlin's actual statement. The complex-exponential partial *) +(* sum of Cx o phi converges to Cx(phi t) whenever phi is integrable on *) +(* [-pi,pi] *) +(* and differentiable at the interior point t in (-pi,pi). *) +let CFOURIER_CONVERGENCE_INTERIOR = prove + (`!(phi:real->real) t. + phi absolutely_real_integrable_on real_interval[--pi,pi] /\ + --pi < t /\ t < pi /\ + phi real_differentiable atreal t + ==> ((\N. cfourier_partial (\x. Cx(phi x)) N t) --> Cx(phi t)) + sequentially`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `Cx(phi t) = Cx(periodize phi t)` SUBST1_TAC THENL + [AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC PERIODIZE_INTERIOR THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + ONCE_REWRITE_TAC[GSYM CFOURIER_PARTIAL_PERIODIZE] THEN + MATCH_MP_TAC CFOURIER_CONVERGENCE_DIFFERENTIABLE THEN + REWRITE_TAC[PERIODIZE_PERIODIC; ETA_AX] THEN + ASM_SIMP_TAC[PERIODIZE_ABSINT] THEN + MATCH_MP_TAC PERIODIZE_DIFFERENTIABLE THEN ASM_REWRITE_TAC[]);; + +(* Reindexing symmetry (Fremlin 286O-b-ii, step 2094->2097): the symmetric *) +(* sum *) +(* of c_{-n} e^{-inu} over |n|<=N equals cfourier_partial g N u (substitute *) +(* n -> -n on the symmetric index set {n | abs n <= N}). This is the bridge *) +(* that turns the R_k tile-sum (indexed by n_I in ZZ) into the 282A partial *) +(* sum. *) +let CFOURIER_PARTIAL_REINDEX = prove + (`!(g:real->complex) N u. + vsum {n:int | abs n <= &N} + (\n. cfourier_coeff g (--n) * cexp(--(ii * Cx(real_of_int n) * Cx + u))) = + cfourier_partial g N u`, + REPEAT GEN_TAC THEN REWRITE_TAC[cfourier_partial] THEN + MATCH_MP_TAC VSUM_EQ_GENERAL THEN + EXISTS_TAC `\n:int. --n` THEN + REWRITE_TAC[IN_ELIM_THM; INT_ABS_NEG] THEN CONJ_TAC THENL + [X_GEN_TAC `m:int` THEN DISCH_TAC THEN + REWRITE_TAC[EXISTS_UNIQUE_THM; IN_ELIM_THM] THEN + CONJ_TAC THENL + [EXISTS_TAC `--m:int` THEN ASM_REWRITE_TAC[INT_ABS_NEG; INT_NEG_NEG]; + REPEAT STRIP_TAC THEN ASM_INT_ARITH_TAC]; + X_GEN_TAC `n:int` THEN DISCH_TAC THEN REWRITE_TAC[INT_NEG_NEG] THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + AP_TERM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[int_neg_th; CX_NEG] THEN CONV_TAC COMPLEX_RING]]);; + +(* Finite reindexed sum with a constant window W: pulls the nI-independent *) +(* factor Cx(2pi)*W out of the tile-sum and collapses the c_{-nI} e^{-inI u} *) +(* part to the 282A partial sum (Fremlin 286O-b-ii, the sum over R_k at *) +(* fixed scale k). *) +let CARLESON_FINITE_REINDEX_SUM = prove + (`!(G:real->complex) N u (W:complex). + vsum {nI:int | abs nI <= &N} + (\nI. Cx(&2 * pi) * + (cfourier_coeff G (--nI) * cexp(--(ii * Cx(real_of_int nI) * Cx + u))) * W) = + Cx(&2 * pi) * cfourier_partial G N u * W`, + REPEAT GEN_TAC THEN + REWRITE_TAC[COMPLEX_RING `Cx(&2 * pi) * a * W = (Cx(&2 * pi) * W) * a`] THEN + ASM_SIMP_TAC[VSUM_COMPLEX_LMUL; CFOURIER_INDEX_FINITE] THEN + REWRITE_TAC[CFOURIER_PARTIAL_REINDEX] THEN CONV_TAC COMPLEX_RING);; + +(* Complex 282L support: cfourier_coeff of a complex g splits into the real *) +(* and imaginary Cx-coefficients (g = Cx(Re g) + ii Cx(Im g), integral is *) +(* C-linear). Needs the two component integrands integrable on the interval. *) +let CFOURIER_COEFF_REIM = prove + (`!(g:real->complex) n. + (\t. Cx(Re(g(drop t))) * cexp(--(ii * Cx(real_of_int n) * Cx(drop t)))) + integrable_on + interval[lift(--pi),lift pi] /\ + (\t. Cx(Im(g(drop t))) * cexp(--(ii * Cx(real_of_int n) * Cx(drop t)))) + integrable_on + interval[lift(--pi),lift pi] + ==> cfourier_coeff g n = + cfourier_coeff (\x. Cx(Re(g x))) n + ii * cfourier_coeff (\x. Cx(Im(g + x))) n`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[cfourier_coeff; IMAGE_LIFT_REAL_INTERVAL] THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC + `Cx(inv(&2 * pi)) * + (integral (interval[lift(--pi),lift pi]) + (\t. Cx(Re(g(drop t))) * cexp(--(ii * Cx(real_of_int n) * Cx(drop t)))) + + + ii * integral (interval[lift(--pi),lift pi]) + (\t. Cx(Im(g(drop t))) * cexp(--(ii * Cx(real_of_int n) * Cx(drop + t)))))` THEN + CONJ_TAC THENL + [AP_TERM_TAC THEN + ASM_SIMP_TAC[GSYM INTEGRAL_COMPLEX_LMUL] THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC + `integral (interval[lift(--pi),lift pi]) + (\t. Cx(Re(g(drop t))) * cexp(--(ii * Cx(real_of_int n) * Cx(drop t))) + + + ii * (Cx(Im(g(drop t))) * cexp(--(ii * Cx(real_of_int n) * Cx(drop + t)))))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC INTEGRAL_EQ THEN X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN + REWRITE_TAC[] THEN + GEN_REWRITE_TAC (LAND_CONV o RATOR_CONV o RAND_CONV) [COMPLEX_EXPAND] + THEN + CONV_TAC COMPLEX_RING; + MATCH_MP_TAC INTEGRAL_ADD THEN ASM_SIMP_TAC[INTEGRABLE_COMPLEX_LMUL]]; + ALL_TAC] THEN + REWRITE_TAC[cfourier_coeff; IMAGE_LIFT_REAL_INTERVAL] THEN + CONV_TAC COMPLEX_RING);; + +(* Partial-sum Re/Im split (lifts CFOURIER_COEFF_REIM to the partial sum). *) +let CFOURIER_PARTIAL_REIM = prove + (`!(g:real->complex) N t. + (!n. abs n <= &N ==> + (\z. Cx(Re(g(drop z))) * cexp(--(ii * Cx(real_of_int n) * Cx(drop z)))) + integrable_on + interval[lift(--pi),lift pi] /\ + (\z. Cx(Im(g(drop z))) * cexp(--(ii * Cx(real_of_int n) * Cx(drop z)))) + integrable_on + interval[lift(--pi),lift pi]) + ==> cfourier_partial g N t = + cfourier_partial (\x. Cx(Re(g x))) N t + ii * cfourier_partial (\x. + Cx(Im(g x))) N t`, + REPEAT STRIP_TAC THEN REWRITE_TAC[cfourier_partial] THEN + SIMP_TAC[GSYM VSUM_COMPLEX_LMUL; CFOURIER_INDEX_FINITE] THEN + SIMP_TAC[GSYM VSUM_ADD; CFOURIER_INDEX_FINITE] THEN + MATCH_MP_TAC VSUM_EQ THEN X_GEN_TAC `n:int` THEN + REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n:int`) THEN ASM_REWRITE_TAC[] THEN + STRIP_TAC THEN + ASM_SIMP_TAC[CFOURIER_COEFF_REIM] THEN CONV_TAC COMPLEX_RING);; + +(* 282L(i) for a COMPLEX g: if Re g, Im g are integrable on [-pi,pi] and *) +(* differentiable at the interior point t, then cfourier_partial g N t --> g *) +(* t. *) +(* Splits g into its real/imaginary parts and combines two real *) +(* interior-282L *) +(* limits (LIM_ADD + LIM_COMPLEX_LMUL). This is the tool the complex tile *) +(* function g(t)=hhat(2^k t+yhat_k) e^{it/2} phihat(t) needs. *) +let CFOURIER_CONVERGENCE_INTERIOR_CX = prove + (`!(g:real->complex) t. + (\x. Re(g x)) absolutely_real_integrable_on real_interval[--pi,pi] /\ + (\x. Im(g x)) absolutely_real_integrable_on real_interval[--pi,pi] /\ + --pi < t /\ t < pi /\ + (\x. Re(g x)) real_differentiable atreal t /\ + (\x. Im(g x)) real_differentiable atreal t + ==> ((\N. cfourier_partial g N t) --> g t) sequentially`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `!N. cfourier_partial (g:real->complex) N t = + cfourier_partial (\x. Cx(Re(g x))) N t + ii * cfourier_partial (\x. + Cx(Im(g x))) N t` + (fun th -> REWRITE_TAC[th]) THENL + [GEN_TAC THEN MATCH_MP_TAC CFOURIER_PARTIAL_REIM THEN + X_GEN_TAC `n:int` THEN DISCH_TAC THEN CONJ_TAC THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC CFOURIER_INTEGRAND_ABSINT THEN + MATCH_MP_TAC CX_PHI_ABSINT THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [COMPLEX_EXPAND] THEN + MATCH_MP_TAC LIM_ADD THEN CONJ_TAC THENL + [MATCH_MP_TAC CFOURIER_CONVERGENCE_INTERIOR THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC LIM_COMPLEX_LMUL THEN + MATCH_MP_TAC CFOURIER_CONVERGENCE_INTERIOR THEN ASM_REWRITE_TAC[]]);; + +(* Vector-differentiability of g(drop .) at lift t gives *) +(* real-differentiability of Re g and Im g at t (Re, Im are linear *) +(* real^2->real^1 up to lift, chain rule). Bridges a complex tile function's *) +(* vector derivative to the Re/Im hypotheses of *) +(* CFOURIER_CONVERGENCE_INTERIOR_CX. *) +let VECTOR_DIFF_IMP_REIM_DIFF = prove + (`!(g:real->complex) t. + (\z. g(drop z)) differentiable (at(lift t)) + ==> (\x. Re(g x)) real_differentiable atreal t /\ + (\x. Im(g x)) real_differentiable atreal t`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[REAL_DIFFERENTIABLE_AT; o_DEF] THEN CONJ_TAC THENL + [SUBGOAL_THEN + `(\z. lift(Re(g(drop z)))) = (\w. lift(Re w)) o (\z. g(drop z))` + SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC]; + SUBGOAL_THEN + `(\z. lift(Im(g(drop z)))) = (\w. lift(Im w)) o (\z. g(drop z))` + SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC]] THEN + MATCH_MP_TAC DIFFERENTIABLE_CHAIN_AT THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC DIFFERENTIABLE_LINEAR THEN + REWRITE_TAC[linear; LIFT_ADD; LIFT_CMUL; RE_ADD; IM_ADD; RE_CMUL; + IM_CMUL] THEN + REWRITE_TAC[LIFT_ADD; LIFT_CMUL]);; + +(* Product rule for complex-valued functions of a real^1 variable (via the *) +(* bilinear vector-derivative rule). A building block for showing the tile *) +(* function g = hhat(2^k .+yhat_k) * e^{i./2} * phihat is *) +(* vector-differentiable. *) +let DIFFERENTIABLE_COMPLEX_MUL_AT = prove + (`!(f:real^1->complex) g a. + f differentiable (at a) /\ g differentiable (at a) + ==> (\x. f x * g x) differentiable (at a)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_IMP_DIFFERENTIABLE THEN + EXISTS_TAC + `f a * vector_derivative (g:real^1->complex) (at a) + + vector_derivative (f:real^1->complex) (at a) * g a` THEN + MP_TAC(ISPECL + [`(\x y. x * y):complex->complex->complex`; + `f:real^1->complex`; `g:real^1->complex`; + `vector_derivative (f:real^1->complex) (at a)`; + `vector_derivative (g:real^1->complex) (at a)`; `a:real^1`] + HAS_VECTOR_DERIVATIVE_BILINEAR_AT) THEN + ASM_SIMP_TAC[BILINEAR_COMPLEX_MUL; GSYM VECTOR_DERIVATIVE_WORKS] THEN + BETA_TAC THEN DISCH_THEN MATCH_MP_TAC THEN + SUBGOAL_THEN `(\x y. x * y):complex->complex->complex = (*)` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM]; REWRITE_TAC[BILINEAR_COMPLEX_MUL]]);; + +(* fourier of a Schwartz function is vector-differentiable everywhere *) +(* (FOURIER_SCHWARTZ_DERIV gives the derivative --ii*fourier(x*h)). *) +let FOURIER_SCHWARTZ_DIFFERENTIABLE = prove + (`!(h:real->complex) a. schwartz h ==> + (\z. fourier h (drop z)) differentiable (at a)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_IMP_DIFFERENTIABLE THEN + EXISTS_TAC `--ii * fourier (\x. Cx x * h x) (drop a)` THEN + MP_TAC(ISPECL [`h:real->complex`; `drop a`] FOURIER_SCHWARTZ_DERIV) THEN + ASM_REWRITE_TAC[LIFT_DROP]);; + +(* fourier h composed with an affine real map c*t+b is *) +(* vector-differentiable. *) +let FOURIER_SCHWARTZ_AFFINE_DIFF = prove + (`!(h:real->complex) c b a. schwartz h ==> + (\z. fourier h (c * drop z + b)) differentiable (at a)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\z. fourier h (c * drop z + b)) = + (\w. fourier h (drop w)) o (\z:real^1. c % z + lift b)` + SUBST1_TAC THENL + [REWRITE_TAC[o_DEF; FUN_EQ_THM] THEN GEN_TAC THEN + REWRITE_TAC[DROP_ADD; DROP_CMUL; LIFT_DROP]; ALL_TAC] THEN + MATCH_MP_TAC DIFFERENTIABLE_CHAIN_AT THEN CONJ_TAC THENL + [MATCH_MP_TAC DIFFERENTIABLE_ADD THEN + REWRITE_TAC[DIFFERENTIABLE_CONST] THEN + MATCH_MP_TAC DIFFERENTIABLE_CMUL THEN REWRITE_TAC[DIFFERENTIABLE_ID]; + ASM_SIMP_TAC[FOURIER_SCHWARTZ_DIFFERENTIABLE]]);; + +(* cexp of a linear real^1->complex map c*Cx(drop z) is *) +(* vector-differentiable. *) +let CEXP_LINEAR_DIFF = prove + (`!(c:complex) a. (\z. cexp(c * Cx(drop z))) differentiable (at a)`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN + `(\z. cexp(c * Cx(drop z))) = cexp o (\z:real^1. c * Cx(drop z))` + SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN + MATCH_MP_TAC DIFFERENTIABLE_CHAIN_AT THEN CONJ_TAC THENL + [MATCH_MP_TAC DIFFERENTIABLE_LINEAR THEN + REWRITE_TAC[linear; DROP_ADD; DROP_CMUL; CX_ADD; CX_MUL; COMPLEX_CMUL] THEN + CONV_TAC COMPLEX_RING; + MATCH_MP_TAC COMPLEX_DIFFERENTIABLE_IMP_DIFFERENTIABLE THEN + REWRITE_TAC[COMPLEX_DIFFERENTIABLE_AT_CEXP]]);; + +(* If g(drop .) is vector-differentiable everywhere then Re g, Im g are *) +(* absolutely-real-integrable on [-pi,pi] (differentiable => continuous on *) +(* the *) +(* compact interval => absolutely integrable). Supplies the integrability *) +(* hypotheses of CFOURIER_CONVERGENCE_INTERIOR_CX. *) +let VECTOR_DIFF_IMP_REIM_ABSINT = prove + (`!(g:real->complex). + (!a. (\z. g(drop z)) differentiable (at a)) + ==> (\x. Re(g x)) absolutely_real_integrable_on real_interval[--pi,pi] /\ + (\x. Im(g x)) absolutely_real_integrable_on real_interval[--pi,pi]`, + GEN_TAC THEN DISCH_TAC THEN CONJ_TAC THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_CONTINUOUS THEN + MATCH_MP_TAC REAL_DIFFERENTIABLE_ON_IMP_REAL_CONTINUOUS_ON THEN + REWRITE_TAC[real_differentiable_on; GSYM real_differentiable] THEN + X_GEN_TAC `x:real` THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_DIFFERENTIABLE_ATREAL_WITHIN THEN + MP_TAC(ISPECL [`g:real->complex`; `x:real`] VECTOR_DIFF_IMP_REIM_DIFF) THEN + ASM_REWRITE_TAC[] THEN SIMP_TAC[]);; + + +(* ------------------------------------------------------------------------- *) +(* The one-dimensional Hardy-Littlewood maximal function (Fremlin 286A). *) +(* f*(x) = sup of the average of |f| over intervals [a,b] containing x. *) +(* ------------------------------------------------------------------------- *) + +(* ========================================================================= *) +(* Layer-cake / distribution-function infrastructure (Fremlin 252O). *) +(* *) +(* Not present in the library as a named result, but derivable: the region *) +(* under the graph of a nonnegative g has measure int g (via *) +(* HAS_INTEGRAL_MEASURE_UNDER_CURVE), and slicing it horizontally at height *) +(* t (via FUBINI_MEASURE_ALT) has section {x | t <= g x}. Equating the two *) +(* gives int g = int_{t} measure {x | t <= g x} dt. *) +(* ========================================================================= *) + +(* Vector-level engine: g:real^1->real^1, g >= 0, integrating to m. *) +(* Then t |-> measure {x | t <= g x} (with the &0 <= t guard from the *) +(* closed region [vec 0, g x]) integrates to the same m over all of R. *) + + +(* ========================================================================= *) +(* Fremlin 286E(b): the Lacey-Thiele test function and tile-bump family. *) +(* ========================================================================= *) + +let psi0 = new_definition + `psi0 (x:real) = rtheta(&11 - &60 * x) * rtheta(&11 + &60 * x)`;; + +let PSI0_ONE = prove + (`!x. abs x <= &1 / &6 ==> psi0 x = &1`, + REPEAT STRIP_TAC THEN REWRITE_TAC[psi0] THEN + SUBGOAL_THEN `rtheta(&11 - &60 * x) = &1 /\ rtheta(&11 + &60 * x) = &1` + (fun th -> REWRITE_TAC[th; REAL_MUL_LID]) THEN + CONJ_TAC THEN MATCH_MP_TAC RTHETA_ONE THEN ASM_REAL_ARITH_TAC);; + +let PSI0_SUPPORT = prove + (`!x. &1 / &5 < abs x ==> psi0 x = &0`, + REPEAT STRIP_TAC THEN REWRITE_TAC[psi0] THEN + DISJ_CASES_TAC(REAL_ARITH `x < &0 \/ &0 <= x`) THENL + [SUBGOAL_THEN `rtheta(&11 + &60 * x) = &0` SUBST1_TAC THENL + [MATCH_MP_TAC RTHETA_ZERO THEN + ASM_REAL_ARITH_TAC; REWRITE_TAC[REAL_MUL_RZERO]]; + SUBGOAL_THEN `rtheta(&11 - &60 * x) = &0` SUBST1_TAC THENL + [MATCH_MP_TAC RTHETA_ZERO THEN + ASM_REAL_ARITH_TAC; REWRITE_TAC[REAL_MUL_LZERO]]]);; + +let PSI0_BOUNDS = prove + (`!x. &0 <= psi0 x /\ psi0 x <= &1`, + GEN_TAC THEN REWRITE_TAC[psi0] THEN + MP_TAC(SPEC `&11 - &60 * x` RTHETA_BOUNDS) THEN + MP_TAC(SPEC `&11 + &60 * x` RTHETA_BOUNDS) THEN + STRIP_TAC THEN STRIP_TAC THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `rtheta(&11 - &60 * x) * &1` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[REAL_MUL_RID] THEN ASM_REAL_ARITH_TAC]]);; + +let PSI0_EVEN = prove + (`!x. psi0(--x) = psi0 x`, + GEN_TAC THEN REWRITE_TAC[psi0] THEN + REWRITE_TAC[REAL_ARITH `&11 - &60 * --x = &11 + &60 * x`; + REAL_ARITH `&11 + &60 * --x = &11 - &60 * x`] THEN + REAL_ARITH_TAC);; + +(* psi0 is smooth with compact support, hence Schwartz. *) +let PSI0_CHAIN = prove + (`?q:num->real->complex. + q 0 = (\x. Cx(psi0 x)) /\ + (!n y. ((\z. q n(drop z)) has_vector_derivative (q(SUC n) y))(at(lift + y)))`, + X_CHOOSE_THEN `d:num->real->complex` STRIP_ASSUME_TAC RTHETA_CHAIN THEN + MP_TAC(ISPECL [`d:num->real->complex`; `&11`; `-- &60`] AFFINE_CHAIN) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`d:num->real->complex`; `&11`; `&60`] AFFINE_CHAIN) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MP_TAC(ISPECL + [`\n x. Cx(-- &60) pow n * (d:num->real->complex) n (&11 + -- &60 * x)`; + `\n x. Cx(&60) pow n * (d:num->real->complex) n (&11 + &60 * x)`] + LEIBNIZ_CHAIN) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `q:num->real->complex` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `q:num->real->complex` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:real` THEN + ASM_REWRITE_TAC[complex_pow; COMPLEX_MUL_LID; psi0; CX_MUL] THEN + REWRITE_TAC[REAL_ARITH `&11 + -- &60 * x = &11 - &60 * x`]);; + +let SCHWARTZ_PSI0 = prove + (`schwartz (\x. Cx(psi0 x))`, + X_CHOOSE_THEN `q:num->real->complex` STRIP_ASSUME_TAC PSI0_CHAIN THEN + SUBGOAL_THEN `(\x. Cx(psi0 x)) = (q:num->real->complex) 0` SUBST1_TAC THENL + [ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC COMPACT_SUPPORT_SMOOTH_IMP_SCHWARTZ THEN + EXISTS_TAC `&1 / &5` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[real_gt] THEN MATCH_MP_TAC CHAIN_SUPPORT THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [REAL_ARITH_TAC; + X_GEN_TAC `x:real` THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `psi0 x = &0` SUBST1_TAC THENL + [MATCH_MP_TAC PSI0_SUPPORT THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[COMPLEX_VEC_0; CX_INJ]]]);; + +(* phi = fourier(Cx o psi0); fourier phi = Cx o psi0 (psi0 even + double *) +(* transform). So phi-hat is real and satisfies the plateau sandwich. *) +let PHI_FOURIER = prove + (`!z. fourier (fourier (\x. Cx(psi0 x))) z = Cx(psi0 z)`, + GEN_TAC THEN + MP_TAC(ISPECL [`\x:real. Cx(psi0 x)`; `--z:real`] DOUBLE_TRANSFORM) THEN + REWRITE_TAC[SCHWARTZ_PSI0; REAL_NEG_NEG] THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[PSI0_EVEN]);; + +(* ------------------------------------------------------------------------- *) +(* Toward 284C (fhat of a compactly-supported smooth fn is Schwartz), which *) +(* will give phi = fourier(Cx o psi0) itself Schwartz. Product rule for the *) +(* multiplication-by-x operator (first brick of "Schwartz closed under *) +(* x*."). *) +(* ------------------------------------------------------------------------- *) + +let CARLESON_286EB = prove + (`?phi:real->complex. + schwartz phi /\ + (!y. real(fourier phi y)) /\ + (!y. (if abs y <= &1 / &6 then &1 else &0) <= Re(fourier phi y)) /\ + (!y. Re(fourier phi y) <= (if abs y <= &1 / &5 then &1 else &0))`, + EXISTS_TAC `fourier (\x. Cx(psi0 x))` THEN + REWRITE_TAC[PHI_FOURIER; RE_CX; REAL_CX] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC SCHWARTZ_FOURIER THEN REWRITE_TAC[SCHWARTZ_PSI0]; + GEN_TAC THEN COND_CASES_TAC THENL + [ASM_SIMP_TAC[PSI0_ONE; REAL_LE_REFL]; + MP_TAC(SPEC `y:real` PSI0_BOUNDS) THEN REAL_ARITH_TAC]; + GEN_TAC THEN COND_CASES_TAC THENL + [MP_TAC(SPEC `y:real` PSI0_BOUNDS) THEN REAL_ARITH_TAC; + SUBGOAL_THEN `psi0 y = &0` SUBST1_TAC THENL + [MATCH_MP_TAC PSI0_SUPPORT THEN + ASM_REAL_ARITH_TAC; REWRITE_TAC[REAL_LE_REFL]]]]);; + +(* ------------------------------------------------------------------------- *) +(* Toward the phi_sigma family (286E): a nonzero affine map is onto R. *) +(* (First building block for the L^2 dilation-invariance *) +(* ||phi_sigma||=||phi||) *) +(* ------------------------------------------------------------------------- *) + +let PHISIG_LNORM_SQ = prove + (`!(psi:real->complex) mJ a b. + &0 < mJ /\ (\x:real^1. lift(norm(psi(drop x)) pow 2)) integrable_on + (:real^1) + ==> integral (:real^1) + (\x. lift(norm(Cx(sqrt mJ) * cexp(ii * Cx b * Cx(drop x)) * + psi(mJ * (drop x - a))) pow 2)) = + integral (:real^1) (\x. lift(norm(psi(drop x)) pow 2))`, + REPEAT STRIP_TAC THEN + ABBREV_TAC `ff = \y:real^1. lift(norm((psi:real->complex)(drop y)) pow 2)` + THEN + SUBGOAL_THEN + `(\x:real^1. lift(norm(Cx(sqrt mJ) * cexp(ii * Cx b * Cx(drop x)) * + (psi:real->complex)(mJ * (drop x - a))) pow 2)) = + (\x. mJ % (ff:real^1->real^1) (mJ % x + --(mJ % lift a)))` + SUBST1_TAC THENL + [EXPAND_TAC "ff" THEN + REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:real^1` THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX; GSYM CX_MUL; + NORM_CEXP_II] THEN + REWRITE_TAC[REAL_MUL_RID; REAL_POW_ONE; VECTOR_MUL_LID] THEN + REWRITE_TAC[REAL_POW_MUL; GSYM LIFT_CMUL] THEN + REWRITE_TAC[DROP_ADD; DROP_CMUL; DROP_NEG; LIFT_DROP] THEN + REWRITE_TAC[REAL_ARITH `mJ * drop x + --(mJ * a) = mJ * (drop x - a)`] THEN + AP_TERM_TAC THEN REWRITE_TAC[REAL_POW_ONE; REAL_MUL_LID] THEN + SUBGOAL_THEN `abs(sqrt mJ) = sqrt mJ` SUBST1_TAC THENL + [REWRITE_TAC[REAL_ABS_REFL] THEN MATCH_MP_TAC SQRT_POS_LE THEN + ASM_REAL_ARITH_TAC; + ASM_SIMP_TAC[SQRT_POW_2; REAL_LT_IMP_LE]]; + ALL_TAC] THEN + SUBGOAL_THEN `(ff:real^1->real^1) integrable_on (:real^1)` ASSUME_TAC THENL + [EXPAND_TAC "ff" THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_SIMP_TAC[INTEGRAL_CMUL; INTEGRABLE_DILATE_UNIV; REAL_LT_IMP_NZ] THEN + ASM_SIMP_TAC[INTEGRAL_DILATE_UNIV; REAL_LT_IMP_NZ] THEN + REWRITE_TAC[VECTOR_MUL_ASSOC] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < m ==> abs m = m`; REAL_MUL_RINV; + REAL_LT_IMP_NZ; + VECTOR_MUL_LID]);; + +(* ------------------------------------------------------------------------- *) +(* The phi_sigma family (286E b), abstract in the scalars mJ (= mu J > 0), *) +(* a (= x_sigma), b (= y^l_sigma): *) +(* phimst mJ a b phi = \x. sqrt(mJ) e^{i b x} phi(mJ (x - a)). *) +(* b(i): ||phimst||_2 = ||phi||_2 (PHIMST_L2, from PHISIG_LNORM_SQ). *) +(* ------------------------------------------------------------------------- *) + +(* Polynomial-growth helpers for the affine Schwartz-closure decay bounds. *) +let phimst = new_definition + `phimst mJ a b (phi:real->complex) = + \x. Cx(sqrt mJ) * cexp(ii * Cx b * Cx x) * phi(mJ * (x - a))`;; + +let PHIMST_L2 = prove + (`!(phi:real->complex) mJ a b. + &0 < mJ /\ (\x:real^1. lift(norm(phi(drop x)) pow 2)) integrable_on + (:real^1) + ==> lnorm (:real^1) (&2) (\z. phimst mJ a b phi (drop z)) = + lnorm (:real^1) (&2) (\z. phi(drop z))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[lnorm; phimst] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + SUBGOAL_THEN + `(\x. lift(norm(Cx(sqrt mJ) * cexp(ii * Cx b * Cx(drop x)) * + (phi:real->complex)(mJ * (drop x - a))) rpow &2)) = + (\x. lift(norm(Cx(sqrt mJ) * cexp(ii * Cx b * Cx(drop x)) * + phi(mJ * (drop x - a))) pow 2))` + SUBST1_TAC THENL + [REWRITE_TAC[RPOW_POW]; ALL_TAC] THEN + SUBGOAL_THEN + `(\x. lift(norm((phi:real->complex)(drop x)) rpow &2)) = + (\x. lift(norm(phi(drop x)) pow 2))` + SUBST1_TAC THENL + [REWRITE_TAC[RPOW_POW]; ALL_TAC] THEN + MATCH_MP_TAC PHISIG_LNORM_SQ THEN ASM_REWRITE_TAC[]);; + +(* Schwartz closed under affine reparametrization x |-> c + s x (s <> 0): *) +(* chain via AFFINE_CHAIN; decay bounds via the |x|^k <= *) +(* 2^k(|u|^k+|c|^k)/|s|^k estimate (AFFINE_XPOW_BOUND/AFFINE_WEIGHT_BOUND *) +(* from POW_ADD_2BOUND). *) +let PHIMST_SCHWARTZ = prove + (`!(phi:real->complex) mJ a b. schwartz phi /\ ~(mJ = &0) + ==> schwartz (phimst mJ a b phi)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[phimst] THEN + MATCH_MP_TAC SCHWARTZ_CMUL THEN MATCH_MP_TAC SCHWARTZ_MODULATE THEN + SUBGOAL_THEN + `(\x. (phi:real->complex)(mJ * (x - a))) = (\x. phi(--(mJ * a) + mJ * x))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN AP_TERM_TAC THEN REAL_ARITH_TAC; + MATCH_MP_TAC SCHWARTZ_AFFINE THEN ASM_REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* The modulated-affine core \x. e^{i b x} phi(mJ (x - a)) is Schwartz *) +(* (phimst without the constant factor). Reused for FOURIER_LMUL's side *) +(* condition below. *) +(* ------------------------------------------------------------------------- *) + +let FOURIER_PHI_SCALE_SHIFT = prove + (`!(phi:real->complex) mJ a z. &0 < mJ /\ schwartz phi + ==> fourier (\x. phi(mJ * (x - a))) z = + Cx(&1 / mJ) * cexp(--(ii * Cx a * Cx z)) * fourier phi (z / mJ)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\x. (phi:real->complex)(mJ * (x - a))) = + (\x. (\t. phi(mJ * t))(x + (--a)))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN REWRITE_TAC[] THEN + AP_TERM_TAC THEN + REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPECL [`\t. (phi:real->complex)(mJ * t)`; `--a:real`; + `z:real`] FOURIER_SHIFT) THEN + ANTS_TAC THENL + [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + SUBGOAL_THEN `schwartz (\t. (phi:real->complex)(mJ * t))` MP_TAC THENL + [SUBGOAL_THEN + `(\t. (phi:real->complex)(mJ * t)) = + (\t. phi(&0 + mJ * t))` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; REAL_ADD_LID]; + MATCH_MP_TAC SCHWARTZ_AFFINE THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC]; + DISCH_THEN(MP_TAC o SPEC `z:real` o MATCH_MP SCHWARTZ_MOD_ABSINT) THEN + REWRITE_TAC[]]; + DISCH_THEN SUBST1_TAC] THEN + MP_TAC(ISPECL [`phi:real->complex`; `mJ:real`; + `z:real`] FOURIER_DILATION) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC SCHWARTZ_MOD_ABSINT THEN ASM_REWRITE_TAC[]; + DISCH_THEN SUBST1_TAC] THEN + REWRITE_TAC[CX_NEG; COMPLEX_MUL_LNEG; COMPLEX_MUL_RNEG; COMPLEX_NEG_NEG] THEN + REWRITE_TAC[COMPLEX_MUL_AC]);; + +(* ------------------------------------------------------------------------- *) +(* Scalar identity: sqrt mJ * (1/mJ) = 1/sqrt mJ (mJ > 0). *) +(* ------------------------------------------------------------------------- *) + +let PHIMST_FHAT = prove + (`!(phi:real->complex) mJ a b y. &0 < mJ /\ schwartz phi + ==> fourier (phimst mJ a b phi) y = + Cx(&1 / sqrt mJ) * cexp(--(ii * Cx a * Cx(y - b))) * fourier phi ((y - + b) / mJ)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[phimst] THEN + MP_TAC(BETA_RULE(ISPECL [`\x. cexp(ii * Cx b * Cx x) * (phi:real->complex)(mJ + * (x - a))`; + `Cx(sqrt mJ)`; `y:real`] FOURIER_LMUL)) THEN + ANTS_TAC THENL + [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MP_TAC(ISPECL [`phi:real->complex`; `mJ:real`; `a:real`; + `b:real`] SCHWARTZ_MODAFFINE) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `y:real` o MATCH_MP SCHWARTZ_MOD_ABSINT) THEN + REWRITE_TAC[]; + DISCH_THEN SUBST1_TAC] THEN + MP_TAC(BETA_RULE(ISPECL [`\x. (phi:real->complex)(mJ * (x - a))`; `b:real`; + `y:real`] + FOURIER_MODULATION)) THEN + DISCH_THEN SUBST1_TAC THEN + MP_TAC(ISPECL [`phi:real->complex`; `mJ:real`; `a:real`; `y - b:real`] + FOURIER_PHI_SCALE_SHIFT) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[COMPLEX_MUL_ASSOC; GSYM CX_MUL] THEN + ASM_SIMP_TAC[SQRT_SCALE_ID]);; + +(* ------------------------------------------------------------------------- *) +(* 286E b(iii): frequency support of phimst. If fhat = fourier phi is *) +(* supported in [c,d], then fourier(phimst mJ a b phi) is supported in *) +(* [b + mJ c, b + mJ d] (support scales by mJ and shifts by b -- exactly the *) +(* frequency-interval transformation of the tile). Immediate from *) +(* PHIMST_FHAT: *) +(* the transform is a NONZERO multiple of fhat((y-b)/mJ). *) +(* ------------------------------------------------------------------------- *) + +let PHIMST_FHAT_SUPPORT = prove + (`!(phi:real->complex) mJ a b c d. &0 < mJ /\ schwartz phi /\ + (!u. u < c \/ d < u ==> fourier phi u = Cx(&0)) + ==> (!y. y < b + mJ * c \/ b + mJ * d < y + ==> fourier (phimst mJ a b phi) y = Cx(&0))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN X_GEN_TAC `y:real` THEN DISCH_TAC THEN + ASM_SIMP_TAC[PHIMST_FHAT] THEN + SUBGOAL_THEN + `fourier (phi:real->complex) ((y - b) / mJ) = Cx(&0)` SUBST1_TAC THENL + [FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `((y:real) - b) / mJ` th)) THEN + ANTS_TAC THENL + [UNDISCH_TAC `y < b + mJ * c \/ b + mJ * d < y` THEN STRIP_TAC THENL + [DISJ1_TAC THEN ASM_SIMP_TAC[REAL_LT_LDIV_EQ] THEN ASM_REAL_ARITH_TAC; + DISJ2_TAC THEN ASM_SIMP_TAC[REAL_LT_RDIV_EQ] THEN ASM_REAL_ARITH_TAC]; + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[COMPLEX_MUL_RZERO]]; + REWRITE_TAC[COMPLEX_MUL_RZERO]]);; + +(* ------------------------------------------------------------------------- *) +(* 286E b(iv), abstract core: two Schwartz functions with DISJOINT frequency *) +(* supports are L^2-orthogonal. If for every u at least one of fhat_f(u), *) +(* ghat(u) vanishes, then = INT f cnj g = 0. Immediate from 284Ob *) +(* (PARSEVAL_SCHWARTZ_BILINEAR): the transform-side integrand is identically *) +(* 0. *) +(* ------------------------------------------------------------------------- *) + +(* ========================================================================= *) + +(* Structural core: the superlevel set of a monotone-const-monotone g is an *) +(* interval. (Order reasoning; the geometric fact that makes the per-level *) +(* maximal-average bound int_{g>=t} f <= gamma mu{g>=t} applicable.) *) +let MCM_SUPERLEVEL_INTERVAL = prove + (`!(gg:real->real) al be t. + al <= be /\ + (!x y. x <= y /\ y <= al ==> gg x <= gg y) /\ + (!x y. be <= x /\ x <= y ==> gg y <= gg x) /\ + (!x. al <= x /\ x <= be ==> gg x = gg al) + ==> is_realinterval {x | t <= gg x}`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 (LABEL_TAC "inc") + (CONJUNCTS_THEN2 (LABEL_TAC "dec") (LABEL_TAC "flat")))) THEN + REWRITE_TAC[is_realinterval; IN_ELIM_THM] THEN + MAP_EVERY X_GEN_TAC [`x1:real`; `x2:real`; `c:real`] THEN STRIP_TAC THEN + ASM_CASES_TAC `c <= al` THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(gg:real->real) x1` THEN + ASM_REWRITE_TAC[] THEN USE_THEN + "inc" (MP_TAC o SPECL [`x1:real`; `c:real`]) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[]]; + ALL_TAC] THEN + ASM_CASES_TAC `be <= c` THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(gg:real->real) x2` THEN + ASM_REWRITE_TAC[] THEN USE_THEN + "dec" (MP_TAC o SPECL [`c:real`; `x2:real`]) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN `(gg:real->real) c = gg al` SUBST1_TAC THENL + [USE_THEN "flat" (MP_TAC o SPEC `c:real`) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[]]; ALL_TAC] THEN + ASM_CASES_TAC `x1 <= al` THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(gg:real->real) x1` THEN + ASM_REWRITE_TAC[] THEN USE_THEN + "inc" (MP_TAC o SPECL [`x1:real`; `al:real`]) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[]]; + SUBGOAL_THEN + `(gg:real->real) x1 = gg al` (fun th -> ASM_MESON_TAC[th]) THEN + USE_THEN "flat" (MP_TAC o SPEC `x1:real`) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[]]]);; + + +let LAYER_CAKE_UNDER_CURVE = prove + (`!g:real^1->real^1 m. + (!x. &0 <= drop(g x)) /\ (g has_integral lift m) (:real^1) + ==> ((\t. lift(measure {x | drop t <= drop(g x) /\ &0 <= drop t})) + has_integral lift m) (:real^1)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `measurable {pastecart x y | y IN interval[vec 0, (g:real^1->real^1) x]}` + ASSUME_TAC THENL + [ASM_MESON_TAC[INTEGRABLE_IFF_MEASURABLE_UNDER_CURVE; integrable_on]; + ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP FUBINI_MEASURE_ALT) THEN STRIP_TAC THEN + SUBGOAL_THEN + `!t. {x:real^1 | pastecart x t IN + {pastecart x y | y IN interval[vec 0,(g:real^1->real^1) + x]}} + = {x | drop t <= drop(g x) /\ &0 <= drop t}` + (fun th -> RULE_ASSUM_TAC(REWRITE_RULE[th])) THENL + [GEN_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_ELIM_PASTECART_THM; + PASTECART_INJ; IN_INTERVAL_1; DROP_VEC] THEN MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `measure {pastecart x y | y IN interval[vec 0, (g:real^1->real^1) x]} = m` + (fun th -> ASM_MESON_TAC[th]) THEN + MP_TAC(ISPECL [`g:real^1->real^1`; + `m:real`] HAS_INTEGRAL_MEASURE_UNDER_CURVE) THEN + ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[HAS_MEASURE_MEASURABLE_MEASURE; HAS_MEASURE_UNIQUE]);; + +(* Real-valued layer-cake: for nonnegative real g integrating to m over R, *) +(* the distribution function t |-> real_measure {x | t <= g x} integrates to *) +(* the same m over (0,inf). This is the M1 workhorse (Fremlin 252O). *) + +let REAL_LAYER_CAKE = prove + (`!g m. (!x. &0 <= g x) /\ (g has_real_integral m) (:real) + ==> ((\t. real_measure {x | t <= g x}) has_real_integral m) {t | &0 < + t}`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o REWRITE_RULE[has_real_integral]) THEN + REWRITE_TAC[IMAGE_LIFT_UNIV] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`lift o g o drop`; `m:real`] LAYER_CAKE_UNDER_CURVE) THEN + ASM_REWRITE_TAC[o_THM; LIFT_DROP] THEN DISCH_TAC THEN + REWRITE_TAC[has_real_integral; o_DEF] THEN + ONCE_REWRITE_TAC[GSYM HAS_INTEGRAL_RESTRICT_UNIV] THEN + MATCH_MP_TAC HAS_INTEGRAL_SPIKE THEN + EXISTS_TAC `(\t. lift (measure {x | drop t <= g (drop x) /\ &0 <= drop t})) + :real^1->real^1` THEN + EXISTS_TAC `{lift(&0)}` THEN + ASM_REWRITE_TAC[NEGLIGIBLE_SING] THEN + REWRITE_TAC[IN_DIFF; IN_SING; IN_IMAGE_LIFT_DROP; IN_ELIM_THM; IN_UNIV] THEN + X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN + SUBGOAL_THEN `~(drop t = &0)` ASSUME_TAC THENL + [ASM_MESON_TAC[LIFT_DROP]; ALL_TAC] THEN + SUBGOAL_THEN `{x | drop t <= g (drop x) /\ &0 <= drop t} = + if &0 < drop t then IMAGE lift {x | drop t <= g x} else {}` + SUBST1_TAC THENL + [COND_CASES_TAC THEN + REWRITE_TAC[EXTENSION; IN_IMAGE_LIFT_DROP; IN_ELIM_THM; NOT_IN_EMPTY] THEN + GEN_TAC THEN REWRITE_TAC[GSYM DROP_EQ; LIFT_DROP] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + COND_CASES_TAC THEN + ASM_REWRITE_TAC[MEASURE_EMPTY; LIFT_NUM; GSYM REAL_MEASURE_MEASURE]);; + +(* ========================================================================= *) +(* Rising-sun infrastructure for the maximal theorem (Fremlin 286A(b)). *) +(* *) +(* The heart of the weak-type bound is a rising-sun argument. We package it *) +(* as a clean statement about continuous functions: if every interior point *) +(* of [a,b] is "in shadow" (some later point has a strictly larger value), *) +(* then the left endpoint value does not exceed the right endpoint value. *) +(* Applied to F(x) = int_a^x f - t*(x-a), the shadow condition is exactly *) +(* the running-average maximal condition and the conclusion is the desired *) +(* interval bound int_a^b f >= t*(b-a). *) +(* ========================================================================= *) + +(* The upper level set {x in [a,b] | c <= ff x} of a continuous ff is *) +(* real_compact (closed sublevel of a continuous fn, intersect a compact). *) + +let REAL_COMPACT_UPPER_LEVEL = prove + (`!ff a b c. ff real_continuous_on real_interval[a,b] + ==> real_compact {x | x IN real_interval[a,b] /\ c <= ff x}`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[real_compact; COMPACT_EQ_BOUNDED_CLOSED] THEN + CONJ_TAC THENL + [MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `interval[lift a,lift b]` THEN + REWRITE_TAC[BOUNDED_INTERVAL; GSYM IMAGE_LIFT_REAL_INTERVAL] THEN + SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `closed {y:real^1 | c <= drop y}` ASSUME_TAC THENL + [REWRITE_TAC[drop; GSYM real_ge; CLOSED_HALFSPACE_COMPONENT_GE]; + ALL_TAC] THEN + SUBGOAL_THEN + `IMAGE lift {x | x IN real_interval[a,b] /\ c <= ff x} = + {z | z IN IMAGE lift (real_interval[a,b]) /\ + (lift o (ff:real->real) o drop) z IN {y:real^1 | c <= drop y}}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM; o_THM; LIFT_DROP] THEN + MESON_TAC[LIFT_DROP]; ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE THEN ASM_REWRITE_TAC[ETA_AX] THEN + ASM_REWRITE_TAC[GSYM REAL_CONTINUOUS_ON; IMAGE_LIFT_REAL_INTERVAL; + CLOSED_INTERVAL]);; + +(* The rising-sun lemma. Take the largest maximizer x0 of ff on [a,b]; if x0 *) +(* < b the shadow condition produces a strictly larger value, contradicting *) +(* maximality, so x0 = b and ff a <= ff c = ff x0 = ff b. *) + +let RISING_SUN = prove + (`!ff a b. + a <= b /\ ff real_continuous_on real_interval[a,b] /\ + (!x. a <= x /\ x < b ==> ?d. x < d /\ d <= b /\ ff x < ff d) + ==> ff a <= ff b`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`ff:real->real`; `real_interval[a,b]`] + REAL_CONTINUOUS_ATTAINS_SUP) THEN + ASM_REWRITE_TAC[REAL_COMPACT_INTERVAL; REAL_INTERVAL_EQ_EMPTY; + REAL_NOT_LT] THEN + DISCH_THEN(X_CHOOSE_THEN `c:real` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`ff:real->real`; `a:real`; `b:real`; `ff(c:real):real`] + REAL_COMPACT_UPPER_LEVEL) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`\x:real. x`; `{x | x IN real_interval[a,b] /\ ff c <= ff x}`] + REAL_CONTINUOUS_ATTAINS_SUP) THEN + ASM_REWRITE_TAC[REAL_CONTINUOUS_ON_ID] THEN + ANTS_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + EXISTS_TAC `c:real` THEN ASM_REWRITE_TAC[REAL_LE_REFL]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `x0:real` STRIP_ASSUME_TAC) THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_ELIM_THM; IN_REAL_INTERVAL]) THEN + SUBGOAL_THEN `ff(x0:real):real = ff c` ASSUME_TAC THENL + [ASM_MESON_TAC[REAL_LE_ANTISYM]; ALL_TAC] THEN + SUBGOAL_THEN `ff(a:real):real <= ff c` ASSUME_TAC THENL + [FIRST_X_ASSUM(fun th -> MATCH_MP_TAC th) THEN + ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `~(x0:real < b)` ASSUME_TAC THENL + [DISCH_TAC THEN + UNDISCH_TAC `!x. a <= x /\ x < b ==> ?d. x < d /\ d <= b /\ ff x < ff d` + THEN + DISCH_THEN(MP_TAC o SPEC `x0:real`) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `ff(d:real) <= ff c` MP_TAC THENL + [FIRST_X_ASSUM(fun th -> MATCH_MP_TAC th) THEN ASM_REAL_ARITH_TAC; + ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN `x0:real = b` SUBST_ALL_TAC THENL + [ASM_REAL_ARITH_TAC; ASM_REAL_ARITH_TAC]);; + +(* The integral form of the rising-sun bound (Fremlin 286A(b), part gamma): *) +(* if throughout (x,b) there is a later point d with average of f exceeding *) +(* t, *) +(* i.e. (d-x)*t < int_[x,d] f, then int_[a,b] f >= (b-a)*t. Obtained from *) +(* RISING_SUN with ff x = int_[a,x] f - t*(x-a) (continuous; shadow <=> *) +(* the maximal condition via integral additivity). *) + +let MAXIMAL_INTERVAL_BOUND = prove + (`!f t a b. + f real_integrable_on real_interval[a,b] /\ a < b /\ + (!x. a <= x /\ x < b + ==> ?d. x < d /\ d <= b /\ + (d - x) * t < real_integral (real_interval[x,d]) f) + ==> (b - a) * t <= real_integral (real_interval[a,b]) f`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`\x. real_integral (real_interval[a,x]) f - t * (x - a)`; + `a:real`; `b:real`] RISING_SUN) THEN + REWRITE_TAC[] THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_CONTINUOUS_ON_SUB THEN CONJ_TAC THENL + [ASM_SIMP_TAC[REAL_INDEFINITE_INTEGRAL_CONTINUOUS_RIGHT]; + MATCH_MP_TAC REAL_CONTINUOUS_ON_MUL THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_CONST] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_SUB THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_ID; REAL_CONTINUOUS_ON_CONST]]; + X_GEN_TAC `x:real` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`f:real->real`; `a:real`; `d:real`; `x:real`] + REAL_INTEGRAL_COMBINE) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_INTEGRABLE_SUBINTERVAL THEN + MAP_EVERY EXISTS_TAC [`a:real`; `b:real`] THEN + ASM_REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC]; + DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_REAL_ARITH_TAC]]; + ALL_TAC] THEN + SUBGOAL_THEN + `real_integral (real_interval[a:real,a]) f = &0` SUBST1_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN REWRITE_TAC[HAS_REAL_INTEGRAL_REFL]; + ALL_TAC] THEN + REAL_ARITH_TAC);; + +(* The running integral x |-> int_[x,a] f (lower limit varying) is *) +(* continuous at any point x0 < a. Obtained from *) +(* REAL_INDEFINITE_INTEGRAL_CONTINUOUS_LEFT on a neighbourhood [x0-1,a], *) +(* upgrading within-continuity at the interior point x0 to atreal-continuity *) +(* (delta shrunk to keep inside the interval). *) + +let RUNNING_INTEGRAL_CONTINUOUS = prove + (`!f a x0. f real_integrable_on (:real) /\ x0 < a + ==> (\x. real_integral (real_interval[x,a]) f) real_continuous (atreal + x0)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:real->real`; `x0 - &1`; `a:real`] + REAL_INDEFINITE_INTEGRAL_CONTINUOUS_LEFT) THEN + ANTS_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `(:real)` THEN ASM_REWRITE_TAC[SUBSET_UNIV]; ALL_TAC] THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + DISCH_THEN(MP_TAC o SPEC `x0:real`) THEN + ANTS_TAC THENL [REWRITE_TAC[IN_REAL_INTERVAL] THEN + ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[real_continuous_withinreal; real_continuous_atreal] THEN + DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `min d (min (&1) (a - x0))` THEN + ASM_REWRITE_TAC[REAL_LT_MIN; REAL_LT_01] THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + X_GEN_TAC `x':real` THEN STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[IN_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC);; + +(* The superlevel set of the one-sided maximal function is open (Fremlin *) +(* 286A(b)(i)). Stated as Fremlin's G_t without any sup: the set of x from *) +(* which some later point a gives above-threshold average of f. Openness is *) +(* pointwise continuity of x |-> int_[x,a] f - (a-x)*t (positive at x0, so *) +(* positive nearby). *) + +let MAXIMAL_SUPERLEVEL_OPEN = prove + (`!f t. f real_integrable_on (:real) /\ &0 < t + ==> real_open {x | ?a. x < a /\ + (a - x) * t < real_integral (real_interval[x,a]) + f}`, + REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_OPEN; open_def] THEN + REWRITE_TAC[FORALL_IN_IMAGE; IN_ELIM_THM; FORALL_LIFT; DIST_LIFT] THEN + X_GEN_TAC `x0:real` THEN DISCH_THEN(X_CHOOSE_THEN + `a:real` STRIP_ASSUME_TAC) THEN + REWRITE_TAC[LIFT_IN_IMAGE_LIFT; IN_ELIM_THM] THEN + SUBGOAL_THEN + `(\x. real_integral (real_interval[x,a]) f - (a - x) * t) real_continuous + (atreal x0)` + MP_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_SUB THEN CONJ_TAC THENL + [MATCH_MP_TAC RUNNING_INTEGRAL_CONTINUOUS THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_CONTINUOUS_MUL THEN + REWRITE_TAC[REAL_CONTINUOUS_CONST] THEN + MATCH_MP_TAC REAL_CONTINUOUS_SUB THEN + REWRITE_TAC[REAL_CONTINUOUS_CONST; REAL_CONTINUOUS_AT_ID]]; + ALL_TAC] THEN + REWRITE_TAC[real_continuous_atreal; REALLIM_ATREAL] THEN + DISCH_THEN(MP_TAC o SPEC + `real_integral (real_interval[x0,a]) f - (a - x0) * t`) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `min d (a - x0)` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + X_GEN_TAC `x':real` THEN STRIP_TAC THEN EXISTS_TAC `a:real` THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x':real`) THEN ASM_REAL_ARITH_TAC);; + +(* The per-component interval bound (Fremlin 286A(b)(ii), parts *) +(* alpha-gamma): *) +(* if (a,b) is a component interval of the superlevel set G_t -- i.e. every *) +(* interior point is in G_t, and the right endpoint b is not (stated as the *) +(* one-sided condition int_[b,c] f <= (c-b)*t for all c > b) -- then *) +(* (b - a) * t <= int_[a,b] f. *) +(* Proof: (alpha) the shadow witness for an interior x can be capped at b, *) +(* using b notin G_t and integral additivity; (beta) MAXIMAL_INTERVAL_BOUND *) +(* on *) +(* [z,b] gives (b-z)*t <= int_[z,b] f for each z in (a,b); (gamma) let z -> *) +(* a *) +(* (REALLIM_LE with RUNNING_INTEGRAL_CONTINUOUS). *) + +let MAXIMAL_COMPONENT_BOUND = prove + (`!f t a b. + f real_integrable_on (:real) /\ &0 < t /\ a < b /\ + (!x. a < x /\ x < b + ==> ?c. x < c /\ (c - x) * t < real_integral (real_interval[x,c]) f) + /\ + (!c. b < c ==> real_integral (real_interval[b,c]) f <= (c - b) * t) + ==> (b - a) * t <= real_integral (real_interval[a,b]) f`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 (LABEL_TAC "interior") (LABEL_TAC "bnotin"))))) THEN + SUBGOAL_THEN + `!z. a < z /\ z < b ==> (b - z) * t <= real_integral (real_interval[z,b]) f` + ASSUME_TAC THENL + [X_GEN_TAC `z:real` THEN STRIP_TAC THEN + MP_TAC(ISPECL [`f:real->real`; `t:real`; `z:real`; `b:real`] + MAXIMAL_INTERVAL_BOUND) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `(:real)` THEN ASM_REWRITE_TAC[SUBSET_UNIV]; ALL_TAC] THEN + X_GEN_TAC `x:real` THEN STRIP_TAC THEN + SUBGOAL_THEN `a < x /\ x < b` STRIP_ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + USE_THEN "interior" (fun th -> MP_TAC(SPEC `x:real` th)) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `c:real` STRIP_ASSUME_TAC) THEN + ASM_CASES_TAC `c:real <= b` THENL + [EXISTS_TAC `c:real` THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC; ALL_TAC] THEN + EXISTS_TAC `b:real` THEN + REPEAT CONJ_TAC THENL [ASM_REAL_ARITH_TAC; REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPECL [`f:real->real`; `x:real`; `c:real`; `b:real`] + REAL_INTEGRAL_COMBINE) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `(:real)` THEN ASM_REWRITE_TAC[SUBSET_UNIV]]; ALL_TAC] THEN + USE_THEN "bnotin" (fun th -> MP_TAC(SPEC `c:real` th)) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_TAC THEN DISCH_THEN(MP_TAC o SYM) THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(ISPECL [`atreal a within real_interval[a,b]`; + `\z:real. (b - z) * t`; + `\z:real. real_integral (real_interval[z,b]) (f:real->real)`] REALLIM_LE) + THEN + REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC REALLIM_MUL THEN REWRITE_TAC[REALLIM_CONST] THEN + MATCH_MP_TAC REALLIM_SUB THEN + REWRITE_TAC[REALLIM_CONST; REALLIM_WITHINREAL_ID]; + MP_TAC(ISPECL [`f:real->real`; `b:real`; + `a:real`] RUNNING_INTEGRAL_CONTINUOUS) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `real_interval[a,b]` o + MATCH_MP REAL_CONTINUOUS_ATREAL_WITHINREAL) THEN + REWRITE_TAC[REAL_CONTINUOUS_WITHINREAL]; + MP_TAC(ISPECL [`real_interval[a,b]`; + `a:real`] TRIVIAL_LIMIT_WITHIN_REALINTERVAL) THEN + ANTS_TAC THENL + [REWRITE_TAC[IN_REAL_INTERVAL] THEN CONJ_TAC THENL + [REWRITE_TAC[IS_REALINTERVAL_CONNECTED; IMAGE_LIFT_REAL_INTERVAL; + CONNECTED_INTERVAL]; + ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[EXTENSION; IN_REAL_INTERVAL; IN_SING; NOT_FORALL_THM] THEN + EXISTS_TAC `b:real` THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[EVENTUALLY_WITHINREAL; IN_REAL_INTERVAL] THEN + EXISTS_TAC `(b:real) - a` THEN ASM_REWRITE_TAC[REAL_SUB_LT] THEN + X_GEN_TAC `z:real` THEN STRIP_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* The one-dimensional Hardy-Littlewood maximal function (Fremlin 286A). *) +(* f*(x) = sup of the average of |f| over intervals [a,b] containing x. *) +(* ------------------------------------------------------------------------- *) + +let hl_maximal = new_definition + `hl_maximal (f:real->real) x = + sup {real_integral (real_interval[a,b]) (\t. abs(f t)) / (b - a) + | a,b | a <= x /\ x <= b /\ a < b}`;; + +(* The one-sided (forward) maximal function f1*(x) = sup over intervals *) +(* [x,a] *) +(* to the RIGHT of x. Its superlevel set {x | u < f1* x} is Fremlin's G_u. *) +(* CAVEAT: the average set can be unbounded above (near an L^1 spike), where *) +(* HOL's sup returns junk; so only the FORWARD inclusion {f1*>u} SUBSET G_u *) +(* is junk-free (HL_FWD_SUPERLEVEL_SUB). The two agree up to a NULL set (the *) +(* unbounded locus, contained in every G_u hence of measure 0 by the *) +(* weak-type *) +(* bound), which is all the layer-cake needs. *) +let hl_maximal_fwd = new_definition + `hl_maximal_fwd (f:real->real) x = + sup {real_integral (real_interval[x,a]) f / (a - x) | a | x < a}`;; + +(* Junk-free forward inclusion: {x | u < f1* x} SUBSET G_u. Proved by *) +(* contrapositive -- if x is NOT in G_u then every average is <= u, so the *) +(* sup *) +(* (now genuinely bounded above by u) is <= u. *) +let HL_FWD_SUPERLEVEL_SUB = prove + (`!f u x. u < hl_maximal_fwd f x + ==> (?a. x < a /\ (a - x) * u < real_integral (real_interval[x,a]) + f)`, + REPEAT GEN_TAC THEN GEN_REWRITE_TAC I [GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[NOT_EXISTS_THM; REAL_NOT_LT; DE_MORGAN_THM] THEN DISCH_TAC THEN + REWRITE_TAC[hl_maximal_fwd] THEN MATCH_MP_TAC REAL_SUP_LE THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + MAP_EVERY EXISTS_TAC + [`real_integral (real_interval[x,x + &1]) f / (x + &1 - x)`; + `x + &1`] THEN + REWRITE_TAC[] THEN REAL_ARITH_TAC; + REWRITE_TAC[FORALL_IN_GSPEC] THEN X_GEN_TAC `a:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `a:real`) THEN + ASM_SIMP_TAC[REAL_ARITH `x < a ==> ~(a <= x)`] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_SUB_LT]]);; + +(* Under a uniform bound |f| <= M, the one-sided maximal function is bounded *) +(* by M everywhere (each average of things <= M is <= M; *) +(* REAL_INTEGRAL_UBOUND). Hence f1* is FINITE, the sup-junk locus is empty, *) +(* and the reverse superlevel inclusion G_u SUBSET {f1*>u} holds -- giving *) +(* the full biconditional needed for the layer-cake to see genuine bounded *) +(* interval sections. *) +let HL_FWD_BOUNDED = prove + (`!f:real->real M. f real_integrable_on (:real) /\ (!x. abs(f x) <= M) + ==> !x. hl_maximal_fwd f x <= M`, + REPEAT GEN_TAC THEN STRIP_TAC THEN GEN_TAC THEN + REWRITE_TAC[hl_maximal_fwd] THEN MATCH_MP_TAC REAL_SUP_LE THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + MAP_EVERY EXISTS_TAC + [`real_integral (real_interval[x,x + &1]) f / (x + &1 - x)`; + `x + &1`] THEN + REWRITE_TAC[] THEN REAL_ARITH_TAC; + REWRITE_TAC[FORALL_IN_GSPEC] THEN X_GEN_TAC `a:real` THEN DISCH_TAC THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_SUB_LT] THEN + MATCH_MP_TAC REAL_INTEGRAL_UBOUND THEN REPEAT CONJ_TAC THENL + [ASM_SIMP_TAC[REAL_LT_IMP_LE]; + MATCH_MP_TAC REAL_INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `(:real)` THEN + ASM_REWRITE_TAC[SUBSET_UNIV]; + GEN_TAC THEN DISCH_TAC THEN + FIRST_X_ASSUM(fun th -> if concl th = `!x. abs((f:real->real) x) <= M` + then MP_TAC(SPEC `x':real` th) else NO_TAC) THEN REAL_ARITH_TAC]]);; + +(* Reverse superlevel inclusion (needs boundedness): if x IN G_u -- i.e. *) +(* some *) +(* right-average exceeds u -- then u < f1*(x). That average is a member of *) +(* the *) +(* sup-set which, under |f| <= M, is bounded above by M (REAL_LE_SUP *) +(* applies). *) +(* With HL_FWD_SUPERLEVEL_SUB this gives the biconditional {x | u < f1* x} = *) +(* G_u. *) +let HL_FWD_SUPERLEVEL_SUPER = prove + (`!f:real->real M u x. f real_integrable_on (:real) /\ (!x. abs(f x) <= M) /\ + (?a. x < a /\ (a - x) * u < real_integral (real_interval[x,a]) f) + ==> u < hl_maximal_fwd f x`, + REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[hl_maximal_fwd] THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN + EXISTS_TAC `real_integral (real_interval[x,a]) f / (a - x)` THEN + CONJ_TAC THENL + [ASM_SIMP_TAC[REAL_LT_RDIV_EQ; REAL_SUB_LT] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LE_SUP THEN + MAP_EVERY EXISTS_TAC + [`M:real`; `real_integral (real_interval[x,a]) f / (a - x)`] THEN + REWRITE_TAC[REAL_LE_REFL] THEN CONJ_TAC THENL + [REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `a:real` THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[FORALL_IN_GSPEC] THEN X_GEN_TAC `b:real` THEN DISCH_TAC THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_SUB_LT] THEN + MATCH_MP_TAC REAL_INTEGRAL_UBOUND THEN REPEAT CONJ_TAC THENL + [ASM_SIMP_TAC[REAL_LT_IMP_LE]; + MATCH_MP_TAC REAL_INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `(:real)` THEN + ASM_REWRITE_TAC[SUBSET_UNIV]; + GEN_TAC THEN DISCH_TAC THEN + FIRST_X_ASSUM(fun th -> if concl th = `!x. abs((f:real->real) x) <= M` + then MP_TAC(SPEC `x':real` th) else NO_TAC) THEN + REAL_ARITH_TAC]]]);; + +(* f >= 0 (and bounded) ==> f1* >= 0: the [x,x+1] average is >= 0 and, being *) +(* a member of the (bounded) sup-set, is <= f1*(x). *) +let HL_FWD_POS = prove + (`!f:real->real M. f real_integrable_on (:real) /\ (!x. &0 <= f x) /\ (!x. + abs(f x) <= M) + ==> !x. &0 <= hl_maximal_fwd f x`, + REPEAT GEN_TAC THEN STRIP_TAC THEN GEN_TAC THEN + REWRITE_TAC[hl_maximal_fwd] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `real_integral (real_interval[x,x + &1]) f / ((x + &1) - x)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_DIV THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_POS THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `(:real)` THEN + ASM_REWRITE_TAC[SUBSET_UNIV]; + ASM_REWRITE_TAC[]]; + REAL_ARITH_TAC]; + MATCH_MP_TAC REAL_LE_SUP THEN + MAP_EVERY EXISTS_TAC [`M:real`; + `real_integral (real_interval[x,x + &1]) f / ((x + &1) - x)`] THEN + REWRITE_TAC[REAL_LE_REFL] THEN CONJ_TAC THENL + [REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `x + &1` THEN REWRITE_TAC[] THEN + REAL_ARITH_TAC; + REWRITE_TAC[FORALL_IN_GSPEC] THEN X_GEN_TAC `b:real` THEN DISCH_TAC THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_SUB_LT] THEN + MATCH_MP_TAC REAL_INTEGRAL_UBOUND THEN REPEAT CONJ_TAC THENL + [ASM_SIMP_TAC[REAL_LT_IMP_LE]; + MATCH_MP_TAC REAL_INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `(:real)` THEN + ASM_REWRITE_TAC[SUBSET_UNIV]; + GEN_TAC THEN DISCH_TAC THEN + FIRST_X_ASSUM(fun th -> if concl th = `!x. abs((f:real->real) x) <= M` + then MP_TAC(SPEC `x':real` th) else NO_TAC) THEN + REAL_ARITH_TAC]]]);; + +(* The running integral x |-> int_[x,a] f, lifted to a real^1->real^1 map, *) +(* is continuous at y0 whenever drop y0 < a (bridges RUNNING_INTEGRAL_ *) +(* CONTINUOUS to the vector world for the 2D region-openness argument). *) +let RUNNING_INTEGRAL_CONTINUOUS_LIFT = prove + (`!f a y0:real^1. f real_integrable_on (:real) /\ drop y0 < a + ==> (\y:real^1. lift(real_integral (real_interval[drop y, a]) f)) continuous + (at y0)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:real->real`; `a:real`; + `drop(y0:real^1)`] RUNNING_INTEGRAL_CONTINUOUS) THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[real_continuous_atreal; CONTINUOUS_AT; REALLIM_ATREAL; + LIM_AT] THEN + REWRITE_TAC[DIST_LIFT; o_THM; DIST_REAL; GSYM drop] THEN + DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `y:real^1` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `drop(y:real^1)`) THEN + ASM_REWRITE_TAC[GSYM DIST_REAL; DIST_LIFT; LIFT_DROP] THEN + ASM_REWRITE_TAC[dist; GSYM DROP_SUB; GSYM NORM_LIFT; LIFT_DROP]);; + +(* The 2D region S = {(x,u) | 0 < u /\ x IN G_u} whose 2u-weighted integral *) +(* gives the p=2 layer-cake is OPEN. For each fixed a the set *) +(* {z | z$1 < a /\ (a - z$1)*z$2 < int_[z$1,a] f} *) +(* is the strict-positivity set of the continuous function *) +(* Phi(z) = int_[z$1,a] f - (a - z$1)*z$2 (running-integral continuity in *) +(* z$1 lifted + composed, times the polynomial z$2 part), and S is the union *) +(* over a intersected with the open halfspace {z$2 > 0}. Openness makes S *) +(* measurable for FREE -- no measurability of the (sup-junky) f1* needed. *) +let MAXIMAL_REGION_OPEN_FS = prove + (`!f:real->real. f real_integrable_on (:real) + ==> open {z:real^(1,1)finite_sum | &0 < drop(sndcart z) /\ + ?a. drop(fstcart z) < a /\ + (a - drop(fstcart z)) * drop(sndcart z) < + real_integral (real_interval[drop(fstcart z),a]) f}`, + REPEAT STRIP_TAC THEN REWRITE_TAC[OPEN_CONTAINS_BALL] THEN + X_GEN_TAC `z0:real^(1,1)finite_sum` THEN REWRITE_TAC[IN_ELIM_THM] THEN + STRIP_TAC THEN + SUBGOAL_THEN + `(\z:real^(1,1)finite_sum. + lift(real_integral (real_interval[drop(fstcart z), a]) f - + (a - drop(fstcart z)) * drop(sndcart z))) continuous (at z0)` + MP_TAC THENL + [REWRITE_TAC[LIFT_SUB] THEN MATCH_MP_TAC CONTINUOUS_SUB THEN CONJ_TAC THENL + [SUBGOAL_THEN + `(\z:real^(1,1)finite_sum. lift(real_integral + (real_interval[drop(fstcart z), a]) f)) = + (\y:real^1. lift(real_integral (real_interval[drop y, a]) f)) o + fstcart` + SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM; o_THM]; ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_AT_COMPOSE THEN CONJ_TAC THENL + [SIMP_TAC[LINEAR_CONTINUOUS_AT; LINEAR_FSTCART]; + MATCH_MP_TAC RUNNING_INTEGRAL_CONTINUOUS_LIFT THEN ASM_REWRITE_TAC[]]; + REWRITE_TAC[LIFT_CMUL] THEN MATCH_MP_TAC CONTINUOUS_MUL THEN + CONJ_TAC THENL + [REWRITE_TAC[o_DEF; LIFT_SUB] THEN MATCH_MP_TAC CONTINUOUS_SUB THEN + REWRITE_TAC[CONTINUOUS_CONST] THEN + SUBGOAL_THEN + `(\z:real^(1,1)finite_sum. lift(drop(fstcart z))) = + fstcart` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; LIFT_DROP]; ALL_TAC] THEN + SIMP_TAC[LINEAR_CONTINUOUS_AT; LINEAR_FSTCART]; + SUBGOAL_THEN + `(\z:real^(1,1)finite_sum. lift(drop(sndcart z))) = + sndcart` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; LIFT_DROP]; ALL_TAC] THEN + SIMP_TAC[LINEAR_CONTINUOUS_AT; LINEAR_SNDCART]]]; + ALL_TAC] THEN + REWRITE_TAC[CONTINUOUS_AT; LIM_AT; DIST_LIFT] THEN + DISCH_THEN(MP_TAC o SPEC + `real_integral (real_interval[drop(fstcart(z0:real^(1,1)finite_sum)), a]) f + - + (a - drop(fstcart z0)) * drop(sndcart z0)`) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `d1:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `min d1 (min (drop(sndcart(z0:real^(1,1)finite_sum))) (a - + drop(fstcart z0)))` THEN + REWRITE_TAC[REAL_LT_MIN] THEN CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[SUBSET; IN_BALL; IN_ELIM_THM] THEN + X_GEN_TAC `z:real^(1,1)finite_sum` THEN DISCH_TAC THEN + SUBGOAL_THEN + `drop(fstcart(z:real^(1,1)finite_sum)) < a /\ &0 < drop(sndcart z) /\ + dist(z0:real^(1,1)finite_sum,z) < d1` STRIP_ASSUME_TAC THENL + [MP_TAC(ISPECL [`z - z0:real^(1,1)finite_sum`; `1`] COMPONENT_LE_NORM) THEN + MP_TAC(ISPECL [`z - z0:real^(1,1)finite_sum`; `2`] COMPONENT_LE_NORM) THEN + REWRITE_TAC[DIMINDEX_FINITE_SUM; DIMINDEX_1; ARITH; + VECTOR_SUB_COMPONENT] THEN + SUBGOAL_THEN + `!w:real^(1,1)finite_sum. w$1 = drop(fstcart w) /\ w$2 = drop(sndcart w)` + (fun th -> REWRITE_TAC[th]) THENL + [GEN_TAC THEN REWRITE_TAC[drop] THEN + SIMP_TAC[FSTCART_COMPONENT; SNDCART_COMPONENT; DIMINDEX_1; ARITH]; + ALL_TAC] THEN + SUBGOAL_THEN + `norm(z - z0:real^(1,1)finite_sum) = dist(z0,z)` SUBST1_TAC THENL + [REWRITE_TAC[dist; NORM_SUB]; ALL_TAC] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN EXISTS_TAC `a:real` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `z:real^(1,1)finite_sum = z0` THENL + [ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `z:real^(1,1)finite_sum`) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[GSYM DIST_NZ] THEN + ASM_MESON_TAC[DIST_SYM]; ALL_TAC] THEN + ASM_REAL_ARITH_TAC);; + +(* ========================================================================= *) +(* Hardy-Littlewood maximal estimates (Fremlin 286A). *) +(* *) +(* Fremlin's 1D proof needs NO Vitali covering: the superlevel set *) +(* G_t = {x : f1*(x) > t} is open, hence a countable union of intervals, *) +(* and a rising-sun argument bounds each. Combined with the layer-cake *) +(* identity (Fremlin 252O) and Fubini. *) +(* ========================================================================= *) + +(* ------------------------------------------------------------------------- *) +(* Summation infrastructure for the weak-type bound. *) +(* ------------------------------------------------------------------------- *) + +(* Integral over a finite disjoint union splits as a sum of integrals. *) + +let REAL_INTEGRAL_DISJOINT_UNIONS = prove + (`!f D. FINITE D /\ (!C:real->bool. C IN D ==> f real_integrable_on C) /\ + (!C C'. C IN D /\ C' IN D /\ ~(C = C') ==> DISJOINT C C') + ==> real_integral (UNIONS D) f = sum D (\C. real_integral C f)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + MP_TAC(ISPECL [`f:real->real`; `\C:real->bool. real_integral C f`; + `D:(real->bool)->bool`] HAS_REAL_INTEGRAL_UNIONS) THEN + REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [ASM_SIMP_TAC[GSYM REAL_INTEGRABLE_INTEGRAL]; + MAP_EVERY X_GEN_TAC [`C:real->bool`; `C':real->bool`] THEN STRIP_TAC THEN + REWRITE_TAC[real_negligible] THEN + SUBGOAL_THEN `C INTER C':real->bool = {}` (fun th -> REWRITE_TAC[th]) THENL + [ASM_MESON_TAC[DISJOINT]; REWRITE_TAC[IMAGE_CLAUSES; + NEGLIGIBLE_EMPTY]]]);; + +(* Integrability on a finite disjoint union, from integrability on each *) +(* piece. *) + +let REAL_INTEGRABLE_DISJOINT_UNIONS = prove + (`!f D. FINITE D /\ (!C:real->bool. C IN D ==> f real_integrable_on C) /\ + (!C C'. C IN D /\ C' IN D /\ ~(C = C') ==> DISJOINT C C') + ==> f real_integrable_on (UNIONS D)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[real_integrable_on] THEN + EXISTS_TAC `sum D (\C. real_integral C (f:real->real))` THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_UNIONS THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [ASM_SIMP_TAC[GSYM REAL_INTEGRABLE_INTEGRAL]; + MAP_EVERY X_GEN_TAC [`C:real->bool`; `C':real->bool`] THEN STRIP_TAC THEN + REWRITE_TAC[real_negligible] THEN + SUBGOAL_THEN `C INTER C':real->bool = {}` (fun th -> REWRITE_TAC[th]) THENL + [ASM_MESON_TAC[DISJOINT]; REWRITE_TAC[IMAGE_CLAUSES; + NEGLIGIBLE_EMPTY]]]);; + +(* Finite-union core of the weak-type bound: if D is a finite disjoint *) +(* family *) +(* of measurable sets, each with t*measure(C) <= int_C f, then the same *) +(* bound *) +(* holds for their union. (Summed via SUM_LE.) *) + +let WEAK_TYPE_FINITE_CORE = prove + (`!f t D. + FINITE D /\ + (!C. C IN D ==> f real_integrable_on C /\ real_measurable C /\ + t * real_measure C <= real_integral C f) /\ + (!C C'. C IN D /\ C' IN D /\ ~(C = C') ==> DISJOINT C C') + ==> t * real_measure (UNIONS D) <= real_integral (UNIONS D) f`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\C:real->bool. real_measure C`; `D:(real->bool)->bool`] + REAL_MEASURE_DISJOINT_UNIONS) THEN + ASM_SIMP_TAC[HAS_REAL_MEASURE_REAL_MEASURABLE_REAL_MEASURE] THEN + DISCH_THEN SUBST1_TAC THEN + MP_TAC(ISPECL [`f:real->real`; `D:(real->bool)->bool`] + REAL_INTEGRAL_DISJOINT_UNIONS) THEN + ASM_SIMP_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[GSYM SUM_LMUL] THEN MATCH_MP_TAC SUM_LE THEN + ASM_SIMP_TAC[]);; + +(* A real number bounded above by y + e for every positive e is at most y. *) + +let REAL_LE_EPSILON = prove + (`!x y. (!e. &0 < e ==> x <= y + e) ==> x <= y`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH + `~(x > y) ==> x <= y`) THEN REWRITE_TAC[real_gt] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(x - y) / &2`) THEN + ASM_REAL_ARITH_TAC);; + +(* Inner regularity at the real level: a real_measurable set is approximated *) +(* from within by compact subsets (bridged from MEASURABLE_INNER_COMPACT). *) + +let REAL_MEASURABLE_INNER_COMPACT = prove + (`!s e. real_measurable s /\ &0 < e + ==> ?k. real_compact k /\ k SUBSET s /\ real_measurable k /\ + real_measure s < real_measure k + e`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`IMAGE lift s`; `e:real`] MEASURABLE_INNER_COMPACT) THEN + ASM_REWRITE_TAC[GSYM REAL_MEASURABLE_MEASURABLE] THEN + DISCH_THEN(X_CHOOSE_THEN `k:real^1->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `IMAGE drop k` THEN + SUBGOAL_THEN `IMAGE lift (IMAGE drop k) = k` ASSUME_TAC THENL + [REWRITE_TAC[GSYM IMAGE_o; o_DEF; LIFT_DROP] THEN + REWRITE_TAC[IMAGE_ID] THEN ASM SET_TAC[LIFT_DROP]; + ALL_TAC] THEN + ASM_REWRITE_TAC[real_compact; REAL_MEASURABLE_MEASURABLE; + REAL_MEASURE_MEASURE] THEN + RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; IN_IMAGE]) THEN + REWRITE_TAC[SUBSET; IN_IMAGE] THEN ASM_MESON_TAC[LIFT_DROP]);; + +(* Unbounded real intervals (half-lines and the whole line) are not *) +(* real_bounded. *) + +let NOT_RBOUNDED_GT = prove + (`~real_bounded {x | a < x}`, + REWRITE_TAC[REAL_BOUNDED_POS_LT; NOT_EXISTS_THM] THEN GEN_TAC THEN + REWRITE_TAC[TAUT `~(p /\ q) <=> p ==> ~q`; NOT_FORALL_THM] THEN + DISCH_TAC THEN + EXISTS_TAC `abs a + b + &1` THEN REWRITE_TAC[IN_ELIM_THM; NOT_IMP] THEN + ASM_REAL_ARITH_TAC);; + +let NOT_RBOUNDED_GE = prove + (`~real_bounded {x | a <= x}`, + REWRITE_TAC[REAL_BOUNDED_POS_LT; NOT_EXISTS_THM] THEN GEN_TAC THEN + REWRITE_TAC[TAUT `~(p /\ q) <=> p ==> ~q`; NOT_FORALL_THM] THEN + DISCH_TAC THEN + EXISTS_TAC `abs a + b + &1` THEN REWRITE_TAC[IN_ELIM_THM; NOT_IMP] THEN + ASM_REAL_ARITH_TAC);; + +let NOT_RBOUNDED_LT = prove + (`~real_bounded {x | x < b}`, + REWRITE_TAC[REAL_BOUNDED_POS_LT; NOT_EXISTS_THM] THEN GEN_TAC THEN + REWRITE_TAC[TAUT `~(p /\ q) <=> p ==> ~q`; NOT_FORALL_THM] THEN + DISCH_TAC THEN + EXISTS_TAC `--(abs b + b' + &1)` THEN REWRITE_TAC[IN_ELIM_THM; NOT_IMP] THEN + ASM_REAL_ARITH_TAC);; + +let NOT_RBOUNDED_LE = prove + (`~real_bounded {x | x <= b}`, + REWRITE_TAC[REAL_BOUNDED_POS_LT; NOT_EXISTS_THM] THEN GEN_TAC THEN + REWRITE_TAC[TAUT `~(p /\ q) <=> p ==> ~q`; NOT_FORALL_THM] THEN + DISCH_TAC THEN + EXISTS_TAC `--(abs b + b' + &1)` THEN REWRITE_TAC[IN_ELIM_THM; NOT_IMP] THEN + ASM_REAL_ARITH_TAC);; + +let NOT_RBOUNDED_UNIV = prove + (`~real_bounded (:real)`, + REWRITE_TAC[REAL_BOUNDED_POS_LT; NOT_EXISTS_THM] THEN GEN_TAC THEN + REWRITE_TAC[TAUT `~(p /\ q) <=> p ==> ~q`; NOT_FORALL_THM] THEN + DISCH_TAC THEN + EXISTS_TAC `abs b + &1` THEN REWRITE_TAC[IN_UNIV; NOT_IMP] THEN + ASM_REAL_ARITH_TAC);; + +(* A real set with a minimum (resp. maximum) element is not real_open. *) + +let REAL_NOT_OPEN_MIN = prove + (`!C a. a IN C /\ (!x. x IN C ==> a <= x) ==> ~real_open C`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o REWRITE_RULE[REAL_OPEN; open_def]) THEN + REWRITE_TAC[FORALL_IN_IMAGE; FORALL_LIFT; DIST_LIFT; LIFT_IN_IMAGE_LIFT] THEN + DISCH_THEN(MP_TAC o SPEC `a:real`) THEN ASM_REWRITE_TAC[NOT_FORALL_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `a - e / &2`) THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `abs((a - e / &2) - a) < e` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `a - e / &2`) THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC);; + +let REAL_NOT_OPEN_MAX = prove + (`!C b. b IN C /\ (!x. x IN C ==> x <= b) ==> ~real_open C`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o REWRITE_RULE[REAL_OPEN; open_def]) THEN + REWRITE_TAC[FORALL_IN_IMAGE; FORALL_LIFT; DIST_LIFT; LIFT_IN_IMAGE_LIFT] THEN + DISCH_THEN(MP_TAC o SPEC `b:real`) THEN ASM_REWRITE_TAC[NOT_FORALL_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `b + e / &2`) THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `abs((b + e / &2) - b) < e` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `b + e / &2`) THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC);; + +(* A nonempty bounded real_open set is an open interval (a,b) with a < b. By *) +(* IS_REAL_INTERVAL_CASES: unbounded forms killed by NOT_RBOUNDED_*, closed- *) +(* endpoint forms by REAL_NOT_OPEN_MIN/MAX, empty by hypothesis. *) + +let REAL_OPEN_BOUNDED_INTERVAL = prove + (`!C. real_open C /\ is_realinterval C /\ real_bounded C /\ ~(C = {}) + ==> ?a b. a < b /\ C = real_interval(a,b)`, + GEN_TAC THEN STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IS_REAL_INTERVAL_CASES]) THEN + STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THENL + [ASM_MESON_TAC[]; + ASM_MESON_TAC[NOT_RBOUNDED_UNIV]; + ASM_MESON_TAC[NOT_RBOUNDED_GT]; + ASM_MESON_TAC[NOT_RBOUNDED_GE]; + ASM_MESON_TAC[NOT_RBOUNDED_LE]; + ASM_MESON_TAC[NOT_RBOUNDED_LT]; + MAP_EVERY EXISTS_TAC [`a:real`; `b:real`] THEN + SUBGOAL_THEN `a:real < b` ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + REWRITE_TAC[IN_ELIM_THM] THEN REAL_ARITH_TAC; + ASM_REWRITE_TAC[EXTENSION; IN_REAL_INTERVAL; IN_ELIM_THM]]; + SUBGOAL_THEN `a:real < b` ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + REWRITE_TAC[IN_ELIM_THM] THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `~real_open {x | a < x /\ x <= b}` MP_TAC THENL + [MATCH_MP_TAC REAL_NOT_OPEN_MAX THEN EXISTS_TAC `b:real` THEN + REWRITE_TAC[IN_ELIM_THM] THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; X_GEN_TAC `z:real` THEN + REAL_ARITH_TAC]; + ASM_REWRITE_TAC[]]; + SUBGOAL_THEN `a:real < b` ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + REWRITE_TAC[IN_ELIM_THM] THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `~real_open {x | a <= x /\ x < b}` MP_TAC THENL + [MATCH_MP_TAC REAL_NOT_OPEN_MIN THEN EXISTS_TAC `a:real` THEN + REWRITE_TAC[IN_ELIM_THM] THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; X_GEN_TAC `z:real` THEN + REAL_ARITH_TAC]; + ASM_REWRITE_TAC[]]; + SUBGOAL_THEN `a:real <= b` ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + REWRITE_TAC[IN_ELIM_THM] THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `~real_open {x | a <= x /\ x <= b}` MP_TAC THENL + [MATCH_MP_TAC REAL_NOT_OPEN_MIN THEN EXISTS_TAC `a:real` THEN + REWRITE_TAC[IN_ELIM_THM] THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; X_GEN_TAC `z:real` THEN + REAL_ARITH_TAC]; + ASM_REWRITE_TAC[]]]);; + +(* For c a subset of a lifted set, lift o drop is the identity on it. *) + +let LIFT_IMAGE_DROP_SUBSET = prove + (`!c:real^1->bool s. c SUBSET IMAGE lift s ==> IMAGE lift (IMAGE drop c) = c`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM IMAGE_o; o_DEF; LIFT_DROP] THEN + REWRITE_TAC[EXTENSION; IN_IMAGE] THEN X_GEN_TAC `z:real^1` THEN + EQ_TAC THENL [STRIP_TAC THEN ASM_REWRITE_TAC[]; DISCH_TAC] THEN + EXISTS_TAC `z:real^1` THEN ASM_REWRITE_TAC[] THEN + RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; IN_IMAGE]) THEN + ASM_MESON_TAC[LIFT_DROP]);; + +(* Transfer of openness and interval-ness from a lifted vector set to its *) +(* drop. (Generalised over c so they apply via MATCH_MP_TAC even in a *) +(* cluttered assumption context, where REWRITE_TAC[REAL_OPEN] on the goal *) +(* misbehaves.) *) + +let REAL_OPEN_IMAGE_DROP = prove + (`!c:real^1->bool. open c /\ IMAGE lift (IMAGE drop c) = c + ==> real_open (IMAGE drop c)`, + GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[REAL_OPEN] THEN ASM_REWRITE_TAC[]);; + +let IS_REALINTERVAL_IMAGE_DROP = prove + (`!c:real^1->bool. connected c /\ IMAGE lift (IMAGE drop c) = c + ==> is_realinterval (IMAGE drop c)`, + GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[IS_REALINTERVAL_CONNECTED] THEN + ASM_REWRITE_TAC[]);; + +(* A real_open set is the union of a pairwise-disjoint family of real_open *) +(* sets *) +(* (its connected components, transferred from the vector world), stated for *) +(* the *) +(* EXPLICIT family D0 = IMAGE (IMAGE drop) (components (IMAGE lift s)) so it *) +(* can be *) +(* instantiated directly. This is the family fed to MAXIMAL_WEAK_TYPE_LIFT. *) + +let MAXIMAL_COMPONENT_FAMILY = prove + (`!s. real_open s + ==> (!C. C IN IMAGE (IMAGE drop) (components (IMAGE lift s)) ==> + real_open C) /\ + (!C C'. C IN IMAGE (IMAGE drop) (components (IMAGE lift s)) /\ + C' IN IMAGE (IMAGE drop) (components (IMAGE lift s)) /\ ~(C + = C') + ==> DISJOINT C C') /\ + UNIONS (IMAGE (IMAGE drop) (components (IMAGE lift s))) = s`, + GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN `open (IMAGE lift s)` ASSUME_TAC THENL + [ASM_MESON_TAC[REAL_OPEN]; ALL_TAC] THEN + SUBGOAL_THEN + `!c:real^1->bool. c IN components (IMAGE lift s) ==> c SUBSET IMAGE lift s` + ASSUME_TAC THENL [ASM_MESON_TAC[IN_COMPONENTS_SUBSET]; ALL_TAC] THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[FORALL_IN_IMAGE] THEN X_GEN_TAC `c:real^1->bool` THEN + DISCH_TAC THEN + REWRITE_TAC[REAL_OPEN] THEN + SUBGOAL_THEN + `IMAGE lift (IMAGE drop c) = c` (fun th -> REWRITE_TAC[th]) THENL + [MATCH_MP_TAC LIFT_IMAGE_DROP_SUBSET THEN EXISTS_TAC `s:real->bool` THEN + ASM_SIMP_TAC[]; ALL_TAC] THEN + ASM_MESON_TAC[OPEN_COMPONENTS]; + MAP_EVERY X_GEN_TAC [`C:real->bool`; `C':real->bool`] THEN + REWRITE_TAC[IN_IMAGE] THEN STRIP_TAC THEN + SUBGOAL_THEN `~(x':real^1->bool = x)` ASSUME_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `DISJOINT (x':real^1->bool) x` MP_TAC THENL + [MP_TAC(ISPEC `IMAGE lift s` PAIRWISE_DISJOINT_COMPONENTS) THEN + REWRITE_TAC[pairwise] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `(x':real^1->bool) SUBSET IMAGE lift s /\ x SUBSET IMAGE lift s` + STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[DISJOINT; EXTENSION; IN_INTER; NOT_IN_EMPTY; IN_IMAGE] THEN + RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; IN_IMAGE]) THEN + ASM_MESON_TAC[LIFT_DROP]; + REWRITE_TAC[GSYM IMAGE_UNIONS] THEN + SUBGOAL_THEN `UNIONS (components (IMAGE lift s)) = IMAGE lift s` + (fun th -> REWRITE_TAC[th]) THENL + [MESON_TAC[UNIONS_COMPONENTS]; ALL_TAC] THEN + REWRITE_TAC[GSYM IMAGE_o; o_DEF; LIFT_DROP; IMAGE_ID]]);; + +(* Real-level Heine-Borel: a real_compact set covered by a family of *) +(* real_open sets is covered by a finite subfamily (bridged from *) +(* COMPACT_IMP_HEINE_BOREL). *) + +let REAL_COMPACT_HEINE_BOREL_UNIONS = prove + (`!k D. real_compact k /\ (!C:real->bool. C IN D ==> real_open C) /\ + k SUBSET UNIONS D + ==> ?D'. D' SUBSET D /\ FINITE D' /\ k SUBSET UNIONS D'`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `IMAGE lift k` COMPACT_IMP_HEINE_BOREL) THEN + ASM_REWRITE_TAC[GSYM real_compact] THEN + DISCH_THEN(MP_TAC o SPEC `IMAGE (IMAGE lift) D`) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [REWRITE_TAC[FORALL_IN_IMAGE] THEN X_GEN_TAC `C:real->bool` THEN + DISCH_TAC THEN + ASM_MESON_TAC[REAL_OPEN]; + REWRITE_TAC[GSYM IMAGE_UNIONS] THEN MATCH_MP_TAC IMAGE_SUBSET THEN + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `g:(real^1->bool)->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `IMAGE (IMAGE drop) g` THEN + ASM_SIMP_TAC[FINITE_IMAGE] THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + X_GEN_TAC `u:real^1->bool` THEN DISCH_TAC THEN + SUBGOAL_THEN `u IN IMAGE (IMAGE lift) D` MP_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + REWRITE_TAC[IN_IMAGE] THEN + DISCH_THEN(X_CHOOSE_THEN `C:real->bool` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `IMAGE drop u = C` (fun th -> ASM_MESON_TAC[th]) THEN + ASM_REWRITE_TAC[GSYM IMAGE_o; o_DEF; LIFT_DROP; IMAGE_ID]; + REWRITE_TAC[SUBSET] THEN X_GEN_TAC `x:real` THEN DISCH_TAC THEN + SUBGOAL_THEN `lift x IN UNIONS g` MP_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + REWRITE_TAC[IN_UNIONS] THEN + DISCH_THEN(X_CHOOSE_THEN `u:real^1->bool` STRIP_ASSUME_TAC) THEN + REWRITE_TAC[IN_UNIONS] THEN EXISTS_TAC `IMAGE drop u` THEN + CONJ_TAC THENL + [REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `u:real^1->bool` THEN + ASM_REWRITE_TAC[]; + REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `lift x` THEN + ASM_REWRITE_TAC[LIFT_DROP]]]);; + +(* Lifting: for a family D of pairwise-disjoint real_open sets each *) +(* satisfying t*measure(C) <= int_C f (f >= 0), the same bound holds for *) +(* their union. This is the reusable heart of the weak-type argument: inner *) +(* regularity (REAL_MEASURABLE_INNER_COMPACT) reduces to a compact subset K; *) +(* Heine-Borel (REAL_COMPACT_HEINE_BOREL_UNIONS) covers K by a finite *) +(* subfamily; and WEAK_TYPE_FINITE_CORE bounds that finite union. *) + +let MAXIMAL_WEAK_TYPE_LIFT = prove + (`!f t D. + &0 < t /\ + (!C. C IN D ==> real_open C /\ real_measurable C /\ + f real_integrable_on C /\ + t * real_measure C <= real_integral C f) /\ + (!C C'. C IN D /\ C' IN D /\ ~(C = C') ==> DISJOINT C C') /\ + real_measurable (UNIONS D) /\ f real_integrable_on (UNIONS D) /\ + (!x. x IN UNIONS D ==> &0 <= f x) + ==> t * real_measure (UNIONS D) <= real_integral (UNIONS D) f`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_EPSILON THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(ISPECL [`UNIONS D:real->bool`; `(e:real) / t`] + REAL_MEASURABLE_INNER_COMPACT) THEN + ASM_SIMP_TAC[REAL_LT_DIV] THEN + DISCH_THEN(X_CHOOSE_THEN `k:real->bool` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`k:real->bool`; `D:(real->bool)->bool`] + REAL_COMPACT_HEINE_BOREL_UNIONS) THEN + ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `D':(real->bool)->bool` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `!C:real->bool. C IN D' ==> C IN D` ASSUME_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `real_measurable (UNIONS D')` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_MEASURABLE_UNIONS THEN ASM_MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `f real_integrable_on (UNIONS D')` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_DISJOINT_UNIONS THEN + ASM_MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `UNIONS D' SUBSET UNIONS D:real->bool` ASSUME_TAC THENL + [MATCH_MP_TAC SUBSET_UNIONS THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL [`f:real->real`; `t:real`; `D':(real->bool)->bool`] + WEAK_TYPE_FINITE_CORE) THEN + ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN DISCH_TAC THEN + SUBGOAL_THEN `real_measure k <= real_measure (UNIONS D')` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_MEASURE_SUBSET THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `real_integral (UNIONS D') f <= real_integral (UNIONS D) f` + ASSUME_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_SUBSET_LE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `t * real_measure (UNIONS D) < t * (real_measure k + e / t)` + ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LT_LMUL THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `t * (real_measure k + e / t) = t * real_measure k + e` + ASSUME_TAC THENL + [REWRITE_TAC[REAL_ADD_LDISTRIB] THEN AP_TERM_TAC THEN + MATCH_MP_TAC REAL_DIV_LMUL THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `t * real_measure k <= t * real_measure (UNIONS D')` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_REAL_ARITH_TAC);; + +(* Quantitative level-set bound (Fremlin 286A(b)(ii) beta): any x whose *) +(* average of f from z exceeds the threshold t lies within ||f||_1/t of z. *) +(* This forces the components of the superlevel set G_t to be bounded (no *) +(* half-lines). *) + +let MAXIMAL_LEVEL_SET_BOUND = prove + (`!f t z. f real_integrable_on (:real) /\ (!x. &0 <= f x) /\ &0 < t + ==> !x. z <= x /\ (x - z) * t <= real_integral (real_interval[z,x]) f + ==> x <= z + real_integral (:real) f / t`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `real_integral (real_interval[z,x]) f <= real_integral (:real) f` + ASSUME_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_SUBSET_LE THEN + ASM_REWRITE_TAC[SUBSET_UNIV] THEN + MATCH_MP_TAC REAL_INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `(:real)` THEN ASM_REWRITE_TAC[SUBSET_UNIV]; + ALL_TAC] THEN + SUBGOAL_THEN `(x - z) * t <= real_integral (:real) f` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `x - z <= real_integral (:real) f / t` MP_TAC THENL + [ONCE_REWRITE_TAC[REAL_ARITH `x - z <= y <=> (x - z) <= y`] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ]; ALL_TAC] THEN + REAL_ARITH_TAC);; + +(* If a real_open set s contains the open interval (a,b) and also its right *) +(* endpoint b, the interval extends to the right within s. Contrapositive: a *) +(* component of s of the form (a,b) cannot contain b, i.e. b is not in s. *) +(* Used to discharge the "endpoint not in G_t" hypothesis of *) +(* MAXIMAL_COMPONENT_BOUND. *) + +let REAL_OPEN_INTERVAL_EXTEND_RIGHT = prove + (`!s a b. real_open s /\ real_interval(a,b) SUBSET s /\ b IN s /\ a < b + ==> ?b'. b < b' /\ real_interval(a,b') SUBSET s`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "op") + (CONJUNCTS_THEN2 (LABEL_TAC "sub") + (CONJUNCTS_THEN2 (LABEL_TAC "bin") (LABEL_TAC "ab")))) THEN + USE_THEN "op" (MP_TAC o REWRITE_RULE[REAL_OPEN; open_def; FORALL_IN_IMAGE; + FORALL_LIFT; DIST_LIFT; LIFT_IN_IMAGE_LIFT]) THEN + DISCH_THEN(MP_TAC o SPEC `b:real`) THEN + ANTS_TAC THENL [USE_THEN "bin" ACCEPT_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `b + e / &2` THEN CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[SUBSET; IN_REAL_INTERVAL] THEN X_GEN_TAC `y:real` THEN + STRIP_TAC THEN + ASM_CASES_TAC `y < b` THENL + [USE_THEN "sub" (MP_TAC o REWRITE_RULE[SUBSET; IN_REAL_INTERVAL]) THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC; + FIRST_X_ASSUM(MP_TAC o SPEC `y:real`) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; SIMP_TAC[]]]);; + +let REAL_COMPONENT_ENDPOINT_RIGHT = prove + (`!s a b. real_open s /\ a < b /\ real_interval(a,b) SUBSET s /\ + (!t. real_interval(a,b) SUBSET t /\ t SUBSET s /\ is_realinterval t + ==> t = real_interval(a,b)) + ==> ~(b IN s)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`s:real->bool`; `a:real`; + `b:real`] REAL_OPEN_INTERVAL_EXTEND_RIGHT) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `b':real` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `real_interval(a,b')`) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [REWRITE_TAC[SUBSET; IN_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC; + ASM_REWRITE_TAC[]; + REWRITE_TAC[IS_REALINTERVAL_INTERVAL]]; + REWRITE_TAC[EXTENSION; IN_REAL_INTERVAL] THEN + DISCH_THEN(MP_TAC o SPEC `(b + b') / &2`) THEN ASM_REAL_ARITH_TAC]);; + +let MAXIMAL_REACH_COMPACT = prove + (`!f t z. f real_integrable_on (:real) /\ (!x. &0 <= f x) /\ &0 < t + ==> real_compact {x | z <= x /\ (x - z) * t <= real_integral + (real_interval[z,x]) f}`, + REPEAT STRIP_TAC THEN + ABBREV_TAC `K = z + real_integral (:real) f / t` THEN + SUBGOAL_THEN + `{x | z <= x /\ (x - z) * t <= real_integral (real_interval[z,x]) f} + = {x | x IN real_interval[z,K] /\ + &0 <= real_integral (real_interval[z,x]) f - (x - z) * t}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_REAL_INTERVAL] THEN + X_GEN_TAC `x:real` THEN + SUBGOAL_THEN `z <= x /\ (x - z) * t <= real_integral (real_interval[z,x]) f + ==> x <= K` (fun th -> MP_TAC th) THENL + [EXPAND_TAC "K" THEN STRIP_TAC THEN + MP_TAC(ISPECL [`f:real->real`; `t:real`; + `z:real`] MAXIMAL_LEVEL_SET_BOUND) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `x:real`) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + REAL_ARITH_TAC]; + ALL_TAC] THEN + REWRITE_TAC[real_compact; COMPACT_EQ_BOUNDED_CLOSED] THEN + CONJ_TAC THENL + [MATCH_MP_TAC BOUNDED_SUBSET THEN EXISTS_TAC `interval[lift z,lift K]` THEN + REWRITE_TAC[BOUNDED_INTERVAL; GSYM IMAGE_LIFT_REAL_INTERVAL] THEN + SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `closed {y:real^1 | &0 <= drop y}` ASSUME_TAC THENL + [REWRITE_TAC[drop; REAL_ARITH `&0 <= a <=> a >= &0`; + CLOSED_HALFSPACE_COMPONENT_GE]; ALL_TAC] THEN + SUBGOAL_THEN + `IMAGE lift {x | x IN real_interval[z,K] /\ + &0 <= real_integral (real_interval[z,x]) f - (x - z) * t} + = {w | w IN IMAGE lift (real_interval[z,K]) /\ + (lift o (\x. real_integral (real_interval[z,x]) f - (x - z) * t) o + drop) w + IN {y:real^1 | &0 <= drop y}}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM; o_THM; LIFT_DROP] THEN + MESON_TAC[LIFT_DROP]; ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE THEN ASM_REWRITE_TAC[ETA_AX] THEN + REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL; CLOSED_INTERVAL; + GSYM REAL_CONTINUOUS_ON] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_SUB THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_INDEFINITE_INTEGRAL_CONTINUOUS_RIGHT THEN + MATCH_MP_TAC REAL_INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `(:real)` THEN ASM_REWRITE_TAC[SUBSET_UNIV]; + MATCH_MP_TAC REAL_CONTINUOUS_ON_MUL THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_CONST] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_SUB THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_ID; REAL_CONTINUOUS_ON_CONST]]);; + +(* Fremlin 286A(b)(ii) beta: the right endpoint of a G_t-interval through z *) +(* is at most z + ||f||_1/t, hence finite. Let M = max A_z (A_z compact via *) +(* MAXIMAL_REACH_COMPACT, nonempty as z in A_z). If b > M then M lies in the *) +(* open interval (a,b) subset G_t, so M has a G_t-witness c > M with (c-M)t *) +(* < int_[M,c]f; by additivity int_[z,c]f >= (M-z)t + (c-M)t = (c-z)t, so c *) +(* in A_z with c > M, contradicting maximality. Thus b <= M <= z + ||f||_1/t *) +(* (MAXIMAL_LEVEL_SET_BOUND). *) + +let MAXIMAL_COMPONENT_SUP_BOUND = prove + (`!f t a b z. + f real_integrable_on (:real) /\ (!x. &0 <= f x) /\ &0 < t /\ + a < z /\ z < b /\ + real_interval(a,b) SUBSET + {x | ?c. x < c /\ (c - x) * t < real_integral (real_interval[x,c]) f} + ==> b <= z + real_integral (:real) f / t`, + REPEAT STRIP_TAC THEN + ABBREV_TAC `Az = {x | z <= x /\ (x - z) * t <= real_integral + (real_interval[z,x]) f}` THEN + SUBGOAL_THEN `(z:real) IN Az` ASSUME_TAC THENL + [EXPAND_TAC "Az" THEN + REWRITE_TAC[IN_ELIM_THM; REAL_LE_REFL; REAL_SUB_REFL] THEN + REWRITE_TAC[REAL_MUL_LZERO] THEN + SUBGOAL_THEN `real_integral (real_interval[z:real,z]) f = &0` + (fun th -> REWRITE_TAC[th; REAL_LE_REFL]) THEN + MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN REWRITE_TAC[HAS_REAL_INTEGRAL_REFL]; + ALL_TAC] THEN + SUBGOAL_THEN `real_compact Az` ASSUME_TAC THENL + [EXPAND_TAC "Az" THEN MATCH_MP_TAC MAXIMAL_REACH_COMPACT THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MP_TAC(ISPECL [`\x:real. x`; + `Az:real->bool`] REAL_CONTINUOUS_ATTAINS_SUP) THEN + ASM_REWRITE_TAC[REAL_CONTINUOUS_ON_ID] THEN + ANTS_TAC THENL [ASM_MESON_TAC[MEMBER_NOT_EMPTY]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `M:real` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `z <= M /\ (M - z) * t <= real_integral (real_interval[z,M]) f` + STRIP_ASSUME_TAC THENL + [UNDISCH_TAC `(M:real) IN Az` THEN EXPAND_TAC "Az" THEN + REWRITE_TAC[IN_ELIM_THM]; ALL_TAC] THEN + SUBGOAL_THEN `M <= z + real_integral (:real) f / t` ASSUME_TAC THENL + [MP_TAC(ISPECL [`f:real->real`; `t:real`; + `z:real`] MAXIMAL_LEVEL_SET_BOUND) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `b <= M` (fun th -> ASM_MESON_TAC[th; REAL_LE_TRANS]) THEN + REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN + SUBGOAL_THEN + `?c. M < c /\ (c - M) * t < real_integral (real_interval[M,c]) f` + STRIP_ASSUME_TAC THENL + [UNDISCH_TAC + `real_interval(a,b) SUBSET + {x | ?c. x < c /\ (c - x) * t < real_integral (real_interval[x,c]) f}` + THEN + REWRITE_TAC[SUBSET; IN_REAL_INTERVAL; IN_ELIM_THM] THEN + DISCH_THEN(MP_TAC o SPEC `M:real`) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; SIMP_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN `(c:real) IN Az` MP_TAC THENL + [EXPAND_TAC "Az" THEN REWRITE_TAC[IN_ELIM_THM] THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPECL [`f:real->real`; `z:real`; `c:real`; + `M:real`] REAL_INTEGRAL_COMBINE) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `(:real)` THEN ASM_REWRITE_TAC[SUBSET_UNIV]]; + DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + DISCH_TAC THEN + SUBGOAL_THEN `c <= M` MP_TAC THENL [ASM_MESON_TAC[]; ASM_REAL_ARITH_TAC]);; + +(* Point version: any x to the right of a base point z in a G_t-component C *) +(* is within ||f||_1/t of z. (Pick a in C just left of z since C is open, *) +(* apply MAXIMAL_COMPONENT_SUP_BOUND to the sub-interval (a,x) which lies in *) +(* C hence G_t.) *) + +let MAXIMAL_COMPONENT_PT_SUP = prove + (`!f t z C x. + f real_integrable_on (:real) /\ (!x. &0 <= f x) /\ &0 < t /\ + real_open C /\ is_realinterval C /\ z IN C /\ x IN C /\ z < x /\ + C SUBSET {y | ?c. y < c /\ (c - y) * t < real_integral (real_interval[y,c]) + f} + ==> x <= z + real_integral (:real) f / t`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `z:real` o + REWRITE_RULE[REAL_OPEN; open_def; FORALL_IN_IMAGE; FORALL_LIFT; DIST_LIFT; + LIFT_IN_IMAGE_LIFT]) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN + `e:real` STRIP_ASSUME_TAC) THEN + ABBREV_TAC `a = z - e / &2` THEN + SUBGOAL_THEN `(a:real) IN C` ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `a:real`) THEN EXPAND_TAC "a" THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; SIMP_TAC[]]; ALL_TAC] THEN + SUBGOAL_THEN `real_interval(a,x) SUBSET C` ASSUME_TAC THENL + [REWRITE_TAC[SUBSET; IN_REAL_INTERVAL] THEN X_GEN_TAC `y:real` THEN + STRIP_TAC THEN + UNDISCH_TAC `is_realinterval C` THEN REWRITE_TAC[is_realinterval] THEN + DISCH_THEN(MP_TAC o SPECL [`a:real`; `x:real`; `y:real`]) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(ISPECL [`f:real->real`; `t:real`; `a:real`; `x:real`; `z:real`] + MAXIMAL_COMPONENT_SUP_BOUND) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + CONJ_TAC THENL + [EXPAND_TAC "a" THEN ASM_REAL_ARITH_TAC; ASM_MESON_TAC[SUBSET_TRANS]]);; + +(* Consequently a component C of G_t is real_bounded: every w in C is within *) +(* ||f||_1/t of a fixed base point z (apply the point bound in whichever *) +(* direction w lies from z). *) + +let MAXIMAL_COMPONENT_BOUNDED = prove + (`!f t z C. + f real_integrable_on (:real) /\ (!x. &0 <= f x) /\ &0 < t /\ + real_open C /\ is_realinterval C /\ z IN C /\ + C SUBSET {y | ?c. y < c /\ (c - y) * t < real_integral (real_interval[y,c]) + f} + ==> real_bounded C`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&0 <= real_integral (:real) f / t` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_DIV THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN + MATCH_MP_TAC REAL_INTEGRAL_POS THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[REAL_BOUNDED_POS_LT] THEN + EXISTS_TAC `abs z + real_integral (:real) f / t + &1` THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + X_GEN_TAC `w:real` THEN DISCH_TAC THEN + SUBGOAL_THEN `w <= z + real_integral (:real) f / t /\ + z <= w + real_integral (:real) f / t` MP_TAC THENL + [CONJ_TAC THENL + [ASM_CASES_TAC `z:real < w` THENL + [MP_TAC(ISPECL [`f:real->real`; `t:real`; `z:real`; `C:real->bool`; + `w:real`] + MAXIMAL_COMPONENT_PT_SUP) THEN ASM_REWRITE_TAC[]; + ASM_REAL_ARITH_TAC]; + ASM_CASES_TAC `w:real < z` THENL + [MP_TAC(ISPECL [`f:real->real`; `t:real`; `w:real`; `C:real->bool`; + `z:real`] + MAXIMAL_COMPONENT_PT_SUP) THEN ASM_REWRITE_TAC[]; + ASM_REAL_ARITH_TAC]]; + ASM_REAL_ARITH_TAC]);; + +(* Structural facts for a component c (in the vector world) of the *) +(* superlevel *) +(* set G_t: its real image IMAGE drop c is real_open, an interval, nonempty, *) +(* and *) +(* contained in G_t. (Transfer via REAL_OPEN_IMAGE_DROP / *) +(* IS_REALINTERVAL_IMAGE_ *) +(* DROP / OPEN_COMPONENTS / IN_COMPONENTS_*. NB: annotate `open *) +(* (c:real^1->bool)` *) +(* -- an unannotated `open c` parses c polymorphically and breaks the *) +(* proof.) *) + +let MAXIMAL_COMPONENT_STRUCT = prove + (`!f t c. + f real_integrable_on (:real) /\ (!x. &0 <= f x) /\ &0 < t /\ + c IN components (IMAGE lift + {y | ?a. y < a /\ (a - y) * t < real_integral (real_interval[y,a]) f}) + ==> real_open (IMAGE drop c) /\ is_realinterval (IMAGE drop c) /\ + ~(IMAGE drop c = {}) /\ + (IMAGE drop c) SUBSET + {y | ?a. y < a /\ (a - y) * t < real_integral (real_interval[y,a]) + f}`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + ABBREV_TAC `s = {y | ?a. y < a /\ (a - y) * t < real_integral + (real_interval[y,a]) f}` THEN + SUBGOAL_THEN `real_open s` ASSUME_TAC THENL + [EXPAND_TAC "s" THEN MATCH_MP_TAC MAXIMAL_SUPERLEVEL_OPEN THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `open (IMAGE lift s)` ASSUME_TAC THENL + [ASM_MESON_TAC[REAL_OPEN]; ALL_TAC] THEN + SUBGOAL_THEN `c SUBSET IMAGE lift s` ASSUME_TAC THENL + [MATCH_MP_TAC IN_COMPONENTS_SUBSET THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `open (c:real^1->bool)` ASSUME_TAC THENL + [MP_TAC(ISPECL [`IMAGE lift s`; `c:real^1->bool`] OPEN_COMPONENTS) THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_CONNECTED) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP IN_COMPONENTS_NONEMPTY) THEN + SUBGOAL_THEN `IMAGE lift (IMAGE drop c) = c` ASSUME_TAC THENL + [MATCH_MP_TAC LIFT_IMAGE_DROP_SUBSET THEN EXISTS_TAC `s:real->bool` THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `(IMAGE drop c) SUBSET s` ASSUME_TAC THENL + [REWRITE_TAC[SUBSET] THEN X_GEN_TAC `y:real` THEN + REWRITE_TAC[IN_IMAGE] THEN DISCH_THEN(X_CHOOSE_THEN + `w:real^1` STRIP_ASSUME_TAC) THEN + UNDISCH_TAC `c SUBSET IMAGE lift s` THEN REWRITE_TAC[SUBSET] THEN + DISCH_THEN(MP_TAC o SPEC `w:real^1`) THEN ASM_REWRITE_TAC[IN_IMAGE] THEN + ASM_MESON_TAC[LIFT_DROP]; ALL_TAC] THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC REAL_OPEN_IMAGE_DROP THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC IS_REALINTERVAL_IMAGE_DROP THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[IMAGE_EQ_EMPTY] THEN ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]]);; + +(* Real-level maximality of a component: any real-interval t with *) +(* (IMAGE drop c) SUBSET t SUBSET G_t equals IMAGE drop c. *) +(* (COMPONENTS_MAXIMAL *) +(* applied to IMAGE lift t.) Feeds the endpoint lemmas *) +(* REAL_COMPONENT_ENDPOINT_*. *) + +let MAXIMAL_COMPONENT_MAXIMALITY = prove + (`!f th c t. + c IN components (IMAGE lift + {y | ?a. y < a /\ (a - y) * th < real_integral (real_interval[y,a]) f}) + /\ + IMAGE lift (IMAGE drop c) = c /\ is_realinterval t /\ + (IMAGE drop c) SUBSET t /\ + t SUBSET {y | ?a. y < a /\ (a - y) * th < real_integral + (real_interval[y,a]) f} /\ + ~(IMAGE drop c = {}) + ==> t = IMAGE drop c`, + REPEAT STRIP_TAC THEN + ABBREV_TAC `s = {y | ?a. y < a /\ (a - y) * th < real_integral + (real_interval[y,a]) f}` THEN + SUBGOAL_THEN `connected (IMAGE lift t)` ASSUME_TAC THENL + [REWRITE_TAC[GSYM IS_REALINTERVAL_CONNECTED] THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `IMAGE lift t SUBSET IMAGE lift s` ASSUME_TAC THENL + [MATCH_MP_TAC IMAGE_SUBSET THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `~(c INTER IMAGE lift t = {})` ASSUME_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + SUBGOAL_THEN `?y:real. y IN IMAGE drop c` STRIP_ASSUME_TAC THENL + [ASM_REWRITE_TAC[MEMBER_NOT_EMPTY]; ALL_TAC] THEN + EXISTS_TAC `lift y` THEN REWRITE_TAC[IN_INTER] THEN CONJ_TAC THENL + [FIRST_X_ASSUM(fun th -> if concl th = `IMAGE lift (IMAGE drop c) = c` + then SUBST1_TAC(SYM th) else NO_TAC) THEN + ASM_REWRITE_TAC[LIFT_IN_IMAGE_LIFT]; + REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `y:real` THEN + ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `IMAGE drop c SUBSET t` THEN REWRITE_TAC[SUBSET] THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN + SUBGOAL_THEN `IMAGE lift t SUBSET c` ASSUME_TAC THENL + [MP_TAC(ISPECL [`IMAGE lift s`; `IMAGE lift t`; + `c:real^1->bool`] COMPONENTS_MAXIMAL) THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `t SUBSET IMAGE drop c` ASSUME_TAC THENL + [REWRITE_TAC[SUBSET] THEN X_GEN_TAC `y:real` THEN DISCH_TAC THEN + REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `lift y` THEN + REWRITE_TAC[LIFT_DROP] THEN + UNDISCH_TAC `IMAGE lift t SUBSET c` THEN REWRITE_TAC[SUBSET] THEN + DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[IN_IMAGE] THEN + EXISTS_TAC `y:real` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ]);; + +(* Per-component bound: each component c (vector world) of G_t satisfies *) +(* t * real_measure(IMAGE drop c) <= real_integral (IMAGE drop c) f. *) +(* Chain: STRUCT (real_open/interval/nonempty/subset) + *) +(* MAXIMAL_COMPONENT_BOUNDED *) +(* (bounded) + REAL_OPEN_BOUNDED_INTERVAL => IMAGE drop c = *) +(* real_interval(a,b),a b not in *) +(* G_t; *) +(* interior in G_t (subset); MAXIMAL_COMPONENT_BOUND => (b-a)*t <= *) +(* int_[a,b]f; *) +(* real_measure(a,b)=b-a, int_(a,b)=int_[a,b]. (NB annotate `(b:real) IN *) +(* s`.) *) + +let MAXIMAL_COMPONENT_MEASURE_BOUND = prove + (`!f t c. + f real_integrable_on (:real) /\ (!x. &0 <= f x) /\ &0 < t /\ + c IN components (IMAGE lift + {y | ?a. y < a /\ (a - y) * t < real_integral (real_interval[y,a]) f}) + ==> t * real_measure (IMAGE drop c) <= real_integral (IMAGE drop c) f`, + REPEAT STRIP_TAC THEN + ABBREV_TAC `s = {y | ?a. y < a /\ (a - y) * t < real_integral + (real_interval[y,a]) f}` THEN + SUBGOAL_THEN `real_open s` ASSUME_TAC THENL + [EXPAND_TAC "s" THEN MATCH_MP_TAC MAXIMAL_SUPERLEVEL_OPEN THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL [`f:real->real`; `t:real`; + `c:real^1->bool`] MAXIMAL_COMPONENT_STRUCT) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + SUBGOAL_THEN `?z:real. z IN IMAGE drop c` STRIP_ASSUME_TAC THENL + [ASM_REWRITE_TAC[MEMBER_NOT_EMPTY]; ALL_TAC] THEN + SUBGOAL_THEN `real_bounded (IMAGE drop c)` ASSUME_TAC THENL + [MP_TAC(ISPECL [`f:real->real`; `t:real`; `z:real`; `IMAGE drop c`] + MAXIMAL_COMPONENT_BOUNDED) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `c SUBSET IMAGE lift s` ASSUME_TAC THENL + [MATCH_MP_TAC IN_COMPONENTS_SUBSET THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `IMAGE lift (IMAGE drop c) = c` ASSUME_TAC THENL + [MATCH_MP_TAC LIFT_IMAGE_DROP_SUBSET THEN EXISTS_TAC `s:real->bool` THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + MP_TAC(ISPEC `IMAGE drop c` REAL_OPEN_BOUNDED_INTERVAL) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `a:real` (X_CHOOSE_THEN + `b:real` STRIP_ASSUME_TAC)) THEN + SUBGOAL_THEN + `!u. real_interval(a,b) SUBSET u /\ u SUBSET s /\ is_realinterval u + ==> u = real_interval(a,b)` ASSUME_TAC THENL + [X_GEN_TAC `u:real->bool` THEN STRIP_TAC THEN + MP_TAC(ISPECL [`f:real->real`; `t:real`; `c:real^1->bool`; `u:real->bool`] + MAXIMAL_COMPONENT_MAXIMALITY) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[]; ASM_MESON_TAC[]]; ALL_TAC] THEN + SUBGOAL_THEN `real_interval(a,b) SUBSET s` ASSUME_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `~((b:real) IN s)` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_COMPONENT_ENDPOINT_RIGHT THEN + ASM_MESON_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[REAL_MEASURE_REAL_INTERVAL; REAL_INTEGRAL_OPEN_INTERVAL] THEN + SUBGOAL_THEN `max (b - a) (&0) = b - a` SUBST1_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + MP_TAC(ISPECL [`f:real->real`; `t:real`; `a:real`; + `b:real`] MAXIMAL_COMPONENT_BOUND) THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [X_GEN_TAC `x:real` THEN STRIP_TAC THEN + SUBGOAL_THEN `(x:real) IN s` MP_TAC THENL + [UNDISCH_TAC `real_interval(a,b) SUBSET s` THEN + REWRITE_TAC[SUBSET; IN_REAL_INTERVAL] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_REAL_ARITH_TAC; + EXPAND_TAC "s" THEN REWRITE_TAC[IN_ELIM_THM] THEN SIMP_TAC[]]; + UNDISCH_TAC `~((b:real) IN s)` THEN EXPAND_TAC "s" THEN + REWRITE_TAC[IN_ELIM_THM; NOT_EXISTS_THM] THEN + DISCH_TAC THEN X_GEN_TAC `cc:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `cc:real`) THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC]);; + +(* Companion: each component image is real_measurable and f is integrable on *) +(* it (it is a bounded interval). *) + +let MAXIMAL_COMPONENT_MEASURABLE = prove + (`!f t c. + f real_integrable_on (:real) /\ (!x. &0 <= f x) /\ &0 < t /\ + c IN components (IMAGE lift + {y | ?a. y < a /\ (a - y) * t < real_integral (real_interval[y,a]) f}) + ==> real_measurable (IMAGE drop c) /\ f real_integrable_on (IMAGE drop c)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + ABBREV_TAC `s = {y | ?a. y < a /\ (a - y) * t < real_integral + (real_interval[y,a]) f}` THEN + MP_TAC(ISPECL [`f:real->real`; `t:real`; + `c:real^1->bool`] MAXIMAL_COMPONENT_STRUCT) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN + SUBGOAL_THEN `?z:real. z IN IMAGE drop c` STRIP_ASSUME_TAC THENL + [ASM_REWRITE_TAC[MEMBER_NOT_EMPTY]; ALL_TAC] THEN + SUBGOAL_THEN `real_bounded (IMAGE drop c)` ASSUME_TAC THENL + [MP_TAC(ISPECL [`f:real->real`; `t:real`; `z:real`; `IMAGE drop c`] + MAXIMAL_COMPONENT_BOUNDED) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MP_TAC(ISPEC `IMAGE drop c` REAL_OPEN_BOUNDED_INTERVAL) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `a:real` (X_CHOOSE_THEN + `b:real` STRIP_ASSUME_TAC)) THEN + FIRST_ASSUM(fun th -> if concl th = `IMAGE drop c = real_interval(a,b)` + then SUBST1_TAC th else NO_TAC) THEN + CONJ_TAC THENL + [REWRITE_TAC[REAL_MEASURABLE_REAL_INTERVAL]; + REWRITE_TAC[REAL_INTEGRABLE_ON_OPEN_INTERVAL] THEN + MATCH_MP_TAC REAL_INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `(:real)` THEN ASM_REWRITE_TAC[SUBSET_UNIV]]);; + +(* The measure of any finite subfamily of G_t's component-images is at most *) +(* ||f||_1 / t. (Per-component bounds summed via WEAK_TYPE_FINITE_CORE, then *) +(* the *) +(* union integral bounded by int over R.) This is the uniform partial-sum *) +(* bound *) +(* needed to conclude G_t is real_measurable via *) +(* REAL_MEASURABLE_COUNTABLE_UNIONS_ *) +(* STRONG, even when G_t is unbounded. *) + +let MAXIMAL_FINITE_MEASURE_BOUND = prove + (`!f t D'. + f real_integrable_on (:real) /\ (!x. &0 <= f x) /\ &0 < t /\ FINITE D' /\ + D' SUBSET IMAGE (IMAGE drop) (components (IMAGE lift + {y | ?a. y < a /\ (a - y) * t < real_integral (real_interval[y,a]) f})) + ==> real_measure (UNIONS D') <= real_integral (:real) f / t`, + REPEAT STRIP_TAC THEN + ABBREV_TAC `s = {y | ?a. y < a /\ (a - y) * t < real_integral + (real_interval[y,a]) f}` THEN + SUBGOAL_THEN + `!C. C IN D' ==> f real_integrable_on C /\ real_measurable C /\ + t * real_measure C <= real_integral C f` + ASSUME_TAC THENL + [X_GEN_TAC `C:real->bool` THEN DISCH_TAC THEN + SUBGOAL_THEN + `?c. C = + IMAGE drop c /\ c IN components (IMAGE lift s)` STRIP_ASSUME_TAC THENL + [UNDISCH_TAC `D' SUBSET IMAGE (IMAGE drop) (components (IMAGE lift s))` + THEN + REWRITE_TAC[SUBSET; IN_IMAGE] THEN + DISCH_THEN(MP_TAC o SPEC `C:real->bool`) THEN + ASM_REWRITE_TAC[] THEN MESON_TAC[]; ALL_TAC] THEN + FIRST_X_ASSUM SUBST1_TAC THEN + MP_TAC(ISPECL [`f:real->real`; `t:real`; + `c:real^1->bool`] MAXIMAL_COMPONENT_MEASURABLE) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + MP_TAC(ISPECL [`f:real->real`; `t:real`; + `c:real^1->bool`] MAXIMAL_COMPONENT_MEASURE_BOUND) THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + MP_TAC(ISPEC `s:real->bool` MAXIMAL_COMPONENT_FAMILY) THEN + ANTS_TAC THENL + [EXPAND_TAC "s" THEN MATCH_MP_TAC MAXIMAL_SUPERLEVEL_OPEN THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + STRIP_TAC THEN + SUBGOAL_THEN + `!C C':real->bool. C IN D' /\ C' IN D' /\ ~(C = C') ==> DISJOINT C C'` + ASSUME_TAC THENL + [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN + MP_TAC(ISPECL [`f:real->real`; `t:real`; + `D':(real->bool)->bool`] WEAK_TYPE_FINITE_CORE) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + SUBGOAL_THEN + `!C:real->bool. C IN D' ==> f real_integrable_on C` ASSUME_TAC THENL + [X_GEN_TAC `C:real->bool` THEN DISCH_TAC THEN + UNDISCH_TAC `!C:real->bool. C IN D' ==> f real_integrable_on C /\ + real_measurable C /\ + t * real_measure C <= real_integral C f` THEN + DISCH_THEN(MP_TAC o SPEC `C:real->bool`) THEN ASM_REWRITE_TAC[] THEN + SIMP_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `real_integral (UNIONS D') f <= real_integral (:real) f` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_SUBSET_LE THEN ASM_REWRITE_TAC[SUBSET_UNIV] THEN + MATCH_MP_TAC REAL_INTEGRABLE_DISJOINT_UNIONS THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `t * real_measure (UNIONS D') <= real_integral (:real) f` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* The superlevel set G_t of the one-sided maximal function is *) +(* real_measurable. *) +(* G_t is real_open (MAXIMAL_SUPERLEVEL_OPEN) but possibly UNBOUNDED, so we *) +(* decompose IMAGE lift G_t into its (countably many) connected components, *) +(* enumerate them (COUNTABLE_AS_IMAGE), and apply the STRONG countable-union *) +(* measurability criterion whose partial measures are bounded by ||f||_1 / t *) +(* (MAXIMAL_FINITE_MEASURE_BOUND). Empty-component case handled separately. *) +(* ------------------------------------------------------------------------- *) +let MAXIMAL_SUPERLEVEL_MEASURABLE = prove + (`!f t. f real_integrable_on (:real) /\ (!x. &0 <= f x) /\ &0 < t + ==> real_measurable + {x | ?a. x < a /\ (a - x) * t < real_integral (real_interval[x,a]) f}`, + REPEAT STRIP_TAC THEN + ABBREV_TAC `s = {y | ?a. y < a /\ (a - y) * t < real_integral + (real_interval[y,a]) f}` THEN + SUBGOAL_THEN `real_open s` ASSUME_TAC THENL + [EXPAND_TAC "s" THEN MATCH_MP_TAC MAXIMAL_SUPERLEVEL_OPEN THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `open (IMAGE lift s)` ASSUME_TAC THENL + [ASM_MESON_TAC[REAL_OPEN]; ALL_TAC] THEN + ASM_CASES_TAC `components (IMAGE lift s) = {}` THENL + [SUBGOAL_THEN `s:real->bool = {}` SUBST1_TAC THENL + [MP_TAC(ISPEC `IMAGE lift s` UNIONS_COMPONENTS) THEN + ASM_REWRITE_TAC[UNIONS_0] THEN + REWRITE_TAC[IMAGE_EQ_EMPTY] THEN SIMP_TAC[]; ALL_TAC] THEN + REWRITE_TAC[REAL_MEASURABLE_EMPTY]; ALL_TAC] THEN + SUBGOAL_THEN `COUNTABLE (components (IMAGE lift s))` ASSUME_TAC THENL + [MATCH_MP_TAC COUNTABLE_COMPONENTS THEN + MATCH_MP_TAC OPEN_IMP_LOCALLY_CONNECTED THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + MP_TAC(ISPEC `components (IMAGE lift s)` COUNTABLE_AS_IMAGE) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `g:num->real^1->bool`) THEN + SUBGOAL_THEN + `!n. (g:num->real^1->bool) n IN components (IMAGE lift s)` ASSUME_TAC THENL + [GEN_TAC THEN FIRST_ASSUM(fun th -> + if concl th = `components (IMAGE lift s) = IMAGE (g:num->real^1->bool) + (:num)` + then SUBST1_TAC th else NO_TAC) THEN + REWRITE_TAC[IN_IMAGE; IN_UNIV] THEN MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `s = UNIONS {IMAGE drop ((g:num->real^1->bool) n) | n IN (:num)}` + SUBST1_TAC THENL + [MP_TAC(ISPEC `s:real->bool` MAXIMAL_COMPONENT_FAMILY) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o last o CONJUNCTS) THEN + ASM_REWRITE_TAC[SIMPLE_IMAGE; GSYM IMAGE_o; o_DEF] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[]; ALL_TAC] THEN + UNDISCH_THEN + `components (IMAGE lift s) = IMAGE (g:num->real^1->bool) (:num)` (K + ALL_TAC) THEN + MATCH_MP_TAC REAL_MEASURABLE_COUNTABLE_UNIONS_STRONG THEN + EXISTS_TAC `real_integral (:real) f / t` THEN CONJ_TAC THENL + [X_GEN_TAC `n:num` THEN + MP_TAC(ISPECL [`f:real->real`; `t:real`; `(g:num->real^1->bool) n`] + MAXIMAL_COMPONENT_MEASURABLE) THEN + ASM_REWRITE_TAC[] THEN SIMP_TAC[]; + X_GEN_TAC `n:num` THEN + MP_TAC(ISPECL [`f:real->real`; `t:real`; + `{IMAGE drop ((g:num->real^1->bool) k) | k <= n}`] + MAXIMAL_FINITE_MEASURE_BOUND) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL + [REWRITE_TAC[SET_RULE `{(fn:num->real->bool) k | k <= n} = IMAGE fn {k | k + <= n}`] THEN + SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG_LE]; + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `(g:num->real^1->bool) k` THEN + ASM_REWRITE_TAC[]]]);; + +(* ------------------------------------------------------------------------- *) +(* f is real_integrable_on G_t (needed as a global hypothesis of the LIFT). *) +(* Route: f is real_measurable_on R (integrable), G_t is real_lebesgue_ *) +(* measurable (from MAXIMAL_SUPERLEVEL_MEASURABLE), so the restriction *) +(* f*1_{G_t} is real_measurable_on R and bounded by the integrable f (f >= *) +(* 0), *) +(* hence integrable on R; REAL_INTEGRABLE_RESTRICT_INTER then gives f on *) +(* G_t. *) +(* ------------------------------------------------------------------------- *) + +let MAXIMAL_SUPERLEVEL_INTEGRABLE = prove + (`!f t. f real_integrable_on (:real) /\ (!x. &0 <= f x) /\ &0 < t + ==> f real_integrable_on + {x | ?a. x < a /\ (a - x) * t < real_integral (real_interval[x,a]) f}`, + REPEAT STRIP_TAC THEN + ABBREV_TAC `s = {x | ?a. x < a /\ (a - x) * t < real_integral + (real_interval[x,a]) f}` THEN + SUBGOAL_THEN `real_measurable s` ASSUME_TAC THENL + [EXPAND_TAC "s" THEN MATCH_MP_TAC MAXIMAL_SUPERLEVEL_MEASURABLE THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `(\x. if x IN s then f x else &0) real_integrable_on (:real)` MP_TAC THENL + [MATCH_MP_TAC REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN + EXISTS_TAC `f:real->real` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_MEASURABLE_ON_RESTRICT THEN CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_IMP_REAL_MEASURABLE THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_MEASURABLE_IMP_REAL_LEBESGUE_MEASURABLE THEN + ASM_REWRITE_TAC[]]; + GEN_TAC THEN DISCH_TAC THEN COND_CASES_TAC THENL + [ASM_SIMP_TAC[real_abs; REAL_LE_REFL]; + REWRITE_TAC[REAL_ABS_NUM] THEN ASM_REWRITE_TAC[]]]; + REWRITE_TAC[REAL_INTEGRABLE_RESTRICT_INTER; INTER_UNIV]]);; + +(* ------------------------------------------------------------------------- *) +(* Intermediate weak-type bound (Fremlin 286A(b)(iii)). For f >= 0 *) +(* integrable *) +(* and t > 0, the superlevel set G_t of the one-sided maximal function has *) +(* t * measure(G_t) <= int_{G_t} f. *) +(* Assembled by instantiating MAXIMAL_WEAK_TYPE_LIFT with the component *) +(* family *) +(* D0 = IMAGE(IMAGE drop)(components(IMAGE lift G_t)); per-component facts *) +(* from *) +(* MAXIMAL_COMPONENT_{STRUCT,MEASURABLE,MEASURE_BOUND}, global facts from *) +(* MAXIMAL_COMPONENT_FAMILY + MAXIMAL_SUPERLEVEL_{MEASURABLE,INTEGRABLE}. *) +(* ------------------------------------------------------------------------- *) + +let MAXIMAL_WEAK_TYPE = prove + (`!f t. f real_integrable_on (:real) /\ (!x. &0 <= f x) /\ &0 < t + ==> t * real_measure {x | ?a. x < a /\ + (a - x) * t < real_integral (real_interval[x,a]) f} + <= real_integral + {x | ?a. x < a /\ + (a - x) * t < real_integral (real_interval[x,a]) f} f`, + REPEAT STRIP_TAC THEN + ABBREV_TAC `s = {y | ?a. y < a /\ (a - y) * t < real_integral + (real_interval[y,a]) f}` THEN + SUBGOAL_THEN `real_open s` ASSUME_TAC THENL + [EXPAND_TAC "s" THEN MATCH_MP_TAC MAXIMAL_SUPERLEVEL_OPEN THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL [`f:real->real`; `t:real`; + `IMAGE (IMAGE drop) (components (IMAGE lift s))`] MAXIMAL_WEAK_TYPE_LIFT) + THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[FORALL_IN_IMAGE] THEN X_GEN_TAC `c:real^1->bool` THEN + DISCH_TAC THEN + REPEAT CONJ_TAC THENL + [MP_TAC(ISPECL [`f:real->real`; `t:real`; + `c:real^1->bool`] MAXIMAL_COMPONENT_STRUCT) THEN + ASM_REWRITE_TAC[] THEN SIMP_TAC[]; + MP_TAC(ISPECL [`f:real->real`; `t:real`; + `c:real^1->bool`] MAXIMAL_COMPONENT_MEASURABLE) THEN + ASM_REWRITE_TAC[] THEN SIMP_TAC[]; + MP_TAC(ISPECL [`f:real->real`; `t:real`; + `c:real^1->bool`] MAXIMAL_COMPONENT_MEASURABLE) THEN + ASM_REWRITE_TAC[] THEN SIMP_TAC[]; + MP_TAC(ISPECL [`f:real->real`; `t:real`; + `c:real^1->bool`] MAXIMAL_COMPONENT_MEASURE_BOUND) THEN + ASM_REWRITE_TAC[]]; + MP_TAC(ISPEC `s:real->bool` MAXIMAL_COMPONENT_FAMILY) THEN + ASM_REWRITE_TAC[] THEN + SIMP_TAC[]; + MP_TAC(ISPEC `s:real->bool` MAXIMAL_COMPONENT_FAMILY) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o last o CONJUNCTS) THEN DISCH_THEN SUBST1_TAC THEN + EXPAND_TAC "s" THEN MATCH_MP_TAC MAXIMAL_SUPERLEVEL_MEASURABLE THEN + ASM_REWRITE_TAC[]; + MP_TAC(ISPEC `s:real->bool` MAXIMAL_COMPONENT_FAMILY) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o last o CONJUNCTS) THEN DISCH_THEN SUBST1_TAC THEN + EXPAND_TAC "s" THEN MATCH_MP_TAC MAXIMAL_SUPERLEVEL_INTEGRABLE THEN + ASM_REWRITE_TAC[]]; + MP_TAC(ISPEC `s:real->bool` MAXIMAL_COMPONENT_FAMILY) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o last o CONJUNCTS) THEN DISCH_THEN SUBST1_TAC THEN + EXPAND_TAC "s" THEN REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* L^2 assembly helpers (Fremlin 286A(c), specialized to p = 2). *) +(* ------------------------------------------------------------------------- *) + +(* The positive part (f - c)_+ = max 0 (f - c) is integrable, for f >= 0 *) +(* integrable and c >= 0 (dominated by f itself since c >= 0). *) +let POS_PART_INTEGRABLE = prove + (`!f c. f real_integrable_on (:real) /\ (!x. &0 <= f x) /\ &0 <= c + ==> (\x. max (&0) (f x - c)) real_integrable_on (:real)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN + EXISTS_TAC `f:real->real` THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC REAL_MEASURABLE_ON_MAX THEN + REWRITE_TAC[REAL_MEASURABLE_ON_CONST] THEN + MATCH_MP_TAC REAL_MEASURABLE_ON_SUB THEN + REWRITE_TAC[REAL_MEASURABLE_ON_CONST] THEN + MATCH_MP_TAC INTEGRABLE_IMP_REAL_MEASURABLE THEN ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= fx /\ &0 <= c ==> abs(max (&0) (fx - c)) <= + fx`) THEN + ASM_REWRITE_TAC[]]);; + +(* A non-negative function integrable on R is integrable on any measurable *) +(* subset (restrict, dominate by the whole-line function, RESTRICT_INTER). *) +let INTEGRABLE_ON_MEASURABLE_SUBSET_UNIV = prove + (`!g s. g real_integrable_on (:real) /\ (!x. &0 <= g x) /\ real_measurable s + ==> g real_integrable_on s`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\x. if x IN s then g x else &0) real_integrable_on (:real)` MP_TAC THENL + [MATCH_MP_TAC REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN + EXISTS_TAC `g:real->real` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_MEASURABLE_ON_RESTRICT THEN CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_IMP_REAL_MEASURABLE THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_MEASURABLE_IMP_REAL_LEBESGUE_MEASURABLE THEN + ASM_REWRITE_TAC[]]; + GEN_TAC THEN DISCH_TAC THEN COND_CASES_TAC THENL + [ASM_SIMP_TAC[real_abs; REAL_LE_REFL]; + REWRITE_TAC[REAL_ABS_NUM] THEN ASM_REWRITE_TAC[]]]; + REWRITE_TAC[REAL_INTEGRABLE_RESTRICT_INTER; INTER_UNIV]]);; + +(* A constant is integrable on a measurable set, with integral c * measure. *) +let CONST_INTEGRABLE_MEASURABLE = prove + (`!s c. real_measurable s + ==> (\x:real. c) real_integrable_on s /\ + real_integral s (\x:real. c) = c * real_measure s`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN `(\x:real. &1) real_integrable_on s` ASSUME_TAC THENL + [MP_TAC(ISPECL [`\x:real. &1`; `s:real->bool`; + `(:real)`] REAL_INTEGRABLE_RESTRICT_INTER) THEN + REWRITE_TAC[INTER_UNIV] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + FIRST_ASSUM(MP_TAC o REWRITE_RULE[REAL_MEASURABLE_REAL_INTEGRABLE]) THEN + REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `(\x:real. c) = (\x:real. c * &1)` SUBST1_TAC THENL + [REWRITE_TAC[REAL_MUL_RID]; ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_LMUL THEN ASM_REWRITE_TAC[]; + ASM_SIMP_TAC[REAL_INTEGRAL_LMUL] THEN + ASM_SIMP_TAC[REAL_INTEGRAL_REAL_MEASURE] THEN REAL_ARITH_TAC]);; + +(* FTC brick for the p=2 layer-cake: int_[0,A] 2u du = A^2 (A >= 0). *) +(* Gives the pointwise identity g(x)^2 = int_[0,g(x)] 2u du used to turn *) +(* int g^2 into the weighted layer-cake int_{u>0} 2u mu{g>u} du via Fubini. *) +let INTEGRAL_2U = prove + (`!A. &0 <= A ==> ((\u. &2 * u) has_real_integral A pow 2) + (real_interval[&0,A])`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\u:real. u pow 2`; `\u:real. &2 * u`; `&0:real`; `A:real`] + REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + REAL_DIFF_TAC THEN CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[REAL_POW_1] THEN REAL_ARITH_TAC; + REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_SUB_RZERO]]);; + +(* Inner 1D integral (part B of the p=2 layer-cake bound): *) +(* int_{u>0} (A - u/2)_+ du = A^2 for A >= 0. *) +(* The integrand is supported on (0,2A] where it equals A - u/2 (antideriv *) +(* A*u - u^2/4), and vanishes on (2A,inf); split the domain as [0,2A] union *) +(* (2A,inf) (HAS_REAL_INTEGRAL_UNION) and spike-set to (0,inf). *) +let INNER_POS_PART_INTEGRAL = prove + (`!A. &0 <= A + ==> ((\u. max (&0) (A - u / &2)) has_real_integral A pow 2) {u | &0 < u}`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_SPIKE_SET THEN + EXISTS_TAC `real_interval[&0, &2 * A] UNION {u | &2 * A < u}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{&0}` THEN + REWRITE_TAC[REAL_NEGLIGIBLE_SING] THEN + REWRITE_TAC[SUBSET; IN_UNION; IN_DIFF; IN_ELIM_THM; IN_SING; + IN_REAL_INTERVAL] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `A pow 2 = A pow 2 + &0` SUBST1_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_UNION THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC HAS_REAL_INTEGRAL_SPIKE THEN + EXISTS_TAC `\u. A - u / &2` THEN EXISTS_TAC `{}:real->bool` THEN + REWRITE_TAC[REAL_NEGLIGIBLE_EMPTY; IN_DIFF; NOT_IN_EMPTY] THEN + CONJ_TAC THENL + [X_GEN_TAC `u:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN STRIP_TAC THEN + REWRITE_TAC[REAL_ARITH `max (&0) (A - u / &2) = A - u / &2 <=> &0 <= A - + u / &2`] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `(\u. A * u - u pow 2 / &4) (&2 * A) - (\u. A * u - u pow 2 / &4) (&0) = A + pow 2` + (fun th -> ONCE_REWRITE_TAC[GSYM th]) THENL + [REWRITE_TAC[] THEN CONV_TAC REAL_RING; ALL_TAC] THEN + MATCH_MP_TAC REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; + REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN + CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[REAL_POW_1] THEN + REAL_ARITH_TAC]; + MATCH_MP_TAC HAS_REAL_INTEGRAL_SPIKE THEN + EXISTS_TAC `\u:real. &0` THEN EXISTS_TAC `{}:real->bool` THEN + REWRITE_TAC[REAL_NEGLIGIBLE_EMPTY; IN_DIFF; NOT_IN_EMPTY; + HAS_REAL_INTEGRAL_0] THEN + X_GEN_TAC `u:real` THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN + REWRITE_TAC[REAL_ARITH `max (&0) (A - u / &2) = &0 <=> A - u / &2 <= &0`] + THEN + ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{&2 * A}` THEN + REWRITE_TAC[REAL_NEGLIGIBLE_SING] THEN + REWRITE_TAC[SUBSET; IN_INTER; IN_REAL_INTERVAL; IN_ELIM_THM; IN_SING] THEN + ASM_REAL_ARITH_TAC]);; + +(* x-slice inner integral for the p=2 weighted layer-cake (real level): *) +(* int_{u>0} (if u < A then 2u else 0) du = A^2 for A >= 0. *) +(* This is the vertical slice of the weighted region integrand 2u over *) +(* {0 < u < g(x)} at a fixed x with A = g(x); reuses INTEGRAL_2U on [0,A] *) +(* and vanishes on (A,inf), split via HAS_REAL_INTEGRAL_UNION. *) +let XSLICE_REAL = prove + (`!A. &0 <= A + ==> ((\u. if u < A then &2 * u else &0) has_real_integral A pow 2) {u | &0 < + u}`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_SPIKE_SET THEN + EXISTS_TAC `real_interval[&0, A] UNION {u | A < u}` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{&0}` THEN + REWRITE_TAC[REAL_NEGLIGIBLE_SING; SUBSET; IN_UNION; IN_DIFF; IN_ELIM_THM; + IN_SING; IN_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `A pow 2 = A pow 2 + &0` SUBST1_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_UNION THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC HAS_REAL_INTEGRAL_SPIKE THEN + EXISTS_TAC `\u. &2 * u` THEN EXISTS_TAC `{A:real}` THEN + REWRITE_TAC[REAL_NEGLIGIBLE_SING; IN_DIFF; IN_SING] THEN CONJ_TAC THENL + [X_GEN_TAC `u:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN STRIP_TAC THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + ASM_SIMP_TAC[INTEGRAL_2U]]; + MATCH_MP_TAC HAS_REAL_INTEGRAL_SPIKE THEN + EXISTS_TAC `\u:real. &0` THEN EXISTS_TAC `{}:real->bool` THEN + REWRITE_TAC[REAL_NEGLIGIBLE_EMPTY; IN_DIFF; NOT_IN_EMPTY; + HAS_REAL_INTEGRAL_0] THEN + X_GEN_TAC `u:real` THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{A:real}` THEN + REWRITE_TAC[REAL_NEGLIGIBLE_SING; SUBSET; IN_INTER; IN_REAL_INTERVAL; + IN_ELIM_THM; IN_SING] THEN ASM_REAL_ARITH_TAC]);; + +(* u-slice inner integral for the p=2 weighted layer-cake (vector level): *) +(* for fixed u > 0 with {x | u < g x} real_measurable, the horizontal slice *) +(* int_{x:real^1} (if 0 t * real_measure {x | ?a. x < a /\ (a - x) * t < real_integral + (real_interval[x,a]) f} + <= &2 * real_integral (:real) (\x. max (&0) (f x - t / &2))`, + REPEAT STRIP_TAC THEN + ABBREV_TAC `s = {x | ?a. x < a /\ (a - x) * t < real_integral + (real_interval[x,a]) f}` THEN + MP_TAC(ISPECL [`f:real->real`; `t:real`] MAXIMAL_WEAK_TYPE) THEN + ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN + SUBGOAL_THEN `real_measurable s` ASSUME_TAC THENL + [EXPAND_TAC "s" THEN MATCH_MP_TAC MAXIMAL_SUPERLEVEL_MEASURABLE THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `f real_integrable_on s` ASSUME_TAC THENL + [EXPAND_TAC "s" THEN MATCH_MP_TAC MAXIMAL_SUPERLEVEL_INTEGRABLE THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `(\x. max (&0) (f x - t / &2)) real_integrable_on (:real)` ASSUME_TAC THENL + [MATCH_MP_TAC POS_PART_INTEGRABLE THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `(\x. max (&0) (f x - t / &2)) real_integrable_on s` ASSUME_TAC THENL + [MATCH_MP_TAC INTEGRABLE_ON_MEASURABLE_SUBSET_UNIV THEN + ASM_REWRITE_TAC[] THEN + GEN_TAC THEN REWRITE_TAC[] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(ISPECL [`s:real->bool`; `t / &2`] CONST_INTEGRABLE_MEASURABLE) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + SUBGOAL_THEN + `real_integral s f + <= real_integral s (\x. max (&0) (f x - t / &2)) + t / &2 * real_measure s` + ASSUME_TAC THENL + [FIRST_X_ASSUM(fun th -> + if concl th = `real_integral s (\x:real. t / &2) = t / &2 * real_measure + s` + then SUBST1_TAC(SYM th) else NO_TAC) THEN + ASM_SIMP_TAC[GSYM REAL_INTEGRAL_ADD] THEN + MATCH_MP_TAC REAL_INTEGRAL_LE THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_ADD THEN ASM_REWRITE_TAC[]; + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[] THEN REAL_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN + `real_integral s (\x. max (&0) (f x - t / &2)) + <= real_integral (:real) (\x. max (&0) (f x - t / &2))` + ASSUME_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_SUBSET_LE THEN ASM_REWRITE_TAC[SUBSET_UNIV] THEN + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_REAL_ARITH_TAC);; + +(* Measurability brick: a real-measurable f on R, precomposed with the first *) +(* coordinate projection, is (lift-)measurable on R^2. (Via *) +(* MEASURABLE_ON_COMPOSE_FSTCART at N:=1; the real<->vector bridge *) +(* real_measurable_on = lift o f o drop measurable_on IMAGE lift.) *) +let LIFTF_MEAS = prove + (`!f:real->real. + f real_measurable_on (:real) + ==> (\z:real^(1,1)finite_sum. lift(f(drop(fstcart z)))) measurable_on + (:real^(1,1)finite_sum)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\y:real^1. lift((f:real->real)(drop y))`] + (INST_TYPE [`:1`,`:N`] MEASURABLE_ON_COMPOSE_FSTCART)) THEN + REWRITE_TAC[] THEN + ANTS_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE[real_measurable_on; IMAGE_LIFT_UNIV; + o_DEF]) THEN + ASM_REWRITE_TAC[]; + REWRITE_TAC[]]);; + +(* The height coordinate u = drop(sndcart z), scaled, is (lift-)measurable *) +(* on R^2 -- it is linear (LINEAR_SNDCART) hence continuous. *) +let SND_MEAS = prove + (`(\z:real^(1,1)finite_sum. lift(drop(sndcart z) / &2)) measurable_on + (:real^(1,1)finite_sum)`, + MATCH_MP_TAC CONTINUOUS_IMP_MEASURABLE_ON THEN + SUBGOAL_THEN + `(\z:real^(1,1)finite_sum. lift(drop(sndcart z) / &2)) = + (\z:real^(1,1)finite_sum. (&1 / &2) % sndcart z)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM LIFT_DROP] THEN + REWRITE_TAC[GSYM LIFT_CMUL] THEN AP_TERM_TAC THEN REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_CMUL THEN + SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART]);; + +(* Hence z |-> lift(f(x) - u/2) (x = fstcart, u = sndcart) is measurable. *) +let DIFF_MEAS = prove + (`!f:real->real. f real_measurable_on (:real) + ==> (\z:real^(1,1)finite_sum. lift(f(drop(fstcart z)) - drop(sndcart z) / + &2)) + measurable_on (:real^(1,1)finite_sum)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\z:real^(1,1)finite_sum. lift(f(drop(fstcart z)) - drop(sndcart z) / &2)) + = + (\z:real^(1,1)finite_sum. lift(f(drop(fstcart z))) - lift(drop(sndcart z) / + &2))` + SUBST1_TAC THENL [REWRITE_TAC[LIFT_SUB]; ALL_TAC] THEN + MATCH_MP_TAC MEASURABLE_ON_SUB THEN + ASM_SIMP_TAC[LIFTF_MEAS; SND_MEAS]);; + +(* And the positive part z |-> lift(max 0 (f(x) - u/2)) is measurable, via *) +(* the identity max 0 a = (a + abs a)/2 (MEASURABLE_ON_LIFT_ABS + ADD + *) +(* CMUL). *) +let MAXPART_MEAS = prove + (`!f:real->real. f real_measurable_on (:real) + ==> (\z:real^(1,1)finite_sum. lift(max (&0) (f(drop(fstcart z)) - + drop(sndcart z) / &2))) + measurable_on (:real^(1,1)finite_sum)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\z:real^(1,1)finite_sum. lift(max (&0) (f(drop(fstcart z)) - drop(sndcart + z) / &2))) = + (\z:real^(1,1)finite_sum. (&1 / &2) % + (lift(f(drop(fstcart z)) - drop(sndcart z) / &2) + + lift(abs(f(drop(fstcart z)) - drop(sndcart z) / &2))))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + REWRITE_TAC[GSYM LIFT_ADD; GSYM LIFT_CMUL] THEN AP_TERM_TAC THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC MEASURABLE_ON_CMUL THEN MATCH_MP_TAC MEASURABLE_ON_ADD THEN + ASM_SIMP_TAC[DIFF_MEAS] THEN + MATCH_MP_TAC MEASURABLE_ON_LIFT_ABS THEN ASM_SIMP_TAC[DIFF_MEAS]);; + +(* The full (f-u/2)_+ region integrand (0 off the upper halfspace u>0) is *) +(* measurable on R^2: restrict the positive part MAXPART_MEAS to the open *) +(* halfspace {w | w$2 > 0} = {w | 0 < drop(sndcart w)} (OPEN_HALFSPACE_ *) +(* COMPONENT_GT), via MEASURABLE_ON_RESTRICT. *) +let PSI_MEAS = prove + (`!f:real->real. f real_measurable_on (:real) + ==> (\z:real^(1,1)finite_sum. + if &0 < drop(sndcart z) + then lift(max (&0) (f(drop(fstcart z)) - drop(sndcart z) / &2)) + else vec 0) measurable_on (:real^(1,1)finite_sum)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\z:real^(1,1)finite_sum. + if &0 < drop(sndcart z) + then lift(max (&0) (f(drop(fstcart z)) - drop(sndcart z) / &2)) else vec + 0) = + (\z:real^(1,1)finite_sum. + if z IN {w | &0 < drop(sndcart w)} + then (\z. lift(max (&0) (f(drop(fstcart z)) - drop(sndcart z) / &2))) z + else vec 0)` + SUBST1_TAC THENL [REWRITE_TAC[IN_ELIM_THM]; ALL_TAC] THEN + MATCH_MP_TAC MEASURABLE_ON_RESTRICT THEN CONJ_TAC THENL + [ASM_SIMP_TAC[MAXPART_MEAS]; + MATCH_MP_TAC LEBESGUE_MEASURABLE_OPEN THEN + SUBGOAL_THEN + `{w:real^(1,1)finite_sum | &0 < drop(sndcart w)} = + {w:real^(1,1)finite_sum | w$2 > &0}` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN GEN_TAC THEN + SIMP_TAC[SNDCART_COMPONENT; DIMINDEX_1; ARITH; GSYM drop; LIFT_DROP; + drop] THEN + REAL_ARITH_TAC; + REWRITE_TAC[OPEN_HALFSPACE_COMPONENT_GT]]]);; + +(* The vertical (u-)slice of the (f-u/2)_+ region integrand at a fixed x *) +(* integrates to f(x)^2. Real level first (extend INNER_POS_PART_INTEGRAL *) +(* from {u>0} to (:real) by zero, forward HAS_REAL_INTEGRAL_RESTRICT_UNIV -- *) +(* NOT GSYM under ONCE_DEPTH_CONV, which LOOPS), then bridge to the vector *) +(* slice through the definition of has_real_integral. *) +let PSI_XSLICE_REAL = prove + (`!f:real->real x. &0 <= f x + ==> ((\t. if t IN {u | &0 < u} then max (&0) (f x - t / &2) else &0) + has_real_integral (f x) pow 2) (:real)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[HAS_REAL_INTEGRAL_RESTRICT_UNIV] THEN + MATCH_MP_TAC INNER_POS_PART_INTEGRAL THEN ASM_REWRITE_TAC[]);; + +let PSI_XSLICE_VEC = prove + (`!f:real->real x. &0 <= f x + ==> ((\u:real^1. if &0 < drop u then lift(max (&0) (f x - drop u / &2)) else + vec 0) + has_integral lift((f x) pow 2)) (:real^1)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:real->real`; `x:real`] PSI_XSLICE_REAL) THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[has_real_integral; IMAGE_LIFT_UNIV; o_DEF] THEN + REWRITE_TAC[IN_ELIM_THM] THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + ABS_TAC THEN COND_CASES_TAC THEN REWRITE_TAC[LIFT_NUM]);; + +(* Each vertical slice of the (f-u/2)_+ region integrand is absolutely *) +(* integrable (nonnegative + integrable via PSI_XSLICE_VEC). Feeds the *) +(* "all slices" hypothesis of REAL_FUBINI_NONNEG_ABS. *) +let PSI_SLICE_ABS = prove + (`!f:real->real x:real^1. (!x. &0 <= f x) + ==> (\u. if &0 < drop u then lift(max (&0) (f(drop x) - drop u / &2)) else + vec 0) + absolutely_integrable_on (:real^1)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC NONNEGATIVE_ABSOLUTELY_INTEGRABLE THEN + CONJ_TAC THENL + [REPEAT GEN_TAC THEN REWRITE_TAC[] THEN STRIP_TAC THEN + SUBGOAL_THEN `i = 1` SUBST_ALL_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE[DIMINDEX_1]) THEN + ASM_ARITH_TAC; ALL_TAC] THEN + COND_CASES_TAC THEN REWRITE_TAC[LIFT_COMPONENT; VEC_COMPONENT] THEN + REAL_ARITH_TAC; + MP_TAC(ISPECL [`f:real->real`; `drop(x:real^1)`] PSI_XSLICE_VEC) THEN + ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN REWRITE_TAC[integrable_on] THEN + EXISTS_TAC `lift((f:real->real)(drop x) pow 2)` THEN ASM_REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Fubini abs-integrability gate for the p=2 layer-cake. For a NONNEGATIVE *) +(* measurable 2D integrand ff whose every vertical slice is abs-integrable *) +(* and whose x-iterate is integrable, ff is absolutely integrable on R^2. *) +(* (FUBINI_TONELLI: the "bad slice" set is EMPTY here -- all slices *) +(* integrable *) +(* -- so the negligibility condition is trivial; the norm-iterate = the *) +(* x-iterate since norm = drop = abs on nonnegative real^1 values.) *) +(* NOTE: never name the integrand `F` -- it is the boolean constant `false`. *) +let REAL_FUBINI_NONNEG_ABS = prove + (`!ff:real^(1,1)finite_sum->real^1. + ff measurable_on (:real^(1,1)finite_sum) /\ + (!z. &0 <= drop(ff z)) /\ + (!x. (\u. ff(pastecart x u)) absolutely_integrable_on (:real^1)) /\ + (\x. integral (:real^1) (\u. ff(pastecart x u))) integrable_on (:real^1) + ==> ff absolutely_integrable_on (:real^(1,1)finite_sum)`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(fun th -> ONCE_REWRITE_TAC[MATCH_MP FUBINI_TONELLI th]) THEN + CONJ_TAC THENL + [SUBGOAL_THEN + `{x | ~((\y. (ff:real^(1,1)finite_sum->real^1) (pastecart x y)) + absolutely_integrable_on (:real^1))} = {}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN ASM_MESON_TAC[]; + REWRITE_TAC[NEGLIGIBLE_EMPTY]]; + SUBGOAL_THEN + `!x u. lift(norm((ff:real^(1,1)finite_sum->real^1)(pastecart x u))) = + ff(pastecart x u)` + (fun th -> ASM_REWRITE_TAC[th]) THEN + REPEAT GEN_TAC THEN REWRITE_TAC[NORM_1] THEN + MP_TAC(SPEC `pastecart (x:real^1) (u:real^1)` + (ASSUME `!z. &0 <= drop((ff:real^(1,1)finite_sum->real^1) z)`)) THEN + SIMP_TAC[real_abs] THEN DISCH_TAC THEN REWRITE_TAC[LIFT_DROP]]);; + +(* The u-outer companion of REAL_FUBINI_NONNEG_ABS (FUBINI_TONELLI_ALT): the *) +(* integrability CONDITION is the outer-u iterate (\y. int_x ff(pastecart x *) +(* y)). Used for the MAIN region S, whose x-iterate is f1star squared (NOT *) +(* known integrable a priori -- circular), but whose u-iterate is 2u *) +(* mu(G_u), integrable by domination against the (f-u/2)_+ integral *) +(* (POS_PART_LAYER_CAKE). *) +let REAL_FUBINI_NONNEG_ABS_ALT = prove + (`!ff:real^(1,1)finite_sum->real^1. + ff measurable_on (:real^(1,1)finite_sum) /\ + (!z. &0 <= drop(ff z)) /\ + (!y. (\x. ff(pastecart x y)) absolutely_integrable_on (:real^1)) /\ + (\y. integral (:real^1) (\x. ff(pastecart x y))) integrable_on (:real^1) + ==> ff absolutely_integrable_on (:real^(1,1)finite_sum)`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(fun th -> ONCE_REWRITE_TAC[MATCH_MP FUBINI_TONELLI_ALT th]) THEN + CONJ_TAC THENL + [SUBGOAL_THEN + `{y | ~((\x. (ff:real^(1,1)finite_sum->real^1) (pastecart x y)) + absolutely_integrable_on (:real^1))} = {}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN ASM_MESON_TAC[]; + REWRITE_TAC[NEGLIGIBLE_EMPTY]]; + SUBGOAL_THEN + `!x y. lift(norm((ff:real^(1,1)finite_sum->real^1)(pastecart x y))) = + ff(pastecart x y)` + (fun th -> ASM_REWRITE_TAC[th]) THEN + REPEAT GEN_TAC THEN REWRITE_TAC[NORM_1] THEN + MP_TAC(SPEC `pastecart (x:real^1) (y:real^1)` + (ASSUME `!z. &0 <= drop((ff:real^(1,1)finite_sum->real^1) z)`)) THEN + SIMP_TAC[real_abs] THEN DISCH_TAC THEN REWRITE_TAC[LIFT_DROP]]);; + +(* The (f-u/2)_+ region integrand is absolutely integrable on R^2, for f *) +(* real- *) +(* measurable, nonnegative, with f^2 integrable. This is the NON-CIRCULAR *) +(* entry point: the x-iterate is int_u (f(x)-u/2)_+ = f(x)^2 *) +(* (PSI_XSLICE_VEC), *) +(* integrable BY HYPOTHESIS -- so REAL_FUBINI_NONNEG_ABS applies with no *) +(* appeal to the very bound we are trying to prove. *) +let PSI_ABS = prove + (`!f:real->real. + f real_measurable_on (:real) /\ (!x. &0 <= f x) /\ + (\x. f x pow 2) real_integrable_on (:real) + ==> (\z:real^(1,1)finite_sum. if &0 < drop(sndcart z) + then lift(max (&0) (f(drop(fstcart z)) - drop(sndcart z) / &2)) + else vec 0) + absolutely_integrable_on (:real^(1,1)finite_sum)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_FUBINI_NONNEG_ABS THEN + REPEAT CONJ_TAC THENL + [ASM_SIMP_TAC[PSI_MEAS]; + GEN_TAC THEN REWRITE_TAC[] THEN COND_CASES_TAC THEN + REWRITE_TAC[DROP_VEC; LIFT_DROP; REAL_LE_REFL] THEN REAL_ARITH_TAC; + GEN_TAC THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN + ASM_SIMP_TAC[PSI_SLICE_ABS]; + SUBGOAL_THEN + `(\x. integral (:real^1) + (\u. (\z:real^(1,1)finite_sum. if &0 < drop(sndcart z) + then lift(max (&0) (f(drop(fstcart z)) - drop(sndcart z) / + &2)) else vec 0) + (pastecart x u))) = + (\x:real^1. lift(f(drop x) pow 2))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:real^1` THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN + MATCH_MP_TAC INTEGRAL_UNIQUE THEN + MP_TAC(ISPECL [`f:real->real`; `drop(x:real^1)`] PSI_XSLICE_VEC) THEN + ASM_REWRITE_TAC[]; + UNDISCH_TAC `(\x. f x pow 2) real_integrable_on (:real)` THEN + REWRITE_TAC[real_integrable_on] THEN STRIP_TAC THEN + REWRITE_TAC[integrable_on] THEN EXISTS_TAC `lift y` THEN + FIRST_X_ASSUM(MP_TAC o REWRITE_RULE[has_real_integral; IMAGE_LIFT_UNIV; + o_DEF]) THEN + REWRITE_TAC[]]]);; + +(* x-outer Fubini value: integrating the (f-u/2)_+ region first over u (the *) +(* vertical slice = f(x)^2) then over x gives lift(int_R f^2). *) +let XOUT = prove + (`!f:real->real. + f real_measurable_on (:real) /\ (!x. &0 <= f x) /\ (\x. f x pow 2) + real_integrable_on (:real) + ==> integral (:real^(1,1)finite_sum) + (\z:real^(1,1)finite_sum. if &0 < drop(sndcart z) + then lift(max (&0) (f(drop(fstcart z)) - drop(sndcart z) / &2)) + else vec 0) + = lift(real_integral (:real) (\x. f x pow 2))`, + REPEAT STRIP_TAC THEN + MP_TAC(MATCH_MP FUBINI_INTEGRAL (MATCH_MP PSI_ABS (ASSUME + `f real_measurable_on (:real) /\ (!x. &0 <= f x) /\ (\x. f x pow 2) + real_integrable_on (:real)`))) THEN + DISCH_THEN SUBST1_TAC THEN + SUBGOAL_THEN + `(\x. integral (:real^1) + (\u. (\z:real^(1,1)finite_sum. if &0 < drop(sndcart z) + then lift(max (&0) (f(drop(fstcart z)) - drop(sndcart z) / &2)) + else vec 0) + (pastecart x u))) = (\x:real^1. lift(f(drop x) pow 2))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:real^1` THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN + MATCH_MP_TAC INTEGRAL_UNIQUE THEN + MP_TAC(ISPECL [`f:real->real`; `drop(x:real^1)`] PSI_XSLICE_VEC) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP REAL_INTEGRAL) THEN + REWRITE_TAC[IMAGE_LIFT_UNIV; o_DEF] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[LIFT_DROP]);; + +(* The u-slice (fixed height u = drop u_pt > 0) of the (f-u/2)_+ region *) +(* integrand, integrated over x, has_integral lift(int_R (f - drop *) +(* u_pt/2)_+). *) +let PSI_USLICE = prove + (`!f:real->real u. f real_integrable_on (:real) /\ (!x. &0 <= f x) /\ &0 < + drop u + ==> ((\x:real^1. (\z:real^(1,1)finite_sum. if &0 < drop(sndcart z) + then lift(max (&0) (f(drop(fstcart z)) - drop(sndcart z) / &2)) + else vec 0) + (pastecart x u)) + has_integral lift(real_integral (:real) (\y. max (&0) (f y - drop u / + &2)))) + (:real^1)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `(\y. max (&0) ((f:real->real) y - drop u / &2)) + real_integrable_on (:real)` + ASSUME_TAC THENL + [MATCH_MP_TAC POS_PART_INTEGRABLE THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP REAL_INTEGRABLE_INTEGRAL) THEN + REWRITE_TAC[has_real_integral; IMAGE_LIFT_UNIV; o_DEF]);; + +(* The inner x-integral as a function of the height y: it is the u-slice *) +(* value *) +(* on {y>0} and vec 0 elsewhere. Feeds the outer u-integral of the *) +(* layer-cake. *) +let INNER_U = prove + (`!f:real->real y. f real_integrable_on (:real) /\ (!x. &0 <= f x) + ==> integral (:real^1) (\x. (\z:real^(1,1)finite_sum. if &0 < drop(sndcart + z) + then lift(max (&0) (f(drop(fstcart z)) - drop(sndcart z) / &2)) + else vec 0) + (pastecart x y)) + = (if &0 < drop y then lift(real_integral (:real) (\t. max (&0) (f t - + drop y / &2))) else vec 0)`, + REPEAT STRIP_TAC THEN COND_CASES_TAC THENL + [MATCH_MP_TAC INTEGRAL_UNIQUE THEN + MP_TAC(ISPECL [`f:real->real`; `y:real^1`] PSI_USLICE) THEN + ASM_REWRITE_TAC[]; + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[INTEGRAL_0]]);; + +(* Raw u-outer Fubini for the (f-u/2)_+ region: the outer iterate (integrate *) +(* over x first) has_integral lift(int f^2). *) +(* FUBINI_ABSOLUTELY_INTEGRABLE_ALT *) +(* on PSI_ABS gives has_integral (int_R^2 Psi); SUBS the XOUT value. Stated *) +(* in *) +(* the raw (unreduced pastecart) form so the combine goes through without *) +(* the *) +(* ABS-failing rewriter (MP_TAC ... THEN REWRITE_TAC[] closes the plain *) +(* implication A ==> A by beta alone). *) +let POS_PART_FUBINI_RAW = prove + (`!f:real->real. + f real_measurable_on (:real) /\ (!x. &0 <= f x) /\ (\x. f x pow 2) + real_integrable_on (:real) + ==> ((\v:real^1. integral (:real^1) (\x. (\z:real^(1,1)finite_sum. if &0 < + drop(sndcart z) + then lift(max (&0) (f(drop(fstcart z)) - drop(sndcart z) / &2)) + else vec 0) + (pastecart x v))) + has_integral lift(real_integral (:real) (\x. f x pow 2))) (:real^1)`, + REPEAT STRIP_TAC THEN + MP_TAC(SUBS[MATCH_MP XOUT (ASSUME + `f real_measurable_on (:real) /\ (!x. &0 <= f x) /\ (\x. f x pow 2) + real_integrable_on (:real)`)] + (CONJUNCT2 (MATCH_MP FUBINI_ABSOLUTELY_INTEGRABLE_ALT (MATCH_MP PSI_ABS + (ASSUME + `f real_measurable_on (:real) /\ (!x. &0 <= f x) /\ (\x. f x pow 2) + real_integrable_on (:real)`))))) THEN + REWRITE_TAC[]);; + +(* The p=2 layer-cake for the positive part (Fremlin 286A(c), the (f-u/2)_+ *) +(* half): *) +(* int_{u>0} (int_R (f - u/2)_+ dx) du = int_R f^2. *) +(* Real-level restatement of POS_PART_FUBINI_RAW: spike the vector outer *) +(* integrand to the real-level one (INNER_U identifies the x-slice), on *) +(* {u>0}. *) +let POS_PART_LAYER_CAKE = prove + (`!f:real->real. + f real_measurable_on (:real) /\ f real_integrable_on (:real) /\ (!x. &0 <= + f x) /\ + (\x. f x pow 2) real_integrable_on (:real) + ==> ((\u. real_integral (:real) (\y. max (&0) (f y - u / &2))) + has_real_integral real_integral (:real) (\x. f x pow 2)) {u | &0 < + u}`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[has_real_integral] THEN + ONCE_REWRITE_TAC[GSYM HAS_INTEGRAL_RESTRICT_UNIV] THEN + MATCH_MP_TAC HAS_INTEGRAL_SPIKE THEN + EXISTS_TAC `\v:real^1. integral (:real^1) (\x. (\z:real^(1,1)finite_sum. if + &0 < drop(sndcart z) + then lift(max (&0) (f(drop(fstcart z)) - drop(sndcart z) / &2)) + else vec 0) + (pastecart x v))` THEN + EXISTS_TAC `{}:real^1->bool` THEN + REWRITE_TAC[NEGLIGIBLE_EMPTY; IN_DIFF; NOT_IN_EMPTY] THEN CONJ_TAC THENL + [X_GEN_TAC `v:real^1` THEN DISCH_TAC THEN + REWRITE_TAC[IN_IMAGE_LIFT_DROP; IN_ELIM_THM; o_THM] THEN + MP_TAC(ISPECL [`f:real->real`; `v:real^1`] INNER_U) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN + COND_CASES_TAC THEN REWRITE_TAC[LIFT_DROP]; + MP_TAC(ISPEC `f:real->real` POS_PART_FUBINI_RAW) THEN ASM_REWRITE_TAC[]]);; + +(* ========================================================================= *) +(* 286B weighted layer-cake (M5): the crux analytic brick of the monotone- *) +(* kernel maximal domination. For nonnegative f (abs-integrable) and *) +(* nonnegative continuous gg with f*gg integrable, *) +(* int_{u>0} (int_{gg>=u} f) du = int_R f*gg. *) +(* Route = 2D Tonelli on the region integrand *) +(* H(z) = if 0 < snd z /\ snd z <= gg(fst z) then f(fst z) else 0, *) +(* a structural clone of the POS_PART_LAYER_CAKE machinery just above. *) +(* ========================================================================= *) + +(* The constant k on the half-open interval (0,c] integrates to k*c (c>=0). *) +(* Spike from the closed interval [0,c] (differ only at the single point 0). *) +let CONST_HALFOPEN_INTEGRAL = prove + (`!k c. &0 <= c + ==> ((\t. if &0 < t /\ t <= c then k else &0) has_real_integral k * c) + (:real)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_SPIKE THEN + EXISTS_TAC `\t. if t IN real_interval[&0,c] then k else &0` THEN + EXISTS_TAC `{&0}` THEN + REWRITE_TAC[REAL_NEGLIGIBLE_SING] THEN CONJ_TAC THENL + [REWRITE_TAC[IN_DIFF; IN_UNIV; IN_SING; IN_REAL_INTERVAL] THEN + REPEAT STRIP_TAC THEN REPEAT COND_CASES_TAC THEN REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[HAS_REAL_INTEGRAL_RESTRICT_UNIV] THEN + SUBGOAL_THEN `k * c = k * (c - &0)` SUBST1_TAC THENL + [REAL_ARITH_TAC; ASM_SIMP_TAC[HAS_REAL_INTEGRAL_CONST]]]);; + +(* Vertical (x-fixed) slice of H: integral over u of the (0,gg x]-indicator *) +(* times f x is f x * gg x (when gg x >= 0). *) +let WLC_XSLICE = prove + (`!(f:real->real) (gg:real->real) x. &0 <= gg x + ==> ((\u:real^1. if &0 < drop u /\ drop u <= gg x then lift(f x) else vec 0) + has_integral lift(f x * gg x)) (:real^1)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`(f:real->real) x`; + `(gg:real->real) x`] CONST_HALFOPEN_INTEGRAL) THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[has_real_integral; IMAGE_LIFT_UNIV; o_DEF] THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + ABS_TAC THEN COND_CASES_TAC THEN REWRITE_TAC[LIFT_NUM]);; + +(* Absolute integrability of the vertical slice (nonnegative, integral *) +(* known). *) +let WLC_SLICE_ABS = prove + (`!(f:real->real) (gg:real->real) x:real^1. (!x. &0 <= f x) /\ (!x. &0 <= gg + x) + ==> (\u:real^1. if &0 < drop u /\ drop u <= gg(drop x) then lift(f(drop x)) + else vec 0) + absolutely_integrable_on (:real^1)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC NONNEGATIVE_ABSOLUTELY_INTEGRABLE THEN + CONJ_TAC THENL + [REPEAT GEN_TAC THEN REWRITE_TAC[] THEN STRIP_TAC THEN + SUBGOAL_THEN `i = 1` SUBST_ALL_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE[DIMINDEX_1]) THEN + ASM_ARITH_TAC; ALL_TAC] THEN + COND_CASES_TAC THEN REWRITE_TAC[LIFT_COMPONENT; VEC_COMPONENT] THEN + ASM_SIMP_TAC[REAL_LE_REFL]; + REWRITE_TAC[integrable_on] THEN + EXISTS_TAC `lift(f(drop(x:real^1)) * gg(drop x))` THEN + MP_TAC(ISPECL [`f:real->real`; `gg:real->real`; + `drop(x:real^1)`] WLC_XSLICE) THEN + ASM_REWRITE_TAC[]]);; + +(* The 2D region integrand H is measurable on R^2: f o fst is measurable *) +(* (LIFTF_MEAS), and the region {0real) (gg:real->real). + f real_measurable_on (:real) /\ gg real_continuous_on (:real) + ==> (\z:real^(1,1)finite_sum. + if &0 < drop(sndcart z) /\ drop(sndcart z) <= gg(drop(fstcart z)) + then lift(f(drop(fstcart z))) else vec 0) + measurable_on (:real^(1,1)finite_sum)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\z:real^(1,1)finite_sum. + if &0 < drop(sndcart z) /\ drop(sndcart z) <= gg(drop(fstcart z)) + then lift(f(drop(fstcart z))) else vec 0) = + (\z:real^(1,1)finite_sum. + if z IN {w | &0 < drop(sndcart w) /\ drop(sndcart w) <= gg(drop(fstcart + w))} + then (\z. lift(f(drop(fstcart z)))) z else vec 0)` + SUBST1_TAC THENL [REWRITE_TAC[IN_ELIM_THM]; ALL_TAC] THEN + MATCH_MP_TAC MEASURABLE_ON_RESTRICT THEN CONJ_TAC THENL + [ASM_SIMP_TAC[LIFTF_MEAS]; ALL_TAC] THEN + SUBGOAL_THEN + `{w:real^(1,1)finite_sum | &0 < drop (sndcart w) /\ drop (sndcart w) <= gg + (drop (fstcart w))} = + {w | drop(sndcart w) > &0} INTER + {w | (lift o (\z. gg(drop(fstcart z)) - drop(sndcart z))) w IN {y:real^1 | + &0 <= drop y}}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM; o_THM; LIFT_DROP] THEN + GEN_TAC THEN REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC LEBESGUE_MEASURABLE_INTER THEN CONJ_TAC THENL + [MATCH_MP_TAC LEBESGUE_MEASURABLE_OPEN THEN + SUBGOAL_THEN + `{w:real^(1,1)finite_sum | drop (sndcart w) > &0} = {w | w$2 > &0}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN GEN_TAC THEN + SIMP_TAC[SNDCART_COMPONENT; DIMINDEX_1; ARITH; GSYM drop; LIFT_DROP; + drop] THEN REAL_ARITH_TAC; + REWRITE_TAC[OPEN_HALFSPACE_COMPONENT_GT]]; + ALL_TAC] THEN + MATCH_MP_TAC LEBESGUE_MEASURABLE_CLOSED THEN + MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_UNIV THEN CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[drop; GSYM real_ge; CLOSED_HALFSPACE_COMPONENT_GE]] THEN + X_GEN_TAC `w:real^(1,1)finite_sum` THEN REWRITE_TAC[o_DEF; LIFT_SUB] THEN + MATCH_MP_TAC CONTINUOUS_SUB THEN CONJ_TAC THENL + [SUBGOAL_THEN `(\w:real^(1,1)finite_sum. lift (gg (drop (fstcart w)))) = + (lift o gg o drop) o (fstcart:real^(1,1)finite_sum->real^1)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; o_THM]; ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_AT_COMPOSE THEN CONJ_TAC THENL + [MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN + REWRITE_TAC[LINEAR_FSTCART]; ALL_TAC] THEN + SUBGOAL_THEN `(lift o gg o drop) continuous_on (:real^1)` MP_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REAL_CONTINUOUS_ON]) THEN + REWRITE_TAC[IMAGE_LIFT_UNIV]; + SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT; OPEN_UNIV; IN_UNIV]]; + REWRITE_TAC[LIFT_DROP; ETA_AX] THEN + MATCH_MP_TAC LINEAR_CONTINUOUS_AT THEN REWRITE_TAC[LINEAR_SNDCART]]);; + +(* H is absolutely integrable on R^2 (Tonelli via REAL_FUBINI_NONNEG_ABS): *) +(* measurable, nonnegative, vertical slices abs-integrable, x-iterate f*gg *) +(* integrable by hypothesis. *) +let WLC_ABS = prove + (`!(f:real->real) (gg:real->real). + f real_measurable_on (:real) /\ gg real_continuous_on (:real) /\ + (!x. &0 <= f x) /\ (!x. &0 <= gg x) /\ + (\x. f x * gg x) real_integrable_on (:real) + ==> (\z:real^(1,1)finite_sum. if &0 < drop(sndcart z) /\ drop(sndcart z) + <= gg(drop(fstcart z)) + then lift(f(drop(fstcart z))) else vec 0) + absolutely_integrable_on (:real^(1,1)finite_sum)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_FUBINI_NONNEG_ABS THEN + REPEAT CONJ_TAC THENL + [ASM_SIMP_TAC[WLC_MEAS]; + GEN_TAC THEN REWRITE_TAC[] THEN COND_CASES_TAC THEN + REWRITE_TAC[DROP_VEC; LIFT_DROP; REAL_LE_REFL] THEN ASM_SIMP_TAC[]; + GEN_TAC THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN + ASM_SIMP_TAC[WLC_SLICE_ABS]; + SUBGOAL_THEN + `(\x:real^1. integral (:real^1) + (\u. (\z:real^(1,1)finite_sum. if &0 < drop(sndcart z) /\ drop(sndcart + z) <= gg(drop(fstcart z)) + then lift(f(drop(fstcart z))) else vec 0) (pastecart x u))) = + (\x:real^1. lift(f(drop x) * gg(drop x)))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:real^1` THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN + MATCH_MP_TAC INTEGRAL_UNIQUE THEN + MP_TAC(ISPECL [`f:real->real`; `gg:real->real`; + `drop(x:real^1)`] WLC_XSLICE) THEN + ASM_REWRITE_TAC[]; + UNDISCH_TAC `(\x. f x * gg x) real_integrable_on (:real)` THEN + REWRITE_TAC[real_integrable_on] THEN STRIP_TAC THEN + REWRITE_TAC[integrable_on] THEN EXISTS_TAC `lift y` THEN + FIRST_X_ASSUM(MP_TAC o REWRITE_RULE[has_real_integral; IMAGE_LIFT_UNIV; + o_DEF]) THEN + REWRITE_TAC[]]]);; + +(* Superlevel set of a continuous gg is real-Lebesgue-measurable (closed). *) +let SUPERLEVEL_RLM = prove + (`!(gg:real->real) u. gg real_continuous_on (:real) + ==> real_lebesgue_measurable {x | u <= gg x}`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[REAL_LEBESGUE_MEASURABLE] THEN + SUBGOAL_THEN `IMAGE lift {x | u <= gg x} = + {z:real^1 | (lift o gg o drop) z IN {y:real^1 | u <= drop y}}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM; o_THM; LIFT_DROP] THEN + MESON_TAC[LIFT_DROP]; ALL_TAC] THEN + MATCH_MP_TAC LEBESGUE_MEASURABLE_CLOSED THEN + MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_UNIV THEN CONJ_TAC THENL + [REWRITE_TAC[ETA_AX] THEN X_GEN_TAC `z:real^1` THEN + SUBGOAL_THEN `(lift o gg o drop) continuous_on (:real^1)` MP_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REAL_CONTINUOUS_ON]) THEN + REWRITE_TAC[IMAGE_LIFT_UNIV]; + SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT; OPEN_UNIV; IN_UNIV]]; + REWRITE_TAC[drop; GSYM real_ge; CLOSED_HALFSPACE_COMPONENT_GE]]);; + +(* f (abs-integrable on R) is integrable on any superlevel {gg>=u}. *) +let F_SUPERLEVEL_INT = prove + (`!(f:real->real) (gg:real->real) u. + f absolutely_real_integrable_on (:real) /\ gg real_continuous_on (:real) + ==> f real_integrable_on {x | u <= gg x}`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE THEN + REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_ON] THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN + EXISTS_TAC `IMAGE lift (:real)` THEN + ASM_REWRITE_TAC[GSYM ABSOLUTELY_REAL_INTEGRABLE_ON] THEN CONJ_TAC THENL + [REWRITE_TAC[IMAGE_LIFT_UNIV; SUBSET_UNIV]; + MP_TAC(ISPECL [`gg:real->real`; `u:real`] SUPERLEVEL_RLM) THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[REAL_LEBESGUE_MEASURABLE]]);; + +(* Horizontal (u-fixed, u>0) slice of H integrated over x is int_{gg>=u} f. *) +let WLC_USLICE = prove + (`!(f:real->real) (gg:real->real) u:real^1. + f absolutely_real_integrable_on (:real) /\ gg real_continuous_on (:real) + /\ &0 < drop u + ==> integral (:real^1) (\x. (\z:real^(1,1)finite_sum. if &0 < drop(sndcart + z) /\ drop(sndcart z) <= gg(drop(fstcart z)) + then lift(f(drop(fstcart z))) else vec 0) (pastecart x u)) + = lift(real_integral {x | drop u <= gg x} f)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `(\x:real^1. if drop u <= gg (drop x) then lift (f (drop x)) else vec 0) = + (\x:real^1. if x IN IMAGE lift {x | drop u <= gg x} then (lift o f o drop) + x else vec 0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:real^1` THEN + REWRITE_TAC[IN_IMAGE_LIFT_DROP; IN_ELIM_THM; o_THM]; ALL_TAC] THEN + REWRITE_TAC[INTEGRAL_RESTRICT_UNIV; ETA_AX] THEN + MP_TAC(ISPECL [`f:real->real`; `gg:real->real`; + `drop(u:real^1)`] F_SUPERLEVEL_INT) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP REAL_INTEGRAL) THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[LIFT_DROP]);; + +(* x-outer Fubini value: int_R^2 H = int_R f*gg. *) +let WLC_XOUT = prove + (`!(f:real->real) (gg:real->real). + f real_measurable_on (:real) /\ gg real_continuous_on (:real) /\ + (!x. &0 <= f x) /\ (!x. &0 <= gg x) /\ + (\x. f x * gg x) real_integrable_on (:real) + ==> integral (:real^(1,1)finite_sum) + (\z:real^(1,1)finite_sum. if &0 < drop(sndcart z) /\ drop(sndcart z) + <= gg(drop(fstcart z)) + then lift(f(drop(fstcart z))) else vec 0) + = lift(real_integral (:real) (\x. f x * gg x))`, + REPEAT STRIP_TAC THEN + MP_TAC(MATCH_MP FUBINI_INTEGRAL (MATCH_MP WLC_ABS (ASSUME + `f real_measurable_on (:real) /\ gg real_continuous_on (:real) /\ + (!x. &0 <= f x) /\ (!x. &0 <= gg x) /\ + (\x. f x * gg x) real_integrable_on (:real)`))) THEN + DISCH_THEN SUBST1_TAC THEN + SUBGOAL_THEN + `(\x. integral (:real^1) + (\y. (\z:real^(1,1)finite_sum. if &0 < drop(sndcart z) /\ drop(sndcart + z) <= gg(drop(fstcart z)) + then lift(f(drop(fstcart z))) else vec 0) (pastecart x y))) = + (\x:real^1. lift(f(drop x) * gg(drop x)))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:real^1` THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN + MATCH_MP_TAC INTEGRAL_UNIQUE THEN + MP_TAC(ISPECL [`f:real->real`; `gg:real->real`; + `drop(x:real^1)`] WLC_XSLICE) THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP REAL_INTEGRAL) THEN + REWRITE_TAC[IMAGE_LIFT_UNIV; o_DEF] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[LIFT_DROP]);; + +(* Raw u-outer Fubini: the outer (integrate x first) iterate has_integral *) +(* int_R f*gg (FUBINI_ABSOLUTELY_INTEGRABLE_ALT on WLC_ABS, SUBS WLC_XOUT). *) +let WLC_UOUT_RAW = prove + (`!(f:real->real) (gg:real->real). + f real_measurable_on (:real) /\ gg real_continuous_on (:real) /\ + (!x. &0 <= f x) /\ (!x. &0 <= gg x) /\ + (\x. f x * gg x) real_integrable_on (:real) + ==> ((\v:real^1. integral (:real^1) (\x. (\z:real^(1,1)finite_sum. + if &0 < drop(sndcart z) /\ drop(sndcart z) <= gg(drop(fstcart z)) + then lift(f(drop(fstcart z))) else vec 0) (pastecart x v))) + has_integral lift(real_integral (:real) (\x. f x * gg x))) + (:real^1)`, + REPEAT STRIP_TAC THEN + MP_TAC(SUBS[MATCH_MP WLC_XOUT (ASSUME + `f real_measurable_on (:real) /\ gg real_continuous_on (:real) /\ + (!x. &0 <= f x) /\ (!x. &0 <= gg x) /\ + (\x. f x * gg x) real_integrable_on (:real)`)] + (CONJUNCT2 (MATCH_MP FUBINI_ABSOLUTELY_INTEGRABLE_ALT (MATCH_MP WLC_ABS + (ASSUME + `f real_measurable_on (:real) /\ gg real_continuous_on (:real) /\ + (!x. &0 <= f x) /\ (!x. &0 <= gg x) /\ + (\x. f x * gg x) real_integrable_on (:real)`))))) THEN + REWRITE_TAC[]);; + +(* 286B weighted layer-cake proper: int_{u>0} (int_{gg>=u} f) du = int_R *) +(* f*gg. *) +let WEIGHTED_LAYER_CAKE = prove + (`!(f:real->real) (gg:real->real). + f real_measurable_on (:real) /\ f absolutely_real_integrable_on (:real) /\ + gg real_continuous_on (:real) /\ + (!x. &0 <= f x) /\ (!x. &0 <= gg x) /\ + (\x. f x * gg x) real_integrable_on (:real) + ==> ((\u. real_integral {x | u <= gg x} f) has_real_integral + real_integral (:real) (\x. f x * gg x)) {u | &0 < u}`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[has_real_integral] THEN + ONCE_REWRITE_TAC[GSYM HAS_INTEGRAL_RESTRICT_UNIV] THEN + MATCH_MP_TAC HAS_INTEGRAL_SPIKE THEN + EXISTS_TAC `\v:real^1. integral (:real^1) (\x. (\z:real^(1,1)finite_sum. + if &0 < drop(sndcart z) /\ drop(sndcart z) <= gg(drop(fstcart z)) + then lift(f(drop(fstcart z))) else vec 0) (pastecart x v))` THEN + EXISTS_TAC `{}:real^1->bool` THEN + REWRITE_TAC[NEGLIGIBLE_EMPTY; IN_DIFF; NOT_IN_EMPTY] THEN CONJ_TAC THENL + [X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN + REWRITE_TAC[IN_IMAGE_LIFT_DROP; IN_ELIM_THM; o_THM] THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN + COND_CASES_TAC THENL + [MP_TAC(ISPECL [`f:real->real`; `gg:real->real`; + `x:real^1`] WLC_USLICE) THEN + ASM_REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN REFL_TAC; + SUBGOAL_THEN + `!x':real^1. ~(&0 < drop x /\ drop x <= gg(drop x'))` (fun th -> + REWRITE_TAC[th]) THENL + [ASM_MESON_TAC[]; REWRITE_TAC[INTEGRAL_0]]]; + SUBGOAL_THEN + `f real_measurable_on (:real) /\ gg real_continuous_on (:real) /\ + (!x. &0 <= f x) /\ (!x. &0 <= gg x) /\ (\x. f x * gg x) + real_integrable_on (:real)` + ASSUME_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP WLC_UOUT_RAW) THEN + REWRITE_TAC[SNDCART_PASTECART; FSTCART_PASTECART]]);; + +(* ========================================================================= *) +(* 286B assembly (M5): from the weighted layer-cake to the monotone-kernel *) +(* maximal domination. MCM = monotone-const-monotone (nondecr on (-inf,al], *) +(* nonincr on [be,inf), const on [al,be]). *) +(* ========================================================================= *) + +(* P2 (the endpoint-free integral assembly): given the PER-LEVEL bound *) +(* int_{gg>=u} f <= M * mu{gg>=u} for all u>0, *) +(* the two layer-cakes (WEIGHTED_LAYER_CAKE for int f*gg, REAL_LAYER_CAKE *) +(* for *) +(* int gg) + REAL_INTEGRAL_LE give int f*gg <= M * int gg. *) +let MCM_DOMINATION_FROM_LEVEL = prove + (`!(f:real->real) (gg:real->real) M. + f real_measurable_on (:real) /\ f absolutely_real_integrable_on (:real) /\ + gg real_continuous_on (:real) /\ (!x. &0 <= f x) /\ (!x. &0 <= gg x) /\ + (\x. f x * gg x) real_integrable_on (:real) /\ gg real_integrable_on + (:real) /\ + (!u. &0 < u ==> real_integral {x | u <= gg x} f <= M * real_measure {x | u + <= gg x}) + ==> real_integral (:real) (\x. f x * gg x) <= M * real_integral (:real) + gg`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:real->real`; `gg:real->real`] WEIGHTED_LAYER_CAKE) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(fun th -> SUBST1_TAC(SYM(MATCH_MP REAL_INTEGRAL_UNIQUE th)) THEN + ASSUME_TAC(MATCH_MP HAS_REAL_INTEGRAL_INTEGRABLE th)) THEN + MP_TAC(ISPECL [`gg:real->real`; + `real_integral (:real) gg`] REAL_LAYER_CAKE) THEN + ASM_SIMP_TAC[REAL_INTEGRABLE_INTEGRAL] THEN + DISCH_THEN(fun th -> ASSUME_TAC(MATCH_MP HAS_REAL_INTEGRAL_INTEGRABLE th) + THEN + MP_TAC(SYM(MATCH_MP REAL_INTEGRAL_UNIQUE th))) THEN + DISCH_THEN(fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [th]) THEN + ASM_SIMP_TAC[GSYM REAL_INTEGRAL_LMUL] THEN + MATCH_MP_TAC REAL_INTEGRAL_LE THEN + ASM_SIMP_TAC[IN_ELIM_THM; REAL_INTEGRABLE_LMUL]);; + +(* A bounded nonempty real-interval S has real_interval(inf S, sup S) SUBSET *) +(* S. *) +let BOUNDED_REALINTERVAL_OPEN_SUBSET = prove + (`!S. is_realinterval S /\ ~(S = {}) /\ real_bounded S + ==> real_interval(inf S, sup S) SUBSET S`, + GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "ri") STRIP_ASSUME_TAC) THEN + REWRITE_TAC[SUBSET; IN_REAL_INTERVAL] THEN X_GEN_TAC `x:real` THEN + STRIP_TAC THEN + SUBGOAL_THEN `?a. a IN S /\ a < x` STRIP_ASSUME_TAC THENL + [MP_TAC(SPECL [`x:real`] (INST [`S:real->bool`,`s:real->bool`] REAL_LE_INF)) + THEN + ASM_MESON_TAC[REAL_NOT_LT; REAL_LTE_TRANS; REAL_LT_REFL]; + ALL_TAC] THEN + SUBGOAL_THEN `?b. b IN S /\ x < b` STRIP_ASSUME_TAC THENL + [MP_TAC(SPECL [`x:real`] (INST [`S:real->bool`,`s:real->bool`] REAL_SUP_LE)) + THEN + ASM_MESON_TAC[REAL_NOT_LT; REAL_LET_TRANS; REAL_LT_REFL]; + ALL_TAC] THEN + USE_THEN "ri" (fun th -> MP_TAC(REWRITE_RULE[is_realinterval] th)) THEN + DISCH_THEN(MP_TAC o SPECL [`a:real`; `b:real`; `x:real`]) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC);; + +(* Every bounded nonempty S sits inside the closed interval [inf S, sup S]. *) +let BOUNDED_SUBSET_REALINTERVAL_CLOSED = prove + (`!S. ~(S = {}) /\ real_bounded S ==> S SUBSET real_interval[inf S, sup S]`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(X_CHOOSE_THEN + `B:real` STRIP_ASSUME_TAC o REWRITE_RULE[REAL_BOUNDED_POS_LT]) THEN + REWRITE_TAC[SUBSET; IN_REAL_INTERVAL] THEN X_GEN_TAC `x:real` THEN + DISCH_TAC THEN + MP_TAC(SPEC `S:real->bool` INF) THEN MP_TAC(SPEC `S:real->bool` SUP) THEN + ANTS_TAC THENL + [ASM_MESON_TAC[REAL_ARITH `abs(x) < B ==> x <= B`]; ALL_TAC] THEN + STRIP_TAC THEN + ANTS_TAC THENL + [ASM_MESON_TAC[REAL_ARITH `abs(x) < B ==> --B <= x`]; ALL_TAC] THEN + STRIP_TAC THEN ASM_SIMP_TAC[]);; + +(* A bounded nonempty real-interval S is measurable with measure sup S - inf *) +(* S (it differs from the open interval (inf S, sup S) by at most 2 *) +(* endpoints). *) +let MCM_LEVEL_MEASURE = prove + (`!S. is_realinterval S /\ ~(S = {}) /\ real_bounded S /\ inf S <= sup S + ==> real_measurable S /\ real_measure S = sup S - inf S`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(ISPEC `S:real->bool` BOUNDED_REALINTERVAL_OPEN_SUBSET) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MP_TAC(ISPEC `S:real->bool` BOUNDED_SUBSET_REALINTERVAL_CLOSED) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + SUBGOAL_THEN + `real_negligible((real_interval(inf S, sup S) DIFF S) UNION (S DIFF + real_interval(inf S, sup S)))` + ASSUME_TAC THENL + [MATCH_MP_TAC REAL_NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{inf S, sup S}` THEN + REWRITE_TAC[REAL_NEGLIGIBLE_INSERT; REAL_NEGLIGIBLE_SING] THEN + RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; IN_REAL_INTERVAL]) THEN + REWRITE_TAC[SUBSET; IN_UNION; IN_DIFF; IN_REAL_INTERVAL; IN_INSERT; + NOT_IN_EMPTY] THEN + GEN_TAC THEN STRIP_TAC THEN + ASM_MESON_TAC[REAL_LE_ANTISYM; REAL_LE_LT; REAL_LT_LE]; ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_MEASURABLE_REAL_NEGLIGIBLE_SYMDIFF THEN + EXISTS_TAC `real_interval(inf S, sup S)` THEN + ASM_REWRITE_TAC[REAL_MEASURABLE_REAL_INTERVAL]; + MP_TAC(ISPECL [`real_interval(inf S, sup S)`; + `S:real->bool`] REAL_MEASURE_REAL_NEGLIGIBLE_SYMDIFF) THEN + ASM_REWRITE_TAC[REAL_MEASURABLE_REAL_INTERVAL] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[REAL_MEASURE_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC]);; + +(* MCM structure: gg attains its global maximum on the flat middle [al,be], *) +(* so gg x <= gg al for every x. *) +let MCM_GLOBAL_MAX = prove + (`!(gg:real->real) (al:real) (be:real) (x:real). + al <= be /\ + (!x y. x <= y /\ y <= al ==> gg x <= gg y) /\ + (!x y. be <= x /\ x <= y ==> gg y <= gg x) /\ + (!x. al <= x /\ x <= be ==> gg x = gg al) + ==> gg x <= gg al`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 (LABEL_TAC "inc") + (CONJUNCTS_THEN2 (LABEL_TAC "dec") (LABEL_TAC "flat")))) THEN + ASM_CASES_TAC `x <= al` THENL + [USE_THEN "inc" (MP_TAC o SPECL [`x:real`; `al:real`]) THEN + ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_CASES_TAC `x <= be` THENL + [SUBGOAL_THEN + `(gg:real->real) x = gg al` (fun th -> REWRITE_TAC[th; REAL_LE_REFL]) THEN + USE_THEN "flat" (MP_TAC o SPEC `x:real`) THEN ANTS_TAC THENL + [ASM_REAL_ARITH_TAC; REWRITE_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN + `(gg:real->real) be = gg al` (fun th -> ONCE_REWRITE_TAC[GSYM th]) THENL + [USE_THEN "flat" (MP_TAC o SPEC `be:real`) THEN + ASM_REAL_ARITH_TAC; ALL_TAC] THEN + USE_THEN "dec" (MP_TAC o SPECL [`be:real`; `x:real`]) THEN + ASM_REAL_ARITH_TAC);; + +(* P1 (the per-level bound): for u>0 the superlevel set gg>=u is a bounded *) +(* interval that (when nonempty) contains [al,be] (MCM_GLOBAL_MAX + MCM_ *) +(* SUPERLEVEL_INTERVAL); its endpoints straddle [al,be] so the *) +(* interval-average hypothesis gives int_S f = int_[inf,sup] f <= *) +(* M*(sup-inf) = M*mu S. *) +let MCM_LEVEL_INTEGRAL_BOUND = prove + (`!(f:real->real) (gg:real->real) al be (M:real) u. + al <= be /\ + (!x y. x <= y /\ y <= al ==> gg x <= gg y) /\ + (!x y. be <= x /\ x <= y ==> gg y <= gg x) /\ + (!x. al <= x /\ x <= be ==> gg x = gg al) /\ + (!x. &0 <= f x) /\ f absolutely_real_integrable_on (:real) /\ + real_bounded {x | u <= gg x} /\ + (!a b. a <= al /\ be <= b ==> real_integral (real_interval[a,b]) f <= M * + (b - a)) /\ + &0 < u + ==> real_integral {x | u <= gg x} f <= M * real_measure {x | u <= gg x}`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "albe") + (CONJUNCTS_THEN2 (LABEL_TAC "inc") + (CONJUNCTS_THEN2 (LABEL_TAC "dec") + (CONJUNCTS_THEN2 (LABEL_TAC "flat") + (CONJUNCTS_THEN2 (LABEL_TAC "fpos") + (CONJUNCTS_THEN2 (LABEL_TAC "fint") + (CONJUNCTS_THEN2 (LABEL_TAC "bdd") + (CONJUNCTS_THEN2 (LABEL_TAC "avg") (LABEL_TAC "upos"))))))))) THEN + ASM_CASES_TAC `{x | u <= gg x} = ({}:real->bool)` THENL + [ASM_REWRITE_TAC[REAL_INTEGRAL_EMPTY; REAL_MEASURE_EMPTY] THEN + REAL_ARITH_TAC; ALL_TAC] THEN + ABBREV_TAC `S = {x:real | u <= gg x}` THEN + SUBGOAL_THEN `u <= (gg:real->real) al` (LABEL_TAC "ugal") THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + EXPAND_TAC "S" THEN REWRITE_TAC[IN_ELIM_THM] THEN + DISCH_THEN(X_CHOOSE_TAC `x0:real`) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(gg:real->real) x0` THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`gg:real->real`; `al:real`; `be:real`; + `x0:real`] MCM_GLOBAL_MAX) THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `(gg:real->real) be = gg al` (LABEL_TAC "gbe") THENL + [USE_THEN "flat" (MP_TAC o SPEC `be:real`) THEN + ANTS_TAC THENL [USE_THEN "albe" MP_TAC THEN + REAL_ARITH_TAC; REWRITE_TAC[]]; ALL_TAC] THEN + SUBGOAL_THEN `(al:real) IN S /\ (be:real) IN S` STRIP_ASSUME_TAC THENL + [EXPAND_TAC "S" THEN REWRITE_TAC[IN_ELIM_THM] THEN CONJ_TAC THENL + [USE_THEN "ugal" ACCEPT_TAC; + USE_THEN "gbe" (fun th -> REWRITE_TAC[th]) THEN USE_THEN + "ugal" ACCEPT_TAC]; ALL_TAC] THEN + SUBGOAL_THEN `is_realinterval S` (LABEL_TAC "ri") THENL + [EXPAND_TAC "S" THEN + MP_TAC(ISPECL [`gg:real->real`; `al:real`; `be:real`; + `u:real`] MCM_SUPERLEVEL_INTERVAL) THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `inf S <= al /\ be <= sup S` STRIP_ASSUME_TAC THENL + [USE_THEN "bdd" (X_CHOOSE_THEN + `B:real` STRIP_ASSUME_TAC o REWRITE_RULE[REAL_BOUNDED_POS_LT]) THEN + MP_TAC(SPEC `S:real->bool` INF) THEN MP_TAC(SPEC `S:real->bool` SUP) THEN + ANTS_TAC THENL + [ASM_MESON_TAC[REAL_ARITH `abs(x) < B ==> x <= B`]; ALL_TAC] THEN + STRIP_TAC THEN + ANTS_TAC THENL + [ASM_MESON_TAC[REAL_ARITH `abs(x) < B ==> --B <= x`]; ALL_TAC] THEN + STRIP_TAC THEN ASM_SIMP_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `inf S <= sup S` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPEC `S:real->bool` MCM_LEVEL_MEASURE) THEN ASM_REWRITE_TAC[] THEN + STRIP_TAC THEN + SUBGOAL_THEN + `real_negligible((S DIFF real_interval[inf S,sup S]) UNION + (real_interval[inf S,sup S] DIFF S))` + ASSUME_TAC THENL + [MP_TAC(ISPEC `S:real->bool` BOUNDED_REALINTERVAL_OPEN_SUBSET) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MP_TAC(ISPEC `S:real->bool` BOUNDED_SUBSET_REALINTERVAL_CLOSED) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{inf S, sup S}` THEN + REWRITE_TAC[REAL_NEGLIGIBLE_INSERT; REAL_NEGLIGIBLE_SING] THEN + RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; IN_REAL_INTERVAL]) THEN + REWRITE_TAC[SUBSET; IN_UNION; IN_DIFF; IN_REAL_INTERVAL; IN_INSERT; + NOT_IN_EMPTY] THEN + GEN_TAC THEN STRIP_TAC THEN + ASM_MESON_TAC[REAL_LE_ANTISYM; REAL_LE_LT; REAL_LT_LE]; ALL_TAC] THEN + SUBGOAL_THEN + `real_integral S f = real_integral (real_interval[inf S, sup S]) f` + SUBST1_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_SPIKE_SET THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `M * (sup S - inf S)` THEN + CONJ_TAC THENL + [USE_THEN "avg" (MP_TAC o SPECL [`inf S:real`; `sup S:real`]) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; REWRITE_TAC[]]; + REWRITE_TAC[REAL_LE_REFL]]);; + +(* 286B (the monotone-kernel maximal domination lemma, Fremlin): for f>=0 *) +(* measurable+abs-integrable and gg an MCM kernel (nondecr on (-inf,al], *) +(* nonincr on [be,inf), const on [al,be]) that is >=0, continuous, *) +(* integrable *) +(* with bounded superlevels, and with all straddling averages bounded by M, *) +(* int_R f*gg <= M * int_R gg. *) +(* = P1 (MCM_LEVEL_INTEGRAL_BOUND, per-level) fed into P2 (MCM_DOMINATION_ *) +(* FROM_LEVEL, the layer-cake assembly). The M is folded (no REAL_SUP here) *) +(* -- *) +(* AVG_LE_HL_MAXIMAL identifies M with the H-L maximal function at the M6 *) +(* step. *) +let MCM_MAXIMAL_DOMINATION = prove + (`!(f:real->real) (gg:real->real) al be (M:real). + al <= be /\ + (!x y. x <= y /\ y <= al ==> gg x <= gg y) /\ + (!x y. be <= x /\ x <= y ==> gg y <= gg x) /\ + (!x. al <= x /\ x <= be ==> gg x = gg al) /\ + f real_measurable_on (:real) /\ f absolutely_real_integrable_on (:real) /\ + (!x. &0 <= f x) /\ (!x. &0 <= gg x) /\ gg real_continuous_on (:real) /\ + (\x. f x * gg x) real_integrable_on (:real) /\ gg real_integrable_on + (:real) /\ + (!u. &0 < u ==> real_bounded {x | u <= gg x}) /\ + (!a b. a <= al /\ be <= b ==> real_integral (real_interval[a,b]) f <= M * + (b - a)) + ==> real_integral (:real) (\x. f x * gg x) <= M * real_integral (:real) + gg`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC MCM_DOMINATION_FROM_LEVEL THEN + ASM_REWRITE_TAC[] THEN + X_GEN_TAC `u:real` THEN DISCH_TAC THEN + MATCH_MP_TAC MCM_LEVEL_INTEGRAL_BOUND THEN + MAP_EVERY EXISTS_TAC [`al:real`; `be:real`] THEN ASM_SIMP_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* The MAIN region layer-cake (Fremlin 286A(c) proper): the 2u-weighted *) +(* integral over S = {(x,u) | 00} 2u mu(G_u) du. *) +(* Integrand SIGMA(z) = if z IN S then lift(2 drop(sndcart z)) else 0. *) +(* ------------------------------------------------------------------------- *) + +(* SIGMA is measurable: 2*sndcart (continuous) restricted to the OPEN region *) +(* S (MAXIMAL_REGION_OPEN_FS => lebesgue_measurable). *) +let SIGMA_MEAS = prove + (`!f:real->real. f real_integrable_on (:real) + ==> (\z:real^(1,1)finite_sum. + if &0 < drop(sndcart z) /\ + (?a. drop(fstcart z) < a /\ + (a - drop(fstcart z)) * drop(sndcart z) < + real_integral (real_interval[drop(fstcart z),a]) f) + then lift(&2 * drop(sndcart z)) else vec 0) + measurable_on (:real^(1,1)finite_sum)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\z:real^(1,1)finite_sum. + if &0 < drop(sndcart z) /\ + (?a. drop(fstcart z) < a /\ + (a - drop(fstcart z)) * drop(sndcart z) < + real_integral (real_interval[drop(fstcart z),a]) f) + then lift(&2 * drop(sndcart z)) else vec 0) = + (\z:real^(1,1)finite_sum. + if z IN {w | &0 < drop(sndcart w) /\ + ?a. drop(fstcart w) < a /\ + (a - drop(fstcart w)) * drop(sndcart w) < + real_integral (real_interval[drop(fstcart w),a]) f} + then (\z. lift(&2 * drop(sndcart z))) z else vec 0)` + SUBST1_TAC THENL [REWRITE_TAC[IN_ELIM_THM]; ALL_TAC] THEN + MATCH_MP_TAC MEASURABLE_ON_RESTRICT THEN CONJ_TAC THENL + [SUBGOAL_THEN `(\z:real^(1,1)finite_sum. lift(&2 * drop(sndcart z))) = + (\z:real^(1,1)finite_sum. &2 % sndcart z)` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM LIFT_DROP] THEN + REWRITE_TAC[GSYM LIFT_CMUL] THEN AP_TERM_TAC THEN REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_IMP_MEASURABLE_ON THEN + MATCH_MP_TAC CONTINUOUS_ON_CMUL THEN + SIMP_TAC[LINEAR_CONTINUOUS_ON; LINEAR_SNDCART]; + MATCH_MP_TAC LEBESGUE_MEASURABLE_OPEN THEN + MATCH_MP_TAC MAXIMAL_REGION_OPEN_FS THEN ASM_REWRITE_TAC[]]);; + +(* The horizontal (x-)slice of SIGMA at fixed height u_pt (drop u_pt > 0): *) +(* integral over x = 2u * mu(G_u), where G_u is the (measurable) superlevel *) +(* set. SIGMA(pastecart x u) = (2u) times the indicator of IMAGE lift G_u; *) +(* use HAS_INTEGRAL_CMUL + the HAS_MEASURE definition (as in U_INNER). *) +let SIGMA_USLICE = prove + (`!f:real->real u_pt. f real_integrable_on (:real) /\ (!x. &0 <= f x) /\ &0 < + drop u_pt + ==> ((\x:real^1. (\z:real^(1,1)finite_sum. + if &0 < drop(sndcart z) /\ + (?a. drop(fstcart z) < a /\ + (a - drop(fstcart z)) * drop(sndcart z) < + real_integral (real_interval[drop(fstcart z),a]) f) + then lift(&2 * drop(sndcart z)) else vec 0) + (pastecart x u_pt)) + has_integral + lift(&2 * drop u_pt * + real_measure {x | ?a. x < a /\ (a - x) * drop u_pt < real_integral + (real_interval[x,a]) f})) + (:real^1)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN ASM_REWRITE_TAC[] THEN + ABBREV_TAC `G = {x | ?a. x < a /\ (a - x) * drop u_pt < real_integral + (real_interval[x,a]) f}` THEN + SUBGOAL_THEN `real_measurable G` ASSUME_TAC THENL + [EXPAND_TAC "G" THEN MATCH_MP_TAC MAXIMAL_SUPERLEVEL_MEASURABLE THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `!x:real^1. (if ?a. drop x < a /\ (a - drop x) * drop u_pt < + real_integral (real_interval[drop x,a]) f + then lift(&2 * drop u_pt) else vec 0) = + (&2 * drop u_pt) % (if x IN IMAGE lift G then vec 1 else vec 0)` + (fun th -> REWRITE_TAC[th]) THENL + [X_GEN_TAC `x:real^1` THEN + SUBGOAL_THEN `(x IN IMAGE lift G) <=> + (?a. drop x < a /\ (a - drop x) * drop u_pt < + real_integral (real_interval[drop x,a]) f)` SUBST1_TAC + THENL + [REWRITE_TAC[IN_IMAGE] THEN EXPAND_TAC "G" THEN + REWRITE_TAC[IN_ELIM_THM] THEN + EQ_TAC THENL + [DISCH_THEN(X_CHOOSE_THEN `y:real` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM SUBST_ALL_TAC THEN REWRITE_TAC[LIFT_DROP] THEN + EXISTS_TAC `a:real` THEN ASM_REWRITE_TAC[]; + DISCH_TAC THEN EXISTS_TAC `drop x` THEN ASM_REWRITE_TAC[LIFT_DROP]]; + COND_CASES_TAC THEN + REWRITE_TAC[GSYM LIFT_EQ_CMUL; VECTOR_MUL_RZERO; LIFT_NUM]]; + ALL_TAC] THEN + SUBGOAL_THEN `lift(&2 * drop u_pt * real_measure G) = + (&2 * drop u_pt) % lift(real_measure G)` SUBST1_TAC THENL + [REWRITE_TAC[GSYM LIFT_CMUL; REAL_MUL_ASSOC]; ALL_TAC] THEN + MATCH_MP_TAC HAS_INTEGRAL_CMUL THEN + REWRITE_TAC[REAL_MEASURE_MEASURE; GSYM HAS_MEASURE] THEN + REWRITE_TAC[GSYM HAS_MEASURE_MEASURE] THEN + ASM_REWRITE_TAC[GSYM REAL_MEASURABLE_MEASURABLE]);; + +(* Vector form of XSLICE_REAL: int_{u:real^1} (if 0= 0. (Bridge via has_real_integral defn.) *) +let XSLICE_VEC = prove + (`!A. &0 <= A + ==> ((\u:real^1. if &0 < drop u /\ drop u < A then lift(&2 * drop u) else + vec 0) + has_integral lift(A pow 2)) (:real^1)`, + REPEAT STRIP_TAC THEN + MP_TAC(SPEC `A:real` + (prove(`!A. &0 <= A + ==> ((\t. if t IN {u | &0 < u} then (if t < A then &2 * t else &0) else + &0) + has_real_integral A pow 2) (:real)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[HAS_REAL_INTEGRAL_RESTRICT_UNIV] THEN + MATCH_MP_TAC XSLICE_REAL THEN ASM_REWRITE_TAC[]))) THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[has_real_integral; IMAGE_LIFT_UNIV; o_DEF] THEN + REWRITE_TAC[IN_ELIM_THM] THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + ABS_TAC THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[LIFT_NUM] THEN + COND_CASES_TAC THEN REWRITE_TAC[LIFT_NUM] THEN ASM_REAL_ARITH_TAC);; + +(* The horizontal (x-)slice of SIGMA at fixed spatial point x_pt: integral *) +(* over *) +(* u = f1star(x_pt)^2. Uses the superlevel BICONDITIONAL *) +(* (HL_FWD_SUPERLEVEL_SUB *) +(* + _SUPER, needs boundedness) to rewrite the region condition to u < *) +(* f1star, *) +(* then XSLICE_VEC with A = f1star(x_pt) >= 0 (HL_FWD_POS). *) +let SIGMA_XSLICE = prove + (`!f:real->real M x_pt. f real_integrable_on (:real) /\ (!x. &0 <= f x) /\ + (!x. abs(f x) <= M) + ==> ((\u:real^1. (\z:real^(1,1)finite_sum. + if &0 < drop(sndcart z) /\ + (?a. drop(fstcart z) < a /\ + (a - drop(fstcart z)) * drop(sndcart z) < + real_integral (real_interval[drop(fstcart z),a]) f) + then lift(&2 * drop(sndcart z)) else vec 0) + (pastecart x_pt u)) + has_integral lift((hl_maximal_fwd f (drop x_pt)) pow 2)) (:real^1)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN + SUBGOAL_THEN + `!u:real^1. (&0 < drop u /\ + (?a. drop x_pt < a /\ (a - drop x_pt) * drop u < + real_integral (real_interval[drop x_pt,a]) f)) + <=> (&0 < drop u /\ drop u < hl_maximal_fwd f (drop x_pt))` + (fun th -> REWRITE_TAC[th]) THENL + [GEN_TAC THEN AP_TERM_TAC THEN EQ_TAC THENL + [STRIP_TAC THEN MATCH_MP_TAC HL_FWD_SUPERLEVEL_SUPER THEN + EXISTS_TAC `M:real` THEN ASM_REWRITE_TAC[] THEN + EXISTS_TAC `a:real` THEN ASM_REWRITE_TAC[]; + DISCH_TAC THEN + MP_TAC(ISPECL [`f:real->real`; `drop u`; + `drop x_pt`] HL_FWD_SUPERLEVEL_SUB) THEN + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + MP_TAC(ISPEC `hl_maximal_fwd f (drop x_pt)` XSLICE_VEC) THEN + ANTS_TAC THENL + [MP_TAC(ISPECL [`f:real->real`; `M:real`] HL_FWD_POS) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `drop(x_pt:real^1)`) THEN + REWRITE_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[]);; + +(* The superlevel set G_u is ANTITONE in u (u <= v ==> G_v SUBSET G_u): a *) +(* larger threshold is harder to meet. Hence u |-> mu(G_u) is *) +(* non-increasing, *) +(* which (with the refined bound) will give integrability of u |-> 2u *) +(* mu(G_u). *) +(* NOTE annotate the fresh product `((b:real) - y) * v` fed to EXISTS_TAC *) +(* (else *) +(* it parses as real^2 vector subtraction). *) +let GU_ANTITONE = prove + (`!f:real->real u v. &0 < u /\ u <= v + ==> {y | ?a. y < a /\ (a - y) * v < real_integral (real_interval[y,a]) f} + SUBSET + {y | ?a. y < a /\ (a - y) * u < real_integral (real_interval[y,a]) f}`, + REPEAT STRIP_TAC THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN + X_GEN_TAC `y:real` THEN DISCH_THEN(X_CHOOSE_THEN + `b:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `b:real` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `((b:real) - y) * v` THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REAL_ARITH_TAC);; + +(* Hence u |-> mu(G_u) is non-increasing on u > 0 (GU_ANTITONE + *) +(* REAL_MEASURE_ *) +(* SUBSET, both G's measurable via MAXIMAL_SUPERLEVEL_MEASURABLE). Route to *) +(* the *) +(* integrability of the u-iterate u |-> 2u mu(G_u). *) +let MU_G_DECREASING = prove + (`!f:real->real u v. f real_integrable_on (:real) /\ (!x. &0 <= f x) /\ &0 < u + /\ u <= v + ==> real_measure {y | ?a. y < a /\ (a - y) * v < real_integral + (real_interval[y,a]) f} <= + real_measure {y | ?a. y < a /\ (a - y) * u < real_integral + (real_interval[y,a]) f}`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_MEASURE_SUBSET THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC MAXIMAL_SUPERLEVEL_MEASURABLE THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC; + MATCH_MP_TAC MAXIMAL_SUPERLEVEL_MEASURABLE THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC GU_ANTITONE THEN ASM_REWRITE_TAC[]]);; + +(* u |-> 2u mu(G_u) is integrable on any closed subinterval [a,b] with a > *) +(* 0: 2u is continuous (integrable) and mu(G_u) is decreasing there *) +(* (REAL_INTEGRABLE_DECREASING_PRODUCT + MU_G_DECREASING). *) +let MAIN_UITER_INTERVAL = prove + (`!f:real->real a b. f real_integrable_on (:real) /\ (!x. &0 <= f x) /\ &0 < a + ==> (\u. &2 * u * real_measure {y | ?c. y < c /\ (c - y) * u < real_integral + (real_interval[y,c]) f}) + real_integrable_on real_interval[a,b]`, + REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[REAL_ARITH `&2 * u * m = m * &2 * u`] THEN + MATCH_MP_TAC REAL_INTEGRABLE_DECREASING_PRODUCT THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_CONTINUOUS THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_LMUL THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_ID]; + REPEAT STRIP_TAC THEN MATCH_MP_TAC MU_G_DECREASING THEN + ASM_REWRITE_TAC[] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_REAL_INTERVAL]) THEN ASM_REAL_ARITH_TAC]);; + +(* The dominating function h(u) = 4 int_R (f - u/2)_+ is integrable on {u>0} *) +(* (4 times the POS_PART_LAYER_CAKE integrand). *) +let DOMH = prove + (`!f:real->real. f real_measurable_on (:real) /\ f real_integrable_on (:real) + /\ + (!x. &0 <= f x) /\ (\x. f x pow 2) real_integrable_on (:real) + ==> (\u. &4 * real_integral (:real) (\y. max (&0) (f y - u / &2))) + real_integrable_on {u | &0 < u}`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRABLE_LMUL THEN + REWRITE_TAC[real_integrable_on] THEN + EXISTS_TAC `real_integral (:real) (\x. (f:real->real) x pow 2)` THEN + MATCH_MP_TAC POS_PART_LAYER_CAKE THEN ASM_REWRITE_TAC[]);; + +(* Domination for the dominated-convergence argument: the truncated *) +(* approximant *) +(* (2u mu(G_u) on [1/(k+1),k+1], else 0) is bounded in abs by h(u) = 4 int *) +(* (f-u/2)_+, uniformly in k, for u > 0. Uses MAXIMAL_WEAK_TYPE_REFINED *) +(* (u mu(G_u) <= 2 int(f-u/2)_+) and mu(G_u) >= 0. ABBREV m, q to keep *) +(* ASM_REAL_ARITH_TAC linear (the whole context has the nonlinear refined *) +(* bound). *) +let MAIN_DOM = prove + (`!f:real->real k u. f real_integrable_on (:real) /\ (!x. &0 <= f x) /\ u IN + {u | &0 < u} + ==> abs((if u IN real_interval[inv(&k + &1), &k + &1] + then &2 * u * real_measure {x | ?a. x < a /\ (a - x) * u < + real_integral (real_interval[x,a]) f} + else &0)) + <= &4 * real_integral (:real) (\y. max (&0) (f y - u / &2))`, + REPEAT STRIP_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[IN_ELIM_THM]) THEN + MP_TAC(ISPECL [`f:real->real`; `u:real`] MAXIMAL_WEAK_TYPE_REFINED) THEN + ASM_REWRITE_TAC[] THEN + ABBREV_TAC `m = real_measure {x | ?a. x < a /\ (a - x) * u < real_integral + (real_interval[x,a]) f}` THEN + ABBREV_TAC `q = real_integral (:real) (\y. max (&0) (f y - u / &2))` THEN + DISCH_TAC THEN + SUBGOAL_THEN `&0 <= m` ASSUME_TAC THENL + [EXPAND_TAC "m" THEN MATCH_MP_TAC REAL_MEASURE_POS_LE THEN + MATCH_MP_TAC MAXIMAL_SUPERLEVEL_MEASURABLE THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `&0 <= u * m` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + COND_CASES_TAC THEN + REWRITE_TAC[REAL_ARITH `&2 * u * m = &2 * (u * m)`] THEN + ASM_REAL_ARITH_TAC);; + +(* Arithmetic helper for the pointwise limit: inv K <= u when u+inv u <= K. *) +let INV_HELP = prove + (`!u K:real. &0 < u /\ &0 < K /\ u + inv u <= K ==> inv K <= u`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `inv u <= K` ASSUME_TAC THENL + [MP_TAC(SPEC `u:real` REAL_LE_INV_EQ) THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_INV] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN ASM_SIMP_TAC[REAL_LT_INV_EQ]);; + +(* The truncated approximant f_k (= 2u mu(G_u) on [1/(k+1),k+1], else 0) is *) +(* integrable on {u>0}: MAIN_UITER_INTERVAL on [1/(k+1),k+1] (a>0), *) +(* restricted to {u>0} (REAL_INTEGRABLE_RESTRICT_INTER; the interval meets *) +(* {u>0} in itself). *) +let MAIN_FK = prove + (`!f:real->real k. f real_integrable_on (:real) /\ (!x. &0 <= f x) + ==> (\u. if u IN real_interval[inv(&k + &1), &k + &1] + then &2 * u * real_measure {x | ?a. x < a /\ (a - x) * u < + real_integral (real_interval[x,a]) f} + else &0) real_integrable_on {u | &0 < u}`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[REAL_INTEGRABLE_RESTRICT_INTER] THEN + SUBGOAL_THEN + `real_interval[inv(&k + &1), &k + &1] INTER {u | &0 < u} = + real_interval[inv(&k + &1), &k + &1]` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_INTER; IN_REAL_INTERVAL; IN_ELIM_THM] THEN + GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MP_TAC(SPEC `&k + &1` REAL_LT_INV_EQ) THEN + SIMP_TAC[REAL_ARITH `&0 < &k + &1`] THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC MAIN_UITER_INTERVAL THEN ASM_REWRITE_TAC[REAL_LT_INV_EQ] THEN + REAL_ARITH_TAC]);; + +(* Pointwise limit: for fixed u > 0, f_k(u) -> c (the value 2u mu(G_u)) *) +(* since u lies in [1/(k+1),k+1] for all large k (REALLIM_EVENTUALLY + *) +(* REAL_ARCH). *) +let MAIN_LIM = prove + (`!u:real c. &0 < u + ==> ((\k. if u IN real_interval[inv(&k + &1), &k + &1] then c else &0) ---> + c) sequentially`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REALLIM_EVENTUALLY THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN BETA_TAC THEN + X_CHOOSE_TAC `N:num` (SPEC `(u:real) + inv u` REAL_ARCH_SIMPLE) THEN + EXISTS_TAC `N:num` THEN X_GEN_TAC `k:num` THEN DISCH_TAC THEN + SUBGOAL_THEN `&0 < inv u` ASSUME_TAC THENL + [ASM_SIMP_TAC[REAL_LT_INV_EQ]; ALL_TAC] THEN + SUBGOAL_THEN `(u:real) + inv u <= &k + &1` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&N:real` THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `&N:real <= &k` MP_TAC THENL + [ASM_REWRITE_TAC[REAL_OF_NUM_LE]; REAL_ARITH_TAC]; ALL_TAC] THEN + SUBGOAL_THEN `u IN real_interval[inv(&k + &1), &k + &1]` + (fun th -> REWRITE_TAC[th]) THEN + REWRITE_TAC[IN_REAL_INTERVAL] THEN CONJ_TAC THENL + [MATCH_MP_TAC INV_HELP THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + ASM_REAL_ARITH_TAC]);; + +(* THE u-iterate is integrable: u |-> 2u mu(G_u) is integrable on {u>0}. *) +(* REAL_DOMINATED_CONVERGENCE with approximants f_k truncated to *) +(* [1/(k+1),k+1]: *) +(* MAIN_FK (each integrable), DOMH (dominator 4 int(f-u/2)_+ integrable), *) +(* MAIN_DOM (uniform domination), MAIN_LIM (pointwise limit). This is the *) +(* integrability hypothesis of the u-outer Fubini gate for the main region. *) +let MAIN_UITER = prove + (`!f:real->real. f real_measurable_on (:real) /\ f real_integrable_on (:real) + /\ + (!x. &0 <= f x) /\ (\x. f x pow 2) real_integrable_on (:real) + ==> (\u. &2 * u * real_measure {x | ?a. x < a /\ (a - x) * u < real_integral + (real_interval[x,a]) f}) + real_integrable_on {u | &0 < u}`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`\k u. if u IN real_interval[inv(&k + &1), &k + &1] + then &2 * u * real_measure {x | ?a. x < a /\ (a - x) * u < + real_integral (real_interval[x,a]) f} + else &0`; + `\u. &2 * u * real_measure {x | ?a. x < a /\ (a - x) * u < real_integral + (real_interval[x,a]) f}`; + `\u. &4 * real_integral (:real) (\y. max (&0) (f y - u / &2))`; + `{u | &0 < u}`] REAL_DOMINATED_CONVERGENCE) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [GEN_TAC THEN REWRITE_TAC[] THEN MATCH_MP_TAC MAIN_FK THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC DOMH THEN ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN MATCH_MP_TAC MAIN_DOM THEN + ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN MATCH_MP_TAC MAIN_LIM THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_ELIM_THM]) THEN ASM_REWRITE_TAC[]]; + REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[]]);; + +(* Real->vector bridge for the u-iterate: a real function integrable on *) +(* {u>0} gives the lift-extended (0 off {drop y>0}) vector function *) +(* integrable on (:real^1) (via has_real_integral defn + *) +(* HAS_INTEGRAL_RESTRICT_UNIV). *) +let UITER_VEC_BRIDGE = prove + (`!g:real->real. g real_integrable_on {u | &0 < u} + ==> (\y:real^1. if &0 < drop y then lift(g(drop y)) else vec 0) + integrable_on (:real^1)`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o REWRITE_RULE[real_integrable_on]) THEN + DISCH_THEN(X_CHOOSE_TAC `k:real`) THEN + REWRITE_TAC[integrable_on] THEN EXISTS_TAC `lift k` THEN + SUBGOAL_THEN + `(\y:real^1. if &0 < drop y then lift(g(drop y)) else vec 0) = + (\y:real^1. if y IN {w | &0 < drop w} then (\w. lift(g(drop w))) y else vec + 0)` + SUBST1_TAC THENL [REWRITE_TAC[IN_ELIM_THM]; ALL_TAC] THEN + REWRITE_TAC[HAS_INTEGRAL_RESTRICT_UNIV] THEN + FIRST_X_ASSUM(MP_TAC o REWRITE_RULE[has_real_integral; o_DEF]) THEN + SUBGOAL_THEN `IMAGE lift {u | &0 < u} = {w:real^1 | &0 < drop w}` + (fun th -> REWRITE_TAC[th]) THEN + REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM] THEN GEN_TAC THEN EQ_TAC THENL + [STRIP_TAC THEN ASM_REWRITE_TAC[LIFT_DROP]; + DISCH_TAC THEN EXISTS_TAC `drop x` THEN ASM_REWRITE_TAC[LIFT_DROP]]);; + +(* The x-slice (fixed height y with drop y > 0) of the SIGMA region *) +(* integrand is absolutely integrable on x (its integral = 2 (drop y) *) +(* mu(G_(drop y))). Mirrors PSI_SLICE_ABS; witness from SIGMA_USLICE. *) +let SIGMA_SLICE_ABS = prove + (`!f:real->real y:real^1. f real_integrable_on (:real) /\ (!x. &0 <= f x) /\ + &0 < drop y + ==> (\x. (\z:real^(1,1)finite_sum. + if &0 < drop(sndcart z) /\ + (?a. drop(fstcart z) < a /\ + (a - drop(fstcart z)) * drop(sndcart z) < + real_integral (real_interval[drop(fstcart z),a]) f) + then lift(&2 * drop(sndcart z)) else vec 0) + (pastecart x y)) + absolutely_integrable_on (:real^1)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC NONNEGATIVE_ABSOLUTELY_INTEGRABLE THEN + CONJ_TAC THENL + [REPEAT GEN_TAC THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN + STRIP_TAC THEN + SUBGOAL_THEN `i = 1` SUBST_ALL_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE[DIMINDEX_1]) THEN + ASM_ARITH_TAC; ALL_TAC] THEN + COND_CASES_TAC THEN REWRITE_TAC[LIFT_COMPONENT; VEC_COMPONENT] THEN + ASM_REAL_ARITH_TAC; + MP_TAC(ISPECL [`f:real->real`; `y:real^1`] SIGMA_USLICE) THEN + ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN REWRITE_TAC[integrable_on] THEN + EXISTS_TAC `lift(&2 * drop y * real_measure {x | ?a. x < a /\ (a - x) * + drop y < real_integral (real_interval[x,a]) f})` THEN + ASM_REWRITE_TAC[]]);; + +(* The SIGMA region integrand z |-> 2 sndcart z * [z in main region] is *) +(* absolutely integrable on R^2. u-OUTER Tonelli gate *) +(* (REAL_FUBINI_NONNEG_ABS_ *) +(* ALT): nonneg + every x-slice abs-int (SIGMA_SLICE_ABS for y>0, else zero) *) +(* + *) +(* the u-iterate (\y. int_x SIGMA)(y) = 2y mu(G_y) integrable (SIGMA_USLICE *) +(* identifies the slice integral; MAIN_UITER + UITER_VEC_BRIDGE give its *) +(* integrability). Twin of PSI_ABS, oriented u-outer to dodge the circular *) +(* "int (f1star)^2 finite". *) +let SIGMA_ABS = prove + (`!f:real->real. + f real_measurable_on (:real) /\ f real_integrable_on (:real) /\ + (!x. &0 <= f x) /\ (\x. f x pow 2) real_integrable_on (:real) + ==> (\z:real^(1,1)finite_sum. + if &0 < drop(sndcart z) /\ + (?a. drop(fstcart z) < a /\ + (a - drop(fstcart z)) * drop(sndcart z) < + real_integral (real_interval[drop(fstcart z),a]) f) + then lift(&2 * drop(sndcart z)) else vec 0) + absolutely_integrable_on (:real^(1,1)finite_sum)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_FUBINI_NONNEG_ABS_ALT THEN + REPEAT CONJ_TAC THENL + [ASM_SIMP_TAC[SIGMA_MEAS]; + GEN_TAC THEN REWRITE_TAC[] THEN COND_CASES_TAC THEN + REWRITE_TAC[DROP_VEC; LIFT_DROP; REAL_LE_REFL] THEN ASM_REAL_ARITH_TAC; + X_GEN_TAC `y:real^1` THEN + ASM_CASES_TAC `&0 < drop(y:real^1)` THENL + [ASM_SIMP_TAC[SIGMA_SLICE_ABS]; + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[ABSOLUTELY_INTEGRABLE_0]]; + SUBGOAL_THEN + `(\y. integral (:real^1) + (\x. (\z:real^(1,1)finite_sum. + if &0 < drop(sndcart z) /\ + (?a. drop(fstcart z) < a /\ (a - drop(fstcart z)) * drop(sndcart + z) < real_integral (real_interval[drop(fstcart z),a]) f) + then lift(&2 * drop(sndcart z)) else vec 0) (pastecart x y))) = + (\y:real^1. if &0 < drop y + then lift(&2 * drop y * real_measure {x | ?a. x < a /\ (a - + x) * drop y < real_integral (real_interval[x,a]) f}) + else vec 0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `y:real^1` THEN + COND_CASES_TAC THENL + [MP_TAC(ISPECL [`f:real->real`; `y:real^1`] SIGMA_USLICE) THEN + ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN + FIRST_X_ASSUM(fun th -> ONCE_REWRITE_TAC[MATCH_MP INTEGRAL_UNIQUE + th]) THEN + REFL_TAC; + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[INTEGRAL_0]]; + ALL_TAC] THEN + MP_TAC(ISPEC + `\u. &2 * u * real_measure {x | ?a. x < a /\ (a - x) * u < real_integral + (real_interval[x,a]) f}` + UITER_VEC_BRIDGE) THEN + ANTS_TAC THENL [MATCH_MP_TAC MAIN_UITER THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* The MAIN region layer-cake (Fremlin 286A(c) proper). SIGMA integrated *) +(* two ways: int_R (f1star)^2 = int_(:R^2) SIGMA = int_{u>0} 2u mu(G_u) du. *) +(* Twin of the POS_PART_FUBINI_RAW / POS_PART_LAYER_CAKE construction. *) +(* ------------------------------------------------------------------------- *) + +(* x-OUTER raw Fubini: the x-outer iterate (\x. int_y SIGMA(pastecart x y)) *) +(* has_integral int_(:R^2) SIGMA. Stated in the raw (unreduced pastecart, *) +(* inner bound var y matching FUBINI's) form so the combine avoids "Failure *) +(* ABS" -- MP_TAC(...FUBINI_ABSOLUTELY_INTEGRABLE...) THEN REWRITE_TAC[]. *) +let MAIN_XOUT_RAW = prove + (`!f:real->real. + f real_measurable_on (:real) /\ f real_integrable_on (:real) /\ (!x. &0 <= + f x) /\ + (\x. f x pow 2) real_integrable_on (:real) + ==> ((\x:real^1. + integral (:real^1) + (\y. (\z:real^(1,1)finite_sum. + if &0 < drop(sndcart z) /\ + (?a. drop(fstcart z) < a /\ + (a - drop(fstcart z)) * drop(sndcart z) < + real_integral (real_interval[drop(fstcart z),a]) f) + then lift(&2 * drop(sndcart z)) else vec 0) + (pastecart x y))) + has_integral + (integral (:real^(1,1)finite_sum) + (\z:real^(1,1)finite_sum. + if &0 < drop(sndcart z) /\ + (?a. drop(fstcart z) < a /\ + (a - drop(fstcart z)) * drop(sndcart z) < + real_integral (real_interval[drop(fstcart z),a]) f) + then lift(&2 * drop(sndcart z)) else vec 0))) (:real^1)`, + REPEAT STRIP_TAC THEN + MP_TAC(CONJUNCT2(MATCH_MP FUBINI_ABSOLUTELY_INTEGRABLE (MATCH_MP SIGMA_ABS + (ASSUME + `f real_measurable_on (:real) /\ f real_integrable_on (:real) /\ (!x. &0 <= + f x) /\ + (\x. f x pow 2) real_integrable_on (:real)`)))) THEN + REWRITE_TAC[]);; + +(* Reduced x-outer: (\x. (f1star x)^2) has_integral int_(:R^2) SIGMA. Spike *) +(* the inner x-slice int_y SIGMA(pastecart x y) to lift((f1star x)^2) via *) +(* SIGMA_XSLICE (needs boundedness M for the superlevel biconditional). *) +let MAIN_XOUT = prove + (`!f:real->real M. + f real_measurable_on (:real) /\ f real_integrable_on (:real) /\ (!x. &0 <= + f x) /\ + (\x. f x pow 2) real_integrable_on (:real) /\ (!x. abs(f x) <= M) + ==> ((\x:real^1. lift((hl_maximal_fwd f (drop x)) pow 2)) + has_integral + (integral (:real^(1,1)finite_sum) + (\z:real^(1,1)finite_sum. + if &0 < drop(sndcart z) /\ + (?a. drop(fstcart z) < a /\ + (a - drop(fstcart z)) * drop(sndcart z) < + real_integral (real_interval[drop(fstcart z),a]) f) + then lift(&2 * drop(sndcart z)) else vec 0))) (:real^1)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `f:real->real` MAIN_XOUT_RAW) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:real^1` THEN + MATCH_MP_TAC INTEGRAL_UNIQUE THEN + MP_TAC(ISPECL [`f:real->real`; `M:real`; `x:real^1`] SIGMA_XSLICE) THEN + ASM_REWRITE_TAC[]);; + +(* u-OUTER raw Fubini (ALT): the u-outer iterate (\y. int_x SIGMA(pastecart *) +(* x y)) has_integral int_(:R^2) SIGMA. *) +let MAIN_UOUT_RAW = prove + (`!f:real->real. + f real_measurable_on (:real) /\ f real_integrable_on (:real) /\ (!x. &0 <= + f x) /\ + (\x. f x pow 2) real_integrable_on (:real) + ==> ((\y:real^1. + integral (:real^1) + (\x. (\z:real^(1,1)finite_sum. + if &0 < drop(sndcart z) /\ + (?a. drop(fstcart z) < a /\ + (a - drop(fstcart z)) * drop(sndcart z) < + real_integral (real_interval[drop(fstcart z),a]) f) + then lift(&2 * drop(sndcart z)) else vec 0) + (pastecart x y))) + has_integral + (integral (:real^(1,1)finite_sum) + (\z:real^(1,1)finite_sum. + if &0 < drop(sndcart z) /\ + (?a. drop(fstcart z) < a /\ + (a - drop(fstcart z)) * drop(sndcart z) < + real_integral (real_interval[drop(fstcart z),a]) f) + then lift(&2 * drop(sndcart z)) else vec 0))) (:real^1)`, + REPEAT STRIP_TAC THEN + MP_TAC(CONJUNCT2(MATCH_MP FUBINI_ABSOLUTELY_INTEGRABLE_ALT (MATCH_MP + SIGMA_ABS (ASSUME + `f real_measurable_on (:real) /\ f real_integrable_on (:real) /\ (!x. &0 <= + f x) /\ + (\x. f x pow 2) real_integrable_on (:real)`)))) THEN + REWRITE_TAC[]);; + +(* SIGMA analogue of INNER_U: the u-outer inner x-slice. *) +let SIGMA_INNER_U = prove + (`!f:real->real y. f real_integrable_on (:real) /\ (!x. &0 <= f x) + ==> integral (:real^1) (\x. (\z:real^(1,1)finite_sum. + if &0 < drop(sndcart z) /\ + (?a. drop(fstcart z) < a /\ + (a - drop(fstcart z)) * drop(sndcart z) < + real_integral (real_interval[drop(fstcart z),a]) f) + then lift(&2 * drop(sndcart z)) else vec 0) + (pastecart x y)) + = (if &0 < drop y + then lift(&2 * drop y * real_measure {x | ?a. x < a /\ (a - x) * drop + y < real_integral (real_interval[x,a]) f}) + else vec 0)`, + REPEAT STRIP_TAC THEN COND_CASES_TAC THENL + [MATCH_MP_TAC INTEGRAL_UNIQUE THEN + MP_TAC(ISPECL [`f:real->real`; `y:real^1`] SIGMA_USLICE) THEN + ASM_REWRITE_TAC[]; + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[INTEGRAL_0]]);; + +(* The MAIN layer-cake identity, real-level u-side: *) +(* (\u. 2u mu(G_u)) has_real_integral drop(int_(:R^2) SIGMA) on {u>0}. *) +(* Real-level restatement of MAIN_UOUT_RAW; spike via SIGMA_INNER_U. *) +(* Combined *) +(* with MAIN_XOUT this gives int_R (f1star)^2 = int_{u>0} 2u mu(G_u) du. *) +let MAIN_LAYER_CAKE = prove + (`!f:real->real. + f real_measurable_on (:real) /\ f real_integrable_on (:real) /\ (!x. &0 <= + f x) /\ + (\x. f x pow 2) real_integrable_on (:real) + ==> ((\u. &2 * u * real_measure {x | ?a. x < a /\ (a - x) * u < + real_integral (real_interval[x,a]) f}) + has_real_integral + drop(integral (:real^(1,1)finite_sum) + (\z:real^(1,1)finite_sum. + if &0 < drop(sndcart z) /\ + (?a. drop(fstcart z) < a /\ + (a - drop(fstcart z)) * drop(sndcart z) < + real_integral (real_interval[drop(fstcart z),a]) f) + then lift(&2 * drop(sndcart z)) else vec 0))) {u | &0 < u}`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[has_real_integral] THEN + ONCE_REWRITE_TAC[GSYM HAS_INTEGRAL_RESTRICT_UNIV] THEN + MATCH_MP_TAC HAS_INTEGRAL_SPIKE THEN + EXISTS_TAC `\y:real^1. integral (:real^1) (\x. (\z:real^(1,1)finite_sum. + if &0 < drop(sndcart z) /\ + (?a. drop(fstcart z) < a /\ + (a - drop(fstcart z)) * drop(sndcart z) < + real_integral (real_interval[drop(fstcart z),a]) f) + then lift(&2 * drop(sndcart z)) else vec 0) + (pastecart x y))` THEN + EXISTS_TAC `{}:real^1->bool` THEN + REWRITE_TAC[NEGLIGIBLE_EMPTY; IN_DIFF; NOT_IN_EMPTY] THEN CONJ_TAC THENL + [X_GEN_TAC `y:real^1` THEN DISCH_TAC THEN + REWRITE_TAC[IN_IMAGE_LIFT_DROP; IN_ELIM_THM; o_THM] THEN + MP_TAC(ISPECL [`f:real->real`; `y:real^1`] SIGMA_INNER_U) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN + COND_CASES_TAC THEN REWRITE_TAC[LIFT_DROP]; + REWRITE_TAC[LIFT_DROP] THEN + MP_TAC(ISPEC `f:real->real` MAIN_UOUT_RAW) THEN + ASM_REWRITE_TAC[LIFT_DROP]]);; + +(* Real-level bridge of MAIN_XOUT: (\x. (f1star x)^2) has_real_integral *) +(* drop(int_(:R^2) SIGMA) on (:real). *) +let MAIN_XOUT_REAL = prove + (`!f:real->real M. + f real_measurable_on (:real) /\ f real_integrable_on (:real) /\ (!x. &0 <= + f x) /\ + (\x. f x pow 2) real_integrable_on (:real) /\ (!x. abs(f x) <= M) + ==> ((\x. (hl_maximal_fwd f x) pow 2) + has_real_integral + drop(integral (:real^(1,1)finite_sum) + (\z:real^(1,1)finite_sum. + if &0 < drop(sndcart z) /\ + (?a. drop(fstcart z) < a /\ + (a - drop(fstcart z)) * drop(sndcart z) < + real_integral (real_interval[drop(fstcart z),a]) f) + then lift(&2 * drop(sndcart z)) else vec 0))) (:real)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[has_real_integral; IMAGE_LIFT_UNIV; o_DEF; LIFT_DROP] THEN + MP_TAC(ISPECL [`f:real->real`; `M:real`] MAIN_XOUT) THEN ASM_REWRITE_TAC[]);; + +(* The MAIN comparison bound (Fremlin 286A(c) endgame, one-sided): *) +(* int_R (f1star)^2 <= 4 int_R f^2. *) +(* Combine MAIN_XOUT_REAL (LHS = drop(int SIGMA)) with MAIN_LAYER_CAKE *) +(* (drop(int SIGMA) = int_{u>0} 2u mu(G_u)) and the 4-scaled *) +(* POS_PART_LAYER_CAKE *) +(* (int_{u>0} 4 int(f-u/2)_+ = 4 int f^2) via HAS_REAL_INTEGRAL_LE, with the *) +(* pointwise 2u mu(G_u) <= 4 int(f-u/2)_+ coming from *) +(* MAXIMAL_WEAK_TYPE_REFINED *) +(* (u mu(G_u) <= 2 int(f-u/2)_+, doubled). The nonlinear product u*mu(G_u) *) +(* is *) +(* generalized to a fresh var so ASM_REAL_ARITH can finish. *) +let MAIN_COMPARISON = prove + (`!f:real->real M. + f real_measurable_on (:real) /\ f real_integrable_on (:real) /\ (!x. &0 <= + f x) /\ + (\x. f x pow 2) real_integrable_on (:real) /\ (!x. abs(f x) <= M) + ==> real_integral (:real) (\x. (hl_maximal_fwd f x) pow 2) + <= &4 * real_integral (:real) (\x. f x pow 2)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:real->real`; `M:real`] MAIN_XOUT_REAL) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(fun th -> SUBST1_TAC(MATCH_MP REAL_INTEGRAL_UNIQUE th)) THEN + MP_TAC(ISPEC `f:real->real` MAIN_LAYER_CAKE) THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN + MP_TAC(ISPEC `f:real->real` POS_PART_LAYER_CAKE) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `&4` o MATCH_MP HAS_REAL_INTEGRAL_LMUL) THEN + REWRITE_TAC[] THEN DISCH_TAC THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_LE THEN + MAP_EVERY EXISTS_TAC + [`\u. &2 * u * real_measure {x | ?a. x < a /\ (a - x) * u < real_integral + (real_interval[x,a]) f}`; + `\u. &4 * real_integral (:real) (\y. max (&0) (f y - u / &2))`; + `{u | &0 < u}`] THEN + REPEAT CONJ_TAC THENL + [FIRST_ASSUM ACCEPT_TAC; + FIRST_ASSUM ACCEPT_TAC; + REWRITE_TAC[IN_ELIM_THM] THEN X_GEN_TAC `u:real` THEN DISCH_TAC THEN + MP_TAC(ISPECL [`f:real->real`; `u:real`] MAXIMAL_WEAK_TYPE_REFINED) THEN + ASM_REWRITE_TAC[] THEN + SPEC_TAC(`real_measure {x | ?a. x < a /\ (a - x) * u < real_integral + (real_interval[x,a]) f}`,`m:real`) THEN + SPEC_TAC(`real_integral (:real) (\x. max (&0) (f x - u / &2))`,`i:real`) + THEN + REPEAT STRIP_TAC THEN + REWRITE_TAC[REAL_ARITH `&2 * u * m = &2 * (u * m) /\ &4 * i = &2 * (&2 * + i:real)`] THEN + ASM_REAL_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Two-sided assembly (Fremlin 286A(d)): the full maximal fn hl_maximal is *) +(* the max of the forward one-sided fn f1star and a BACKWARD one-sided fn *) +(* f2star, so int (hl_maximal)^2 <= int f1star^2 + int f2star^2 <= 8 int *) +(* f^2. *) +(* The backward fn is obtained from the forward machinery by reflection *) +(* x |-> -x (a single reflection lemma), so no separate rising-sun/layer- *) +(* cake development is needed for it. *) +(* ------------------------------------------------------------------------- *) + +(* The backward one-sided maximal function: sup of averages over intervals *) +(* [a,x] to the LEFT of x. *) +let hl_maximal_bwd = new_definition + `hl_maximal_bwd (f:real->real) x = + sup {real_integral (real_interval[a,x]) f / (x - a) | a | a < x}`;; + +(* Reflection bridge: bwd f x = fwd (\t. f(-t)) (-x). Via REAL_INTEGRAL_ *) +(* REFLECT (int_[--b,--a](\t.f(--t)) = int_[a,b]f) on the defining set. *) +let HL_BWD_REFLECT = prove + (`!f:real->real x. hl_maximal_bwd f x = hl_maximal_fwd (\t. f(--t)) (--x)`, + REPEAT GEN_TAC THEN REWRITE_TAC[hl_maximal_bwd; hl_maximal_fwd] THEN + AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN + X_GEN_TAC `r:real` THEN EQ_TAC THENL + [DISCH_THEN(X_CHOOSE_THEN `a:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `--a:real` THEN CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[REAL_ARITH `!a x:real. --a - --x = x - a`] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN + MP_TAC(ISPECL [`f:real->real`; `a:real`; + `x:real`] REAL_INTEGRAL_REFLECT) THEN + REWRITE_TAC[]; + DISCH_THEN(X_CHOOSE_THEN `b:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `--b:real` THEN CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[REAL_ARITH `!b x:real. b - --x = x - --b`] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + MP_TAC(ISPECL [`f:real->real`; `--b:real`; + `x:real`] REAL_INTEGRAL_REFLECT) THEN + REWRITE_TAC[REAL_NEG_NEG]]);; + +(* An admissible right-average is <= f1star (it is a member of the sup-set, *) +(* which is bounded above by M when g <= M). *) +let HL_FWD_GE = prove + (`!g:real->real M x b. g real_integrable_on (:real) /\ (!y. g y <= M) /\ x < b + ==> real_integral (real_interval[x,b]) g / (b - x) <= hl_maximal_fwd g x`, + REPEAT STRIP_TAC THEN REWRITE_TAC[hl_maximal_fwd] THEN + MATCH_MP_TAC REAL_LE_SUP THEN + MAP_EVERY EXISTS_TAC + [`M:real`; + `real_integral (real_interval[x,b]) (g:real->real) / (b - x)`] THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `b:real` THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_LE_REFL]; + REWRITE_TAC[FORALL_IN_GSPEC] THEN X_GEN_TAC `a:real` THEN DISCH_TAC THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_SUB_LT] THEN + MATCH_MP_TAC REAL_INTEGRAL_UBOUND THEN REPEAT CONJ_TAC THENL + [ASM_SIMP_TAC[REAL_LT_IMP_LE]; + MATCH_MP_TAC REAL_INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `(:real)` THEN + ASM_REWRITE_TAC[SUBSET_UNIV]; + ASM_REWRITE_TAC[]]]);; + +(* An admissible left-average is <= f2star (bwd), same argument. *) +let HL_BWD_GE = prove + (`!g:real->real M x a. g real_integrable_on (:real) /\ (!y. g y <= M) /\ a < x + ==> real_integral (real_interval[a,x]) g / (x - a) <= hl_maximal_bwd g x`, + REPEAT STRIP_TAC THEN REWRITE_TAC[hl_maximal_bwd] THEN + MATCH_MP_TAC REAL_LE_SUP THEN + MAP_EVERY EXISTS_TAC + [`M:real`; + `real_integral (real_interval[a,x]) (g:real->real) / (x - a)`] THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `a:real` THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_LE_REFL]; + REWRITE_TAC[FORALL_IN_GSPEC] THEN X_GEN_TAC `c:real` THEN DISCH_TAC THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_SUB_LT] THEN + MATCH_MP_TAC REAL_INTEGRAL_UBOUND THEN REPEAT CONJ_TAC THENL + [ASM_SIMP_TAC[REAL_LT_IMP_LE]; + MATCH_MP_TAC REAL_INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `(:real)` THEN + ASM_REWRITE_TAC[SUBSET_UNIV]; + ASM_REWRITE_TAC[]]]);; + +(* Mediant inequality: (ll+rr)/(p+q) <= max(ll/p, rr/q) for p,q > 0. *) +let MEDIANT_LE_MAX = prove + (`!ll rr p q. &0 < p /\ &0 < q ==> (ll + rr) / (p + q) <= max (ll / p) (rr / + q)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&0 < p + q` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_ADD_LDISTRIB] THEN + MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THENL + [MP_TAC(ISPECL [`ll:real`; `p:real`] REAL_DIV_RMUL) THEN + ASM_SIMP_TAC[REAL_LT_IMP_NZ] THEN + DISCH_THEN(fun th -> GEN_REWRITE_TAC LAND_CONV [SYM th]) THEN + MATCH_MP_TAC REAL_LE_RMUL THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_ARITH `!x y:real. x <= max x y`]; + MP_TAC(ISPECL [`rr:real`; `q:real`] REAL_DIV_RMUL) THEN + ASM_SIMP_TAC[REAL_LT_IMP_NZ] THEN + DISCH_THEN(fun th -> GEN_REWRITE_TAC LAND_CONV [SYM th]) THEN + MATCH_MP_TAC REAL_LE_RMUL THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_ARITH `!x y:real. y <= max x y`]]);; + +(* The pointwise two-sided <= max bound: hl_maximal f x <= *) +(* max(f1star,f2star) *) +(* of |f|. Every two-sided average over [a,b] (a<=x<=b) splits at x into a *) +(* convex combination of the left average (<= f2star, HL_BWD_GE) and right *) +(* average (<= f1star, HL_FWD_GE); MEDIANT_LE_MAX bounds it by the max. The *) +(* boundary cases a=x, x=b are pure one-sided. *) +let HL_MAX_LE_MAX = prove + (`!f:real->real M x. + (\t. abs(f t)) real_integrable_on (:real) /\ (!y. abs(f y) <= M) + ==> hl_maximal f x <= max (hl_maximal_fwd (\t. abs(f t)) x) + (hl_maximal_bwd (\t. abs(f t)) x)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[hl_maximal] THEN + MATCH_MP_TAC REAL_SUP_LE THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + MAP_EVERY EXISTS_TAC + [`real_integral (real_interval[x,x + &1]) (\t. abs((f:real->real) t)) / + ((x + &1) - x)`; + `x:real`; `x + &1`] THEN REAL_ARITH_TAC; + REWRITE_TAC[FORALL_IN_GSPEC]] THEN + MAP_EVERY X_GEN_TAC [`a:real`; `b:real`] THEN STRIP_TAC THEN + ASM_CASES_TAC `a:real = x` THENL + [FIRST_X_ASSUM SUBST_ALL_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `hl_maximal_fwd (\t. abs((f:real->real) t)) x` THEN + ASM_SIMP_TAC[REAL_ARITH `!x y:real. x <= max x y`] THEN + MATCH_MP_TAC HL_FWD_GE THEN EXISTS_TAC `M:real` THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + ASM_CASES_TAC `x:real = b` THENL + [FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `hl_maximal_bwd (\t. abs((f:real->real) t)) x` THEN + ASM_SIMP_TAC[REAL_ARITH `!x y:real. y <= max x y`] THEN + MATCH_MP_TAC HL_BWD_GE THEN EXISTS_TAC `M:real` THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `a < x /\ x < b` STRIP_ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `real_integral (real_interval[a,b]) (\t. abs((f:real->real) t)) = + real_integral (real_interval[a,x]) (\t. abs(f t)) + + real_integral (real_interval[x,b]) (\t. abs(f t))` + SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_INTEGRAL_COMBINE THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN + MATCH_MP_TAC REAL_INTEGRABLE_ON_SUBINTERVAL THEN EXISTS_TAC `(:real)` THEN + ASM_REWRITE_TAC[SUBSET_UNIV]; + ALL_TAC] THEN + SUBGOAL_THEN `b - a:real = (x - a) + (b - x)` SUBST1_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `max (real_integral (real_interval[a,x]) (\t. abs((f:real->real) + t)) / (x - a)) + (real_integral (real_interval[x,b]) (\t. abs((f:real->real) + t)) / (b - x))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC MEDIANT_LE_MAX THEN ASM_REWRITE_TAC[REAL_SUB_LT]; + REWRITE_TAC[REAL_MAX_LE] THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `hl_maximal_bwd (\t. abs((f:real->real) t)) x` THEN + ASM_SIMP_TAC[REAL_ARITH `!x y:real. y <= max x y`] THEN + MATCH_MP_TAC HL_BWD_GE THEN EXISTS_TAC `M:real` THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `hl_maximal_fwd (\t. abs((f:real->real) t)) x` THEN + ASM_SIMP_TAC[REAL_ARITH `!x y:real. x <= max x y`] THEN + MATCH_MP_TAC HL_FWD_GE THEN EXISTS_TAC `M:real` THEN + ASM_REWRITE_TAC[]]]);; + +(* Whole-line reflection x |-> -x preserves the integral and integrability *) +(* on *) +(* (:real) (IMAGE (--) (:real) = (:real)). Bridges the backward maximal fn *) +(* to *) +(* the forward machinery. *) +let REAL_INTEGRAL_REFLECT_UNIV = prove + (`!h:real->real. real_integral (:real) (\x. h(--x)) = real_integral (:real) + h`, + GEN_TAC THEN REWRITE_TAC[real_integral] THEN AP_TERM_TAC THEN ABS_TAC THEN + REWRITE_TAC[HAS_REAL_INTEGRAL_REFLECT_GEN] THEN + SUBGOAL_THEN `IMAGE (--) (:real) = (:real)` (fun th -> REWRITE_TAC[th]) THEN + REWRITE_TAC[EXTENSION; IN_IMAGE; IN_UNIV] THEN MESON_TAC[REAL_NEG_NEG]);; + +let REAL_INTEGRABLE_REFLECT_UNIV = prove + (`!h:real->real. (\x. h(--x)) real_integrable_on (:real) <=> h + real_integrable_on (:real)`, + GEN_TAC THEN REWRITE_TAC[real_integrable_on] THEN + REWRITE_TAC[HAS_REAL_INTEGRAL_REFLECT_GEN] THEN + SUBGOAL_THEN `IMAGE (--) (:real) = (:real)` (fun th -> REWRITE_TAC[th]) THEN + REWRITE_TAC[EXTENSION; IN_IMAGE; IN_UNIV] THEN MESON_TAC[REAL_NEG_NEG]);; + +(* Forward comparison for |f|: int (f1star|f|)^2 <= 4 int f^2. *) +(* MAIN_COMPARISON at g = |f| (measurable via *) +(* INTEGRABLE_IMP_REAL_MEASURABLE, *) +(* nonneg, |f|^2 = f^2). *) +let FWD_COMPARISON_ABS = prove + (`!f:real->real M. + (\x. abs(f x)) real_integrable_on (:real) /\ + (\x. f x pow 2) real_integrable_on (:real) /\ (!x. abs(f x) <= M) + ==> real_integral (:real) (\x. (hl_maximal_fwd (\t. abs(f t)) x) pow 2) + <= &4 * real_integral (:real) (\x. f x pow 2)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\t. abs((f:real->real) t)`; `M:real`] MAIN_COMPARISON) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_IMP_REAL_MEASURABLE THEN ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_ABS_POS]; + REWRITE_TAC[REAL_POW2_ABS] THEN ASM_REWRITE_TAC[]; + GEN_TAC THEN REWRITE_TAC[REAL_ABS_ABS] THEN ASM_REWRITE_TAC[]]; + REWRITE_TAC[REAL_POW2_ABS]]);; + +(* Backward comparison: int (f2star|f|)^2 <= 4 int f^2. Reflect the backward *) +(* maximal fn to a forward one (HL_BWD_REFLECT), reflect the integration var *) +(* (REAL_INTEGRAL_REFLECT_UNIV), then MAIN_COMPARISON at g = \t. |f(-t)|. *) +let BWD_COMPARISON = prove + (`!f:real->real M. + (\x. abs(f x)) real_integrable_on (:real) /\ + (\x. f x pow 2) real_integrable_on (:real) /\ (!x. abs(f x) <= M) + ==> real_integral (:real) (\x. (hl_maximal_bwd (\t. abs(f t)) x) pow 2) + <= &4 * real_integral (:real) (\x. f x pow 2)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[HL_BWD_REFLECT] THEN + SUBGOAL_THEN + `real_integral (:real) (\x. (hl_maximal_fwd (\t. abs((f:real->real)(--t))) + (--x)) pow 2) = + real_integral (:real) (\y. (hl_maximal_fwd (\t. abs(f(--t))) y) pow 2)` + SUBST1_TAC THENL + [GEN_REWRITE_TAC (RAND_CONV) [GSYM REAL_INTEGRAL_REFLECT_UNIV] THEN + REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `real_integral (:real) (\x. (f:real->real) x pow 2) = + real_integral (:real) (\x. (f(--x)) pow 2)` SUBST1_TAC THENL + [GEN_REWRITE_TAC (LAND_CONV) [GSYM REAL_INTEGRAL_REFLECT_UNIV] THEN + REWRITE_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL [`\t. abs((f:real->real)(--t))`; + `M:real`] MAIN_COMPARISON) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_IMP_REAL_MEASURABLE THEN + ONCE_REWRITE_TAC[GSYM REAL_INTEGRABLE_REFLECT_UNIV] THEN + REWRITE_TAC[REAL_NEG_NEG] THEN ASM_REWRITE_TAC[]; + ONCE_REWRITE_TAC[GSYM REAL_INTEGRABLE_REFLECT_UNIV] THEN + REWRITE_TAC[REAL_NEG_NEG] THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_ABS_POS]; + REWRITE_TAC[REAL_LE_POW2; REAL_POW2_ABS] THEN + ONCE_REWRITE_TAC[GSYM REAL_INTEGRABLE_REFLECT_UNIV] THEN + REWRITE_TAC[REAL_NEG_NEG] THEN ASM_REWRITE_TAC[]; + GEN_TAC THEN REWRITE_TAC[REAL_ABS_ABS] THEN ASM_REWRITE_TAC[]]; + REWRITE_TAC[REAL_POW2_ABS]]);; + +(* Integrability of the forward maximal fn squared (from MAIN_XOUT_REAL's *) +(* has_real_integral) and, by reflection, of the backward one squared. *) +let FWD_SQ_INTEGRABLE = prove + (`!f:real->real M. + (\x. abs(f x)) real_integrable_on (:real) /\ + (\x. f x pow 2) real_integrable_on (:real) /\ (!x. abs(f x) <= M) + ==> (\x. (hl_maximal_fwd (\t. abs(f t)) x) pow 2) real_integrable_on + (:real)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\t. abs((f:real->real) t)`; `M:real`] MAIN_XOUT_REAL) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_IMP_REAL_MEASURABLE THEN ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_ABS_POS]; + REWRITE_TAC[REAL_POW2_ABS] THEN ASM_REWRITE_TAC[]; + GEN_TAC THEN REWRITE_TAC[REAL_ABS_ABS] THEN ASM_REWRITE_TAC[]]; + REWRITE_TAC[real_integrable_on] THEN DISCH_TAC THEN ASM_MESON_TAC[]]);; + +let BWD_SQ_INTEGRABLE = prove + (`!f:real->real M. + (\x. abs(f x)) real_integrable_on (:real) /\ + (\x. f x pow 2) real_integrable_on (:real) /\ (!x. abs(f x) <= M) + ==> (\x. (hl_maximal_bwd (\t. abs(f t)) x) pow 2) real_integrable_on + (:real)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[HL_BWD_REFLECT] THEN + ONCE_REWRITE_TAC[GSYM REAL_INTEGRABLE_REFLECT_UNIV] THEN + REWRITE_TAC[REAL_NEG_NEG] THEN + MP_TAC(ISPECL [`\t. (f:real->real)(--t)`; `M:real`] FWD_SQ_INTEGRABLE) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [ONCE_REWRITE_TAC[GSYM REAL_INTEGRABLE_REFLECT_UNIV] THEN + REWRITE_TAC[REAL_NEG_NEG] THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[GSYM REAL_INTEGRABLE_REFLECT_UNIV] THEN + REWRITE_TAC[REAL_NEG_NEG] THEN ASM_REWRITE_TAC[]; + GEN_TAC THEN ASM_REWRITE_TAC[]]; + REWRITE_TAC[]]);; + +(* The superlevel-open lemma with unrestricted threshold t, needed for *) +(* f1star measurability at all thresholds. *) +let MAXIMAL_SUPERLEVEL_OPEN_GEN = prove + (`!f t. f real_integrable_on (:real) + ==> real_open {x | ?a. x < a /\ (a - x) * t < real_integral + (real_interval[x,a]) f}`, + REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_OPEN; open_def] THEN + REWRITE_TAC[FORALL_IN_IMAGE; IN_ELIM_THM; FORALL_LIFT; DIST_LIFT] THEN + X_GEN_TAC `x0:real` THEN DISCH_THEN(X_CHOOSE_THEN + `a:real` STRIP_ASSUME_TAC) THEN + REWRITE_TAC[LIFT_IN_IMAGE_LIFT; IN_ELIM_THM] THEN + SUBGOAL_THEN + `(\x. real_integral (real_interval[x,a]) f - (a - x) * t) real_continuous + (atreal x0)` + MP_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_SUB THEN CONJ_TAC THENL + [MATCH_MP_TAC RUNNING_INTEGRAL_CONTINUOUS THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_CONTINUOUS_MUL THEN + REWRITE_TAC[REAL_CONTINUOUS_CONST] THEN + MATCH_MP_TAC REAL_CONTINUOUS_SUB THEN + REWRITE_TAC[REAL_CONTINUOUS_CONST; REAL_CONTINUOUS_AT_ID]]; + ALL_TAC] THEN + REWRITE_TAC[real_continuous_atreal; REALLIM_ATREAL] THEN + DISCH_THEN(MP_TAC o SPEC `real_integral (real_interval[x0,a]) f - (a - x0) * + t`) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `min d (a - x0)` THEN ASM_REWRITE_TAC[REAL_LT_MIN] THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + X_GEN_TAC `x':real` THEN STRIP_TAC THEN EXISTS_TAC `a:real` THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x':real`) THEN ASM_REAL_ARITH_TAC);; + +(* Each one-sided maximal fn is <= the full two-sided one (a one-sided *) +(* average *) +(* is an admissible two-sided average). With HL_MAX_LE_MAX this gives the *) +(* EXACT *) +(* decomposition hl_maximal f = max(f1star,f2star) of |f|. *) +let HL_FWD_LE_MAXIMAL = prove + (`!f:real->real M x. + (\t. abs(f t)) real_integrable_on (:real) /\ (!y. abs(f y) <= M) + ==> hl_maximal_fwd (\t. abs(f t)) x <= hl_maximal f x`, + REPEAT STRIP_TAC THEN REWRITE_TAC[hl_maximal_fwd] THEN + MATCH_MP_TAC REAL_SUP_LE THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + EXISTS_TAC `real_integral (real_interval[x,x + &1]) (\t. abs((f:real->real) + t)) / ((x + &1) - x)` THEN + EXISTS_TAC `x + &1` THEN REAL_ARITH_TAC; + REWRITE_TAC[FORALL_IN_GSPEC] THEN X_GEN_TAC `b:real` THEN DISCH_TAC] THEN + REWRITE_TAC[hl_maximal] THEN MATCH_MP_TAC REAL_LE_SUP THEN + MAP_EVERY EXISTS_TAC + [`M:real`; + `real_integral (real_interval[x,b]) (\t. abs((f:real->real) t)) / (b - + x)`] THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[IN_ELIM_THM] THEN MAP_EVERY EXISTS_TAC [`x:real`;`b:real`] THEN + ASM_REWRITE_TAC[REAL_LE_REFL] THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[REAL_LE_REFL]; + REWRITE_TAC[FORALL_IN_GSPEC] THEN + MAP_EVERY X_GEN_TAC [`p:real`;`q:real`] THEN STRIP_TAC THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_SUB_LT] THEN + MATCH_MP_TAC REAL_INTEGRAL_UBOUND THEN REPEAT CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `(:real)` THEN ASM_REWRITE_TAC[SUBSET_UNIV]; + ASM_REWRITE_TAC[]]]);; + +let HL_BWD_LE_MAXIMAL = prove + (`!f:real->real M x. + (\t. abs(f t)) real_integrable_on (:real) /\ (!y. abs(f y) <= M) + ==> hl_maximal_bwd (\t. abs(f t)) x <= hl_maximal f x`, + REPEAT STRIP_TAC THEN REWRITE_TAC[hl_maximal_bwd] THEN + MATCH_MP_TAC REAL_SUP_LE THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + EXISTS_TAC `real_integral (real_interval[x - &1,x]) (\t. abs((f:real->real) + t)) / (x - (x - &1))` THEN + EXISTS_TAC `x - &1` THEN REAL_ARITH_TAC; + REWRITE_TAC[FORALL_IN_GSPEC] THEN X_GEN_TAC `a:real` THEN DISCH_TAC] THEN + REWRITE_TAC[hl_maximal] THEN MATCH_MP_TAC REAL_LE_SUP THEN + MAP_EVERY EXISTS_TAC + [`M:real`; + `real_integral (real_interval[a,x]) (\t. abs((f:real->real) t)) / (x - + a)`] THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[IN_ELIM_THM] THEN MAP_EVERY EXISTS_TAC [`a:real`;`x:real`] THEN + ASM_REWRITE_TAC[REAL_LE_REFL] THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[REAL_LE_REFL]; + REWRITE_TAC[FORALL_IN_GSPEC] THEN + MAP_EVERY X_GEN_TAC [`p:real`;`q:real`] THEN STRIP_TAC THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_SUB_LT] THEN + MATCH_MP_TAC REAL_INTEGRAL_UBOUND THEN REPEAT CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `(:real)` THEN ASM_REWRITE_TAC[SUBSET_UNIV]; + ASM_REWRITE_TAC[]]]);; + +(* Whole-line reflection preserves real-measurability (via the vector *) +(* MEASURABLE_ON_REFLECT and the real<->vector bridge). *) +let REAL_MEASURABLE_ON_REFLECT_UNIV = prove + (`!h:real->real. (\x. h(--x)) real_measurable_on (:real) <=> h + real_measurable_on (:real)`, + GEN_TAC THEN REWRITE_TAC[real_measurable_on; IMAGE_LIFT_UNIV] THEN + SUBGOAL_THEN + `lift o (\x. h(--x)) o drop = + (\v. (lift o h o drop)(--v))` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; o_THM] THEN GEN_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[DROP_NEG]; ALL_TAC] THEN + REWRITE_TAC[MEASURABLE_ON_REFLECT; ETA_AX] THEN + SUBGOAL_THEN `IMAGE (--) (:real^1) = (:real^1)` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_UNIV] THEN + MESON_TAC[VECTOR_NEG_NEG]; REWRITE_TAC[]]);; + +(* f1star is measurable: its superlevel {x | a < f1star g x} = the OPEN G_a *) +(* (SUB/SUPER biconditional under boundedness) for every threshold a; *) +(* halfspace- GT criterion + open => lebesgue-measurable. *) +let HL_FWD_MEASURABLE = prove + (`!g:real->real M. g real_integrable_on (:real) /\ (!x. abs(g x) <= M) + ==> hl_maximal_fwd g real_measurable_on (:real)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[REAL_MEASURABLE_ON_PREIMAGE_HALFSPACE_GT] THEN + X_GEN_TAC `a:real` THEN REWRITE_TAC[real_gt] THEN + SUBGOAL_THEN + `{x | a < hl_maximal_fwd (g:real->real) x} = + {x | ?c. x < c /\ (c - x) * a < real_integral (real_interval[x,c]) g}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `x:real` THEN + EQ_TAC THENL + [DISCH_TAC THEN MATCH_MP_TAC HL_FWD_SUPERLEVEL_SUB THEN ASM_REWRITE_TAC[]; + DISCH_TAC THEN MATCH_MP_TAC HL_FWD_SUPERLEVEL_SUPER THEN + EXISTS_TAC `M:real` THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LEBESGUE_MEASURABLE_OPEN THEN + MATCH_MP_TAC MAXIMAL_SUPERLEVEL_OPEN_GEN THEN ASM_REWRITE_TAC[]);; + +(* f2star is measurable, by reflecting f1star. *) +let HL_BWD_MEASURABLE = prove + (`!g:real->real M. g real_integrable_on (:real) /\ (!x. abs(g x) <= M) + ==> hl_maximal_bwd g real_measurable_on (:real)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `hl_maximal_bwd (g:real->real) = (\x. hl_maximal_fwd (\t. g(--t)) (--x))` + SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM; HL_BWD_REFLECT]; ALL_TAC] THEN + MP_TAC(ISPEC `hl_maximal_fwd (\t. (g:real->real)(--t))` + REAL_MEASURABLE_ON_REFLECT_UNIV) THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN + MATCH_MP_TAC HL_FWD_MEASURABLE THEN EXISTS_TAC `M:real` THEN CONJ_TAC THENL + [ONCE_REWRITE_TAC[GSYM REAL_INTEGRABLE_REFLECT_UNIV] THEN + REWRITE_TAC[REAL_NEG_NEG; ETA_AX] THEN ASM_REWRITE_TAC[]; + GEN_TAC THEN ASM_REWRITE_TAC[]]);; + +(* hl_maximal f is measurable: it equals max(f1star,f2star) of |f| *) +(* (HL_MAX_LE_MAX + the two reverse inequalities), and *) +(* REAL_MEASURABLE_ON_MAX. *) +let HL_MAXIMAL_MEASURABLE = prove + (`!f:real->real M. + (\t. abs(f t)) real_integrable_on (:real) /\ (!x. abs(f x) <= M) + ==> hl_maximal f real_measurable_on (:real)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `hl_maximal (f:real->real) = + (\x. max (hl_maximal_fwd (\t. abs(f t)) x) (hl_maximal_bwd (\t. abs(f t)) + x))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:real` THEN + REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN CONJ_TAC THENL + [MATCH_MP_TAC HL_MAX_LE_MAX THEN EXISTS_TAC `M:real` THEN + ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_MAX_LE] THEN CONJ_TAC THENL + [MATCH_MP_TAC HL_FWD_LE_MAXIMAL THEN EXISTS_TAC `M:real` THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC HL_BWD_LE_MAXIMAL THEN EXISTS_TAC `M:real` THEN + ASM_REWRITE_TAC[]]]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_MEASURABLE_ON_MAX THEN REWRITE_TAC[ETA_AX] THEN + CONJ_TAC THENL + [MATCH_MP_TAC HL_FWD_MEASURABLE THEN EXISTS_TAC `M:real` THEN + ASM_REWRITE_TAC[] THEN GEN_TAC THEN REWRITE_TAC[REAL_ABS_ABS] THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC HL_BWD_MEASURABLE THEN EXISTS_TAC `M:real` THEN + ASM_REWRITE_TAC[] THEN GEN_TAC THEN REWRITE_TAC[REAL_ABS_ABS] THEN + ASM_REWRITE_TAC[]]);; + +(* hl_maximal f is nonnegative (sup of averages of the nonnegative |f|). *) +let HL_MAXIMAL_POS = prove + (`!f:real->real M x. (\t. abs(f t)) real_integrable_on (:real) /\ (!y. abs(f + y) <= M) + ==> &0 <= hl_maximal f x`, + REPEAT STRIP_TAC THEN REWRITE_TAC[hl_maximal] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `real_integral (real_interval[x,x + &1]) (\t. abs((f:real->real) + t)) / ((x + &1) - x)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_DIV THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_POS THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `(:real)` THEN ASM_REWRITE_TAC[SUBSET_UNIV]; + REWRITE_TAC[REAL_ABS_POS]]; + REAL_ARITH_TAC]; + MATCH_MP_TAC REAL_LE_SUP THEN + MAP_EVERY EXISTS_TAC + [`M:real`; + `real_integral (real_interval[x,x + &1]) (\t. abs((f:real->real) t)) / + ((x + &1) - x)`] THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[IN_ELIM_THM] THEN + MAP_EVERY EXISTS_TAC [`x:real`; `x + &1`] THEN REAL_ARITH_TAC; + REWRITE_TAC[REAL_LE_REFL]; + REWRITE_TAC[FORALL_IN_GSPEC] THEN + MAP_EVERY X_GEN_TAC [`a:real`;`b:real`] THEN STRIP_TAC THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_SUB_LT] THEN + MATCH_MP_TAC REAL_INTEGRAL_UBOUND THEN REPEAT CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `(:real)` THEN ASM_REWRITE_TAC[SUBSET_UNIV]; + ASM_REWRITE_TAC[]]]]);; + +(* Backward maximal function is bounded by M when |f| <= M (via *) +(* HL_BWD_REFLECT to the forward maximal function of the reflection, which *) +(* is also bounded). *) +let HL_BWD_BOUNDED = prove + (`!f:real->real M. f real_integrable_on (:real) /\ (!x. abs(f x) <= M) + ==> !x. hl_maximal_bwd f x <= M`, + REPEAT GEN_TAC THEN STRIP_TAC THEN GEN_TAC THEN + REWRITE_TAC[HL_BWD_REFLECT] THEN + MP_TAC(ISPECL [`\t. (f:real->real)(--t)`; `M:real`] HL_FWD_BOUNDED) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [REWRITE_TAC[REAL_INTEGRABLE_REFLECT_UNIV; ETA_AX] THEN ASM_REWRITE_TAC[]; + GEN_TAC THEN REWRITE_TAC[] THEN ASM_REWRITE_TAC[]]; + DISCH_THEN(fun th -> REWRITE_TAC[th])]);; + +(* The two-sided H-L maximal function is bounded by M when |f| <= M. (fwd, *) +(* bwd *) +(* both <= M, and hl_maximal <= max of them by HL_MAX_LE_MAX.) *) +let HL_MAXIMAL_BOUNDED = prove + (`!f:real->real M. (\t. abs(f t)) real_integrable_on (:real) /\ (!x. abs(f x) + <= M) + ==> !x. hl_maximal f x <= M`, + REPEAT GEN_TAC THEN STRIP_TAC THEN GEN_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `max (hl_maximal_fwd (\t. abs((f:real->real) t)) x) + (hl_maximal_bwd (\t. abs(f t)) x)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC HL_MAX_LE_MAX THEN EXISTS_TAC `M:real` THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_MAX_LE] THEN CONJ_TAC THENL + [MP_TAC(ISPECL [`\t. abs((f:real->real) t)`; + `M:real`] HL_FWD_BOUNDED) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[REAL_ABS_ABS]; DISCH_THEN(fun th -> REWRITE_TAC[th])]; + MP_TAC(ISPECL [`\t. abs((f:real->real) t)`; + `M:real`] HL_BWD_BOUNDED) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[REAL_ABS_ABS]; + DISCH_THEN(fun th -> REWRITE_TAC[th])]]]);; + +(* max(a,b)^2 <= a^2 + b^2. *) +let MAX_SQ_LE = prove + (`!a b:real. max a b pow 2 <= a pow 2 + b pow 2`, + REPEAT GEN_TAC THEN REWRITE_TAC[real_max] THEN COND_CASES_TAC THEN + REWRITE_TAC[REAL_LE_ADDL; REAL_LE_ADDR; REAL_LE_POW_2]);; + +(* Pointwise: (hl_maximal f x)^2 <= (f1star x)^2 + (f2star x)^2 of |f|. *) +(* From 0 <= hl_maximal f x <= max(f1star,f2star) (square-monotone) and *) +(* MAX_SQ_LE. *) +let HL_SQ_PTBOUND = prove + (`!f:real->real M x. + (\t. abs(f t)) real_integrable_on (:real) /\ (!y. abs(f y) <= M) + ==> hl_maximal f x pow 2 <= + (hl_maximal_fwd (\t. abs(f t)) x) pow 2 + (hl_maximal_bwd (\t. abs(f + t)) x) pow 2`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(max (hl_maximal_fwd (\t. abs((f:real->real) t)) x) + (hl_maximal_bwd (\t. abs(f t)) x)) pow 2` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_POW_LE2 THEN CONJ_TAC THENL + [MATCH_MP_TAC HL_MAXIMAL_POS THEN EXISTS_TAC `M:real` THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC HL_MAX_LE_MAX THEN EXISTS_TAC `M:real` THEN + ASM_REWRITE_TAC[]]; + REWRITE_TAC[MAX_SQ_LE]]);; + +(* 286B/(vi) support: a per-interval average of |f| over [a,b] (with *) +(* a<=x<=b) is *) +(* <= hl_maximal f x, provided the averages are bounded above by some M *) +(* (needed *) +(* for HOL's sup to behave; holds for bounded f, e.g. Schwartz). This is the *) +(* "gamma <= f-star(x')" step of Fremlin's monotone-kernel bound (286B), in *) +(* the *) +(* form part (h)(vi) consumes: the maximal average over intervals straddling *) +(* [alpha,beta] is dominated by the H-L maximal function at any interior *) +(* point. *) +let AVG_LE_HL_MAXIMAL = prove + (`!f:real->real M a b x. + a <= x /\ x <= b /\ a < b /\ + (!c d. c < d ==> real_integral (real_interval[c,d]) (\t. abs(f t)) / (d - + c) <= M) + ==> real_integral (real_interval[a,b]) (\t. abs(f t)) / (b - a) <= + hl_maximal f x`, + REPEAT STRIP_TAC THEN REWRITE_TAC[hl_maximal] THEN + MATCH_MP_TAC REAL_LE_SUP THEN + MAP_EVERY EXISTS_TAC + [`M:real`; + `real_integral (real_interval[a,b]) (\t. abs((f:real->real) t)) / (b - a)`] + THEN + REWRITE_TAC[IN_ELIM_THM] THEN REPEAT CONJ_TAC THENL + [MAP_EVERY EXISTS_TAC [`a:real`; `b:real`] THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_LE_REFL]; + X_GEN_TAC `z:real` THEN + DISCH_THEN(X_CHOOSE_THEN `c:real` (X_CHOOSE_THEN + `d:real` STRIP_ASSUME_TAC)) THEN + ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[]]);; + +(* ========================================================================= *) +(* The Hardy-Littlewood maximal theorem at p = 2 (Fremlin 286A). *) +(* *) +(* The application in 286L is to a Schwartz (hence L^1 cap L^2) function. *) +(* Thus only the strong p=2 estimate is needed, with *) +(* constant 2 (p/(p-1)) rpow p = 8 at p = 2, i.e. ||fstar||_2 <= 2 sqrt2 *) +(* ||f||_2. *) +(* *) +(* Assembled from MAXIMAL_WEAK_TYPE (= Fremlin 286A(b), the p-independent *) +(* core) via the refined per-level bound u mu(G_u) <= 2 int (f-u/2)_+ *) +(* and the t = u squared layer-cake + Fubini (286A(c)), with fstar = *) +(* max(f1star,f2star) (286A(d)) contributing the factor 2 (hence 4 -> 8). *) +(* *) +(* BOUNDEDNESS HYPOTHESIS: we assume f is *) +(* BOUNDED (?M. !x. abs(f x) <= M). This makes the one-sided maximal fn *) +(* hl_maximal_fwd finite EVERYWHERE (average of things <= M is <= M), so the *) +(* sup-junk locus B (where the running averages are unbounded) is EMPTY, the *) +(* superlevel identity {x | u < f1* x} = G_u holds as a full biconditional, *) +(* and every layer-cake section is a genuine bounded interval. The *) +(* application below is to a Schwartz function, so this suffices. *) +(* ========================================================================= *) + +(* NOTE on the integrability hypothesis: we assume the ABSOLUTE *) +(* integrability *) +(* (\x. abs(f x)) real_integrable_on (:real) -- equivalently f in L^1 -- *) +(* rather *) +(* than the weaker conditional f real_integrable_on (:real). This is what *) +(* the *) +(* two-sided average (which is built from |f|) genuinely needs, and it is *) +(* automatic for Carleson's Schwartz g~ (286L), which is L^1 cap L^2. *) +let HARDY_LITTLEWOOD_MAXIMAL_L2 = prove + (`!f. (\x. abs(f x)) real_integrable_on (:real) /\ + (\x. f x pow 2) real_integrable_on (:real) /\ + (?M. !x. abs(f x) <= M) + ==> (\x. hl_maximal f x pow 2) real_integrable_on (:real) /\ + real_integral (:real) (\x. hl_maximal f x pow 2) + <= &8 * real_integral (:real) (\x. f x pow 2)`, + GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_TAC `M:real`))) THEN + MP_TAC(ISPECL [`f:real->real`;`M:real`] FWD_SQ_INTEGRABLE) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`f:real->real`;`M:real`] BWD_SQ_INTEGRABLE) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`f:real->real`;`M:real`] FWD_COMPARISON_ABS) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`f:real->real`;`M:real`] BWD_COMPARISON) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`f:real->real`;`M:real`] HL_MAXIMAL_MEASURABLE) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + SUBGOAL_THEN + `(\x. (hl_maximal_fwd (\t. abs((f:real->real) t)) x) pow 2 + + (hl_maximal_bwd (\t. abs(f t)) x) pow 2) real_integrable_on (:real)` + ASSUME_TAC THENL [MATCH_MP_TAC REAL_INTEGRABLE_ADD THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `(\x. hl_maximal (f:real->real) x pow 2) real_integrable_on (:real)` + ASSUME_TAC THENL + [MATCH_MP_TAC REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN + EXISTS_TAC `(\x. (hl_maximal_fwd (\t. abs((f:real->real) t)) x) pow 2 + + (hl_maximal_bwd (\t. abs(f t)) x) pow 2)` THEN + REPEAT CONJ_TAC THENL + [ONCE_REWRITE_TAC[REAL_POW_2] THEN + MATCH_MP_TAC REAL_MEASURABLE_ON_MUL THEN + CONJ_TAC THEN ASM_REWRITE_TAC[ETA_AX]; + ASM_REWRITE_TAC[]; + X_GEN_TAC `x:real` THEN DISCH_TAC THEN + REWRITE_TAC[REAL_ABS_POW; REAL_POW2_ABS] THEN + MATCH_MP_TAC HL_SQ_PTBOUND THEN EXISTS_TAC `M:real` THEN + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + CONJ_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `real_integral (:real) (\x. (hl_maximal_fwd (\t. + abs((f:real->real) t)) x) pow 2 + + (hl_maximal_bwd (\t. abs(f t)) x) pow + 2)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_LE THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `x:real` THEN DISCH_TAC THEN + MATCH_MP_TAC HL_SQ_PTBOUND THEN EXISTS_TAC `M:real` THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `real_integral (:real) (\x. (hl_maximal_fwd (\t. abs((f:real->real) t)) x) + pow 2 + + (hl_maximal_bwd (\t. abs(f t)) x) pow 2) = + real_integral (:real) (\x. (hl_maximal_fwd (\t. abs(f t)) x) pow 2) + + real_integral (:real) (\x. (hl_maximal_bwd (\t. abs(f t)) x) pow 2)` + SUBST1_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_ADD THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&4 * real_integral (:real) (\x. (f:real->real) x pow 2) + + &4 * real_integral (:real) (\x. f x pow 2)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_ADD2 THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_ARITH `&4 * a + &4 * a = &8 * a`; REAL_LE_REFL]]);; + +(* ========================================================================= *) +(* Tile setup and partial orders (Fremlin 286E-286G). *) +(* The dyadic grid, tile orders, and weight estimates are geometric; the *) +(* tile-localized test functions use the Fourier and Schwartz theory above. *) +(* ========================================================================= *) + +(* --- The dyadic grid (286E) --------------------------------------------- *) +(* Fremlin's dyadic intervals are the half-open [2^k n, 2^k (n+1)) with *) +(* k,n in Z (here dyho k n). Half-open is essential: it makes distinct *) +(* same-scale intervals genuinely DISJOINT (closed intervals would share an *) +(* endpoint) and gives the clean nesting trichotomy. 2^k for k in Z is the *) +(* integer power &2 zpow k. *) + +let dyho = new_definition + `dyho (k:int) (n:int) = + {x:real | real_of_int n * &2 zpow k <= x /\ x < (real_of_int n + &1) * &2 + zpow k}`;; + +(* 2^d is a positive integer when d >= 0 (used to change scale). *) +let DYADIC_SCALE_INT = prove + (`!d:int. &0 <= d ==> ?u:int. &2 zpow d = real_of_int u /\ &1 <= u`, + REPEAT STRIP_TAC THEN EXISTS_TAC `(&2:int) pow (num_of_int d)` THEN + ASM_SIMP_TAC[real_zpow] THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM REAL_OF_INT_CLAUSES] THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[REAL_OF_INT_CLAUSES]; REWRITE_TAC[INT_LE_POW2]]);; + +(* int<->real bridges kept LOCAL and TARGETED: the full REAL_OF_INT_CLAUSES *) +(* under GSYM would rewrite &2 into real_of_int(&2) and corrupt the zpow *) +(* base, so we extract only the product/sum/one clauses as directed *) +(* rewrites. *) +let ROI_LT_SUCC = prove + (`!a b:int. real_of_int a < real_of_int b + &1 ==> a <= b`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM INT_NOT_LT] THEN DISCH_TAC THEN + MP_TAC(SPECL [`b:int`;`a:int`] INT_LT_DISCRETE) THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN + SUBGOAL_THEN `real_of_int b + &1 <= real_of_int a` MP_TAC THENL + [SUBGOAL_THEN `real_of_int(b + &1) <= real_of_int a` MP_TAC THENL + [ASM_REWRITE_TAC[GSYM int_le]; ALL_TAC] THEN + REWRITE_TAC[REAL_OF_INT_CLAUSES] THEN + SIMP_TAC[GSYM REAL_OF_INT_CLAUSES] THEN + REWRITE_TAC[REAL_OF_INT_CLAUSES]; ALL_TAC] THEN ASM_REAL_ARITH_TAC);; + +let ROI_MUL = prove + (`!a b:int. real_of_int(a * b) = real_of_int a * real_of_int b`, + REWRITE_TAC[REAL_OF_INT_CLAUSES]);; + +let ROI_ADD = prove + (`!a b:int. real_of_int(a + b) = real_of_int a + real_of_int b`, + REWRITE_TAC[REAL_OF_INT_CLAUSES]);; + +let ROI_1 = prove + (`real_of_int(&1) = &1`, + REWRITE_TAC[REAL_OF_INT_CLAUSES]);; + +(* Same-scale disjointness: distinct dyadic intervals of the same length are *) +(* disjoint. *) +let DYHO_DISJOINT_SAMESCALE = prove + (`!k n m. ~(n = m) ==> DISJOINT (dyho k n) (dyho k m)`, + SUBGOAL_THEN + `!k p q:int. p < q ==> DISJOINT (dyho k p) (dyho k q)` ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&0 < &2 zpow k` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `real_of_int p + &1 <= real_of_int q` ASSUME_TAC THENL + [SUBGOAL_THEN `real_of_int(p + &1) <= real_of_int q` MP_TAC THENL + [REWRITE_TAC[GSYM int_le] THEN + ASM_MESON_TAC[INT_LT_DISCRETE]; ALL_TAC] THEN + REWRITE_TAC[ROI_ADD; ROI_1]; ALL_TAC] THEN + SUBGOAL_THEN + `(real_of_int p + &1) * &2 zpow k <= real_of_int q * &2 zpow k` + ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_RMUL THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE]; ALL_TAC] THEN + REWRITE_TAC[DISJOINT; EXTENSION; IN_INTER; NOT_IN_EMPTY; dyho; + IN_ELIM_THM] THEN + X_GEN_TAC `x:real` THEN ASM_REAL_ARITH_TAC; + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`n:int`; `m:int`] INT_LT_TOTAL) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_MESON_TAC[DISJOINT_SYM]]);; + +(* NESTING (the essential geometric property, 286E): if a finer dyadic *) +(* interval (k <= k', so length 2^k <= 2^k') meets a coarser one, it is *) +(* contained in it. Reduce to integers by writing 2^k' = 2^k * u with u a *) +(* positive integer (DYADIC_SCALE_INT), then n' u <= n and n+1 <= (n'+1) u. *) +let DYHO_NEST = prove + (`!k k' n n' x. + k <= k' /\ x IN dyho k n /\ x IN dyho k' n' + ==> dyho k n SUBSET dyho k' n'`, + REPEAT GEN_TAC THEN REWRITE_TAC[dyho; IN_ELIM_THM; SUBSET] THEN + STRIP_TAC THEN + SUBGOAL_THEN `&0 < &2 zpow k` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(SPEC `k' - k:int` DYADIC_SCALE_INT) THEN ANTS_TAC THENL + [ASM_INT_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `u:int` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `&2 zpow k' = &2 zpow k * real_of_int u` ASSUME_TAC THENL + [SUBGOAL_THEN + `k':int = k + (k' - k)` (fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) + [th]) THENL + [INT_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_ZPOW_ADD; REAL_ARITH `~(&2 = &0)`]; ALL_TAC] THEN + FIRST_ASSUM(fun th -> if concl th = `&2 zpow k' = &2 zpow k * real_of_int u` + then (ONCE_REWRITE_TAC[th] THEN + RULE_ASSUM_TAC(ONCE_REWRITE_RULE[th])) else NO_TAC) THEN + ABBREV_TAC `tt = &2 zpow k` THEN + SUBGOAL_THEN `(n':int) * u <= n` ASSUME_TAC THENL + [MATCH_MP_TAC ROI_LT_SUCC THEN REWRITE_TAC[ROI_MUL] THEN + SUBGOAL_THEN + `(real_of_int n' * real_of_int u) * tt < (real_of_int n + &1) * tt` + MP_TAC THENL + [SUBGOAL_THEN + `(real_of_int n' * real_of_int u) * tt = + real_of_int n' * (tt * real_of_int u)` + SUBST1_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LT_RMUL_EQ]; ALL_TAC] THEN + SUBGOAL_THEN `(n:int) < (n' + &1) * u` ASSUME_TAC THENL + [SUBGOAL_THEN `real_of_int n < real_of_int((n' + &1) * u)` MP_TAC THENL + [REWRITE_TAC[ROI_MUL; ROI_ADD; ROI_1] THEN + SUBGOAL_THEN + `real_of_int n * tt < ((real_of_int n' + &1) * real_of_int u) * tt` + MP_TAC THENL + [SUBGOAL_THEN + `((real_of_int n' + &1) * real_of_int u) * tt = (real_of_int n' + &1) + * (tt * real_of_int u)` + SUBST1_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LT_RMUL_EQ]; ALL_TAC] THEN + REWRITE_TAC[REAL_OF_INT_CLAUSES]; ALL_TAC] THEN + SUBGOAL_THEN `(n:int) + &1 <= (n' + &1) * u` ASSUME_TAC THENL + [ASM_MESON_TAC[INT_LT_DISCRETE]; ALL_TAC] THEN + X_GEN_TAC `y:real` THEN STRIP_TAC THEN + SUBGOAL_THEN `real_of_int n' * (tt * real_of_int u) <= real_of_int n * tt /\ + (real_of_int n + &1) * tt <= (real_of_int n' + &1) * (tt * + real_of_int u)` MP_TAC THENL + [CONJ_TAC THENL + [SUBGOAL_THEN + `real_of_int n' * (tt * real_of_int u) = + (real_of_int n' * real_of_int u) * tt` + SUBST1_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN + REWRITE_TAC[GSYM ROI_MUL; GSYM int_le] THEN ASM_REWRITE_TAC[]; + SUBGOAL_THEN + `(real_of_int n' + &1) * (tt * real_of_int u) = ((real_of_int n' + &1) + * real_of_int u) * tt` + SUBST1_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN + REWRITE_TAC[GSYM ROI_1; GSYM ROI_ADD; GSYM ROI_MUL; GSYM int_le] THEN + ASM_REWRITE_TAC[]]; ALL_TAC] THEN + ASM_REAL_ARITH_TAC);; + +(* The nesting trichotomy: any two dyadic intervals are nested or disjoint. *) +let DYHO_TRICHOTOMY = prove + (`!k n k' n'. dyho k n SUBSET dyho k' n' \/ dyho k' n' SUBSET dyho k n \/ + DISJOINT (dyho k n) (dyho k' n')`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `DISJOINT (dyho k n) (dyho k' n')` THENL + [ASM_REWRITE_TAC[]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o REWRITE_RULE[DISJOINT; GSYM MEMBER_NOT_EMPTY; + IN_INTER]) THEN + DISCH_THEN(X_CHOOSE_THEN `x:real` STRIP_ASSUME_TAC) THEN + DISJ_CASES_TAC(INT_ARITH `(k:int) <= k' \/ k':int <= k`) THENL + [DISJ1_TAC THEN MATCH_MP_TAC DYHO_NEST THEN EXISTS_TAC `x:real` THEN + ASM_REWRITE_TAC[]; + DISJ2_TAC THEN DISJ1_TAC THEN MATCH_MP_TAC DYHO_NEST THEN + EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[]]);; + +(* A dyadic interval is nonempty (contains its left endpoint). *) +let DYHO_NONEMPTY = prove + (`!k n. (real_of_int n * &2 zpow k) IN dyho k n`, + REPEAT GEN_TAC THEN REWRITE_TAC[dyho; IN_ELIM_THM] THEN + SUBGOAL_THEN `&0 < &2 zpow k` MP_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + REAL_ARITH_TAC);; + +(* Same-scale nesting forces EQUALITY: two dyadic cells of the same length, *) +(* one *) +(* contained in the other, must coincide (a nonempty subset cannot be *) +(* disjoint *) +(* from its superset, but distinct same-scale cells ARE disjoint). The *) +(* equal- *) +(* scale companion to DYHO_SUBSET_SCALE; feeds the tree J-orthogonality of *) +(* 286L. *) +let DYHO_SAMESCALE_EQ = prove + (`!k m n. dyho k m SUBSET dyho k n ==> m = n`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + GEN_REWRITE_TAC I [TAUT `p <=> ~ ~p`] THEN DISCH_TAC THEN + MP_TAC(SPECL [`k:int`; `m:int`; `n:int`] DYHO_DISJOINT_SAMESCALE) THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(SPECL [`k:int`; `m:int`] DYHO_NONEMPTY) THEN + REWRITE_TAC[DISJOINT; EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN + DISCH_TAC THEN DISCH_THEN(MP_TAC o SPEC `real_of_int m * &2 zpow k`) THEN + ASM SET_TAC[]);; + +(* 2^k = 2 * 2^(k-1); and the halving dyho k n = dyho(k-1)(2n) UNION *) +(* dyho(k-1)(2n+1). *) +let ZPOWK_HALF = prove + (`!k:int. &2 zpow k = &2 * &2 zpow (k - &1)`, + GEN_TAC THEN + SUBGOAL_THEN + `k:int = (k - &1) + &1` (fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) + [th]) THENL + [INT_ARITH_TAC; ALL_TAC] THEN + SIMP_TAC[REAL_ZPOW_ADD; REAL_ARITH `~(&2 = &0)`] THEN + REWRITE_TAC[REAL_ZPOW_1] THEN REAL_ARITH_TAC);; + +let ROI_2 = prove (`real_of_int(&2) = &2`, MESON_TAC[REAL_OF_INT_CLAUSES]);; + +(* Integer arithmetic helpers for the 286Fc J^l-disjointness (parity) *) +(* argument. 2 zpow d for d >= 1 is an EVEN positive integer: it equals 2 * *) +(* 2^(d-1). *) +let ZPOW_POS_EVEN_INT = prove + (`!d:int. &1 <= d + ==> ?M:int. &2 zpow d = real_of_int M /\ (?M':int. M = &2 * M' /\ &1 <= + M')`, + REPEAT STRIP_TAC THEN + EXISTS_TAC `&2 * &(2 EXP (num_of_int (d - &1))):int` THEN + SUBGOAL_THEN `d - &1 = &(num_of_int (d - &1))` ASSUME_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC INT_OF_NUM_OF_INT THEN + ASM_INT_ARITH_TAC; + ALL_TAC] THEN + CONJ_TAC THENL + [GEN_REWRITE_TAC (LAND_CONV) [ZPOWK_HALF] THEN + REWRITE_TAC[int_mul_th; int_of_num_th] THEN AP_TERM_TAC THEN + FIRST_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [th]) THEN + REWRITE_TAC[REAL_ZPOW_POW; REAL_OF_NUM_POW]; + EXISTS_TAC `&(2 EXP (num_of_int (d - &1))):int` THEN + REWRITE_TAC[INT_OF_NUM_LE] THEN + REWRITE_TAC[ARITH_RULE `1 <= m <=> ~(m = 0)`; EXP_EQ_0] THEN ARITH_TAC]);; + +(* even <= odd => even <= odd - 1 (over Z): 2B <= 2Q+1 ==> 2B <= 2Q. *) +let PARITY_HALF_LE = prove + (`!B Q:int. &2 * B <= &2 * Q + &1 ==> &2 * B <= &2 * Q`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `B <= Q:int` (fun th -> MP_TAC th THEN INT_ARITH_TAC) THEN + SUBGOAL_THEN `B < Q + &1:int` (fun th -> MP_TAC th THEN INT_ARITH_TAC) THEN + ONCE_REWRITE_TAC[GSYM(SPECL [`B:int`; `Q + &1:int`; + `&2:int`] INT_LT_LMUL_EQ)] THEN + ASM_INT_ARITH_TAC);; + +(* Product form of the halving: 2 zpow d (d>=1) = real_of_int(&2 * M'), *) +(* M'>=1. *) +let ZPOW_POS_EVEN_INT2 = prove + (`!d:int. &1 <= d ==> ?M':int. &2 zpow d = real_of_int (&2 * M') /\ &1 <= M'`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `d:int` ZPOW_POS_EVEN_INT) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `M:int` + (CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN + `M':int` STRIP_ASSUME_TAC))) THEN + EXISTS_TAC `M':int` THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `&2 zpow d = real_of_int M` THEN ASM_REWRITE_TAC[]);; + +(* even <= odd => even <= odd-1, in the c*(2M') product form (PARITY_HALF_LE *) +(* with B = c*M', pushed through INT_RING). *) +let ODD_PROD_HALF_LE = prove + (`!c M' Q:int. c * (&2 * M') <= &2 * Q + &1 ==> c * (&2 * M') <= &2 * Q`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `!X:int. c * (&2 * M') <= X <=> &2 * (c * M') <= X` + (fun th -> REWRITE_TAC[th]) THENL + [GEN_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + CONV_TAC INT_RING; ALL_TAC] THEN + REWRITE_TAC[PARITY_HALF_LE]);; + +let DYHO_HALVES = prove + (`!k n. dyho k n = dyho (k - &1) (&2 * n) UNION dyho (k - &1) (&2 * n + &1)`, + REPEAT GEN_TAC THEN REWRITE_TAC[EXTENSION; IN_UNION; dyho; IN_ELIM_THM] THEN + X_GEN_TAC `x:real` THEN + SUBGOAL_THEN `&0 < &2 zpow (k - &1)` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[ROI_MUL; ROI_ADD; ROI_1; ROI_2] THEN + MP_TAC(SPEC `k:int` ZPOWK_HALF) THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN + REAL_ARITH_TAC);; + +(* Exponent-monotonicity for base 2: p <= q ==> 2^p <= 2^q. *) +let ZPOW2_MONOE = prove + (`!p q:int. p <= q ==> &2 zpow p <= &2 zpow q`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&2 zpow q = &2 zpow p * &2 zpow (q - p)` SUBST1_TAC THENL + [SUBGOAL_THEN + `q:int = p + (q - p)` (fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) + [th]) THENL + [INT_ARITH_TAC; ALL_TAC] THEN + SIMP_TAC[REAL_ZPOW_ADD; REAL_ARITH `~(&2 = &0)`]; ALL_TAC] THEN + MP_TAC(SPEC `q - p:int` DYADIC_SCALE_INT) THEN ANTS_TAC THENL + [ASM_INT_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `u:int` STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[] 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_LT_IMP_LE THEN MATCH_MP_TAC REAL_ZPOW_LT THEN + REAL_ARITH_TAC; + UNDISCH_TAC `&1 <= u:int` THEN REWRITE_TAC[int_le] THEN + REWRITE_TAC[REAL_OF_INT_CLAUSES]]);; + +(* Strict version: 2 zpow is strictly increasing in the exponent. *) +let ZPOW2_MONOE_LT = prove + (`!k1 k2:int. k1 < k2 ==> &2 zpow k1 < &2 zpow k2`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&2 zpow (k1 + &1)` THEN + CONJ_TAC THENL + [SUBGOAL_THEN `&2 zpow (k1 + &1) = &2 zpow k1 * &2` SUBST1_TAC THENL + [SIMP_TAC[REAL_ZPOW_ADD; REAL_OF_NUM_EQ; ARITH_EQ; REAL_ZPOW_1]; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < &2 zpow k1` MP_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + REAL_ARITH_TAC; + MATCH_MP_TAC ZPOW2_MONOE THEN ASM_INT_ARITH_TAC]);; + +(* Strict-monotonicity contrapositive: 2^a0 < 2^kk forces a0 <= kk *) +(* (integers). *) +let ZPOW2_LT_IMP_LE = prove + (`!a0 kk:int. &2 zpow a0 < &2 zpow kk ==> a0 <= kk`, + REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC I [GSYM INT_NOT_LT] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`kk:int`; `a0:int`] ZPOW2_MONOE_LT) THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC);; + +(* Non-strict reverse monotonicity: 2^x <= 2^y => x <= y (integers). *) +let ZPOW2_LE_REV = prove + (`!x y:int. &2 zpow x <= &2 zpow y ==> x <= y`, + REPEAT STRIP_TAC THEN GEN_REWRITE_TAC I [GSYM INT_NOT_LT] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`y:int`; `x:int`] ZPOW2_MONOE_LT) THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC);; + +(* Strict reverse monotonicity: 2^a < 2^b => a < b (integers). *) +(* (Contrapositive of *) +(* ZPOW2_MONOE: b <= a => 2^b <= 2^a.) Needed for the alpha1 W1 level bound *) +(* mu K > mu I_tau (2^{-kt} < 2^{FST ap}) => -kt < FST ap => -kt + 1 <= FST *) +(* ap. *) +let ZPOW2_LT_REV = prove + (`!a b:int. &2 zpow a < &2 zpow b ==> a < b`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `~(b <= a:int)` MP_TAC THENL + [DISCH_TAC THEN + MP_TAC(ISPECL [`b:int`; `a:int`] ZPOW2_MONOE) THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC; + INT_ARITH_TAC]);; + +(* Containment forces the scale ordering: dyho a m SUBSET dyho b p ==> a <= *) +(* b *) +(* (the contained interval is the shorter one). Proof: if b < a, the left *) +(* endpoint and midpoint of dyho a m are at distance 2^(a-1) >= 2^b = the *) +(* full *) +(* width of dyho b p, so they cannot both lie in dyho b p. *) +let DYHO_SUBSET_SCALE = prove + (`!a m b p. dyho a m SUBSET dyho b p ==> a <= b`, + REPEAT GEN_TAC THEN REWRITE_TAC[GSYM INT_NOT_LT] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&0 < &2 zpow a` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `&2 zpow b <= &2 zpow (a - &1)` ASSUME_TAC THENL + [MATCH_MP_TAC ZPOW2_MONOE THEN ASM_INT_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `&2 zpow a = &2 * &2 zpow (a - &1)` ASSUME_TAC THENL + [SUBGOAL_THEN + `a:int = (a - &1) + &1` (fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) + [th]) THENL + [INT_ARITH_TAC; ALL_TAC] THEN + SIMP_TAC[REAL_ZPOW_ADD; REAL_ARITH `~(&2 = &0)`; REAL_ZPOW_1] THEN + REAL_ARITH_TAC; ALL_TAC] THEN + FIRST_X_ASSUM(fun th -> + let th' = REWRITE_RULE[SUBSET; dyho; IN_ELIM_THM] th in + MP_TAC(SPEC `real_of_int m * &2 zpow a` th') THEN + MP_TAC(SPEC `(real_of_int m + &1 / &2) * &2 zpow a` th')) THEN + ASM_REAL_ARITH_TAC);; + +(* PARENT-CELL NESTING: a dyadic cell dyho a p sits inside its parent at the *) +(* next *) +(* coarser scale a+1, whose index is the integer floor p div 2 (a cell [p *) +(* 2^a, *) +(* (p+1)2^a) with p = 2q+r, r in {0,1}, lies in [q 2^{a+1}, (q+1)2^{a+1})). *) +(* The *) +(* step that grows a cell toward the maximal cover Cal K one level at a *) +(* time. *) +let DYHO_PARENT = prove + (`!a p:int. dyho a p SUBSET dyho (a + &1) (p div &2)`, + REPEAT GEN_TAC THEN REWRITE_TAC[dyho; SUBSET; IN_ELIM_THM] THEN + X_GEN_TAC `x:real` THEN + SUBGOAL_THEN + `&0 < &2 zpow a /\ &2 zpow (a + &1) = + &2 * &2 zpow a` STRIP_ASSUME_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; + SIMP_TAC[REAL_ZPOW_ADD; REAL_ARITH `~(&2 = &0)`] THEN + REWRITE_TAC[REAL_ZPOW_1] THEN REAL_ARITH_TAC]; ALL_TAC] THEN + SUBGOAL_THEN + `real_of_int p = &2 * real_of_int (p div &2) + real_of_int(p rem &2) /\ + &0 <= real_of_int(p rem &2) /\ real_of_int(p rem &2) <= &1` + STRIP_ASSUME_TAC THENL + [MP_TAC(SPECL [`p:int`; `&2:int`] INT_DIVISION) THEN + ANTS_TAC THENL [INT_ARITH_TAC; ALL_TAC] THEN + STRIP_TAC THEN REWRITE_TAC[GSYM REAL_OF_INT_CLAUSES] THEN + REPEAT CONJ_TAC THEN REWRITE_TAC[REAL_OF_INT_CLAUSES] THEN + ASM_INT_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `real_of_int (p div &2) * &2 zpow (a + &1) = + real_of_int p * &2 zpow a - real_of_int(p rem &2) * &2 zpow a /\ + (real_of_int (p div &2) + &1) * &2 zpow (a + &1) = + real_of_int p * &2 zpow a + (&2 - real_of_int(p rem &2)) * &2 zpow a` + (CONJUNCTS_THEN SUBST1_TAC) THENL + [CONJ_TAC THEN + MAP_EVERY UNDISCH_TAC + [`real_of_int p = &2 * real_of_int (p div &2) + real_of_int(p rem &2)`; + `&2 zpow (a + &1) = &2 * &2 zpow a`] THEN + CONV_TAC REAL_RING; ALL_TAC] THEN + SUBGOAL_THEN `&0 <= real_of_int(p rem &2) * &2 zpow a /\ + &2 zpow a <= (&2 - real_of_int(p rem &2)) * &2 zpow a` + STRIP_ASSUME_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE]; + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN + ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + FIRST_X_ASSUM(K ALL_TAC o check (fun th -> + free_in `(p:int) div &2` (concl th)) o SPEC_ALL) THEN + SUBGOAL_THEN + `(real_of_int p + &1) * &2 zpow a = real_of_int p * &2 zpow a + &2 zpow a` + ASSUME_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + STRIP_TAC THEN CONJ_TAC THEN ASM_REAL_ARITH_TAC);; + +(* SUB-CELL ENUMERATION (286Gf): a finer cell dyho a p (a <= b, so length *) +(* 2 zpow a <= 2 zpow b) sits inside the coarser dyho b n exactly when its *) +(* index *) +(* p lands in the block [n*M, n*M + M) of the M = 2 zpow (b - a) sub-cells *) +(* of *) +(* dyho b n. Forward: the left endpoint p * 2 zpow a of dyho a p lies in *) +(* dyho *) +(* b n, giving both integer bounds (upper via int discreteness). Backward: *) +(* interval nesting. This is the workhorse for enumerating the same-scale *) +(* sub-tiles sigma <= tau of a coarse spatial cell I_tau. *) +let DYHO_SUBCELL_IFF = prove + (`!a b M n p. a <= b /\ &2 zpow (b - a) = real_of_int M + ==> (dyho a p SUBSET dyho b n <=> n * M <= p /\ p < n * M + M)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&0 < &2 zpow a` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `&2 zpow b = real_of_int M * &2 zpow a` ASSUME_TAC THENL + [FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + SUBGOAL_THEN + `b:int = (b - a) + a` (fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) + [th]) THENL + [INT_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_ZPOW_ADD THEN REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[dyho; SUBSET; IN_ELIM_THM] THEN ASM_REWRITE_TAC[] THEN + ABBREV_TAC `tt = &2 zpow a` THEN + SUBGOAL_THEN + `real_of_int n * real_of_int M * tt = real_of_int (n * M) * tt /\ + (real_of_int n + &1) * real_of_int M * tt = + (real_of_int (n * M) + real_of_int M) * tt` + STRIP_ASSUME_TAC THENL + [REWRITE_TAC[ROI_MUL] THEN CONJ_TAC THEN CONV_TAC REAL_RING; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN ABBREV_TAC `q = real_of_int (n * M)` THEN + SUBGOAL_THEN `(n * M <= p <=> q <= real_of_int p) /\ + (p < n * M + M <=> real_of_int p < q + real_of_int M)` + (fun th -> REWRITE_TAC[th]) THENL + [EXPAND_TAC "q" THEN REWRITE_TAC[GSYM ROI_ADD] THEN + REWRITE_TAC[int_le; int_lt]; ALL_TAC] THEN + EQ_TAC THENL + [DISCH_THEN(MP_TAC o SPEC `real_of_int p * tt`) THEN + ANTS_TAC THENL + [CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LT_RMUL THEN ASM_REAL_ARITH_TAC; + ASM_SIMP_TAC[REAL_LE_RMUL_EQ; REAL_LT_RMUL_EQ]]; + STRIP_TAC THEN + SUBGOAL_THEN `real_of_int p + &1 <= q + real_of_int M` ASSUME_TAC THENL + [MP_TAC(ASSUME `real_of_int p < q + real_of_int M`) THEN + EXPAND_TAC "q" THEN + REWRITE_TAC[GSYM ROI_1] THEN REWRITE_TAC[GSYM ROI_ADD] THEN + REWRITE_TAC[GSYM int_lt; GSYM int_le] THEN INT_ARITH_TAC; + ALL_TAC] THEN + X_GEN_TAC `x:real` THEN STRIP_TAC THEN CONJ_TAC THENL + [SUBGOAL_THEN `q * tt <= real_of_int p * tt` MP_TAC THENL + [ASM_SIMP_TAC[REAL_LE_RMUL_EQ]; ASM_REAL_ARITH_TAC]; + SUBGOAL_THEN + `(real_of_int p + &1) * tt <= (q + real_of_int M) * tt` MP_TAC THENL + [ASM_SIMP_TAC[REAL_LE_RMUL_EQ]; ASM_REAL_ARITH_TAC]]]);; + +(* M4: dyadic coarsening -- a length-2^a dyadic cell sits inside the coarser *) +(* length-2^b cell dyho b (p div 2^{b-a}) whenever a <= b. Existence of the *) +(* containing length-2^m interval Jhat for J_tau = dyho k_tau n (take b=m, *) +(* nhat = n div 2^{m-k_tau}, m >= k_tau). Via DYHO_SUBCELL_IFF + *) +(* INT_DIVISION *) +(* (Euclidean bounds n*M <= p < n*M+M with n = p div M, M = 2^{b-a} > 0). *) +let DYHO_COARSEN = prove + (`!a b p:int. a <= b ==> dyho a p SUBSET dyho b (p div (&2 pow (num_of_int (b + - a))))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&0 < (&2:int) pow (num_of_int (b - a))` ASSUME_TAC THENL + [MATCH_MP_TAC INT_POW_LT THEN INT_ARITH_TAC; ALL_TAC] THEN + ABBREV_TAC `M = (&2:int) pow (num_of_int (b - a))` THEN + SUBGOAL_THEN `&2 zpow (b - a) = real_of_int M` ASSUME_TAC THENL + [EXPAND_TAC "M" THEN + SUBGOAL_THEN + `b - a = &(num_of_int(b - a)):int` (fun th -> ONCE_REWRITE_TAC[th]) THENL + [ASM_SIMP_TAC[INT_OF_NUM_OF_INT; INT_SUB_LE]; ALL_TAC] THEN + REWRITE_TAC[REAL_ZPOW_NUM; int_pow_th; int_of_num_th; NUM_OF_INT_OF_NUM]; + ALL_TAC] THEN + MP_TAC(ISPECL [`a:int`; `b:int`; `M:int`; `p div M`; + `p:int`] DYHO_SUBCELL_IFF) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN + SUBGOAL_THEN `~(M:int = &0)` ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `abs(M:int) = M` ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPECL [`p:int`; `M:int`] INT_DIVISION) THEN + ASM_REWRITE_TAC[] THEN INT_ARITH_TAC);; + +(* M4 tree geometry: two dyadic cells that MEET, the first no coarser than *) +(* the *) +(* second (k <= k'), nest with the finer inside the coarser (shared point + *) +(* DYHO_NEST). Drives both (A-tree) containments (J_sigma SUBSET Jhat, Jhat *) +(* SUBSET J^r_sigma) from the shared J^r_tau. *) +let DYHO_MEET_NEST = prove + (`!k k' n n':int. + k <= k' /\ ~(DISJOINT (dyho k n) (dyho k' n')) + ==> dyho k n SUBSET dyho k' n'`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o REWRITE_RULE[SET_RULE + `~DISJOINT s t <=> ?x. x IN s /\ x IN t`]) THEN + DISCH_THEN(X_CHOOSE_THEN `x:real` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC DYHO_NEST THEN EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[]);; + +(* The k-scale index span [p*M, p*M+M) of a cell dyho a p (M = 2^{a+k}), *) +(* viewed *) +(* at tile-scale --k, is exactly dyho a p as a point set: q*2^{-k} = p*2^a *) +(* and *) +(* (q+M)*2^{-k} = (p+1)*2^a. This makes CARLESON_ALPHA_SCALE's k-span domain *) +(* condition definitional for a cover cell (Sc SUBSET dyho a p by *) +(* construction). *) +let DYHO_SPAN_INTERVAL = prove + (`!a p k M. &2 zpow (a + k) = real_of_int M + ==> {x | real_of_int (p * M) * &2 zpow (--k) <= x /\ + x < real_of_int (p * M + M) * &2 zpow (--k)} = dyho a p`, + REPEAT STRIP_TAC THEN REWRITE_TAC[dyho; EXTENSION; IN_ELIM_THM] THEN + X_GEN_TAC `x:real` THEN + SUBGOAL_THEN + `real_of_int (p * M) * &2 zpow (--k) = real_of_int p * &2 zpow a /\ + real_of_int (p * M + M) * &2 zpow (--k) = + (real_of_int p + &1) * &2 zpow a` + (fun th -> REWRITE_TAC[th]) THEN + REWRITE_TAC[] THEN + SUBGOAL_THEN `&2 zpow (a + k) * &2 zpow (--k) = &2 zpow a` ASSUME_TAC THENL + [SUBGOAL_THEN `~(&2 = &0)` + (fun th -> REWRITE_TAC[GSYM(MATCH_MP REAL_ZPOW_ADD th)]) THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + AP_TERM_TAC THEN INT_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[int_mul_th; int_add_th] THEN + UNDISCH_TAC `&2 zpow (a + k) = real_of_int M` THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + UNDISCH_TAC `&2 zpow (a + k) * &2 zpow (--k) = &2 zpow a` THEN + CONV_TAC REAL_RING);; + +(* --- The tile set Q and its associated quantities (286E) ---------------- *) +(* A tile sigma = (I_sigma, J_sigma) with mu(I)*mu(J) = 1 is parametrised by *) +(* (k, nI, nJ) : int#int#int, with I_sigma = dyho(-k) nI of length 2^-k and *) +(* J_sigma = dyho k nJ of length 2^k, so mu(I)*mu(J) = 1 holds by *) +(* construction. *) +(* k_sigma = k; x_sigma, y_sigma the midpoints; J^l, J^r the halves of J. *) + +let tile_I = new_definition `tile_I (k:int,nI:int,nJ:int) = dyho (--k) nI`;; +let tile_J = new_definition `tile_J (k:int,nI:int,nJ:int) = dyho k nJ`;; +let tile_k = new_definition `tile_k (k:int,nI:int,nJ:int) = k`;; +let dyho_mid = new_definition + `dyho_mid (k:int) (n:int) = (real_of_int n + &1 / &2) * &2 zpow k`;; +let tile_xmid = new_definition `tile_xmid (k:int,nI:int,nJ:int) = dyho_mid + (--k) nI`;; +let tile_ymid = new_definition + `tile_ymid (k:int,nI:int,nJ:int) = dyho_mid (k - &1) (&2 * nJ)`;; +let tile_Jl = new_definition `tile_Jl (k:int,nI:int,nJ:int) = dyho (k - &1) (&2 + * nJ)`;; +let tile_Jr = new_definition `tile_Jr (k:int,nI:int,nJ:int) = dyho (k - &1) (&2 + * nJ + &1)`;; + +(* The right half J^r of J is a sub-cell of J (the odd child *) +(* dyho(k-1)(2nJ+1) of *) +(* dyho k nJ), hence tile_Jr s SUBSET tile_J s. Used so that h x IN J_s^r *) +(* ==> *) +(* h x IN J_s, letting the Sc = ... cap h^-1[J_s^r] domain satisfy *) +(* CARLESON_ALPHA_ *) +(* SCALE's Sc SUBSET {x | h x IN tile_J s}. *) +let TILE_JR_SUBSET_J = prove + (`!s:int#int#int. tile_Jr s SUBSET tile_J s`, + REWRITE_TAC[FORALL_PAIR_THM; tile_Jr; tile_J] THEN REPEAT GEN_TAC THEN + MP_TAC(ISPECL [`p1 - &1:int`; `p1:int`; `&2:int`; `p2:int`; + `&2 * p2 + &1:int`] + DYHO_SUBCELL_IFF) THEN + ANTS_TAC THENL + [CONJ_TAC THENL [INT_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `p1 - (p1 - &1):int = &1` SUBST1_TAC THENL + [INT_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_ZPOW_1] THEN REWRITE_TAC[int_of_num_th]; + DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN INT_ARITH_TAC]);; + +(* Positional identity for the sub-tile enumeration (286Gf). A cell dyho kp *) +(* p *) +(* whose index p = M * n + j (M = 2 zpow (k - kp), the sub-cell count) sits *) +(* inside dyho k n; its midpoint measured from the parent left edge n * 2 *) +(* zpow k *) +(* equals (j + 1/2) * 2 zpow kp. Proof: 2 zpow k = 2 zpow (k-kp) * 2 zpow *) +(* kp, *) +(* so M * n * 2 zpow kp = n * 2 zpow k cancels. *) +let DYHO_MID_OFFSET = prove + (`!k kp M n j. &2 zpow (k - kp) = real_of_int M + ==> dyho_mid kp (M * n + j) - real_of_int n * &2 zpow k = + (real_of_int j + &1 / &2) * &2 zpow kp`, + REPEAT STRIP_TAC THEN REWRITE_TAC[dyho_mid] THEN + REWRITE_TAC[int_add_th; int_mul_th; int_of_num_th] THEN + SUBGOAL_THEN `&2 zpow k = &2 zpow (k - kp) * &2 zpow kp` SUBST1_TAC THENL + [SUBGOAL_THEN + `k:int = (k - kp) + kp` (fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) + [th]) THENL + [INT_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_ZPOW_ADD THEN REAL_ARITH_TAC; + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC]);; + +(* K-relative edge-distance (286L alpha0/alpha1 offset value). For a scale-k *) +(* tile *) +(* centre dyho_mid(--k) p and a coarser cover-cell left edge mm * 2^b (b + k *) +(* >= 0, *) +(* M = 2 zpow (b+k) the sub-cell count), the scaled distance to that edge is *) +(* a *) +(* HALF-INTEGER: 2^k (dyho_mid(--k) p - mm 2^b) = real_of_int (p - mm M) + *) +(* 1/2. *) +(* So the offset of x_sigma past K's edge, in units of 2^{-k}, is the *) +(* integer *) +(* p - mm M plus 1/2 -- exactly the argument of w(n + 1/2) in the alpha-sum *) +(* tail. *) +(* (2^k 2^{--k} = 1 and 2^k 2^b = 2^{b+k} = M cancel; REAL_RING closes.) *) +let TILE_DIST_TO_CELL = prove + (`!k q M nI x. + (q + M <= nI \/ nI <= q - &1) /\ + real_of_int q * &2 zpow (--k) <= x /\ x < real_of_int (q + M) * &2 zpow + (--k) + ==> (real_of_int (if q + M <= nI then nI - (q + M) else (q - &1) - nI) + + &1 / &2) + <= &2 zpow k * abs(x - dyho_mid (--k) nI)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN `&0 < &2 zpow k` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `&2 zpow k * &2 zpow (--k) = &1` ASSUME_TAC THENL + [SIMP_TAC[GSYM REAL_ZPOW_ADD; REAL_ARITH `~(&2 = &0)`] THEN + SUBGOAL_THEN `(k:int) + --k = &0` SUBST1_TAC THENL + [INT_ARITH_TAC; REWRITE_TAC[REAL_ZPOW_0]]; ALL_TAC] THEN + REWRITE_TAC[dyho_mid] THEN + SUBGOAL_THEN + `&2 zpow k * abs(x - (real_of_int nI + &1 / &2) * &2 zpow (--k)) = + abs(&2 zpow k * x - (real_of_int nI + &1 / &2))` + SUBST1_TAC THENL + [SUBGOAL_THEN + `&2 zpow k * abs(x - (real_of_int nI + &1 / &2) * &2 zpow (--k)) = + abs(&2 zpow k * (x - (real_of_int nI + &1 / &2) * &2 zpow + (--k)))` + SUBST1_TAC THENL + [REWRITE_TAC[REAL_ABS_MUL] THEN + SUBGOAL_THEN `abs(&2 zpow k) = &2 zpow k` SUBST1_TAC THENL + [ASM_REAL_ARITH_TAC; REWRITE_TAC[]]; + AP_TERM_TAC THEN + FIRST_X_ASSUM(fun th -> if concl th = `&2 zpow k * &2 zpow (--k) = &1` + then MP_TAC th else NO_TAC) THEN + CONV_TAC REAL_RING]; ALL_TAC] THEN + SUBGOAL_THEN + `&2 zpow k * (real_of_int q * &2 zpow (--k)) = real_of_int q /\ + &2 zpow k * (real_of_int (q + M) * &2 zpow (--k)) = real_of_int (q + M)` + STRIP_ASSUME_TAC THENL + [CONJ_TAC THEN + FIRST_X_ASSUM(fun th -> if concl th = `&2 zpow k * &2 zpow (--k) = &1` + then MP_TAC th else NO_TAC) THEN + CONV_TAC REAL_RING; ALL_TAC] THEN + SUBGOAL_THEN + `real_of_int q <= &2 zpow k * x /\ &2 zpow k * x < real_of_int (q + M)` + STRIP_ASSUME_TAC THENL + [CONJ_TAC THENL + [FIRST_X_ASSUM(SUBST1_TAC o SYM o + check (fun th -> concl th = `&2 zpow k * (real_of_int q * &2 zpow + (--k)) = real_of_int q`)) THEN + ASM_SIMP_TAC[REAL_LE_LMUL_EQ]; + FIRST_X_ASSUM(SUBST1_TAC o SYM o + check (fun th -> concl th = `&2 zpow k * (real_of_int (q + M) * &2 zpow + (--k)) = real_of_int (q + M)`)) THEN + ASM_SIMP_TAC[REAL_LT_LMUL_EQ]]; ALL_TAC] THEN + REPEAT (FIRST_X_ASSUM(K ALL_TAC o check (fun th -> + free_in `&2 zpow (--k)` (concl th)))) THEN + RULE_ASSUM_TAC(REWRITE_RULE[int_add_th; int_sub_th; int_of_num_th]) THEN + COND_CASES_TAC THEN + POP_ASSUM(MP_TAC o REWRITE_RULE[int_le; int_add_th; int_sub_th; + int_of_num_th]) THEN + REWRITE_TAC[int_add_th; int_sub_th; int_of_num_th] THEN + ASM_REAL_ARITH_TAC);; + +(* dyho_mid is INJECTIVE in the index at a fixed scale: (n + 1/2) 2^k = *) +(* (m+1/2) *) +(* 2^k forces n = m (cancel the positive 2^k, then the +1/2, then int_eq). *) +(* Used *) +(* to recover a tile's spatial index from its centre in the *) +(* tree-orthogonality. *) +let DYHO_MID_INJ = prove + (`!k m n. dyho_mid k m = dyho_mid k n ==> m = n`, + REPEAT GEN_TAC THEN REWRITE_TAC[dyho_mid] THEN + SUBGOAL_THEN `&0 < &2 zpow k` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_EQ_MUL_RCANCEL; REAL_LT_IMP_NZ] THEN + REWRITE_TAC[REAL_EQ_ADD_RCANCEL; GSYM int_eq]);; + +(* Distinct same-scale dyadic centres are at least 2^k apart: their *) +(* difference is *) +(* (real_of_int m - real_of_int n) 2^k with |m - n| >= 1 (distinct *) +(* integers). *) +(* This is the delta = 2^k SEPARATION that feeds CARD_LE_1_SEPARATED for the *) +(* alpha0/alpha1 offset fibers (the tile centres of a tree at scale k are *) +(* distinct *) +(* -- TILE_TREE_SAMESCALE_XMID_INJ -- hence 2^{-k}-separated at scale -k). *) +let tile_le = new_definition + `tile_le s t <=> tile_I s SUBSET tile_I t /\ tile_J t SUBSET tile_J s`;; +let tile_ler = new_definition + `tile_ler s t <=> tile_I s SUBSET tile_I t /\ tile_Jr t SUBSET tile_Jr s`;; +let TILE_LE_SCALE = prove + (`!s t. tile_le s t ==> tile_k t <= tile_k s`, + REWRITE_TAC[FORALL_PAIR_THM; tile_le; tile_I; tile_J; tile_k] THEN + REPEAT GEN_TAC THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP DYHO_SUBSET_SCALE) THEN INT_ARITH_TAC);; + +(* SUB-CELL INDEX (286Gf): if sigma = (k,nIs,nJs) <= tau = (kt,nIt,nJt) with *) +(* kt <= k, its spatial index nIs falls in the block [nIt*M, nIt*M + M) of *) +(* the *) +(* M = 2 zpow (k - kt) scale-k sub-cells of I_tau. Direct from *) +(* DYHO_SUBCELL_IFF *) +(* on I_sigma = dyho(--k) nIs SUBSET dyho(--kt) nIt = I_tau. *) +let TILE_LE_SUBCELL_INDEX = prove + (`!k kt nIs nJs nIt nJt M. + tile_le (k,nIs,nJs) (kt,nIt,nJt) /\ kt <= k /\ + &2 zpow (k - kt) = real_of_int M + ==> nIt * M <= nIs /\ nIs < nIt * M + M`, + REPEAT GEN_TAC THEN REWRITE_TAC[tile_le; tile_I] THEN STRIP_TAC THEN + MP_TAC(ISPECL [`--k:int`; `--kt:int`; `M:int`; `nIt:int`; + `nIs:int`] DYHO_SUBCELL_IFF) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [ASM_INT_ARITH_TAC; + SUBGOAL_THEN `--kt - --k:int = k - kt` SUBST1_TAC THENL + [INT_ARITH_TAC; ASM_REWRITE_TAC[]]]; + DISCH_THEN(fun th -> ASM_MESON_TAC[th])]);; + +(* SUB-CELL EDGE DISTANCES (286Gf): for a scale-k sub-tile of I_tau at *) +(* offset j *) +(* (index nIt*M + j, M = 2 zpow (k - kt) sub-cells), the scaled distance of *) +(* its *) +(* centre x_sigma from the LEFT edge alpha = nIt * 2 zpow (--kt) of I_tau is *) +(* 2^k*(x_sigma - alpha) = j + 1/2, and from the RIGHT edge gamma = (nIt+1) *) +(* * *) +(* 2 zpow (--kt) is 2^k*(gamma - x_sigma) = (M-1-j) + 1/2. These are exactly *) +(* the *) +(* arguments of CWTILE_TAIL_COMPLEMENT, mapping the per-tile tail onto the *) +(* half-integer pair (j, M-1-j) of TWO_SIDED_TAIL_SUM. Proof: *) +(* DYHO_MID_OFFSET *) +(* plus 2 zpow k * 2 zpow (--k) = 1 and 2 zpow (--kt) = M * 2 zpow (--k), *) +(* REAL_ *) +(* RING closes both. *) +let TILE_SUBCELL_EDGE_DIST = prove + (`!k kt M nIt j nJs. + &2 zpow (k - kt) = real_of_int M + ==> &2 zpow k * + (tile_xmid (k, M * nIt + j, nJs) - real_of_int nIt * &2 zpow (--kt)) = + real_of_int j + &1 / &2 /\ + &2 zpow k * + ((real_of_int nIt + &1) * &2 zpow (--kt) - tile_xmid (k, M * nIt + j, + nJs)) = + (real_of_int M - real_of_int j - &1) + &1 / &2`, + REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[tile_xmid] THEN + SUBGOAL_THEN `&2 zpow k * &2 zpow (--k) = &1` ASSUME_TAC THENL + [SIMP_TAC[GSYM REAL_ZPOW_ADD; REAL_ARITH `~(&2 = &0)`] THEN + SUBGOAL_THEN `(k:int) + --k = &0` SUBST1_TAC THENL + [INT_ARITH_TAC; REWRITE_TAC[REAL_ZPOW_0]]; + ALL_TAC] THEN + SUBGOAL_THEN + `&2 zpow (--kt) = real_of_int M * &2 zpow (--k)` ASSUME_TAC THENL + [FIRST_X_ASSUM(fun th -> if concl th = `&2 zpow (k - kt) = real_of_int M` + then SUBST1_TAC(SYM th) else NO_TAC) THEN + SUBGOAL_THEN `(--kt):int = (k - kt) + (--k)` SUBST1_TAC THENL + [INT_ARITH_TAC; SIMP_TAC[REAL_ZPOW_ADD; REAL_ARITH `~(&2 = &0)`]]; + ALL_TAC] THEN + MP_TAC(ISPECL [`--kt:int`; `--k:int`; `M:int`; `nIt:int`; + `j:int`] DYHO_MID_OFFSET) THEN + REWRITE_TAC[INT_ARITH `--kt - --k:int = k - kt`] THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + CONJ_TAC THEN POP_ASSUM_LIST(fun ths -> MP_TAC(end_itlist CONJ ths)) THEN + CONV_TAC REAL_RING);; + +(* <= is reflexive; <=_r refines <= (sigma <=_r tau ==> sigma <= tau). *) +let TILE_LE_REFL = prove + (`!s. tile_le s s`, + REWRITE_TAC[FORALL_PAIR_THM; tile_le; SUBSET_REFL]);; + +(* tile_le is TRANSITIVE (the chain/tree arguments of M3 rely on this). *) +let TILE_LE_TRANS = prove + (`!s t u. tile_le s t /\ tile_le t u ==> tile_le s u`, + REWRITE_TAC[tile_le] THEN REPEAT STRIP_TAC THEN ASM SET_TAC[]);; + +(* Dyadic ANCESTOR: for a <= b (with 2^{b-a} = M an integer), the cell dyho *) +(* a p sits *) +(* inside its scale-b ancestor dyho b (p div M). (DYHO_SUBCELL_IFF at n = p *) +(* div M; the *) +(* index bounds (p div M) M <= p < (p div M) M + M are INT_DIVISION with M *) +(* >= 1.) This *) +(* is the tool for constructing intermediate-scale intervals (286F(a-iv)). *) +let DYHO_ANCESTOR = prove + (`!a b M p:int. a <= b /\ &2 zpow (b - a) = real_of_int M + ==> dyho a p SUBSET dyho b (p div M)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&1 <= M:int` ASSUME_TAC THENL + [SUBGOAL_THEN `real_of_int (&1) <= real_of_int M` MP_TAC THENL + [REWRITE_TAC[int_of_num_th] THEN + UNDISCH_TAC `&2 zpow (b - a) = real_of_int M` THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + GEN_REWRITE_TAC LAND_CONV [GSYM(ISPEC `&2` REAL_ZPOW_0)] THEN + MATCH_MP_TAC ZPOW2_MONOE THEN ASM_INT_ARITH_TAC; + REWRITE_TAC[GSYM int_le]]; + ALL_TAC] THEN + MP_TAC(ISPECL [`a:int`; `b:int`; `M:int`; `p div M:int`; + `p:int`] DYHO_SUBCELL_IFF) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN + MP_TAC(ISPECL [`p:int`; `M:int`] INT_DIVISION) THEN + ANTS_TAC THENL [ASM_INT_ARITH_TAC; ALL_TAC] THEN + ASM_INT_ARITH_TAC);; + +(* 286F(a-iv) TREE INTERPOLATION: if sig <= tau (my tile_le sig tau: I_sig *) +(* SUBSET I_tau, *) +(* J_tau SUBSET J_sig) and k_tau <= k <= k_sig, there is an intermediate *) +(* tile ups with *) +(* sig <= ups <= tau and k_ups = k. Witness ups = (k, nI_sig div Mi, nJ_tau *) +(* div Mj): *) +(* I_ups = the scale-2^{-k} ancestor of I_sig (DYHO_ANCESTOR, Mi = *) +(* 2^{ksig-k}); J_ups = *) +(* the scale-2^k ancestor of J_tau (Mj = 2^{k-ktau}). The two "nest" *) +(* containments *) +(* I_ups SUBSET I_tau, J_ups SUBSET J_sig follow from DYHO_NEST at the *) +(* common point of *) +(* I_sig (resp J_tau). This is the key lemma for the G_K measure bound in *) +(* alpha2/alpha3. *) +let TILE_INTERP = prove + (`!sig tau k:int. + tile_le sig tau /\ tile_k tau <= k /\ k <= tile_k sig + ==> ?ups. tile_le sig ups /\ tile_le ups tau /\ tile_k ups = k`, + REWRITE_TAC[FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC + [`ksig:int`; `nIsig:int`; `nJsig:int`; `ktau:int`; `nItau:int`; `nJtau:int`; + `k:int`] THEN + REWRITE_TAC[tile_le; tile_I; tile_J; tile_k] THEN STRIP_TAC THEN + MP_TAC(ISPEC `ksig - k:int` DYADIC_SCALE_INT) THEN ANTS_TAC THENL + [ASM_INT_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `Mi:int` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPEC `k - ktau:int` DYADIC_SCALE_INT) THEN ANTS_TAC THENL + [ASM_INT_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `Mj:int` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(k, nIsig div Mi, nJtau div Mj):int#int#int` THEN + REWRITE_TAC[tile_I; tile_J; tile_k] THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC DYHO_ANCESTOR THEN + CONJ_TAC THENL [ASM_INT_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `--k - --ksig = ksig - k:int` SUBST1_TAC THENL + [INT_ARITH_TAC; ASM_REWRITE_TAC[]]; + MATCH_MP_TAC DYHO_NEST THEN + EXISTS_TAC `real_of_int nJtau * &2 zpow ktau` THEN + CONJ_TAC THENL + [ASM_INT_ARITH_TAC; + CONJ_TAC THENL + [MP_TAC(ISPECL [`ktau:int`; `k:int`; `Mj:int`; + `nJtau:int`] DYHO_ANCESTOR) THEN + ANTS_TAC THENL [ASM_INT_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[SUBSET] THEN DISCH_THEN MATCH_MP_TAC THEN + REWRITE_TAC[DYHO_NONEMPTY]; + UNDISCH_TAC `dyho ktau nJtau SUBSET dyho ksig nJsig` THEN + REWRITE_TAC[SUBSET] THEN DISCH_THEN MATCH_MP_TAC THEN + REWRITE_TAC[DYHO_NONEMPTY]]]; + MATCH_MP_TAC DYHO_NEST THEN + EXISTS_TAC `real_of_int nIsig * &2 zpow (--ksig)` THEN + CONJ_TAC THENL + [ASM_INT_ARITH_TAC; + CONJ_TAC THENL + [MP_TAC(ISPECL [`--ksig:int`; `--k:int`; `Mi:int`; + `nIsig:int`] DYHO_ANCESTOR) THEN + ANTS_TAC THENL + [CONJ_TAC THENL [ASM_INT_ARITH_TAC; + SUBGOAL_THEN `--k - --ksig = ksig - k:int` SUBST1_TAC THENL + [INT_ARITH_TAC; ASM_REWRITE_TAC[]]]; + ALL_TAC] THEN + REWRITE_TAC[SUBSET] THEN DISCH_THEN MATCH_MP_TAC THEN + REWRITE_TAC[DYHO_NONEMPTY]; + UNDISCH_TAC `dyho (--ksig) nIsig SUBSET dyho (--ktau) nItau` THEN + REWRITE_TAC[SUBSET] THEN DISCH_THEN MATCH_MP_TAC THEN + REWRITE_TAC[DYHO_NONEMPTY]]]; + MATCH_MP_TAC DYHO_ANCESTOR THEN + ASM_REWRITE_TAC[] THEN ASM_INT_ARITH_TAC]);; + +(* TREE J-ORTHOGONALITY (286L): two tiles s, t below a common tile u with *) +(* the *) +(* SAME scale k_s = k_t have the SAME frequency cell J_s = J_t. Both J_s, *) +(* J_t *) +(* contain J_u (from tile_le: J_u SUBSET J_s and J_u SUBSET J_t), and J_u is *) +(* nonempty; DYHO_NEST at the equal scale k_s nests J_s, J_t both ways *) +(* (SUBSET_ANTISYM) using J_u's left endpoint as the common point. This is *) +(* what *) +(* collapses the tree Gram matrix onto the 286J diagonal (equal-J block). *) +let TILE_TREE_SAMESCALE_J = prove + (`!s t u. tile_le s u /\ tile_le t u /\ tile_k s = tile_k t + ==> tile_J s = tile_J t`, + REWRITE_TAC[FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC + [`ks:int`;`nIs:int`;`nJs:int`;`kt:int`;`nIt:int`;`nJt:int`; + `ku:int`;`nIu:int`;`nJu:int`] THEN + REWRITE_TAC[tile_le; tile_k; tile_J; tile_I] THEN STRIP_TAC THEN + MATCH_MP_TAC SUBSET_ANTISYM THEN + FIRST_X_ASSUM SUBST_ALL_TAC THEN + CONJ_TAC THEN MATCH_MP_TAC DYHO_NEST THEN + EXISTS_TAC `real_of_int nJu * &2 zpow ku` THEN + ASM_REWRITE_TAC[INT_LE_REFL] THEN + CONJ_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET]) THEN + REWRITE_TAC[DYHO_NONEMPTY]);; + +(* TREE same-scale CENTRE-injectivity: two tiles s, t below a common u with *) +(* equal *) +(* scale AND equal centre x_sigma are EQUAL. Same centre + DYHO_MID_INJ *) +(* gives *) +(* nI_s = nI_t; TILE_TREE_SAMESCALE_J then gives J_s = J_t hence nJ_s = nJ_t *) +(* (DYHO_SAMESCALE_EQ); with k_s = k_t the triples coincide. This is why *) +(* distinct *) +(* scale-k tiles of a tree have DISTINCT centres -- the injectivity that *) +(* makes the *) +(* alpha0/alpha1 offset map at most 2-to-1 (one tile per side of the cover *) +(* cell). *) +let TILE_TREE_SAMESCALE_XMID_INJ = prove + (`!s t u. tile_le s u /\ tile_le t u /\ tile_k s = tile_k t /\ tile_xmid s = + tile_xmid t + ==> s = t`, + REWRITE_TAC[FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC + [`ks:int`;`nIs:int`;`nJs:int`;`kt:int`;`nIt:int`;`nJt:int`; + `ku:int`;`nIu:int`;`nJu:int`] THEN + REWRITE_TAC[tile_k; tile_xmid] THEN STRIP_TAC THEN + UNDISCH_TAC `ks:int = kt` THEN DISCH_THEN SUBST_ALL_TAC THEN + SUBGOAL_THEN `nIs:int = nIt` ASSUME_TAC THENL + [MATCH_MP_TAC DYHO_MID_INJ THEN EXISTS_TAC `--kt:int` THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `nJs:int = nJt` ASSUME_TAC THENL + [SUBGOAL_THEN `dyho kt nJs = dyho kt nJt` MP_TAC THENL + [MP_TAC(ISPECL [`(kt,nIs,nJs):int#int#int`; `(kt,nIt,nJt):int#int#int`; + `(ku,nIu,nJu):int#int#int`] TILE_TREE_SAMESCALE_J) THEN + REWRITE_TAC[tile_k; tile_J] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[]; + DISCH_TAC THEN MATCH_MP_TAC DYHO_SAMESCALE_EQ THEN + EXISTS_TAC `kt:int` THEN + ASM_REWRITE_TAC[SUBSET_REFL]]; + ASM_REWRITE_TAC[PAIR_EQ]]);; + +(* Corollary: on a scale-k tree, the SPATIAL INDEX nI determines the tile. *) +(* Same *) +(* nI (with same scale k, common upper bound u) => same centre x_sigma => *) +(* equal *) +(* tile (TILE_TREE_SAMESCALE_XMID_INJ). *) +let TILE_TREE_NI_INJ = prove + (`!k nI nJs nJt u. + tile_le (k,nI,nJs) u /\ tile_le (k,nI,nJt) u + ==> (k,nI,nJs):int#int#int = (k,nI,nJt)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC TILE_TREE_SAMESCALE_XMID_INJ THEN + EXISTS_TAC `u:int#int#int` THEN ASM_REWRITE_TAC[tile_k; tile_xmid]);; + +(* Packaged for a tree SUBSET: if every tile of Pk has scale k and lies *) +(* below u, then FST(SND .) = nI is INJECTIVE on Pk. *) +let TILE_TREE_FST_SND_INJ = prove + (`!(Pk:(int#int#int)->bool) k u s t. + (!r. r IN Pk ==> tile_k r = k /\ tile_le r u) /\ + s IN Pk /\ t IN Pk /\ FST(SND s) = FST(SND t) + ==> s = t`, + MAP_EVERY X_GEN_TAC [`Pk:(int#int#int)->bool`; `k:int`; `u:int#int#int`] THEN + REWRITE_TAC[FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC + [`ks:int`;`nIs:int`;`nJs:int`;`kt:int`;`nIt:int`;`nJt:int`] THEN + REWRITE_TAC[FST; SND] THEN STRIP_TAC THEN + SUBGOAL_THEN `tile_k (ks,nIs,nJs) = k /\ tile_le (ks,nIs,nJs) u /\ + tile_k (kt,nIt,nJt) = k /\ tile_le (kt,nIt,nJt) u` + STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[tile_k]) THEN + UNDISCH_TAC `kt:int = k` THEN UNDISCH_TAC `ks:int = k` THEN + DISCH_THEN SUBST_ALL_TAC THEN DISCH_THEN SUBST_ALL_TAC THEN + UNDISCH_TAC `nIs:int = nIt` THEN DISCH_THEN SUBST_ALL_TAC THEN + MATCH_MP_TAC TILE_TREE_NI_INJ THEN EXISTS_TAC `u:int#int#int` THEN + ASM_REWRITE_TAC[]);; + +(* 286L alpha0/alpha1 OFFSET-FIBER CARD <= 2. For a scale-k tree Pk and an *) +(* integer *) +(* reference index q (= mm * M, the cover cell K's left-edge index scaled to *) +(* level *) +(* -k), the fiber {sigma in Pk : |nI_sigma - q| = n} has at most TWO tiles: *) +(* nI is *) +(* injective on Pk (TILE_TREE_FST_SND_INJ), and |nI - q| = n pins nI in *) +(* {q-n, q+n}, *) +(* a 2-element set. This is the <=2-to-1 property SUM_FIBER_COUNT_2 consumes *) +(* (the *) +(* integer route: no separation/side split needed -- nI-injectivity + the *) +(* two *) +(* solutions of |nI - q| = n). *) +let FIBER_CARD_LE_INJ_PREIMAGE_GUARD = prove + (`!(A:B->bool) (key:B->C) (Q:C->bool) (h:C->num) (n:num). + FINITE A /\ (!s t. s IN A /\ t IN A /\ key s = key t ==> s = t) /\ + (!s. s IN A ==> Q(key s)) /\ + CARD {c:C | Q c /\ h c = n} <= 2 /\ FINITE {c:C | Q c /\ h c = n} + ==> CARD {s | s IN A /\ h(key s) = n} <= 2`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC LE_TRANS THEN + EXISTS_TAC `CARD (IMAGE (key:B->C) {s:B | s IN A /\ (h:C->num)(key s) = + (n:num)})` THEN + CONJ_TAC THENL + [MATCH_MP_TAC EQ_IMP_LE THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC CARD_IMAGE_INJ THEN CONJ_TAC THENL + [REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[]; + MATCH_MP_TAC FINITE_RESTRICT THEN ASM_REWRITE_TAC[]]; + MATCH_MP_TAC LE_TRANS THEN + EXISTS_TAC `CARD {c:C | (Q:C->bool) c /\ (h:C->num) c = (n:num)}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC CARD_SUBSET THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[SUBSET; IN_IMAGE; IN_ELIM_THM] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; + ASM_REWRITE_TAC[]]]);; + +(* 286L alpha0/alpha1 NEAREST-EDGE value-set count. The guarded value-set of *) +(* the *) +(* nearest-edge offset -- indices nI OUTSIDE the cover cell's index-span [q, *) +(* q+M) *) +(* (guard nI >= q+M \/ nI <= q-1) whose edge-distance num_of_int(if nI>=q+M *) +(* then *) +(* nI-(q+M) else (q-1)-nI) equals n -- has at most TWO elements {q+M+n, *) +(* q-1-n} *) +(* (one per side). Given &0 <= M. This is the CARD{c | Q c /\ h c = n} <= 2 *) +(* input *) +(* to FIBER_CARD_LE_INJ_PREIMAGE_GUARD. ASM_CASES on the guard simplifies *) +(* the *) +(* if-then-else; each branch pins nI to q+M+&n resp. q-1-&n *) +(* (INT_OF_NUM_OF_INT on *) +(* the nonneg edge-distance). *) +let EDGEOFF_VALSET_CARD = prove + (`!q M n:num. + &0 <= M + ==> CARD {nI:int | (q + M <= nI \/ nI <= q - &1) /\ + num_of_int(if q + M <= nI then nI - (q + M) else (q - &1) - + nI) = n} <= 2`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC LE_TRANS THEN + EXISTS_TAC `CARD {(q + M) + &n:int, (q - &1) - &n}` THEN CONJ_TAC THENL + [MATCH_MP_TAC CARD_SUBSET THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INSERT; NOT_IN_EMPTY] THEN + X_GEN_TAC `nI:int` THEN + ASM_CASES_TAC `q + M <= nI:int` THEN ASM_REWRITE_TAC[] THEN + STRIP_TAC THENL + [DISJ1_TAC THEN + MP_TAC(ISPEC `nI - (q + M):int` INT_OF_NUM_OF_INT) THEN + ANTS_TAC THENL [ASM_INT_ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN INT_ARITH_TAC; + DISJ2_TAC THEN + MP_TAC(ISPEC `(q - &1) - nI:int` INT_OF_NUM_OF_INT) THEN + ANTS_TAC THENL [ASM_INT_ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN INT_ARITH_TAC]; + REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY]]; + SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY] THEN ARITH_TAC]);; + +(* Companion to EDGEOFF_VALSET_CARD: the guarded nearest-edge value-set is *) +(* FINITE *) +(* (it is a subset of the 2-element {q+M+n, q-1-n}). Both CARD<=2 and FINITE *) +(* are *) +(* the two hypotheses FIBER_CARD_LE_INJ_PREIMAGE_GUARD needs on the *) +(* value-set. *) +let EDGEOFF_VALSET_FINITE = prove + (`!q M n:num. + FINITE {nI:int | (q + M <= nI \/ nI <= q - &1) /\ + num_of_int(if q + M <= nI then nI - (q + M) else (q - &1) - + nI) = n}`, + REPEAT GEN_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `{(q + M) + &n:int, (q - &1) - &n}` THEN + REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_INSERT; NOT_IN_EMPTY] THEN + X_GEN_TAC `c:int` THEN + ASM_CASES_TAC `q + M <= c:int` THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THENL + [DISJ1_TAC THEN + MP_TAC(ISPEC `c - (q + M):int` INT_OF_NUM_OF_INT) THEN + ANTS_TAC THENL [ASM_INT_ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN INT_ARITH_TAC; + DISJ2_TAC THEN + MP_TAC(ISPEC `(q - &1) - c:int` INT_OF_NUM_OF_INT) THEN + ANTS_TAC THENL [ASM_INT_ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN INT_ARITH_TAC]);; + +(* The concrete tile offset-fiber count: among the tiles of a same-scale *) +(* tree A *) +(* whose index nI lies OUTSIDE the cover cell's span [q,q+M), at most two *) +(* share *) +(* any given nearest-edge offset value n. Composes the abstract fiber-count *) +(* engine (FIBER_CARD_LE_INJ_PREIMAGE_GUARD) with tree nI-injectivity *) +(* (TILE_TREE_FST_SND_INJ) and the value-set count plus finiteness lemmas. *) +(* This discharges the fiber hypothesis of ALPHA_SCALE_BOUND_ABSTRACT. *) +let TILE_OFFSET_FIBER_CARD = prove + (`!(A:(int#int#int)->bool) k u q M n. + FINITE A /\ &0 <= M /\ + (!s. s IN A ==> tile_k s = k /\ tile_le s u) /\ + (!s. s IN A ==> (q + M <= FST(SND s) \/ FST(SND s) <= q - &1)) + ==> CARD {s | s IN A /\ + num_of_int(if q + M <= FST(SND s) then FST(SND s) - (q + M) + else (q - &1) - FST(SND s)) = n} <= 2`, + REPEAT STRIP_TAC THEN + MP_TAC(BETA_RULE(ISPECL + [`A:(int#int#int)->bool`; + `\s:int#int#int. FST(SND s)`; + `\c:int. q + M <= c \/ c <= q - &1`; + `\c:int. num_of_int(if q + M <= c then c - (q + M) else (q - &1) - c)`; + `n:num`] FIBER_CARD_LE_INJ_PREIMAGE_GUARD)) THEN + DISCH_THEN MATCH_MP_TAC THEN REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC THEN MATCH_MP_TAC TILE_TREE_FST_SND_INJ THEN + MAP_EVERY EXISTS_TAC [`A:(int#int#int)->bool`; `k:int`; + `u:int#int#int`] THEN + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + MP_TAC(ISPECL [`q:int`; `M:int`; `n:num`] EDGEOFF_VALSET_CARD) THEN + ASM_REWRITE_TAC[]; + REWRITE_TAC[EDGEOFF_VALSET_FINITE]]);; + +(* Dyadic half-interval facts underlying the 286F-b refinement. *) +(* J^r = dyho(k-1)(2n+1) is the RIGHT half of J = dyho k n, hence inside it. *) +let DYHO_JR_SUBSET_J = prove + (`!k n. dyho (k - &1) (&2 * n + &1) SUBSET dyho k n`, + REPEAT GEN_TAC THEN GEN_REWRITE_TAC (RAND_CONV) [DYHO_HALVES] THEN + REWRITE_TAC[SUBSET_UNION]);; + +(* Jr-nesting forces J-nesting: Jr t SUBSET Jr s ==> J t SUBSET J s. The *) +(* left *) +(* endpoint z of Jr t lies in Jr t (DYHO_NONEMPTY), hence in J t and (via Jr *) +(* s *) +(* SUBSET J s) in J s; the shared point z + the scale ordering from *) +(* DYHO_SUBSET_ *) +(* SCALE feed DYHO_NEST to nest the full J's. *) +let DYHO_JR_NEST_J = prove + (`!k n k' n'. + dyho (k' - &1) (&2 * n' + &1) SUBSET dyho (k - &1) (&2 * n + &1) + ==> dyho k' n' SUBSET dyho k n`, + REPEAT STRIP_TAC THEN + ABBREV_TAC `z = real_of_int(&2 * n' + &1) * &2 zpow (k' - &1)` THEN + SUBGOAL_THEN `(z:real) IN dyho (k' - &1) (&2 * n' + &1)` ASSUME_TAC THENL + [EXPAND_TAC "z" THEN REWRITE_TAC[DYHO_NONEMPTY]; ALL_TAC] THEN + SUBGOAL_THEN `(z:real) IN dyho k' n'` ASSUME_TAC THENL + [MP_TAC(ISPECL [`k':int`;`n':int`] DYHO_JR_SUBSET_J) THEN + ASM SET_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `(z:real) IN dyho k n` ASSUME_TAC THENL + [MP_TAC(ISPECL [`k:int`;`n:int`] DYHO_JR_SUBSET_J) THEN + ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC DYHO_NEST THEN EXISTS_TAC `z:real` THEN ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP DYHO_SUBSET_SCALE) THEN INT_ARITH_TAC);; + +(* 286F-b: sigma <=_r tau ==> sigma <= tau. The I-parts coincide; *) +(* DYHO_JR_NEST_J *) +(* upgrades the J^r-nesting to J-nesting. *) +let TILE_LER_IMP_LE = prove + (`!s t. tile_ler s t ==> tile_le s t`, + REWRITE_TAC[FORALL_PAIR_THM; tile_ler; tile_le; tile_I; tile_J; tile_Jr] THEN + REPEAT GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC DYHO_JR_NEST_J THEN ASM_REWRITE_TAC[]);; + +let TILE_LER_REFL = prove + (`!s. tile_ler s s`, + REWRITE_TAC[FORALL_PAIR_THM; tile_ler; SUBSET_REFL]);; + +(* 286F-a-i for <=_r: sigma <=_r tau ==> k_tau <= k_sigma (via *) +(* TILE_LER_IMP_LE). *) +let TILE_LER_SCALE = prove + (`!s t. tile_ler s t ==> tile_k t <= tile_k s`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC TILE_LE_SCALE THEN + MATCH_MP_TAC TILE_LER_IMP_LE THEN ASM_REWRITE_TAC[]);; + +(* <=_r is TRANSITIVE (I-parts nest forward, J^r-parts nest backward, both *) +(* by *) +(* SUBSET transitivity). Underlies the tile-tree monotonicity below and the *) +(* nested-tree bookkeeping in 286K. *) +let cw = new_definition `cw (x:real) = &1 / (&1 + abs x) pow 3`;; + +(* cw is continuous everywhere since the denominator (1+|x|)^3 is nonzero. *) +let CW_CONTINUOUS = prove + (`cw real_continuous_on (:real)`, + SUBGOAL_THEN `cw = (\x. &1 / (&1 + abs x) pow 3)` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; cw]; ALL_TAC] THEN + MP_TAC(BETA_RULE(ISPECL [`(\x:real. &1)`; `(\x:real. (&1 + abs x) pow 3)`; + `(:real)`] + REAL_CONTINUOUS_ON_DIV)) THEN + ANTS_TAC THENL + [REWRITE_TAC[REAL_CONTINUOUS_ON_CONST] THEN CONJ_TAC THENL + [MP_TAC(BETA_RULE(ISPECL [`(\x:real. &1 + abs x)`; `3`; `(:real)`] + REAL_CONTINUOUS_ON_POW)) THEN DISCH_THEN MATCH_MP_TAC THEN + MP_TAC(BETA_RULE(ISPECL [`(\x:real. &1)`; `(\x:real. abs x)`; `(:real)`] + REAL_CONTINUOUS_ON_ADD)) THEN DISCH_THEN MATCH_MP_TAC THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_CONST] THEN + MP_TAC(BETA_RULE(ISPECL [`(\x:real. x)`; + `(:real)`] REAL_CONTINUOUS_ON_ABS)) THEN + DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[REAL_CONTINUOUS_ON_ID]; + GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC REAL_POW_NZ THEN + MP_TAC(ISPEC `x:real` REAL_ABS_POS) THEN REAL_ARITH_TAC]; + DISCH_THEN ACCEPT_TAC]);; + +(* The affinely-shifted weight is continuous: x |-> w(a x + b) = w o *) +(* (affine). *) +let CW_SHIFT_CONTINUOUS = prove + (`!a b. (\x. cw(a * x + b)) real_continuous_on (:real)`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `(\x. cw(a * x + b)) = cw o (\x. a * x + b)` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; o_THM]; ALL_TAC] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL + [MP_TAC(BETA_RULE(ISPECL [`(\x:real. a * x)`; `(\x:real. b:real)`; + `(:real)`] + REAL_CONTINUOUS_ON_ADD)) THEN DISCH_THEN MATCH_MP_TAC THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_CONST] THEN + MP_TAC(BETA_RULE(ISPECL [`(\x:real. x)`; `a:real`; + `(:real)`] REAL_CONTINUOUS_ON_LMUL)) THEN + REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_ID]; + MATCH_MP_TAC REAL_CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `(:real)` THEN + REWRITE_TAC[CW_CONTINUOUS; SUBSET_UNIV]]);; + +(* cw is even. *) +let CW_EVEN = prove + (`!x. cw(--x) = cw x`, + GEN_TAC THEN REWRITE_TAC[cw; REAL_ABS_NEG]);; + +let CW_POS = prove + (`!x. &0 < cw x`, + GEN_TAC THEN REWRITE_TAC[cw] THEN MATCH_MP_TAC REAL_LT_DIV THEN + CONJ_TAC THENL [REAL_ARITH_TAC; MATCH_MP_TAC REAL_POW_LT THEN + REAL_ARITH_TAC]);; + +let CW_LE_1 = prove + (`!x. cw x <= &1`, + GEN_TAC THEN REWRITE_TAC[cw] THEN + SUBGOAL_THEN `&0 < (&1 + abs x) pow 3` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_POW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ] THEN REWRITE_TAC[REAL_MUL_LID] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM(REAL_ARITH `&1 pow 3 = &1`)] THEN + MATCH_MP_TAC REAL_POW_LE2 THEN REAL_ARITH_TAC);; + +(* The tile-localized weight w_sigma(x) = 2^k w(2^k (x - x_sigma)) (286E-c); *) +(* this is positive by construction. *) +let cw_tile = new_definition + `cw_tile (s:int#int#int) (x:real) = + &2 zpow (tile_k s) * cw (&2 zpow (tile_k s) * (x - tile_xmid s))`;; + +let CW_TILE_POS = prove + (`!s x. &0 < cw_tile s x`, + REPEAT GEN_TAC THEN REWRITE_TAC[cw_tile] THEN MATCH_MP_TAC REAL_LT_MUL THEN + CONJ_TAC THENL [MATCH_MP_TAC REAL_ZPOW_LT THEN + REAL_ARITH_TAC; REWRITE_TAC[CW_POS]]);; + +(* Antiderivative / definite integral of the profile 1/(1+x)^3 (needed for *) +(* the 286G weight estimates: normalization int w = 1, tails, and 286G-d). *) +(* F(x) = -1/(2(1+x)^2) has F'(x) = 1/(1+x)^3 for x > -1. *) +let W_DERIV = prove + (`!x. &0 < &1 + x + ==> ((\x. --(&1 / (&2 * (&1 + x) pow 2))) has_real_derivative (&1 / (&1 + x) + pow 3)) (atreal x)`, + REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN + SUBGOAL_THEN `~(&1 + x = &0)` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[REAL_POW_1] THEN + POP_ASSUM MP_TAC THEN CONV_TAC REAL_FIELD);; + +let W_INTEGRAL = prove + (`!a b. -- &1 < a /\ a <= b + ==> ((\x. &1 / (&1 + x) pow 3) has_real_integral + (&1 / (&2 * (&1 + a) pow 2) - &1 / (&2 * (&1 + b) pow 2))) + (real_interval[a,b])`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `&1 / (&2 * (&1 + a) pow 2) - &1 / (&2 * (&1 + b) pow 2) = + (\x. --(&1 / (&2 * (&1 + x) pow 2))) b - (\x. --(&1 / (&2 * (&1 + x) pow + 2))) a` + SUBST1_TAC THENL [REWRITE_TAC[] THEN REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS THEN + ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real` THEN DISCH_TAC THEN + MATCH_MP_TAC HAS_REAL_DERIVATIVE_ATREAL_WITHIN THEN MATCH_MP_TAC W_DERIV THEN + FIRST_X_ASSUM(MP_TAC o REWRITE_RULE[IN_REAL_INTERVAL]) THEN + ASM_REAL_ARITH_TAC);; + +(* inv(1+x) -> 0 and hence the tail value 1/(2(1+b)^2) -> 0 at +infinity *) +(* (the residual term in W_INTEGRAL as the upper limit goes to infinity). *) +let INV_1PX_LIM = prove + (`((\x. inv(&1 + x)) ---> &0) at_posinfinity`, + REWRITE_TAC[REALLIM_AT_POSINFINITY] THEN X_GEN_TAC `e:real` THEN + DISCH_TAC THEN + EXISTS_TAC `&1 / e` THEN X_GEN_TAC `x:real` THEN REWRITE_TAC[real_ge] THEN + DISCH_TAC THEN + SUBGOAL_THEN `&0 < &1 / e` ASSUME_TAC THENL + [ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_01]; ALL_TAC] THEN + ABBREV_TAC `d = &1 / e` THEN + SUBGOAL_THEN `d < &1 + x` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `&0 < &1 + x` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_SUB_RZERO] THEN + ASM_SIMP_TAC[REAL_ABS_INV; REAL_ARITH `&0 < y ==> abs y = y`] THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `inv(d:real)` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LT_INV2 THEN ASM_REWRITE_TAC[]; + EXPAND_TAC "d" THEN ASM_SIMP_TAC[REAL_INV_DIV] THEN ASM_REAL_ARITH_TAC]);; + +let TAIL_PW = prove + (`!x. &0 <= x ==> abs(&1 / (&2 * (&1 + x) pow 2)) <= inv(&1 + x)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&0 < &1 + x` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `&0 < (&1 + x) pow 2` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_POW_LT THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `&0 < &2 * (&1 + x) pow 2` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_ABS_DIV; REAL_ABS_NUM; + REAL_ARITH `&0 < a ==> abs a = a`] THEN + REWRITE_TAC[REAL_ARITH `&1 / y = inv y`] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[REAL_POW_2] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < a ==> (a <= &2 * a * a <=> &1 * a <= (&2 * a) * + a)`] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN ASM_REAL_ARITH_TAC);; + +let TAILVAL_LIM = prove + (`((\b. &1 / (&2 * (&1 + b) pow 2)) ---> &0) at_posinfinity`, + MATCH_MP_TAC REALLIM_NULL_COMPARISON THEN EXISTS_TAC `\x. inv(&1 + x)` THEN + REWRITE_TAC[INV_1PX_LIM] THEN REWRITE_TAC[EVENTUALLY_AT_POSINFINITY] THEN + EXISTS_TAC `&0` THEN X_GEN_TAC `x:real` THEN REWRITE_TAC[real_ge] THEN + DISCH_TAC THEN MATCH_MP_TAC TAIL_PW THEN ASM_REWRITE_TAC[]);; + +(* A reusable real-level HALF-LINE integral criterion: f has integral l over *) +(* {x | a <= x} iff f is integrable on every [a,b] and the finite integrals *) +(* converge to l as b -> +infinity. Bridged from the vector *) +(* HAS_INTEGRAL_LIM_AT_POSINFINITY_GEN via the has_real_integral definition *) +(* (IMAGE lift {x | a<=x} = {t | a<=drop t}, TENDSTO_REAL, REAL_INTEGRAL). *) +let IMAGE_LIFT_GE = prove + (`!a. IMAGE lift {x | a <= x} = {t:real^1 | a <= drop t}`, + GEN_TAC THEN REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM] THEN GEN_TAC THEN + EQ_TAC THENL + [STRIP_TAC THEN ASM_REWRITE_TAC[LIFT_DROP]; + DISCH_TAC THEN EXISTS_TAC `drop x` THEN ASM_REWRITE_TAC[LIFT_DROP]]);; + +let REAL_HALFLINE_INTEGRAL = prove + (`!f a l. (f has_real_integral l) {x | a <= x} <=> + (!b. f real_integrable_on real_interval[a,b]) /\ + ((\b. real_integral (real_interval[a,b]) f) ---> l) at_posinfinity`, + REPEAT GEN_TAC THEN REWRITE_TAC[has_real_integral; IMAGE_LIFT_GE] THEN + MP_TAC(ISPECL [`lift o f o drop`; `a:real`; + `lift l`] HAS_INTEGRAL_LIM_AT_POSINFINITY_GEN) THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN + REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; GSYM REAL_INTEGRABLE_ON] THEN + MATCH_MP_TAC(TAUT `(a ==> (b <=> b')) ==> (a /\ b <=> a /\ b')`) THEN + DISCH_TAC THEN REWRITE_TAC[TENDSTO_REAL] THEN + SUBGOAL_THEN + `(\b. integral (IMAGE lift (real_interval [a,b])) (lift o f o drop)) = + (lift o (\b. real_integral (real_interval [a,b]) f))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; o_THM] THEN X_GEN_TAC `b:real` THEN + ASM_SIMP_TAC[REAL_INTEGRAL] THEN + REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL; LIFT_DROP]; REWRITE_TAC[]]);; + +(* w on [0,b] (b>=0) equals the profile 1/(1+x)^3 (abs x = x there), so its *) +(* integral is the W_INTEGRAL value. *) +let CW_INTEGRAL_0B = prove + (`!b. &0 <= b + ==> (cw has_real_integral (&1 / (&2 * (&1 + &0) pow 2) - &1 / (&2 * (&1 + b) + pow 2))) (real_interval[&0,b])`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_SPIKE THEN + EXISTS_TAC `\x. &1 / (&1 + x) pow 3` THEN EXISTS_TAC `{}:real->bool` THEN + REWRITE_TAC[REAL_NEGLIGIBLE_EMPTY; IN_DIFF; NOT_IN_EMPTY] THEN CONJ_TAC THENL + [X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN STRIP_TAC THEN + REWRITE_TAC[cw] THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + AP_TERM_TAC THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC W_INTEGRAL THEN ASM_REAL_ARITH_TAC]);; + +let CW_TAIL_LIM = prove + (`((\b. real_integral (real_interval[&0,b]) cw) ---> &1 / &2) at_posinfinity`, + MATCH_MP_TAC REALLIM_TRANSFORM_EVENTUALLY THEN + EXISTS_TAC `\b. &1 / &2 - &1 / (&2 * (&1 + b) pow 2)` THEN CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_AT_POSINFINITY] THEN EXISTS_TAC `&0` THEN + X_GEN_TAC `b:real` THEN REWRITE_TAC[real_ge] THEN DISCH_TAC THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `&1 / (&2 * (&1 + &0) pow 2) - &1 / (&2 * (&1 + b) pow 2)` THEN + CONJ_TAC THENL + [CONV_TAC REAL_RAT_REDUCE_CONV; + CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + ASM_SIMP_TAC[CW_INTEGRAL_0B]]; + GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV) [REAL_ARITH `&1 / &2 = &1 / &2 - + &0`] THEN + MATCH_MP_TAC REALLIM_SUB THEN REWRITE_TAC[REALLIM_CONST; TAILVAL_LIM]]);; + +(* The right-hand half of the normalization: int_{[0,inf)} w = 1/2. *) +let CW_HALFLINE = prove + (`(cw has_real_integral (&1 / &2)) {x | &0 <= x}`, + REWRITE_TAC[REAL_HALFLINE_INTEGRAL; CW_TAIL_LIM] THEN + X_GEN_TAC `b:real` THEN + DISJ_CASES_TAC(REAL_ARITH `&0 <= b \/ b < &0`) THENL + [MATCH_MP_TAC HAS_REAL_INTEGRAL_INTEGRABLE THEN + EXISTS_TAC `&1 / (&2 * (&1 + &0) pow 2) - &1 / (&2 * (&1 + b) pow 2)` THEN + ASM_SIMP_TAC[CW_INTEGRAL_0B]; + SUBGOAL_THEN `real_interval[&0,b] = {}` SUBST1_TAC THENL + [REWRITE_TAC[REAL_INTERVAL_EQ_EMPTY] THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[REAL_INTEGRABLE_ON_EMPTY]]]);; + +(* ------------------------------------------------------------------------- *) +(* Weight-tail integrals from a base point c >= 0 (toward Fremlin 286Gf, the *) +(* "mass leaking outside I_tau" estimate). cw = 1/(1+|x|)^3 = 1/(1+x)^3 on *) +(* x >= 0, so the FTC value 1/(2(1+a)^2) - 1/(2(1+b)^2) (W_INTEGRAL) *) +(* transfers. *) +(* ------------------------------------------------------------------------- *) + +(* Finite [c,b] tail (c <= b, c >= 0). *) +let CW_INTEGRAL_CB = prove + (`!c b. &0 <= c /\ c <= b + ==> (cw has_real_integral (&1 / (&2 * (&1 + c) pow 2) - &1 / (&2 * (&1 + b) + pow 2))) + (real_interval[c,b])`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_SPIKE THEN + EXISTS_TAC `\x. &1 / (&1 + x) pow 3` THEN EXISTS_TAC `{}:real->bool` THEN + REWRITE_TAC[REAL_NEGLIGIBLE_EMPTY; IN_DIFF; NOT_IN_EMPTY] THEN CONJ_TAC THENL + [X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN STRIP_TAC THEN + REWRITE_TAC[cw] THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + AP_TERM_TAC THEN + ASM_REAL_ARITH_TAC; + MATCH_MP_TAC W_INTEGRAL THEN ASM_REAL_ARITH_TAC]);; + +(* The finite tail -> 1/(2(1+c)^2) as b -> +inf. *) +let CW_TAIL_LIM_C = prove + (`!c. &0 <= c + ==> ((\b. real_integral (real_interval[c,b]) cw) ---> &1 / (&2 * (&1 + c) + pow 2)) + at_posinfinity`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REALLIM_TRANSFORM_EVENTUALLY THEN + EXISTS_TAC `\b. &1 / (&2 * (&1 + c) pow 2) - &1 / (&2 * (&1 + b) pow 2)` THEN + CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_AT_POSINFINITY] THEN EXISTS_TAC `c:real` THEN + X_GEN_TAC `b:real` THEN REWRITE_TAC[real_ge] THEN DISCH_TAC THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + MATCH_MP_TAC CW_INTEGRAL_CB THEN ASM_REWRITE_TAC[]; + GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV) + [REAL_ARITH `&1 / (&2 * (&1 + c) pow 2) = &1 / (&2 * (&1 + c) pow 2) - + &0`] THEN + MATCH_MP_TAC REALLIM_SUB THEN REWRITE_TAC[REALLIM_CONST; TAILVAL_LIM]]);; + +(* The half-line tail value: int_{x >= c} w = 1/(2(1+c)^2) for c >= 0. *) +(* (At c=0 this is CW_HALFLINE = 1/2.) The exact weight mass to the right of *) +(* c. *) +let CW_TAIL_FROM_C = prove + (`!c. &0 <= c ==> (cw has_real_integral (&1 / (&2 * (&1 + c) pow 2))) {x | c + <= x}`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[REAL_HALFLINE_INTEGRAL] THEN ASM_SIMP_TAC[CW_TAIL_LIM_C] THEN + X_GEN_TAC `b:real` THEN + DISJ_CASES_TAC(REAL_ARITH `c <= b \/ b < c`) THENL + [MATCH_MP_TAC HAS_REAL_INTEGRAL_INTEGRABLE THEN + EXISTS_TAC `&1 / (&2 * (&1 + c) pow 2) - &1 / (&2 * (&1 + b) pow 2)` THEN + ASM_SIMP_TAC[CW_INTEGRAL_CB]; + SUBGOAL_THEN `real_interval[c,b] = {}` SUBST1_TAC THENL + [REWRITE_TAC[REAL_INTERVAL_EQ_EMPTY] THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[REAL_INTEGRABLE_ON_EMPTY]]]);; + +(* ------------------------------------------------------------------------- *) +(* Change-of-variables for the scaled weight (the tile-weight is *) +(* w_sigma(x) = 2^k cw(2^k(x - x_sigma)), an affine scaling of cw). Reduces *) +(* int_{[a,b]} cw(m x + e) / int_{{x>=beta}} to cw over the m-scaled domain. *) +(* ------------------------------------------------------------------------- *) + +(* Real affine change-of-variables over an ARBITRARY set (the library's *) +(* HAS_REAL_INTEGRAL_AFFINITY is interval-only; the vector *) +(* HAS_INTEGRAL_AFFINITY *) +(* is general-set, so lift through the has_real_integral def). Lets the *) +(* halfline *) +(* tail transform without an (absent) limit-composition lemma. *) +let HAS_REAL_INTEGRAL_AFFINITY_GEN = prove + (`!f:real->real i s m c. + (f has_real_integral i) s /\ ~(m = &0) + ==> ((\x. f(m * x + c)) has_real_integral (inv(abs(m)) * i)) + (IMAGE (\x. inv m * (x - c)) s)`, + REPEAT GEN_TAC THEN REWRITE_TAC[has_real_integral] THEN + DISCH_THEN(MP_TAC o SPEC `lift c` o MATCH_MP HAS_INTEGRAL_AFFINITY) THEN + REWRITE_TAC[DIMINDEX_1; REAL_POW_1] THEN + REWRITE_TAC[o_DEF; DROP_ADD; DROP_CMUL; LIFT_DROP; LIFT_CMUL] THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + REWRITE_TAC[GSYM IMAGE_o; o_DEF] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM; LIFT_CMUL; LIFT_SUB] THEN VECTOR_ARITH_TAC);; + +(* The affine map x |-> inv m (x - e) sends the halfline {x | c <= x} onto *) +(* {x | inv m (c - e) <= x} (m>0). *) +let IMAGE_AFFINE_HALFLINE_CW = prove + (`!m e c. &0 < m + ==> IMAGE (\x. inv m * (x - e)) {x | c <= x} = {x | inv m * (c - e) <= + x}`, + REPEAT STRIP_TAC THEN REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM] THEN + X_GEN_TAC `y:real` THEN EQ_TAC THENL + [DISCH_THEN(X_CHOOSE_THEN + `x:real` (CONJUNCTS_THEN2 SUBST1_TAC ASSUME_TAC)) THEN + ONCE_REWRITE_TAC[GSYM(MATCH_MP REAL_LE_LMUL_EQ (ASSUME `&0 < m`))] THEN + ASM_SIMP_TAC[REAL_FIELD `&0 < m ==> m * inv m * (z - e) = z - e`] THEN + ASM_REAL_ARITH_TAC; + DISCH_TAC THEN EXISTS_TAC `m * y + e:real` THEN CONJ_TAC THENL + [ASM_SIMP_TAC[REAL_FIELD `&0 < m ==> inv m * ((m * y + e) - e) = y`]; + SUBGOAL_THEN `m * (inv m * (c - e)) <= m * y` MP_TAC THENL + [ASM_SIMP_TAC[REAL_LE_LMUL_EQ]; + ASM_SIMP_TAC[REAL_FIELD `&0 < m ==> m * (inv m * (c - e)) = c - e`] + THEN + REAL_ARITH_TAC]]]);; + +(* The affine map x |-> inv m (x - e) sends [m a + e, m b + e] onto [a,b] *) +(* (m>0). *) +let CWTILE_TAIL_RIGHT = prove + (`!(s:int#int#int) beta. tile_xmid s <= beta + ==> (cw_tile s has_real_integral + (&1 / (&2 * (&1 + &2 zpow (tile_k s) * (beta - tile_xmid s)) pow 2))) + {x | beta <= x}`, + REPEAT STRIP_TAC THEN + ABBREV_TAC `m = &2 zpow (tile_k s)` THEN + SUBGOAL_THEN `&0 < m` ASSUME_TAC THENL + [EXPAND_TAC "m" THEN MATCH_MP_TAC REAL_ZPOW_LT THEN + REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPEC `m * (beta - tile_xmid s)` CW_TAIL_FROM_C) THEN + ANTS_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPECL [`m:real`; `--(m * tile_xmid s)`] o + MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_REAL_INTEGRAL_AFFINITY_GEN)) THEN + ASM_SIMP_TAC[REAL_LT_IMP_NZ; IMAGE_AFFINE_HALFLINE_CW] THEN + SUBGOAL_THEN + `inv m * (m * (beta - tile_xmid s) - --(m * tile_xmid s)) = beta` + SUBST1_TAC THENL + [ASM_SIMP_TAC[REAL_FIELD `&0 < m ==> inv m * (m * (beta - tile_xmid s) - + --(m * tile_xmid s)) = beta`]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `m:real` o MATCH_MP HAS_REAL_INTEGRAL_LMUL) THEN + SUBGOAL_THEN + `(\x. m * cw(m * x + --(m * tile_xmid s))) = cw_tile s` ASSUME_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; cw_tile] THEN GEN_TAC THEN ASM_REWRITE_TAC[] THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN REAL_ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `abs m = m` SUBST1_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_FIELD `&0 < m ==> m * inv m * x = x`]);; + +(* The tile weight is symmetric about its centre x_sigma (cw is even): *) +(* w_sigma(2 x_sigma - x) = w_sigma(x). *) +(* Gives the LEFT tail from the right one by the reflection x |-> 2 x_sigma *) +(* - x. *) +let CWTILE_REFLECT = prove + (`!(s:int#int#int) x. cw_tile s (&2 * tile_xmid s - x) = cw_tile s x`, + REPEAT GEN_TAC THEN REWRITE_TAC[cw_tile] THEN AP_TERM_TAC THEN + GEN_REWRITE_TAC (LAND_CONV) [GSYM CW_EVEN] THEN AP_TERM_TAC THEN + CONV_TAC REAL_RING);; + +(* The tile weight's LEFT TAIL, by reflecting CWTILE_TAIL_RIGHT about *) +(* x_sigma *) +(* (affinity x |-> 2 x_sigma - x = -1 * x + 2 x_sigma, *) +(* CWTILE_REFLECT-invariant): *) +(* int_{x <= alpha} w_sigma = 1 / (2 (1 + 2^k (x_sigma - alpha))^2) *) +(* (alpha<=x_s). *) +let CWTILE_TAIL_LEFT = prove + (`!(s:int#int#int) alpha. alpha <= tile_xmid s + ==> (cw_tile s has_real_integral + (&1 / (&2 * (&1 + &2 zpow (tile_k s) * (tile_xmid s - alpha)) pow + 2))) + {x | x <= alpha}`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`s:int#int#int`; + `&2 * tile_xmid s - alpha`] CWTILE_TAIL_RIGHT) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPECL [`-- &1:real`; `&2 * tile_xmid s`] o + MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_REAL_INTEGRAL_AFFINITY_GEN)) THEN + REWRITE_TAC[REAL_ARITH `~(-- &1 = &0)`; REAL_ABS_NEG; REAL_ABS_NUM; + REAL_INV_1; + REAL_MUL_LID] THEN + SUBGOAL_THEN + `IMAGE (\x. inv (-- &1) * (x - &2 * tile_xmid s)) {x | &2 * tile_xmid s - + alpha <= x} = + {x | x <= alpha}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM; REAL_INV_NEG; + REAL_INV_1] THEN + X_GEN_TAC `y:real` THEN EQ_TAC THENL + [DISCH_THEN(X_CHOOSE_THEN + `x:real` (CONJUNCTS_THEN2 SUBST1_TAC ASSUME_TAC)) THEN + ASM_REAL_ARITH_TAC; + DISCH_TAC THEN EXISTS_TAC `&2 * tile_xmid s - y:real` THEN + CONJ_TAC THEN ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN `(\x. cw_tile s (-- &1 * x + &2 * tile_xmid s)) = cw_tile s` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + GEN_REWRITE_TAC (RAND_CONV) [GSYM CWTILE_REFLECT] THEN AP_TERM_TAC THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `&2 * tile_xmid s - alpha - tile_xmid s = + tile_xmid s - alpha` SUBST1_TAC THENL + [REAL_ARITH_TAC; DISCH_THEN ACCEPT_TAC]);; + +(* The tile weight's mass OUTSIDE an interval (alpha,gamma) containing *) +(* x_sigma = *) +(* left tail + right tail (the two disjoint halflines {x<=alpha}, *) +(* {gamma<=x}). *) +(* int_{{x<=alpha} U {gamma<=x}} w_sigma *) +(* = 1/(2(1+2^k(x_s-alpha))^2) + 1/(2(1+2^k(gamma-x_s))^2). *) +(* The complete per-tile 286Gf ingredient (mass leaking past both edges of *) +(* I_tau). *) +let CWTILE_TAIL_COMPLEMENT = prove + (`!(s:int#int#int) alpha gamma. + alpha <= tile_xmid s /\ tile_xmid s <= gamma /\ alpha < gamma + ==> (cw_tile s has_real_integral + (&1 / (&2 * (&1 + &2 zpow (tile_k s) * (tile_xmid s - alpha)) pow 2) + + + &1 / (&2 * (&1 + &2 zpow (tile_k s) * (gamma - tile_xmid s)) pow + 2))) + ({x | x <= alpha} UNION {x | gamma <= x})`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_UNION THEN + ASM_SIMP_TAC[CWTILE_TAIL_LEFT; CWTILE_TAIL_RIGHT] THEN + MATCH_MP_TAC REAL_NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{}:real->bool` THEN + REWRITE_TAC[REAL_NEGLIGIBLE_EMPTY; SUBSET; IN_INTER; IN_ELIM_THM; + NOT_IN_EMPTY] THEN + X_GEN_TAC `x:real` THEN STRIP_TAC THEN ASM_REAL_ARITH_TAC);; + +(* w is even; the left half-line integral equals the right one (reflection), *) +(* and the two halves combine to the full-line NORMALIZATION int_R w = 1 *) +(* (Fremlin 286E-c-ii). *) +let IMAGE_NEG_LE0 = prove + (`IMAGE (--) {x:real | x <= &0} = {x | &0 <= x}`, + REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM] THEN GEN_TAC THEN EQ_TAC THENL + [STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + DISCH_TAC THEN EXISTS_TAC `--x:real` THEN REWRITE_TAC[REAL_NEG_NEG] THEN + ASM_REAL_ARITH_TAC]);; + +let CW_NEGHALF = prove + (`(cw has_real_integral (&1 / &2)) {x | x <= &0}`, + MP_TAC(ISPECL [`cw`; `&1 / &2`; + `{x:real | x <= &0}`] HAS_REAL_INTEGRAL_REFLECT_GEN) THEN + REWRITE_TAC[CW_EVEN; ETA_AX; IMAGE_NEG_LE0] THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[CW_HALFLINE]);; + +let CW_FULL = prove + (`(cw has_real_integral (&1)) (:real)`, + MP_TAC(ISPECL [`cw`; `&1 / &2`; `&1 / &2`; `{x:real | x <= &0}`; + `{x:real | &0 <= x}`] + HAS_REAL_INTEGRAL_UNION) THEN + REWRITE_TAC[CW_NEGHALF; CW_HALFLINE] THEN ANTS_TAC THENL + [SUBGOAL_THEN + `{x:real | x <= &0} INTER {x | &0 <= x} = {&0}` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM; IN_SING] THEN GEN_TAC THEN + REAL_ARITH_TAC; + REWRITE_TAC[REAL_NEGLIGIBLE_SING]]; ALL_TAC] THEN + SUBGOAL_THEN + `{x:real | x <= &0} UNION {x | &0 <= x} = (:real)` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_UNION; IN_ELIM_THM; IN_UNIV] THEN GEN_TAC THEN + REAL_ARITH_TAC; + CONV_TAC REAL_RAT_REDUCE_CONV]);; + +(* Whole-line real affine change of variables (the UNIV analog of the *) +(* library's *) +(* HAS_REAL_INTEGRAL_AFFINITY, which is stated only over an interval). *) +(* Reduces *) +(* to the vector HAS_INTEGRAL_AFFINITY on lifted data; the affine image of *) +(* the *) +(* whole line is the whole line (AFFINE_IMAGE_UNIV). *) +let HAS_REAL_INTEGRAL_AFFINITY_UNIV = prove + (`!(f:real->real) i m c. ~(m = &0) /\ (f has_real_integral i) (:real) + ==> ((\x. f(m * x + c)) has_real_integral (inv(abs m) * i)) (:real)`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o REWRITE_RULE[has_real_integral; IMAGE_LIFT_UNIV]) THEN + DISCH_THEN(fun th -> + MP_TAC(MATCH_MP (REWRITE_RULE[IMP_CONJ] HAS_INTEGRAL_AFFINITY) th)) THEN + DISCH_THEN(MP_TAC o SPECL [`m:real`; `lift c`]) THEN + ASM_REWRITE_TAC[DIMINDEX_1; REAL_POW_1] THEN + ASM_SIMP_TAC[AFFINE_IMAGE_UNIV] THEN + REWRITE_TAC[has_real_integral; IMAGE_LIFT_UNIV; LIFT_CMUL] THEN + SUBGOAL_THEN `(\x. (lift o f o drop) (m % x + lift c)) = + (lift o (\x. f (m * x + c)) o drop)` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; o_THM; DROP_ADD; DROP_CMUL; LIFT_DROP]; + ALL_TAC] THEN + REWRITE_TAC[]);; + +(* 286G(a), tile form: INT_R cw_tile s = 1 (the tile weight is a probability *) +(* density: change of variables y = 2^k(x - x_sigma) from CW_FULL). *) +let CW_TILE_FULL = prove + (`!s:int#int#int. (cw_tile s has_real_integral (&1)) (:real)`, + GEN_TAC THEN + SUBGOAL_THEN `&0 < &2 zpow (tile_k s)` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `abs(&2 zpow (tile_k s)) = &2 zpow (tile_k s)` ASSUME_TAC THENL + [ASM_REWRITE_TAC[REAL_ABS_REFL] THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE]; ALL_TAC] THEN + SUBGOAL_THEN + `cw_tile s = + (\x. &2 zpow (tile_k s) * + cw (&2 zpow (tile_k s) * x + --(&2 zpow (tile_k s) * tile_xmid s)))` + SUBST1_TAC THENL + [REWRITE_TAC[cw_tile; FUN_EQ_THM] THEN GEN_TAC THEN AP_TERM_TAC THEN + AP_TERM_TAC THEN + REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `&1 = &2 zpow (tile_k s) * inv(&2 zpow (tile_k s)) * &1` SUBST1_TAC THENL + [UNDISCH_TAC `&0 < &2 zpow (tile_k s)` THEN + CONV_TAC REAL_FIELD; ALL_TAC] THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_LMUL THEN + MP_TAC(ISPECL [`cw`; `&1`; `&2 zpow (tile_k s)`; + `--(&2 zpow (tile_k s) * tile_xmid s)`] + HAS_REAL_INTEGRAL_AFFINITY_UNIV) THEN + ASM_SIMP_TAC[CW_FULL; REAL_LT_IMP_NZ]);; + +(* Fremlin 286G(a): sum_{n>=m} w(n + 1/2) <= 1/(2(1+m)^2). We prove the *) +(* finite *) +(* partial-sum form (uniform in n), which is the reusable content; the *) +(* infinite *) +(* sum follows by real_summable when a downstream bound needs it. The *) +(* per-term *) +(* estimate w(k+1/2) <= F(k) - F(k+1) (F(k) = 1/(2(1+k)^2)) is purely *) +(* algebraic *) +(* -- it reduces to the polynomial 16(1+t)^2(2+t)^2 <= (3+2t)^4 -- and *) +(* telescopes. *) + +let CW_POLY_BND = prove + (`!t. &0 <= t ==> &16 * (&1 + t) pow 2 * (&2 + t) pow 2 <= (&3 + &2 * t) pow + 4`, + GEN_TAC THEN DISCH_TAC THEN + MP_TAC(REAL_RING + `(&3 + &2 * t) pow 4 = + &16 * (&1 + t) pow 2 * (&2 + t) pow 2 + (&8 * (&1 + t) * (&2 + t) + &1)`) + THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= e ==> x <= x + e`) THEN + MATCH_MP_TAC REAL_LE_ADD THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_ARITH `&8 * a * b = &8 * (a * b)`] THEN + MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [REAL_ARITH_TAC; MATCH_MP_TAC REAL_LE_MUL THEN ASM_REAL_ARITH_TAC]; + REAL_ARITH_TAC]);; + +let CW_TERM_BOUND = prove + (`!t. &0 <= t + ==> cw(t + &1 / &2) <= &1 / (&2 * (&1 + t) pow 2) - &1 / (&2 * (&1 + (t + + &1)) pow 2)`, + GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN + `&0 < &1 + t /\ &0 < &2 + t /\ &0 < &3 + &2 * t` STRIP_ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `cw(t + &1 / &2) = &8 / (&3 + &2 * t) pow 3` SUBST1_TAC THENL + [REWRITE_TAC[cw] THEN + SUBGOAL_THEN `abs(t + &1 / &2) = t + &1 / &2` SUBST1_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC(REAL_FIELD + `&0 < &3 + &2 * t ==> &1 / (&1 + (t + &1 / &2)) pow 3 = &8 / (&3 + &2 * + t) pow 3`) THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `&1 / (&2 * (&1 + t) pow 2) - &1 / (&2 * (&1 + (t + &1)) pow 2) = + (&3 + &2 * t) / (&2 * (&1 + t) pow 2 * (&2 + t) pow 2)` SUBST1_TAC THENL + [MATCH_MP_TAC(REAL_FIELD + `&0 < &1 + t /\ &0 < &2 + t + ==> &1 / (&2 * (&1 + t) pow 2) - &1 / (&2 * (&1 + (t + &1)) pow 2) = + (&3 + &2 * t) / (&2 * (&1 + t) pow 2 * (&2 + t) pow 2)`) THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `&0 < (&3 + &2 * t) pow 3 /\ &0 < &2 * (&1 + t) pow 2 * (&2 + t) pow 2` + STRIP_ASSUME_TAC THENL + [CONJ_TAC THEN REPEAT(MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC) THEN + TRY(MATCH_MP_TAC REAL_POW_LT) THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LE_DIV2_EQ; REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ] THEN + SUBGOAL_THEN + `(&3 + &2 * t) / (&2 * (&1 + t) pow 2 * (&2 + t) pow 2) * (&3 + &2 * t) pow + 3 = + (&3 + &2 * t) pow 4 / (&2 * (&1 + t) pow 2 * (&2 + t) pow 2)` SUBST1_TAC + THENL + [CONV_TAC REAL_FIELD; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP CW_POLY_BND) THEN REAL_ARITH_TAC);; + +(* Geometric-series atoms for the 286L outer summation (alpha0/alpha1 sum *) +(* over *) +(* scales k). The dyadic tail sum_{k>=L} 2^{-k} = 2*2^{-L} drives the *) +(* convergence *) +(* after CARLESON_ALPHA_SCALE gives C1 2^{-k} energy mass per scale. *) + +(* Closed form for the finite dyadic GP: sum_{n=0}^m (1/2)^n = 2 - (1/2)^m. *) +let GP_HALF_CLOSED = prove + (`!m. sum (0..m) (\n. inv(&2) pow n) = &2 - inv(&2) pow m`, + GEN_TAC THEN REWRITE_TAC[SUM_GP] THEN + COND_CASES_TAC THENL [POP_ASSUM MP_TAC THEN ARITH_TAC; ALL_TAC] THEN + COND_CASES_TAC THENL [POP_ASSUM MP_TAC THEN + CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN + REWRITE_TAC[real_pow; REAL_POW_ADD] THEN CONV_TAC REAL_FIELD);; + +(* Any finite set of natural exponents: sum of (1/2)^n <= 2 (bounded by *) +(* 0..max GP). *) +let SUM_HALF_POW_LE_2 = prove + (`!(N:num->bool). FINITE N ==> sum N (\n. inv(&2) pow n) <= &2`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\n:num. n`; `N:num->bool`] UPPER_BOUND_FINITE_SET) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `m:num`) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum (0..m) (\n. inv(&2) pow n)` THEN CONJ_TAC THENL + [MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN + ASM_SIMP_TAC[FINITE_NUMSEG; SUBSET; IN_NUMSEG; LE_0] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_POW_LE THEN REAL_ARITH_TAC; + REWRITE_TAC[GP_HALF_CLOSED] THEN + MP_TAC(ISPECL [`inv(&2)`; `m:num`] REAL_POW_LE) THEN REAL_ARITH_TAC]);; + +(* Scaled half-power GP: sum over any finite K of naturals of c(1/2)^k <= 2c *) +(* (c>=0). = SUM_HALF_POW_LE_2 scaled by c. In 286J part (d) this sums the *) +(* per-scale bounds gamma sum_{R_k} muI_tau <= 2^{11-k} muE = (2^11 *) +(* muE)(1/2)^k *) +(* over k to gamma sum_{R} muI_tau <= 2*(2^11 muE) = 2^12 muE = C5 muE. *) +let SUM_HALF_POW_SCALED_LE = prove + (`!(K:num->bool) c. FINITE K /\ &0 <= c + ==> sum K (\k. c * inv(&2) pow k) <= &2 * c`, + REPEAT STRIP_TAC THEN REWRITE_TAC[SUM_LMUL] THEN + ONCE_REWRITE_TAC[REAL_ARITH `&2 * c = c * &2`] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[SUM_HALF_POW_LE_2]);; + +(* 286J part(b) geometric bound: sum_{k=0} 2^{-k-4} = 2^{-3}). Each annulus threshold in the R_k *) +(* dichotomy is *) +(* 2^{-k-4} gam, and if all annulus terms are below threshold their sum is *) +(* REWRITE_TAC[th]) THENL + [GEN_TAC THEN + SUBGOAL_THEN `--(&k) - &4 = (--(&k)) + (-- &4):int` SUBST1_TAC THENL + [INT_ARITH_TAC; ALL_TAC] THEN + SIMP_TAC[REAL_ZPOW_ADD; REAL_OF_NUM_EQ; ARITH_EQ] THEN + REWRITE_TAC[REAL_ZPOW_NEG; REAL_ZPOW_NUM; GSYM REAL_POW_INV] THEN + CONV_TAC REAL_FIELD; ALL_TAC] THEN + REWRITE_TAC[SUM_LMUL] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(&1 / &16) * &2` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [REAL_ARITH_TAC; + MP_TAC(SPEC `{k:num | k < K}` SUM_HALF_POW_LE_2) THEN + REWRITE_TAC[FINITE_NUMSEG_LT]]; + REAL_ARITH_TAC]);; + +(* 286J part(b): cw(2^{k-1}) <= 2^{-3k+3} (Fremlin's *) +(* w(2^{k-1})=(1+2^{k-1})^{-3} *) +(* <= 2^{-3(k-1)}). 1/(1+x)^3 <= 1/x^3 (x=2^{k-1}>0, REAL_LE_INV2+POW_LE2) *) +(* then *) +(* 1/(2^{k-1})^3 = 2^{-3k+3} (REAL_ZPOW_ZPOW). Feeds the annulus threshold *) +(* arithmetic cw(2^{k-1}) 2^{2k-7} <= 2^{-k-4} in the R_k dichotomy. *) +let CW_IDIL_EDGE_POW_BOUND = prove + (`!k:num. cw (&2 zpow (&k - &1)) <= &2 zpow (--(&3) * &k + &3)`, + GEN_TAC THEN REWRITE_TAC[cw] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&1 / (&2 zpow (&k - &1)) pow 3` THEN CONJ_TAC THENL + [SUBGOAL_THEN `&0 < &2 zpow (&k - &1)` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[real_div; REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LE_INV2 THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_POW_LT THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_POW_LE2 THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]; + SUBGOAL_THEN + `abs(&2 zpow (&k - &1)) = &2 zpow (&k - &1)` SUBST1_TAC THENL + [ASM_REAL_ARITH_TAC; REAL_ARITH_TAC]]]; + MATCH_MP_TAC REAL_EQ_IMP_LE THEN + REWRITE_TAC[GSYM REAL_ZPOW_POW; REAL_ZPOW_ZPOW] THEN + REWRITE_TAC[real_div; REAL_MUL_LID; GSYM REAL_ZPOW_NEG] THEN + AP_TERM_TAC THEN INT_ARITH_TAC]);; + +(* 286J part(b): the annulus term is below its threshold when R_{k+1} would *) +(* fail. *) +(* If M = muJ_tau mu(S cap I^(k+1)) <= 2^{2k-7}gam, then cw(2^{k-1}) M <= *) +(* 2^{-3k+3} 2^{2k-7} gam = 2^{-k-4} gam. REAL_LE_MUL2 (cw>=0, *) +(* cw<=2^{-3k+3}) + *) +(* zpow exponent collapse. *) +let CWTILE_ANNULUS_TERM_BOUND = prove + (`!k M gam. &0 <= M /\ &0 <= gam /\ M <= &2 zpow (&2 * &k - &7) * gam + ==> cw (&2 zpow (&k - &1)) * M <= &2 zpow (--(&k) - &4) * gam`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&2 zpow (--(&3) * &k + &3) * (&2 zpow (&2 * &k - &7) * gam)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL2 THEN + ASM_REWRITE_TAC[CW_IDIL_EDGE_POW_BOUND] THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN REWRITE_TAC[CW_POS]; + REWRITE_TAC[REAL_MUL_ASSOC] THEN + SUBGOAL_THEN `&2 zpow (--(&3) * &k + &3) * &2 zpow (&2 * &k - &7) = + &2 zpow (--(&k) - &4)` SUBST1_TAC THENL + [SIMP_TAC[GSYM REAL_ZPOW_ADD; REAL_OF_NUM_EQ; ARITH_EQ] THEN + AP_TERM_TAC THEN INT_ARITH_TAC; + REWRITE_TAC[REAL_LE_REFL]]]);; + +(* Pointwise reindex: for integers L <= k, inv(2^k) = inv(2^L) (1/2)^(k-L). *) +let INV_ZPOW_REINDEX = prove + (`!L k:int. L <= k + ==> inv(&2 zpow k) = inv(&2 zpow L) * inv(&2) pow (num_of_int(k - L))`, + REPEAT STRIP_TAC THEN + ABBREV_TAC `n = num_of_int(k - L)` THEN + SUBGOAL_THEN `k:int = L + &n` SUBST1_TAC THENL + [EXPAND_TAC "n" THEN + MP_TAC(ISPEC `k - L:int` INT_OF_NUM_OF_INT) THEN + ANTS_TAC THENL [ASM_INT_ARITH_TAC; ALL_TAC] THEN INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `~(&2 = &0)` ASSUME_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_ZPOW_ADD; REAL_ZPOW_NUM; REAL_INV_MUL; + GSYM REAL_INV_POW]);; + +(* THE dyadic geometric tail: a finite set SK of integer scales all >= L has *) +(* sum_{k in SK} inv(2^k) <= 2 inv(2^L). (Reindex each term via *) +(* INV_ZPOW_REINDEX, *) +(* factor inv(2^L), then the residual sum of distinct (1/2)^(k-L) <= 2 via *) +(* SUM_HALF_POW_LE_2 after SUM_IMAGE with num_of_int(.-L) injective on SK.) *) +let SUM_INV_ZPOW_GE_LE = prove + (`!(SK:int->bool) L. FINITE SK /\ (!k. k IN SK ==> L <= k) + ==> sum SK (\k. inv(&2 zpow k)) <= &2 * inv(&2 zpow L)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `sum SK (\k. inv(&2 zpow k)) = + inv(&2 zpow L) * sum SK (\k. inv(&2) pow (num_of_int(k - L)))` + SUBST1_TAC THENL + [REWRITE_TAC[GSYM SUM_LMUL] THEN MATCH_MP_TAC SUM_EQ THEN + X_GEN_TAC `k:int` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + MATCH_MP_TAC INV_ZPOW_REINDEX THEN ASM_SIMP_TAC[]; + ALL_TAC] THEN + GEN_REWRITE_TAC (RAND_CONV) [REAL_MUL_SYM] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_LE_INV_EQ] THEN MATCH_MP_TAC REAL_ZPOW_LE THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `sum SK (\k. inv(&2) pow (num_of_int(k - L))) = + sum (IMAGE (\k:int. num_of_int(k - L)) SK) (\n. inv(&2) pow n)` + SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN + MP_TAC(ISPECL [`\k:int. num_of_int(k - L)`; `\n:num. inv(&2) pow n`; + `SK:int->bool`] + SUM_IMAGE) THEN + ANTS_TAC THENL + [REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`a:int`; `b:int`] THEN + STRIP_TAC THEN + SUBGOAL_THEN `L <= a:int /\ L <= b:int` STRIP_ASSUME_TAC THENL + [ASM_SIMP_TAC[]; ALL_TAC] THEN + MP_TAC(ISPEC `a - L:int` INT_OF_NUM_OF_INT) THEN + ANTS_TAC THENL [ASM_INT_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPEC `b - L:int` INT_OF_NUM_OF_INT) THEN + ANTS_TAC THENL [ASM_INT_ARITH_TAC; ALL_TAC] THEN + REPEAT DISCH_TAC THEN + SUBGOAL_THEN `a - L:int = b - L` MP_TAC THENL + [FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [SYM th]) THEN + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN + ASM_REWRITE_TAC[]; + INT_ARITH_TAC]; + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[o_DEF]]; + MATCH_MP_TAC SUM_HALF_POW_LE_2 THEN MATCH_MP_TAC FINITE_IMAGE THEN + ASM_REWRITE_TAC[]]);; + +(* Scaled dyadic geometric tail: sum over a finite set of scales k >= L of *) +(* c/2^k <= 2c/2^L (c >= 0). = SUM_INV_ZPOW_GE_LE scaled by c. In 286K's H_j *) +(* estimate, c = C3^2 gam^2 C4 and L = k_(tau_j), giving H_j <= 2 C3^2 C4 *) +(* gam^2 *) +(* 2^(-k_tau_j) = 2 C3^2 C4 gam^2 muI_(tau_j). *) +let SUM_INV_ZPOW_GE_SCALED = prove + (`!(SK:int->bool) L c. FINITE SK /\ &0 <= c /\ (!k. k IN SK ==> L <= k) + ==> sum SK (\k. c * inv(&2 zpow k)) <= &2 * c * inv(&2 zpow L)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[SUM_LMUL] THEN + ONCE_REWRITE_TAC[REAL_ARITH `&2 * c * x = c * (&2 * x)`] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC SUM_INV_ZPOW_GE_LE THEN ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Two-sided dyadic geometric sum (286M part b tail): the level-sum *) +(* sum_{n in NN} min(2^{k-n}, 2^{n-k}) that appears when 286M sums *) +(* CARLESON_286L *) +(* over the iterated stopping-time decomposition. Fremlin bounds the ZZ-sum *) +(* by *) +(* 3; we bound the NN-sum by 4 (2 per half), which suffices for a valid C8. *) +(* ------------------------------------------------------------------------- *) + +(* One-sided halves: reindex the exponent to a plain (1/2)^j GP <= 2. *) +let MINGEOM_UPPER = prove + (`!(N:num->bool) k. FINITE N + ==> sum {n | n IN N /\ k < n} (\n. inv(&2) pow (n - k)) <= &2`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\n:num. n - (k:num)`; + `\j:num. inv(&2) pow j`] SUM_IMAGE) THEN + DISCH_THEN(MP_TAC o SPEC `{n:num | n IN N /\ k < n}`) THEN + ANTS_TAC THENL + [SIMP_TAC[IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN + ASM_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[o_DEF] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC SUM_HALF_POW_LE_2 THEN MATCH_MP_TAC FINITE_IMAGE THEN + MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `N:num->bool` THEN + ASM_REWRITE_TAC[] THEN SET_TAC[]);; + +let MINGEOM_LOWER = prove + (`!(N:num->bool) k. FINITE N + ==> sum {n | n IN N /\ n <= k} (\n. inv(&2) pow (k - n)) <= &2`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\n:num. (k:num) - n`; + `\j:num. inv(&2) pow j`] SUM_IMAGE) THEN + DISCH_THEN(MP_TAC o SPEC `{n:num | n IN N /\ n <= k}`) THEN + ANTS_TAC THENL + [SIMP_TAC[IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN + ASM_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[o_DEF] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC SUM_HALF_POW_LE_2 THEN MATCH_MP_TAC FINITE_IMAGE THEN + MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `N:num->bool` THEN + ASM_REWRITE_TAC[] THEN SET_TAC[]);; + +(* Per-term power identities collapsing the min-branches to (1/2)^|k-n|. *) +let MINGEOM_POW_LO = prove + (`!k n:num. n <= k ==> inv(&2 pow k) * &2 pow n = inv(&2) pow (k - n)`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[REAL_POW_SUB; REAL_ARITH `~(inv(&2) = &0)`] THEN + REWRITE_TAC[REAL_INV_POW; real_div] THEN + REWRITE_TAC[REAL_INV_INV] THEN CONV_TAC REAL_RING);; + +let MINGEOM_POW_HI = prove + (`!k n:num. k < n ==> &2 pow k * inv(&2) pow n = inv(&2) pow (n - k)`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[REAL_POW_SUB; REAL_ARITH `~(inv(&2) = &0)`; LT_IMP_LE] THEN + REWRITE_TAC[REAL_INV_POW; real_div] THEN + REWRITE_TAC[REAL_INV_INV] THEN CONV_TAC REAL_RING);; + +(* The two-sided min-geometric sum <= 4 over any finite set of level *) +(* indices. *) +let TWO_SIDED_MIN_GEOM = prove + (`!(N:num->bool) k. FINITE N + ==> sum N (\n. min (&2 pow k * inv(&2) pow n) (inv(&2 pow k) * &2 pow n)) + <= &4`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `sum N (\n. if n <= k then inv(&2) pow (k - n) else inv(&2) pow (n - k))` + THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `n:num` THEN + DISCH_TAC THEN COND_CASES_TAC THENL + [ASM_SIMP_TAC[GSYM MINGEOM_POW_LO] THEN REAL_ARITH_TAC; + FIRST_X_ASSUM(MP_TAC o REWRITE_RULE[NOT_LE]) THEN DISCH_TAC THEN + ASM_SIMP_TAC[GSYM MINGEOM_POW_HI] THEN REAL_ARITH_TAC]; + ASM_SIMP_TAC[SUM_CASES] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&2 + &2` THEN + CONJ_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN + MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THENL + [ASM_SIMP_TAC[MINGEOM_LOWER]; + SUBGOAL_THEN `{n | n IN N /\ ~(n <= k)} = {n:num | n IN N /\ k < n}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN GEN_TAC THEN + MATCH_MP_TAC(TAUT `(b <=> c) ==> (a /\ b <=> a /\ c)`) THEN ARITH_TAC; + ASM_SIMP_TAC[MINGEOM_UPPER]]]]);; + +(* 286M part (b), per-level arithmetic bridge. At stopping-time level n the *) +(* CARLESON_286M_LEVEL RHS is C7 energy(P_n) mass(P_n) sum_{R_n} muI; with *) +(* the *) +(* invariants energy(P_n) <= gam_n, mass(P_n) <= min(1, gam_n^2) and the *) +(* budget *) +(* gam_n^2 sum_{R_n} muI <= B (=C5+C6), this collapses to C7 B *) +(* min(1/gam_n,gam_n). *) +(* At gam_n = 2^{k-n} that is C7 B min(2^{n-k},2^{k-n}), summable by *) +(* TWO_SIDED_MIN_ *) +(* GEOM. Abstract core (e=energy, m=mass, S=sum muI): e m S <= B min(inv *) +(* gam,gam). *) +(* Cases on inv gam <= gam (gam>=1, use m<=1) vs gam e * m * S <= B * min (inv gam) gam`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&0 < gam pow 2` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_POW_LT THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `(S:real) <= B * inv(gam pow 2)` ASSUME_TAC THENL + [REWRITE_TAC[real_div] THEN ONCE_REWRITE_TAC[GSYM real_div] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `&0 <= B` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `gam pow 2 * (S:real)` THEN + ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_IMP_LE]; ALL_TAC] THEN + SUBGOAL_THEN `&0 <= inv(gam pow 2)` ASSUME_TAC THENL + [ASM_SIMP_TAC[REAL_LE_INV_EQ; REAL_LT_IMP_LE]; ALL_TAC] THEN + REWRITE_TAC[real_min] THEN COND_CASES_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `gam * (&1 * ((B:real) * inv(gam pow 2)))` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL2 THEN REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REWRITE_TAC[]]; + MATCH_MP_TAC REAL_EQ_IMP_LE THEN + SUBGOAL_THEN `~(gam = &0)` MP_TAC THENL + [ASM_REAL_ARITH_TAC; REWRITE_TAC[REAL_POW_2] THEN CONV_TAC REAL_FIELD]]; + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `gam * ((gam pow 2) * ((B:real) * inv(gam pow 2)))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL2 THEN REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REWRITE_TAC[]]; + MATCH_MP_TAC REAL_EQ_IMP_LE THEN + SUBGOAL_THEN `~(gam = &0)` MP_TAC THENL + [ASM_REAL_ARITH_TAC; REWRITE_TAC[REAL_POW_2] THEN + CONV_TAC REAL_FIELD]]]);; + +(* Abstract OUTER-SUMMATION engine for alpha0/alpha1: group a finite sum by *) +(* the *) +(* scale sc a, and if every scale-fiber sums to <= C 2^{-k} and all scales *) +(* are *) +(* >= L, then the whole sum is <= 2 C 2^{-L}. Composes SUM_GROUP (regroup by *) +(* scale) with SUM_INV_ZPOW_GE_LE (the dyadic geometric tail). In 286L this *) +(* consumes CARLESON_ALPHA_SCALE as the per-scale-fiber bound (C = C1 energy *) +(* mass, *) +(* L = l_K within a cover cell, or k_tau across cells), decoupling the *) +(* geometric *) +(* series from the tile geometry. *) +let ABSTRACT_SCALE_GEOM_SUM = prove + (`!(A:B->bool) (sc:B->int) (g:B->real) L C. + FINITE A /\ &0 <= C /\ + (!a. a IN A ==> L <= sc a) /\ + (!k. sum {a | a IN A /\ sc a = k} g <= C * inv(&2 zpow k)) + ==> sum A g <= &2 * C * inv(&2 zpow L)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`sc:B->int`; `g:B->real`; `A:B->bool`; `IMAGE (sc:B->int) A`] + SUM_GROUP) THEN + ASM_REWRITE_TAC[SUBSET_REFL] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum (IMAGE (sc:B->int) A) (\y. C * inv(&2 zpow y))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE THEN ASM_SIMP_TAC[FINITE_IMAGE]; + REWRITE_TAC[SUM_LMUL] THEN + SUBGOAL_THEN + `&2 * C * inv(&2 zpow L) = C * (&2 * inv(&2 zpow L))` SUBST1_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC SUM_INV_ZPOW_GE_LE THEN + ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE]]);; + +(* --- CUBIC (ratio 1/8) geometric machinery for alpha1's k-sum --- *) +(* alpha1's per-scale-slice bound is <= C inv(2^{2a}) inv(2^{3k}) (the TIGHT *) +(* decay); *) +(* the inner sum over scales k >= k_tau is a CUBIC geometric series (ratio *) +(* 1/8, not *) +(* 1/2 as in alpha0). inv(2^{3k}) = inv(8^k) (ZPOW_2_3), so these are the *) +(* base-8 *) +(* analogues of INV_ZPOW_REINDEX / SUM_INV_ZPOW_GE_LE / *) +(* ABSTRACT_SCALE_GEOM_SUM. *) + +(* Generic finite geometric bound: sum of r^n over any finite exponent set *) +(* <= 1/(1-r) for 0 <= r < 1 (bounded by the 0..max closed form SUM_GP). *) +let SUM_POW_LE_GEN = prove + (`!(N:num->bool) r. FINITE N /\ &0 <= r /\ r < &1 + ==> sum N (\n. r pow n) <= inv(&1 - r)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\n:num. n`; `N:num->bool`] UPPER_BOUND_FINITE_SET) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `m:num`) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sum (0..m) (\n. r pow n)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN + ASM_SIMP_TAC[FINITE_NUMSEG; SUBSET; IN_NUMSEG; LE_0] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_POW_LE THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[SUM_GP] THEN + COND_CASES_TAC THENL [POP_ASSUM MP_TAC THEN ARITH_TAC; ALL_TAC] THEN + COND_CASES_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `&0 < &1 - r` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ] THEN + SUBGOAL_THEN `inv(&1 - r) * (&1 - r) = &1` SUBST1_TAC THENL + [MATCH_MP_TAC REAL_MUL_LINV THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= b ==> r pow 0 - b <= &1`) THEN + REWRITE_TAC[real_pow] THEN + ONCE_REWRITE_TAC[GSYM real_pow] THEN MATCH_MP_TAC REAL_POW_LE THEN + ASM_REWRITE_TAC[]]);; + +let ZPOW_2_3 = prove + (`!k:int. &2 zpow (&3 * k) = &8 zpow k`, + GEN_TAC THEN + SUBGOAL_THEN `(&8:real) = &2 zpow (&3)` SUBST1_TAC THENL + [REWRITE_TAC[REAL_ZPOW_POW] THEN + CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN + REWRITE_TAC[REAL_ZPOW_ZPOW]);; + +let INV_ZPOW8_REINDEX = prove + (`!L k:int. L <= k + ==> inv(&8 zpow k) = inv(&8 zpow L) * inv(&8) pow (num_of_int(k - L))`, + REPEAT STRIP_TAC THEN + ABBREV_TAC `n = num_of_int(k - L)` THEN + SUBGOAL_THEN `k:int = L + &n` SUBST1_TAC THENL + [EXPAND_TAC "n" THEN + MP_TAC(ISPEC `k - L:int` INT_OF_NUM_OF_INT) THEN + ANTS_TAC THENL [ASM_INT_ARITH_TAC; ALL_TAC] THEN INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `~(&8 = &0)` ASSUME_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_ZPOW_ADD; REAL_ZPOW_NUM; REAL_INV_MUL; + GSYM REAL_INV_POW]);; + +(* The cubic dyadic tail: a finite set SK of scales all >= L has sum *) +(* inv(8^k) <= *) +(* (8/7) inv(8^L). (Reindex via INV_ZPOW8_REINDEX, factor inv(8^L), residual *) +(* sum of *) +(* distinct (1/8)^{k-L} <= 8/7 = inv(1 - 1/8) via SUM_POW_LE_GEN after *) +(* SUM_IMAGE.) *) +let SUM_INV_ZPOW8_GE_LE = prove + (`!(SK:int->bool) L. FINITE SK /\ (!k. k IN SK ==> L <= k) + ==> sum SK (\k. inv(&8 zpow k)) <= (&8 / &7) * inv(&8 zpow L)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `sum SK (\k. inv(&8 zpow k)) = + inv(&8 zpow L) * sum SK (\k. inv(&8) pow (num_of_int(k - L)))` + SUBST1_TAC THENL + [REWRITE_TAC[GSYM SUM_LMUL] THEN MATCH_MP_TAC SUM_EQ THEN + X_GEN_TAC `k:int` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + MATCH_MP_TAC INV_ZPOW8_REINDEX THEN ASM_SIMP_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `(&8 / &7) * inv(&8 zpow L) = inv(&8 zpow L) * (&8 / &7)` SUBST1_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_LE_INV_EQ] THEN MATCH_MP_TAC REAL_ZPOW_LE THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `sum SK (\k. inv(&8) pow (num_of_int(k - L))) = + sum (IMAGE (\k:int. num_of_int(k - L)) SK) (\n. inv(&8) pow n)` + SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN + MP_TAC(ISPECL [`\k:int. num_of_int(k - L)`; `\n:num. inv(&8) pow n`; + `SK:int->bool`] + SUM_IMAGE) THEN + ANTS_TAC THENL + [REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`a:int`; `b:int`] THEN + STRIP_TAC THEN + SUBGOAL_THEN `L <= a:int /\ L <= b:int` STRIP_ASSUME_TAC THENL + [ASM_SIMP_TAC[]; ALL_TAC] THEN + MP_TAC(ISPEC `a - L:int` INT_OF_NUM_OF_INT) THEN + ANTS_TAC THENL [ASM_INT_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPEC `b - L:int` INT_OF_NUM_OF_INT) THEN + ANTS_TAC THENL [ASM_INT_ARITH_TAC; ALL_TAC] THEN + REPEAT DISCH_TAC THEN + SUBGOAL_THEN `a - L:int = b - L` MP_TAC THENL + [FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [SYM th]) THEN + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN + ASM_REWRITE_TAC[]; + INT_ARITH_TAC]; + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[o_DEF]]; + ALL_TAC] THEN + SUBGOAL_THEN `&8 / &7 = inv(&1 - inv(&8))` SUBST1_TAC THENL + [CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN + MATCH_MP_TAC SUM_POW_LE_GEN THEN + SIMP_TAC[FINITE_IMAGE; ASSUME `FINITE(SK:int->bool)`] THEN + CONV_TAC REAL_RAT_REDUCE_CONV);; + +(* Abstract cubic outer-summation engine (base-8 analogue of *) +(* ABSTRACT_SCALE_GEOM_SUM): per-scale slices <= C inv(8^k) for scales >= L *) +(* give total <= (8/7) C inv(8^L). *) +let ABSTRACT_SCALE_GEOM_SUM8 = prove + (`!(A:B->bool) (sc:B->int) (g:B->real) L C. + FINITE A /\ &0 <= C /\ + (!a. a IN A ==> L <= sc a) /\ + (!k. sum {a | a IN A /\ sc a = k} g <= C * inv(&8 zpow k)) + ==> sum A g <= (&8 / &7) * C * inv(&8 zpow L)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`sc:B->int`; `g:B->real`; `A:B->bool`; `IMAGE (sc:B->int) A`] + SUM_GROUP) THEN + ASM_REWRITE_TAC[SUBSET_REFL] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum (IMAGE (sc:B->int) A) (\y. C * inv(&8 zpow y))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE THEN ASM_SIMP_TAC[FINITE_IMAGE]; + REWRITE_TAC[SUM_LMUL] THEN + SUBGOAL_THEN + `(&8 / &7) * C * inv(&8 zpow L) = C * ((&8 / &7) * inv(&8 zpow L))` + SUBST1_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC SUM_INV_ZPOW8_GE_LE THEN + ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE]]);; + +(* --- QUADRATIC (ratio 1/4) geometric machinery for alpha1's coarse-LEVEL *) +(* sum --- *) +(* The alpha1 OUTER sum over cover levels a carries the inv(2^{2a}) = *) +(* inv(4^a) weight; *) +(* summed over levels a >= L (with a bounded count per level) it is a *) +(* QUADRATIC geometric *) +(* series (ratio 1/4, constant 4/3). Base-4 analogues of the base-8 lemmas *) +(* above. *) +let ZPOW_2_2 = prove + (`!k:int. &2 zpow (&2 * k) = &4 zpow k`, + GEN_TAC THEN + SUBGOAL_THEN `(&4:real) = &2 zpow (&2)` SUBST1_TAC THENL + [REWRITE_TAC[REAL_ZPOW_POW] THEN + CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN + REWRITE_TAC[REAL_ZPOW_ZPOW]);; + +let INV_ZPOW4_REINDEX = prove + (`!L k:int. L <= k + ==> inv(&4 zpow k) = inv(&4 zpow L) * inv(&4) pow (num_of_int(k - L))`, + REPEAT STRIP_TAC THEN + ABBREV_TAC `n = num_of_int(k - L)` THEN + SUBGOAL_THEN `k:int = L + &n` SUBST1_TAC THENL + [EXPAND_TAC "n" THEN + MP_TAC(ISPEC `k - L:int` INT_OF_NUM_OF_INT) THEN + ANTS_TAC THENL [ASM_INT_ARITH_TAC; ALL_TAC] THEN INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `~(&4 = &0)` ASSUME_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_ZPOW_ADD; REAL_ZPOW_NUM; REAL_INV_MUL; + GSYM REAL_INV_POW]);; + +let SUM_INV_ZPOW4_GE_LE = prove + (`!(SK:int->bool) L. FINITE SK /\ (!k. k IN SK ==> L <= k) + ==> sum SK (\k. inv(&4 zpow k)) <= (&4 / &3) * inv(&4 zpow L)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `sum SK (\k. inv(&4 zpow k)) = + inv(&4 zpow L) * sum SK (\k. inv(&4) pow (num_of_int(k - L)))` + SUBST1_TAC THENL + [REWRITE_TAC[GSYM SUM_LMUL] THEN MATCH_MP_TAC SUM_EQ THEN + X_GEN_TAC `k:int` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + MATCH_MP_TAC INV_ZPOW4_REINDEX THEN ASM_SIMP_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `(&4 / &3) * inv(&4 zpow L) = inv(&4 zpow L) * (&4 / &3)` SUBST1_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_LE_INV_EQ] THEN MATCH_MP_TAC REAL_ZPOW_LE THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `sum SK (\k. inv(&4) pow (num_of_int(k - L))) = + sum (IMAGE (\k:int. num_of_int(k - L)) SK) (\n. inv(&4) pow n)` + SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN + MP_TAC(ISPECL [`\k:int. num_of_int(k - L)`; `\n:num. inv(&4) pow n`; + `SK:int->bool`] + SUM_IMAGE) THEN + ANTS_TAC THENL + [REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`a:int`; `b:int`] THEN + STRIP_TAC THEN + SUBGOAL_THEN `L <= a:int /\ L <= b:int` STRIP_ASSUME_TAC THENL + [ASM_SIMP_TAC[]; ALL_TAC] THEN + MP_TAC(ISPEC `a - L:int` INT_OF_NUM_OF_INT) THEN + ANTS_TAC THENL [ASM_INT_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPEC `b - L:int` INT_OF_NUM_OF_INT) THEN + ANTS_TAC THENL [ASM_INT_ARITH_TAC; ALL_TAC] THEN + REPEAT DISCH_TAC THEN + SUBGOAL_THEN `a - L:int = b - L` MP_TAC THENL + [FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [SYM th]) THEN + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN + ASM_REWRITE_TAC[]; + INT_ARITH_TAC]; + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[o_DEF]]; + ALL_TAC] THEN + SUBGOAL_THEN `&4 / &3 = inv(&1 - inv(&4))` SUBST1_TAC THENL + [CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN + MATCH_MP_TAC SUM_POW_LE_GEN THEN + SIMP_TAC[FINITE_IMAGE; ASSUME `FINITE(SK:int->bool)`] THEN + CONV_TAC REAL_RAT_REDUCE_CONV);; + +(* 286L(d) tight-decay: the tight per-scale factor inv((1+M)^2), M = *) +(* 2^{a+k}, is *) +(* <= inv(2^{2a}) inv(2^{2k}). (1+M > M > 0 so (1+M)^2 > M^2 = 2^{2a+2k} = *) +(* 2^{2a}2^{2k}; *) +(* REAL_LE_INV2.) This converts the tight per-scale bound into the CUBIC *) +(* form *) +(* C inv(2^{2a}) inv(8^k) whose k-sum (>= k_tau) converges (ratio 1/8) and *) +(* whose *) +(* inv(2^{2a}) constant feeds the coarse-level (ratio 1/4) outer sum. *) +let TIGHT_DECAY_BOUND = prove + (`!a k M:int. &2 zpow (a + k) = real_of_int M /\ &1 <= M + ==> inv((&1 + real_of_int M) pow 2) + <= inv(&2 zpow (&2 * a)) * inv(&2 zpow (&2 * k))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&1 <= real_of_int M` ASSUME_TAC THENL + [UNDISCH_TAC `&1 <= (M:int)` THEN + REWRITE_TAC[int_le; GSYM ROI_1]; ALL_TAC] THEN + SUBGOAL_THEN `inv(&2 zpow (&2 * a)) * inv(&2 zpow (&2 * k)) = + inv((real_of_int M) pow 2)` SUBST1_TAC THENL + [REWRITE_TAC[GSYM REAL_INV_MUL] THEN AP_TERM_TAC THEN + SIMP_TAC[GSYM REAL_ZPOW_ADD; REAL_ARITH `~(&2 = &0)`] THEN + SUBGOAL_THEN `&2 * a + &2 * k = &2 * (a + k):int` SUBST1_TAC THENL + [INT_ARITH_TAC; ALL_TAC] THEN + ONCE_REWRITE_TAC[INT_MUL_SYM] THEN REWRITE_TAC[GSYM REAL_ZPOW_ZPOW] THEN + ASM_REWRITE_TAC[REAL_ZPOW_POW] THEN CONV_TAC REAL_RAT_REDUCE_CONV; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_POW_LT THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_POW_LE2 THEN ASM_REAL_ARITH_TAC]);; + +(* alpha1 OUTER coarse-level geometric combinators. The per-cover-cell *) +(* alpha1 bound *) +(* carries the weight inv(4^{a_K}) (a_K = -l_K the cover level); summed over *) +(* the cover *) +(* with a per-level bound it telescopes via the QUADRATIC tail *) +(* SUM_INV_ZPOW4_GE_LE. *) + +(* Fiber form (flexible): if each level-fiber sum of g is <= N inv(4^m), *) +(* then the total *) +(* over S is <= N (4/3) inv(4^L). SUM_GROUP by lev, per-fiber bound, then *) +(* base-4 tail. *) +let LEVEL_FIBER_SUM_LE = prove + (`!(S:A->bool) (lev:A->int) (g:A->real) L N. + FINITE S /\ &0 <= N /\ + (!x. x IN S ==> L <= lev x) /\ + (!m. sum {x | x IN S /\ lev x = m} g <= N * inv(&4 zpow m)) + ==> sum S g <= N * (&4 / &3) * inv(&4 zpow L)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`lev:A->int`; `g:A->real`; `S:A->bool`; + `IMAGE (lev:A->int) S`] SUM_GROUP) THEN + ASM_REWRITE_TAC[SUBSET_REFL] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum (IMAGE (lev:A->int) S) (\m. N * inv(&4 zpow m))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE THEN ASM_SIMP_TAC[FINITE_IMAGE]; + REWRITE_TAC[SUM_LMUL] THEN + SUBGOAL_THEN + `N * (&4 / &3) * inv(&4 zpow L) = N * ((&4 / &3) * inv(&4 zpow L))` + SUBST1_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC SUM_INV_ZPOW4_GE_LE THEN + ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE]]);; + +(* Count form: if each level-fiber has <= N members, then sum inv(4^{lev x}) *) +(* over S is *) +(* <= N (4/3) inv(4^L). (Specialises LEVEL_FIBER_SUM_LE at g = inv(4^{lev *) +(* .}); each *) +(* fiber sum = &(CARD fiber) inv(4^m) <= N inv(4^m).) *) +let LEVEL_WEIGHTED_SUM_LE = prove + (`!(S:A->bool) (lev:A->int) L N. + FINITE S /\ &0 <= N /\ + (!x. x IN S ==> L <= lev x) /\ + (!m. &(CARD {x | x IN S /\ lev x = m}) <= N) + ==> sum S (\x. inv(&4 zpow (lev x))) <= N * (&4 / &3) * inv(&4 zpow L)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC LEVEL_FIBER_SUM_LE THEN + EXISTS_TAC `lev:A->int` THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `m:int` THEN + SUBGOAL_THEN + `sum {x:A | x IN S /\ lev x = m} (\x. inv(&4 zpow (lev x))) = + sum {x:A | x IN S /\ lev x = m} (\x. inv(&4 zpow m))` + SUBST1_TAC THENL + [MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `x:A` THEN REWRITE_TAC[IN_ELIM_THM] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_SIMP_TAC[SUM_CONST; FINITE_RESTRICT] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_LE_INV_EQ] THEN MATCH_MP_TAC REAL_ZPOW_LE THEN + REAL_ARITH_TAC]);; + +let CW_SUM_BOUND = prove + (`!m n. sum(m..n) (\k. cw(&k + &1 / &2)) <= &1 / (&2 * (&1 + &m) pow 2)`, + REPEAT GEN_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(m..n) (\k. &1 / (&2 * (&1 + &k) pow 2) - &1 / (&2 * (&1 + (&k + + &1)) pow 2))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE THEN REWRITE_TAC[FINITE_NUMSEG] THEN + X_GEN_TAC `k:num` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + MATCH_MP_TAC CW_TERM_BOUND THEN REWRITE_TAC[REAL_POS]; ALL_TAC] THEN + SUBGOAL_THEN + `sum(m..n) (\k. &1 / (&2 * (&1 + &k) pow 2) - &1 / (&2 * (&1 + (&k + &1)) + pow 2)) = + sum(m..n) (\k. (\j. &1 / (&2 * (&1 + &j) pow 2)) k - (\j. &1 / (&2 * (&1 + + &j) pow 2)) (k + 1))` + SUBST1_TAC THENL + [MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `k:num` THEN DISCH_TAC THEN + REWRITE_TAC[] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + AP_TERM_TAC THEN + REWRITE_TAC[] THEN REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[SUM_DIFFS] THEN COND_CASES_TAC THENL + [MATCH_MP_TAC(REAL_ARITH `&0 <= b ==> a - b <= a`) THEN + MATCH_MP_TAC REAL_LE_DIV THEN CONJ_TAC THENL + [REAL_ARITH_TAC; MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [REAL_ARITH_TAC; MATCH_MP_TAC REAL_POW_LE THEN REAL_ARITH_TAC]]; + MATCH_MP_TAC REAL_LE_DIV THEN CONJ_TAC THENL + [REAL_ARITH_TAC; MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [REAL_ARITH_TAC; MATCH_MP_TAC REAL_POW_LE THEN REAL_ARITH_TAC]]]);; + +(* The QUADRATIC-decay half-integer sum (distinct from CW_SUM_BOUND's cubic *) +(* one): *) +(* sum_{k=m..n} 1/(2(1+(k+1/2))^2) <= 1/(2(1+m)). *) +(* This is the convergent series behind Fremlin's C4 = 2 sum_j *) +(* int_{j+1/2}^inf w = *) +(* 2 sum_j 1/(2(1+(j+1/2))^2): each tile-tail value is *) +(* 1/(2(1+scaled-dist)^2) *) +(* (the CWTILE_TAIL family) and the scaled distances run over the *) +(* half-integer grid. *) +(* Telescopes via CW_QUAD_TERM_BOUND (term <= 1/(2(1+k)) - 1/(2(1+k+1))) + *) +(* SUM_DIFFS. *) +let CW_QUAD_TERM_BOUND = prove + (`!t. &0 <= t + ==> &1 / (&2 * (&1 + (t + &1 / &2)) pow 2) + <= &1 / (&2 * (&1 + t)) - &1 / (&2 * (&1 + (t + &1)))`, + GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN + `&0 < &1 + t /\ &0 < &2 + t /\ &0 < &3 + &2 * t` STRIP_ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `&1 / (&2 * (&1 + (t + &1 / &2)) pow 2) = &2 / (&3 + &2 * t) pow 2` + SUBST1_TAC THENL + [MATCH_MP_TAC(REAL_FIELD `&0 < &3 + &2 * t ==> + &1 / (&2 * (&1 + (t + &1 / &2)) pow 2) = &2 / (&3 + &2 * t) pow 2`) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `&1 / (&2 * (&1 + t)) - &1 / (&2 * (&1 + (t + &1))) = + &1 / (&2 * (&1 + t) * (&2 + t))` SUBST1_TAC THENL + [MATCH_MP_TAC(REAL_FIELD `&0 < &1 + t /\ &0 < &2 + t ==> + &1 / (&2 * (&1 + t)) - &1 / (&2 * (&1 + (t + &1))) = &1 / (&2 * (&1 + t) + * (&2 + t))`) THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `&0 < (&3 + &2 * t) pow 2 /\ &0 < &2 * (&1 + t) * (&2 + t)` + STRIP_ASSUME_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC REAL_POW_LT THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC THENL + [REAL_ARITH_TAC; MATCH_MP_TAC REAL_LT_MUL THEN ASM_REAL_ARITH_TAC]]; + ALL_TAC] THEN + SUBGOAL_THEN + `&2 * &2 * (&1 + t) * (&2 + t) <= (&3 + &2 * t) pow 2` ASSUME_TAC THENL + [MP_TAC(SPEC `t:real` (REAL_RING + `!t:real. (&3 + &2 * t) pow 2 - &2 * (&2 * (&1 + t) * (&2 + t)) = &1`)) + THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ] THEN + ASM_SIMP_TAC[REAL_FIELD `&0 < A ==> &2 / A * &2 * (&1 + t) * (&2 + t) = + (&2 * &2 * (&1 + t) * (&2 + t)) / A`] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_MUL_LID]);; + +let QUAD_HALF_SUM_BOUND = prove + (`!m n. sum(m..n) (\k. &1 / (&2 * (&1 + (&k + &1 / &2)) pow 2)) <= &1 / (&2 * + (&1 + &m))`, + REPEAT GEN_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(m..n) (\k. &1 / (&2 * (&1 + &k)) - &1 / (&2 * (&1 + (&k + + &1))))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE THEN REWRITE_TAC[FINITE_NUMSEG] THEN + X_GEN_TAC `k:num` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + MATCH_MP_TAC CW_QUAD_TERM_BOUND THEN REWRITE_TAC[REAL_POS]; ALL_TAC] THEN + SUBGOAL_THEN + `sum(m..n) (\k. &1 / (&2 * (&1 + &k)) - &1 / (&2 * (&1 + (&k + &1)))) = + sum(m..n) (\k. (\j. &1 / (&2 * (&1 + &j))) k - (\j. &1 / (&2 * (&1 + &j))) + (k + 1))` + SUBST1_TAC THENL + [MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `k:num` THEN DISCH_TAC THEN + REWRITE_TAC[] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + AP_TERM_TAC THEN + REWRITE_TAC[] THEN REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[SUM_DIFFS] THEN COND_CASES_TAC THENL + [MATCH_MP_TAC(REAL_ARITH `&0 <= b ==> a - b <= a`) THEN + MATCH_MP_TAC REAL_LE_DIV THEN CONJ_TAC THENL + [REAL_ARITH_TAC; MATCH_MP_TAC REAL_LE_MUL THEN REAL_ARITH_TAC]; + MATCH_MP_TAC REAL_LE_DIV THEN CONJ_TAC THENL + [REAL_ARITH_TAC; MATCH_MP_TAC REAL_LE_MUL THEN REAL_ARITH_TAC]]);; + +(* Fremlin's C4 = 2 sum_{j>=0} int_{j+1/2}^inf w <= 1: the doubled quadratic *) +(* tail *) +(* sum from 0 is <= 1 (QUAD_HALF_SUM_BOUND at m=0 gives sum <= 1/2). The *) +(* two-sided *) +(* per-tile tail (left + right, CWTILE_TAIL_COMPLEMENT) summed over the *) +(* same-scale *) +(* sub-tiles of I_tau reduces to this after re-indexing the mirror half. *) +let QUAD_HALF_SUM_DOUBLED = prove + (`!n. &2 * sum(0..n) (\k. &1 / (&2 * (&1 + (&k + &1 / &2)) pow 2)) <= &1`, + GEN_TAC THEN + MP_TAC(SPECL [`0`; `n:num`] QUAD_HALF_SUM_BOUND) THEN + REWRITE_TAC[REAL_ADD_RID; REAL_MUL_RID] THEN REAL_ARITH_TAC);; + +(* The TWO-SIDED tail sum <= 1: summing over j = 0..N the pair *) +(* [left tail 1/(2(1+(j+1/2))^2)] + [right tail 1/(2(1+((N-j)+1/2))^2)] *) +(* is <= 1. The right half re-indexes (SUM_REFLECT, j |-> N-j) to the left *) +(* half, so *) +(* the total is 2 * (one half) <= 1 (QUAD_HALF_SUM_DOUBLED). This is the *) +(* abstract *) +(* combinatorial core of 286Gf's sum over the same-scale sub-tiles of I_tau *) +(* of *) +(* int_{R\I_tau} w_sigma <= C4 (C4 = 1): each sub-tile's complement mass is *) +(* left+ *) +(* right tail (CWTILE_TAIL_COMPLEMENT), and the sub-tiles tile I_tau so the *) +(* scaled *) +(* edge-distances are exactly j+1/2 and (N-j)+1/2. *) +let TWO_SIDED_TAIL_SUM = prove + (`!N. sum(0..N) (\j. &1 / (&2 * (&1 + (&j + &1 / &2)) pow 2) + + &1 / (&2 * (&1 + (&(N - j) + &1 / &2)) pow 2)) <= &1`, + GEN_TAC THEN REWRITE_TAC[SUM_ADD_NUMSEG] THEN + SUBGOAL_THEN + `sum (0..N) (\j. &1 / (&2 * (&1 + &(N - j) + &1 / &2) pow 2)) = + sum (0..N) (\j. &1 / (&2 * (&1 + &j + &1 / &2) pow 2))` + SUBST1_TAC THENL + [MP_TAC(ISPECL [`\i. &1 / (&2 * (&1 + &i + &1 / &2) pow 2)`; `0`; + `N:num`] SUM_REFLECT) THEN + REWRITE_TAC[SUB_0; LT] THEN + DISCH_THEN(fun th -> GEN_REWRITE_TAC RAND_CONV [th]) THEN + REWRITE_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `&2 * s <= &1 ==> s + s <= &1`) THEN + REWRITE_TAC[QUAD_HALF_SUM_DOUBLED]);; + +(* 286Gf, per-sub-tile step: the weight-mass of a scale-k sub-tile of I_tau *) +(* OUTSIDE I_tau = (alpha, gamma) equals the tail pair (j, N-1-j) of half- *) +(* integer arguments. alpha = nIt * 2 zpow (--kt) (left edge of I_tau), *) +(* gamma *) +(* = (nIt + 1) * 2 zpow (--kt) (right edge); the sub-tile at offset j (index *) +(* &N * nIt + &j, N = 2 zpow (k - kt) sub-cells) has centre edge-distances *) +(* j + 1/2 and (N-1-j) + 1/2 (TILE_SUBCELL_EDGE_DIST), so *) +(* CWTILE_TAIL_COMPLEMENT *) +(* gives exactly the two quadratic tail terms. 1 <= N from 2 zpow (k-kt) = *) +(* &N *) +(* >= 1; the alpha < xmid < gamma hypotheses of CWTILE_TAIL_COMPLEMENT *) +(* follow *) +(* from the edge distances by cancelling the positive factor 2 zpow k. *) +let CWTILE_SUBTILE_COMPL_VALUE = prove + (`!k kt N nIt nJs j. + kt <= k /\ &2 zpow (k - kt) = &N /\ j <= N - 1 + ==> real_integral + ({x | x <= real_of_int nIt * &2 zpow (--kt)} UNION + {x | (real_of_int nIt + &1) * &2 zpow (--kt) <= x}) + (cw_tile (k, &N * nIt + &j, nJs)) = + &1 / (&2 * (&1 + (&j + &1 / &2)) pow 2) + + &1 / (&2 * (&1 + (&((N - 1) - j) + &1 / &2)) pow 2)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `1 <= N` ASSUME_TAC THENL + [MP_TAC(ISPECL [`&2:real`; `k - kt:int`] REAL_ZPOW_LT) THEN + REWRITE_TAC[REAL_ARITH `&0 < &2`] THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[REAL_OF_NUM_LT] THEN ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `&0 < &2 zpow k` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `(&N:real) - &j - &1 = &((N - 1) - j)` ASSUME_TAC THENL + [MP_TAC(SPECL [`j:num`; `N - 1`] REAL_OF_NUM_SUB) THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(SPECL [`1`; `N:num`] REAL_OF_NUM_SUB) THEN ASM_REWRITE_TAC[] THEN + REPEAT(DISCH_THEN(SUBST1_TAC o SYM)) THEN REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPECL [`k:int`;`kt:int`;`&N:int`;`nIt:int`;`&j:int`;`nJs:int`] + TILE_SUBCELL_EDGE_DIST) THEN + REWRITE_TAC[int_of_num_th] THEN ANTS_TAC THENL + [ASM_REWRITE_TAC[]; ALL_TAC] THEN + STRIP_TAC THEN + MP_TAC(ISPECL [`(k, &N * nIt + &j, nJs):int#int#int`; + `real_of_int nIt * &2 zpow (--kt)`; + `(real_of_int nIt + &1) * &2 zpow (--kt)`] + CWTILE_TAIL_COMPLEMENT) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [MATCH_MP_TAC REAL_LT_IMP_LE THEN MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN + EXISTS_TAC `&2 zpow k` THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LT_IMP_LE THEN MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN + EXISTS_TAC `&2 zpow k` THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN EXISTS_TAC `&2 zpow k` THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + REWRITE_TAC[tile_k] THEN + DISCH_THEN(MP_TAC o MATCH_MP REAL_INTEGRAL_UNIQUE) THEN + DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[]);; + +(* 286Gf PROPER: summing the per-sub-tile complement mass over the N = 2 *) +(* zpow *) +(* (k - kt) scale-k sub-tiles of I_tau (offsets j = 0..N-1) gives <= C4 = 1. *) +(* Each term is the (j, N-1-j) half-integer tail pair (CWTILE_SUBTILE_COMPL_ *) +(* VALUE), and TWO_SIDED_TAIL_SUM at N-1 bounds their sum by 1. This is *) +(* Fremlin's 286G(f): the total weight leaking outside a coarse spatial *) +(* cell, *) +(* summed over one frequency level's sub-tiles, is bounded by the tail *) +(* constant. *) +let CARLESON_SUBTILE_TAIL_SUM = prove + (`!k kt N nIt nJs. + kt <= k /\ &2 zpow (k - kt) = &N + ==> sum (0..N - 1) (\j. + real_integral + ({x | x <= real_of_int nIt * &2 zpow (--kt)} UNION + {x | (real_of_int nIt + &1) * &2 zpow (--kt) <= x}) + (cw_tile (k, &N * nIt + &j, nJs))) + <= &1`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum (0..N - 1) (\j. + &1 / (&2 * (&1 + (&j + &1 / &2)) pow 2) + + &1 / (&2 * (&1 + (&((N - 1) - j) + &1 / &2)) pow 2))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC SUM_EQ THEN + X_GEN_TAC `j:num` THEN REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN + MATCH_MP_TAC CWTILE_SUBTILE_COMPL_VALUE THEN ASM_REWRITE_TAC[]; + MP_TAC(SPEC `N - 1` TWO_SIDED_TAIL_SUM) THEN REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* 286E-b: the tile-localized test function phi_sigma. *) +(* *) +(* The abstract modulated-scaled-translated family *) +(* phimst mJ a b phi = \x. sqrt(mJ) e^{i b x} phi(mJ (x - a)) *) +(* and its properties are instantiated at the *) +(* tile parameters mJ = 2^k, a = x_sigma = tile_xmid, b = y^l = tile_ymid: *) +(* phi_sigma s phi = 2^(k/2) M_{y_s} S_{-x_s} D_{2^k} phi = Fremlin's phi_s. *) +(* CARLESON_286EB supplies the base test function with *) +(* char[-1/6,1/6] <= phi^ <= char[-1/5,1/5]. *) +(* ------------------------------------------------------------------------- *) + +let phi_sigma = new_definition + `phi_sigma (s:int#int#int) (phi:real->complex) = + phimst (&2 zpow (tile_k s)) (tile_xmid s) (tile_ymid s) phi`;; + +(* The tile scale mJ = 2^k is strictly positive (discharges the mJ>0 / mJ<>0 *) +(* hypotheses of every PHIMST_* lemma below). *) +let PHISIG_SCALE_POS = prove + (`!s:int#int#int. &0 < &2 zpow (tile_k s)`, + GEN_TAC THEN MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC);; + +(* A Schwartz function is square-integrable in the lift(norm . ^2) form the *) +(* norm lemmas need (from SCHWARTZ_L2 membership in lspace(&2), RPOW_POW). *) +let SCHWARTZ_NORMSQ_INTEGRABLE = prove + (`!(phi:real->complex). schwartz phi + ==> (\x:real^1. lift(norm(phi(drop x)) pow 2)) integrable_on (:real^1)`, + REPEAT STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP SCHWARTZ_L2) THEN + REWRITE_TAC[lspace; IN_ELIM_THM] THEN STRIP_TAC THEN + POP_ASSUM MP_TAC THEN REWRITE_TAC[RPOW_POW]);; + +(* 286E b: phi_sigma of a Schwartz function is Schwartz. *) +let PHISIG_SCHWARTZ = prove + (`!(s:int#int#int) (phi:real->complex). schwartz phi ==> schwartz (phi_sigma s + phi)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[phi_sigma] THEN + MATCH_MP_TAC PHIMST_SCHWARTZ THEN + ASM_SIMP_TAC[REAL_LT_IMP_NZ; PHISIG_SCALE_POS]);; + +(* 286E b-i: ||phi_sigma s phi||_2 = ||phi||_2 (L^2-norm preserved). *) +let PHISIG_L2 = prove + (`!(s:int#int#int) (phi:real->complex). schwartz phi + ==> lnorm (:real^1) (&2) (\z. phi_sigma s phi (drop z)) = + lnorm (:real^1) (&2) (\z. phi (drop z))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[phi_sigma] THEN + MATCH_MP_TAC PHIMST_L2 THEN + ASM_SIMP_TAC[PHISIG_SCALE_POS; SCHWARTZ_NORMSQ_INTEGRABLE]);; + +(* 286E b-ii: the Fourier transform of phi_sigma. *) +let PHISIG_FHAT = prove + (`!(s:int#int#int) (phi:real->complex) y. schwartz phi + ==> fourier (phi_sigma s phi) y = + Cx(&1 / sqrt(&2 zpow (tile_k s))) * + cexp(--(ii * Cx(tile_xmid s) * Cx(y - tile_ymid s))) * + fourier phi ((y - tile_ymid s) / &2 zpow (tile_k s))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[phi_sigma] THEN + MATCH_MP_TAC PHIMST_FHAT THEN ASM_REWRITE_TAC[PHISIG_SCALE_POS]);; + +(* 286E b-iii: frequency support of phi_sigma. If phi^ is supported in *) +(* [c,d], *) +(* then (phi_sigma s phi)^ is supported in [y_s + 2^k c, y_s + 2^k d]. *) +let PHISIG_FHAT_SUPPORT = prove + (`!(s:int#int#int) (phi:real->complex) c d. schwartz phi /\ + (!u. u < c \/ d < u ==> fourier phi u = Cx(&0)) + ==> (!y. y < tile_ymid s + &2 zpow (tile_k s) * c \/ + tile_ymid s + &2 zpow (tile_k s) * d < y + ==> fourier (phi_sigma s phi) y = Cx(&0))`, + REPEAT GEN_TAC THEN REWRITE_TAC[phi_sigma] THEN STRIP_TAC THEN + MATCH_MP_TAC PHIMST_FHAT_SUPPORT THEN ASM_REWRITE_TAC[PHISIG_SCALE_POS]);; + +(* 286E b-ii, L^1 half: INT|phi_sigma^| = sqrt(2^k) INT|phi^|. *) +let carleson_phi = new_specification ["carleson_phi"] + (REWRITE_RULE[SKOLEM_THM] CARLESON_286EB);; + +let CARLESON_PHI_SCHWARTZ = prove + (`schwartz carleson_phi`, + STRIP_ASSUME_TAC carleson_phi THEN ASM_REWRITE_TAC[]);; + +(* fourier carleson_phi vanishes for |y| > 1/5: at such y both the lower and *) +(* upper characteristic bounds are 0, forcing Re(fourier phi y) = 0; and *) +(* fourier phi y is real, so it is Cx(&0). *) +let CARLESON_PHI_FHAT_SUPPORT = prove + (`!y. &1 / &5 < abs y ==> fourier carleson_phi y = Cx(&0)`, + GEN_TAC THEN DISCH_TAC THEN STRIP_ASSUME_TAC carleson_phi THEN + SUBGOAL_THEN `Re(fourier carleson_phi y) = &0` ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `y:real`) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `y:real`) THEN + COND_CASES_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + COND_CASES_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REAL_ARITH_TAC; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REAL] o SPEC `y:real`) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC COMPLEX_RING);; + +(* Support in the [c,d] = [-1/5,1/5] form the phi_sigma lemmas consume. *) +let CARLESON_PHI_SUPP_CD = prove + (`!u. u < --(&1 / &5) \/ &1 / &5 < u ==> fourier carleson_phi u = Cx(&0)`, + GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC CARLESON_PHI_FHAT_SUPPORT THEN + ASM_REAL_ARITH_TAC);; + +(* M4 brick (step iv-ii): fourier carleson_phi = 1 on [-1/6,1/6]. From the *) +(* carleson_phi spec char[-1/6,1/6] <= Re(fhat) <= char[-1/5,1/5] and fhat *) +(* real: *) +(* for abs y <= 1/6, lower gives 1 <= Re fhat and (1/6<=1/5) upper gives *) +(* Re fhat <= 1, so Re fhat = 1; fhat real => fhat y = Cx 1. *) +let CARLESON_PHI_FHAT_ONE = prove + (`!y. abs y <= &1 / &6 ==> fourier carleson_phi y = Cx(&1)`, + GEN_TAC THEN DISCH_TAC THEN STRIP_ASSUME_TAC carleson_phi THEN + SUBGOAL_THEN `Re(fourier carleson_phi y) = &1` ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `y:real`) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `y:real`) THEN + REPEAT COND_CASES_TAC THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REAL] o SPEC `y:real`) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC COMPLEX_RING);; + +(* CLOSED support (Fremlin 286(h)(iii) uses the CLOSED cutoff abs(arg) >= *) +(* 1/5, *) +(* line 1617): fourier carleson_phi vanishes on the CLOSED complement *) +(* 1/5 <= abs y, not just the open 1/5 < abs y. This is the knife-edge *) +(* keystone: at the finest excluded scale k_sigma = m+1 the KILL separation *) +(* is *) +(* exactly (3/5)2^m (line 1616 uses >=, not >), so the support edge and *) +(* cutoff *) +(* meet at abs(arg) = 1/5 EXACTLY. The abstract spec only forces vanishing *) +(* on *) +(* the open ray, so we CLOSE it by continuity: fourier carleson_phi is *) +(* Schwartz *) +(* (SCHWARTZ_FOURIER), hence continuous, and vanishes on (1/5,inf); *) +(* approaching *) +(* y (with 1/5 <= abs y) from OUTSIDE along y*(1+1/(n+1)) [abs strictly > *) +(* abs y *) +(* >= 1/5], LIM_RE_UBOUND gives Re(fhat y) <= 0, while the lower chi-bound *) +(* gives *) +(* Re >= 0 (abs y > 1/6), so Re = 0; fhat real => fhat y = 0. *) +let CARLESON_PHI_FHAT_CLOSED = prove + (`!y. &1 / &5 <= abs y ==> fourier carleson_phi y = Cx(&0)`, + GEN_TAC THEN DISCH_TAC THEN + MP_TAC(SPEC `carleson_phi` SCHWARTZ_FOURIER) THEN + REWRITE_TAC[CARLESON_PHI_SCHWARTZ] THEN DISCH_TAC THEN + STRIP_ASSUME_TAC carleson_phi THEN + SUBGOAL_THEN `Re(fourier carleson_phi y) = &0` ASSUME_TAC THENL + [REWRITE_TAC[REAL_ARITH `x = &0 <=> x <= &0 /\ &0 <= x`] THEN CONJ_TAC THENL + [MATCH_MP_TAC(ISPEC `sequentially` LIM_RE_UBOUND) THEN + EXISTS_TAC `\n. fourier carleson_phi (y * (&1 + inv(&n + &1)))` THEN + REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN CONJ_TAC THENL + [MP_TAC(ISPECL [`carleson_phi`; `y:real`] FOURIER_CONTINUOUS_SEQ) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [X_GEN_TAC `y':real` THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MP_TAC(ISPEC `carleson_phi` FOURIER_MODULATE_ABSINT) THEN + REWRITE_TAC[ETA_AX; CARLESON_PHI_SCHWARTZ] THEN + DISCH_THEN(MP_TAC o SPEC `y':real`) THEN REWRITE_TAC[]; + MP_TAC(ISPEC `carleson_phi` SCHWARTZ_ABSINT) THEN + REWRITE_TAC[CARLESON_PHI_SCHWARTZ] THEN + DISCH_THEN(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_NORM) THEN + REWRITE_TAC[o_DEF] THEN + SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE]]; + DISCH_THEN(MP_TAC o SPEC `\n. y * (&1 + inv(&n + &1))`) THEN + REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + REWRITE_TAC[REAL_ADD_LDISTRIB; REAL_MUL_RID] THEN + SUBST1_TAC(REAL_ARITH `y = y + &0`) THEN + MATCH_MP_TAC REALLIM_ADD THEN + REWRITE_TAC[REAL_ADD_RID; REALLIM_CONST] THEN + MATCH_MP_TAC REALLIM_NULL_LMUL THEN + REWRITE_TAC[REALLIM_1_OVER_N_OFFSET]]; + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `0` THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `y * (&1 + inv(&n + &1))`) THEN + SUBGOAL_THEN `&1 / &5 < abs(y * (&1 + inv(&n + &1)))` MP_TAC THENL + [REWRITE_TAC[REAL_ABS_MUL] THEN + SUBGOAL_THEN `&1 < abs(&1 + inv(&n + &1))` ASSUME_TAC THENL + [MATCH_MP_TAC(REAL_ARITH `&0 < i ==> &1 < abs(&1 + i)`) THEN + MATCH_MP_TAC REAL_LT_INV THEN REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN + EXISTS_TAC `&1 / &5 * abs(&1 + inv(&n + &1))` THEN CONJ_TAC THENL + [GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LT_LMUL THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ASM_REWRITE_TAC[]]; + MATCH_MP_TAC REAL_LE_RMUL THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; REAL_ARITH_TAC]]; + DISCH_TAC THEN COND_CASES_TAC THENL + [ASM_REAL_ARITH_TAC; REWRITE_TAC[]]]]; + FIRST_X_ASSUM(K ALL_TAC o SPEC `y:real`) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `y:real`) THEN + COND_CASES_TAC THENL [ASM_REAL_ARITH_TAC; REAL_ARITH_TAC]]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REAL] o SPEC `y:real`) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC COMPLEX_RING]);; + +(* ------------------------------------------------------------------------- *) +(* Fremlin 286H(v): psicheck, the inverse Fourier transform of the *) +(* m-cutoff multiplier psi. Fremlin: psicheck(x) = 3*2^m e^{ix yhat} *) +(* phi(3*2^m x), i.e. 3*2^m M_yhat D_{3*2^m} phi -- an *) +(* affine-reparametrized, *) +(* modulated, scaled copy of the base test function. scal = 3*2^m > 0. *) +(* ------------------------------------------------------------------------- *) +(* The m-cutoff frequency multiplier cpsi (Fremlin 286H(i)). *) +(* cpsi(y) = phihat((1/3) 2^{-m}(y - yhat)), the frequency-domain cutoff *) +(* whose inverse transform is (1/sqrt2pi) psicheck. Parametrized by scale *) +(* m:int and anchor yhat:real. *) +let cpsi = new_definition + `cpsi (m:int) (yhat:real) (y:real) = + fourier carleson_phi ((&1 / &3) * &2 zpow (--m) * (y - yhat))`;; + +(* cpsi = 1 on the band abs(y - yhat) <= 2^m/2 (Fremlin (h)(ii)): there the *) +(* argument (1/3)2^{-m}(y-yhat) has absolute value <= 1/6, where phihat = 1. *) +let CPSI_ONE = prove + (`!m yhat y. abs(y - yhat) <= &2 zpow m / &2 ==> cpsi m yhat y = Cx(&1)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[cpsi] THEN + MATCH_MP_TAC CARLESON_PHI_FHAT_ONE THEN + SUBGOAL_THEN `&0 < &2 zpow m` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_ZPOW_NEG; REAL_ABS_MUL; REAL_ABS_INV] THEN + SUBGOAL_THEN `abs(&2 zpow m) = &2 zpow m` SUBST1_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `inv(&2 zpow m) * abs(y - yhat) <= inv(&2 zpow m) * (&2 zpow m / &2)` + MP_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN + ASM_SIMP_TAC[REAL_LE_INV_EQ; REAL_LT_IMP_LE]; ALL_TAC] THEN + SUBGOAL_THEN `inv(&2 zpow m) * (&2 zpow m / &2) = &1 / &2` SUBST1_TAC THENL + [REWRITE_TAC[real_div; REAL_MUL_ASSOC] THEN + ASM_SIMP_TAC[REAL_MUL_LINV; REAL_LT_IMP_NZ] THEN + REAL_ARITH_TAC; ALL_TAC] THEN + REAL_ARITH_TAC);; + +(* cpsi = 0 outside the band abs(y - yhat) > 3 2^m/5 (Fremlin (h)(iii) *) +(* support side): there abs((1/3)2^{-m}(y-yhat)) > 1/5, beyond phihat's *) +(* support. *) +let CPSI_ZERO_CLOSED = prove + (`!m yhat y. &3 * &2 zpow m / &5 <= abs(y - yhat) ==> cpsi m yhat y = Cx(&0)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[cpsi] THEN + MP_TAC(ISPEC `(&1 / &3) * &2 zpow (--m) * (y - yhat)` + CARLESON_PHI_FHAT_CLOSED) THEN + DISCH_THEN MATCH_MP_TAC THEN + SUBGOAL_THEN `&0 < &2 zpow m` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_ZPOW_NEG; REAL_ABS_MUL; REAL_ABS_INV] THEN + SUBGOAL_THEN `abs(&2 zpow m) = &2 zpow m` SUBST1_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `inv(&2 zpow m) * (&3 * &2 zpow m / &5) <= inv(&2 zpow m) * abs(y - yhat)` + MP_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN + ASM_SIMP_TAC[REAL_LT_INV_EQ; REAL_LT_IMP_LE]; ALL_TAC] THEN + SUBGOAL_THEN + `inv(&2 zpow m) * (&3 * &2 zpow m / &5) = &3 / &5` SUBST1_TAC THENL + [REWRITE_TAC[real_div] THEN + ONCE_REWRITE_TAC[REAL_ARITH `i * (&3 * M * f) = (&3 * f) * (i * M)`] THEN + ASM_SIMP_TAC[REAL_MUL_LINV; REAL_LT_IMP_NZ] THEN + REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `abs(&1 / &3) = &1 / &3` SUBST1_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + REAL_ARITH_TAC);; + +let psicheck = new_definition + `psicheck (scal:real) (yhat:real) (phi:real->complex) (x:real) = + Cx scal * cexp(ii * Cx yhat * Cx x) * phi(scal * x)`;; + +(* psicheck of a Schwartz phi is Schwartz (scal>0): SCHWARTZ_AFFINE *) +(* (s=scal), then SCHWARTZ_MODULATE (b=yhat), then SCHWARTZ_CMUL (c=Cx *) +(* scal). *) +let PSICHECK_SCHWARTZ = prove + (`!(phi:real->complex) scal yhat. schwartz phi /\ &0 < scal + ==> schwartz (psicheck scal yhat phi)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `psicheck scal yhat (phi:real->complex) = + (\x. Cx scal * cexp(ii * Cx yhat * Cx x) * phi(scal * x))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; psicheck]; ALL_TAC] THEN + MATCH_MP_TAC SCHWARTZ_CMUL THEN + MP_TAC(ISPECL [`\x. (phi:real->complex)(scal * x)`; + `yhat:real`] SCHWARTZ_MODULATE) THEN + ANTS_TAC THENL + [MP_TAC(ISPECL [`phi:real->complex`; `scal:real`; + `&0`] SCHWARTZ_AFFINE) THEN + ASM_SIMP_TAC[REAL_LT_IMP_NZ; REAL_ADD_LID; ETA_AX]; + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM]]);; + +(* M4 (part h step v) DUALITY: the Fourier transform of psicheck is cpsi. *) +(* fourier (psicheck (3*2^m) yhat carleson_phi) y = cpsi m yhat y. *) +(* psicheck = 3*2^m M_yhat D_{3*2^m} phi, so its transform is *) +(* 3*2^m * (1/(3*2^m)) S_{-yhat} D_{1/(3*2^m)} phihat = *) +(* phihat((y-yhat)/(3*2^m)) *) +(* = cpsi. FOURIER_LMUL (pull Cx(3*2^m)) + FOURIER_MODULATION (shift by *) +(* yhat, *) +(* unconditional) + FOURIER_DILATION (scale 3*2^m); integrability of the *) +(* dilated/modulated Schwartz factors via FOURIER_MODULATE_ABSINT. This is *) +(* the *) +(* bridge that makes gt_m = (1/sqrt2pi)(gt * psicheck) (step C). *) +let PSICHECK_FOURIER = prove + (`!m yhat y. + fourier (psicheck (&3 * &2 zpow m) yhat carleson_phi) y = cpsi m yhat y`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `&0 < &3 * &2 zpow m` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC THENL + [REAL_ARITH_TAC; MATCH_MP_TAC REAL_ZPOW_LT THEN + REAL_ARITH_TAC]; ALL_TAC] THEN + ABBREV_TAC `c = &3 * &2 zpow m` THEN + SUBGOAL_THEN + `schwartz (\x. (carleson_phi:real->complex)(c * x))` ASSUME_TAC THENL + [MP_TAC(ISPECL [`carleson_phi`; `c:real`; `&0`] SCHWARTZ_AFFINE) THEN + ASM_SIMP_TAC[REAL_LT_IMP_NZ; REAL_ADD_LID; ETA_AX; CARLESON_PHI_SCHWARTZ]; + ALL_TAC] THEN + SUBGOAL_THEN + `schwartz (\x. cexp(ii * Cx yhat * Cx x) * (carleson_phi:real->complex)(c * + x))` + ASSUME_TAC THENL + [MP_TAC(ISPECL [`\x. (carleson_phi:real->complex)(c * x)`; + `yhat:real`] SCHWARTZ_MODULATE) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM]; ALL_TAC] THEN + SUBGOAL_THEN `psicheck c yhat (carleson_phi:real->complex) = + (\x. Cx c * cexp(ii * Cx yhat * Cx x) * carleson_phi(c * x))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; psicheck]; ALL_TAC] THEN + MP_TAC(ISPECL [`\x. cexp(ii * Cx yhat * Cx x) * + (carleson_phi:real->complex)(c * x)`; + `Cx c`; `y:real`] FOURIER_LMUL) THEN + ANTS_TAC THENL + [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MP_TAC(ISPECL [`\x. cexp(ii * Cx yhat * Cx x) * + (carleson_phi:real->complex)(c * x)`; `y:real`] + FOURIER_MODULATE_ABSINT) THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[ETA_AX]; + ALL_TAC] THEN + REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + MP_TAC(ISPECL [`\x. (carleson_phi:real->complex)(c * x)`; `yhat:real`; + `y:real`] + FOURIER_MODULATION) THEN + REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + MP_TAC(SPECL [`carleson_phi`; `c:real`; + `y - yhat:real`] FOURIER_DILATION) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [FIRST_ASSUM ACCEPT_TAC; + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MP_TAC(SPECL [`carleson_phi`; + `((y:real) - yhat) / c`] FOURIER_MODULATE_ABSINT) THEN + REWRITE_TAC[CARLESON_PHI_SCHWARTZ]]; + DISCH_THEN SUBST1_TAC] THEN + REWRITE_TAC[cpsi] THEN + REWRITE_TAC[COMPLEX_MUL_ASSOC; GSYM CX_MUL] THEN + SUBGOAL_THEN `c * &1 / c = &1` SUBST1_TAC THENL + [ASM_SIMP_TAC[REAL_FIELD `&0 < c ==> c * &1 / c = &1`]; ALL_TAC] THEN + REWRITE_TAC[CX_MUL; COMPLEX_MUL_LID] THEN AP_TERM_TAC THEN + EXPAND_TAC "c" THEN REWRITE_TAC[REAL_ZPOW_NEG] THEN + SUBGOAL_THEN `&0 < &2 zpow m` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[real_div] THEN + ASM_SIMP_TAC[REAL_FIELD + `&0 < p ==> (y - yhat) * inv(&3 * p) = &1 * inv(&3) * inv p * (y - yhat)`] + THEN + REWRITE_TAC[REAL_MUL_ASSOC]);; + +(* M6 brick: the pointwise modulus of psicheck. The modulation factor *) +(* cexp(ii yhat t) has modulus 1, so |psicheck scal yhat phi t| = |scal| *) +(* |phi(scal t)|. *) +(* Feeds Fremlin (h)(vi): (1/sqrt2pi) int |gt(x-t)| |psicheck(t)| = *) +(* (3 2^m/sqrt2pi) int |gt(x-t)| |phi(3 2^m t)|. *) +let PSICHECK_NORM = prove + (`!scal yhat (phi:real->complex) t. + norm(psicheck scal yhat phi t) = abs scal * norm(phi(scal * t))`, + REWRITE_TAC[psicheck; COMPLEX_NORM_MUL; COMPLEX_NORM_CX] THEN + REPEAT GEN_TAC THEN + SUBGOAL_THEN `ii * Cx yhat * Cx t = ii * Cx(yhat * t)` ASSUME_TAC THENL + [REWRITE_TAC[CX_MUL] THEN CONV_TAC COMPLEX_RING; ALL_TAC] THEN + ASM_REWRITE_TAC[NORM_CEXP_II; REAL_MUL_LID]);; + +(* M4 brick (part h step v / 283G everywhere-uniqueness): the Fourier *) +(* transform *) +(* is injective on Schwartz functions. Apply DOUBLE_TRANSFORM (inversion) on *) +(* both sides: f x = fourier(fourier f)(-x) = fourier(fourier g)(-x) = g x. *) +let FOURIER_VSUM = prove + (`!(s:A->bool) (f:A->real->complex) y. + FINITE s /\ (!i. i IN s ==> schwartz (f i)) + ==> fourier (\x. vsum s (\i. f i x)) y = vsum s (\i. fourier (f i) y)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[fourier] THEN + ASM_SIMP_TAC[VSUM_COMPLEX_LMUL] THEN AP_TERM_TAC THEN + SUBGOAL_THEN + `(\x. cexp (--(ii * Cx y * Cx (drop x))) * vsum s (\i. (f:A->real->complex) + i (drop x))) = + (\x. vsum s (\i. cexp (--(ii * Cx y * Cx (drop x))) * f i (drop x)))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + ASM_SIMP_TAC[VSUM_COMPLEX_LMUL]; ALL_TAC] THEN + MP_TAC(ISPECL + [`\i:A. \x:real^1. cexp (--(ii * Cx y * Cx (drop x))) * (f:A->real->complex) + i (drop x)`; + `(:real^1)`; `s:A->bool`] INTEGRAL_VSUM) THEN + ASM_SIMP_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + X_GEN_TAC `i:A` THEN DISCH_TAC THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC FOURIER_MODULATE_ABSINT THEN + REWRITE_TAC[ETA_AX] THEN ASM_SIMP_TAC[]);; + +(* M4 brick: the Fourier transform of a tile-tree reconstruction pushes onto *) +(* the individual tile transforms. For any FINITE index set Q, *) +(* (vsum Q (\s. c_s phi_sigma_s))^ (y) = vsum Q (\s. c_s phihat_sigma_s(y)). *) +(* FOURIER_VSUM (each summand Schwartz via SCHWARTZ_CMUL + PHISIG_SCHWARTZ) *) +(* then *) +(* FOURIER_LMUL termwise (modulated phi_sigma integrable via *) +(* FOURIER_MODULATE_ *) +(* ABSINT). The backbone for gt_m^ = cpsi*gt^ (step (iv) summed over the *) +(* tree). *) +let FTILDE_FHAT = prove + (`!(c:(int#int#int)->complex) (Q:(int#int#int)->bool) y. FINITE Q + ==> fourier (\x. vsum Q (\s. c s * phi_sigma s carleson_phi x)) y = + vsum Q (\s. c s * fourier (phi_sigma s carleson_phi) y)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`Q:(int#int#int)->bool`; + `\s:int#int#int. \x. c s * phi_sigma s carleson_phi x`; + `y:real`] + FOURIER_VSUM) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC SCHWARTZ_CMUL THEN REWRITE_TAC[ETA_AX] THEN + MATCH_MP_TAC PHISIG_SCHWARTZ THEN REWRITE_TAC[CARLESON_PHI_SCHWARTZ]; + ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC VSUM_EQ THEN + X_GEN_TAC `s:int#int#int` THEN DISCH_TAC THEN BETA_TAC THEN + MATCH_MP_TAC FOURIER_LMUL THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC FOURIER_MODULATE_ABSINT THEN + REWRITE_TAC[ETA_AX] THEN + MATCH_MP_TAC PHISIG_SCHWARTZ THEN REWRITE_TAC[CARLESON_PHI_SCHWARTZ]);; + +(* 286E b-i, concrete: ||phi_sigma s carleson_phi||_2 = ||carleson_phi||_2. *) +let PHISIG_CARLESON_L2 = prove + (`!(s:int#int#int). lnorm (:real^1) (&2) (\z. phi_sigma s carleson_phi (drop + z)) = + lnorm (:real^1) (&2) (\z. carleson_phi (drop z))`, + GEN_TAC THEN MATCH_MP_TAC PHISIG_L2 THEN + REWRITE_TAC[CARLESON_PHI_SCHWARTZ]);; + +(* 286E b-iii, TILE-NATIVE: the frequency support of phi_sigma s *) +(* carleson_phi *) +(* lies inside tile_J s. tile_J s = [nJ 2^k,(nJ+1)2^k); the modulation *) +(* anchor *) +(* ymid = dyho_mid(k-1)(2nJ) = (nJ+1/4)2^k (Fremlin's lower quartile y^l, *) +(* the *) +(* midpoint of J^l), and the support half-width is 2^k/5, so the support *) +(* [(nJ+1/4-1/5)2^k,(nJ+1/4+1/5)2^k] = [(nJ+1/20)2^k,(nJ+9/20)2^k] fits in *) +(* J. *) +let PHISIG_CARLESON_SUPP_IN_JL = prove + (`!(s:int#int#int) y. ~(y IN tile_Jl s) + ==> fourier (phi_sigma s carleson_phi) y = Cx(&0)`, + REWRITE_TAC[FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC [`k:int`;`nI:int`;`nJ:int`] THEN + GEN_TAC THEN + REWRITE_TAC[tile_Jl; dyho; IN_ELIM_THM; DE_MORGAN_THM; REAL_NOT_LE] THEN + DISCH_TAC THEN + MP_TAC(ISPECL [`(k,nI,nJ):int#int#int`; `carleson_phi`; `--(&1 / &5)`; + `&1 / &5`] + PHISIG_FHAT_SUPPORT) THEN + REWRITE_TAC[CARLESON_PHI_SCHWARTZ; CARLESON_PHI_SUPP_CD] THEN + DISCH_THEN MATCH_MP_TAC THEN + REWRITE_TAC[tile_ymid; tile_k; dyho_mid] THEN + SUBGOAL_THEN `&2 zpow (k - &1) = &2 zpow k / &2` SUBST1_TAC THENL + [SIMP_TAC[REAL_ZPOW_SUB; REAL_ZPOW_1; REAL_OF_NUM_EQ; ARITH_EQ]; + ALL_TAC] THEN + RULE_ASSUM_TAC(REWRITE_RULE + [MESON[REAL_ZPOW_SUB; REAL_ZPOW_1; REAL_OF_NUM_EQ; ARITH_EQ] + `&2 zpow (k - &1) = &2 zpow k / &2`]) THEN + SUBGOAL_THEN + `real_of_int (&2 * nJ) = &2 * real_of_int nJ` SUBST_ALL_TAC THENL + [REWRITE_TAC[int_mul_th; int_of_num_th]; ALL_TAC] THEN + SUBGOAL_THEN `&0 < &2 zpow k` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + ABBREV_TAC `M = &2 zpow k` THEN + FIRST_X_ASSUM DISJ_CASES_TAC THENL [DISJ1_TAC; DISJ2_TAC] THEN + ASM_REAL_ARITH_TAC);; + +(* M4 step (iv), pointwise, k_sigma<=m case: if the whole left-half tile *) +(* J^l_s *) +(* sits inside the cpsi=1 band [yhat +- 2^m/2], then phihat_s * cpsi = *) +(* phihat_s *) +(* pointwise. On J^l_s cpsi=1 (CPSI_ONE); off J^l_s phihat_s=0 (SUPP_IN_JL). *) +(* The band-containment (tile-geometry from J_s SUBSET Jhat) is a *) +(* hypothesis. *) +let PHISIG_CPSI_KEEP = prove + (`!(s:int#int#int) m yhat y. + (!z. z IN tile_Jl s ==> abs(z - yhat) <= &2 zpow m / &2) + ==> fourier (phi_sigma s carleson_phi) y * cpsi m yhat y = + fourier (phi_sigma s carleson_phi) y`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `(y:real) IN tile_Jl s` THENL + [SUBGOAL_THEN + `cpsi m yhat y = Cx(&1)` (fun th -> REWRITE_TAC[th; COMPLEX_MUL_RID]) THEN + MATCH_MP_TAC CPSI_ONE THEN ASM_SIMP_TAC[]; + SUBGOAL_THEN `fourier (phi_sigma s carleson_phi) y = Cx(&0)` + (fun th -> REWRITE_TAC[th; COMPLEX_MUL_LZERO]) THEN + MATCH_MP_TAC PHISIG_CARLESON_SUPP_IN_JL THEN ASM_REWRITE_TAC[]]);; + +(* M4 step (iv), pointwise, k_sigma>m case: if J^l_s sits in the cpsi=0 *) +(* region (abs(z-yhat) > 3 2^m/5 for all z in J^l_s), then phihat_s * cpsi = *) +(* 0. *) +let DYHO_MEM_BAND = prove + (`!(mm:int) (nhat:int) (z:real). + z IN dyho mm nhat ==> abs(z - dyho_mid mm nhat) <= &2 zpow mm / &2`, + REPEAT GEN_TAC THEN REWRITE_TAC[dyho; dyho_mid; IN_ELIM_THM] THEN + SUBGOAL_THEN `&0 < &2 zpow mm` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + STRIP_TAC THEN + SUBGOAL_THEN `(real_of_int nhat + &1 / &2) * &2 zpow mm - &2 zpow mm / &2 = + real_of_int nhat * &2 zpow mm` ASSUME_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `(real_of_int nhat + &1 / &2) * &2 zpow mm + &2 zpow mm / &2 = + (real_of_int nhat + &1) * &2 zpow mm` ASSUME_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + ASM_REAL_ARITH_TAC);; + +(* M4 step (iv) KEEP, geometric form: if the left-half tile J^l_s sits *) +(* inside *) +(* the length-2^mm dyadic interval Jhat = dyho mm nhat (anchor yhat = its *) +(* midpoint), then phihat_s * cpsi = phihat_s pointwise. Reduces KEEP's band *) +(* hypothesis to the dyadic containment J^l_s SUBSET Jhat (Fremlin (h)(ii)). *) +let PHISIG_CPSI_KEEP_GEOM = prove + (`!(s:int#int#int) mm nhat y. + tile_Jl s SUBSET dyho mm nhat + ==> fourier (phi_sigma s carleson_phi) y * cpsi mm (dyho_mid mm nhat) y = + fourier (phi_sigma s carleson_phi) y`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC PHISIG_CPSI_KEEP THEN + X_GEN_TAC `z:real` THEN DISCH_TAC THEN + MATCH_MP_TAC DYHO_MEM_BAND THEN ASM SET_TAC[]);; + +(* M4 (h)(iii) SHARP support: fourier(phi_sigma s carleson_phi) vanishes *) +(* outside *) +(* [tile_ymid s - (1/5)2^k, tile_ymid s + (1/5)2^k] (half-width (1/5)muJ *) +(* about *) +(* the lower-quartile anchor y^l_sigma = tile_ymid). Direct *) +(* PHISIG_FHAT_SUPPORT *) +(* at c=-1/5,d=1/5 (carleson_phi support); keeps the sharp bounds, unlike *) +(* SUPP_IN_JL which weakens to J^l. Needed for the KILL side's 1/20 muJ *) +(* slack. *) +let PHISIG_CARLESON_SUPP_CLOSED = prove + (`!(s:int#int#int) y. + y <= tile_ymid s - &1 / &5 * &2 zpow (tile_k s) \/ + tile_ymid s + &1 / &5 * &2 zpow (tile_k s) <= y + ==> fourier (phi_sigma s carleson_phi) y = Cx(&0)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + ASM_SIMP_TAC[PHISIG_FHAT; CARLESON_PHI_SCHWARTZ] THEN + SUBGOAL_THEN + `fourier carleson_phi ((y - tile_ymid s) / &2 zpow (tile_k s)) = Cx(&0)` + SUBST1_TAC THENL + [MATCH_MP_TAC CARLESON_PHI_FHAT_CLOSED THEN + SUBGOAL_THEN `&0 < &2 zpow (tile_k s)` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_ABS_DIV] THEN + SUBGOAL_THEN + `abs(&2 zpow (tile_k s)) = &2 zpow (tile_k s)` SUBST1_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ] THEN ASM_REAL_ARITH_TAC; + CONV_TAC COMPLEX_RING]);; + +(* M4 step (iv) KILL, sharp-support form: if the whole sharp frequency *) +(* support [tile_ymid s +- (1/5)2^k] lies in the cpsi=0 region abs(z-yhat) > *) +(* 3 2^m/5, then phihat_s * cpsi = 0 pointwise (CPSI_ZERO on supp, else *) +(* SUPP_SHARP). *) +let PHISIG_CPSI_KILL_CLOSED = prove + (`!(s:int#int#int) m yhat y. + (!z. tile_ymid s - &1 / &5 * &2 zpow (tile_k s) <= z /\ + z <= tile_ymid s + &1 / &5 * &2 zpow (tile_k s) + ==> &3 * &2 zpow m / &5 <= abs(z - yhat)) + ==> fourier (phi_sigma s carleson_phi) y * cpsi m yhat y = Cx(&0)`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC + `tile_ymid s - &1 / &5 * &2 zpow (tile_k s) <= y /\ + y <= tile_ymid s + &1 / &5 * &2 zpow (tile_k s)` THENL + [SUBGOAL_THEN + `cpsi m yhat y = + Cx(&0)` (fun th -> REWRITE_TAC[th; COMPLEX_MUL_RZERO]) THEN + MATCH_MP_TAC CPSI_ZERO_CLOSED THEN ASM_SIMP_TAC[]; + SUBGOAL_THEN `fourier (phi_sigma s carleson_phi) y = Cx(&0)` + (fun th -> REWRITE_TAC[th; COMPLEX_MUL_LZERO]) THEN + MATCH_MP_TAC PHISIG_CARLESON_SUPP_CLOSED THEN ASM_REAL_ARITH_TAC]);; + +(* 286E b-iv, TILE-NATIVE: phi_sigma at two tiles with DISJOINT frequency *) +(* intervals tile_J are orthogonal (each support sits inside its own *) +(* tile_J). *) +let PHISIG_CARLESON_ORTHO_JL = prove + (`!(s:int#int#int) (t:int#int#int). DISJOINT (tile_Jl s) (tile_Jl t) + ==> integral (:real^1) + (\z. phi_sigma s carleson_phi (drop z) * + cnj(phi_sigma t carleson_phi (drop z))) = Cx(&0)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SCHWARTZ_ORTHO_DISJOINT_FHAT THEN + REWRITE_TAC[ETA_AX] THEN + SIMP_TAC[PHISIG_SCHWARTZ; CARLESON_PHI_SCHWARTZ] THEN + X_GEN_TAC `u:real` THEN ASM_CASES_TAC `(u:real) IN tile_Jl s` THENL + [DISJ2_TAC THEN MATCH_MP_TAC PHISIG_CARLESON_SUPP_IN_JL THEN + ASM_MESON_TAC[DISJOINT; IN_INTER; NOT_IN_EMPTY; EXTENSION]; + DISJ1_TAC THEN MATCH_MP_TAC PHISIG_CARLESON_SUPP_IN_JL THEN + ASM_REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* 286G(e-f): the KERNEL BOUNDS -- the test function is dominated pointwise *) +(* by *) +(* the tile weight. norm(phi_sigma s carleson_phi x)^2 <= C cw_tile s x. The *) +(* mass/energy estimates of M3 use this to reduce tile correlations to the *) +(* summable weight cw. Foundations: a Schwartz function decays like *) +(* C/(1+u^2) *) +(* (SCHWARTZ_DECAY_EXISTS from the k=0,k=2 bounds), and (1+|u|)^3 <= *) +(* 4(1+u^2)^2 *) +(* (CUBE_LE_SQSQ, via the degree-4 positivity POLY43_BOUND) gives *) +(* inv(1+u^2)^2 <= 4 cw u (INVSQ_LE_CW). *) +(* ------------------------------------------------------------------------- *) + +(* Degree-4 positivity: 4t^4 - t^3 + 5t^2 - 3t + 3 >= 0 for t >= 0. Split at *) +(* t = 1 (t^3 <= t^2 below, t^3 <= t^4 above) + the square 4t^2 - 4t + 1 >= *) +(* 0. *) +let SCHWARTZ_DECAY_EXISTS = prove + (`!h:real->complex. schwartz h + ==> ?C. &0 <= C /\ !u. norm(h u) <= C * inv(&1 + u pow 2)`, + GEN_TAC THEN REWRITE_TAC[schwartz] THEN + DISCH_THEN(X_CHOOSE_THEN `d:num->real->complex` STRIP_ASSUME_TAC) THEN + FIRST_ASSUM(X_CHOOSE_TAC `B0:real` o SPECL [`0`; `0`]) THEN + FIRST_ASSUM(X_CHOOSE_TAC `B2:real` o SPECL [`2`; `0`]) THEN + EXISTS_TAC `B0 + B2:real` THEN CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `&0`) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `&0`) THEN + MP_TAC(ISPEC `(d:num->real->complex) 0 (&0)` NORM_POS_LE) THEN + REWRITE_TAC[real_pow; REAL_MUL_LID] THEN REAL_ARITH_TAC; + X_GEN_TAC `u:real` THEN + FIRST_ASSUM(SUBST1_TAC o SYM o check (fun th -> concl th = + `(d:num->real->complex) 0 = h`)) THEN + MATCH_MP_TAC SCHWARTZ_DECAY_DOMINATION THEN ASM_REWRITE_TAC[]]);; + +(* 286G(e): base kernel bound norm(carleson_phi u)^2 <= C cw u. *) +let SUM_QUADRATIC_EXPAND = prove + (`!(s:A->bool) f g y. FINITE s + ==> sum s (\i. (f i * y + g i) pow 2) = + sum s (\i. f i pow 2) * y pow 2 + + &2 * sum s (\i. f i * g i) * y + + sum s (\i. g i pow 2)`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[GSYM SUM_LMUL; GSYM SUM_RMUL; GSYM SUM_ADD] THEN + MATCH_MP_TAC SUM_EQ THEN REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN + REAL_ARITH_TAC);; + +let SUM_CAUCHY_SCHWARZ = prove + (`!(s:A->bool) f g. FINITE s + ==> (sum s (\i. f i * g i)) pow 2 <= (sum s (\i. f i pow 2)) * (sum s (\i. + g i pow 2))`, + REPEAT STRIP_TAC THEN + ABBREV_TAC `A = sum s (\i. (f:A->real) i pow 2)` THEN + ABBREV_TAC `B = sum s (\i. (f:A->real) i * g i)` THEN + ABBREV_TAC `C = sum s (\i. (g:A->real) i pow 2)` THEN + SUBGOAL_THEN `!y:real. &0 <= A * y pow 2 + &2 * B * y + C` ASSUME_TAC THENL + [GEN_TAC THEN + MP_TAC(ISPECL [`s:A->bool`; `f:A->real`; `g:A->real`; + `y:real`] SUM_QUADRATIC_EXPAND) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC SUM_POS_LE THEN REWRITE_TAC[REAL_LE_POW_2]; + ALL_TAC] THEN + SUBGOAL_THEN `&0 <= A` ASSUME_TAC THENL + [EXPAND_TAC "A" THEN MATCH_MP_TAC SUM_POS_LE THEN + REWRITE_TAC[REAL_LE_POW_2]; ALL_TAC] THEN + SUBGOAL_THEN `&0 <= C` ASSUME_TAC THENL + [EXPAND_TAC "C" THEN MATCH_MP_TAC SUM_POS_LE THEN + REWRITE_TAC[REAL_LE_POW_2]; ALL_TAC] THEN + SUBGOAL_THEN `&0 <= A * C` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_CASES_TAC `A = &0` THENL + [SUBGOAL_THEN `B = &0` MP_TAC THENL + [MATCH_MP_TAC(REAL_ARITH `~(&0 < abs B) ==> B = &0`) THEN DISCH_TAC THEN + FIRST_X_ASSUM(fun th -> if is_forall(concl th) + then MP_TAC(SPEC `--(C + &1) / (&2 * B):real` th) else NO_TAC) THEN + ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_LID] THEN + ASM_SIMP_TAC[REAL_FIELD `&0 < abs B ==> &2 * B * --(C + &1) / (&2 * B) + + C = --(&1)`] THEN + REAL_ARITH_TAC; + DISCH_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC]; + SUBGOAL_THEN `&0 < A` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + FIRST_X_ASSUM(fun th -> if is_forall(concl th) + then MP_TAC(SPEC `--B / A:real` th) else NO_TAC) THEN + ASM_SIMP_TAC[REAL_FIELD + `&0 < A ==> A * (--B / A) pow 2 + &2 * B * --B / A + C = C - B pow 2 / A`] + THEN + DISCH_TAC THEN + SUBGOAL_THEN `B pow 2 / A <= C` MP_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ] THEN REWRITE_TAC[REAL_MUL_SYM]]);; + +(* WEIGHTED discrete Cauchy-Schwarz (the 286L energy x mass split). *) +(* Inserting *) +(* the trivial factor sqrt(w) * inv(sqrt(w)) = 1 into sum |a b| and applying *) +(* SUM_CAUCHY_SCHWARZ splits the bilinear sum into a w-weighted a-factor and *) +(* an *) +(* inv(w)-weighted b-factor: (sum|a_i b_i|)^2 <= (sum w_i a_i^2)(sum w_i^-1 *) +(* b_i^2) *) +(* for w_i > 0. In 286L: w_i = 2 zpow k_s makes the a-factor the energy sum *) +(* (sum 2^k_s |(f|phi_s)|^2) and the b-factor the mass sum (sum 2^-k_s *) +(* |int|^2). *) +let SUM_FIBER_COUNT_2 = prove + (`!(A:(int#int#int)->bool) (g:(int#int#int)->num) (ff:num->real) N M. + FINITE A /\ (!n. &0 <= ff n) /\ + (!a. a IN A ==> g a IN N..M) /\ + (!n. CARD {a | a IN A /\ g a = n} <= 2) + ==> sum A (\a. ff(g a)) <= &2 * sum (N..M) ff`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`g:(int#int#int)->num`; + `\a:(int#int#int). (ff:num->real)(g a)`; + `A:(int#int#int)->bool`] SUM_IMAGE_GEN) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum (IMAGE (g:(int#int#int)->num) A) (\y. &2 * ff y)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN + X_GEN_TAC `y:num` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + SUBGOAL_THEN + `sum {x | x IN A /\ (g:(int#int#int)->num) x = y} (\a. ff(g a)) = + sum {x | x IN A /\ g x = y} (\a:int#int#int. ff y)` + SUBST1_TAC THENL + [MATCH_MP_TAC SUM_EQ THEN SIMP_TAC[IN_ELIM_THM]; ALL_TAC] THEN + ASM_SIMP_TAC[SUM_CONST; FINITE_RESTRICT] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[REAL_OF_NUM_LE]; + REWRITE_TAC[SUM_LMUL] THEN MATCH_MP_TAC REAL_LE_LMUL THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[FINITE_NUMSEG]; + REWRITE_TAC[SUBSET; IN_IMAGE] THEN ASM_MESON_TAC[]; + X_GEN_TAC `n:num` THEN REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[]]]);; + +(* 286L alpha0/alpha1 PER-SCALE WEIGHT SUM. If g : A -> num is <=2-to-1 with *) +(* range *) +(* in N..M, then sum_{a in A} cw(&(g a) + 1/2) <= 1/(1 + &N)^2. *) +(* SUM_FIBER_COUNT_2 *) +(* bounds the sum by 2 sum_{N..M} cw(&n + 1/2); CW_SUM_BOUND bounds that *) +(* tail by *) +(* 1/(2(1+N)^2), and the 2 cancels the 1/2. In 286L: g = the nearest-edge *) +(* offset *) +(* of x_sigma past the cover cell K (so cw(&(g)+1/2) = w(2^k rho)); N = *) +(* 2^{k-l_K}, *) +(* giving Fremlin's sum_{k_sigma=k} w(2^k rho) <= (1 + 2^{k-l_K})^{-2}. *) +let WEIGHT_OFFSET_SUM_BOUND = prove + (`!(A:(int#int#int)->bool) g N M. + FINITE A /\ (!a. a IN A ==> g a IN N..M) /\ + (!n. CARD {a | a IN A /\ g a = n} <= 2) + ==> sum A (\a. cw(&(g a) + &1 / &2)) <= &1 / (&1 + &N) pow 2`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&2 * sum (N..M) (\n. cw(&n + &1 / &2))` THEN + CONJ_TAC THENL + [MP_TAC(ISPECL [`A:(int#int#int)->bool`; `g:(int#int#int)->num`; + `\n:num. cw(&n + &1 / &2)`; `N:num`; + `M:num`] SUM_FIBER_COUNT_2) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + GEN_TAC THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN REWRITE_TAC[CW_POS]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&2 * &1 / (&2 * (&1 + &N) pow 2)` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [REAL_ARITH_TAC; REWRITE_TAC[CW_SUM_BOUND]]; + MATCH_MP_TAC REAL_EQ_IMP_LE THEN + SUBGOAL_THEN `&0 < (&1 + &N) pow 2` MP_TAC THENL + [MATCH_MP_TAC REAL_POW_LT THEN REAL_ARITH_TAC; CONV_TAC REAL_FIELD]]);; + +(* 286L alpha0/alpha1 PER-SCALE ALPHA BOUND (abstract). If each term f a is *) +(* dominated by B * cw(&(g a) + 1/2) with g a <=2-to-1 and range in N..M, *) +(* then *) +(* sum_A f <= B / (1 + N)^2. Combines a per-tile bound (SUM_LE termwise) *) +(* with *) +(* WEIGHT_OFFSET_SUM_BOUND (SUM_LMUL pulls out B, REAL_LE_LMUL). In 286L: f *) +(* sigma = *) +(* norm(alpha_sigma_K), B = C1 2^{-k} gamma gamma' (from *) +(* CARLESON_ALPHA_PAIR, since *) +(* w(2^k rho) = cw(&(g sigma) + 1/2)), g = the nearest-edge offset, N = *) +(* 2^{k-l_K}; *) +(* gives the per-scale sum_{k_sigma=k} norm(alpha_sK) <= C1 2^{-k} gg' *) +(* /(1+2^{k-lK})^2. *) +let ALPHA_SCALE_BOUND_ABSTRACT = prove + (`!(A:(int#int#int)->bool) f g B N M. + FINITE A /\ &0 <= B /\ + (!a. a IN A ==> f a <= B * cw(&(g a) + &1 / &2)) /\ + (!a. a IN A ==> g a IN N..M) /\ + (!n. CARD {a | a IN A /\ g a = n} <= 2) + ==> sum A f <= B * &1 / (&1 + &N) pow 2`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum (A:(int#int#int)->bool) + (\a. B * cw(&((g:(int#int#int)->num) a) + &1 / &2))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[SUM_LMUL] THEN + ONCE_REWRITE_TAC[REAL_ARITH `B * &1 / x = B * (&1 / x)`] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC WEIGHT_OFFSET_SUM_BOUND THEN + EXISTS_TAC `M:num` THEN ASM_REWRITE_TAC[]]);; + +(* SEPARATED-SET COUNTING: a set A whose x-values are pairwise >= d apart, *) +(* all *) +(* confined to a half-open window [c, c+d), has at most ONE element. (Two *) +(* distinct *) +(* elements would lie < d apart in the window, contradicting the >= d *) +(* separation.) *) +(* This is the "at most one tile per side of the cover cell K, per offset" *) +(* atom of *) +(* the alpha0/alpha1 <=2-to-1 count: on each side of K the offset pins *) +(* x_sigma to a *) +(* 2^{-k}-window, and the tree centres are 2^{-k}-separated *) +(* (TILE_TREE_SAMESCALE_ *) +(* XMID_INJ). Two such windows (the two sides) give the CARD <= 2 for *) +(* SUM_FIBER_ *) +(* COUNT_2. *) +let carleson_ip = new_definition + `carleson_ip (f:real->complex) (s:int#int#int) = + lproduct (:real^1) (\z. f(drop z)) (\z. phi_sigma s carleson_phi (drop + z))`;; + +(* Every element of a finite set has a maximal element above it, for any *) +(* reflexive transitive relation R (a finite-poset maximal-above lemma; on *) +(* tiles *) +(* R = tile_le). 286J part (a) picks R = minimal witnesses = tile_le-MAXIMAL *) +(* representatives (Fremlin's <=-minimal, our reversed order). Induction on *) +(* the *) +(* finite set; the INSERT step: if the new element a lies R-above the *) +(* recursively- *) +(* found maximal m (and nothing in S is R-above a) then a is the new *) +(* maximal, else *) +(* m stays maximal. NB the relation var R MUST be fully type-annotated in *) +(* every *) +(* ASM_CASES/EXISTS tactic term -- a bare `R m a` invents a polymorphic type *) +(* for R *) +(* and SPEC(EXCLUDED_MIDDLE) then fails "inventing type variables". *) +let TILE_LE_MAXIMAL_ABOVE = prove + (`!(R:(int#int#int)->(int#int#int)->bool) S. + FINITE S /\ (!x. R x x) /\ (!x y z. R x y /\ R y z ==> R x z) + ==> !s. s IN S ==> ?m. m IN S /\ R s m /\ + (!n. n IN S /\ R m n ==> R n m)`, + GEN_TAC THEN GEN_TAC THEN STRIP_TAC THEN + UNDISCH_TAC `FINITE (S:(int#int#int)->bool)` THEN + SPEC_TAC(`S:(int#int#int)->bool`,`S:(int#int#int)->bool`) THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + REWRITE_TAC[NOT_IN_EMPTY] THEN + MAP_EVERY X_GEN_TAC [`a:int#int#int`; `S:(int#int#int)->bool`] THEN + STRIP_TAC THEN + X_GEN_TAC `s:int#int#int` THEN REWRITE_TAC[IN_INSERT] THEN STRIP_TAC THENL + [FIRST_X_ASSUM SUBST_ALL_TAC THEN + ASM_CASES_TAC `?t:int#int#int. t IN S /\ + (R:(int#int#int)->(int#int#int)->bool) a t` THENL + [FIRST_X_ASSUM(X_CHOOSE_THEN `t:int#int#int` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `?m:int#int#int. m IN S /\ R (t:int#int#int) m /\ + (!n. n IN S /\ R m n ==> R n m)` STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + EXISTS_TAC `m:int#int#int` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [ASM_MESON_TAC[]; + X_GEN_TAC `n:int#int#int` THEN + DISCH_THEN(CONJUNCTS_THEN2 DISJ_CASES_TAC ASSUME_TAC) THEN + ASM_MESON_TAC[]]; + EXISTS_TAC `a:int#int#int` THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `n:int#int#int` THEN + DISCH_THEN(CONJUNCTS_THEN2 DISJ_CASES_TAC ASSUME_TAC) THEN + ASM_MESON_TAC[]]; + SUBGOAL_THEN + `?m:int#int#int. m IN S /\ R (s:int#int#int) m /\ + (!n. n IN S /\ R m n ==> R n m)` STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + ASM_CASES_TAC `(R:(int#int#int)->(int#int#int)->bool) m a` THENL + [ASM_CASES_TAC `?u:int#int#int. u IN S /\ + (R:(int#int#int)->(int#int#int)->bool) a u` THENL + [EXISTS_TAC `m:int#int#int` THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `n:int#int#int` THEN + DISCH_THEN(CONJUNCTS_THEN2 DISJ_CASES_TAC ASSUME_TAC) THEN + ASM_MESON_TAC[]; + EXISTS_TAC `a:int#int#int` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [ASM_MESON_TAC[]; + X_GEN_TAC `n:int#int#int` THEN + DISCH_THEN(CONJUNCTS_THEN2 DISJ_CASES_TAC ASSUME_TAC) THEN + ASM_MESON_TAC[]]]; + EXISTS_TAC `m:int#int#int` THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `n:int#int#int` THEN + DISCH_THEN(CONJUNCTS_THEN2 DISJ_CASES_TAC ASSUME_TAC) THEN + ASM_MESON_TAC[]]]);; + +(* 286H mass: mass_{E,h}(P) = sup over sigma in P and tiles tau >= sigma of *) +(* the *) +(* weight w_tau = cw_tile tau integrated over E INTER h^-1[J_tau]. Bounded *) +(* by 1 *) +(* since INT w_tau = 1. *) +let mass_Eh = new_definition + `mass_Eh (E:real->bool) (h:real->real) (P:(int#int#int)->bool) = + sup { real_integral {x | x IN E /\ h x IN tile_J t} (cw_tile t) + | s,t | s IN P /\ tile_le s t }`;; + +(* 286H energy: energy_f(P) = sup over tiles tau of 2^(k_tau/2) times the *) +(* l^2-aggregate sqrt(sum_{sigma in P, sigma <=_r tau} |(f|phi_sigma)|^2) of *) +(* the *) +(* coefficients along the <=_r-tree below tau. (2^(k/2) = sqrt(2 zpow k).) *) +let energy_f = new_definition + `energy_f (f:real->complex) (P:(int#int#int)->bool) = + sup { sqrt(&2 zpow (tile_k t)) * + sqrt(sum {s | s IN P /\ tile_ler s t} (\s. norm(carleson_ip f s) pow + 2)) + | t IN (:int#int#int) }`;; + +(* The integral of the tile weight over ANY set where it is integrable is <= *) +(* 1 (subset monotonicity + CW_TILE_FULL + cw_tile >= 0). *) +let CW_TILE_SUBSET_LE_1 = prove + (`!(s:int#int#int) t. cw_tile s real_integrable_on t + ==> real_integral t (cw_tile s) <= &1`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_SUBSET_LE THEN + MAP_EVERY EXISTS_TAC [`cw_tile s`; `t:real->bool`; `(:real)`] THEN + ASM_SIMP_TAC[SUBSET_UNIV; CW_TILE_FULL; REAL_INTEGRABLE_INTEGRAL] THEN + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`s:int#int#int`; `x:real`] CW_TILE_POS) THEN + REAL_ARITH_TAC);; + +(* 286H: mass_{E,h}(P) <= 1. Each term INT_{E cap h^-1[J_tau]} w_tau <= *) +(* INT_R *) +(* w_tau = 1; the sup of a nonempty set bounded by 1 is <= 1. The *) +(* nonemptiness *) +(* (P nonempty, via tile_le reflexivity) and per-tile integrability are the *) +(* explicit hypotheses that the 286I caller supplies (E measurable, P *) +(* finite). *) +let MASS_LE_1 = prove + (`!(E:real->bool) (h:real->real) (P:(int#int#int)->bool). + ~(P = {}) /\ + (!t. cw_tile t real_integrable_on {x | x IN E /\ h x IN tile_J t}) + ==> mass_Eh E h P <= &1`, + REPEAT STRIP_TAC THEN REWRITE_TAC[mass_Eh] THEN + MATCH_MP_TAC REAL_SUP_LE THEN CONJ_TAC THENL + [REWRITE_TAC[EXTENSION; NOT_FORALL_THM; IN_ELIM_THM; NOT_IN_EMPTY] THEN + FIRST_X_ASSUM(X_CHOOSE_TAC `s0:int#int#int` o + REWRITE_RULE[GSYM MEMBER_NOT_EMPTY]) THEN + MAP_EVERY EXISTS_TAC + [`real_integral {x | x IN E /\ h x IN tile_J s0} (cw_tile s0)`] THEN + MAP_EVERY EXISTS_TAC [`s0:int#int#int`; `s0:int#int#int`] THEN + ASM_REWRITE_TAC[TILE_LE_REFL]; + REWRITE_TAC[FORALL_IN_GSPEC] THEN + MAP_EVERY X_GEN_TAC [`s:int#int#int`; `t:int#int#int`] THEN + STRIP_TAC THEN MATCH_MP_TAC CW_TILE_SUBSET_LE_1 THEN ASM_REWRITE_TAC[]]);; + +(* 286H: mass is MONOTONE in the tile set. P' SUBSET P ==> mass P' <= mass *) +(* P. *) +(* The P'-value-set is a subset of the P-value-set (same terms, fewer *) +(* sigma); *) +(* REAL_SUP_LE_SUBSET with nonemptiness (tile_le refl) and the bound 1 *) +(* above. *) +let MASS_MONO = prove + (`!(E:real->bool) h (P:(int#int#int)->bool) P'. + P' SUBSET P /\ ~(P' = {}) /\ + (!t. cw_tile t real_integrable_on {x | x IN E /\ h x IN tile_J t}) + ==> mass_Eh E h P' <= mass_Eh E h P`, + REPEAT STRIP_TAC THEN REWRITE_TAC[mass_Eh] THEN + MATCH_MP_TAC REAL_SUP_LE_SUBSET THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + FIRST_X_ASSUM(X_CHOOSE_TAC `s0:int#int#int` o REWRITE_RULE[GSYM + MEMBER_NOT_EMPTY]) THEN + EXISTS_TAC `real_integral {x | x IN E /\ h x IN tile_J s0} (cw_tile s0)` + THEN + REWRITE_TAC[IN_ELIM_THM] THEN + MAP_EVERY EXISTS_TAC [`s0:int#int#int`; `s0:int#int#int`] THEN + ASM_REWRITE_TAC[TILE_LE_REFL]; + REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN + MAP_EVERY X_GEN_TAC [`s:int#int#int`; `t:int#int#int`] THEN STRIP_TAC THEN + REWRITE_TAC[IN_ELIM_THM] THEN + MAP_EVERY EXISTS_TAC [`s:int#int#int`; `t:int#int#int`] THEN + ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; + EXISTS_TAC `&1` THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN + MAP_EVERY X_GEN_TAC [`s:int#int#int`; `t:int#int#int`] THEN STRIP_TAC THEN + MATCH_MP_TAC CW_TILE_SUBSET_LE_1 THEN ASM_REWRITE_TAC[]]);; + +(* 286J part (a) core: mass_Eh E h S <= c whenever EVERY qualifying *) +(* single-tile *) +(* integral (over the tile_le-cone above some s in S) is <= c. Direct *) +(* REAL_SUP_LE *) +(* on the mass_Eh sup (index nonempty since S nonempty: t := s, *) +(* TILE_LE_REFL). In *) +(* 286J this turns the Vitali conclusion "P\R+ SUBSET {sigma : *) +(* mass({sigma})<=gam/4}" *) +(* into mass_Eh(P\R+) <= gam/4. *) +let MASS_EH_LE = prove + (`!(E:real->bool) h (S:(int#int#int)->bool) c. + ~(S = {}) /\ + (!s t. s IN S /\ tile_le s t + ==> real_integral {x | x IN E /\ h x IN tile_J t} (cw_tile t) <= c) + ==> mass_Eh E h S <= c`, + REPEAT STRIP_TAC THEN REWRITE_TAC[mass_Eh] THEN + MATCH_MP_TAC REAL_SUP_LE THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + FIRST_X_ASSUM(X_CHOOSE_TAC `s0:int#int#int` o REWRITE_RULE[GSYM + MEMBER_NOT_EMPTY]) THEN + EXISTS_TAC `real_integral {x | x IN E /\ h x IN tile_J s0} (cw_tile s0)` + THEN + REWRITE_TAC[IN_ELIM_THM] THEN + MAP_EVERY EXISTS_TAC [`s0:int#int#int`; `s0:int#int#int`] THEN + ASM_REWRITE_TAC[TILE_LE_REFL]; + REWRITE_TAC[IN_ELIM_THM] THEN + X_GEN_TAC `y:real` THEN + DISCH_THEN(REPEAT_TCL CHOOSE_THEN + (CONJUNCTS_THEN2 STRIP_ASSUME_TAC SUBST1_TAC)) THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN EXISTS_TAC `s:int#int#int` THEN + ASM_REWRITE_TAC[]]);; + +(* 286J part (a) witness: mass_Eh{sigma} > c ==> some tile t >= sigma has *) +(* int_{E cap h^-1[J_t]} w_t > c. SUP_APPROACH on the mass_Eh{sigma} sup *) +(* (nonempty t:=sigma; bounded by 1 via CW_TILE_SUBSET_LE_1). Picks *) +(* Fremlin's *) +(* witnessing tile sigma' for each large-single-mass sigma in the *) +(* R-selection. *) +let MASS_EH_WITNESS = prove + (`!(E:real->bool) h sigma c. + (!t. cw_tile t real_integrable_on {x | x IN E /\ h x IN tile_J t}) /\ + c < mass_Eh E h {sigma} + ==> ?t. tile_le sigma t /\ + c < real_integral {x | x IN E /\ h x IN tile_J t} (cw_tile t)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`{ real_integral {x | x IN E /\ h x IN tile_J t} (cw_tile t) + | s,t | s IN {sigma:int#int#int} /\ tile_le s t }`; `c:real`] + SUP_APPROACH) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + EXISTS_TAC `real_integral {x | x IN E /\ h x IN tile_J sigma} (cw_tile + sigma)` THEN + MAP_EVERY EXISTS_TAC [`sigma:int#int#int`; `sigma:int#int#int`] THEN + REWRITE_TAC[IN_SING; TILE_LE_REFL]; + EXISTS_TAC `&1` THEN REWRITE_TAC[FORALL_IN_GSPEC; IN_SING] THEN + MAP_EVERY X_GEN_TAC [`s:int#int#int`; `t:int#int#int`] THEN + STRIP_TAC THEN + MATCH_MP_TAC CW_TILE_SUBSET_LE_1 THEN ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[GSYM mass_Eh]]; + REWRITE_TAC[IN_ELIM_THM; IN_SING] THEN + DISCH_THEN(X_CHOOSE_THEN `v:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `t:int#int#int` THEN CONJ_TAC THENL + [ASM_MESON_TAC[]; + FIRST_X_ASSUM(fun th -> SUBST1_TAC(SYM th)) THEN ASM_REWRITE_TAC[]]]);; + +(* 286H mass, single-term lower bound: for sigma in P, the tile-weight *) +(* integral *) +(* over E cap h^-1[J_sigma] is <= mass_Eh E h P. The (s,t) = (sigma,sigma) *) +(* term *) +(* of the mass sup (tile_le reflexive); upper bound 1 via *) +(* CW_TILE_SUBSET_LE_1. *) +(* This is how the mass factor gamma' enters the 286L(c-i) kernel estimate. *) +let MASS_TERM_LE = prove + (`!(E:real->bool) h (P:(int#int#int)->bool) sigma. + sigma IN P /\ + (!t. cw_tile t real_integrable_on {x | x IN E /\ h x IN tile_J t}) + ==> real_integral {x | x IN E /\ h x IN tile_J sigma} (cw_tile sigma) + <= mass_Eh E h P`, + REPEAT STRIP_TAC THEN REWRITE_TAC[mass_Eh] THEN + MATCH_MP_TAC REAL_LE_SUP THEN + MAP_EVERY EXISTS_TAC + [`&1`; + `real_integral {x | x IN E /\ h x IN tile_J sigma} (cw_tile sigma)`] THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[IN_ELIM_THM] THEN + MAP_EVERY EXISTS_TAC [`sigma:int#int#int`; `sigma:int#int#int`] THEN + ASM_REWRITE_TAC[TILE_LE_REFL]; + REWRITE_TAC[REAL_LE_REFL]; + REWRITE_TAC[FORALL_IN_GSPEC] THEN + MAP_EVERY X_GEN_TAC [`s:int#int#int`; `t:int#int#int`] THEN STRIP_TAC THEN + MATCH_MP_TAC CW_TILE_SUBSET_LE_1 THEN ASM_REWRITE_TAC[]]);; + +(* Generalisation of MASS_TERM_LE to any ups ABOVE a P-element (Fremlin mass *) +(* sup is over sigma in P, tau <= sigma -- my tile_le sigma ups, the *) +(* (s,t)=(sigma,ups) term). This is the gamma' bound int_{E cap g^-1[J_ups]} *) +(* w_ups <= mass_Eh used in 286L(e). *) +let MASS_TERM_LE_GEN = prove + (`!(E:real->bool) h (P:(int#int#int)->bool) sigma ups. + sigma IN P /\ tile_le sigma ups /\ + (!t. cw_tile t real_integrable_on {x | x IN E /\ h x IN tile_J t}) + ==> real_integral {x | x IN E /\ h x IN tile_J ups} (cw_tile ups) + <= mass_Eh E h P`, + REPEAT STRIP_TAC THEN REWRITE_TAC[mass_Eh] THEN + MATCH_MP_TAC REAL_LE_SUP THEN + MAP_EVERY EXISTS_TAC + [`&1`; + `real_integral {x | x IN E /\ h x IN tile_J ups} (cw_tile ups)`] THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[IN_ELIM_THM] THEN + MAP_EVERY EXISTS_TAC [`sigma:int#int#int`; `ups:int#int#int`] THEN + ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_LE_REFL]; + REWRITE_TAC[FORALL_IN_GSPEC] THEN + MAP_EVERY X_GEN_TAC [`s:int#int#int`; `t:int#int#int`] THEN STRIP_TAC THEN + MATCH_MP_TAC CW_TILE_SUBSET_LE_1 THEN ASM_REWRITE_TAC[]]);; + +(* 286L(c-i) step 2: split w_sigma^2 = w_sigma * w_sigma, bound ONE factor *) +(* by its *) +(* upper bound Mw on S (= sup_K w_sigma later), integrate the other. So *) +(* int_S w_sigma^2 <= Mw int_S w_sigma. Pure integral monotonicity (cw_tile *) +(* > 0 *) +(* by CW_TILE_POS, so w^2 = w*w <= Mw*w pointwise) + REAL_INTEGRAL_LMUL. *) +let CWTILE_SQ_INT_LE = prove + (`!(sigma:int#int#int) S Mw. + cw_tile sigma real_integrable_on S /\ + (\x. (cw_tile sigma x) pow 2) real_integrable_on S /\ + (!x. x IN S ==> cw_tile sigma x <= Mw) + ==> real_integral S (\x. (cw_tile sigma x) pow 2) + <= Mw * real_integral S (cw_tile sigma)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `real_integral S (\x. Mw * cw_tile (sigma:int#int#int) x)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_LE THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_LMUL THEN ASM_REWRITE_TAC[ETA_AX]; + X_GEN_TAC `x:real` THEN DISCH_TAC THEN + MP_TAC(SPECL [`sigma:int#int#int`; `x:real`] CW_TILE_POS) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real`) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[REAL_POW_2] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_RMUL THEN ASM_REAL_ARITH_TAC]; + MATCH_MP_TAC REAL_EQ_IMP_LE THEN + MATCH_MP_TAC REAL_INTEGRAL_LMUL THEN ASM_REWRITE_TAC[]]);; + +(* The inner energy sum over a SINGLETON tile set collapses: sum over *) +(* {s | s IN {sigma} /\ sigma <=_r t} is |(f|phi_sigma)|^2 if sigma <=_r t, *) +(* else 0 (empty index set). *) +let ENERGY_SING_SUM = prove + (`!(f:real->complex) sigma t. + sum {s | s IN {sigma} /\ tile_ler s t} (\s. norm(carleson_ip f s) pow 2) = + (if tile_ler sigma t then norm(carleson_ip f sigma) pow 2 else &0)`, + REPEAT GEN_TAC THEN COND_CASES_TAC THENL + [SUBGOAL_THEN + `{s | s IN {sigma} /\ tile_ler s t} = {sigma}` SUBST1_TAC THENL + [ASM_REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_SING] THEN GEN_TAC THEN + EQ_TAC THENL + [SIMP_TAC[]; ASM_MESON_TAC[]]; ALL_TAC] THEN REWRITE_TAC[SUM_SING]; + SUBGOAL_THEN `{s | s IN {sigma} /\ tile_ler s t} = {}` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_SING; NOT_IN_EMPTY] THEN + X_GEN_TAC `u:int#int#int` THEN ASM_CASES_TAC `u:int#int#int = sigma` THEN + ASM_REWRITE_TAC[]; REWRITE_TAC[SUM_CLAUSES]]]);; + +(* 286H: energy of a SINGLETON. energy_f({sigma}) = *) +(* 2^(k_sigma/2)|(f|phi_sigma)|. *) +(* The sup over tiles t is attained at t = sigma: for sigma <=_r t we have *) +(* k_t <= k_sigma (TILE_LER_SCALE) so sqrt(2^k_t) <= sqrt(2^k_sigma); and *) +(* the *) +(* t = sigma term realises the bound (TILE_LER_REFL). *) +let ENERGY_SING = prove + (`!(f:real->complex) sigma. + energy_f f {sigma} = sqrt(&2 zpow (tile_k sigma)) * norm(carleson_ip f + sigma)`, + REPEAT GEN_TAC THEN REWRITE_TAC[energy_f; ENERGY_SING_SUM] THEN + MATCH_MP_TAC REAL_SUP_UNIQUE THEN CONJ_TAC THENL + [REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN X_GEN_TAC `t:int#int#int` THEN + COND_CASES_TAC THENL + [REWRITE_TAC[POW_2_SQRT_ABS; REAL_ABS_NORM] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN + MATCH_MP_TAC SQRT_MONO_LE THEN MATCH_MP_TAC ZPOW2_MONOE THEN + MATCH_MP_TAC TILE_LER_SCALE THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[SQRT_0; REAL_MUL_RZERO] THEN + MATCH_MP_TAC REAL_LE_MUL THEN + REWRITE_TAC[NORM_POS_LE] THEN MATCH_MP_TAC SQRT_POS_LE THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN MATCH_MP_TAC REAL_ZPOW_LT THEN + REAL_ARITH_TAC]; + X_GEN_TAC `b':real` THEN DISCH_TAC THEN + EXISTS_TAC `sqrt(&2 zpow (tile_k sigma)) * norm(carleson_ip f sigma)` THEN + ASM_REWRITE_TAC[IN_ELIM_THM] THEN + EXISTS_TAC `sigma:int#int#int` THEN + REWRITE_TAC[IN_UNIV; TILE_LER_REFL; POW_2_SQRT_ABS; REAL_ABS_NORM]]);; + +(* ------------------------------------------------------------------------- *) +(* Energy finiteness and the per-coefficient bound (used throughout 286K/L). *) +(* The energy value E(t) = 2^(k_t/2) sqrt(sum_{s in P, s <=_r t} *) +(* |(f|phi_s)|^2) *) +(* is uniformly bounded by sqrt(sum_{s in P} 2^k_s |(f|phi_s)|^2) (since *) +(* s <=_r t forces k_t <= k_s), so energy_f is a genuine finite sup; and *) +(* each *) +(* single coefficient obeys 2^(k_sigma/2) |(f|phi_sigma)| <= energy_f(P). *) +(* ------------------------------------------------------------------------- *) + +(* The core term estimate: 2^k_t sum_{s<=_r t} c_s <= sum_{s in P} 2^k_s *) +(* c_s. *) +let ENERGY_TERM_BOUND = prove + (`!(f:real->complex) (P:(int#int#int)->bool) (t:int#int#int). FINITE P + ==> (&2 zpow (tile_k t)) * sum {s | s IN P /\ tile_ler s t} (\s. + norm(carleson_ip f s) pow 2) + <= sum P (\s. (&2 zpow (tile_k s)) * norm(carleson_ip f s) pow 2)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM SUM_LMUL] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum {s | s IN P /\ tile_ler s t} (\s. (&2 zpow (tile_k s)) * + norm(carleson_ip f s) pow 2)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE THEN ASM_SIMP_TAC[FINITE_RESTRICT; IN_ELIM_THM] THEN + X_GEN_TAC `s:int#int#int` THEN STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_LE_POW_2] THEN + MATCH_MP_TAC ZPOW2_MONOE THEN MATCH_MP_TAC TILE_LER_SCALE THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN MESON_TAC[]; + X_GEN_TAC `s:int#int#int` THEN REWRITE_TAC[IN_DIFF; IN_ELIM_THM] THEN + STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_LE_POW_2] THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN MATCH_MP_TAC REAL_ZPOW_LT THEN + REAL_ARITH_TAC]]);; + +(* energy_f is finite: bounded by sqrt(sum_{s in P} 2^k_s |(f|phi_s)|^2). *) +let ENERGY_LE = prove + (`!(f:real->complex) (P:(int#int#int)->bool). FINITE P + ==> energy_f f P <= sqrt(sum P (\s. (&2 zpow (tile_k s)) * + norm(carleson_ip f s) pow 2))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[energy_f] THEN + MATCH_MP_TAC REAL_SUP_LE THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + EXISTS_TAC `sqrt(&2 zpow (tile_k (ARB:int#int#int))) * + sqrt(sum {s | s IN P /\ tile_ler s ARB} (\s. norm(carleson_ip f + s) pow 2))` THEN + REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `ARB:int#int#int` THEN + REWRITE_TAC[IN_UNIV]; + REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN X_GEN_TAC `t:int#int#int` THEN + SUBGOAL_THEN + `sqrt(&2 zpow (tile_k t)) * + sqrt(sum {s | s IN P /\ tile_ler s t} (\s. norm(carleson_ip f s) pow 2)) + = + sqrt((&2 zpow (tile_k t)) * + sum {s | s IN P /\ tile_ler s t} (\s. norm(carleson_ip f s) pow 2))` + SUBST1_TAC THENL + [REWRITE_TAC[GSYM SQRT_MUL]; ALL_TAC] THEN + MATCH_MP_TAC SQRT_MONO_LE THEN ASM_SIMP_TAC[ENERGY_TERM_BOUND]]);; + +(* energy_f is NONNEGATIVE (a sup of nonneg terms sqrt(..)*sqrt(sum of *) +(* squares) over the nonempty universe of tiles; bounded above via *) +(* ENERGY_TERM_BOUND). *) +let ENERGY_F_POS = prove + (`!(f:real->complex) (P:(int#int#int)->bool). FINITE P ==> &0 <= energy_f f + P`, + REPEAT STRIP_TAC THEN REWRITE_TAC[energy_f] THEN + MATCH_MP_TAC REAL_LE_SUP THEN + EXISTS_TAC `sqrt(sum P (\s. (&2 zpow (tile_k s)) * norm(carleson_ip f s) pow + 2))` THEN + EXISTS_TAC `sqrt(&2 zpow (tile_k (ARB:int#int#int))) * + sqrt(sum {s | s IN P /\ tile_ler s ARB} (\s. norm(carleson_ip f + s) pow 2))` THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `ARB:int#int#int` THEN + REWRITE_TAC[IN_UNIV]; + MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THEN MATCH_MP_TAC SQRT_POS_LE THENL + [MATCH_MP_TAC REAL_LT_IMP_LE THEN MATCH_MP_TAC REAL_ZPOW_LT THEN + REAL_ARITH_TAC; + MATCH_MP_TAC SUM_POS_LE THEN SIMP_TAC[FINITE_RESTRICT] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_LE_POW_2]]; + REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN X_GEN_TAC `t:int#int#int` THEN + SUBGOAL_THEN + `sqrt(&2 zpow (tile_k t)) * + sqrt(sum {s | s IN P /\ tile_ler s t} (\s. norm(carleson_ip f s) pow 2)) + = + sqrt((&2 zpow (tile_k t)) * + sum {s | s IN P /\ tile_ler s t} (\s. norm(carleson_ip f s) pow 2))` + SUBST1_TAC THENL + [REWRITE_TAC[GSYM SQRT_MUL]; ALL_TAC] THEN + MATCH_MP_TAC SQRT_MONO_LE THEN ASM_SIMP_TAC[ENERGY_TERM_BOUND]]);; + +(* 286H single-tile energy bound: for sigma in P, sqrt(2^{k_sigma}) *) +(* |(f|phi_sigma)| <= *) +(* energy_f f P (i.e. |(f|phi_sigma)| <= sqrt(mu I_sigma) gamma). The energy *) +(* sup at *) +(* t = sigma: the tile-set {s | tile_ler s sigma} contains sigma *) +(* (TILE_LER_REFL), so *) +(* sum |ip|^2 >= |ip_sigma|^2; the sup is bounded above by ENERGY_TERM_BOUND *) +(* as usual. *) +(* This is the gamma-input to the alpha2 v2 pointwise bound (286L f-iii). *) +let ENERGY_IP_BOUND = prove + (`!(f:real->complex) (P:(int#int#int)->bool) sigma. + FINITE P /\ sigma IN P + ==> sqrt(&2 zpow (tile_k sigma)) * norm(carleson_ip f sigma) <= energy_f f + P`, + REPEAT STRIP_TAC THEN REWRITE_TAC[energy_f] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sqrt(&2 zpow (tile_k sigma)) * + sqrt(sum {s | s IN P /\ tile_ler s sigma} (\s. norm(carleson_ip f + s) pow 2))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC SQRT_POS_LE THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN + MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `norm(carleson_ip (f:real->complex) sigma) = + sqrt(norm(carleson_ip f sigma) pow 2)` SUBST1_TAC THENL + [REWRITE_TAC[POW_2_SQRT_ABS; REAL_ABS_NORM]; ALL_TAC] THEN + MATCH_MP_TAC SQRT_MONO_LE THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum {sigma:int#int#int} (\s. norm(carleson_ip f s) pow 2)` THEN + CONJ_TAC THENL + [REWRITE_TAC[SUM_SING; REAL_LE_REFL]; + MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN + ASM_SIMP_TAC[FINITE_RESTRICT] THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET; IN_SING; IN_ELIM_THM] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[TILE_LER_REFL]; + REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_LE_POW_2]]]; + MATCH_MP_TAC REAL_LE_SUP THEN + EXISTS_TAC `sqrt(sum P (\s. (&2 zpow (tile_k s)) * norm(carleson_ip + (f:real->complex) s) pow 2))` THEN + EXISTS_TAC `sqrt(&2 zpow (tile_k sigma)) * + sqrt(sum {s | s IN P /\ tile_ler s sigma} (\s. norm(carleson_ip + (f:real->complex) s) pow 2))` THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `sigma:int#int#int` THEN + REWRITE_TAC[IN_UNIV]; + REWRITE_TAC[REAL_LE_REFL]; + REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN X_GEN_TAC `t:int#int#int` THEN + SUBGOAL_THEN + `sqrt(&2 zpow (tile_k t)) * + sqrt(sum {s | s IN P /\ tile_ler s t} (\s. norm(carleson_ip + (f:real->complex) s) pow 2)) = + sqrt((&2 zpow (tile_k t)) * + sum {s | s IN P /\ tile_ler s t} (\s. norm(carleson_ip f s) pow + 2))` + SUBST1_TAC THENL + [REWRITE_TAC[GSYM SQRT_MUL]; ALL_TAC] THEN + MATCH_MP_TAC SQRT_MONO_LE THEN ASM_SIMP_TAC[ENERGY_TERM_BOUND]]]);; + +(* 286M part (b) residual-vanishing: on a zero-energy tile set every *) +(* carleson *) +(* coefficient vanishes (ENERGY_IP_BOUND + sqrt(2^k)>0), hence any *) +(* correlation *) +(* sum vanishes. This kills the INTER_n P_n tail in the 286M iteration *) +(* (Fremlin *) +(* 1832: =0 for sigma in INTER P_n as energy(P_n) -> 0). *) +let MASS_EH_POS = prove + (`!(E:real->bool) (h:real->real) (P:(int#int#int)->bool). + ~(P = {}) /\ + (!t. cw_tile t real_integrable_on {x | x IN E /\ h x IN tile_J t}) + ==> &0 <= mass_Eh E h P`, + REPEAT STRIP_TAC THEN REWRITE_TAC[mass_Eh] THEN MATCH_MP_TAC REAL_LE_SUP THEN + FIRST_X_ASSUM(X_CHOOSE_TAC `s0:int#int#int` o REWRITE_RULE[GSYM + MEMBER_NOT_EMPTY]) THEN + EXISTS_TAC `&1` THEN + EXISTS_TAC `real_integral {x | x IN E /\ h x IN tile_J s0} (cw_tile s0)` THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[IN_ELIM_THM] THEN + MAP_EVERY EXISTS_TAC [`s0:int#int#int`; `s0:int#int#int`] THEN + ASM_REWRITE_TAC[TILE_LE_REFL]; + MATCH_MP_TAC REAL_INTEGRAL_POS THEN ASM_SIMP_TAC[] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN + REWRITE_TAC[CW_TILE_POS]; + REWRITE_TAC[FORALL_IN_GSPEC] THEN + MAP_EVERY X_GEN_TAC [`s:int#int#int`; `t:int#int#int`] THEN STRIP_TAC THEN + MATCH_MP_TAC CW_TILE_SUBSET_LE_1 THEN ASM_REWRITE_TAC[]]);; + + +(* 286H/286L(c-i): 2^(k_sigma/2) |(f|phi_sigma)| <= energy_f(P) for sigma in *) +(* P. *) +let COEFF_LE_ENERGY = prove + (`!(f:real->complex) (P:(int#int#int)->bool) (sigma:int#int#int). FINITE P /\ + sigma IN P + ==> sqrt(&2 zpow (tile_k sigma)) * norm(carleson_ip f sigma) <= energy_f f + P`, + REPEAT STRIP_TAC THEN REWRITE_TAC[energy_f] THEN + MATCH_MP_TAC REAL_LE_SUP THEN + EXISTS_TAC `sqrt(sum P (\s. (&2 zpow (tile_k s)) * norm(carleson_ip f s) pow + 2))` THEN + EXISTS_TAC `sqrt(&2 zpow (tile_k sigma)) * + sqrt(sum {s | s IN P /\ tile_ler s sigma} (\s. norm(carleson_ip f + s) pow 2))` THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `sigma:int#int#int` THEN + REWRITE_TAC[IN_UNIV]; + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC SQRT_POS_LE THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN + MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_RSQRT THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum {sigma:int#int#int} (\s. norm(carleson_ip f s) pow 2)` THEN + CONJ_TAC THENL + [REWRITE_TAC[SUM_SING; REAL_LE_REFL]; + MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN + ASM_SIMP_TAC[FINITE_RESTRICT; FINITE_SING] THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET; IN_SING; IN_ELIM_THM] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[TILE_LER_REFL]; + REWRITE_TAC[IN_DIFF; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[REAL_LE_POW_2]]]; + REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN X_GEN_TAC `t:int#int#int` THEN + SUBGOAL_THEN + `sqrt(&2 zpow (tile_k t)) * + sqrt(sum {s | s IN P /\ tile_ler s t} (\s. norm(carleson_ip f s) pow 2)) + = + sqrt((&2 zpow (tile_k t)) * + sum {s | s IN P /\ tile_ler s t} (\s. norm(carleson_ip f s) pow 2))` + SUBST1_TAC THENL + [REWRITE_TAC[GSYM SQRT_MUL]; ALL_TAC] THEN + MATCH_MP_TAC SQRT_MONO_LE THEN ASM_SIMP_TAC[ENERGY_TERM_BOUND]]);; + +(* 286L(c-i) form: |(f|phi_sigma)| <= 2^(-k_sigma/2) energy_f(P) (dividing *) +(* COEFF_LE_ENERGY through by the positive sqrt(2^k_sigma)). *) +let COEFF_LE_ENERGY_HALF = prove + (`!(f:real->complex) (P:(int#int#int)->bool) (sigma:int#int#int). FINITE P /\ + sigma IN P + ==> norm(carleson_ip f sigma) <= inv(sqrt(&2 zpow (tile_k sigma))) * + energy_f f P`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&0 < sqrt(&2 zpow (tile_k sigma))` ASSUME_TAC THENL + [MATCH_MP_TAC SQRT_POS_LT THEN MATCH_MP_TAC REAL_ZPOW_LT THEN + REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(SPECL [`f:real->complex`; `P:(int#int#int)->bool`; + `sigma:int#int#int`] COEFF_LE_ENERGY) THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `inv(sqrt(&2 zpow (tile_k sigma))) * energy_f f P = + energy_f f P / sqrt(&2 zpow (tile_k sigma))` SUBST1_TAC THENL + [REWRITE_TAC[real_div] THEN REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ] THEN REWRITE_TAC[REAL_MUL_SYM]);; + +(* sqrt(2^k) sqrt(2^-k) = 1 (the tile mass/scale cancellation, muI_tau *) +(* muJ_tau=1 *) +(* under the root). Recurs in the 286K H_j coefficient bound. *) +let SQRT_ZPOW_NEG_MUL = prove + (`!k:int. sqrt(&2 zpow k) * sqrt(&2 zpow (--k)) = &1`, + GEN_TAC THEN + SUBGOAL_THEN `&2 zpow (--k) = inv(&2 zpow k)` SUBST1_TAC THENL + [REWRITE_TAC[REAL_ZPOW_NEG]; ALL_TAC] THEN + SUBGOAL_THEN `&0 < &2 zpow k` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[GSYM SQRT_INV; GSYM SQRT_MUL; REAL_MUL_RINV; REAL_LT_IMP_NZ; + SQRT_1]);; + +(* 286Gc->286Gg arithmetic reshape: given the midpoint-integral bound *) +(* W*2^(-kt) *) +(* <= INT (286Gc with W = w_sigma(x_tau), muI_tau = 2^(-kt), INT = *) +(* int_{I_tau} *) +(* w_sigma) and W >= 0, upgrade inv(sqrt 2^kt)*W <= sqrt(2^kt)*INT. (LHS = *) +(* sqrt(muI_tau) W; RHS = sqrt(muJ_tau) INT.) Cancel sqrt(2^kt)>0 *) +(* [REAL_LE_LCANCEL_ *) +(* IMP]: sqrt*sqrt = 2^kt [SQRT_POW_2], sqrt*inv sqrt = 1, and *) +(* 2^kt*(W*2^-kt) = W *) +(* [2^kt 2^-kt = 1, INT_ADD_RINV] <= 2^kt*INT [REAL_LE_LMUL]. *) +let GG_RESHAPE = prove + (`!kt W INT:real. &0 <= W /\ W * &2 zpow (--kt) <= INT + ==> inv(sqrt(&2 zpow kt)) * W <= sqrt(&2 zpow kt) * INT`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&0 < &2 zpow kt` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `&0 < sqrt(&2 zpow kt)` ASSUME_TAC THENL + [MATCH_MP_TAC SQRT_POS_LT THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `sqrt(&2 zpow kt) * sqrt(&2 zpow kt) = &2 zpow kt` ASSUME_TAC THENL + [MP_TAC(SPEC `&2 zpow kt` SQRT_POW_2) THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_POW_2]; + ALL_TAC] THEN + SUBGOAL_THEN `&2 zpow kt * &2 zpow (--kt) = &1` ASSUME_TAC THENL + [SIMP_TAC[GSYM REAL_ZPOW_ADD; REAL_ARITH `~(&2 = &0)`] THEN + REWRITE_TAC[INT_ADD_RINV; REAL_ZPOW_0]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN EXISTS_TAC `sqrt(&2 zpow kt)` THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `sqrt(&2 zpow kt) * inv(sqrt(&2 zpow kt)) * W = W` SUBST1_TAC THENL + [SUBGOAL_THEN `~(sqrt(&2 zpow kt) = &0)` MP_TAC THENL + [ASM_REAL_ARITH_TAC; CONV_TAC REAL_FIELD]; ALL_TAC] THEN + SUBGOAL_THEN + `sqrt(&2 zpow kt) * sqrt(&2 zpow kt) * INT = + &2 zpow kt * INT` SUBST1_TAC THENL + [ASM_REWRITE_TAC[REAL_MUL_ASSOC]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&2 zpow kt * (W * &2 zpow (--kt))` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_EQ_IMP_LE THEN + MP_TAC(ASSUME `&2 zpow kt * &2 zpow (--kt) = &1`) THEN CONV_TAC REAL_RING; + MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE]]);; + +(* 286K H_j coefficient bound: for tau in P with energy_f f P <= gam, *) +(* norm(f|phi_tau) <= gam sqrt(2^(-k_tau)) = gam sqrt(muI_tau). *) +(* From COEFF_LE_ENERGY (sqrt(2^k) norm <= energy <= gam) x sqrt(2^-k) >= 0, *) +(* using *) +(* sqrt(2^k) sqrt(2^-k) = 1 (SQRT_ZPOW_NEG_MUL). This is Fremlin's *) +(* || *) +(* <= gam sqrt(muI_tau) used termwise inside the H_j Cauchy-Schwarz *) +(* estimate. *) +let COEFF_LE_ENERGY_MASS = prove + (`!(f:real->complex) (P:(int#int#int)->bool) tau gam. + FINITE P /\ tau IN P /\ energy_f f P <= gam + ==> norm(carleson_ip f tau) <= gam * sqrt(&2 zpow (--(tile_k tau)))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `sqrt(&2 zpow (tile_k tau)) * norm(carleson_ip f tau) <= gam` + ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `energy_f (f:real->complex) P` THEN + ASM_SIMP_TAC[COEFF_LE_ENERGY]; ALL_TAC] THEN + MP_TAC(ISPECL [`sqrt(&2 zpow (--(tile_k tau)))`; + `sqrt(&2 zpow (tile_k tau)) * norm(carleson_ip f tau)`; + `gam:real`] REAL_LE_LMUL) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC SQRT_POS_LE THEN MATCH_MP_TAC REAL_ZPOW_LE THEN + REAL_ARITH_TAC; + ASM_REWRITE_TAC[]]; + MATCH_MP_TAC(REAL_ARITH + `a = n /\ b = g * m ==> a <= b ==> n <= g * m`) THEN + CONJ_TAC THENL + [REWRITE_TAC[REAL_MUL_ASSOC] THEN + GEN_REWRITE_TAC (RAND_CONV) [GSYM REAL_MUL_LID] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[SQRT_ZPOW_NEG_MUL]; + REWRITE_TAC[REAL_MUL_AC]]]);; + +(* Any single energy value E_P(t) is below the energy sup (the 286H energy *) +(* is attained/dominated at every tile), and energy is MONOTONE under P *) +(* subset Q (the <=_r-trees only grow) -- the energy analog of MASS_MONO. *) +let ENERGY_TERM_LE_SELF = prove + (`!(f:real->complex) (P:(int#int#int)->bool) (t:int#int#int). FINITE P + ==> sqrt(&2 zpow (tile_k t)) * + sqrt(sum {s | s IN P /\ tile_ler s t} (\s. norm(carleson_ip f s) pow + 2)) + <= energy_f f P`, + REPEAT STRIP_TAC THEN REWRITE_TAC[energy_f] THEN + MATCH_MP_TAC REAL_LE_SUP THEN + EXISTS_TAC `sqrt(sum P (\s. (&2 zpow (tile_k s)) * norm(carleson_ip f s) pow + 2))` THEN + EXISTS_TAC `sqrt(&2 zpow (tile_k t)) * + sqrt(sum {s | s IN P /\ tile_ler s t} (\s. norm(carleson_ip f s) + pow 2))` THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `t:int#int#int` THEN + REWRITE_TAC[IN_UNIV]; + REWRITE_TAC[REAL_LE_REFL]; + REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN X_GEN_TAC `u:int#int#int` THEN + SUBGOAL_THEN + `sqrt(&2 zpow (tile_k u)) * + sqrt(sum {s | s IN P /\ tile_ler s u} (\s. norm(carleson_ip f s) pow 2)) + = + sqrt((&2 zpow (tile_k u)) * + sum {s | s IN P /\ tile_ler s u} (\s. norm(carleson_ip f s) pow 2))` + SUBST1_TAC THENL + [REWRITE_TAC[GSYM SQRT_MUL]; ALL_TAC] THEN + MATCH_MP_TAC SQRT_MONO_LE THEN ASM_SIMP_TAC[ENERGY_TERM_BOUND]]);; + +(* Arithmetic helper: from c > 0 and c D <= E, conclude D <= E / c (as E * *) +(* inv c). *) +let LE_INV_MUL_FROM_MUL = prove + (`!c D E. &0 < c /\ c * D <= E ==> D <= E * inv c`, + REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_INV] THEN + ASM_SIMP_TAC[GSYM real_div; REAL_LE_RDIV_EQ; REAL_LT_INV_EQ; + REAL_INV_INV] THEN + ASM_REWRITE_TAC[REAL_INV_INV] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ASM_REWRITE_TAC[]);; + +(* 286L(g) ENERGY STEP: for the tree P' = {s IN P : s <=_r tau}, the sum of *) +(* squared coefficients is bounded by energy^2 . 2^{-k_tau}. This is the *) +(* energy *) +(* input to the alpha3 Gram bound ||g~||_2^2 <= C3 gamma^2 2^{-k_tau}. *) +(* Square the *) +(* energy-sup bound ENERGY_TERM_LE_SELF at t = tau (sqrt(2^{k_tau}) *) +(* sqrt(sum|ip|^2) *) +(* <= energy) and divide by 2^{k_tau} > 0 (LE_INV_MUL_FROM_MUL). *) +let FTILDE_ENERGY_SUM = prove + (`!(f:real->complex) (P:(int#int#int)->bool) tau. FINITE P + ==> sum {s | s IN P /\ tile_ler s tau} (\s. norm(carleson_ip f s) pow 2) + <= (energy_f f P) pow 2 * &2 zpow (--(tile_k tau))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:real->complex`; `P:(int#int#int)->bool`; `tau:int#int#int`] + ENERGY_TERM_LE_SELF) THEN + ASM_REWRITE_TAC[] THEN + ABBREV_TAC `D = sum {s | s IN P /\ tile_ler s tau} + (\s. norm(carleson_ip (f:real->complex) s) pow 2)` THEN + SUBGOAL_THEN `&0 <= D` ASSUME_TAC THENL + [EXPAND_TAC "D" THEN MATCH_MP_TAC SUM_POS_LE THEN + REWRITE_TAC[REAL_LE_POW_2]; ALL_TAC] THEN + SUBGOAL_THEN `&0 <= energy_f (f:real->complex) P` ASSUME_TAC THENL + [ASM_SIMP_TAC[ENERGY_F_POS]; ALL_TAC] THEN + SUBGOAL_THEN `&0 < &2 zpow (tile_k tau)` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_TAC THEN + REWRITE_TAC[REAL_ZPOW_NEG] THEN + MATCH_MP_TAC LE_INV_MUL_FROM_MUL THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`2`; `sqrt(&2 zpow (tile_k tau)) * sqrt D`; + `energy_f (f:real->complex) P`] REAL_POW_LE2) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THEN MATCH_MP_TAC SQRT_POS_LE THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE]; ASM_REWRITE_TAC[]]; + REWRITE_TAC[REAL_POW_MUL] THEN + ASM_SIMP_TAC[SQRT_POW_2; REAL_LT_IMP_LE]]);; + +let ENERGY_MONO = prove + (`!(f:real->complex) (P:(int#int#int)->bool) (Q:(int#int#int)->bool). + FINITE Q /\ P SUBSET Q ==> energy_f f P <= energy_f f Q`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `FINITE (P:(int#int#int)->bool)` ASSUME_TAC THENL + [ASM_MESON_TAC[FINITE_SUBSET]; ALL_TAC] THEN + GEN_REWRITE_TAC LAND_CONV [energy_f] THEN + MATCH_MP_TAC REAL_SUP_LE THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + EXISTS_TAC `sqrt(&2 zpow (tile_k (ARB:int#int#int))) * + sqrt(sum {s | s IN P /\ tile_ler s ARB} (\s. norm(carleson_ip f + s) pow 2))` THEN + REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `ARB:int#int#int` THEN + REWRITE_TAC[IN_UNIV]; + REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN X_GEN_TAC `t:int#int#int` THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sqrt(&2 zpow (tile_k t)) * + sqrt(sum {s | s IN Q /\ tile_ler s t} (\s. norm(carleson_ip f + s) pow 2))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC SQRT_POS_LE THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN + MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC SQRT_MONO_LE THEN MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN + ASM_SIMP_TAC[FINITE_RESTRICT] THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ASM_MESON_TAC[SUBSET]; + REWRITE_TAC[IN_DIFF; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[REAL_LE_POW_2]]; + MATCH_MP_TAC ENERGY_TERM_LE_SELF THEN ASM_REWRITE_TAC[]]]);; + +(* ------------------------------------------------------------------------- *) +(* Fremlin's coefficient-mass functional Delta(A) = sum_{sigma in A} *) +(* |(f|phi_sigma)|^2, pervasive in the 286K induction. Nonnegative, *) +(* monotone, *) +(* and finitely additive over disjoint unions. *) +(* ------------------------------------------------------------------------- *) + +let delta_f = new_definition + `delta_f (f:real->complex) (A:(int#int#int)->bool) = + sum A (\s. norm(carleson_ip f s) pow 2)`;; + +let DELTA_POS = prove + (`!(f:real->complex) (A:(int#int#int)->bool). &0 <= delta_f f A`, + REPEAT GEN_TAC THEN REWRITE_TAC[delta_f] THEN + MATCH_MP_TAC SUM_POS_LE THEN REWRITE_TAC[REAL_LE_POW_2]);; + +let DELTA_MONO = prove + (`!(f:real->complex) (A:(int#int#int)->bool) (B:(int#int#int)->bool). + FINITE B /\ A SUBSET B ==> delta_f f A <= delta_f f B`, + REPEAT STRIP_TAC THEN REWRITE_TAC[delta_f] THEN + MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN ASM_REWRITE_TAC[] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_LE_POW_2]);; + +let DELTA_UNIONS = prove + (`!(f:real->complex) (S:((int#int#int)->bool)->bool). + FINITE S /\ (!A. A IN S ==> FINITE A) /\ + (!A B. A IN S /\ B IN S /\ ~(A = B) ==> DISJOINT A B) + ==> delta_f f (UNIONS S) = sum S (\A. delta_f f A)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[delta_f] THEN + MATCH_MP_TAC SUM_UNIONS_NONZERO THEN ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC [`A:(int#int#int)->bool`; `B:(int#int#int)->bool`; + `s:int#int#int`] THEN + STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`A:(int#int#int)->bool`; + `B:(int#int#int)->bool`]) THEN + ASM_REWRITE_TAC[DISJOINT; EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN + ASM_MESON_TAC[]);; + +(* Subset splitting: Delta(P) = Delta(Q) + Delta(P \ Q) for Q SUBSET P. The *) +(* mass removed when the recursion peels off a subtree Q = T(tau_j) from P_j *) +(* (via the library SUM_DIFF: sum(P\Q) = sum P - sum Q). *) +let tile_tree = new_definition + `tile_tree (P:(int#int#int)->bool) (t:int#int#int) = {s | s IN P /\ tile_ler s + t}`;; + +let TILE_TREE_FINITE = prove + (`!(P:(int#int#int)->bool) (t:int#int#int). FINITE P ==> FINITE (tile_tree P + t)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[tile_tree] THEN + MATCH_MP_TAC FINITE_RESTRICT THEN ASM_REWRITE_TAC[]);; + +(* The tree is a subset of P; it grows monotonically in the root order <=_r *) +(* (via *) +(* TILE_LER_TRANS) and in the ambient tile set P; and it commutes with *) +(* restriction *) +(* to a subset. These are the set-algebra facts the 286K stopping-time *) +(* recursion *) +(* uses to reason about the shrinking tile sets P'_j = P'_{j-1} \ T(tau_j). *) +let TILE_TREE_SUBSET = prove + (`!(P:(int#int#int)->bool) t. tile_tree P t SUBSET P`, + REWRITE_TAC[tile_tree; SUBSET; IN_ELIM_THM] THEN MESON_TAC[]);; + +let TILE_TREE_MONO_SET = prove + (`!(P:(int#int#int)->bool) Q t. P SUBSET Q ==> tile_tree P t SUBSET tile_tree + Q t`, + REWRITE_TAC[tile_tree; SUBSET; IN_ELIM_THM] THEN MESON_TAC[]);; + +let TILE_TREE_INTER = prove + (`!(P:(int#int#int)->bool) Q t. tile_tree (P INTER Q) t = tile_tree P t INTER + Q`, + REWRITE_TAC[tile_tree; EXTENSION; IN_INTER; IN_ELIM_THM] THEN MESON_TAC[]);; + +let ENERGY_WITNESS = prove + (`!(f:real->complex) (P:(int#int#int)->bool) c. FINITE P /\ &0 <= c /\ c < + energy_f f P + ==> ?t. c pow 2 < (&2 zpow (tile_k t)) * delta_f f (tile_tree P t)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`{sqrt (&2 zpow tile_k t) * + sqrt (sum {s | s IN P /\ tile_ler s t} (\s. norm(carleson_ip + (f:real->complex) s) pow 2)) + | t IN (:int#int#int)}`; `c:real`] SUP_APPROACH) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + EXISTS_TAC `sqrt (&2 zpow tile_k (ARB:int#int#int)) * + sqrt (sum {s | s IN P /\ tile_ler s ARB} (\s. norm(carleson_ip + (f:real->complex) s) pow 2))` THEN + REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `ARB:int#int#int` THEN + REWRITE_TAC[IN_UNIV]; + EXISTS_TAC `sqrt(sum P (\s. (&2 zpow (tile_k s)) * norm(carleson_ip + (f:real->complex) s) pow 2))` THEN + REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN X_GEN_TAC `t:int#int#int` THEN + MP_TAC(ISPECL [`f:real->complex`; `P:(int#int#int)->bool`; + `t:int#int#int`] ENERGY_TERM_LE_SELF) THEN + ASM_REWRITE_TAC[energy_f] THEN + DISCH_THEN(fun th -> MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `energy_f (f:real->complex) P` THEN CONJ_TAC THENL + [REWRITE_TAC[energy_f] THEN + MP_TAC(ISPECL [`f:real->complex`; `P:(int#int#int)->bool`; + `t:int#int#int`] ENERGY_TERM_LE_SELF) THEN + ASM_REWRITE_TAC[energy_f]; ALL_TAC]) THEN + MP_TAC(ISPECL [`f:real->complex`; + `P:(int#int#int)->bool`] ENERGY_LE) THEN + ASM_REWRITE_TAC[energy_f]; + ASM_REWRITE_TAC[GSYM energy_f]]; + ALL_TAC] THEN + REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN + DISCH_THEN(X_CHOOSE_THEN `x:real` (CONJUNCTS_THEN2 MP_TAC ASSUME_TAC)) THEN + DISCH_THEN(X_CHOOSE_THEN `t:int#int#int` SUBST_ALL_TAC) THEN + EXISTS_TAC `t:int#int#int` THEN REWRITE_TAC[delta_f; tile_tree] THEN + SUBGOAL_THEN `&0 <= &2 zpow tile_k t * + sum {s | s IN P /\ tile_ler s t} (\s. norm (carleson_ip (f:real->complex) + s) pow 2)` + ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LT_IMP_LE THEN MATCH_MP_TAC REAL_ZPOW_LT THEN + REAL_ARITH_TAC; + MATCH_MP_TAC SUM_POS_LE THEN REWRITE_TAC[REAL_LE_POW_2]]; + ALL_TAC] THEN + SUBGOAL_THEN `c pow 2 < (sqrt (&2 zpow tile_k t * + sum {s | s IN P /\ tile_ler s t} (\s. norm (carleson_ip (f:real->complex) + s) pow 2))) pow 2` + MP_TAC THENL + [MATCH_MP_TAC REAL_POW_LT2 THEN ASM_REWRITE_TAC[ARITH_EQ] THEN + ASM_REWRITE_TAC[SQRT_MUL]; + ASM_SIMP_TAC[SQRT_POW_2]]);; + +(* The stopping condition (contrapositive of ENERGY_WITNESS): if NO *) +(* tile-tree *) +(* carries mass exceeding c^2, then energy_f f P <= c. This bounds the *) +(* leftover *) +(* energy when the 286K recursion halts (Fremlin's energy(P1) <= gamma/2 *) +(* once no *) +(* tau survives the R_j selection). *) +let ENERGY_THRESHOLD = prove + (`!(f:real->complex) (P:(int#int#int)->bool) c. FINITE P /\ &0 <= c /\ + (!t. (&2 zpow (tile_k t)) * delta_f f (tile_tree P t) <= c pow 2) + ==> energy_f f P <= c`, + REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC I [REAL_ARITH `x <= c <=> ~(c < x)`] THEN + DISCH_TAC THEN + MP_TAC(ISPECL [`f:real->complex`; `P:(int#int#int)->bool`; + `c:real`] ENERGY_WITNESS) THEN + ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN + X_GEN_TAC `t:int#int#int` THEN + REWRITE_TAC[REAL_NOT_LT] THEN ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* 286M infrastructure: the up-set R+ and a union-sum bound. Fremlin's *) +(* stopping-time lemmas (286J/286K) select R subset Q and remove R+ = *) +(* {sigma : some tau in R has tau <= sigma} (Fremlin's order) from P; the *) +(* combine step of 286M takes R = R0 UNION R1 and needs both the *) +(* nested-removal *) +(* identity P\(R0uR1)+ = (P\R0+)\R1+ and the sub-additive measure budget *) +(* sum_{R0uR1} <= sum + sum. In our reversed order (tile_le s t = Fremlin *) +(* t <= s), Fremlin tau <= sigma becomes tile_le sigma tau, so R+ = {s | ?t *) +(* IN *) +(* R. tile_le s t} -- the union of the 286L trees {s | tile_le s tau}. *) +(* ------------------------------------------------------------------------- *) + +(* R+ up-set (Fremlin 286Fb): sigma in R+ iff some tau in R has tau <= sigma *) +(* (Fremlin's order). Our tile_le s t = Fremlin (t <= s), so Fremlin tau <= *) +(* sigma = our tile_le sigma tau; hence R+ = {s | ?t IN R. tile_le s t}. *) +(* This is the union of the 286L trees {s | tile_le s tau}, tau in R. *) +let tile_upset = new_definition + `tile_upset (R:(int#int#int)->bool) = {s | ?t. t IN R /\ tile_le s t}`;; + +let TILE_UPSET_UNION_DIFF = prove + (`!P R0 R1:(int#int#int)->bool. + P DIFF tile_upset (R0 UNION R1) = + (P DIFF tile_upset R0) DIFF tile_upset R1`, + REWRITE_TAC[tile_upset; EXTENSION; IN_DIFF; IN_ELIM_THM; IN_UNION] THEN + MESON_TAC[]);; + +(* ========================================================================= *) +(* 286J part (a) (Fremlin mt286.tex 833-846): the greedy minimal-witness R. *) +(* R = tile_le-maximal elements of {sigma' : sigma in P, mass{sigma}>c}, *) +(* where *) +(* sigma' = carleson_jwit is a witnessing tile >= sigma (tile_le sigma *) +(* sigma') *) +(* with big integral (MASS_EH_WITNESS). Then P \ R^+ SUBSET {sigma : *) +(* mass{sigma}<=c}, so mass_Eh(P\R^+) <= c (MASS_EH_LE, guarded by *) +(* nonempty). *) +(* The mass and energy stopping sets. *) +(* ========================================================================= *) +let carleson_jwit = new_definition + `carleson_jwit E h c sigma = + @t. tile_le sigma t /\ + c < real_integral {x | x IN E /\ h x IN tile_J t} (cw_tile t)`;; + +let carleson_jwitset = new_definition + `carleson_jwitset E h c (P:(int#int#int)->bool) = + { carleson_jwit E h c sigma | sigma | sigma IN P /\ c < mass_Eh E h {sigma} + }`;; + +let carleson_jR = new_definition + `carleson_jR E h c (P:(int#int#int)->bool) = + { r | r IN carleson_jwitset E h c P /\ + (!n. n IN carleson_jwitset E h c P /\ tile_le r n ==> tile_le n r) + }`;; + +(* the witness spec: mass{sigma}>c ==> jwit sigma >= sigma with big integral *) +let CARLESON_JWIT_SPEC = prove + (`!E h c sigma. + (!t. cw_tile t real_integrable_on {x | x IN E /\ h x IN tile_J t}) /\ + c < mass_Eh E h {sigma} + ==> tile_le sigma (carleson_jwit E h c sigma) /\ + c < real_integral {x | x IN E /\ h x IN tile_J (carleson_jwit E h c + sigma)} + (cw_tile (carleson_jwit E h c sigma))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[carleson_jwit] THEN + CONV_TAC SELECT_CONV THEN + MP_TAC(ISPECL [`E:real->bool`;`h:real->real`;`sigma:int#int#int`;`c:real`] + MASS_EH_WITNESS) THEN + ASM_REWRITE_TAC[]);; + +let CARLESON_JWITSET_FINITE = prove + (`!E h c P:(int#int#int)->bool. FINITE P ==> FINITE (carleson_jwitset E h c + P)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[carleson_jwitset] THEN + MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `IMAGE (carleson_jwit E h c) P` THEN + ASM_SIMP_TAC[FINITE_IMAGE] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_IMAGE] THEN MESON_TAC[]);; + +let CARLESON_JR_FINITE = prove + (`!E h c P:(int#int#int)->bool. FINITE P ==> FINITE (carleson_jR E h c P)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[carleson_jR] THEN + MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `carleson_jwitset E h c P` THEN + ASM_SIMP_TAC[CARLESON_JWITSET_FINITE] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN MESON_TAC[]);; + +(* every big-single-mass sigma in P lies in R^+ *) +let CARLESON_JR_UPSET = prove + (`!E h c P sigma:int#int#int. + FINITE P /\ + (!t. cw_tile t real_integrable_on {x | x IN E /\ h x IN tile_J t}) /\ + sigma IN P /\ c < mass_Eh E h {sigma} + ==> sigma IN tile_upset (carleson_jR E h c P)`, + REPEAT STRIP_TAC THEN + ABBREV_TAC `sp = carleson_jwit E h c sigma` THEN + SUBGOAL_THEN `(sp:int#int#int) IN carleson_jwitset E h c P` ASSUME_TAC THENL + [REWRITE_TAC[carleson_jwitset; IN_ELIM_THM] THEN + EXISTS_TAC `sigma:int#int#int` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `tile_le sigma (sp:int#int#int)` ASSUME_TAC THENL + [EXPAND_TAC "sp" THEN + MP_TAC(ISPECL [`E:real->bool`;`h:real->real`;`c:real`;`sigma:int#int#int`] + CARLESON_JWIT_SPEC) THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL [`tile_le`; + `carleson_jwitset E h c P`] TILE_LE_MAXIMAL_ABOVE) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[CARLESON_JWITSET_FINITE; TILE_LE_REFL] THEN + MESON_TAC[TILE_LE_TRANS]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `sp:int#int#int`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `r:int#int#int` STRIP_ASSUME_TAC) THEN + REWRITE_TAC[tile_upset; IN_ELIM_THM] THEN + EXISTS_TAC `r:int#int#int` THEN CONJ_TAC THENL + [REWRITE_TAC[carleson_jR; IN_ELIM_THM] THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC TILE_LE_TRANS THEN EXISTS_TAC `sp:int#int#int` THEN + ASM_REWRITE_TAC[]]);; + +(* 286J part (a) MASS BOUND: mass_Eh(P \ R^+) <= c (guarded by nonemptiness, *) +(* matching carleson_mass_budget's guarded conclusion -- mass_Eh is a raw *) +(* sup so mass_Eh {} is junk; Fremlin's mass is 0 on empty, so the guard *) +(* loses nothing). *) +let CARLESON_JMASS_BOUND = prove + (`!E h c P:(int#int#int)->bool. + FINITE P /\ + (!t. cw_tile t real_integrable_on {x | x IN E /\ h x IN tile_J t}) + ==> ~(P DIFF tile_upset (carleson_jR E h c P) = {}) + ==> mass_Eh E h (P DIFF tile_upset (carleson_jR E h c P)) <= c`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC MASS_EH_LE THEN ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC [`s:int#int#int`; `t:int#int#int`] THEN + REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN + (* s in P, s NOT in R^+, tile_le s t. Then mass{s} <= c (contrapositive of + JR_UPSET), and int_{J_t} w_t <= mass{s} (MASS_TERM_LE_GEN on {s}). *) + SUBGOAL_THEN `mass_Eh E h {s:int#int#int} <= c` ASSUME_TAC THENL + [MATCH_MP_TAC(REAL_ARITH `~(c < m) ==> m <= c`) THEN DISCH_TAC THEN + UNDISCH_TAC `~(s:int#int#int IN tile_upset (carleson_jR E h c P))` THEN + REWRITE_TAC[] THEN + MATCH_MP_TAC CARLESON_JR_UPSET THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `mass_Eh E h {s:int#int#int}` THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`E:real->bool`;`h:real->real`;`{s:int#int#int}`; + `s:int#int#int`;`t:int#int#int`] MASS_TERM_LE_GEN) THEN + ASM_REWRITE_TAC[IN_SING]);; + +(* Sub-additive measure budget over a (possibly overlapping) union, for the *) +(* nonnegative interval-lengths mu I_tau. Inclusion-exclusion + sum(s INTER *) +(* t) *) +(* >= 0. *) +let SUM_UNION_LE_POS = prove + (`!(f:A->real) s t. FINITE s /\ FINITE t /\ (!x. x IN s INTER t ==> &0 <= f x) + ==> sum (s UNION t) f <= sum s f + sum t f`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`s:A->bool`; `t:A->bool`; `f:A->real`] SUM_INCL_EXCL) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= i ==> u <= u + i`) THEN + MATCH_MP_TAC SUM_POS_LE THEN ASM_SIMP_TAC[FINITE_INTER]);; + +(* Peel one index a from a UNIONS-of-IMAGE set identity. Used to bound the *) +(* sum *) +(* over a finite union of tree-supports by the sum of per-tree sums. *) +let UNIONS_IMAGE_DELETE = prove + (`!(G:A->(B->bool)) R a. a IN R + ==> UNIONS (IMAGE G R) = G a UNION UNIONS (IMAGE G (R DELETE a))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `R = (a:A) INSERT (R DELETE a)` + (fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o RAND_CONV) [th]) THENL + [ASM SET_TAC[]; ALL_TAC] THEN + REWRITE_TAC[IMAGE_CLAUSES; UNIONS_INSERT]);; + +(* Subadditive union-sum: for a nonnegative phi, the sum over a finite union *) +(* of *) +(* pieces is at most the sum of the per-piece sums. 286M part (b) uses this *) +(* to *) +(* bound sum over P cap R+ = sum over UNIONS of the trees {sigma : sigma >= *) +(* tau} *) +(* (tau in R) by sum_{tau in R} (tree sum). WF-induction on CARD R; peel one *) +(* tau *) +(* (SUM_DELETE on RHS, UNIONS_IMAGE_DELETE + SUM_UNION_LE_POS on LHS), *) +(* recurse. *) +let SUM_UNIONS_LE_SUM = prove + (`!(G:A->(B->bool)) (R:A->bool) (phi:B->real). + FINITE R /\ (!t. t IN R ==> FINITE (G t)) /\ (!x. &0 <= phi x) + ==> sum (UNIONS (IMAGE G R)) phi <= sum R (\t. sum (G t) phi)`, + GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN + WF_INDUCT_TAC `CARD(R:A->bool)` THEN STRIP_TAC THEN + ASM_CASES_TAC `R:A->bool = {}` THENL + [ASM_REWRITE_TAC[IMAGE_CLAUSES; UNIONS_0; SUM_CLAUSES; REAL_LE_REFL]; + ALL_TAC] THEN + FIRST_X_ASSUM(X_CHOOSE_TAC `a:A` o REWRITE_RULE[GSYM MEMBER_NOT_EMPTY]) THEN + SUBGOAL_THEN `FINITE((R:A->bool) DELETE a)` ASSUME_TAC THENL + [REWRITE_TAC[FINITE_DELETE] THEN FIRST_ASSUM MATCH_ACCEPT_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `sum R (\t. sum ((G:A->(B->bool)) t) phi) = + sum (G a) phi + sum (R DELETE a) (\t. sum (G t) phi)` + SUBST1_TAC THENL + [MP_TAC(ISPECL [`\t. sum ((G:A->(B->bool)) t) phi`; `R:A->bool`; `a:A`] + SUM_DELETE) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; REAL_ARITH_TAC]; + ALL_TAC] THEN + ASM_SIMP_TAC[UNIONS_IMAGE_DELETE] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum ((G:A->(B->bool)) a) phi + + sum (UNIONS (IMAGE G (R DELETE a))) phi` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_UNION_LE_POS THEN REPEAT CONJ_TAC THENL + [UNDISCH_TAC `!t:A. t IN R ==> FINITE ((G:A->(B->bool)) t)` THEN + DISCH_THEN(MP_TAC o SPEC `a:A`) THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[FINITE_UNIONS; FORALL_IN_IMAGE] THEN + ASM_SIMP_TAC[FINITE_IMAGE; IN_DELETE]; + GEN_TAC THEN DISCH_TAC THEN FIRST_ASSUM MATCH_ACCEPT_TAC]; + MATCH_MP_TAC REAL_LE_ADD2 THEN REWRITE_TAC[REAL_LE_REFL] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(R:A->bool) DELETE a`) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[CARD_DELETE] THEN + MATCH_MP_TAC(ARITH_RULE `~(n = 0) ==> n - 1 < n`) THEN + ASM_SIMP_TAC[CARD_EQ_0] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + EXISTS_TAC `a:A` THEN FIRST_ASSUM MATCH_ACCEPT_TAC; + DISCH_THEN MATCH_MP_TAC THEN ASM_SIMP_TAC[IN_DELETE]]]);; + +(* A descending chain of sets is contained in its first term. *) +let GRAM_ALPHA_BOUND = prove + (`!alpha K:real. &0 <= alpha /\ &0 <= K /\ alpha pow 2 <= K * alpha ==> alpha + <= K`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `alpha = &0` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `&0 < alpha` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPECL [`alpha:real`; `K:real`; `alpha:real`] REAL_LE_RMUL_EQ) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + ASM_REWRITE_TAC[GSYM REAL_POW_2]);; + +(* ------------------------------------------------------------------------- *) +(* 286I geometry/analysis bricks (part b). I_tau^(k) = the interval with the *) +(* same centre x_tau = tile_xmid as I_tau but 2^k times the length; since *) +(* |I_tau| = 2^(-k_tau), its half-width is 2^(k - k_tau - 1). *) +(* ------------------------------------------------------------------------- *) + +let tile_Idil = new_definition + `tile_Idil (s:int#int#int) (k:num) = + {x:real | abs(x - tile_xmid s) < &2 zpow (&k - tile_k s - &1)}`;; + +(* Outside the dilate, the distance to the centre is at least the *) +(* half-width. *) +let CW_ANTITONE = prove + (`!a b:real. abs a <= abs b ==> cw b <= cw a`, + REPEAT STRIP_TAC THEN REWRITE_TAC[cw; REAL_ARITH `&1 / x = inv x`] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_POW_LT THEN REAL_ARITH_TAC; + MATCH_MP_TAC REAL_POW_LE2 THEN CONJ_TAC THENL + [REAL_ARITH_TAC; ASM_REAL_ARITH_TAC]]);; + +(* ------------------------------------------------------------------------- *) +(* The even tent cw1 = min(cw 3, cw x) (Fremlin's w1 = min(w(3), *) +(* w(x))). Flat on [-3,3], = cw outside; this is the monotone-const-monotone *) +(* (MCM) kernel that 286B (MCM_MAXIMAL_DOMINATION) needs, dominating |phi|. *) +(* ------------------------------------------------------------------------- *) +let cw1 = new_definition `cw1 (x:real) = min (cw(&3)) (cw x)`;; + +let CW1_POS = prove + (`!x. &0 < cw1 x`, + GEN_TAC THEN REWRITE_TAC[cw1] THEN + MP_TAC(SPEC `&3` CW_POS) THEN MP_TAC(SPEC `x:real` CW_POS) THEN + REAL_ARITH_TAC);; + +let CW1_EVEN = prove + (`!x. cw1(--x) = cw1 x`, + GEN_TAC THEN REWRITE_TAC[cw1; CW_EVEN]);; + +let CW1_LE_CW = prove + (`!x. cw1 x <= cw x`, + GEN_TAC THEN REWRITE_TAC[cw1] THEN REAL_ARITH_TAC);; + +(* cw1 is MCM with al = -3, be = 3: nondecreasing on (-inf,-3], *) +(* nonincreasing *) +(* on [3,inf), constant on [-3,3]. All from CW_ANTITONE (cw antitone in *) +(* |.|). *) +let CW1_MCM = prove + (`(!x y. x <= y /\ y <= --(&3) ==> cw1 x <= cw1 y) /\ + (!x y. &3 <= x /\ x <= y ==> cw1 y <= cw1 x) /\ + (!x. --(&3) <= x /\ x <= &3 ==> cw1 x = cw1(--(&3)))`, + REWRITE_TAC[cw1] THEN REPEAT CONJ_TAC THEN REPEAT STRIP_TAC THENL + [MP_TAC(SPECL [`y:real`; `x:real`] CW_ANTITONE) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; REAL_ARITH_TAC]; + MP_TAC(SPECL [`x:real`; `y:real`] CW_ANTITONE) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; REAL_ARITH_TAC]; + SUBGOAL_THEN `cw(&3) <= cw x /\ cw(&3) <= cw(--(&3))` MP_TAC THENL + [CONJ_TAC THEN MATCH_MP_TAC CW_ANTITONE THEN ASM_REAL_ARITH_TAC; + REAL_ARITH_TAC]]);; + +(* cw1 is continuous (min of two continuous) and, being <= cw (L^1, CW_FULL) *) +(* and >= 0, absolutely integrable on R. Both are MCM_MAXIMAL_DOMINATION *) +(* hyps. *) +let CW1_CONTINUOUS = prove + (`cw1 real_continuous_on (:real)`, + SUBGOAL_THEN `cw1 = \x. min ((\y. cw(&3)) x) (cw x)` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; cw1]; ALL_TAC] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_MIN THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_CONST; CW_CONTINUOUS]);; + +let CW1_ABSINT = prove + (`cw1 absolutely_real_integrable_on (:real)`, + MATCH_MP_TAC REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE + THEN + EXISTS_TAC `cw` THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_IMP_REAL_MEASURABLE_ON THEN + REWRITE_TAC[CW1_CONTINUOUS]; + MATCH_MP_TAC HAS_REAL_INTEGRAL_INTEGRABLE THEN EXISTS_TAC `&1` THEN + REWRITE_TAC[CW_FULL]; + X_GEN_TAC `x:real` THEN DISCH_TAC THEN + MP_TAC(SPEC `x:real` CW1_POS) THEN MP_TAC(SPEC `x:real` CW1_LE_CW) THEN + REAL_ARITH_TAC]);; + +(* The DILATED tent gg(t) = cw1(3 2^m t) is MCM with al = -2^{-m}, be = *) +(* 2^{-m}: *) +(* the flat edges 3 2^m (+-2^{-m}) = +-3 map to cw1's flat region [-3,3]. *) +(* This *) +(* is the exact gg for the (h)(vi) application of MCM_MAXIMAL_DOMINATION. *) +(* Key *) +(* arithmetic: 3 2^m (+-2^{-m}) = +-3 (since 2^m 2^{-m}=1); monotone scaling *) +(* of *) +(* the argument (REAL_LE_LMUL, 3 2^m > 0) then CW1_MCM. *) +let CW1_DILATE_MCM = prove + (`!m. &0 < &2 zpow m + ==> (!x y. x <= y /\ y <= --(&2 zpow(--m)) + ==> cw1(&3 * &2 zpow m * x) <= cw1(&3 * &2 zpow m * y)) /\ + (!x y. &2 zpow(--m) <= x /\ x <= y + ==> cw1(&3 * &2 zpow m * y) <= cw1(&3 * &2 zpow m * x)) /\ + (!x. --(&2 zpow(--m)) <= x /\ x <= &2 zpow(--m) + ==> cw1(&3 * &2 zpow m * x) = cw1(&3 * &2 zpow m * (--(&2 + zpow(--m)))))`, + GEN_TAC THEN DISCH_TAC THEN + ABBREV_TAC `M = &2 zpow m` THEN + SUBGOAL_THEN + `&3 * M * (&2 zpow(--m)) = &3 /\ &3 * M * (--(&2 zpow(--m))) = --(&3)` + STRIP_ASSUME_TAC THENL + [SUBGOAL_THEN `M * &2 zpow(--m) = &1` MP_TAC THENL + [EXPAND_TAC "M" THEN REWRITE_TAC[REAL_ZPOW_NEG] THEN + MATCH_MP_TAC REAL_MUL_RINV THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[REAL_ARITH `&3 * M * b = &3 * (M * b)`; + REAL_ARITH `&3 * M * --b = --(&3 * (M * b))`] THEN + DISCH_THEN SUBST1_TAC THEN REAL_ARITH_TAC]; ALL_TAC] THEN + SUBGOAL_THEN + `!p q:real. p <= q ==> &3 * M * p <= &3 * M * q` ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN + REWRITE_TAC[REAL_ARITH `&3 * M * p = (&3 * M) * p`] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REPEAT CONJ_TAC THEN REPEAT STRIP_TAC THENL + [MATCH_MP_TAC(CONJUNCT1 CW1_MCM) THEN + CONJ_TAC THENL + [FIRST_ASSUM(MATCH_MP_TAC) THEN ASM_REWRITE_TAC[]; + FIRST_X_ASSUM(MP_TAC o SPECL [`y:real`; `--(&2 zpow(--m))`]) THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC]; + MATCH_MP_TAC(CONJUNCT1(CONJUNCT2 CW1_MCM)) THEN + CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPECL [`&2 zpow(--m)`; `x:real`]) THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + FIRST_ASSUM(MATCH_MP_TAC) THEN ASM_REWRITE_TAC[]]; + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(CONJUNCT2(CONJUNCT2 CW1_MCM)) THEN + CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPECL [`--(&2 zpow(--m))`; `x:real`]) THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + FIRST_X_ASSUM(MP_TAC o SPECL [`x:real`; `&2 zpow(--m)`]) THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC]]);; + +(* Superlevel sets of the dilated tent are bounded: {t | u <= cw1(3 2^m t)} *) +(* SUBSET [-R,R] with R = (1/u - 1)/(3 2^m). From cw1 <= cw = 1/(1+|.|)^3: *) +(* u <= 1/(1+|3 2^m t|)^3 forces (1+|3 2^m t|)^3 <= 1/u, hence 1+|3 2^m t| *) +(* <= 1/u *) +(* (cube >= base for base >= 1), so |t| <= R. The last *) +(* MCM_MAXIMAL_DOMINATION *) +(* hypothesis for gg = cw1(3 2^m .). *) +let CW1_DILATE_SUPERLEVEL_BOUNDED = prove + (`!m u. &0 < &2 zpow m /\ &0 < u + ==> real_bounded {t | u <= cw1(&3 * &2 zpow m * t)}`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_BOUNDED_SUBSET THEN + EXISTS_TAC `real_interval[--((inv u - &1)/(&3 * &2 zpow m)), (inv u - &1)/(&3 + * &2 zpow m)]` THEN + REWRITE_TAC[REAL_BOUNDED_REAL_INTERVAL] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_REAL_INTERVAL] THEN + X_GEN_TAC `t:real` THEN DISCH_TAC THEN + SUBGOAL_THEN `u <= cw(&3 * &2 zpow m * t)` MP_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `cw1(&3 * &2 zpow m * t)` THEN + ASM_REWRITE_TAC[CW1_LE_CW]; ALL_TAC] THEN + REWRITE_TAC[cw; REAL_ARITH `&1 / x = inv x`] THEN + SUBGOAL_THEN `&0 < (&1 + abs(&3 * &2 zpow m * t)) pow 3` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_POW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_TAC THEN + SUBGOAL_THEN `(&1 + abs(&3 * &2 zpow m * t)) pow 3 <= inv u` ASSUME_TAC THENL + [GEN_REWRITE_TAC LAND_CONV [GSYM REAL_INV_INV] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `&1 + abs(&3 * &2 zpow m * t) <= inv u` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(&1 + abs(&3 * &2 zpow m * t)) pow 3` THEN + ASM_REWRITE_TAC[] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_POW_1] THEN + MATCH_MP_TAC REAL_POW_MONO THEN CONJ_TAC THENL + [REAL_ARITH_TAC; ARITH_TAC]; ALL_TAC] THEN + SUBGOAL_THEN + `abs(&3 * &2 zpow m * t) = (&3 * &2 zpow m) * abs t` ASSUME_TAC THENL + [REWRITE_TAC[REAL_ABS_MUL] THEN + SUBGOAL_THEN `abs(&3 * &2 zpow m) = &3 * &2 zpow m` MP_TAC THENL + [ASM_REAL_ARITH_TAC; REWRITE_TAC[REAL_ABS_MUL] THEN + REAL_ARITH_TAC]; ALL_TAC] THEN + SUBGOAL_THEN `&0 < &3 * &2 zpow m` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `(&3 * &2 zpow m) * abs t <= inv u - &1` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `abs t <= (inv u - &1) / (&3 * &2 zpow m)` MP_TAC THENL + [ASM_SIMP_TAC[REAL_LE_RDIV_EQ] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + REAL_ARITH_TAC);; + +(* Dilated tent is continuous (cw1 continuous o linear) and real_integrable *) +(* (affine image of the L^1 cw1, HAS_REAL_INTEGRAL_AFFINITY_UNIV): the last *) +(* two MCM_MAXIMAL_DOMINATION hyps for gg = cw1(3 2^m .). *) +let CW1_DILATE_CONT = prove + (`!m. (\t. cw1(&3 * &2 zpow m * t)) real_continuous_on (:real)`, + GEN_TAC THEN + SUBGOAL_THEN + `(\t. cw1(&3 * &2 zpow m * t)) = cw1 o (\t. (&3 * &2 zpow m) * t)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; o_THM; REAL_MUL_ASSOC]; ALL_TAC] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL + [MP_TAC(BETA_RULE(ISPECL [`(\x:real. x)`; `&3 * &2 zpow m`; + `(:real)`] REAL_CONTINUOUS_ON_LMUL)) THEN + REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_ID]; + MATCH_MP_TAC REAL_CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `(:real)` THEN + REWRITE_TAC[CW1_CONTINUOUS; SUBSET_UNIV]]);; + +let CW1_DILATE_INTEGRABLE = prove + (`!m. &0 < &2 zpow m ==> (\t. cw1(&3 * &2 zpow m * t)) real_integrable_on + (:real)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN + MP_TAC(SPECL [`cw1`; `real_integral (:real) cw1`; `&3 * &2 zpow m`; `&0`] + HAS_REAL_INTEGRAL_AFFINITY_UNIV) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_INTEGRABLE_INTEGRAL THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE THEN + REWRITE_TAC[CW1_ABSINT]]; + REWRITE_TAC[REAL_ADD_RID] THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_REAL_INTEGRAL_INTEGRABLE) THEN + REWRITE_TAC[]]);; + +(* norm(gt(x+.)) is absolutely real-integrable for Schwartz gt *) +(* (SCHWARTZ_AFFINE s=1,c=x -> shifted Schwartz -> SCHWARTZ_ABSINT -> *) +(* ABSOLUTELY_INTEGRABLE_NORM). *) +let GT_SHIFT_NORM_REAL_ABSINT = prove + (`!(gt:real->complex) x. schwartz gt + ==> (\t. norm(gt(x + t))) absolutely_real_integrable_on (:real)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_ON; IMAGE_LIFT_UNIV] THEN + SUBGOAL_THEN `schwartz (\t. (gt:real->complex)(x + t))` ASSUME_TAC THENL + [MP_TAC(ISPECL [`gt:real->complex`; `&1`; `x:real`] SCHWARTZ_AFFINE) THEN + ASM_REWRITE_TAC[REAL_MUL_LID; ETA_AX] THEN + DISCH_THEN MATCH_MP_TAC THEN REAL_ARITH_TAC; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP SCHWARTZ_ABSINT) THEN + DISCH_THEN(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_NORM) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[o_DEF; FUN_EQ_THM]);; + +(* M6 CORE: the (h)(vi) maximal domination for the dilated tent. For *) +(* Schwartz *) +(* gt and a bound M on every straddling average of |gt(x+.)| (a<=-2^{-m}, *) +(* b>=2^{-m}), *) +(* int_R |gt(x+t)| cw1(3 2^m t) dt <= M * int_R cw1(3 2^m t) dt. *) +(* Instantiate MCM_MAXIMAL_DOMINATION at f=|gt(x+.)|, gg=cw1(3 2^m .), *) +(* al=-2^{-m}, *) +(* be=2^{-m}; all 12 hyps discharged from the CW1_DILATE_* facts + *) +(* GT_SHIFT_NORM_ *) +(* REAL_ABSINT + the bounded*measurable product (f*gg integrable). *) +let GT_DILATE_MCM_BOUND = prove + (`!(gt:real->complex) x m M. + schwartz gt /\ &0 < &2 zpow m /\ + (!a b. a <= --(&2 zpow(--m)) /\ &2 zpow(--m) <= b + ==> real_integral (real_interval[a,b]) (\t. norm(gt(x + t))) <= M * + (b - a)) + ==> real_integral (:real) (\t. norm(gt(x + t)) * cw1(&3 * &2 zpow m * t)) + <= M * real_integral (:real) (\t. cw1(&3 * &2 zpow m * t))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`\t. norm((gt:real->complex)(x + t))`; + `\t. cw1(&3 * &2 zpow m * t)`; + `--(&2 zpow(--m))`; `&2 zpow(--m)`; `M:real`] MCM_MAXIMAL_DOMINATION) THEN + ANTS_TAC THENL [ALL_TAC; SIMP_TAC[]] THEN + MP_TAC(SPEC `m:int` CW1_DILATE_MCM) THEN ASM_REWRITE_TAC[] THEN + STRIP_TAC THEN + SUBGOAL_THEN `&0 < &2 zpow(--m)` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `(\t. norm((gt:real->complex)(x + t))) + absolutely_real_integrable_on (:real)` + ASSUME_TAC THENL [MATCH_MP_TAC GT_SHIFT_NORM_REAL_ABSINT THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `(\t. norm((gt:real->complex)(x + t))) real_measurable_on (:real)` + ASSUME_TAC THENL + [ASM_MESON_TAC[ABSOLUTELY_REAL_INTEGRABLE_REAL_MEASURABLE]; ALL_TAC] THEN + SUBGOAL_THEN + `(\t. cw1(&3 * &2 zpow m * t)) real_measurable_on (:real)` ASSUME_TAC THENL + [MATCH_MP_TAC CONTINUOUS_IMP_REAL_MEASURABLE_ON THEN + REWRITE_TAC[CW1_DILATE_CONT]; ALL_TAC] THEN + SUBGOAL_THEN + `real_bounded (IMAGE (\t. cw1(&3 * &2 zpow m * t)) (:real))` + ASSUME_TAC THENL + [REWRITE_TAC[real_bounded; FORALL_IN_IMAGE] THEN EXISTS_TAC `cw(&3)` THEN + X_GEN_TAC `t:real` THEN REWRITE_TAC[IN_UNIV] THEN + MP_TAC(SPEC `&3 * &2 zpow m * t` CW1_POS) THEN + SUBGOAL_THEN `cw1(&3 * &2 zpow m * t) <= cw(&3)` MP_TAC THENL + [REWRITE_TAC[cw1] THEN REAL_ARITH_TAC; REAL_ARITH_TAC]; ALL_TAC] THEN + ASM_REWRITE_TAC[CW1_POS; NORM_POS_LE; REAL_LE_REFL; CW1_DILATE_CONT] THEN + REPEAT CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; + GEN_TAC THEN MP_TAC(SPEC `&3 * &2 zpow m * x'` CW1_POS) THEN + REAL_ARITH_TAC; + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC CW1_DILATE_INTEGRABLE THEN ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC THEN MATCH_MP_TAC CW1_DILATE_SUPERLEVEL_BOUNDED THEN + ASM_REWRITE_TAC[]]);; + +(* Reflected companion of GT_SHIFT_NORM_REAL_ABSINT: norm(gt(x-t)) *) +(* real-absint *) +(* (SCHWARTZ_AFFINE s=-1: gt(x - t) Schwartz). Needed for the (h)(vi) *) +(* integrand *) +(* norm(gt(x0 - t)) (CONVOL_NORM_BOUND gives x0 - t, not x0 + t). *) +let GT_SHIFT_NORM_REAL_ABSINT_NEG = prove + (`!(gt:real->complex) x. schwartz gt + ==> (\t. norm(gt(x - t))) absolutely_real_integrable_on (:real)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_ON; IMAGE_LIFT_UNIV] THEN + SUBGOAL_THEN `schwartz (\t. (gt:real->complex)(x - t))` ASSUME_TAC THENL + [MP_TAC(ISPECL [`gt:real->complex`; `-- &1`; `x:real`] SCHWARTZ_AFFINE) THEN + REWRITE_TAC[REAL_ARITH `x + -- &1 * t = x - t`] THEN + ASM_REWRITE_TAC[ETA_AX] THEN DISCH_THEN MATCH_MP_TAC THEN + REAL_ARITH_TAC; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP SCHWARTZ_ABSINT) THEN + DISCH_THEN(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_NORM) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[o_DEF; FUN_EQ_THM]);; + +(* The (h)(vi) product integrand norm(gt(x0-t)) cw1(3 2^m t) is integrable: *) +(* cw1(3 2^m .) bounded-measurable (CW1_DILATE_CONT + cw1<=cw3) times the *) +(* L^1 norm(gt(x0-.)) (GT_SHIFT_NORM_REAL_ABSINT_NEG); *) +(* ABSOLUTELY_REAL_INTEGRABLE_ BOUNDED_MEASURABLE_PRODUCT after REAL_MUL_SYM *) +(* orients cw1 first. *) +let GT_CW1_PROD_INTEGRABLE = prove + (`!(gt:real->complex) m x0. + schwartz gt /\ &0 < &2 zpow m + ==> (\t. lift(norm(gt(x0 - drop t)) * cw1(&3 * &2 zpow m * drop t))) + integrable_on (:real^1)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[GSYM IMAGE_LIFT_UNIV] THEN + REWRITE_TAC[REWRITE_RULE[o_DEF; + IMAGE_LIFT_UNIV] (GSYM REAL_INTEGRABLE_ON)] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_IMP_REAL_MEASURABLE_ON THEN + REWRITE_TAC[CW1_DILATE_CONT]; + REWRITE_TAC[real_bounded; FORALL_IN_IMAGE] THEN EXISTS_TAC `cw(&3)` THEN + X_GEN_TAC `s:real` THEN REWRITE_TAC[IN_UNIV] THEN + MP_TAC(SPEC `&3 * &2 zpow m * s` CW1_POS) THEN + SUBGOAL_THEN `cw1(&3 * &2 zpow m * s) <= cw(&3)` MP_TAC THENL + [REWRITE_TAC[cw1] THEN REAL_ARITH_TAC; REAL_ARITH_TAC]; + MATCH_MP_TAC GT_SHIFT_NORM_REAL_ABSINT_NEG THEN ASM_REWRITE_TAC[]]);; + +(* Real<->vector integral bridges + the (h)(vi) pointwise arithmetic. *) +let DROP_VEC_INTEGRAL_EQ_REAL = prove + (`!(gg:real->real). gg real_integrable_on (:real) + ==> drop(integral (:real^1) (\t. lift(gg(drop t)))) = real_integral (:real) + gg`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP REAL_INTEGRAL) THEN + REWRITE_TAC[IMAGE_LIFT_UNIV; o_DEF] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + REFL_TAC);; + +let PSICHECK_PTWISE_ARITH = prove + (`!a M p C1 c. &0 <= a /\ &0 < M /\ &0 <= C1 /\ &0 <= c /\ p <= C1 * c + ==> a * M * p <= (M * C1) * a * c`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `a * M * (C1 * c):real` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC]; + ASM_REAL_ARITH_TAC]);; + +(* Fremlin 286H(vi): |convol gt psicheck (x0)| <= 3 2^m C1 int_R *) +(* |gt(x0-t)| *) +(* cw1(3 2^m t) dt. CONVOL_NORM_BOUND (triangle) -> drop-vec = real bridge *) +(* (DROP_VEC_INTEGRAL_EQ_REAL) -> REAL_INTEGRAL_LE with the pointwise *) +(* integrand *) +(* bound |psicheck| = 3 2^m |phi(3 2^m t)| <= 3 2^m C1 cw1 (PSICHECK_NORM + *) +(* CARLESON_PHI_CW1, via PSICHECK_PTWISE_ARITH) -> REAL_INTEGRAL_LMUL pulls *) +(* the *) +(* constant. Integrabilities: GT_CW1_PROD_INTEGRABLE + *) +(* CONVOL_INTEGRAND_ABSINT. *) +let GTM_CONVOL_REAL_BOUND = prove + (`!(gt:real->complex) m nhat x0 C1. + schwartz gt /\ &0 < &2 zpow m /\ &0 <= C1 /\ + (!u. norm(carleson_phi u) <= C1 * cw1 u) + ==> norm(convol gt (psicheck (&3 * &2 zpow m) (dyho_mid m nhat) + carleson_phi) x0) + <= (&3 * &2 zpow m) * C1 * + real_integral (:real) (\t. norm(gt(x0 - t)) * cw1(&3 * &2 zpow m * + t))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&0 < &3 * &2 zpow m` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `schwartz (psicheck (&3 * &2 zpow m) (dyho_mid m nhat) carleson_phi)` + ASSUME_TAC THENL + [MATCH_MP_TAC PSICHECK_SCHWARTZ THEN REWRITE_TAC[CARLESON_PHI_SCHWARTZ] THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `(\t. norm((gt:real->complex)(x0 - t)) * cw1(&3 * &2 zpow m * t)) + real_integrable_on (:real)` + ASSUME_TAC THENL + [ONCE_REWRITE_TAC[REAL_INTEGRABLE_ON] THEN + REWRITE_TAC[IMAGE_LIFT_UNIV; o_DEF] THEN + MP_TAC(ISPECL [`gt:real->complex`; `m:int`; + `x0:real`] GT_CW1_PROD_INTEGRABLE) THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `(\t. norm((gt:real->complex)(x0 - t)) * + norm(psicheck (&3 * &2 zpow m) (dyho_mid m nhat) carleson_phi t)) + real_integrable_on (:real)` + ASSUME_TAC THENL + [ONCE_REWRITE_TAC[REAL_INTEGRABLE_ON] THEN + REWRITE_TAC[IMAGE_LIFT_UNIV; o_DEF] THEN + MP_TAC(ISPECL [`gt:real->complex`; + `psicheck (&3 * &2 zpow m) (dyho_mid m nhat) carleson_phi`; + `x0:real`] + CONVOL_INTEGRAND_ABSINT) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_NORM) THEN + DISCH_THEN(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[o_DEF; FUN_EQ_THM; COMPLEX_NORM_MUL]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `real_integral (:real) + (\t. norm((gt:real->complex)(x0 - t)) * + norm(psicheck (&3 * &2 zpow m) (dyho_mid m nhat) carleson_phi t))` + THEN + CONJ_TAC THENL + [MP_TAC(ISPECL [`gt:real->complex`; + `psicheck (&3 * &2 zpow m) (dyho_mid m nhat) carleson_phi`; + `x0:real`] + CONVOL_NORM_BOUND) THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(ISPEC `\t. norm((gt:real->complex)(x0 - t)) * + norm(psicheck (&3 * &2 zpow m) (dyho_mid m nhat) + carleson_phi t)` + DROP_VEC_INTEGRAL_EQ_REAL) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[]; ALL_TAC] THEN + GEN_REWRITE_TAC (RAND_CONV) [REAL_ARITH `(&3 * M) * C1 * a = ((&3 * M) * C1) + * a`] THEN + ASM_SIMP_TAC[GSYM REAL_INTEGRAL_LMUL] THEN + MATCH_MP_TAC REAL_INTEGRAL_LE THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_LMUL THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + X_GEN_TAC `t:real` THEN DISCH_TAC THEN REWRITE_TAC[PSICHECK_NORM] THEN + SUBGOAL_THEN `abs(&3 * &2 zpow m) = &3 * &2 zpow m` SUBST1_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC PSICHECK_PTWISE_ARITH THEN + REWRITE_TAC[NORM_POS_LE] THEN ASM_REWRITE_TAC[] THEN + REPEAT CONJ_TAC THENL + [MP_TAC(SPEC `&3 * &2 zpow m * t` CW1_POS) THEN REAL_ARITH_TAC; + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN ASM_REWRITE_TAC[]]);; + +(* --- M6 (h)(vi) reflect: cw1 is even, so the minus-shift integral equals *) +(* the *) +(* plus-shift integral. This turns GTM_CONVOL_REAL_BOUND's int *) +(* norm(gt(x0-t)) cw1 *) +(* into int norm(gt(x0+t)) cw1, matching GT_DILATE_MCM_BOUND (which uses *) +(* gt(x+.)). *) +let M6_REFLECT = prove + (`!(gt:real->complex) m x0. + real_integral (:real) (\t. norm(gt(x0 - t)) * cw1(&3 * &2 zpow m * t)) = + real_integral (:real) (\t. norm(gt(x0 + t)) * cw1(&3 * &2 zpow m * t))`, + REPEAT GEN_TAC THEN + MP_TAC(ISPECL [`\t. norm((gt:real->complex)(x0 + t)) * cw1(&3 * &2 zpow m * + t)`; + `(:real)`] REAL_INTEGRAL_REFLECT_GEN) THEN + BETA_TAC THEN + REWRITE_TAC[REAL_ARITH `!a t:real. a + --t = a - t`; REAL_MUL_RNEG; + CW1_EVEN] THEN + SUBGOAL_THEN `IMAGE (--) (:real) = (:real)` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_UNIV] THEN + GEN_TAC THEN EXISTS_TAC `--x:real` THEN REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]));; + +(* ========================================================================= *) +(* M6 (h)(vi) capstone: the maximal-domination assembly. These lemmas take *) +(* the convolution bound (GTM_CONVOL_REAL_BOUND) through the reflected even *) +(* kernel (M6_REFLECT), the dilated-tent monotone-kernel domination *) +(* (GT_DILATE_MCM_BOUND), and the straddling-average <= H-L maximal step *) +(* (AVG_SHIFT_LE_HL) to the abstract bound |v| <= (C1 int cw1 / sqrt2pi) g~* *) +(* (GTM_MAXIMAL_ABSTRACT). The concrete CARLESON_GTILDE_MAXIMAL (which needs *) +(* FTILDE_CONVOL_EQ) is assembled later, after that lemma. *) +(* ========================================================================= *) + +(* Pure nonlinear reassociation exposing the (s * inv s) cancellation -- *) +(* REAL_ARITH cannot do it, REAL_RING throws "find" on the inv atom, so *) +(* state it over a fresh variable w standing for inv s. *) +let GTM_REARR = prove + (`!s c1 mm iv w:real. s * c1 * (mm * (w * iv)) = (s * w) * (c1 * (mm * iv))`, + REPEAT GEN_TAC THEN CONV_TAC REAL_RING);; + +let GTM_DIV_REARR = prove + (`!c1 iv sp mm:real. ~(sp = &0) ==> (c1 * iv / sp) * mm = (c1 * mm * iv) / + sp`, + REPEAT STRIP_TAC THEN CONV_TAC REAL_FIELD);; + +(* The constant-folding arithmetic: sp * nv <= s * c1 * (mm * (inv s * iv)) *) +(* ==> nv <= (c1 * iv / sp) * mm. The s cancels against inv s *) +(* (m-independence *) +(* of Cgm); sp = sqrt(2 pi) divides through. *) +let GTM_CONST_ARITH = prove + (`!s c1 mm iv sp nv:real. + &0 < s /\ &0 < sp /\ &0 <= c1 /\ + sp * nv <= s * c1 * (mm * (inv s * iv)) + ==> nv <= (c1 * iv / sp) * mm`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `~(s = &0) /\ ~(sp = &0)` STRIP_ASSUME_TAC THENL + [ASM_SIMP_TAC[REAL_LT_IMP_NZ]; ALL_TAC] THEN + SUBGOAL_THEN `sp * nv <= c1 * mm * iv` ASSUME_TAC THENL + [UNDISCH_TAC `sp * nv <= s * c1 * (mm * (inv s * iv))` THEN + REWRITE_TAC[GTM_REARR] THEN ASM_SIMP_TAC[REAL_MUL_RINV; REAL_MUL_LID]; + ALL_TAC] THEN + ASM_SIMP_TAC[GTM_DIV_REARR] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ] THEN + GEN_REWRITE_TAC (LAND_CONV) [REAL_MUL_SYM] THEN FIRST_X_ASSUM ACCEPT_TAC);; + +(* int_R cw1 >= 0 (cw1 nonneg, L^1). *) +let CW1_INTEGRAL_POS = prove + (`&0 <= real_integral (:real) cw1`, + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `real_integral (:real) (\x:real. &0)` THEN + CONJ_TAC THENL + [REWRITE_TAC[REAL_INTEGRAL_0; REAL_LE_REFL]; + MATCH_MP_TAC REAL_INTEGRAL_LE THEN + REWRITE_TAC[REAL_INTEGRABLE_0] THEN CONJ_TAC THENL + [MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE THEN + REWRITE_TAC[CW1_ABSINT]; + GEN_TAC THEN DISCH_TAC THEN MP_TAC(SPEC `x:real` CW1_POS) THEN + REAL_ARITH_TAC]]);; + +(* The dilated tent integral value: int_R cw1(3 2^m t) dt = inv(3 2^m) int *) +(* cw1. This is where the 2^m in Cgm CANCELS -- making Cgm = C1 int cw1 / *) +(* sqrt2pi m-INDEPENDENT (change of variables via *) +(* HAS_REAL_INTEGRAL_AFFINITY_UNIV). *) +let CW1_DILATE_INTEGRAL_VALUE = prove + (`!m. &0 < &2 zpow m + ==> real_integral (:real) (\t. cw1(&3 * &2 zpow m * t)) = + inv(&3 * &2 zpow m) * real_integral (:real) cw1`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&0 < &3 * &2 zpow m` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN + MP_TAC(ISPECL [`cw1`; `real_integral (:real) cw1`; `&3 * &2 zpow m`; + `&0:real`] + HAS_REAL_INTEGRAL_AFFINITY_UNIV) THEN + REWRITE_TAC[REAL_ADD_RID] THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_INTEGRABLE_INTEGRAL THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE THEN + REWRITE_TAC[CW1_ABSINT]]; + ALL_TAC] THEN + SUBGOAL_THEN `abs(&3 * &2 zpow m) = &3 * &2 zpow m` SUBST1_TAC THENL + [ASM_REWRITE_TAC[REAL_ABS_REFL] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(SUBST1_TAC o MATCH_MP REAL_INTEGRAL_UNIQUE) THEN REFL_TAC);; + +(* Translation of the shift integral: int_[a,b] |gt(x+t)| = *) +(* int_[x+a,x+b]|gt|. HAS_REAL_INTEGRAL_AFFINITY at m=1,c=x; the image *) +(* [x+a,x+b] maps to [a,b]. *) +let NORM_GT_TRANSLATE_INTEGRAL = prove + (`!(gt:real->complex) x a b. + schwartz gt + ==> real_integral (real_interval[a,b]) (\t. norm(gt(x + t))) = + real_integral (real_interval[x + a,x + b]) (\z. norm(gt z))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\z. norm((gt:real->complex) z)`; + `real_integral (real_interval[x+a,x+b]) (\z. + norm((gt:real->complex) z))`; + `x + a:real`; `x + b:real`; `&1:real`; + `x:real`] HAS_REAL_INTEGRAL_AFFINITY) THEN + REWRITE_TAC[REAL_MUL_LID; REAL_INV_1; REAL_ABS_NUM; + REAL_ARITH `&1 * x' + x = x + x'`] THEN + ANTS_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_EQ; ARITH_EQ] THEN + MATCH_MP_TAC REAL_INTEGRABLE_INTEGRAL THEN + MATCH_MP_TAC REAL_INTEGRABLE_CONTINUOUS THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `(:real)` THEN + REWRITE_TAC[SUBSET_UNIV; REAL_CONTINUOUS_ON; o_DEF; IMAGE_LIFT_UNIV] THEN + MATCH_MP_TAC CONTINUOUS_ON_LIFT_NORM_COMPOSE THEN + MP_TAC(ISPEC `gt:real->complex` SCHWARTZ_CONT) THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `IMAGE (\x'. x' - x) (real_interval[x + a,x + b]) = real_interval[a,b]` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_REAL_INTERVAL] THEN + GEN_TAC THEN EQ_TAC THENL + [STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + STRIP_TAC THEN EXISTS_TAC `x + x':real` THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + DISCH_THEN(SUBST1_TAC o MATCH_MP REAL_INTEGRAL_UNIQUE) THEN REFL_TAC);; + +(* Every average of |gt| is <= any Schwartz sup bound B (the technical sup *) +(* upper-bound feeding AVG_LE_HL_MAXIMAL's REAL_LE_SUP). *) +let AVG_NORM_LE_BOUND = prove + (`!(gt:real->complex) B c d. + schwartz gt /\ (!x. norm(gt x) <= B) /\ c < d + ==> real_integral (real_interval[c,d]) (\t. abs(norm(gt t))) / (d - c) <= + B`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[REAL_ABS_NORM] THEN + SUBGOAL_THEN `&0 < d - c` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `real_integral (real_interval[c,d]) (\t:real. B)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_LE THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; NORM_POS_LE] THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_CONTINUOUS THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `(:real)` THEN + REWRITE_TAC[SUBSET_UNIV; REAL_CONTINUOUS_ON; o_DEF; IMAGE_LIFT_UNIV] THEN + MATCH_MP_TAC CONTINUOUS_ON_LIFT_NORM_COMPOSE THEN + MP_TAC(ISPEC `gt:real->complex` SCHWARTZ_CONT) THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_INTEGRABLE_CONST]]; + ASM_SIMP_TAC[REAL_INTEGRAL_CONST; REAL_LT_IMP_LE] THEN + REWRITE_TAC[REAL_MUL_SYM; REAL_LE_REFL]]);; + +(* The straddling-average step: for |x-x'|<=2^{-m} and a<=-2^{-m}, *) +(* b>=2^{-m}, *) +(* int_[a,b]|gt(x+t)| <= g~*(x') (b-a). Translate then AVG_LE_HL_MAXIMAL *) +(* (x' is interior to [x+a,x+b]). *) +let AVG_SHIFT_LE_HL = prove + (`!(gt:real->complex) x x' m a b. + schwartz gt /\ &0 < &2 zpow m /\ abs(x - x') <= &2 zpow(--m) /\ + a <= --(&2 zpow(--m)) /\ &2 zpow(--m) <= b + ==> real_integral (real_interval[a,b]) (\t. norm(gt(x + t))) + <= hl_maximal (\z. norm(gt z)) x' * (b - a)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `gt:real->complex` SCHWARTZ_BOUNDED) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `B:real`) THEN + SUBGOAL_THEN `&0 < &2 zpow(--m)` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPECL [`gt:real->complex`; `x:real`; `a:real`; `b:real`] + NORM_GT_TRANSLATE_INTEGRAL) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + SUBGOAL_THEN `&0 < b - a` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPECL + [`\z. norm((gt:real->complex) z)`; `B:real`; `x + a:real`; `x + b:real`; + `x':real`] + AVG_LE_HL_MAXIMAL) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; ASM_REAL_ARITH_TAC; ASM_REAL_ARITH_TAC; + REPEAT STRIP_TAC THEN BETA_TAC THEN + MATCH_MP_TAC AVG_NORM_LE_BOUND THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + REWRITE_TAC[REAL_ABS_NORM; + REAL_ARITH `!x a b:real. (x + b) - (x + a) = b - a`] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ] THEN REWRITE_TAC[REAL_MUL_SYM]);; + +(* GTM_MAXIMAL_ABSTRACT = Fremlin 286L (h)(vi), abstract form. Whenever the *) +(* convolution gt * psicheck at x factors as sqrt(2 pi) v, the complex value *) +(* v *) +(* is dominated by (C1 int cw1 / sqrt2pi) times the H-L maximal function of *) +(* gt *) +(* at any x' with |x-x'| <= 2^{-m}. This is the whole (vi) chain: convol *) +(* norm *) +(* bound -> reflect -> dilated-tent MCM domination -> straddling avg <= g~* *) +(* -> *) +(* 2^m cancellation -> constant fold. *) +let GTM_MAXIMAL_ABSTRACT = prove + (`!(gt:real->complex) (v:complex) m nhat x x' C1. + schwartz gt /\ &0 < &2 zpow m /\ abs(x - x') <= &2 zpow(--m) /\ + &0 <= C1 /\ (!u. norm(carleson_phi u) <= C1 * cw1 u) /\ + convol gt (psicheck (&3 * &2 zpow m) (dyho_mid m nhat) carleson_phi) x = + Cx(sqrt(&2 * pi)) * v + ==> norm v <= (C1 * real_integral (:real) cw1 / sqrt(&2 * pi)) * + hl_maximal (\z. norm(gt z)) x'`, + REPEAT STRIP_TAC THEN + ABBREV_TAC `M = hl_maximal (\z. norm((gt:real->complex) z)) x'` THEN + SUBGOAL_THEN `&0 < sqrt(&2 * pi)` ASSUME_TAC THENL + [MATCH_MP_TAC SQRT_POS_LT THEN MP_TAC PI_POS THEN + REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `&0 < &3 * &2 zpow m` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `norm(convol gt (psicheck (&3 * &2 zpow m) (dyho_mid m nhat) carleson_phi) + x) + <= (&3 * &2 zpow m) * C1 * + real_integral (:real) (\t. norm((gt:real->complex)(x + t)) * cw1(&3 * &2 + zpow m * t))` + ASSUME_TAC THENL + [MP_TAC(ISPECL [`gt:real->complex`; `m:int`; `nhat:int`; `x:real`; + `C1:real`] + GTM_CONVOL_REAL_BOUND) THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[M6_REFLECT]; ALL_TAC] THEN + SUBGOAL_THEN + `real_integral (:real) (\t. norm((gt:real->complex)(x + t)) * cw1(&3 * &2 + zpow m * t)) + <= M * (inv(&3 * &2 zpow m) * real_integral (:real) cw1)` + ASSUME_TAC THENL + [MP_TAC(SPEC `m:int` CW1_DILATE_INTEGRAL_VALUE) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM th]) + THEN + MATCH_MP_TAC GT_DILATE_MCM_BOUND THEN ASM_REWRITE_TAC[] THEN + REPEAT STRIP_TAC THEN EXPAND_TAC "M" THEN + MATCH_MP_TAC AVG_SHIFT_LE_HL THEN EXISTS_TAC `m:int` THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `sqrt(&2 * pi) * norm(v:complex) + <= (&3 * &2 zpow m) * C1 * + (M * (inv(&3 * &2 zpow m) * real_integral (:real) cw1))` + ASSUME_TAC THENL + [SUBGOAL_THEN + `sqrt(&2 * pi) * norm(v:complex) = + norm(convol gt (psicheck (&3 * &2 zpow m) (dyho_mid m nhat) carleson_phi) + x)` + SUBST1_TAC THENL + [ASM_REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < s ==> abs s = s`]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(&3 * &2 zpow m) * C1 * + real_integral (:real) (\t. norm((gt:real->complex)(x + t)) * cw1(&3 * &2 + zpow m * t))` THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL [`&3 * &2 zpow m`; `C1:real`; `M:real`; + `real_integral (:real) cw1`; + `sqrt(&2 * pi)`; `norm(v:complex)`] GTM_CONST_ARITH) THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[]);; + +(* --- 286Gd: the two-sided continuous weight sum sum_{n in Z} w(x-n) <= 2 *) +(* --- *) +(* (v2's pointwise engine in alpha2: sum_{sigma: k_sigma=k} *) +(* w(2^k(x-x_sigma)) <= *) +(* sum_n w(2^k x - n - 1/2) <= 2, since the x_sigma lie on the half-integer *) +(* grid.) *) +(* Route: nearest-integer split; peak term w(r) <= 1; each side sum <= 1/2 *) +(* via the *) +(* CUBIC telescoping tail CW_SUM_BOUND (NOT the Hermite-Hadamard integral *) +(* comparison). *) + +(* Per-term shift bound: for |r| <= 1/2 and offset j >= 1, both cw(r-&j) and *) +(* cw(r+&j) *) +(* are <= cw(j-1/2) (the nearest the shifted point can get to 0 is j-1/2). *) +(* CW_ANTITONE. *) +let CW_SHIFT_BND = prove + (`!r j:num. abs r <= &1 / &2 /\ 1 <= j + ==> cw(r - &j) <= cw(&j - &1 / &2) /\ cw(r + &j) <= cw(&j - &1 / &2)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `&1 <= &j` ASSUME_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_LE] THEN ASM_ARITH_TAC; ALL_TAC] THEN + CONJ_TAC THEN MATCH_MP_TAC CW_ANTITONE THEN ASM_REAL_ARITH_TAC);; + +(* The half-integer partial sum sum_{1..N} w(j-1/2) <= 1/2. Reindex j |-> *) +(* j-1 (via *) +(* SUM_OFFSET, instantiated EXPLICITLY to avoid the aggressive 1 = 0+1 *) +(* rewrite hitting *) +(* the &1/&2) to sum_{0..N-1} w(j+1/2), then CW_SUM_BOUND at m=0 gives <= *) +(* 1/(2 (1)^2). *) +let CW_NUMSEG_HALF_SUM = prove + (`!N:num. sum (1..N) (\j. cw(&j - &1 / &2)) <= &1 / &2`, + GEN_TAC THEN ASM_CASES_TAC `N = 0` THENL + [ASM_REWRITE_TAC[] THEN REWRITE_TAC[num_CONV `1`; SUM_CLAUSES_NUMSEG] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN + SUBGOAL_THEN `?M. N = M + 1` (CHOOSE_THEN SUBST_ALL_TAC) THENL + [EXISTS_TAC `N - 1` THEN ASM_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `sum (1..M + 1) (\j. cw(&j - &1 / &2)) = sum (0..M) (\j. cw(&j + &1 / &2))` + SUBST1_TAC THENL + [MP_TAC(ISPECL [`1`; `\j:num. cw(&j - &1 / &2)`; `0`; + `M:num`] SUM_OFFSET) THEN + REWRITE_TAC[ADD_CLAUSES] THEN DISCH_THEN SUBST1_TAC THEN + MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `i:num` THEN DISCH_TAC THEN + REWRITE_TAC[] THEN + AP_TERM_TAC THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC; + MP_TAC(ISPECL [`0`; `M:num`] CW_SUM_BOUND) THEN + MATCH_MP_TAC(REAL_ARITH `c = &1 / &2 ==> s <= c ==> s <= &1 / &2`) THEN + CONV_TAC REAL_RAT_REDUCE_CONV]);; + +(* One-sided sums (left and right of the peak): for a finite set J of *) +(* offsets >= 1, *) +(* sum_{j in J} cw(r -/+ &j) <= 1/2. Dominate termwise by cw(j-1/2) *) +(* (CW_SHIFT_BND), *) +(* then by the full sum_{1..maxJ} (nonneg tail, CW_POS), then *) +(* CW_NUMSEG_HALF_SUM. *) +let CW_ONESIDE_SUM = prove + (`!r (J:num->bool). abs r <= &1 / &2 /\ FINITE J /\ (!j. j IN J ==> 1 <= j) + ==> sum J (\j. cw(r - &j)) <= &1 / &2`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum J (\j. cw(&j - &1 / &2))` THEN CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `j:num` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + MP_TAC(ISPECL [`r:real`; `j:num`] CW_SHIFT_BND) THEN ASM_SIMP_TAC[] THEN + SIMP_TAC[]; + ALL_TAC] THEN + MP_TAC(ISPECL [`\j:num. j`; `J:num->bool`] UPPER_BOUND_FINITE_SET) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum (1..N) (\j. cw(&j - &1 / &2))` THEN CONJ_TAC THENL + [MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN + ASM_REWRITE_TAC[FINITE_NUMSEG] THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET; IN_NUMSEG] THEN X_GEN_TAC `j:num` THEN DISCH_TAC THEN + CONJ_TAC THENL [ASM_SIMP_TAC[]; ASM_SIMP_TAC[]]; + X_GEN_TAC `j:num` THEN REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN REWRITE_TAC[CW_POS]]; + REWRITE_TAC[CW_NUMSEG_HALF_SUM]]);; + +let CW_ONESIDE_SUM_R = prove + (`!r (J:num->bool). abs r <= &1 / &2 /\ FINITE J /\ (!j. j IN J ==> 1 <= j) + ==> sum J (\j. cw(r + &j)) <= &1 / &2`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum J (\j. cw(&j - &1 / &2))` THEN CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `j:num` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + MP_TAC(ISPECL [`r:real`; `j:num`] CW_SHIFT_BND) THEN ASM_SIMP_TAC[] THEN + SIMP_TAC[]; + ALL_TAC] THEN + MP_TAC(ISPECL [`\j:num. j`; `J:num->bool`] UPPER_BOUND_FINITE_SET) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum (1..N) (\j. cw(&j - &1 / &2))` THEN CONJ_TAC THENL + [MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN + ASM_REWRITE_TAC[FINITE_NUMSEG] THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET; IN_NUMSEG] THEN X_GEN_TAC `j:num` THEN DISCH_TAC THEN + CONJ_TAC THENL [ASM_SIMP_TAC[]; ASM_SIMP_TAC[]]; + X_GEN_TAC `j:num` THEN REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN REWRITE_TAC[CW_POS]]; + REWRITE_TAC[CW_NUMSEG_HALF_SUM]]);; + +(* The tile weight is antitone in the distance from its centre x_sigma: *) +(* points *) +(* further from x_sigma have smaller w_sigma. (Underlies 286L(c)'s sup_{x in *) +(* K} *) +(* w_sigma bound.) Lifts CW_ANTITONE through the positive 2^k scaling. *) +let CWTILE_ANTITONE = prove + (`!(s:int#int#int) x y. abs(y - tile_xmid s) <= abs(x - tile_xmid s) + ==> cw_tile s x <= cw_tile s y`, + REPEAT STRIP_TAC THEN REWRITE_TAC[cw_tile] THEN + SUBGOAL_THEN `&0 < &2 zpow (tile_k s)` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC CW_ANTITONE THEN + REWRITE_TAC[REAL_ABS_MUL] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_ABS_POS]; ASM_REWRITE_TAC[]]);; + +(* 286L(c-i) geometric decay: if the point x is at distance >= d from the *) +(* tile *) +(* centre x_sigma, the tile weight there is <= its value at distance exactly *) +(* d, *) +(* cw_tile s x <= 2^{k} cw(2^{k} d). *) +(* (cw_tile s (x_s + d) = 2^k cw(2^k d), and CWTILE_ANTITONE monotone in the *) +(* centre-distance.) Supplies the Mw = 2^{k} cw(2^{k} rho(x_s,K)) upper *) +(* bound to *) +(* CARLESON_KERNEL_CI, with d = rho(x_s,K) the distance from x_sigma to the *) +(* cover *) +(* cell K (x_sigma lies outside K, since I_sigma escapes the tripled cell *) +(* Kstar). *) +let CWTILE_DIST_BOUND = prove + (`!(s:int#int#int) x d. &0 <= d /\ d <= abs(x - tile_xmid s) + ==> cw_tile s x <= &2 zpow (tile_k s) * cw(&2 zpow (tile_k s) * d)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&2 zpow (tile_k s) * cw(&2 zpow (tile_k s) * d) = + cw_tile s (tile_xmid s + d)` SUBST1_TAC THENL + [REWRITE_TAC[cw_tile] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC CWTILE_ANTITONE THEN + REWRITE_TAC[REAL_ARITH `(tile_xmid s + d) - tile_xmid s = d`] THEN + ASM_REAL_ARITH_TAC);; + +(* 2^k_tau * 2^(k - k_tau - 1) = 2^(k-1) (zpow exponent arithmetic). *) +let TILE_IDIL_INTERVAL = prove + (`!(s:int#int#int) k. tile_Idil s k = + real_interval(tile_xmid s - &2 zpow (&k - tile_k s - &1), + tile_xmid s + &2 zpow (&k - tile_k s - &1))`, + REPEAT GEN_TAC THEN + REWRITE_TAC[tile_Idil; EXTENSION; IN_ELIM_THM; IN_REAL_INTERVAL] THEN + GEN_TAC THEN REAL_ARITH_TAC);; + +let ZPOW_DOUBLE_KTAU = prove + (`!(s:int#int#int) k. &2 * &2 zpow (&k - tile_k s - &1) = &2 zpow (&k - tile_k + s)`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN + `&2 zpow (&k - tile_k s) = &2 zpow (&1 + (&k - tile_k s - &1))` SUBST1_TAC + THENL + [AP_TERM_TAC THEN INT_ARITH_TAC; ALL_TAC] THEN + SIMP_TAC[REAL_ZPOW_ADD; REAL_ARITH `~(&2 = &0)`; REAL_ZPOW_1]);; + +let TILE_IDIL_MEASURABLE = prove + (`!(s:int#int#int) k. real_measurable (tile_Idil s k)`, + REWRITE_TAC[TILE_IDIL_INTERVAL; REAL_MEASURABLE_REAL_INTERVAL]);; + +let TILE_IDIL_MEASURE = prove + (`!(s:int#int#int) k. real_measure (tile_Idil s k) = &2 zpow (&k - tile_k s)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[TILE_IDIL_INTERVAL; REAL_MEASURE_REAL_INTERVAL] THEN + SUBGOAL_THEN + `(tile_xmid s + &2 zpow (&k - tile_k s - &1)) - + (tile_xmid s - &2 zpow (&k - tile_k s - &1)) = &2 zpow (&k - tile_k s)` + SUBST1_TAC THENL + [REWRITE_TAC[REAL_ARITH `(c + r) - (c - r) = &2 * r`; ZPOW_DOUBLE_KTAU]; + ALL_TAC] THEN + REWRITE_TAC[REAL_ARITH `max x (&0) = x <=> &0 <= x`] THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN MATCH_MP_TAC REAL_ZPOW_LT THEN + REAL_ARITH_TAC);; + +(* Dilate geometry for 286J(c): the I_tau^(k) nest and base-containment. *) +(* Monotone in k: I^(k)_s SUBSET I^(k')_s for k<=k' (half-widths 2^(k-k_s-1) *) +(* <= *) +(* 2^(k'-k_s-1) via ZPOW2_MONOE). Base: I_s SUBSET I^(k)_s for k>=1 (a point *) +(* of *) +(* I_s is within 2^(-k_s) of x_s [DYHO_MID_DIST] <= 2^(k-k_s-1) half-width). *) +let TILE_IDIL_MONO = prove + (`!(s:int#int#int) k k'. k <= k' ==> tile_Idil s k SUBSET tile_Idil s k'`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[TILE_IDIL_INTERVAL; SUBSET; IN_REAL_INTERVAL] THEN + X_GEN_TAC `x:real` THEN + SUBGOAL_THEN `&2 zpow (&k - tile_k s - &1) <= &2 zpow (&k' - tile_k s - &1)` + MP_TAC THENL + [MATCH_MP_TAC ZPOW2_MONOE THEN + FIRST_ASSUM(MP_TAC o REWRITE_RULE[GSYM INT_OF_NUM_LE]) THEN INT_ARITH_TAC; + REAL_ARITH_TAC]);; + +let CWTILE_OUTSIDE_IDIL_LE = prove + (`!tau k x. + ~(x IN tile_Idil tau k) + ==> cw_tile tau x <= + cw_tile tau (tile_xmid tau + &2 zpow (&k - tile_k tau - &1))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CWTILE_ANTITONE THEN + POP_ASSUM MP_TAC THEN + REWRITE_TAC[tile_Idil; IN_ELIM_THM; REAL_NOT_LT] THEN DISCH_TAC THEN + SUBGOAL_THEN `&0 <= &2 zpow (&k - tile_k tau - &1)` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LE THEN REAL_ARITH_TAC; ALL_TAC] THEN + ASM_REAL_ARITH_TAC);; + +(* the edge value: cw_tile tau (x_tau + 2^{k-k_tau-1}) = 2^{k_tau} *) +(* cw(2^{k-1}). *) +let CWTILE_IDIL_EDGE_VALUE = prove + (`!tau k. + cw_tile tau (tile_xmid tau + &2 zpow (&k - tile_k tau - &1)) = + &2 zpow (tile_k tau) * cw (&2 zpow (&k - &1))`, + REPEAT GEN_TAC THEN REWRITE_TAC[cw_tile] THEN + SUBGOAL_THEN `&2 zpow (tile_k tau) * + ((tile_xmid tau + &2 zpow (&k - tile_k tau - &1)) - tile_xmid tau) = + &2 zpow (&k - &1)` SUBST1_TAC THENL + [REWRITE_TAC[REAL_ARITH `!x e:real. (x + e) - x = e`] THEN + SIMP_TAC[GSYM REAL_ZPOW_ADD; REAL_OF_NUM_EQ; ARITH_EQ] THEN + AP_TERM_TAC THEN INT_ARITH_TAC; + REFL_TAC]);; + +(* combined: outside I^(k)_tau, w_tau(x) <= 2^{k_tau} cw(2^{k-1}). This is *) +(* the *) +(* pointwise weight bound feeding the annulus tail sum of 286J(b). *) +let CWTILE_OUTSIDE_IDIL_BOUND = prove + (`!tau k x. + ~(x IN tile_Idil tau k) + ==> cw_tile tau x <= &2 zpow (tile_k tau) * cw (&2 zpow (&k - &1))`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `cw_tile tau (tile_xmid tau + &2 zpow (&k - tile_k tau - &1))` + THEN + ASM_SIMP_TAC[CWTILE_OUTSIDE_IDIL_LE; CWTILE_IDIL_EDGE_VALUE; REAL_LE_REFL]);; + +(* peak weight bound: w_tau(x) <= muJ_tau = 2^{k_tau} everywhere (cw <= 1). *) +let CWTILE_LE_MUJ = prove + (`!s x. cw_tile s x <= &2 zpow (tile_k s)`, + REPEAT GEN_TAC THEN REWRITE_TAC[cw_tile] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN + REWRITE_TAC[CW_LE_1] THEN MATCH_MP_TAC REAL_ZPOW_LE THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Measure of a dyadic interval: mu(dyho k n) = 2^k, and of a tile's spatial *) +(* interval: mu(I_tau) = 2^(-k_tau). dyho k n = (a,b) UNION {a} (half-open), *) +(* so the left endpoint is a null add-on. *) +(* ------------------------------------------------------------------------- *) + +let REAL_MEASURABLE_SING = prove + (`!a:real. real_measurable {a}`, + GEN_TAC THEN MATCH_MP_TAC HAS_REAL_MEASURE_IMP_REAL_MEASURABLE THEN + EXISTS_TAC `&0` THEN REWRITE_TAC[HAS_REAL_MEASURE_0; REAL_NEGLIGIBLE_SING]);; + +let REAL_MEASURE_SING = prove + (`!a:real. real_measure {a} = &0`, + GEN_TAC THEN MATCH_MP_TAC REAL_MEASURE_UNIQUE THEN + REWRITE_TAC[HAS_REAL_MEASURE_0; REAL_NEGLIGIBLE_SING]);; + +let DYHO_UNION_SING = prove + (`!k n. dyho k n = + real_interval(real_of_int n * &2 zpow k, (real_of_int n + &1) * &2 zpow k) + UNION + {real_of_int n * &2 zpow k}`, + REPEAT GEN_TAC THEN REWRITE_TAC[dyho; EXTENSION; IN_UNION; IN_ELIM_THM; + IN_REAL_INTERVAL; IN_SING] THEN + GEN_TAC THEN + SUBGOAL_THEN + `real_of_int n * &2 zpow k < (real_of_int n + &1) * &2 zpow k` MP_TAC THENL + [MATCH_MP_TAC REAL_LT_RMUL THEN CONJ_TAC THENL + [REAL_ARITH_TAC; MATCH_MP_TAC REAL_ZPOW_LT THEN + REAL_ARITH_TAC]; ALL_TAC] THEN + REAL_ARITH_TAC);; + +let DYHO_MEASURABLE = prove + (`!k n. real_measurable (dyho k n)`, + REPEAT GEN_TAC THEN REWRITE_TAC[DYHO_UNION_SING] THEN + MATCH_MP_TAC REAL_MEASURABLE_UNION THEN + REWRITE_TAC[REAL_MEASURABLE_REAL_INTERVAL; REAL_MEASURABLE_SING]);; + +let DYHO_MEASURE = prove + (`!k n. real_measure (dyho k n) = &2 zpow k`, + REPEAT GEN_TAC THEN REWRITE_TAC[DYHO_UNION_SING] THEN + W(MP_TAC o PART_MATCH (lhs o rand) REAL_MEASURE_REAL_NEGLIGIBLE_UNION o lhs o + snd) THEN + REWRITE_TAC[REAL_MEASURABLE_REAL_INTERVAL; REAL_MEASURABLE_SING] THEN + ANTS_TAC THENL + [MATCH_MP_TAC REAL_NEGLIGIBLE_SUBSET THEN + EXISTS_TAC `{real_of_int n * &2 zpow k}` THEN + REWRITE_TAC[REAL_NEGLIGIBLE_SING; INTER_SUBSET]; ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[REAL_MEASURE_REAL_INTERVAL; REAL_MEASURE_SING; REAL_ADD_RID] THEN + SUBGOAL_THEN + `(real_of_int n + &1) * &2 zpow k - real_of_int n * &2 zpow k = &2 zpow k` + SUBST1_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_ARITH `max x (&0) = x <=> &0 <= x`] THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN MATCH_MP_TAC REAL_ZPOW_LT THEN + REAL_ARITH_TAC);; + +let TILE_I_MEASURE = prove + (`!(k:int) (nI:int) (nJ:int). + real_measure (tile_I (k,nI,nJ)) = &2 zpow (--k)`, + REWRITE_TAC[tile_I; DYHO_MEASURE]);; + +let TILE_I_MEASURABLE = prove + (`!(k:int) (nI:int) (nJ:int). real_measurable (tile_I (k,nI,nJ))`, + REWRITE_TAC[tile_I; DYHO_MEASURABLE]);; + +(* ------------------------------------------------------------------------- *) +(* 286L maximal-cover backbone (abstract set theory). In a finite family of *) +(* sets, every member is contained in a SUBSET-MAXIMAL member -- the greedy *) +(* selection Fremlin's maximal dyadic cover K rests on. No such lemma exists *) +(* in the library, so it is built here from finiteness. *) +(* ------------------------------------------------------------------------- *) + +(* The candidate set {N in Fam | s' SUBSET N} shrinks strictly when s' *) +(* strictly enlarges s (s stays above s but drops below s'), giving the *) +(* well-founded measure for the maximal-member recursion. *) +let DISJOINT_FAMILY_MEASURE_SUM = prove + (`!K:(real->bool)->bool. FINITE K /\ + (!c. c IN K ==> real_measurable c) /\ + (!M1 M2. M1 IN K /\ M2 IN K /\ ~(M1 = M2) ==> DISJOINT M1 M2) + ==> real_measure(UNIONS K) = sum K (\c. real_measure c)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\c:real->bool. c`; `K:(real->bool)->bool`] + REAL_MEASURE_DISJOINT_UNIONS_IMAGE) THEN + ASM_REWRITE_TAC[IMAGE_ID; ETA_AX]);; + +(* 286L(a-ii) measure-counting core: a FINITE family K of pairwise-disjoint *) +(* measurable cells, all contained in a bounded measurable B, has total *) +(* measure *) +(* sum_{c in K} mu(c) <= mu(B). (sum = mu(UNIONS K) by *) +(* DISJOINT_FAMILY_MEASURE_SUM; *) +(* UNIONS K SUBSET B by REAL_MEASURE_SUBSET.) In 286L: the cover cells K *) +(* with *) +(* l_K >= k_tau are disjoint and sit in Ihat (mu = 7 2^{-k_tau}), so sum *) +(* 2^{-l_K} <= *) +(* 7 2^{-k_tau} -- the a-ii bound driving alpha0. *) +let DISJOINT_CELLS_MEASURE_SUM_LE = prove + (`!(K:(real->bool)->bool) B. + FINITE K /\ real_measurable B /\ + (!c. c IN K ==> real_measurable c) /\ + (!c. c IN K ==> c SUBSET B) /\ + (!M1 M2. M1 IN K /\ M2 IN K /\ ~(M1 = M2) ==> DISJOINT M1 M2) + ==> sum K (\c. real_measure c) <= real_measure B`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `K:(real->bool)->bool` DISJOINT_FAMILY_MEASURE_SUM) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC REAL_MEASURE_SUBSET THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_MEASURABLE_UNIONS THEN ASM_REWRITE_TAC[]; + ASM SET_TAC[]]);; + +(* Abstract per-cover-cell summation: if each cell's contribution g(c) <= D *) +(* mu(c) (D >= 0) and the cells' total measure sum mu(c) <= S, then sum g(c) *) +(* <= D S. Packages the alpha0/alpha1 "per-cell bound x measure-counting" *) +(* step: with D = 2 C1 energy mass (the per-cell factor from *) +(* ABSTRACT_SCALE_GEOM_SUM, since mu(K) = 2^{-l_K}) and S = mu(Ihat) = 7 *) +(* 2^{-k_tau} (from DISJOINT_CELLS_MEASURE_ SUM_LE), gives sum_K g(K) <= 14 *) +(* C1 energy mass 2^{-k_tau} -- the alpha0 shape. *) +let dyho_star = new_definition + `dyho_star (k:int) (n:int) = + {x:real | (real_of_int n - &1) * &2 zpow k <= x /\ + x < (real_of_int n + &2) * &2 zpow k}`;; + +let DYHO_SUBSET_STAR = prove + (`!k n. dyho k n SUBSET dyho_star k n`, + REPEAT GEN_TAC THEN REWRITE_TAC[dyho; dyho_star; SUBSET; IN_ELIM_THM] THEN + X_GEN_TAC `x:real` THEN + SUBGOAL_THEN `&0 < &2 zpow k` MP_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + REAL_ARITH_TAC);; + +(* The TRIPLED child cell sits inside the TRIPLED parent: (dyho a p)* SUBSET *) +(* (dyho (a+1) (p div 2))*. Key to the maximal-cover soundness -- with p = *) +(* 2q+r, *) +(* r in {0,1}: child* = [(p-1)2^a,(p+2)2^a), parent* = *) +(* [(2q-2)2^a,(2q+4)2^a); -1<=r *) +(* and r<=2 give the containment on both edges. *) +let DYHO_STAR_PARENT = prove + (`!a p:int. dyho_star a p SUBSET dyho_star (a + &1) (p div &2)`, + REPEAT GEN_TAC THEN REWRITE_TAC[dyho_star; SUBSET; IN_ELIM_THM] THEN + X_GEN_TAC `x:real` THEN + SUBGOAL_THEN + `&0 < &2 zpow a /\ &2 zpow (a + &1) = + &2 * &2 zpow a` STRIP_ASSUME_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; + SIMP_TAC[REAL_ZPOW_ADD; REAL_ARITH `~(&2 = &0)`] THEN + REWRITE_TAC[REAL_ZPOW_1] THEN REAL_ARITH_TAC]; ALL_TAC] THEN + SUBGOAL_THEN + `real_of_int p = &2 * real_of_int (p div &2) + real_of_int(p rem &2) /\ + &0 <= real_of_int(p rem &2) /\ real_of_int(p rem &2) <= &1` + STRIP_ASSUME_TAC THENL + [MP_TAC(SPECL [`p:int`; `&2:int`] INT_DIVISION) THEN + ANTS_TAC THENL [INT_ARITH_TAC; ALL_TAC] THEN + STRIP_TAC THEN REWRITE_TAC[GSYM REAL_OF_INT_CLAUSES] THEN + REPEAT CONJ_TAC THEN REWRITE_TAC[REAL_OF_INT_CLAUSES] THEN + ASM_INT_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `(real_of_int (p div &2) - &1) * &2 zpow (a + &1) = + (real_of_int p - &1) * &2 zpow a - (&1 + real_of_int(p rem &2)) * &2 zpow a + /\ + (real_of_int (p div &2) + &2) * &2 zpow (a + &1) = + (real_of_int p + &2) * &2 zpow a + (&2 - real_of_int(p rem &2)) * &2 zpow + a` + (CONJUNCTS_THEN SUBST1_TAC) THENL + [CONJ_TAC THEN + MAP_EVERY UNDISCH_TAC + [`real_of_int p = &2 * real_of_int (p div &2) + real_of_int(p rem &2)`; + `&2 zpow (a + &1) = &2 * &2 zpow a`] THEN + CONV_TAC REAL_RING; ALL_TAC] THEN + SUBGOAL_THEN `&0 <= (&1 + real_of_int(p rem &2)) * &2 zpow a /\ + &0 <= (&2 - real_of_int(p rem &2)) * &2 zpow a` + STRIP_ASSUME_TAC THENL + [CONJ_TAC THEN MATCH_MP_TAC REAL_LE_MUL THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + FIRST_X_ASSUM(K ALL_TAC o check (fun th -> + free_in `(p:int) div &2` (concl th)) o SPEC_ALL) THEN + STRIP_TAC THEN CONJ_TAC THEN ASM_REAL_ARITH_TAC);; + +(* 286L(a) buffer: a point x OUTSIDE the tripled cell dyho_star k n is at *) +(* least *) +(* 2^k away from every point y IN dyho k n. (dyho_star = [(n-1)2^k, *) +(* (n+2)2^k), *) +(* dyho = [n 2^k, (n+1)2^k); the excluded region is a full cell-width past *) +(* each *) +(* edge.) This is the rho(x_sigma, K) >= 2^{-l_K} lower bound feeding the *) +(* alpha0/ *) +(* alpha1 offset map's range: I_sigma escapes K-tripled => x_sigma outside *) +(* K* => *) +(* dist(x_sigma, K) >= mu K = 2^{-l_K}. *) +let in_jscript = new_definition + `in_jscript (P:(int#int#int)->bool) (a:int) (p:int) <=> + !s. s IN P /\ &2 zpow (--(tile_k s)) <= &2 zpow a + ==> ~(tile_I s SUBSET dyho_star a p)`;; + +(* in_kcover P a p: dyho a p is a MAXIMAL member of Cal J = a cover cell of *) +(* Cal K. *) +let in_kcover = new_definition + `in_kcover (P:(int#int#int)->bool) (a:int) (p:int) <=> + in_jscript P a p /\ ~(in_jscript P (a + &1) (p div &2))`;; + +(* PARENT-DOWNWARD-CLOSURE of Cal J: if the parent cell is in Cal J, so is *) +(* the *) +(* child. This is what makes in_kcover (in J /\ parent not in J) coincide *) +(* with the *) +(* genuine "maximal member of Cal J": climbing parents, once you leave Cal J *) +(* you *) +(* stay out (contrapositive), so the first cell to leave IS the maximal one. *) +(* Proof: *) +(* a witness sigma for child-not-in-J (mu I_sigma <= 2^a, I_sigma inside *) +(* child-triple) *) +(* also witnesses parent-not-in-J: 2^a <= 2^{a+1} and child-triple SUBSET *) +(* parent- *) +(* triple (DYHO_STAR_ *) +(* PARENT). *) +let KCOVER_PARENT_WITNESS = prove + (`!P:(int#int#int)->bool a p. + in_kcover P a p + ==> ?sig. sig IN P /\ &2 zpow (--(tile_k sig)) <= &2 zpow (a + &1) /\ + tile_I sig SUBSET dyho_star (a + &1) (p div &2)`, + REWRITE_TAC[in_kcover; in_jscript] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o check (is_neg o concl)) THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN SIMP_TAC[]);; + +(* 286L(e) step a (interpolate): from the witness sigma (mu I_sigma <= 2 mu *) +(* K = 2^{a+1}) *) +(* and P's lower bound tau (tile_le sig tau), with 2 mu K <= mu I_tau *) +(* (2^{a+1} <= *) +(* 2^{-k_tau}, the W2 case mu K < mu I_tau), TILE_INTERP yields upsilon at *) +(* scale *) +(* k_ups = -(a+1) (mu I_ups = 2^{a+1} = 2 mu K) with tau <= ups <= sigma (my *) +(* tile_le sig *) +(* ups /\ tile_le ups tau). Scale bounds k_tau <= -(a+1) <= k_sig via *) +(* ZPOW2_LE_REV. *) +let GK_UPSILON = prove + (`!P:(int#int#int)->bool a p sig tau. + sig IN P /\ tile_le sig tau /\ + &2 zpow (--(tile_k sig)) <= &2 zpow (a + &1) /\ + &2 zpow (a + &1) <= &2 zpow (--(tile_k tau)) + ==> ?ups. tile_le sig ups /\ tile_le ups tau /\ tile_k ups = --(a + &1)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC TILE_INTERP THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o MATCH_MP ZPOW2_LE_REV o + check(fun th -> rand(concl th) = `&2 zpow (--(tile_k tau))`)) THEN + INT_ARITH_TAC; + FIRST_X_ASSUM(MP_TAC o MATCH_MP ZPOW2_LE_REV o + check(fun th -> lhand(concl th) = `&2 zpow (--(tile_k sig))`)) THEN + INT_ARITH_TAC]);; + +(* GENERAL nested-cell facts (for cover disjointness). From dyho a p SUBSET *) +(* dyho b *) +(* q: the endpoint inequalities (left/right), the tripled cells nest too, *) +(* and Cal J *) +(* is closed under passing to sub-cells. *) +let DYHO_SUBSET_ENDPOINTS = prove + (`!a b p q:int. a <= b /\ dyho a p SUBSET dyho b q + ==> real_of_int q * &2 zpow b <= real_of_int p * &2 zpow a /\ + (real_of_int p + &1) * &2 zpow a <= (real_of_int q + &1) * &2 zpow b`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `&0 < &2 zpow a /\ &0 < &2 zpow b` STRIP_ASSUME_TAC THENL + [CONJ_TAC THEN MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + FIRST_ASSUM(LABEL_TAC "mem" o REWRITE_RULE[dyho; SUBSET; IN_ELIM_THM] o + check (fun th -> is_binary "SUBSET" (concl th))) THEN + CONJ_TAC THENL + [USE_THEN "mem" (MP_TAC o SPEC `real_of_int p * &2 zpow a`) THEN + ANTS_TAC THENL [CONJ_TAC THENL + [REAL_ARITH_TAC; ASM_REAL_ARITH_TAC]; REAL_ARITH_TAC]; + ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `~(y < x) ==> x <= y`) THEN DISCH_TAC THEN + USE_THEN "mem" (MP_TAC o SPEC + `max (real_of_int p * &2 zpow a) ((real_of_int q + &1) * &2 zpow b)`) THEN + MATCH_MP_TAC(TAUT `a /\ ~b ==> (a ==> b) ==> F`) THEN CONJ_TAC THENL + [CONJ_TAC THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[DE_MORGAN_THM; REAL_NOT_LE; REAL_NOT_LT] THEN DISJ2_TAC THEN + ASM_REAL_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* One-sidedness (286Gg geometry): a proper dyadic sub-cell lies entirely on *) +(* one side of the coarser cell's midpoint. Needed so 286Gc (the CWTILE *) +(* midpoint-integral lemmas) applies to int_{I_tau} w_sigma (I_tau one side *) +(* of *) +(* x_sigma). *) +(* ------------------------------------------------------------------------- *) + +(* roi m < roi n + 1 ==> m <= n (integer discreteness through the reals). *) +let INT_LE_OF_REAL_LT1 = prove + (`!m n:int. real_of_int m < real_of_int n + &1 ==> m <= n`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `real_of_int n + &1 = real_of_int(n + &1)` SUBST1_TAC THENL + [REWRITE_TAC[int_add_th; int_of_num_th]; ALL_TAC] THEN + REWRITE_TAC[GSYM int_lt] THEN INT_ARITH_TAC);; + +(* CRUX: for a0). *) +let DYHO_MID_INTERIOR_EVEN_FALSE = prove + (`!a b p q M':int. &2 zpow (b - a) = real_of_int (&2 * M') /\ + real_of_int p * &2 zpow a < (real_of_int q + &1 / &2) * &2 zpow b /\ + (real_of_int q + &1 / &2) * &2 zpow b < (real_of_int p + &1) * &2 zpow a + ==> F`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `&0 < &2 zpow a` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `(real_of_int q + &1 / &2) * &2 zpow b = + real_of_int(&2 * q * M' + M') * &2 zpow a` ASSUME_TAC THENL + [SUBGOAL_THEN + `&2 zpow b = real_of_int(&2 * M') * &2 zpow a` SUBST1_TAC THENL + [FIRST_X_ASSUM(fun th -> MP_TAC th THEN DISCH_THEN(SUBST1_TAC o SYM)) THEN + SIMP_TAC[GSYM REAL_ZPOW_ADD; REAL_ARITH `~(&2 = &0)`] THEN + AP_TERM_TAC THEN INT_ARITH_TAC; + REWRITE_TAC[int_add_th; int_mul_th; int_of_num_th] THEN REAL_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN + `real_of_int p * &2 zpow a < real_of_int(&2 * q * M' + M') * &2 zpow a /\ + real_of_int(&2 * q * M' + M') * &2 zpow a < (real_of_int p + + &1) * &2 zpow a` + MP_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LT_RMUL_EQ] THEN + REWRITE_TAC[int_add_th; int_mul_th; int_of_num_th] THEN + REWRITE_TAC[GSYM int_of_num_th; GSYM int_mul_th; GSYM int_add_th] THEN + REWRITE_TAC[GSYM int_lt] THEN INT_ARITH_TAC);; + +(* Same-scale case: the coarser midpoint interior forces equal indices. *) +let DYHO_ONESIDE_SAMESCALE_EQ = prove + (`!b p q:int. + real_of_int p * &2 zpow b < (real_of_int q + &1 / &2) * &2 zpow b /\ + (real_of_int q + &1 / &2) * &2 zpow b < (real_of_int p + &1) * &2 zpow b + ==> p = q`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `&0 < &2 zpow b` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LT_RMUL_EQ] THEN STRIP_TAC THEN + SUBGOAL_THEN `p:int <= q` ASSUME_TAC THENL + [MATCH_MP_TAC INT_LE_OF_REAL_LT1 THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `q:int <= p` ASSUME_TAC THENL + [MATCH_MP_TAC INT_LE_OF_REAL_LT1 THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_INT_ARITH_TAC);; + +(* One-sidedness proper: dyho a p SUBSET dyho b q (a<=b, proper) ==> the *) +(* finer cell dyho a p lies wholly at-or-left, or wholly at-or-right, of *) +(* dyho_mid b q. 3-case split on the coarse midpoint vs the finer cell's *) +(* endpoints; the "strict interior" case is impossible *) +(* (DYHO_MID_INTERIOR_EVEN_FALSE for a (!x. x IN dyho a p ==> x <= dyho_mid b q) \/ + (!x. x IN dyho a p ==> dyho_mid b q <= x)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`a:int`; `b:int`; `p:int`; + `q:int`] DYHO_SUBSET_ENDPOINTS) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + REWRITE_TAC[dyho_mid] THEN + DISJ_CASES_TAC(REAL_ARITH + `(real_of_int p + &1) * &2 zpow a <= (real_of_int q + &1 / &2) * &2 zpow b + \/ + (real_of_int q + &1 / &2) * &2 zpow b <= real_of_int p * &2 zpow a \/ + (real_of_int p * &2 zpow a < (real_of_int q + &1 / &2) * &2 zpow b /\ + (real_of_int q + &1 / &2) * &2 zpow b < (real_of_int p + &1) * &2 zpow + a)`) THENL + [DISJ1_TAC THEN X_GEN_TAC `x:real` THEN REWRITE_TAC[dyho; IN_ELIM_THM] THEN + STRIP_TAC THEN ASM_REAL_ARITH_TAC; + POP_ASSUM(DISJ_CASES_THEN2 ASSUME_TAC ASSUME_TAC) THENL + [DISJ2_TAC THEN X_GEN_TAC `x:real` THEN + REWRITE_TAC[dyho; IN_ELIM_THM] THEN + STRIP_TAC THEN ASM_REAL_ARITH_TAC; + ASM_CASES_TAC `a:int = b` THENL + [UNDISCH_TAC `~(dyho a p = dyho b q)` THEN REWRITE_TAC[] THEN + FIRST_X_ASSUM SUBST_ALL_TAC THEN + SUBGOAL_THEN `p:int = q` (fun th -> REWRITE_TAC[th]) THEN + MATCH_MP_TAC DYHO_ONESIDE_SAMESCALE_EQ THEN EXISTS_TAC `b:int` THEN + ASM_REWRITE_TAC[]; + SUBGOAL_THEN `&1 <= b - a:int` ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPEC `b - a:int` ZPOW_POS_EVEN_INT2) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `M':int` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`a:int`; `b:int`; `p:int`; `q:int`; `M':int`] + DYHO_MID_INTERIOR_EVEN_FALSE) THEN + ASM_REWRITE_TAC[]]]]);; + +(* Disjoint case of one-sidedness: disjoint dyadic cells are *) +(* order-separated. From DISJOINT + the finer cell not entirely left of dyho *) +(* b q, it is entirely right (common-point contradiction at the max *) +(* endpoint). *) +let DYHO_DISJOINT_RIGHTSEP = prove + (`!a b p q:int. DISJOINT (dyho a p) (dyho b q) /\ &0 < &2 zpow a /\ &0 < &2 + zpow b /\ + real_of_int q * &2 zpow b < (real_of_int p + &1) * &2 zpow a + ==> (real_of_int q + &1) * &2 zpow b <= real_of_int p * &2 zpow a`, + REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN + DISCH_TAC THEN + UNDISCH_TAC `DISJOINT (dyho a p) (dyho b q)` THEN + REWRITE_TAC[DISJOINT; EXTENSION; IN_INTER; NOT_IN_EMPTY; dyho; + IN_ELIM_THM] THEN + DISCH_THEN(MP_TAC o SPEC `max (real_of_int p * &2 zpow a) (real_of_int q * &2 + zpow b)`) THEN + ASM_REAL_ARITH_TAC);; + +let DYHO_DISJOINT_ONESIDE = prove + (`!a b p q:int. DISJOINT (dyho a p) (dyho b q) /\ ~(dyho a p = {}) + ==> (!x. x IN dyho a p ==> x <= dyho_mid b q) \/ + (!x. x IN dyho a p ==> dyho_mid b q <= x)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&0 < &2 zpow a /\ &0 < &2 zpow b` STRIP_ASSUME_TAC THENL + [CONJ_TAC THEN MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + DISJ_CASES_TAC(REAL_ARITH + `(real_of_int p + &1) * &2 zpow a <= real_of_int q * &2 zpow b \/ + real_of_int q * &2 zpow b < (real_of_int p + &1) * &2 zpow a`) THENL + [DISJ1_TAC THEN X_GEN_TAC `x:real` THEN + REWRITE_TAC[dyho; dyho_mid; IN_ELIM_THM] THEN + STRIP_TAC THEN + SUBGOAL_THEN + `real_of_int q * &2 zpow b <= (real_of_int q + &1 / &2) * &2 zpow b` + MP_TAC THENL + [MATCH_MP_TAC REAL_LE_RMUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN + REAL_ARITH_TAC; + ASM_REAL_ARITH_TAC]; + DISJ2_TAC THEN X_GEN_TAC `x:real` THEN REWRITE_TAC[dyho; IN_ELIM_THM] THEN + STRIP_TAC THEN + MP_TAC(ISPECL [`a:int`; `b:int`; `p:int`; + `q:int`] DYHO_DISJOINT_RIGHTSEP) THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[dyho_mid] THEN + SUBGOAL_THEN + `(real_of_int q + &1 / &2) * &2 zpow b <= (real_of_int q + &1) * &2 zpow + b` MP_TAC THENL + [MATCH_MP_TAC REAL_LE_RMUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN + REAL_ARITH_TAC; + ASM_REAL_ARITH_TAC]]);; + +(* Same-scale subset forces equal indices (disjointness would empty the *) +(* subset). *) +let DYHO_SAMESCALE_SUBSET_EQ = prove + (`!b p q:int. dyho b q SUBSET dyho b p ==> q = p`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + ASM_CASES_TAC `q:int = p` THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`b:int`; `q:int`; `p:int`] DYHO_DISJOINT_SAMESCALE) THEN + ASM_REWRITE_TAC[DISJOINT] THEN + SUBGOAL_THEN `dyho b q INTER dyho b p = dyho b q` SUBST1_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL [`b:int`; `q:int`] DYHO_NONEMPTY) THEN SET_TAC[]);; + +(* One-sidedness, all positions (286Gg): for a<=b and distinct cells, the *) +(* finer dyho a p lies wholly at-or-left, or wholly at-or-right, of dyho_mid *) +(* b q. Trichotomy: nested -> DYHO_ONESIDE; reverse-nested -> equal (measure *) +(* forces a=b, DYHO_SAMESCALE_SUBSET_EQ forces q=p) contra ~=; disjoint -> *) +(* DYHO_DISJOINT_ ONESIDE. *) +let DYHO_ONESIDE_FULL = prove + (`!a b p q:int. a <= b /\ ~(dyho a p = dyho b q) + ==> (!x. x IN dyho a p ==> x <= dyho_mid b q) \/ + (!x. x IN dyho a p ==> dyho_mid b q <= x)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `~(dyho a p = {})` ASSUME_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + EXISTS_TAC `real_of_int p * &2 zpow a` THEN + REWRITE_TAC[DYHO_NONEMPTY]; ALL_TAC] THEN + MP_TAC(ISPECL [`a:int`; `p:int`; `b:int`; `q:int`] DYHO_TRICHOTOMY) THEN + STRIP_TAC THENL + [MATCH_MP_TAC DYHO_ONESIDE THEN ASM_REWRITE_TAC[]; + SUBGOAL_THEN `a:int = b` ASSUME_TAC THENL + [REWRITE_TAC[GSYM INT_LE_ANTISYM] THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC ZPOW2_LE_REV THEN + MP_TAC(ISPECL [`dyho b q`; `dyho a p`] REAL_MEASURE_SUBSET) THEN + ASM_REWRITE_TAC[DYHO_MEASURABLE; DYHO_MEASURE]; ALL_TAC] THEN + FIRST_X_ASSUM SUBST_ALL_TAC THEN + MP_TAC(ISPECL [`b:int`; `p:int`; `q:int`] DYHO_SAMESCALE_SUBSET_EQ) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + UNDISCH_TAC `~(dyho b p = dyho b q)` THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC DYHO_DISJOINT_ONESIDE THEN ASM_REWRITE_TAC[]]);; + +(* Endpoint form of one-sidedness (feeds CWTILE_TILE_I_MIDPOINT's *) +(* hypothesis). *) +(* Right endpoint: all-of-cell <= c forces (p+1)2^a <= c (limit witness *) +(* approaching *) +(* the sup, REAL_LE_EPSILON). Left endpoint: all-of-cell >= c forces c <= p *) +(* 2^a *) +(* (left endpoint p 2^a is IN the cell, DYHO_NONEMPTY). *) +let DYHO_RIGHT_ENDPOINT_LE = prove + (`!a p c:real. &0 < &2 zpow a /\ (!x. x IN dyho a p ==> x <= c) + ==> (real_of_int p + &1) * &2 zpow a <= c`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_EPSILON THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC + `max (real_of_int p * &2 zpow a) ((real_of_int p + &1) * &2 zpow a - e / + &2)`) THEN + REWRITE_TAC[dyho; IN_ELIM_THM] THEN ANTS_TAC THENL + [REWRITE_TAC[REAL_LE_MAX; REAL_MAX_LT] THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[REAL_MAX_LE] THEN ASM_REAL_ARITH_TAC]);; + +let DYHO_LEFT_ENDPOINT_GE = prove + (`!a p c:real. (!x. x IN dyho a p ==> c <= x) ==> c <= real_of_int p * &2 zpow + a`, + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[DYHO_NONEMPTY]);; + +(* dyho a p (finer, a<=b) is wholly at-or-left/at-or-right of dyho_mid b q, *) +(* in the ENDPOINT form CWTILE_TILE_I_MIDPOINT wants (dyho_mid b q <= left *) +(* \/ right <= mid). *) +let TILE_ONESIDE_ENDPOINTS = prove + (`!a b p q:int. a <= b /\ ~(dyho a p = dyho b q) + ==> dyho_mid b q <= real_of_int p * &2 zpow a \/ + (real_of_int p + &1) * &2 zpow a <= dyho_mid b q`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`a:int`; `b:int`; `p:int`; `q:int`] DYHO_ONESIDE_FULL) THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `&0 < &2 zpow a` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + STRIP_TAC THENL + [DISJ2_TAC THEN MATCH_MP_TAC DYHO_RIGHT_ENDPOINT_LE THEN ASM_REWRITE_TAC[]; + DISJ1_TAC THEN MATCH_MP_TAC DYHO_LEFT_ENDPOINT_GE THEN + ASM_REWRITE_TAC[]]);; + +let DYHO_STAR_MONO = prove + (`!a b p q:int. dyho a p SUBSET dyho b q ==> dyho_star a p SUBSET dyho_star b + q`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP DYHO_SUBSET_SCALE) THEN + MP_TAC(SPECL [`a:int`; `b:int`; `p:int`; `q:int`] DYHO_SUBSET_ENDPOINTS) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + SUBGOAL_THEN `&0 < &2 zpow a /\ &0 < &2 zpow b /\ &2 zpow a <= &2 zpow b` + STRIP_ASSUME_TAC THENL + [REPEAT CONJ_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; + MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; + MATCH_MP_TAC ZPOW2_MONOE THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + REWRITE_TAC[dyho_star; SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `x:real` THEN + STRIP_TAC THEN CONJ_TAC THEN ASM_REAL_ARITH_TAC);; + +let JSCRIPT_MONO = prove + (`!P a b p q:int. dyho a p SUBSET dyho b q /\ in_jscript P b q ==> in_jscript + P a p`, + REPEAT GEN_TAC THEN REWRITE_TAC[in_jscript] THEN STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP DYHO_SUBSET_SCALE) THEN + X_GEN_TAC `s:int#int#int` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `s:int#int#int`) THEN + SUBGOAL_THEN `&2 zpow (--(tile_k s)) <= &2 zpow b` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&2 zpow a` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC ZPOW2_MONOE THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(TAUT `(c ==> d) ==> ~d ==> ~c`) THEN DISCH_TAC THEN + MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `dyho_star a p` THEN + ASM_SIMP_TAC[DYHO_STAR_MONO]);; + +(* The parent of a cell nested in a coarser cell (at scale > a) is still *) +(* nested in *) +(* it (DYHO_NEST via the shared left endpoint). Used to climb toward *) +(* maximality. *) +let DYHO_PARENT_NEST = prove + (`!a b p q:int. a + &1 <= b /\ dyho a p SUBSET dyho b q + ==> dyho (a + &1) (p div &2) SUBSET dyho b q`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(ISPECL [`a + &1:int`; `b:int`; `p div &2:int`; `q:int`; + `real_of_int p * &2 zpow a`] DYHO_NEST) THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MP_TAC(SPECL [`a:int`; `p:int`] DYHO_PARENT) THEN + REWRITE_TAC[SUBSET] THEN DISCH_THEN MATCH_MP_TAC THEN + REWRITE_TAC[DYHO_NONEMPTY]; + FIRST_X_ASSUM(MP_TAC o check (fun t -> is_binary "SUBSET" (concl t))) THEN + REWRITE_TAC[SUBSET] THEN DISCH_THEN MATCH_MP_TAC THEN + REWRITE_TAC[DYHO_NONEMPTY]]);; + +(* A cover cell contained in a Cal J cell must EQUAL it: a proper *) +(* containment would make the cover cell's parent a Cal J cell too *) +(* (JSCRIPT_MONO on parent SUBSET the bigger cell), contradicting maximality *) +(* (in_kcover: parent not in J). *) +let KCOVER_SUBSET_EQ = prove + (`!P a b p q:int. in_kcover P a p /\ in_jscript P b q /\ dyho a p SUBSET dyho + b q + ==> dyho a p = dyho b q`, + REPEAT GEN_TAC THEN REWRITE_TAC[in_kcover] THEN STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP DYHO_SUBSET_SCALE) THEN + FIRST_ASSUM(DISJ_CASES_TAC o MATCH_MP + (INT_ARITH `!a b:int. a <= b ==> a = b \/ a + &1 <= b`)) THENL + [UNDISCH_TAC `a:int = b` THEN DISCH_THEN SUBST_ALL_TAC THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP DYHO_SAMESCALE_EQ o + check (fun t -> is_binary "SUBSET" (concl t))) THEN + DISCH_THEN SUBST1_TAC THEN REFL_TAC; + SUBGOAL_THEN `in_jscript P (a + &1) (p div &2)` ASSUME_TAC THENL + [MATCH_MP_TAC JSCRIPT_MONO THEN + MAP_EVERY EXISTS_TAC [`b:int`; `q:int`] THEN CONJ_TAC THENL + [MATCH_MP_TAC DYHO_PARENT_NEST THEN ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + ASM_MESON_TAC[]]);; + +(* Distinct cover cells are DISJOINT (laminar + both maximal: trichotomy *) +(* gives nested-or-disjoint; either nesting forces equality by *) +(* KCOVER_SUBSET_EQ). *) +let KCOVER_DISJOINT = prove + (`!P a b p q:int. in_kcover P a p /\ in_kcover P b q /\ ~(dyho a p = dyho b q) + ==> DISJOINT (dyho a p) (dyho b q)`, + REPEAT STRIP_TAC THEN + STRIP_ASSUME_TAC(SPECL [`a:int`; `p:int`; `b:int`; + `q:int`] DYHO_TRICHOTOMY) THEN + ASM_REWRITE_TAC[] THEN + RULE_ASSUM_TAC(REWRITE_RULE[in_kcover]) THEN + ASM_MESON_TAC[KCOVER_SUBSET_EQ; in_kcover]);; + +(* The two ENDS of the maximal-cover parent chain (feeding the covering *) +(* argument): *) +(* small cells are VACUOUSLY in Cal J; cells whose triple engulfs a *) +(* qualifying I_sigma *) +(* leave Cal J. Between them a maximal (cover) cell sits over every point. *) +let JSCRIPT_SMALL = prove + (`!P a p:int. (!s. s IN P ==> &2 zpow a < &2 zpow (--(tile_k s))) + ==> in_jscript P a p`, + REPEAT STRIP_TAC THEN REWRITE_TAC[in_jscript] THEN + X_GEN_TAC `s:int#int#int` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `s:int#int#int`) THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC);; + +let JSCRIPT_FAIL = prove + (`!P a p:int s. s IN P /\ &2 zpow (--(tile_k s)) <= &2 zpow a /\ + tile_I s SUBSET dyho_star a p + ==> ~(in_jscript P a p)`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o REWRITE_RULE[in_jscript]) THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN + EXISTS_TAC `s:int#int#int` THEN ASM_REWRITE_TAC[]);; + +(* --- Geometric engine for the COVERING property (UNIONS Cal K = R) --- *) + +(* The triple of a scale-b cell containing x contains the whole *) +(* 2^b-neighbourhood of x (dyho b q = [q2^b,(q+1)2^b) with x inside; *) +(* dyho_star b q = [(q-1)2^b, (q+2)2^b) reaches a full cell-width past each *) +(* edge). *) +let DYHO_STAR_CONTAINS_NBHD = prove + (`!b q x w:real. x IN dyho b q /\ abs(w - x) < &2 zpow b ==> w IN dyho_star b + q`, + REPEAT GEN_TAC THEN REWRITE_TAC[dyho; dyho_star; IN_ELIM_THM] THEN + STRIP_TAC THEN CONJ_TAC THEN ASM_REAL_ARITH_TAC);; + +(* Every real lies in some dyadic cell at every scale (q = int floor of *) +(* x/2^b). *) +let DYHO_COVERS_POINT = prove + (`!b x:real. ?q. x IN dyho b q`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `&0 < &2 zpow b` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + EXISTS_TAC `int_of_real(floor(x / &2 zpow b))` THEN + MP_TAC(SPEC `x / &2 zpow b` FLOOR) THEN + ABBREV_TAC `t = floor(x / &2 zpow b)` THEN STRIP_TAC THEN + REWRITE_TAC[dyho; IN_ELIM_THM] THEN + SUBGOAL_THEN + `real_of_int(int_of_real t) = t` (fun th -> REWRITE_TAC[th]) THENL + [ASM_MESON_TAC[int_rep]; ALL_TAC] THEN + CONJ_TAC THENL + [ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ]; + ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ]]);; + +(* x lies in its SELECT-ed scale-b cell (the cover-climb refers to x's cell *) +(* by the choice operator, whose membership is DYHO_COVERS_POINT via *) +(* SELECT). *) +let XCELL_IN = prove + (`!b x:real. x IN dyho b (@q. x IN dyho b q)`, + REPEAT GEN_TAC THEN CONV_TAC SELECT_CONV THEN + REWRITE_TAC[DYHO_COVERS_POINT]);; + +(* Abstract num boundary: if a predicate Q holds at 0 but fails somewhere, *) +(* there is a *) +(* boundary point n with Q n but ~Q(SUC n). Isolates the well-ordering used *) +(* to climb *) +(* the cells-containing-x chain to the maximal Cal J cell (= cover cell). *) +let NUM_BOUNDARY = prove + (`!Q:num->bool. Q 0 /\ (?N. ~(Q N)) ==> ?n. Q n /\ ~(Q(SUC n))`, + GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `?n:num. ~(Q n) /\ (!m. m < n ==> Q m)` STRIP_ASSUME_TAC THENL + [MP_TAC(ISPEC `\n:num. ~(Q n)` num_WOP) THEN BETA_TAC THEN + DISCH_THEN(MP_TAC o fst o EQ_IMP_RULE) THEN + ANTS_TAC THENL [EXISTS_TAC `N:num` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN REWRITE_TAC[] THEN + STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN GEN_TAC THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `1 <= n` ASSUME_TAC THENL + [ASM_MESON_TAC[ARITH_RULE `~(1 <= n) ==> n = 0`]; ALL_TAC] THEN + EXISTS_TAC `n - 1` THEN CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `n - 1`) THEN + ASM_SIMP_TAC[ARITH_RULE `1 <= n ==> n - 1 < n`]; + ASM_SIMP_TAC[ARITH_RULE `1 <= n ==> SUC(n - 1) = n`]]);; + +(* Every point of a cell dyho c m is within |m 2^c - x| + 2^c of any x. *) +let CELL_DIST_BOUND = prove + (`!c m x w:real. w IN dyho c m + ==> abs(w - x) <= abs(real_of_int m * &2 zpow c - x) + &2 zpow c`, + REPEAT GEN_TAC THEN REWRITE_TAC[dyho; IN_ELIM_THM] THEN + SUBGOAL_THEN `&0 < &2 zpow c` MP_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + REAL_ARITH_TAC);; + +(* 2^b is unbounded above: for any M and start a, some b >= a has M < 2^b. *) +let ZPOW2_ARCH = prove + (`!M a:int. ?b:int. a <= b /\ M < &2 zpow b`, + REPEAT GEN_TAC THEN + MP_TAC(ISPECL [`&2:real`; `M:real`] REAL_ARCH_POW) THEN + ANTS_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN + EXISTS_TAC `abs a + &n:int` THEN CONJ_TAC THENL + [INT_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&2 pow n` THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `&2 pow n = &2 zpow (&n:int)` SUBST1_TAC THENL + [REWRITE_TAC[REAL_ZPOW_NUM]; ALL_TAC] THEN + MATCH_MP_TAC ZPOW2_MONOE THEN INT_ARITH_TAC);; + +(* 286J part(b): the dilated intervals I^(K)_tau exhaust R -- every x lies *) +(* in *) +(* tile_Idil tau K for K large. ZPOW2_ARCH gives an int exponent b with *) +(* 2^b > |x - x_tau| and b >= -k_tau-1, so K = num_of_int(b+k_tau+1) is a *) +(* valid *) +(* num with half-width 2^{&K-k_tau-1} = 2^b > |x-x_tau|. Underlies the *) +(* monotone-convergence decomposition int_S w = lim_K int_{S cap I^(K)} w. *) +let TILE_IDIL_EXHAUSTS = prove + (`!tau x. ?K. x IN tile_Idil tau K`, + REPEAT GEN_TAC THEN REWRITE_TAC[tile_Idil; IN_ELIM_THM] THEN + MP_TAC(ISPECL [`abs(x - tile_xmid tau)`; + `--(tile_k tau) - &1`] ZPOW2_ARCH) THEN + DISCH_THEN(X_CHOOSE_THEN `b:int` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `num_of_int(b + tile_k tau + &1)` THEN + SUBGOAL_THEN `&(num_of_int(b + tile_k tau + &1)) = b + tile_k tau + &1:int` + ASSUME_TAC THENL + [MATCH_MP_TAC INT_OF_NUM_OF_INT THEN ASM_INT_ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `(b + tile_k tau + &1) - tile_k tau - &1 = b:int` SUBST1_TAC THENL + [INT_ARITH_TAC; ASM_REWRITE_TAC[]]);; + +(* THE covering-termination geometric crux: for any tile s and point x, *) +(* arbitrarily *) +(* large scales b have x in a cell dyho b q whose TRIPLE engulfs the whole *) +(* spatial *) +(* interval tile_I s. (tile_I s is bounded; ZPOW2_ARCH picks b with 2^b *) +(* beyond its *) +(* distance to x; DYHO_STAR_CONTAINS_NBHD + CELL_DIST_BOUND then give *) +(* containment.) *) +(* This is what makes the parent-climb leave Cal J (JSCRIPT_FAIL) at large *) +(* scales. *) +let TILE_I_ENGULF = prove + (`!s x a:int. ?b q. a <= b /\ x IN dyho b q /\ tile_I s SUBSET dyho_star b q`, + REWRITE_TAC[FORALL_PAIR_THM; tile_I; tile_k] THEN + MAP_EVERY X_GEN_TAC [`k:int`; `nI:int`; `x:real`; `a:int`] THEN + MP_TAC(SPECL [`abs(real_of_int nI * &2 zpow (--k) - x) + &2 zpow (--k)`; + `a:int`] + ZPOW2_ARCH) THEN + DISCH_THEN(X_CHOOSE_THEN `b:int` STRIP_ASSUME_TAC) THEN + MP_TAC(SPECL [`b:int`; `x:real`] DYHO_COVERS_POINT) THEN + DISCH_THEN(X_CHOOSE_TAC `q:int`) THEN + MAP_EVERY EXISTS_TAC [`b:int`; `q:int`] THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[SUBSET] THEN X_GEN_TAC `w:real` THEN DISCH_TAC THEN + MATCH_MP_TAC DYHO_STAR_CONTAINS_NBHD THEN EXISTS_TAC `x:real` THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `abs(real_of_int nI * &2 zpow (--k) - x) + &2 zpow (--k)` THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(SPECL [`--k:int`; `nI:int`; `x:real`; `w:real`] CELL_DIST_BOUND) THEN + ASM_REWRITE_TAC[]);; + +(* x lies in a UNIQUE scale-b cell; its scale-(b+1) cell is the parent *) +(* (index div 2). *) +let DYHO_POINT_UNIQUE = prove + (`!b m n x:real. x IN dyho b m /\ x IN dyho b n ==> m = n`, + REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC I [TAUT `p <=> ~ ~p`] THEN DISCH_TAC THEN + MP_TAC(SPECL [`b:int`; `m:int`; `n:int`] DYHO_DISJOINT_SAMESCALE) THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[DISJOINT; EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN + DISCH_THEN(MP_TAC o SPEC `x:real`) THEN ASM_REWRITE_TAC[]);; + +let DYHO_POINT_PARENT = prove + (`!b m x:real. x IN dyho b m ==> x IN dyho (b + &1) (m div &2)`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`b:int`; `m:int`] DYHO_PARENT) THEN + REWRITE_TAC[SUBSET] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[]);; + +(* An int-valued function on a finite set has an int upper bound (set *) +(* induction with *) +(* max). Gives a scale below all -k_sigma so JSCRIPT_SMALL applies *) +(* (SMALL_SCALE_ *) +(* EXISTS): for finite P, some scale a has 2^a < 2^{-k_sigma} for every *) +(* sigma. *) +let INT_UPPER_BOUND_FINITE = prove + (`!(f:A->int) s. FINITE s ==> ?K. !x. x IN s ==> f x <= K`, + GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN CONJ_TAC THENL + [EXISTS_TAC `&0:int` THEN REWRITE_TAC[NOT_IN_EMPTY]; + MAP_EVERY X_GEN_TAC [`e:A`; `t:A->bool`] THEN + DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `K:int`) ASSUME_TAC) THEN + EXISTS_TAC `max (f(e:A):int) K` THEN + REWRITE_TAC[IN_INSERT] THEN X_GEN_TAC `y:A` THEN STRIP_TAC THEN + ASM_MESON_TAC[INT_MAX_MAX; INT_LE_TRANS]]);; + +let SMALL_SCALE_EXISTS = prove + (`!P:(int#int#int)->bool. FINITE P + ==> ?a. !s. s IN P ==> &2 zpow a < &2 zpow (--(tile_k s))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`tile_k:int#int#int->int`; `P:(int#int#int)->bool`] + INT_UPPER_BOUND_FINITE) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `K:int`) THEN + EXISTS_TAC `--K - &1:int` THEN X_GEN_TAC `s:int#int#int` THEN DISCH_TAC THEN + MATCH_MP_TAC ZPOW2_MONOE_LT THEN + FIRST_X_ASSUM(MP_TAC o SPEC `s:int#int#int`) THEN ASM_REWRITE_TAC[] THEN + INT_ARITH_TAC);; + +(* Every point x lies in some maximal Cal J cell (in_kcover). Climb from a *) +(* very fine scale a0 (where in_jscript holds vacuously, JSCRIPT_SMALL) up *) +(* to the scale bT where the tile tile_I s0 is engulfed (TILE_I_ENGULF, so *) +(* in_jscript fails, JSCRIPT_FAIL); NUM_BOUNDARY picks the boundary scale *) +(* a0+n where in_jscript still holds but fails one scale up. x's cell *) +(* there is a maximal member. *) +let KCOVER_EXISTS = prove + (`!P:(int#int#int)->bool. FINITE P /\ ~(P = {}) + ==> !x:real. ?a q. in_kcover P a q /\ x IN dyho a q`, + REPEAT STRIP_TAC THEN + MP_TAC(SPEC `P:(int#int#int)->bool` SMALL_SCALE_EXISTS) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `a0:int` ASSUME_TAC) THEN + FIRST_ASSUM(X_CHOOSE_TAC `s0:int#int#int` o REWRITE_RULE[GSYM + MEMBER_NOT_EMPTY]) THEN + MP_TAC(SPECL [`s0:int#int#int`; `x:real`; + `--(tile_k s0)`] TILE_I_ENGULF) THEN + DISCH_THEN(X_CHOOSE_THEN `bT:int` (X_CHOOSE_THEN + `qT:int` STRIP_ASSUME_TAC)) THEN + SUBGOAL_THEN `a0:int <= bT` ASSUME_TAC THENL + [MATCH_MP_TAC INT_LE_TRANS THEN EXISTS_TAC `--(tile_k s0):int` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC ZPOW2_LT_IMP_LE THEN + FIRST_X_ASSUM(MP_TAC o SPEC `s0:int#int#int`) THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `&(num_of_int(bT - a0)):int = bT - a0` ASSUME_TAC THENL + [MATCH_MP_TAC INT_OF_NUM_OF_INT THEN REWRITE_TAC[INT_SUB_LE] THEN + FIRST_ASSUM ACCEPT_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `a0 + &(num_of_int(bT - a0)):int = bT` ASSUME_TAC THENL + [ASM_REWRITE_TAC[] THEN + MATCH_ACCEPT_TAC(INT_ARITH `!a b:int. a + (b - a) = b`); + ALL_TAC] THEN + SUBGOAL_THEN `(@q. x IN dyho bT q) = qT` ASSUME_TAC THENL + [MP_TAC(SPECL [`bT:int`; `(@q. x IN dyho bT q)`; `qT:int`; `x:real`] + DYHO_POINT_UNIQUE) THEN + DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[XCELL_IN]; + ALL_TAC] THEN + SUBGOAL_THEN + `in_jscript P (a0 + &0) (@q. x IN dyho (a0 + &0) q)` ASSUME_TAC THENL + [REWRITE_TAC[INT_ADD_RID] THEN MATCH_MP_TAC JSCRIPT_SMALL THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `~(in_jscript P (a0 + &(num_of_int(bT - a0))) + (@q. x IN dyho (a0 + &(num_of_int(bT - a0))) q))` ASSUME_TAC THENL + [ASM_REWRITE_TAC[] THEN + MP_TAC(SPECL [`P:(int#int#int)->bool`; `bT:int`; `qT:int`; + `s0:int#int#int`] + JSCRIPT_FAIL) THEN + DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC ZPOW2_MONOE THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `?n. in_jscript P (a0 + &n) (@q. x IN dyho (a0 + &n) q) /\ + ~(in_jscript P (a0 + &(SUC n)) (@q. x IN dyho (a0 + &(SUC n)) q))` + STRIP_ASSUME_TAC THENL + [MP_TAC(ISPEC + `\n. in_jscript P (a0 + &n) (@q. x IN dyho (a0 + &n) q)` NUM_BOUNDARY) + THEN + BETA_TAC THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[] THEN + EXISTS_TAC `num_of_int(bT - a0)` THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `(@q. x IN dyho (a0 + &n) q) div &2 = (@q. x IN dyho (a0 + &(SUC n)) q)` + ASSUME_TAC THENL + [MP_TAC(SPECL + [`a0 + &(SUC n):int`; + `(@q. x IN dyho (a0 + &n) q) div &2`; + `(@q. x IN dyho (a0 + &(SUC n)) q)`; `x:real`] DYHO_POINT_UNIQUE) THEN + DISCH_THEN MATCH_MP_TAC THEN + REWRITE_TAC[XCELL_IN] THEN + SUBGOAL_THEN `a0 + &(SUC n):int = (a0 + &n) + &1` SUBST1_TAC THENL + [REWRITE_TAC[GSYM INT_OF_NUM_SUC] THEN INT_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC DYHO_POINT_PARENT THEN REWRITE_TAC[XCELL_IN]; + ALL_TAC] THEN + MAP_EVERY EXISTS_TAC + [`a0 + &n:int`; `(@q. x IN dyho (a0 + &n) q)`] THEN + REWRITE_TAC[XCELL_IN; in_kcover] THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `(a0 + &n) + &1:int = a0 + &(SUC n)` SUBST1_TAC THENL + [REWRITE_TAC[GSYM INT_OF_NUM_SUC] THEN INT_ARITH_TAC; + ASM_REWRITE_TAC[]]);; + +(* l_K bookkeeping: a cover cell dyho a p has measure 2 zpow a (= 2^{-l_K} with + l_K = --a). Trivial from DYHO_MEASURE; + the entry point for the a-ii count. *) +let KCOVER_MEASURE = prove + (`!P:(int#int#int)->bool a p. in_kcover P a p ==> real_measure(dyho a p) = &2 + zpow a`, + REWRITE_TAC[DYHO_MEASURE]);; + +(* Fremlin 286L(a-ii) MEASURE engine: any finite family of cover cells *) +(* (indexed by their (a,p) pairs) all contained in a bounded measurable B *) +(* has total measure <= mu B, since distinct cover cells are DISJOINT *) +(* (KCOVER_DISJOINT). Applied with B = Ihat_tau (length 7 mu I_tau) to bound *) +(* sum of coarse cover-cell measures. *) +let KCOVER_MEASURE_SUM_LE = prove + (`!P:(int#int#int)->bool S B. + FINITE S /\ real_measurable B /\ + (!ap. ap IN S ==> in_kcover P (FST ap) (SND ap)) /\ + (!ap. ap IN S ==> dyho (FST ap) (SND ap) SUBSET B) + ==> sum (IMAGE (\ap. dyho (FST ap) (SND ap)) S) (\c. real_measure c) + <= real_measure B`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC DISJOINT_CELLS_MEASURE_SUM_LE THEN + ASM_SIMP_TAC[FINITE_IMAGE] THEN REPEAT CONJ_TAC THEN + REWRITE_TAC[FORALL_IN_IMAGE] THENL + [X_GEN_TAC `ap:int#int` THEN DISCH_TAC THEN REWRITE_TAC[DYHO_MEASURABLE]; + X_GEN_TAC `ap:int#int` THEN DISCH_TAC THEN ASM_SIMP_TAC[]; + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN + X_GEN_TAC `ap:int#int` THEN DISCH_TAC THEN + REWRITE_TAC[FORALL_IN_IMAGE] THEN + X_GEN_TAC `aq:int#int` THEN DISCH_TAC THEN DISCH_TAC THEN + MP_TAC(SPECL [`P:(int#int#int)->bool`; `FST(ap:int#int)`; + `FST(aq:int#int)`; + `SND(ap:int#int)`; `SND(aq:int#int)`] KCOVER_DISJOINT) THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_SIMP_TAC[]]);; + +(* --- 286L(a-ii) geometric containment: coarse cover cells sit in Ihat_tau *) +(* --- *) + +(* Diameter of a tripled dyadic cell: any two of its points are < 3*2^k *) +(* apart. *) +let DYHO_STAR_DIAM = prove + (`!k n x y. x IN dyho_star k n /\ y IN dyho_star k n + ==> abs(x - y) < &3 * &2 zpow k`, + REPEAT GEN_TAC THEN REWRITE_TAC[dyho_star; IN_ELIM_THM] THEN + REWRITE_TAC[REAL_SUB_RDISTRIB; REAL_ADD_RDISTRIB; REAL_MUL_LID] THEN + REAL_ARITH_TAC);; + +(* A point of a dyadic cell is < 2^k from the cell midpoint. *) +let DYHO_MID_DIST = prove + (`!k n z. z IN dyho k n ==> abs(z - dyho_mid k n) < &2 zpow k`, + REPEAT GEN_TAC THEN REWRITE_TAC[dyho; dyho_mid; IN_ELIM_THM] THEN + REWRITE_TAC[REAL_ADD_RDISTRIB; REAL_MUL_LID] THEN + REAL_ARITH_TAC);; + +(* If the parent-triple of cover cell dyho a p meets I_tau = dyho (--kt) nt *) +(* (and *) +(* mu K = 2^a <= mu I_tau = 2^{--kt}), every point of the cover cell is *) +(* within *) +(* 7 mu I_tau of x_tau. Triangle: |y - x_tau| <= |y - z| + |z - x_tau| where *) +(* y, z share the parent-triple (length 6*2^a <= 6*2^{--kt}) and z in I_tau. *) +let KCOVER_STAR_MEETS_ITAU_CONTAIN = prove + (`!a p kt nt. + &2 zpow a <= &2 zpow (--kt) /\ + ~(dyho_star (a + &1) (p div &2) INTER dyho (--kt) nt = {}) + ==> !y. y IN dyho a p + ==> abs(y - dyho_mid (--kt) nt) <= &7 * &2 zpow (--kt)`, + REPEAT GEN_TAC THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (X_CHOOSE_THEN `z:real` STRIP_ASSUME_TAC)) THEN + X_GEN_TAC `y:real` THEN DISCH_TAC THEN + SUBGOAL_THEN `y IN dyho_star (a + &1) (p div &2)` ASSUME_TAC THENL + [MP_TAC(ISPECL [`a:int`; `p:int`] DYHO_SUBSET_STAR) THEN + MP_TAC(ISPECL [`a:int`; `p:int`] DYHO_STAR_PARENT) THEN ASM SET_TAC[]; + ALL_TAC] THEN + MP_TAC(ISPECL [`a + &1:int`; `p div &2`; `y:real`; + `z:real`] DYHO_STAR_DIAM) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`--kt:int`; `nt:int`; `z:real`] DYHO_MID_DIST) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + SUBGOAL_THEN `&2 zpow (a + &1) = &2 * &2 zpow a` ASSUME_TAC THENL + [SIMP_TAC[REAL_ZPOW_ADD; REAL_OF_NUM_EQ; ARITH_EQ; REAL_ZPOW_1] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_REAL_ARITH_TAC);; + +(* 286L(e) step b (adjacency): if x lies in Ktilde = dyho(a+1) q, and *) +(* dyho(a+1) m (= *) +(* I_ups, same scale) meets Ktilde* = dyho_star(a+1) q (witnessed by z), *) +(* then x is within *) +(* (3/2) mu I_ups of the centre x_ups = dyho_mid(a+1) m. Same-scale *) +(* overlap-when-tripled *) +(* forces q-1 <= m <= q+1 (from z's two membership bounds, cancelling *) +(* 2^{a+1} > 0 and *) +(* rounding to integers), then x in [q, q+1) t and x_ups in [(q-1/2), *) +(* (q+3/2)] t give the *) +(* (3/2)t bound. This is the geometric heart of the G_K weight lower bound. *) +let GK_ADJACENCY = prove + (`!a q m x z:real. + x IN dyho (a + &1) q /\ z IN dyho (a + &1) m /\ z IN dyho_star (a + &1) q + ==> abs(x - dyho_mid (a + &1) m) <= &3 / &2 * &2 zpow (a + &1)`, + REPEAT GEN_TAC THEN REWRITE_TAC[dyho; dyho_star; dyho_mid; IN_ELIM_THM] THEN + SUBGOAL_THEN `&0 < &2 zpow (a + &1)` MP_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[int_add_th; int_of_num_th] THEN STRIP_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN + `real_of_int m < real_of_int q + &2 /\ + real_of_int q - &1 < real_of_int m + &1` + STRIP_ASSUME_TAC THENL + [CONJ_TAC THENL + [SUBGOAL_THEN + `real_of_int m * &2 zpow (a + &1) < (real_of_int q + &2) * &2 zpow (a + + &1)` + MP_TAC THENL [ASM_REAL_ARITH_TAC; ASM_SIMP_TAC[REAL_LT_RMUL_EQ]]; + SUBGOAL_THEN + `(real_of_int q - &1) * &2 zpow (a + &1) < (real_of_int m + &1) * &2 + zpow (a + &1)` + MP_TAC THENL [ASM_REAL_ARITH_TAC; ASM_SIMP_TAC[REAL_LT_RMUL_EQ]]]; + ALL_TAC] THEN + SUBGOAL_THEN + `real_of_int q - &1 <= real_of_int m /\ + real_of_int m <= real_of_int q + &1` + STRIP_ASSUME_TAC THENL + [MAP_EVERY UNDISCH_TAC + [`real_of_int m < real_of_int q + &2`; + `real_of_int q - &1 < real_of_int m + &1`] THEN + REWRITE_TAC[GSYM ROI_1; REAL_OF_INT_CLAUSES; GSYM int_lt; GSYM int_le] THEN + INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `(real_of_int q + &1) * &2 zpow (a + &1) <= (real_of_int m + &2) * &2 zpow + (a + &1) /\ + (real_of_int m - &1) * &2 zpow (a + &1) <= real_of_int q * &2 + zpow (a + &1)` + STRIP_ASSUME_TAC THENL + [CONJ_TAC THEN MATCH_MP_TAC REAL_LE_RMUL THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_REAL_ARITH_TAC);; + +(* Tile form of GK_ADJACENCY (destructured through tile_k/tile_I/tile_xmid). *) +let GK_ADJACENCY_TILE = prove + (`!(ups:int#int#int) a q x z. + tile_k ups = --(a + &1) /\ + x IN dyho (a + &1) q /\ z IN tile_I ups /\ z IN dyho_star (a + &1) q + ==> abs(x - tile_xmid ups) <= &3 / &2 * &2 zpow (--(tile_k ups))`, + REWRITE_TAC[FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC [`ku:int`; `mu:int`; `nu:int`; `a:int`; `q:int`; + `x:real`; `z:real`] THEN + REWRITE_TAC[tile_k; tile_I; tile_xmid] THEN STRIP_TAC THEN + SUBGOAL_THEN `ku:int = --(a + &1)` SUBST_ALL_TAC THENL + [ASM_REWRITE_TAC[]; ALL_TAC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[INT_NEG_NEG]) THEN REWRITE_TAC[INT_NEG_NEG] THEN + MP_TAC(ISPECL [`a:int`; `q:int`; `mu:int`; `x:real`; + `z:real`] GK_ADJACENCY) THEN + ASM_REWRITE_TAC[]);; + +(* Bridge (uses the tree property + maximality): the parent-triple of a *) +(* coarse *) +(* cover cell DOES meet I_tau. in_kcover gives ~in_jscript(parent), i.e. *) +(* some *) +(* sigma in P with I_sigma SUBSET parent*; the tree property I_sigma SUBSET *) +(* I_tau *) +(* plus I_sigma nonempty force parent* INTER I_tau nonempty. *) +let KCOVER_PARENT_MEETS_ITAU = prove + (`!P:(int#int#int)->bool a p kt nt. + (!s. s IN P ==> tile_I s SUBSET dyho (--kt) nt) /\ + &2 zpow (a + &1) <= &2 zpow (--kt) /\ + in_kcover P a p + ==> ~(dyho_star (a + &1) (p div &2) INTER dyho (--kt) nt = {})`, + REPEAT GEN_TAC THEN REWRITE_TAC[in_kcover] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o REWRITE_RULE[in_jscript]) THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN + DISCH_THEN(X_CHOOSE_THEN `s:int#int#int` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `?w:real. w IN tile_I s` (X_CHOOSE_TAC `w:real`) THENL + [SPEC_TAC(`s:int#int#int`,`s:int#int#int`) THEN + REWRITE_TAC[FORALL_PAIR_THM; tile_I] THEN MESON_TAC[DYHO_NONEMPTY]; + ALL_TAC] THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN EXISTS_TAC `w:real` THEN + CONJ_TAC THENL + [ASM SET_TAC[]; + FIRST_X_ASSUM(MP_TAC o SPEC `s:int#int#int`) THEN ASM_REWRITE_TAC[] THEN + ASM SET_TAC[]]);; + +(* 286L(a-ii) containment: a coarse cover cell (mu K <= mu I_tau) *) +(* lies inside the closed interval Ihat_tau = [x_tau - 7 mu I_tau, x_tau + 7 *) +(* mu I_tau]. Composes the geometric containment with the parent-meets-I_tau *) +(* bridge. *) +let KCOVER_SUBSET_IHAT = prove + (`!P:(int#int#int)->bool a p kt nt. + (!s. s IN P ==> tile_I s SUBSET dyho (--kt) nt) /\ + &2 zpow (a + &1) <= &2 zpow (--kt) /\ + in_kcover P a p + ==> dyho a p SUBSET + real_interval[dyho_mid (--kt) nt - &7 * &2 zpow (--kt), + dyho_mid (--kt) nt + &7 * &2 zpow (--kt)]`, + REPEAT STRIP_TAC THEN REWRITE_TAC[SUBSET; IN_REAL_INTERVAL] THEN + X_GEN_TAC `y:real` THEN DISCH_TAC THEN + MP_TAC(ISPECL [`a:int`; `p:int`; `kt:int`; `nt:int`] + KCOVER_STAR_MEETS_ITAU_CONTAIN) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&2 zpow (a + &1)` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC ZPOW2_MONOE THEN INT_ARITH_TAC; + MATCH_MP_TAC KCOVER_PARENT_MEETS_ITAU THEN + MAP_EVERY EXISTS_TAC [`P:(int#int#int)->bool`] THEN ASM_REWRITE_TAC[]]; + DISCH_THEN(MP_TAC o SPEC `y:real`) THEN ASM_REWRITE_TAC[] THEN + REAL_ARITH_TAC]);; + +(* 286L(a-ii) TOTAL MEASURE bound: the coarse cover cells (those with mu K *) +(* <= *) +(* mu I_tau, i.e. 2^{a+1} <= 2^{--kt}) have total measure <= 14 mu I_tau. *) +(* All lie *) +(* in Ihat_tau (KCOVER_SUBSET_IHAT), are disjoint (KCOVER_DISJOINT, inside *) +(* KCOVER_MEASURE_SUM_LE), and mu Ihat = 14*2^{--kt}. Fremlin's sharp 7 *) +(* becomes *) +(* 14 by the crude closed-interval route; immaterial (C7 = some finite *) +(* constant). *) +(* This is the S in CELL_SUM_BOUND_ABSTRACT for the alpha0 outer cover-sum. *) +let KCOVER_COARSE_MEASURE_BOUND = prove + (`!P:(int#int#int)->bool S kt nt. + FINITE S /\ + (!s. s IN P ==> tile_I s SUBSET dyho (--kt) nt) /\ + (!ap. ap IN S ==> in_kcover P (FST ap) (SND ap) /\ + &2 zpow (FST ap + &1) <= &2 zpow (--kt)) + ==> sum (IMAGE (\ap. dyho (FST ap) (SND ap)) S) (\c. real_measure c) + <= &14 * &2 zpow (--kt)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`P:(int#int#int)->bool`; `S:(int#int)->bool`; + `real_interval[dyho_mid (--kt) nt - &7 * &2 zpow (--kt), + dyho_mid (--kt) nt + &7 * &2 zpow (--kt)]`] + KCOVER_MEASURE_SUM_LE) THEN + SUBGOAL_THEN + `real_measure(real_interval[dyho_mid (--kt) nt - &7 * &2 zpow (--kt), + dyho_mid (--kt) nt + &7 * &2 zpow (--kt)]) + = &14 * &2 zpow (--kt)` + (fun th -> REWRITE_TAC[th]) THENL + [REWRITE_TAC[REAL_MEASURE_REAL_INTERVAL] THEN + SUBGOAL_THEN `&0 < &2 zpow (--kt)` MP_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[REAL_MEASURABLE_REAL_INTERVAL] THEN CONJ_TAC THEN + X_GEN_TAC `ap:int#int` THEN DISCH_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `ap:int#int`) THEN ASM_SIMP_TAC[]; + MATCH_MP_TAC KCOVER_SUBSET_IHAT THEN + MAP_EVERY EXISTS_TAC [`P:(int#int#int)->bool`] THEN + ASM_SIMP_TAC[] THEN FIRST_X_ASSUM(MP_TAC o SPEC `ap:int#int`) THEN + ASM_SIMP_TAC[]]);; + +(* --- 286L(a-iv) per-level count: coarse levels have <= 14 cover cells each *) +(* --- *) + +(* General parent-meets-I_tau bridge (NO coarse/fine hypothesis needed): for *) +(* ANY *) +(* cover cell, the tree property + maximality force the parent-triple to *) +(* meet *) +(* I_tau. (The coarseness hyp in KCOVER_PARENT_MEETS_ITAU was unnecessary.) *) +let KCOVER_PARENT_MEETS_ITAU_GEN = prove + (`!P:(int#int#int)->bool a p kt nt. + (!s. s IN P ==> tile_I s SUBSET dyho (--kt) nt) /\ in_kcover P a p + ==> ~(dyho_star (a + &1) (p div &2) INTER dyho (--kt) nt = {})`, + REPEAT GEN_TAC THEN REWRITE_TAC[in_kcover] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o REWRITE_RULE[in_jscript]) THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN + DISCH_THEN(X_CHOOSE_THEN `s:int#int#int` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `?w:real. w IN tile_I s` (X_CHOOSE_TAC `w:real`) THENL + [SPEC_TAC(`s:int#int#int`,`s:int#int#int`) THEN + REWRITE_TAC[FORALL_PAIR_THM; tile_I] THEN + MESON_TAC[DYHO_NONEMPTY]; ALL_TAC] THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN EXISTS_TAC `w:real` THEN + CONJ_TAC THENL + [ASM SET_TAC[]; + FIRST_X_ASSUM(MP_TAC o SPEC `s:int#int#int`) THEN ASM_REWRITE_TAC[] THEN + ASM SET_TAC[]]);; + +(* Unconditional triangle bound: y in cover cell + parent-triple meets I_tau *) +(* => abs(y - x_tau) <= 6*2^a + 2^{--kt} (no scale comparison). *) +let KCOVER_STAR_TRIANGLE = prove + (`!a p kt nt. ~(dyho_star (a + &1) (p div &2) INTER dyho (--kt) nt = {}) + ==> !y. y IN dyho a p + ==> abs(y - dyho_mid (--kt) nt) <= &6 * &2 zpow a + &2 zpow + (--kt)`, + REPEAT GEN_TAC THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN + DISCH_THEN(X_CHOOSE_THEN `z:real` STRIP_ASSUME_TAC) THEN + X_GEN_TAC `y:real` THEN DISCH_TAC THEN + SUBGOAL_THEN `y IN dyho_star (a + &1) (p div &2)` ASSUME_TAC THENL + [MP_TAC(ISPECL [`a:int`; `p:int`] DYHO_SUBSET_STAR) THEN + MP_TAC(ISPECL [`a:int`; `p:int`] DYHO_STAR_PARENT) THEN + ASM SET_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL [`a + &1:int`; `p div &2`; `y:real`; + `z:real`] DYHO_STAR_DIAM) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`--kt:int`; `nt:int`; `z:real`] DYHO_MID_DIST) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + SUBGOAL_THEN `&2 zpow (a + &1) = &2 * &2 zpow a` ASSUME_TAC THENL + [SIMP_TAC[REAL_ZPOW_ADD; REAL_OF_NUM_EQ; ARITH_EQ; REAL_ZPOW_1] THEN + REAL_ARITH_TAC; ALL_TAC] THEN + ASM_REAL_ARITH_TAC);; + +(* Coarse containment: a cover cell at least as large as I_tau (2^{--kt} <= *) +(* 2^a) lies within 7*2^a of x_tau. *) +let KCOVER_SUBSET_IHAT_COARSE = prove + (`!P:(int#int#int)->bool a p kt nt. + (!s. s IN P ==> tile_I s SUBSET dyho (--kt) nt) /\ + &2 zpow (--kt) <= &2 zpow a /\ in_kcover P a p + ==> dyho a p SUBSET + real_interval[dyho_mid (--kt) nt - &7 * &2 zpow a, + dyho_mid (--kt) nt + &7 * &2 zpow a]`, + REPEAT STRIP_TAC THEN REWRITE_TAC[SUBSET; IN_REAL_INTERVAL] THEN + X_GEN_TAC `y:real` THEN DISCH_TAC THEN + MP_TAC(ISPECL [`a:int`; `p:int`; `kt:int`; + `nt:int`] KCOVER_STAR_TRIANGLE) THEN + ANTS_TAC THENL + [MATCH_MP_TAC KCOVER_PARENT_MEETS_ITAU_GEN THEN + MAP_EVERY EXISTS_TAC [`P:(int#int#int)->bool`] THEN ASM_REWRITE_TAC[]; + DISCH_THEN(MP_TAC o SPEC `y:real`) THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC]);; + +(* 286L(a-iv) per-level MEASURE bound: cover cells at a fixed coarse scale a *) +(* (2^{--kt} <= 2^a, i.e. level l = --a < k_tau) have total measure <= *) +(* 14*2^a. *) +(* Each such cell has measure 2^a, so this bounds their COUNT by 14 -- a *) +(* uniform *) +(* per-level bound (Fremlin's exact 3 is not needed; any constant gives *) +(* alpha1 *) +(* convergence). Same measure engine (disjoint cover cells in a 14*2^a *) +(* interval). *) +let KCOVER_LEVEL_MEASURE_BOUND = prove + (`!P:(int#int#int)->bool S a kt nt. + FINITE S /\ &2 zpow (--kt) <= &2 zpow a /\ + (!s. s IN P ==> tile_I s SUBSET dyho (--kt) nt) /\ + (!q. q IN S ==> in_kcover P a q) + ==> sum (IMAGE (\q. dyho a q) S) (\c. real_measure c) <= &14 * &2 zpow + a`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `real_measure(real_interval[dyho_mid (--kt) nt - &7 * &2 zpow a, + dyho_mid (--kt) nt + &7 * &2 zpow a])` + THEN + CONJ_TAC THENL + [MATCH_MP_TAC DISJOINT_CELLS_MEASURE_SUM_LE THEN + ASM_SIMP_TAC[FINITE_IMAGE; REAL_MEASURABLE_REAL_INTERVAL] THEN + REPEAT CONJ_TAC THEN REWRITE_TAC[FORALL_IN_IMAGE] THENL + [X_GEN_TAC `q:int` THEN DISCH_TAC THEN REWRITE_TAC[DYHO_MEASURABLE]; + X_GEN_TAC `q:int` THEN DISCH_TAC THEN + MATCH_MP_TAC KCOVER_SUBSET_IHAT_COARSE THEN + MAP_EVERY EXISTS_TAC [`P:(int#int#int)->bool`] THEN ASM_SIMP_TAC[]; + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN + X_GEN_TAC `q1:int` THEN DISCH_TAC THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN + X_GEN_TAC `q2:int` THEN DISCH_TAC THEN DISCH_TAC THEN + MP_TAC(SPECL [`P:(int#int#int)->bool`; `a:int`; `a:int`; + `q1:int`; `q2:int`] KCOVER_DISJOINT) THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_SIMP_TAC[]]; + REWRITE_TAC[REAL_MEASURE_REAL_INTERVAL] THEN + SUBGOAL_THEN `&0 < &2 zpow a` MP_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + REAL_ARITH_TAC]);; + +(* --- 286L alpha0/alpha1 assembly: the cover -> ALPHA_SCALE bridge --- *) + +(* A cover cell's index-span M = 2^{a+k} at tile-scale --k is >= 1 (k >= *) +(* --a). *) +let ZPOW_SPAN_POS = prove + (`!a k M:int. --k <= a /\ &2 zpow (a + k) = real_of_int M ==> &1 <= M`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `real_of_int (&1) <= real_of_int M` MP_TAC THENL + [REWRITE_TAC[int_of_num_th] THEN + UNDISCH_TAC `&2 zpow (a + k) = real_of_int M` THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + GEN_REWRITE_TAC LAND_CONV [GSYM(ISPEC `&2` REAL_ZPOW_0)] THEN + MATCH_MP_TAC ZPOW2_MONOE THEN ASM_INT_ARITH_TAC; + REWRITE_TAC[GSYM int_le]]);; + +(* "outside the span [Q, Q+M)" as a disjunction (needs M >= 1; Q = p*M *) +(* abstracted). *) +let SPAN_DISJ_EQV = INT_ARITH + `!Q M nI:int. Q + M <= nI \/ nI <= Q - &1 <=> + ~(&1 <= M /\ Q <= nI /\ nI < Q + M)`;; + +(* THE cover -> ALPHA_SCALE bridge: in_jscript P a p forces every *) +(* same-or-finer- *) +(* scale tile (k,nI,nJ) of P (k >= --a, i.e. mu I_sigma <= mu K) to have its *) +(* I-index *) +(* nI OUTSIDE the cover cell's own span [p*M, p*M+M), M = 2^{a+k}. This is *) +(* exactly *) +(* the "q+M <= FST(SND s) \/ FST(SND s) <= q-1" hypothesis of *) +(* CARLESON_ALPHA_SCALE. *) +(* Proof: if nI were inside the span, DYHO_SUBCELL_IFF gives I_sigma SUBSET *) +(* dyho a p *) +(* SUBSET dyho_star a p = K*, contradicting in_jscript (K in Cal J). *) +let JSCRIPT_TILE_OUTSIDE_SPAN = prove + (`!P:(int#int#int)->bool a p k nI nJ M. + in_jscript P a p /\ (k,nI,nJ) IN P /\ --k <= a /\ + &2 zpow (a + k) = real_of_int M + ==> (p * M + M <= nI \/ nI <= p * M - &1)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&1 <= (M:int)` ASSUME_TAC THENL + [MP_TAC(ISPECL [`a:int`; `k:int`; `M:int`] ZPOW_SPAN_POS) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[SPAN_DISJ_EQV] THEN + UNDISCH_TAC `in_jscript (P:(int#int#int)->bool) a p` THEN + REWRITE_TAC[in_jscript] THEN + DISCH_THEN(MP_TAC o SPEC `(k,nI,nJ):int#int#int`) THEN + ASM_REWRITE_TAC[tile_k; tile_I] THEN + SUBGOAL_THEN `&2 zpow (--k) <= &2 zpow a` (fun th -> REWRITE_TAC[th]) THENL + [MATCH_MP_TAC ZPOW2_MONOE THEN ASM_INT_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[] THEN + MATCH_MP_TAC(TAUT `(b ==> a) ==> (~a ==> ~b)`) THEN DISCH_TAC THEN + MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `dyho a p` THEN + REWRITE_TAC[DYHO_SUBSET_STAR] THEN + MP_TAC(ISPECL [`--k:int`; `a:int`; `M:int`; `p:int`; + `nI:int`] DYHO_SUBCELL_IFF) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [ASM_INT_ARITH_TAC; + SUBGOAL_THEN `a - --k = a + k:int` SUBST1_TAC THENL + [INT_ARITH_TAC; ASM_REWRITE_TAC[]]]; + DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN ASM_REWRITE_TAC[]]);; + +(* in_kcover form of the bridge (directly usable at the CARLESON_ALPHA_SCALE *) +(* call *) +(* site): a cover cell dyho a p and any tile s IN P at scale k (k >= --a) *) +(* have s's *) +(* I-index FST(SND s) outside the span [p*M, p*M+M), M = 2^{a+k}. in_kcover *) +(* => *) +(* in_jscript, then JSCRIPT_TILE_OUTSIDE_SPAN on the destructured tile. *) +let KCOVER_TILE_OUTSIDE_SPAN = prove + (`!P:(int#int#int)->bool a p k s M. + in_kcover P a p /\ s IN P /\ tile_k s = k /\ --k <= a /\ + &2 zpow (a + k) = real_of_int M + ==> (p * M + M <= FST(SND s) \/ FST(SND s) <= p * M - &1)`, + REWRITE_TAC[FORALL_PAIR_THM; tile_k; in_kcover] THEN REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`P:(int#int#int)->bool`; `a:int`; `p:int`; + `p1:int`; `p1':int`; `p2:int`; + `M:int`] JSCRIPT_TILE_OUTSIDE_SPAN) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[] THEN ASM_INT_ARITH_TAC);; + +(* --- 286L(d) alpha1: the TIGHT offset bound (via the TRIPLED cell Kstar) *) +(* --- *) +(* alpha1 (W1: mu K > mu I_tau) sums the per-scale bound over INFINITELY *) +(* many coarse *) +(* cover levels l_K < k_tau, so the loose "offset >= 0" of alpha0 is not *) +(* enough: the *) +(* geometric series in the coarse index would diverge. Fremlin's tight *) +(* per-scale *) +(* bound (286L(c-i)) carries a factor (1 + 2^{k-l})^{-2} = (1+N)^{-2} with N *) +(* the offset *) +(* of the tile's I-index from the cover cell's span; N >= M = 2^{a+k}, *) +(* because the tile *) +(* escapes the TRIPLED cell K* (not just K). These lemmas establish that *) +(* tight offset. *) + +(* A tile whose I-index nI lies in the TRIPLED span [(p-1)M,(p+2)M) has *) +(* I_sigma = *) +(* dyho(--k) nI contained in the tripled cover cell K* = dyho_star a p. *) +(* (Endpoint *) +(* arithmetic: 2^a = M 2^{-k}, and (p-1)M <= nI, nI+1 <= (p+2)M scale up to *) +(* the K* *) +(* edges.) This is the containment that in_jscript forbids for same-or-finer *) +(* tiles. *) +let DYHO_STAR_SUBCELL = prove + (`!a k M p nI:int. + --k <= a /\ &2 zpow (a + k) = real_of_int M /\ + (p - &1) * M <= nI /\ nI < (p + &2) * M + ==> dyho (--k) nI SUBSET dyho_star a p`, + REPEAT STRIP_TAC THEN REWRITE_TAC[dyho; dyho_star; SUBSET; IN_ELIM_THM] THEN + SUBGOAL_THEN `&2 zpow a = real_of_int M * &2 zpow (--k)` ASSUME_TAC THENL + [UNDISCH_TAC `&2 zpow (a + k) = real_of_int M` THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + SUBGOAL_THEN + `~(&2 = + &0)` (fun th -> REWRITE_TAC[GSYM(MATCH_MP REAL_ZPOW_ADD th)]) THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + AP_TERM_TAC THEN INT_ARITH_TAC; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `&0 < &2 zpow (--k)` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `real_of_int ((p - &1) * M) <= real_of_int nI /\ + real_of_int nI + &1 <= real_of_int ((p + &2) * M)` + STRIP_ASSUME_TAC THENL + [CONJ_TAC THENL + [ASM_REWRITE_TAC[GSYM int_le]; + REWRITE_TAC[GSYM ROI_1; REAL_OF_INT_CLAUSES; GSYM int_le] THEN + ASM_INT_ARITH_TAC]; + ALL_TAC] THEN + X_GEN_TAC `x:real` THEN STRIP_TAC THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `real_of_int nI * &2 zpow (--k)` THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `(real_of_int p - &1) * real_of_int M * &2 zpow --k = + real_of_int ((p - &1) * M) * &2 zpow (--k)` SUBST1_TAC THENL + [REWRITE_TAC[ROI_MUL; int_sub_th; ROI_1] THEN + CONV_TAC REAL_RING; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LE_RMUL_EQ]; + MATCH_MP_TAC REAL_LTE_TRANS THEN + EXISTS_TAC `(real_of_int nI + &1) * &2 zpow (--k)` THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + SUBGOAL_THEN `(real_of_int p + &2) * real_of_int M * &2 zpow --k = + real_of_int ((p + &2) * M) * &2 zpow (--k)` SUBST1_TAC + THENL + [REWRITE_TAC[ROI_MUL; int_add_th] THEN + SUBGOAL_THEN `real_of_int(&2) = &2` SUBST1_TAC THENL + [REWRITE_TAC[int_of_num_th]; CONV_TAC REAL_RING]; + ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LE_RMUL_EQ]]]);; + +(* in_jscript forbids any same-or-finer tile (k,nI,nJ) in P (k >= --a) from *) +(* having *) +(* I_sigma inside the tripled cover cell K* = dyho_star a p. (SPEC the *) +(* in_jscript *) +(* condition, discharge its scale side-condition 2^{-k} <= 2^a via *) +(* ZPOW2_MONOE.) *) +let JSCRIPT_TILE_NOTSUBSET = prove + (`!P:(int#int#int)->bool a p k nI nJ. + in_jscript P a p /\ (k,nI,nJ) IN P /\ --k <= a + ==> ~(dyho (--k) nI SUBSET dyho_star a p)`, + REPEAT STRIP_TAC THEN + UNDISCH_TAC `in_jscript (P:(int#int#int)->bool) a p` THEN + REWRITE_TAC[in_jscript] THEN + DISCH_THEN(MP_TAC o SPEC `(k,nI,nJ):int#int#int`) THEN + ASM_REWRITE_TAC[tile_k; tile_I] THEN + SUBGOAL_THEN `&2 zpow (--k) <= &2 zpow a` ASSUME_TAC THENL + [MATCH_MP_TAC ZPOW2_MONOE THEN ASM_INT_ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[]);; + +(* Combine: a same-or-finer tile's I-index nI is OUTSIDE the tripled span, *) +(* i.e. *) +(* nI < (p-1)M \/ (p+2)M <= nI. (If nI were inside, DYHO_STAR_SUBCELL would *) +(* put *) +(* I_sigma in K*, contradicting JSCRIPT_TILE_NOTSUBSET. The final integer *) +(* step is a *) +(* pure tautology, proved in a CLEAN context to avoid real-assumption *) +(* INT_ARITH poison.) *) +let JSCRIPT_SPAN_NEG = prove + (`!P:(int#int#int)->bool a p k nI nJ M. + in_jscript P a p /\ (k,nI,nJ) IN P /\ --k <= a /\ + &2 zpow (a + k) = real_of_int M + ==> ~((p - &1) * M <= nI /\ nI < (p + &2) * M)`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`P:(int#int#int)->bool`; `a:int`; `p:int`; `k:int`; `nI:int`; + `nJ:int`] + JSCRIPT_TILE_NOTSUBSET) THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(SPECL [`a:int`; `k:int`; `M:int`; `p:int`; + `nI:int`] DYHO_STAR_SUBCELL) THEN + ASM_REWRITE_TAC[]);; + +let JSCRIPT_TILE_OFFSET_TIGHT = prove + (`!P:(int#int#int)->bool a p k nI nJ M. + in_jscript P a p /\ (k,nI,nJ) IN P /\ --k <= a /\ + &2 zpow (a + k) = real_of_int M + ==> nI < (p - &1) * M \/ (p + &2) * M <= nI`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`P:(int#int#int)->bool`; `a:int`; `p:int`; `k:int`; `nI:int`; + `nJ:int`; + `M:int`] JSCRIPT_SPAN_NEG) THEN + ASM_REWRITE_TAC[] THEN POP_ASSUM_LIST(K ALL_TAC) THEN INT_ARITH_TAC);; + +(* in_kcover form usable at the CARLESON_ALPHA_SCALE_TIGHT call site: the *) +(* loose span- *) +(* exclusion disjunction (q + M <= nI \/ nI <= q - 1, q = pM) AND the TIGHT *) +(* offset lower *) +(* bound N = M on the signed distance to the span. From *) +(* JSCRIPT_TILE_OFFSET_TIGHT: *) +(* nI < (p-1)M gives (q-1)-nI >= M; (p+2)M <= nI gives nI-(q+M) >= M. Both *) +(* branches of *) +(* the offset "if" are >= M. (Products p*M expanded to p*M-M, p*M+2M so *) +(* INT_ARITH sees *) +(* the offsets linearly; M >= 1 from ZPOW_SPAN_POS.) *) +let KCOVER_TILE_OFFSET_TIGHT = prove + (`!P:(int#int#int)->bool a p k s M. + in_kcover P a p /\ s IN P /\ tile_k s = k /\ --k <= a /\ + &2 zpow (a + k) = real_of_int M + ==> (p * M + M <= FST(SND s) \/ FST(SND s) <= p * M - &1) /\ + M <= (if p * M + M <= FST(SND s) then FST(SND s) - (p * M + M) + else (p * M - &1) - FST(SND s))`, + REWRITE_TAC[FORALL_PAIR_THM; tile_k; in_kcover] THEN REPEAT GEN_TAC THEN + STRIP_TAC THEN + SUBGOAL_THEN `&1 <= (M:int) /\ (p1' < (p - &1) * M \/ (p + &2) * M <= p1')` + MP_TAC THENL + [CONJ_TAC THENL + [MP_TAC(ISPECL [`a:int`; `k:int`; `M:int`] ZPOW_SPAN_POS) THEN + ASM_REWRITE_TAC[]; + MP_TAC(SPECL [`P:(int#int#int)->bool`; `a:int`; `p:int`; `k:int`; + `p1':int`; `p2:int`; + `M:int`] JSCRIPT_TILE_OFFSET_TIGHT) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + UNDISCH_TAC `p1,p1',p2 IN (P:(int#int#int)->bool)` THEN + UNDISCH_TAC `p1 = (k:int)` THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[]]; + POP_ASSUM_LIST(K ALL_TAC) THEN + REWRITE_TAC[INT_ARITH `(p - &1) * M = p * M - M`; + INT_ARITH `(p + &2) * M = p * M + &2 * M`] THEN + DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN CONJ_TAC THENL + [ASM_INT_ARITH_TAC; + COND_CASES_TAC THEN ASM_INT_ARITH_TAC]]);; + +(* num_of_int helpers for the tight bound's offset N (a :num). For M >= 0, *) +(* &(num_of_ *) +(* int M) = real_of_int M (so the tight bound's inv((1+&N)^2) with N = *) +(* num_of_int M *) +(* rewrites to inv((1+2^{a+k})^2)); and num_of_int is monotone on the *) +(* nonnegatives. *) +let ROI_NUM_OF_INT = prove + (`!M:int. &0 <= M ==> &(num_of_int M) = real_of_int M`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `M:int` INT_OF_NUM_OF_INT) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [SYM th]) THEN + REWRITE_TAC[int_of_num_th]);; + +let NUM_OF_INT_LE = prove + (`!a b:int. &0 <= a /\ a <= b ==> num_of_int a <= num_of_int b`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&0 <= (b:int)` ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[GSYM INT_OF_NUM_LE] THEN + ASM_SIMP_TAC[INT_OF_NUM_OF_INT] THEN ASM_REWRITE_TAC[]);; + +(* --- 286Gd assembly: two-sided integer weight sum sum_{n in S} w(y-n) <= 2 *) +(* --- *) + +(* A positive integer gap gives a num offset >= 1. *) +let NUM_OF_INT_GE1 = prove + (`!n m:int. m < n ==> 1 <= num_of_int(n - m)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `n - m:int` INT_OF_NUM_OF_INT) THEN + ANTS_TAC THENL [ASM_INT_ARITH_TAC; ALL_TAC] THEN + ABBREV_TAC `p = num_of_int(n - m)` THEN DISCH_TAC THEN + SUBGOAL_THEN `&1 <= &p:int` MP_TAC THENL + [ASM_REWRITE_TAC[] THEN ASM_INT_ARITH_TAC; + REWRITE_TAC[INT_OF_NUM_LE] THEN ARITH_TAC]);; + +(* Every real has an integer within 1/2 (m = floor(y + 1/2)). *) +let NEAREST_INT = prove + (`!y:real. ?m:int. abs(y - real_of_int m) <= &1 / &2`, + GEN_TAC THEN + MP_TAC(ISPEC `y + &1 / &2` FLOOR) THEN STRIP_TAC THEN + EXISTS_TAC `int_of_real(floor(y + &1 / &2))` THEN + SUBGOAL_THEN + `real_of_int(int_of_real(floor(y + &1 / &2))) = floor(y + &1 / &2)` + SUBST1_TAC THENL + [REWRITE_TAC[GSYM int_rep] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_REAL_ARITH_TAC);; + +(* Trichotomy split of a finite integer-indexed sum at m: n < m, n = m, n > *) +(* m. *) +let SUM_INT_TRICHOTOMY = prove + (`!(S:int->bool) (f:int->real) m. FINITE S + ==> sum S f = sum {n | n IN S /\ n < m} f + sum {n | n IN S /\ n = m} f + + sum {n | n IN S /\ m < n} f`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `FINITE {n:int | n IN S /\ n < m} /\ FINITE {n:int | n IN S /\ n = m} /\ + FINITE {n:int | n IN S /\ m < n}` STRIP_ASSUME_TAC THENL + [REPEAT CONJ_TAC THEN MATCH_MP_TAC FINITE_RESTRICT THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `DISJOINT {n:int | n IN S /\ n = m} {n | n IN S /\ m < n}` ASSUME_TAC THENL + [REWRITE_TAC[DISJOINT; EXTENSION; IN_INTER; IN_ELIM_THM; NOT_IN_EMPTY] THEN + X_GEN_TAC `n:int` THEN ASM_INT_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `DISJOINT {n:int | n IN S /\ n < m} + ({n | n IN S /\ n = m} UNION {n | n IN S /\ m < n})` ASSUME_TAC + THENL + [REWRITE_TAC[DISJOINT; EXTENSION; IN_INTER; IN_UNION; IN_ELIM_THM; + NOT_IN_EMPTY] THEN + X_GEN_TAC `n:int` THEN ASM_INT_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `S = {n:int | n IN S /\ n < m} UNION ({n | n IN S /\ n = m} UNION {n | n IN + S /\ m < n})` + (fun th -> GEN_REWRITE_TAC (LAND_CONV o RATOR_CONV o RAND_CONV) [th]) THENL + [REWRITE_TAC[EXTENSION; IN_UNION; IN_ELIM_THM] THEN X_GEN_TAC `n:int` THEN + EQ_TAC THENL [DISCH_TAC THEN ASM_REWRITE_TAC[] THEN ASM_INT_ARITH_TAC; + STRIP_TAC THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + MP_TAC(ISPECL [`f:int->real`; `{n:int | n IN S /\ n < m}`; + `{n:int | n IN S /\ n = m} UNION {n | n IN S /\ m < n}`] + SUM_UNION) THEN + ASM_SIMP_TAC[FINITE_UNION] THEN DISCH_THEN SUBST1_TAC THEN + MP_TAC(ISPECL [`f:int->real`; `{n:int | n IN S /\ n = m}`; + `{n:int | n IN S /\ m < n}`] SUM_UNION) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN REFL_TAC);; + +(* The n > m piece: reindex n |-> num_of_int(n-m) into offsets >= 1, then *) +(* CW_ONESIDE_ *) +(* SUM (left shift r - &j). SUM_IMAGE injectivity from num_of_int being 1-1 *) +(* on the *) +(* positive gaps; the summand equality via ROI_NUM_OF_INT (& num_of_int = *) +(* real_of_int). *) +let CW_TWOSIDE_RIGHT = prove + (`!(S:int->bool) m r. FINITE S /\ abs r <= &1 / &2 + ==> sum {n | n IN S /\ m < n} (\n. cw(r - real_of_int(n - m))) <= &1 / + &2`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `sum {n:int | n IN S /\ m < n} (\n. cw(r - real_of_int(n - m))) = + sum (IMAGE (\n:int. num_of_int(n - m)) {n | n IN S /\ m < n}) (\j. cw(r - + &j))` + SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN + MP_TAC(ISPECL [`\n:int. num_of_int(n - m)`; `\j:num. cw(r - &j)`; + `{n:int | n IN S /\ m < n}`] SUM_IMAGE) THEN + ANTS_TAC THENL + [REWRITE_TAC[IN_ELIM_THM] THEN MAP_EVERY X_GEN_TAC [`a:int`; `b:int`] THEN + STRIP_TAC THEN + MP_TAC(ISPEC `a - m:int` INT_OF_NUM_OF_INT) THEN ANTS_TAC THENL + [ASM_INT_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPEC `b - m:int` INT_OF_NUM_OF_INT) THEN ANTS_TAC THENL + [ASM_INT_ARITH_TAC; ALL_TAC] THEN + REPEAT DISCH_TAC THEN + SUBGOAL_THEN `a - m:int = b - m` MP_TAC THENL + [FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [SYM th]) THEN + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN + ASM_REWRITE_TAC[]; + INT_ARITH_TAC]; + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[o_DEF] THEN + MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `n:int` THEN + REWRITE_TAC[IN_ELIM_THM] THEN + STRIP_TAC THEN REWRITE_TAC[] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + MATCH_MP_TAC ROI_NUM_OF_INT THEN ASM_INT_ARITH_TAC]; + ALL_TAC] THEN + MATCH_MP_TAC CW_ONESIDE_SUM THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC FINITE_IMAGE THEN ASM_SIMP_TAC[FINITE_RESTRICT]; + REWRITE_TAC[FORALL_IN_IMAGE; IN_ELIM_THM] THEN + X_GEN_TAC `n:int` THEN STRIP_TAC THEN + MATCH_MP_TAC NUM_OF_INT_GE1 THEN ASM_REWRITE_TAC[]]);; + +(* The n < m piece: reindex n |-> num_of_int(m-n), CW_ONESIDE_SUM_R (right *) +(* shift r + &j), since r - real_of_int(n-m) = r + real_of_int(m-n). *) +let CW_TWOSIDE_LEFT = prove + (`!(S:int->bool) m r. FINITE S /\ abs r <= &1 / &2 + ==> sum {n | n IN S /\ n < m} (\n. cw(r - real_of_int(n - m))) <= &1 / + &2`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `sum {n:int | n IN S /\ n < m} (\n. cw(r - real_of_int(n - m))) = + sum (IMAGE (\n:int. num_of_int(m - n)) {n | n IN S /\ n < m}) (\j. cw(r + + &j))` + SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN + MP_TAC(ISPECL [`\n:int. num_of_int(m - n)`; `\j:num. cw(r + &j)`; + `{n:int | n IN S /\ n < m}`] SUM_IMAGE) THEN + ANTS_TAC THENL + [REWRITE_TAC[IN_ELIM_THM] THEN MAP_EVERY X_GEN_TAC [`a:int`; `b:int`] THEN + STRIP_TAC THEN + MP_TAC(ISPEC `m - a:int` INT_OF_NUM_OF_INT) THEN ANTS_TAC THENL + [ASM_INT_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPEC `m - b:int` INT_OF_NUM_OF_INT) THEN ANTS_TAC THENL + [ASM_INT_ARITH_TAC; ALL_TAC] THEN + REPEAT DISCH_TAC THEN + SUBGOAL_THEN `m - a:int = m - b` MP_TAC THENL + [FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC LAND_CONV [SYM th]) THEN + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN + ASM_REWRITE_TAC[]; + INT_ARITH_TAC]; + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[o_DEF] THEN + MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `n:int` THEN + REWRITE_TAC[IN_ELIM_THM] THEN + STRIP_TAC THEN REWRITE_TAC[] THEN + SUBGOAL_THEN `&(num_of_int(m - n)) = real_of_int(m - n)` SUBST1_TAC THENL + [MATCH_MP_TAC ROI_NUM_OF_INT THEN ASM_INT_ARITH_TAC; ALL_TAC] THEN + AP_TERM_TAC THEN REWRITE_TAC[int_sub_th] THEN REAL_ARITH_TAC]; + ALL_TAC] THEN + MATCH_MP_TAC CW_ONESIDE_SUM_R THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC FINITE_IMAGE THEN ASM_SIMP_TAC[FINITE_RESTRICT]; + REWRITE_TAC[FORALL_IN_IMAGE; IN_ELIM_THM] THEN + X_GEN_TAC `n:int` THEN STRIP_TAC THEN + MATCH_MP_TAC NUM_OF_INT_GE1 THEN ASM_REWRITE_TAC[]]);; + +(* 286Gd: sum_{n in S} w(y - n) <= 2 for any finite integer set S. Nearest *) +(* integer m *) +(* (NEAREST_INT); trichotomy split (SUM_INT_TRICHOTOMY); left/right pieces *) +(* <= 1/2 each *) +(* (CW_TWOSIDE_LEFT/RIGHT); the n = m singleton term w(y-m) <= 1 (CW_LE_1). *) +(* This is *) +(* the pointwise engine for v2 in alpha2 (286L f-iii): sum over the *) +(* half-integer grid. *) +let CW_INTEGER_SHIFT_SUM = prove + (`!(S:int->bool) y. FINITE S ==> sum S (\n. cw(y - real_of_int n)) <= &2`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `y:real` NEAREST_INT) THEN DISCH_THEN(X_CHOOSE_TAC `m:int`) THEN + ASM_SIMP_TAC[SUM_INT_TRICHOTOMY] THEN + SUBGOAL_THEN + `!n:int. cw(y - real_of_int n) = cw((y - real_of_int m) - real_of_int(n - + m))` + (fun th -> ONCE_REWRITE_TAC[th]) THENL + [GEN_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[int_sub_th] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `l <= &1 / &2 /\ mid <= &1 /\ r <= &1 / &2 ==> l + + mid + r <= &2`) THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CW_TWOSIDE_LEFT THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[INT_SUB_REFL; int_of_num_th; REAL_SUB_RZERO] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum {m:int} (\x. cw(y - real_of_int m))` THEN CONJ_TAC THENL + [MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN + REWRITE_TAC[FINITE_SING] THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_SING] THEN SIMP_TAC[]; + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN + REWRITE_TAC[CW_POS]]; + REWRITE_TAC[SUM_SING] THEN REWRITE_TAC[CW_LE_1]]; + MATCH_MP_TAC CW_TWOSIDE_RIGHT THEN ASM_REWRITE_TAC[]]);; + +(* Chebyshev / Markov (measure from a lower-bounded integral): if c <= f on *) +(* a *) +(* measurable set A and f is integrable there, then c * mu A <= int_A f. *) +(* (int_A c = *) +(* c mu A via has_real_measure = (\x.1) has_real_integral (mu A); *) +(* REAL_INTEGRAL_LE.) *) +(* 286L(e) step 6: on E cap g^-1[J_ups] cap K the weight w_ups >= w(3/2)/(2 *) +(* mu K), so *) +(* (w(3/2)/2 mu K) mu(...) <= int w_ups <= gamma', giving mu(...) <= 2 *) +(* gamma' mu K/w(3/2). *) +let CHEBYSHEV_MEASURE = prove + (`!A f c. real_measurable A /\ f real_integrable_on A /\ (!x. x IN A ==> c <= + f x) + ==> c * real_measure A <= real_integral A f`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `((\x. &1) has_real_integral (real_measure A)) A` ASSUME_TAC THENL + [REWRITE_TAC[GSYM has_real_measure] THEN + ASM_REWRITE_TAC[HAS_REAL_MEASURE_REAL_MEASURABLE_REAL_MEASURE]; + ALL_TAC] THEN + SUBGOAL_THEN + `c * real_measure A = real_integral A (\x. c * &1)` SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_LMUL THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC REAL_INTEGRAL_LE THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_LMUL THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_INTEGRABLE THEN + EXISTS_TAC `real_measure A` THEN ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + X_GEN_TAC `x:real` THEN DISCH_TAC THEN REWRITE_TAC[REAL_MUL_RID] THEN + ASM_SIMP_TAC[]]);; + +(* Dual of CHEBYSHEV_MEASURE: if f <= M on a measurable set A and f is *) +(* integrable there, *) +(* then int_A f <= M mu A. (int_A M = M mu A via has_real_measure = (\x.1) *) +(* has_real_ *) +(* integral (mu A); REAL_INTEGRAL_LE.) This is the per-cell step int_{G_K} *) +(* v2 <= (2 C1 *) +(* gamma) mu G_K in the alpha2 int-v2 layer. *) +let INTEGRAL_LE_BOUND_MEASURE = prove + (`!A f M. real_measurable A /\ f real_integrable_on A /\ (!x. x IN A ==> f x + <= M) + ==> real_integral A f <= M * real_measure A`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `((\x. &1) has_real_integral (real_measure A)) A` ASSUME_TAC THENL + [REWRITE_TAC[GSYM has_real_measure] THEN + ASM_REWRITE_TAC[HAS_REAL_MEASURE_REAL_MEASURABLE_REAL_MEASURE]; + ALL_TAC] THEN + SUBGOAL_THEN + `M * real_measure A = real_integral A (\x. M * &1)` SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_LMUL THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC REAL_INTEGRAL_LE THEN REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_INTEGRABLE_LMUL THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_INTEGRABLE THEN + EXISTS_TAC `real_measure A` THEN ASM_REWRITE_TAC[]; + X_GEN_TAC `x:real` THEN DISCH_TAC THEN REWRITE_TAC[REAL_MUL_RID] THEN + ASM_SIMP_TAC[]]);; + +(* --- 286D toolkit (abstract measure theory, no Carleson dependence): the *) +(* Markov/Chebyshev level-set bound + integrability of a nonneg measurable *) +(* function on a measurable subset. Used for the 286U(b) a.e.-finiteness of *) +(* the *) +(* window family: from int_E Ahat_m f <= C sqrt muE (all finite-measure E), *) +(* the *) +(* sup sup_m Ahat_m f is finite a.e. (Fremlin 286D). --- *) + +(* g restricted to the level set is measurable via the univ-restrict bridge. *) +let REAL_INTEGRABLE_ON_NONNEG_INTER = prove + (`!(g:real->real) A L. + real_measurable A /\ real_lebesgue_measurable L /\ + g real_measurable_on A /\ g real_integrable_on A /\ + (!x. x IN A ==> &0 <= g x) + ==> (g:real->real) real_integrable_on (L INTER A)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_INTEGRABLE_RESTRICT_INTER] THEN + MATCH_MP_TAC REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN + EXISTS_TAC `g:real->real` THEN REPEAT CONJ_TAC THENL + [SUBGOAL_THEN `(g:real->real) real_measurable_on (L INTER A)` MP_TAC THENL + [MATCH_MP_TAC REAL_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN + EXISTS_TAC `A:real->bool` THEN ASM_REWRITE_TAC[INTER_SUBSET] THEN + MATCH_MP_TAC REAL_LEBESGUE_MEASURABLE_INTER THEN + ASM_SIMP_TAC[REAL_MEASURABLE_IMP_REAL_LEBESGUE_MEASURABLE]; + ONCE_REWRITE_TAC[GSYM REAL_MEASURABLE_ON_UNIV] THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:real` THEN + REWRITE_TAC[IN_INTER] THEN + ASM_CASES_TAC `(x:real) IN A` THEN ASM_CASES_TAC `(x:real) IN L` THEN + ASM_REWRITE_TAC[]]; + ASM_REWRITE_TAC[]; + X_GEN_TAC `x:real` THEN DISCH_TAC THEN BETA_TAC THEN + SUBGOAL_THEN `&0 <= (g:real->real) x` ASSUME_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + COND_CASES_TAC THEN ASM_REAL_ARITH_TAC]);; + +let REAL_INTEGRABLE_ON_NONNEG_MEASURABLE_SUBSET = prove + (`!(g:real->real) A L. + real_measurable A /\ real_lebesgue_measurable L /\ L SUBSET A /\ + g real_measurable_on A /\ g real_integrable_on A /\ + (!x. x IN A ==> &0 <= g x) + ==> (g:real->real) real_integrable_on L`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `L:real->bool = L INTER A` (fun th -> ONCE_REWRITE_TAC[th]) THENL + [ASM_SIMP_TAC[SET_RULE `L SUBSET A ==> L = L INTER A`]; ALL_TAC] THEN + MATCH_MP_TAC REAL_INTEGRABLE_ON_NONNEG_INTER THEN ASM_REWRITE_TAC[]);; + +(* A measurable-subset bound in the form needed below. *) +let MK_LEBMEAS_SUBSET = prove + (`!s t. real_lebesgue_measurable s /\ real_measurable t /\ s SUBSET t + ==> real_measurable s`, + REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_MEASURABLE_MEASURABLE] THEN + MATCH_MP_TAC MEASURABLE_LEBESGUE_MEASURABLE_SUBSET THEN + EXISTS_TAC `IMAGE lift t` THEN + ASM_REWRITE_TAC[GSYM REAL_LEBESGUE_MEASURABLE; + GSYM REAL_MEASURABLE_MEASURABLE] THEN + MATCH_MP_TAC IMAGE_SUBSET THEN ASM_REWRITE_TAC[]);; + +(* The level-set identity A INTER {y | k < g y} = superlevel of g.chi_A. *) +let MK_LEVEL_ID = prove + (`!(g:real->real) A k. &0 < k + ==> A INTER {y | k < g y} = {y | (\x. if x IN A then g x else &0) y > k}`, + REPEAT STRIP_TAC THEN REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM] THEN + GEN_TAC THEN REWRITE_TAC[real_gt] THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC);; + +(* Markov/Chebyshev level-set measure bound: k*mu(A INTER {g>k}) <= int_A g *) +(* <= D. *) +let CARLESON_LEVEL_MARKOV_M = prove + (`!(G:num->real->real) A D c m. + real_measurable A /\ &0 < c /\ + (G m) real_measurable_on (:real) /\ (G m) real_integrable_on A /\ + (!x. x IN A ==> &0 <= G m x) /\ real_integral A (G m) <= D + ==> real_measurable (A INTER {y | c < (G:num->real->real) m y}) /\ + c * real_measure (A INTER {y | c < G m y}) <= D`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `real_lebesgue_measurable {y | c < (G:num->real->real) m y}` + ASSUME_TAC THENL + [MP_TAC(ISPEC `(G:num->real->real) m` + REAL_MEASURABLE_ON_PREIMAGE_HALFSPACE_GT) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `c:real`) THEN + REWRITE_TAC[real_gt]; + ALL_TAC] THEN + SUBGOAL_THEN `real_measurable (A INTER {y | c < (G:num->real->real) m y})` + ASSUME_TAC THENL + [MATCH_MP_TAC MK_LEBMEAS_SUBSET THEN EXISTS_TAC `A:real->bool` THEN + ASM_REWRITE_TAC[INTER_SUBSET] THEN + MATCH_MP_TAC REAL_LEBESGUE_MEASURABLE_INTER THEN + ASM_SIMP_TAC[REAL_MEASURABLE_IMP_REAL_LEBESGUE_MEASURABLE]; + ALL_TAC] THEN + SUBGOAL_THEN + `(G:num->real->real) m real_integrable_on (A INTER {y | c < G m y})` + ASSUME_TAC THENL + [ONCE_REWRITE_TAC[INTER_COMM] THEN + MP_TAC(ISPECL [`(G:num->real->real) m`; `A:real->bool`; + `{y | c < (G:num->real->real) m y}`] + REAL_INTEGRABLE_ON_NONNEG_INTER) THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_MEASURABLE_ON_MEASURABLE_SUBSET THEN + EXISTS_TAC `(:real)` THEN ASM_REWRITE_TAC[SUBSET_UNIV]; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`A INTER {y | c < (G:num->real->real) m y}`; + `(G:num->real->real) m`; + `c:real`] CHEBYSHEV_MEASURE) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [X_GEN_TAC `y:real` THEN REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `i <= D ==> c * m <= i ==> c * m <= D`) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `real_integral A ((G:num->real->real) m)` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_INTEGRAL_SUBSET_LE THEN + ASM_REWRITE_TAC[INTER_SUBSET] THEN + X_GEN_TAC `y:real` THEN REWRITE_TAC[IN_INTER] THEN STRIP_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]);; + +(* 286D level-union bound: for an increasing nonneg sequence G with int_A (G *) +(* m)<=D uniformly, the union over m of the level sets A INTER {c HAS_REAL_ MEASURE_NESTED_UNIONS gives measurability + *) +(* mu(UNION)=lim mu <= D/c (REALLIM_ UBOUND). --- *) +let CARLESON_UK_MEASURE = prove + (`!(G:num->real->real) A D c. + real_measurable A /\ &0 < c /\ &0 <= D /\ + (!m. (G m) real_measurable_on (:real) /\ (G m) real_integrable_on A /\ + (!x. x IN A ==> &0 <= G m x) /\ real_integral A (G m) <= D) /\ + (!m x. x IN A ==> G m x <= G (SUC m) x) + ==> real_measurable (UNIONS { A INTER {y | c < G m y} | m IN (:num) }) /\ + real_measure (UNIONS { A INTER {y | c < G m y} | m IN (:num) }) <= D / + c`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN + `!m. real_measurable (A INTER {y | c < (G:num->real->real) m y}) /\ + real_measure (A INTER {y | c < G m y}) <= D / c` + ASSUME_TAC THENL + [GEN_TAC THEN + MP_TAC(ISPECL [`G:num->real->real`; `A:real->bool`; `D:real`; `c:real`; + `m:num`] + CARLESON_LEVEL_MARKOV_M) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `!m. (A INTER {y | c < (G:num->real->real) m y}) SUBSET + (A INTER {y | c < G (SUC m) y})` + ASSUME_TAC THENL + [GEN_TAC THEN REWRITE_TAC[SUBSET; IN_INTER; IN_ELIM_THM] THEN + X_GEN_TAC `y:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `(G:num->real->real) m y` THEN + ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MP_TAC(ISPECL [`\m:num. (A:real->bool) INTER {y | c < (G:num->real->real) m + y}`; + `D / c:real`] HAS_REAL_MEASURE_NESTED_UNIONS) THEN + REWRITE_TAC[] THEN ASM_SIMP_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(ISPEC `sequentially` REALLIM_UBOUND) THEN + EXISTS_TAC `\m. real_measure (A INTER {y | c < (G:num->real->real) m y})` + THEN + ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; EVENTUALLY_SEQUENTIALLY] THEN + EXISTS_TAC `0` THEN ASM_SIMP_TAC[]);; + +(* 286D bad-set = INTERS over k of the level-unions U_k = UNIONS_m A INTER *) +(* {&k+&1 < G m}. (y in bad set <=> y in A and for all k some G m y exceeds *) +(* &k+&1 *) +(* <=> y in every U_k.) Extensional membership form from *) +(* INTERS_GSPEC/IN_UNIONS. --- *) +let CARLESON_BADSET_INTERS_ID = prove + (`!(G:num->real->real) A. + {y | y IN A /\ !k. ?m. &k + &1 < (G:num->real->real) m y} = + INTERS { UNIONS { A INTER {y | &k + &1 < G m y} | m IN (:num) } | k IN + (:num) }`, + REPEAT GEN_TAC THEN + REWRITE_TAC[EXTENSION; INTERS_GSPEC; IN_ELIM_THM; IN_UNIV; IN_UNIONS; + IN_INTER] THEN + X_GEN_TAC `y:real` THEN EQ_TAC THENL + [STRIP_TAC THEN X_GEN_TAC `k:num` THEN + FIRST_X_ASSUM(MP_TAC o SPEC `k:num`) THEN + DISCH_THEN(X_CHOOSE_TAC `m:num`) THEN + EXISTS_TAC `A INTER {y | &k + &1 < (G:num->real->real) m y}` THEN + CONJ_TAC THENL + [EXISTS_TAC `m:num` THEN GEN_TAC THEN REWRITE_TAC[IN_INTER; IN_ELIM_THM]; + ASM_REWRITE_TAC[IN_INTER; IN_ELIM_THM]]; + DISCH_TAC THEN + SUBGOAL_THEN `y IN A /\ !k. ?m. &k + &1 < (G:num->real->real) m y` + (fun th -> ACCEPT_TAC th) THEN + CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `0`) THEN + DISCH_THEN(X_CHOOSE_THEN `t:real->bool` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `y:real` th)) THEN + ASM_REWRITE_TAC[] THEN + SIMP_TAC[]; + X_GEN_TAC `k:num` THEN + FIRST_X_ASSUM(MP_TAC o SPEC `k:num`) THEN + DISCH_THEN(X_CHOOSE_THEN `t:real->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `m:num` THEN + FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `y:real` th)) THEN + ASM_REWRITE_TAC[] THEN + SIMP_TAC[]]]);; + +(* s <= D/(&k+&1) for all k, with s,D >= 0 => s = 0 (D/(&k+&1) -> 0). *) +let LE_DIV_LIM_ZERO = prove + (`!s D. &0 <= s /\ &0 <= D /\ (!k. s <= D / (&k + &1)) ==> s = &0`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= s /\ s <= &0 ==> s = &0`) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(ISPEC `sequentially` REALLIM_LBOUND) THEN + MAP_EVERY EXISTS_TAC [`\k:num. D * inv(&k + &1)`] THEN + REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; EVENTUALLY_SEQUENTIALLY] THEN + REPEAT CONJ_TAC THENL + [MP_TAC(SPEC `D:real` (MATCH_MP REALLIM_LMUL (SPEC `&1` + REALLIM_1_OVER_N_OFFSET))) THEN + SIMP_TAC[REAL_MUL_RZERO]; + EXISTS_TAC `0` THEN X_GEN_TAC `k:num` THEN DISCH_TAC THEN + ASM_REWRITE_TAC[GSYM real_div]]);; + +(* --- 286D (Fremlin mt286.tex 303-342): a.e.-finiteness of the sup. For an *) +(* increasing nonneg sequence G with int_A (G m) <= D uniformly, the "sup = *) +(* inf" *) +(* bad set {y in A : !k. ?m. &k+&1 < G m y} is negligible. bad = INTERS_k *) +(* U_k *) +(* (CARLESON_BADSET_INTERS_ID), measurable (COUNTABLE_INTERS of the U_k), *) +(* and *) +(* mu(bad) <= mu(U_k) <= D/(&k+&1) for every k (CARLESON_UK_MEASURE), so *) +(* mu(bad)=0 *) +(* (LE_DIV_LIM_ZERO); negligible via REAL_MEASURABLE_REAL_MEASURE_EQ_0. *) +(* Instantiate *) +(* G := Ahat_(&m) f_1 to get the a.e.-finiteness the 286U(b) domination *) +(* needs. --- *) +let CARLESON_SUP_AE_FINITE = prove + (`!(G:num->real->real) A D. + real_measurable A /\ &0 <= D /\ + (!m. (G m) real_measurable_on (:real) /\ (G m) real_integrable_on A /\ + (!x. x IN A ==> &0 <= G m x) /\ real_integral A (G m) <= D) /\ + (!m x. x IN A ==> G m x <= G (SUC m) x) + ==> real_negligible {y | y IN A /\ !k. ?m. &k + &1 < (G:num->real->real) m + y}`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN + `!k. real_measurable (UNIONS { A INTER {y | &k + &1 < (G:num->real->real) m + y} | m IN (:num) }) /\ + real_measure (UNIONS { A INTER {y | &k + &1 < (G:num->real->real) m y} + | m IN (:num) }) + <= D / (&k + &1)` + ASSUME_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC CARLESON_UK_MEASURE THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[CARLESON_BADSET_INTERS_ID] THEN + SUBGOAL_THEN + `real_measurable (INTERS { UNIONS { A INTER {y | &k + &1 < + (G:num->real->real) m y} | m IN (:num) } | k IN (:num) })` + ASSUME_TAC THENL + [MATCH_MP_TAC REAL_MEASURABLE_COUNTABLE_INTERS THEN GEN_TAC THEN + ASM_SIMP_TAC[]; + ALL_TAC] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[GSYM(MATCH_MP + REAL_MEASURABLE_REAL_MEASURE_EQ_0 th)]) THEN + MATCH_MP_TAC LE_DIV_LIM_ZERO THEN EXISTS_TAC `D:real` THEN + ASM_SIMP_TAC[REAL_MEASURE_POS_LE] THEN + X_GEN_TAC `k:num` THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `real_measure (UNIONS { A INTER {y | &k + &1 < (G:num->real->real) + m y} | m IN (:num) })` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_MEASURE_SUBSET THEN REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + ASM_SIMP_TAC[]; + MATCH_MP_TAC(SET_RULE `(?k. u = f k) ==> INTERS {f k | k IN (:num)} + SUBSET u`) THEN + EXISTS_TAC `k:num` THEN REFL_TAC]; + ASM_SIMP_TAC[]]);; + +(* Sum/integral interchange (generic, tile-agnostic; reused by alpha2 int-v2 *) +(* and *) +(* alpha3 int-v3). A finite family of integrals of g s over regions Bs s *) +(* SUBSET G *) +(* equals the single integral over G of the pointwise sum of the *) +(* zero-extended *) +(* integrands. Each zero-extension is integrable on G by REAL_INTEGRABLE_ON_ *) +(* SUPERSET (it vanishes off Bs s), and equals g s on Bs s *) +(* (REAL_INTEGRABLE_EQ); *) +(* REAL_INTEGRAL_SUM interchanges, REAL_INTEGRAL_RESTRICT collapses each *) +(* term. *) +let SUM_INTEGRAL_RESTRICT_INTERCHANGE = prove + (`!(A:B->bool) (G:real->bool) (Bs:B->real->bool) (g:B->real->real). + FINITE A /\ real_measurable G /\ + (!s. s IN A ==> Bs s SUBSET G /\ (g s) real_integrable_on (Bs s)) + ==> sum A (\s. real_integral (Bs s) (g s)) = + real_integral G (\x. sum A (\s. if x IN Bs s then g s x else &0))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `!s. s IN A + ==> (\x. if x IN Bs s then (g:B->real->real) s x else &0) + real_integrable_on G` + ASSUME_TAC THENL + [X_GEN_TAC `s:B` THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_INTEGRABLE_ON_SUPERSET THEN + EXISTS_TAC `Bs (s:B):real->bool` THEN + REPEAT CONJ_TAC THENL + [X_GEN_TAC `x:real` THEN DISCH_TAC THEN ASM_REWRITE_TAC[]; + ASM_SIMP_TAC[]; + MATCH_MP_TAC REAL_INTEGRABLE_EQ THEN + EXISTS_TAC `(g:B->real->real) s` THEN + CONJ_TAC THENL + [X_GEN_TAC `x:real` THEN DISCH_TAC THEN ASM_REWRITE_TAC[]; + ASM_SIMP_TAC[]]]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`\s:B. (\x. if x IN Bs s then (g:B->real->real) s x else &0)`; + `G:real->bool`; `A:B->bool`] REAL_INTEGRAL_SUM) THEN + ASM_SIMP_TAC[] THEN DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN + MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `s:B` THEN DISCH_TAC THEN BETA_TAC THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_INTEGRAL_RESTRICT THEN + ASM_SIMP_TAC[]);; + +(* Sum-of-integrals <= D mu G (generic). Interchange (above) turns the *) +(* finite sum *) +(* of region-integrals into one integral over G of the pointwise sum; if *) +(* that *) +(* pointwise sum is <= D on G then INTEGRAL_LE_BOUND_MEASURE gives <= D mu *) +(* G. This *) +(* is the |alpha_j| <= (2 C1 gamma) mu G_K engine (D = 2 C1 gamma from *) +(* V2_POINTWISE_ *) +(* COLLAPSE, G = G_K). *) +let SUM_INTEGRAL_LE_MEASURE = prove + (`!(A:B->bool) (G:real->bool) (Bs:B->real->bool) (g:B->real->real) D. + FINITE A /\ real_measurable G /\ + (!s. s IN A ==> Bs s SUBSET G /\ (g s) real_integrable_on (Bs s)) /\ + (!x. x IN G ==> sum A (\s. if x IN Bs s then g s x else &0) <= D) + ==> sum A (\s. real_integral (Bs s) (g s)) <= D * real_measure G`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`A:B->bool`; `G:real->bool`; `Bs:B->real->bool`; + `g:B->real->real`] SUM_INTEGRAL_RESTRICT_INTERCHANGE) THEN + ASM_SIMP_TAC[] THEN DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN + MATCH_MP_TAC INTEGRAL_LE_BOUND_MEASURE THEN ASM_SIMP_TAC[] THEN + MATCH_MP_TAC REAL_INTEGRABLE_SUM THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `s:B` THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_INTEGRABLE_ON_SUPERSET THEN + EXISTS_TAC `Bs (s:B):real->bool` THEN + REPEAT CONJ_TAC THENL + [X_GEN_TAC `x:real` THEN DISCH_TAC THEN ASM_REWRITE_TAC[]; + ASM_SIMP_TAC[]; + MATCH_MP_TAC REAL_INTEGRABLE_EQ THEN + EXISTS_TAC `(g:B->real->real) s` THEN + CONJ_TAC THENL + [X_GEN_TAC `x:real` THEN DISCH_TAC THEN ASM_REWRITE_TAC[]; + ASM_SIMP_TAC[]]]);; + +(* Termwise piece of the cover-integral bound: sum_{IMAGE G K} int_s v <= *) +(* sum_{IMAGE G K} *) +(* D mu s (each int_{G c} v <= D mu(G c) by INTEGRAL_LE_BOUND_MEASURE). *) +let SUM_COVER_INTEGRAL_LE = prove + (`!(G:A->(real->bool)) (K:A->bool) v II. + FINITE K /\ + (!c c'. c IN K /\ c' IN K /\ G c = G c' ==> c = c') /\ + (!c. c IN K ==> v real_integrable_on (G c) /\ G c SUBSET II) /\ + (!c c'. c IN K /\ c' IN K /\ ~(c = c') ==> real_negligible (G c INTER G + c')) /\ + v real_integrable_on II /\ (!x. &0 <= v x) + ==> sum K (\c. real_integral (G c) v) <= real_integral II v`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`v:real->real`; `\s:real->bool. real_integral s v`; + `IMAGE (G:A->(real->bool)) K`] HAS_REAL_INTEGRAL_UNIONS) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[FINITE_IMAGE] THEN CONJ_TAC THENL + [REWRITE_TAC[FORALL_IN_IMAGE] THEN X_GEN_TAC `c:A` THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_INTEGRABLE_INTEGRAL THEN ASM_SIMP_TAC[]; + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN + X_GEN_TAC `c:A` THEN DISCH_TAC THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN + X_GEN_TAC `c':A` THEN DISCH_TAC THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o check(fun t -> is_forall(concl t) && + (can (find_term (fun tm -> tm = `real_negligible`)) (concl t)))) THEN + ASM_MESON_TAC[]]; + ALL_TAC] THEN + DISCH_TAC THEN + SUBGOAL_THEN + `v real_integrable_on (UNIONS (IMAGE (G:A->(real->bool)) K))` + ASSUME_TAC THENL + [ASM_MESON_TAC[HAS_REAL_INTEGRAL_INTEGRABLE]; ALL_TAC] THEN + SUBGOAL_THEN `sum K (\c. real_integral ((G:A->(real->bool)) c) v) = + real_integral (UNIONS (IMAGE G K)) v` SUBST1_TAC THENL + [FIRST_X_ASSUM(fun th -> if can (find_term (fun tm -> tm = + `has_real_integral`)) (concl th) + then SUBST1_TAC(MATCH_MP REAL_INTEGRAL_UNIQUE th) + else NO_TAC) THEN + MATCH_MP_TAC EQ_SYM THEN + MP_TAC(ISPECL [`G:A->(real->bool)`; `\s:real->bool. real_integral s v`; + `K:A->bool`] + SUM_IMAGE) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(fun th -> REWRITE_TAC[th; o_DEF]); ALL_TAC] THEN + MATCH_MP_TAC REAL_INTEGRAL_SUBSET_LE THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_IMAGE] THEN + X_GEN_TAC `c:A` THEN DISCH_TAC THEN ASM_SIMP_TAC[]; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + ASM_SIMP_TAC[]]);; + + +(* --- 286L(e) G_K weight-lower-bound bricks (toward mu G_K <= 2 gamma' mu *) +(* K/w(3/2)) --- *) + +(* 286L(e) step 4 (raw): if x is within (3/2) mu I_s of the tile centre x_s, *) +(* then *) +(* w_s(x) = cw_tile s x >= 2^{k_s} w(3/2). (cw_tile s x = 2^{k_s} *) +(* cw(2^{k_s}(x-x_s)), *) +(* and |2^{k_s}(x-x_s)| <= 2^{k_s}(3/2)2^{-k_s} = 3/2, so cw(...) >= cw(3/2) *) +(* by antitone.) *) +let CWTILE_LOWER_NEAR = prove + (`!(s:int#int#int) x. + abs(x - tile_xmid s) <= &3 / &2 * &2 zpow (--(tile_k s)) + ==> &2 zpow (tile_k s) * cw(&3 / &2) <= cw_tile s x`, + REPEAT STRIP_TAC THEN REWRITE_TAC[cw_tile] THEN + SUBGOAL_THEN `&0 < &2 zpow (tile_k s)` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [ASM_SIMP_TAC[REAL_LT_IMP_LE]; ALL_TAC] THEN + MATCH_MP_TAC CW_ANTITONE THEN + SUBGOAL_THEN + `abs(&2 zpow (tile_k s) * (x - tile_xmid s)) <= &3 / &2` MP_TAC THENL + [REWRITE_TAC[REAL_ABS_MUL] THEN + SUBGOAL_THEN + `abs(&2 zpow (tile_k s)) = &2 zpow (tile_k s)` SUBST1_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&2 zpow (tile_k s) * (&3 / &2 * &2 zpow (--(tile_k s)))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE]; + SUBGOAL_THEN `&2 zpow (tile_k s) * (&3 / &2 * &2 zpow (--(tile_k s))) = + &3 / &2 * (&2 zpow (tile_k s) * &2 zpow (--(tile_k s)))` + SUBST1_TAC THENL + [REWRITE_TAC[REAL_MUL_AC]; ALL_TAC] THEN + REWRITE_TAC[REAL_ZPOW_NEG] THEN + ASM_SIMP_TAC[REAL_MUL_RINV; REAL_LT_IMP_NZ] THEN REAL_ARITH_TAC]; + SUBGOAL_THEN `abs(&3 / &2) = &3 / &2` SUBST1_TAC THENL + [REAL_ARITH_TAC; REAL_ARITH_TAC]]);; + +(* Same, expressed via mu K: if mu I_ups = 2 mu K (2^{-k_ups} = 2*2^a, mu K *) +(* = 2^a) and *) +(* |x - x_ups| <= (3/2) mu I_ups, then w_ups(x) >= w(3/2)/(2 mu K). *) +(* (2^{k_ups} = *) +(* 1/(2*2^a).) *) +let CWTILE_LOWER_ON_K = prove + (`!(ups:int#int#int) x a:int. + &2 zpow (--(tile_k ups)) = &2 * &2 zpow a /\ + abs(x - tile_xmid ups) <= &3 / &2 * &2 zpow (--(tile_k ups)) + ==> cw(&3 / &2) / (&2 * &2 zpow a) <= cw_tile ups x`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`ups:int#int#int`; `x:real`] CWTILE_LOWER_NEAR) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REAL_ARITH `a = b ==> b <= c ==> a <= c`) THEN + SUBGOAL_THEN `&2 zpow (tile_k ups) = inv(&2 * &2 zpow a)` SUBST1_TAC THENL + [FIRST_X_ASSUM(SUBST1_TAC o SYM o + check(fun th -> lhs(concl th) = `&2 zpow (--(tile_k ups))`)) THEN + REWRITE_TAC[REAL_ZPOW_NEG; REAL_INV_INV]; + REWRITE_TAC[real_div] THEN REAL_ARITH_TAC]);; + +(* 286L(e) step b+4 bundled: for the interpolated upsilon (k_ups = -(a+1), *) +(* tile_le sig *) +(* ups, I_sig SUBSET Ktilde* = dyho_star(a+1)(p div 2)), the weight w_ups is *) +(* >= *) +(* w(3/2)/(2*2^a) EVERYWHERE on the cover cell K = dyho a p. For x in K *) +(* SUBSET Ktilde *) +(* (DYHO_PARENT), GK_ADJACENCY_TILE (witness z in I_sig SUBSET I_ups, z in *) +(* Ktilde-star) *) +(* gives |x-x_ups| <= (3/2) mu I_ups, then CWTILE_LOWER_ON_K. *) +let GK_WEIGHT_ON_K = prove + (`!(ups:int#int#int) (sig:int#int#int) a p x. + tile_k ups = --(a + &1) /\ tile_le sig ups /\ + tile_I sig SUBSET dyho_star (a + &1) (p div &2) /\ + x IN dyho a p + ==> cw(&3 / &2) / (&2 * &2 zpow a) <= cw_tile ups x`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC CWTILE_LOWER_ON_K THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[INT_NEG_NEG] THEN + SIMP_TAC[REAL_ZPOW_ADD; REAL_ARITH `~(&2 = &0)`; REAL_ZPOW_1] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `?z:real. z IN tile_I sig` (X_CHOOSE_TAC `z:real`) THENL + [REWRITE_TAC[MEMBER_NOT_EMPTY] THEN + SPEC_TAC(`sig:int#int#int`,`sig:int#int#int`) THEN + REWRITE_TAC[FORALL_PAIR_THM; tile_I] THEN REPEAT GEN_TAC THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN MESON_TAC[DYHO_NONEMPTY]; + ALL_TAC] THEN + MP_TAC(ISPECL [`ups:int#int#int`; `a:int`; `p div &2:int`; `x:real`; + `z:real`] + GK_ADJACENCY_TILE) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN REPEAT CONJ_TAC THENL + [MP_TAC(ISPECL [`a:int`; `p:int`] DYHO_PARENT) THEN ASM SET_TAC[]; + UNDISCH_TAC `tile_le sig ups` THEN REWRITE_TAC[tile_le] THEN ASM SET_TAC[]; + ASM SET_TAC[]]);; + +(* 286L(e) steps 4+6 combined: if w_ups >= w(3/2)/(2 mu K) on a measurable *) +(* set A and *) +(* int_A w_ups <= gamma', then mu A <= 2 mu K gamma'/w(3/2). *) +(* CWTILE_LOWER_ON_K feeds *) +(* the pointwise bound; CHEBYSHEV_MEASURE (c = w(3/2)/(2 mu K)) gives the *) +(* measure. *) +let GK_INNER_MEASURE = prove + (`!A (ups:int#int#int) a:int gam. + real_measurable A /\ cw_tile ups real_integrable_on A /\ + (!x. x IN A ==> cw(&3 / &2) / (&2 * &2 zpow a) <= cw_tile ups x) /\ + real_integral A (cw_tile ups) <= gam + ==> real_measure A <= &2 * &2 zpow a * gam / cw(&3 / &2)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&0 < &2 * &2 zpow a /\ &0 < cw(&3 / &2)` STRIP_ASSUME_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC THENL + [REAL_ARITH_TAC; MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC]; + REWRITE_TAC[CW_POS]]; + ALL_TAC] THEN + MP_TAC(ISPECL [`A:real->bool`; `cw_tile ups`; + `cw(&3 / &2) / (&2 * &2 zpow a)`] + CHEBYSHEV_MEASURE) THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `&0 < cw(&3 / &2) / (&2 * &2 zpow a)` ASSUME_TAC THENL + [ASM_SIMP_TAC[REAL_LT_DIV]; ALL_TAC] THEN + DISCH_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `real_integral A (cw_tile ups) / (cw(&3 / &2) / (&2 * &2 zpow a))` + THEN + CONJ_TAC THENL + [ASM_SIMP_TAC[REAL_LE_RDIV_EQ] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_REWRITE_TAC[]; + SUBGOAL_THEN + `real_integral A (cw_tile ups) / (cw(&3 / &2) / (&2 * &2 zpow a)) = + (&2 * &2 zpow a) / cw(&3 / &2) * real_integral A (cw_tile ups)` + SUBST1_TAC THENL + [MAP_EVERY UNDISCH_TAC [`&0 < &2 * &2 zpow a`; `&0 < cw(&3 / &2)`] THEN + CONV_TAC REAL_FIELD; ALL_TAC] THEN + SUBGOAL_THEN `&2 * &2 zpow a * gam / cw(&3 / &2) = + (&2 * &2 zpow a) / cw(&3 / &2) * gam` SUBST1_TAC THENL + [CONV_TAC REAL_FIELD; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_DIV THEN ASM_SIMP_TAC[REAL_LT_IMP_LE]; + ASM_REWRITE_TAC[]]]);; + +(* --- 286L(c-ii) alpha0 OUTER skeleton --- *) +(* Fremlin's alpha0 = sum_{K coarse} sum_{sigma: muI<=muK} |alpha_sK|. The *) +(* OUTER *) +(* layer: given a per-cover-cell bound g(K) <= D mu(K) (from the inner *) +(* geometric *) +(* scale-sum, D = 2 C1 energy mass), the total over coarse cover cells is *) +(* bounded *) +(* D * 14 mu I_tau via CELL_SUM_BOUND_ABSTRACT + the a-ii *) +(* KCOVER_COARSE_MEASURE_ *) +(* BOUND. (The inner g(K) <= D mu(K) is the per-cell geometric layer, wired *) +(* later.) *) +let ALPHA_CELL_GEOM_SUM = prove + (`!A:(int#int#int)->bool g a C. + FINITE A /\ &0 <= C /\ + (!s. s IN A ==> --a <= tile_k s) /\ + (!k. sum {s | s IN A /\ tile_k s = k} g <= C * inv(&2 zpow k)) + ==> sum A g <= (&2 * C) * real_measure(dyho a p)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[DYHO_MEASURE] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&2 * C * inv(&2 zpow (--a))` THEN CONJ_TAC THENL + [MATCH_MP_TAC ABSTRACT_SCALE_GEOM_SUM THEN ASM_REWRITE_TAC[] THEN + EXISTS_TAC `tile_k:int#int#int->int` THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_ZPOW_NEG; REAL_INV_INV] THEN REAL_ARITH_TAC]);; + +let SCHWARTZ_BOUND_POS = prove + (`!(g:real->complex) k B. (!x. abs x pow k * norm(g x) <= B) ==> &0 <= B`, + REPEAT STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `&1`) THEN + MP_TAC(ISPEC `(g:real->complex) (&1)` NORM_POS_LE) THEN + REWRITE_TAC[REAL_ABS_NUM; REAL_POW_ONE; REAL_MUL_LID] THEN REAL_ARITH_TAC);; + +(* A Schwartz function's amplitude is dominated by C * (cw)^2 (= *) +(* C/(1+|u|)^6): *) +(* from the k=0..6 decay bounds, (1+|u|)^6 |h(u)| <= sum C(6,j) B_j. This is *) +(* the *) +(* SQUARED-weight bound of Fremlin 286E(c) (|phi(x)| <= C1 w(x)^2, the *) +(* second *) +(* entry of the min); needed for the 286L(c-i) kernel estimate, where one *) +(* factor *) +(* of w_sigma is pulled out as sup_K w_sigma and the other integrated *) +(* against the *) +(* mass. Same shape as SCHWARTZ_CW_DOMINATION but degree 6. *) +let SCHWARTZ_CW_SQ_DOMINATION = prove + (`!h:real->complex. schwartz h ==> ?C. &0 <= C /\ !u. norm(h u) <= C * (cw u) + pow 2`, + GEN_TAC THEN REWRITE_TAC[schwartz] THEN + DISCH_THEN(X_CHOOSE_THEN `d:num->real->complex` STRIP_ASSUME_TAC) THEN + FIRST_ASSUM(X_CHOOSE_TAC `B0:real` o SPECL [`0`; `0`]) THEN + FIRST_ASSUM(X_CHOOSE_TAC `B1:real` o SPECL [`1`; `0`]) THEN + FIRST_ASSUM(X_CHOOSE_TAC `B2:real` o SPECL [`2`; `0`]) THEN + FIRST_ASSUM(X_CHOOSE_TAC `B3:real` o SPECL [`3`; `0`]) THEN + FIRST_ASSUM(X_CHOOSE_TAC `B4:real` o SPECL [`4`; `0`]) THEN + FIRST_ASSUM(X_CHOOSE_TAC `B5:real` o SPECL [`5`; `0`]) THEN + FIRST_ASSUM(X_CHOOSE_TAC `B6:real` o SPECL [`6`; `0`]) THEN + SUBGOAL_THEN + `&0 <= B0 /\ &0 <= B1 /\ &0 <= B2 /\ &0 <= B3 /\ &0 <= B4 /\ &0 <= B5 /\ &0 + <= B6` + STRIP_ASSUME_TAC THENL + [REPEAT CONJ_TAC THEN MATCH_MP_TAC SCHWARTZ_BOUND_POS THEN + ASM_MESON_TAC[]; ALL_TAC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[ASSUME `(d:num->real->complex) 0 = h`]) THEN + EXISTS_TAC `B0 + &6 * B1 + &15 * B2 + &20 * B3 + &15 * B4 + &6 * B5 + B6` + THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + X_GEN_TAC `u:real` THEN REWRITE_TAC[cw] THEN + SUBGOAL_THEN `&0 < (&1 + abs u) pow 3` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_POW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `(&1 / (&1 + abs u) pow 3) pow 2 = + &1 / (&1 + abs u) pow 6` SUBST1_TAC THENL + [REWRITE_TAC[REAL_POW_DIV; REAL_POW_ONE; GSYM REAL_POW_POW] THEN + REWRITE_TAC[ARITH_RULE `6 = 3 * 2`; REAL_POW_POW]; ALL_TAC] THEN + SUBGOAL_THEN `&0 < (&1 + abs u) pow 6` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_POW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_ARITH `x * &1 / y = x / y`] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `u:real` o + check (fun th -> concl th = `!x. abs x pow 6 * norm((h:real->complex) x) <= + B6`)) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `u:real` o + check (fun th -> concl th = `!x. abs x pow 5 * norm((h:real->complex) x) <= + B5`)) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `u:real` o + check (fun th -> concl th = `!x. abs x pow 4 * norm((h:real->complex) x) <= + B4`)) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `u:real` o + check (fun th -> concl th = `!x. abs x pow 3 * norm((h:real->complex) x) <= + B3`)) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `u:real` o + check (fun th -> concl th = `!x. abs x pow 2 * norm((h:real->complex) x) <= + B2`)) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `u:real` o + check (fun th -> concl th = `!x. abs x pow 1 * norm((h:real->complex) x) <= + B1`)) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `u:real` o + check (fun th -> concl th = `!x. abs x pow 0 * norm((h:real->complex) x) <= + B0`)) THEN + REWRITE_TAC[real_pow; REAL_MUL_LID; REAL_POW_1] THEN + SUBGOAL_THEN `(&1 + abs u) pow 6 = + &1 + &6 * abs u + &15 * abs u pow 2 + &20 * abs u pow 3 + + &15 * abs u pow 4 + &6 * abs u pow 5 + abs u pow 6` SUBST1_TAC THENL + [REWRITE_TAC[REAL_POW_2] THEN CONV_TAC REAL_RING; ALL_TAC] THEN + MP_TAC(ISPEC `(h:real->complex) u` NORM_POS_LE) THEN + REWRITE_TAC[REAL_POW_2] THEN REAL_ARITH_TAC);; + +(* A Schwartz function's AMPLITUDE is dominated by C cw: from the k=0,1,2,3 *) +(* decay bounds, (1+|u|)^3 |h(u)| <= B0 + 3B1 + 3B2 + B3. *) +let SCHWARTZ_CW_DOMINATION = prove + (`!h:real->complex. schwartz h ==> ?C. &0 <= C /\ !u. norm(h u) <= C * cw u`, + GEN_TAC THEN REWRITE_TAC[schwartz] THEN + DISCH_THEN(X_CHOOSE_THEN `d:num->real->complex` STRIP_ASSUME_TAC) THEN + FIRST_ASSUM(X_CHOOSE_TAC `B0:real` o SPECL [`0`; `0`]) THEN + FIRST_ASSUM(X_CHOOSE_TAC `B1:real` o SPECL [`1`; `0`]) THEN + FIRST_ASSUM(X_CHOOSE_TAC `B2:real` o SPECL [`2`; `0`]) THEN + FIRST_ASSUM(X_CHOOSE_TAC `B3:real` o SPECL [`3`; `0`]) THEN + SUBGOAL_THEN + `&0 <= B0 /\ &0 <= B1 /\ &0 <= B2 /\ &0 <= B3` STRIP_ASSUME_TAC THENL + [REPEAT CONJ_TAC THEN MATCH_MP_TAC SCHWARTZ_BOUND_POS THEN + ASM_MESON_TAC[]; ALL_TAC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[ASSUME `(d:num->real->complex) 0 = h`]) THEN + EXISTS_TAC `B0 + &3 * B1 + &3 * B2 + B3` THEN CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + X_GEN_TAC `u:real` THEN REWRITE_TAC[cw] THEN + SUBGOAL_THEN `&0 < (&1 + abs u) pow 3` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_POW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_ARITH `x * &1 / y = x / y`] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `u:real` o + check (fun th -> concl th = `!x. abs x pow 3 * norm((h:real->complex) x) <= + B3`)) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `u:real` o + check (fun th -> concl th = `!x. abs x pow 2 * norm((h:real->complex) x) <= + B2`)) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `u:real` o + check (fun th -> concl th = `!x. abs x pow 1 * norm((h:real->complex) x) <= + B1`)) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `u:real` o + check (fun th -> concl th = `!x. abs x pow 0 * norm((h:real->complex) x) <= + B0`)) THEN + REWRITE_TAC[real_pow; REAL_MUL_LID; REAL_POW_1] THEN + SUBGOAL_THEN `(&1 + abs u) pow 3 = + &1 + &3 * abs u + &3 * abs u * abs u + abs u * abs u * abs u` SUBST1_TAC + THENL + [REWRITE_TAC[REAL_POW_2] THEN REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPEC `(h:real->complex) u` NORM_POS_LE) THEN + REWRITE_TAC[REAL_POW_2] THEN REAL_ARITH_TAC);; + +(* Concrete base test function: |carleson_phi u| <= C1 cw u. *) +let CARLESON_PHI_CW = prove + (`?C1. &0 <= C1 /\ !u. norm(carleson_phi u) <= C1 * cw u`, + MATCH_MP_TAC SCHWARTZ_CW_DOMINATION THEN + REWRITE_TAC[CARLESON_PHI_SCHWARTZ]);; + +(* M6 tent-domination (Fremlin 286Ge): |carleson_phi u| <= C1 cw1 u. On *) +(* [-3,3] cw1 = cw(3) (const) and phi is bounded (SCHWARTZ_BOUNDED), so take *) +(* C1 large; off [-3,3] cw1 = cw and CARLESON_PHI_CW applies. Constant *) +(* Ca + B/cw(3). Feeds the (h)(vi) kernel domination gg = cw1(3 2^m .). *) +let CARLESON_PHI_CW1 = prove + (`?C1. &0 <= C1 /\ !u. norm(carleson_phi u) <= C1 * cw1 u`, + MP_TAC CARLESON_PHI_CW THEN + DISCH_THEN(X_CHOOSE_THEN `Ca:real` STRIP_ASSUME_TAC) THEN + MP_TAC(MATCH_MP SCHWARTZ_BOUNDED CARLESON_PHI_SCHWARTZ) THEN + DISCH_THEN(X_CHOOSE_TAC `B:real`) THEN + EXISTS_TAC `Ca + B / cw(&3)` THEN + SUBGOAL_THEN `&0 < cw(&3)` ASSUME_TAC THENL + [REWRITE_TAC[CW_POS]; ALL_TAC] THEN + SUBGOAL_THEN `&0 <= B` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `norm(carleson_phi(&0))` THEN + ASM_REWRITE_TAC[NORM_POS_LE]; ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_ADD THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_DIV THEN ASM_SIMP_TAC[REAL_LT_IMP_LE]; ALL_TAC] THEN + X_GEN_TAC `u:real` THEN + ASM_CASES_TAC `abs u <= &3` THENL + [SUBGOAL_THEN `cw1 u = cw(&3)` SUBST1_TAC THENL + [REWRITE_TAC[cw1] THEN + MATCH_MP_TAC(REAL_ARITH `a <= b ==> min a b = a`) THEN + MATCH_MP_TAC CW_ANTITONE THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `B:real` THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[REAL_ADD_RDISTRIB] THEN + ASM_SIMP_TAC[REAL_DIV_RMUL; REAL_LT_IMP_NZ] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= a ==> B <= a + B`) THEN + MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE]; + SUBGOAL_THEN `cw1 u = cw u` SUBST1_TAC THENL + [REWRITE_TAC[cw1] THEN + MATCH_MP_TAC(REAL_ARITH `b <= a ==> min a b = b`) THEN + MATCH_MP_TAC CW_ANTITONE THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `Ca * cw u` THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[CW_POS; REAL_LT_IMP_LE] THEN + CONJ_TAC THENL + [MATCH_MP_TAC(REAL_ARITH `&0 <= b ==> Ca <= Ca + b`) THEN + MATCH_MP_TAC REAL_LE_DIV THEN ASM_SIMP_TAC[REAL_LT_IMP_LE]; + MP_TAC(SPEC `u:real` CW_POS) THEN REAL_ARITH_TAC]]);; + +(* SQUARED-weight base bound: |carleson_phi u| <= C1 (cw u)^2 (= *) +(* C1/(1+|u|)^6). *) +(* Fremlin 286E(c) second min-entry. Feeds the 286L(c-i) kernel estimate. *) +let CARLESON_PHI_CW_SQ = prove + (`?C1. &0 <= C1 /\ !u. norm(carleson_phi u) <= C1 * (cw u) pow 2`, + MATCH_MP_TAC SCHWARTZ_CW_SQ_DOMINATION THEN + REWRITE_TAC[CARLESON_PHI_SCHWARTZ]);; + +(* Amplitude scaling of phi_sigma: |phi_sigma s phi x| = *) +(* 2^(k/2)|phi(2^k(x-x_s))|. *) +let PHISIG_NORM_PW = prove + (`!(s:int#int#int) (phi:real->complex) x. + norm(phi_sigma s phi x) = + sqrt(&2 zpow (tile_k s)) * norm(phi(&2 zpow (tile_k s) * (x - tile_xmid + s)))`, + REPEAT GEN_TAC THEN REWRITE_TAC[phi_sigma; phimst] THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX] THEN + SUBGOAL_THEN `norm(cexp(ii * Cx(tile_ymid s) * Cx x)) = &1` SUBST1_TAC THENL + [REWRITE_TAC[GSYM CX_MUL; NORM_CEXP_II]; ALL_TAC] THEN + SUBGOAL_THEN + `abs(sqrt(&2 zpow (tile_k s))) = sqrt(&2 zpow (tile_k s))` SUBST1_TAC THENL + [REWRITE_TAC[REAL_ABS_REFL] THEN MATCH_MP_TAC SQRT_POS_LE THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN MATCH_MP_TAC REAL_ZPOW_LT THEN + REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_MUL_LID]);; + +(* 286E(c-iii), tile form: |phi_sigma s carleson_phi x| <= C1 2^(-k/2) *) +(* w_sigma(x). *) +let PHISIG_CW = prove + (`?C1. &0 <= C1 /\ !(s:int#int#int) x. + norm(phi_sigma s carleson_phi x) <= C1 * inv(sqrt(&2 zpow (tile_k s))) * + cw_tile s x`, + MP_TAC CARLESON_PHI_CW THEN + DISCH_THEN(X_CHOOSE_THEN `C1:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `C1:real` THEN ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC [`s:int#int#int`; `x:real`] THEN + REWRITE_TAC[PHISIG_NORM_PW; cw_tile] THEN + SUBGOAL_THEN `&0 < &2 zpow (tile_k s)` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `C1 * inv(sqrt(&2 zpow (tile_k s))) * &2 zpow (tile_k s) * + cw (&2 zpow (tile_k s) * (x - tile_xmid s)) = + sqrt(&2 zpow (tile_k s)) * (C1 * cw(&2 zpow (tile_k s) * (x - tile_xmid + s)))` + SUBST1_TAC THENL + [SUBGOAL_THEN `inv(sqrt(&2 zpow (tile_k s))) * &2 zpow (tile_k s) = + sqrt(&2 zpow (tile_k s))` MP_TAC THENL + [REWRITE_TAC[REAL_ARITH `!s t:real. inv s * t = t / s`] THEN + MATCH_MP_TAC REAL_DIV_SQRT THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE]; ALL_TAC] THEN + CONV_TAC REAL_RING; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC SQRT_POS_LE THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE]; ASM_REWRITE_TAC[]]);; + +(* 286E(c-iii), tile form, SQUARED entry: |phi_sigma s carleson_phi x| <= *) +(* C1 2^(-3k/2) w_sigma(x)^2. From CARLESON_PHI_CW_SQ (base squared bound) *) +(* via *) +(* PHISIG_NORM_PW: norm(phi_s x) = sqrt(2^k) norm(carleson_phi(2^k(x-x_s))) *) +(* <= *) +(* sqrt(2^k) C1 (cw(2^k(x-x_s)))^2; and cw_tile s x = 2^k cw(2^k(x-x_s)) so *) +(* (cw_tile)^2 = 2^{2k}(cw..)^2, giving sqrt(2^k) = inv(sqrt(2^k))^3 2^{2k}, *) +(* i.e. *) +(* the 2^{-3k/2} coefficient. The (c-i) kernel estimate's entry point. *) +let PHISIG_CW_SQ = prove + (`?C1. &0 <= C1 /\ !(s:int#int#int) x. + norm(phi_sigma s carleson_phi x) <= + C1 * inv(sqrt(&2 zpow (tile_k s))) pow 3 * (cw_tile s x) pow 2`, + MP_TAC CARLESON_PHI_CW_SQ THEN + DISCH_THEN(X_CHOOSE_THEN `C1:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `C1:real` THEN ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC [`s:int#int#int`; `x:real`] THEN + REWRITE_TAC[PHISIG_NORM_PW; cw_tile] THEN + SUBGOAL_THEN `&0 < &2 zpow (tile_k s)` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + ABBREV_TAC `p = &2 zpow (tile_k s)` THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sqrt(p) * (C1 * (cw (p * (x - tile_xmid s))) pow 2)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[SQRT_POS_LE; REAL_LT_IMP_LE]; + ALL_TAC] THEN + ABBREV_TAC `cu = cw (p * (x - tile_xmid s))` THEN + MATCH_MP_TAC REAL_EQ_IMP_LE THEN + SUBGOAL_THEN `&0 < sqrt p /\ sqrt p pow 2 = p` STRIP_ASSUME_TAC THENL + [ASM_SIMP_TAC[SQRT_POS_LT; SQRT_POW_2; REAL_LT_IMP_LE]; ALL_TAC] THEN + REWRITE_TAC[REAL_POW_MUL] THEN + MATCH_MP_TAC(REAL_FIELD + `&0 < r /\ r pow 2 = p + ==> r * (C1 * cu pow 2) = C1 * inv(r) pow 3 * (p pow 2 * cu pow 2)`) THEN + ASM_REWRITE_TAC[]);; + +(* 286L(f-iii) per-tile bound: |(f|phi_sigma) phi_sigma(x)| <= C1 energy mu *) +(* I_sigma *) +(* w_sigma(x) for sigma in P. Combines ENERGY_IP_BOUND (|(f|phi_s)| <= *) +(* inv(sqrt 2^k) *) +(* energy) and PHISIG_CW (|phi_s(x)| <= C1 inv(sqrt 2^k) w_s(x)) by *) +(* REAL_LE_MUL2; the *) +(* two inv(sqrt 2^k) factors multiply to inv(2^k) = mu I_sigma. This is the *) +(* summand of *) +(* v2, whose scale-k slice sums (via 286Gd) to <= 2 C1 energy. *) +let IP_PHI_BOUND = prove + (`?C1. &0 <= C1 /\ !(f:real->complex) (P:(int#int#int)->bool) sigma x. + FINITE P /\ sigma IN P + ==> norm(carleson_ip f sigma * phi_sigma sigma carleson_phi x) + <= C1 * energy_f f P * inv(&2 zpow (tile_k sigma)) * cw_tile sigma x`, + X_CHOOSE_THEN + `C1:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "PB")) PHISIG_CW THEN + EXISTS_TAC `C1:real` THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[COMPLEX_NORM_MUL] THEN + SUBGOAL_THEN `&0 < &2 zpow (tile_k sigma)` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `&0 < sqrt(&2 zpow (tile_k sigma))` ASSUME_TAC THENL + [MATCH_MP_TAC SQRT_POS_LT THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(energy_f (f:real->complex) P * inv(sqrt(&2 zpow (tile_k + sigma)))) * + (C1 * inv(sqrt(&2 zpow (tile_k sigma))) * cw_tile sigma x)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[NORM_POS_LE] THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[GSYM real_div] THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + MP_TAC(ISPECL [`f:real->complex`; `P:(int#int#int)->bool`; + `sigma:int#int#int`] + ENERGY_IP_BOUND) THEN ASM_REWRITE_TAC[]; + ASM_SIMP_TAC[]]; + SUBGOAL_THEN + `(energy_f (f:real->complex) P * inv(sqrt(&2 zpow (tile_k sigma)))) * + (C1 * inv(sqrt(&2 zpow (tile_k sigma))) * cw_tile sigma x) = + C1 * energy_f f P * (inv(sqrt(&2 zpow (tile_k sigma))) * inv(sqrt(&2 zpow + (tile_k sigma)))) * + cw_tile sigma x` SUBST1_TAC THENL + [REWRITE_TAC[REAL_MUL_AC]; ALL_TAC] THEN + SUBGOAL_THEN + `inv(sqrt(&2 zpow (tile_k sigma))) * inv(sqrt(&2 zpow (tile_k sigma))) = + inv(&2 zpow (tile_k sigma))` SUBST1_TAC THENL + [REWRITE_TAC[GSYM REAL_INV_MUL] THEN AP_TERM_TAC THEN + REWRITE_TAC[GSYM REAL_POW_2] THEN MATCH_MP_TAC SQRT_POW_2 THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE]; + REWRITE_TAC[REAL_LE_REFL]]]);; + +(* The scale-collapse identity: inv(2^{k_s}) w_s(x) = cw(2^{k_s} x - (nI_s + *) +(* 1/2)). *) +(* (cw_tile s x = 2^{k_s} cw(2^{k_s}(x-x_s)), x_s = (nI_s+1/2) 2^{-k_s}.) *) +(* This puts the *) +(* v2 summand onto the half-integer grid so 286Gd (CW_INTEGER_SHIFT_SUM) *) +(* applies. *) +let CW_TILE_SHIFT_ID = prove + (`!(k:int) nI nJ x. + inv(&2 zpow k) * cw_tile (k,nI,nJ) x = cw(&2 zpow k * x - (real_of_int nI + + &1 / &2))`, + REPEAT GEN_TAC THEN REWRITE_TAC[cw_tile; tile_k; tile_xmid; dyho_mid] THEN + SUBGOAL_THEN `&0 < &2 zpow k` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN + SUBGOAL_THEN `inv(&2 zpow k) * &2 zpow k = &1` SUBST1_TAC THENL + [MATCH_MP_TAC REAL_MUL_LINV THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_MUL_LID] THEN AP_TERM_TAC THEN + REWRITE_TAC[REAL_ZPOW_NEG] THEN + MP_TAC(ASSUME `&0 < &2 zpow k`) THEN CONV_TAC REAL_FIELD);; + +(* 286L(f-iii): v2's scale-k slice bound. For a finite tile set A (all *) +(* tile_k = k, and *) +(* distinct I-indices FST(SND .) -- 286L(a-i): same-scale tiles of P have *) +(* distinct *) +(* centres) contained in P, sum_{s in A} |(f|phi_s) phi_s(x)| <= 2 C1 *) +(* energy_f f P. *) +(* Termwise IP_PHI_BOUND (C1 energy inv(2^k) w_s), then sum inv(2^k) w_s = *) +(* sum cw(2^k x - *) +(* (nI_s+1/2)) (CW_TILE_SHIFT_ID), reindexed over the distinct I-indices to *) +(* CW_INTEGER_ *) +(* SHIFT_SUM <= 2. This bounds Fremlin's v2 pointwise (the single collapsed *) +(* scale k). *) +let V2_SLICE_BOUND = prove + (`?C1. &0 <= C1 /\ !(f:real->complex) (P:(int#int#int)->bool) + (A:(int#int#int)->bool) k x. + FINITE P /\ FINITE A /\ A SUBSET P /\ + (!s. s IN A ==> tile_k s = k) /\ + (!s t. s IN A /\ t IN A /\ FST(SND s) = FST(SND t) ==> s = t) + ==> sum A (\s. norm(carleson_ip f s * phi_sigma s carleson_phi x)) <= &2 * + C1 * energy_f f P`, + X_CHOOSE_THEN + `C1:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "IPB")) IP_PHI_BOUND THEN + EXISTS_TAC `C1:real` THEN ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC + [`f:real->complex`; `P:(int#int#int)->bool`; `A:(int#int#int)->bool`; + `k:int`; `x:real`] THEN + STRIP_TAC THEN + SUBGOAL_THEN `&0 <= energy_f (f:real->complex) P` ASSUME_TAC THENL + [ASM_SIMP_TAC[ENERGY_F_POS]; ALL_TAC] THEN + SUBGOAL_THEN + `sum A (\s. inv(&2 zpow k) * cw_tile s x) <= &2` ASSUME_TAC THENL + [SUBGOAL_THEN + `sum A (\s. inv(&2 zpow k) * cw_tile s x) = + sum (IMAGE (\s:int#int#int. FST(SND s)) A) + (\n. cw((&2 zpow k * x - &1 / &2) - real_of_int n))` + SUBST1_TAC THENL + [SUBGOAL_THEN + `sum A (\s. inv(&2 zpow k) * cw_tile s x) = + sum A (\s. cw(&2 zpow k * x - (real_of_int(FST(SND s)) + &1 / &2)))` + SUBST1_TAC THENL + [MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `s:int#int#int` THEN DISCH_TAC THEN + REWRITE_TAC[] THEN + SUBGOAL_THEN `k = tile_k (s:int#int#int)` SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN ASM_SIMP_TAC[]; ALL_TAC] THEN + SPEC_TAC(`s:int#int#int`,`s:int#int#int`) THEN + REWRITE_TAC[FORALL_PAIR_THM] THEN + REWRITE_TAC[tile_k; CW_TILE_SHIFT_ID]; + ALL_TAC] THEN + CONV_TAC SYM_CONV THEN + MP_TAC(ISPECL [`\s:int#int#int. FST(SND s)`; + `\n:int. cw((&2 zpow k * x - &1 / &2) - real_of_int n)`; + `A:(int#int#int)->bool`] SUM_IMAGE) THEN + ANTS_TAC THENL + [REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[]; + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[o_DEF] THEN + MATCH_MP_TAC SUM_EQ THEN REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN + AP_TERM_TAC THEN REAL_ARITH_TAC]; + MATCH_MP_TAC CW_INTEGER_SHIFT_SUM THEN + MATCH_MP_TAC FINITE_IMAGE THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum A (\s. (C1 * energy_f (f:real->complex) P) * (inv(&2 zpow k) + * cw_tile s x))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `s:int#int#int` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + SUBGOAL_THEN + `(C1 * energy_f (f:real->complex) P) * (inv(&2 zpow k) * cw_tile s x) = + C1 * energy_f f P * inv(&2 zpow k) * cw_tile s x` SUBST1_TAC + THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `k = tile_k (s:int#int#int)` SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN ASM_SIMP_TAC[]; ALL_TAC] THEN + USE_THEN "IPB" (MP_TAC o SPECL + [`f:real->complex`; `P:(int#int#int)->bool`; `s:int#int#int`; + `x:real`]) THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[SUM_LMUL] THEN + SUBGOAL_THEN + `&2 * C1 * energy_f (f:real->complex) P = (C1 * energy_f f P) * &2` + SUBST1_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[]; + GEN_REWRITE_TAC LAND_CONV [GSYM SUM_LMUL] THEN ASM_REWRITE_TAC[]]);; + +(* 286L(c-i) SINGLE-PAIR KERNEL ESTIMATE (the mass half). On a set S *) +(* contained *) +(* in E cap h^-1[J_sigma], with the tile weight bounded by Mw >= 0 there, *) +(* the *) +(* integral of |phi_sigma| is <= C1 2^{-3k/2} Mw mass_Eh(P). Chains the four *) +(* base *) +(* bricks: PHISIG_CW_SQ (|phi_s| <= C1 2^{-3k/2} w_s^2, pointwise, so *) +(* int|phi_s| *) +(* <= C1 2^{-3k/2} int w_s^2), CWTILE_SQ_INT_LE (int_S w_s^2 <= Mw int_S *) +(* w_s), *) +(* REAL_INTEGRAL_SUBSET_LE (int_S w_s <= int_{E cap h^-1[J_s]} w_s, since S *) +(* is a *) +(* subset and w_s > 0), MASS_TERM_LE (that <= mass_Eh). Mw becomes sup_K *) +(* w_sigma *) +(* = 2^{k} w(2^{k} rho(x_s,K)) at the alpha0/alpha1 call site (the geometry *) +(* step). *) +let CARLESON_KERNEL_CI = prove + (`?C1. &0 <= C1 /\ !(sigma:int#int#int) S E h (P:(int#int#int)->bool) Mw. + sigma IN P /\ &0 <= Mw /\ + S SUBSET {x | x IN E /\ h x IN tile_J sigma} /\ + (!x. x IN S ==> cw_tile sigma x <= Mw) /\ + (\x. norm(phi_sigma sigma carleson_phi x)) real_integrable_on S /\ + (\x. (cw_tile sigma x) pow 2) real_integrable_on S /\ + cw_tile sigma real_integrable_on S /\ + (!t. cw_tile t real_integrable_on {x | x IN E /\ h x IN tile_J t}) + ==> real_integral S (\x. norm(phi_sigma sigma carleson_phi x)) + <= C1 * inv(sqrt(&2 zpow (tile_k sigma))) pow 3 * Mw * mass_Eh E h P`, + MP_TAC PHISIG_CW_SQ THEN + DISCH_THEN(X_CHOOSE_THEN `C1:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `C1:real` THEN ASM_REWRITE_TAC[] THEN + REPEAT STRIP_TAC THEN + ABBREV_TAC `cc = C1 * inv(sqrt(&2 zpow (tile_k (sigma:int#int#int)))) pow 3` + THEN + SUBGOAL_THEN `&0 <= cc` ASSUME_TAC THENL + [EXPAND_TAC "cc" THEN MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_POW_LE THEN REWRITE_TAC[REAL_LE_INV_EQ] THEN + MATCH_MP_TAC SQRT_POS_LE THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN + MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `C1 * inv(sqrt(&2 zpow (tile_k (sigma:int#int#int)))) pow 3 * Mw * mass_Eh + E h P = + cc * (Mw * mass_Eh E h P)` + SUBST1_TAC THENL [EXPAND_TAC "cc" THEN REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `cc * real_integral S (\x. (cw_tile (sigma:int#int#int) x) pow 2)` + THEN + CONJ_TAC THENL + [SUBGOAL_THEN + `cc * real_integral S (\x. (cw_tile (sigma:int#int#int) x) pow 2) = + real_integral S (\x. cc * (cw_tile sigma x) pow 2)` + SUBST1_TAC THENL + [MATCH_MP_TAC(GSYM REAL_INTEGRAL_LMUL) THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC REAL_INTEGRAL_LE THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_LMUL THEN ASM_REWRITE_TAC[]; + X_GEN_TAC `x:real` THEN DISCH_TAC THEN EXPAND_TAC "cc" THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `Mw * real_integral S (cw_tile (sigma:int#int#int))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC CWTILE_SQ_INT_LE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `real_integral {x | x IN E /\ h x IN tile_J (sigma:int#int#int)} + (cw_tile sigma)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_SUBSET_LE THEN ASM_REWRITE_TAC[] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN + REWRITE_TAC[CW_TILE_POS]; + MATCH_MP_TAC MASS_TERM_LE THEN ASM_REWRITE_TAC[]]);; + +(* 286L(c-i) kernel estimate in the DISTANCE form. Instantiating CARLESON_ *) +(* KERNEL_CI's abstract Mw with the geometric bound Mw = 2^{k} cw(2^{k} rho) *) +(* (CWTILE_DIST_BOUND, valid when every x in S is at distance >= rho from *) +(* x_sigma) *) +(* and simplifying inv(sqrt(2^k))^3 * 2^k = inv(sqrt(2^k)) gives Fremlin's *) +(* exact *) +(* factor 2 of (c-i): int_S |phi_sigma| <= C1 2^{-k/2} w(2^{k} rho) *) +(* mass_Eh(P). *) +let CARLESON_KERNEL_RHO = prove + (`?C1. &0 <= C1 /\ !(sigma:int#int#int) S E h (P:(int#int#int)->bool) rho. + sigma IN P /\ &0 <= rho /\ + S SUBSET {x | x IN E /\ h x IN tile_J sigma} /\ + (!x. x IN S ==> rho <= abs(x - tile_xmid sigma)) /\ + (\x. norm(phi_sigma sigma carleson_phi x)) real_integrable_on S /\ + (\x. (cw_tile sigma x) pow 2) real_integrable_on S /\ + cw_tile sigma real_integrable_on S /\ + (!t. cw_tile t real_integrable_on {x | x IN E /\ h x IN tile_J t}) + ==> real_integral S (\x. norm(phi_sigma sigma carleson_phi x)) + <= C1 * inv(sqrt(&2 zpow (tile_k sigma))) * + cw(&2 zpow (tile_k sigma) * rho) * mass_Eh E h P`, + MP_TAC CARLESON_KERNEL_CI THEN + DISCH_THEN(X_CHOOSE_THEN `C1:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `C1:real` THEN ASM_REWRITE_TAC[] THEN + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&0 < &2 zpow (tile_k (sigma:int#int#int))` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `C1 * inv(sqrt(&2 zpow (tile_k (sigma:int#int#int)))) pow 3 * + (&2 zpow (tile_k sigma) * cw(&2 zpow (tile_k sigma) * rho)) * + mass_Eh E h P` THEN + CONJ_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN + REWRITE_TAC[CW_POS]; + X_GEN_TAC `x:real` THEN DISCH_TAC THEN + MATCH_MP_TAC CWTILE_DIST_BOUND THEN ASM_SIMP_TAC[]]; + MATCH_MP_TAC REAL_EQ_IMP_LE THEN + SUBGOAL_THEN + `sqrt(&2 zpow (tile_k (sigma:int#int#int))) pow 2 = + &2 zpow (tile_k sigma) /\ + &0 < sqrt(&2 zpow (tile_k sigma))` STRIP_ASSUME_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC SQRT_POW_2 THEN ASM_SIMP_TAC[REAL_LT_IMP_LE]; + MATCH_MP_TAC SQRT_POS_LT THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN + MATCH_MP_TAC(REAL_FIELD + `&0 < r /\ r pow 2 = p + ==> C1 * inv(r) pow 3 * (p * c) * m = C1 * inv(r) * c * m`) THEN + ASM_REWRITE_TAC[]]);; + +(* 286L(c-i) bridge: the norm of the LOCALIZED complex integral of phi_sigma *) +(* over *) +(* a set S is <= the real integral of |phi_sigma| there. Connects the *) +(* lproduct- *) +(* style vector integral (integral (IMAGE lift S) (\z. phi_sigma .. (drop *) +(* z))) -- *) +(* which is how the alpha_{sigma K} term int_{E cap h^-1[J_s^r] cap K} *) +(* phi_sigma *) +(* appears -- to the real_integral that CARLESON_KERNEL_RHO bounds. Via the *) +(* library ABSOLUTELY_INTEGRABLE_LE (norm(int f) <= drop(int |f|)) + *) +(* REAL_INTEGRAL. *) +let NORM_PHISIG_LOCAL_LE = prove + (`!(sigma:int#int#int) S. + (\x. norm(phi_sigma sigma carleson_phi x)) real_integrable_on S /\ + (\z. phi_sigma sigma carleson_phi (drop z)) absolutely_integrable_on + (IMAGE lift S) + ==> norm(integral (IMAGE lift S) (\z. phi_sigma sigma carleson_phi (drop + z))) + <= real_integral S (\x. norm(phi_sigma sigma carleson_phi x))`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP REAL_INTEGRAL) THEN + DISCH_THEN(fun th -> GEN_REWRITE_TAC RAND_CONV [th]) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `drop(integral (IMAGE lift S) + (\z. lift(norm(phi_sigma sigma carleson_phi (drop z)))))` THEN + CONJ_TAC THENL + [FIRST_ASSUM(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_LE) THEN + REWRITE_TAC[]; + MATCH_MP_TAC REAL_EQ_IMP_LE THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[o_DEF]]);; + +(* 286L(c-i) SINGLE-PAIR ESTIMATE (Fremlin's exact per-pair bound). For the *) +(* tile *) +(* localized integral alpha_{sigma K} = (f|phi_sigma) * int_{E cap *) +(* h^-1[J_s^r] *) +(* cap K} phi_sigma (here S = that localized set, so the integral is over *) +(* IMAGE *) +(* lift S), with every point of S at distance >= rho from x_sigma: *) +(* norm(alpha_{sigma K}) <= C1 2^{-k} w(2^{k} rho) energy_f(P) mass_Eh(P). *) +(* Assembles the whole (c-i) chain: COMPLEX_NORM_MUL splits the product; *) +(* COEFF_LE_ENERGY_HALF bounds the coefficient by 2^{-k/2} energy; *) +(* NORM_PHISIG_ *) +(* LOCAL_LE + CARLESON_KERNEL_RHO bound the localized integral by C1 *) +(* 2^{-k/2} *) +(* w(2^k rho) mass; REAL_LE_MUL2 multiplies, and inv(sqrt(2^k))^2 = inv(2^k) *) +(* via *) +(* REAL_FIELD gives the 2^{-k}. This is the atom the alpha0/alpha1 sums add *) +(* up. *) +let CARLESON_ALPHA_PAIR = prove + (`?C1. &0 <= C1 /\ !(f:real->complex) (sigma:int#int#int) S E h + (P:(int#int#int)->bool) rho. + FINITE P /\ sigma IN P /\ &0 <= rho /\ + S SUBSET {x | x IN E /\ h x IN tile_J sigma} /\ + (!x. x IN S ==> rho <= abs(x - tile_xmid sigma)) /\ + (\x. norm(phi_sigma sigma carleson_phi x)) real_integrable_on S /\ + (\x. (cw_tile sigma x) pow 2) real_integrable_on S /\ + cw_tile sigma real_integrable_on S /\ + (\z. phi_sigma sigma carleson_phi (drop z)) absolutely_integrable_on (IMAGE + lift S) /\ + (!t. cw_tile t real_integrable_on {x | x IN E /\ h x IN tile_J t}) + ==> norm(carleson_ip f sigma * + integral (IMAGE lift S) (\z. phi_sigma sigma carleson_phi (drop + z))) + <= C1 * inv(&2 zpow (tile_k sigma)) * cw(&2 zpow (tile_k sigma) * rho) + * + energy_f f P * mass_Eh E h P`, + MP_TAC CARLESON_KERNEL_RHO THEN + DISCH_THEN(X_CHOOSE_THEN `C1:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `C1:real` THEN ASM_REWRITE_TAC[] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[COMPLEX_NORM_MUL] THEN + SUBGOAL_THEN `&0 < &2 zpow (tile_k (sigma:int#int#int))` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `&0 < sqrt(&2 zpow (tile_k (sigma:int#int#int))) /\ + sqrt(&2 zpow (tile_k sigma)) pow 2 = &2 zpow (tile_k sigma)` + STRIP_ASSUME_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC SQRT_POS_LT THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC SQRT_POW_2 THEN ASM_SIMP_TAC[REAL_LT_IMP_LE]]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(inv(sqrt(&2 zpow (tile_k (sigma:int#int#int)))) * energy_f f P) + * + (C1 * inv(sqrt(&2 zpow (tile_k sigma))) * + cw(&2 zpow (tile_k sigma) * rho) * mass_Eh E h P)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[NORM_POS_LE] THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC COEFF_LE_ENERGY_HALF THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `real_integral S (\x. norm(phi_sigma sigma carleson_phi x))` + THEN + CONJ_TAC THENL + [MATCH_MP_TAC NORM_PHISIG_LOCAL_LE THEN ASM_REWRITE_TAC[]; + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]]; + MATCH_MP_TAC REAL_EQ_IMP_LE THEN + MATCH_MP_TAC(REAL_FIELD + `&0 < r /\ r pow 2 = p + ==> (inv(r) * g) * (C1 * inv(r) * c * m) = C1 * inv(p) * c * g * m`) THEN + ASM_REWRITE_TAC[]]);; + +(* 286L alpha0/alpha1 PER-TILE EDGE-FORM BOUND. For a scale-k tile (k,nI,nJ) *) +(* in P *) +(* whose spatial index nI lies OUTSIDE the cover cell's index-span [q, q+M) *) +(* (guard *) +(* q+M<=nI \/ nI<=q-1), and a localized set S contained in E cap *) +(* h^-1[J_sigma] AND *) +(* in the cover-cell interval [q 2^{-k}, (q+M) 2^{-k}): *) +(* norm((f|phi_sigma) int_{IMAGE lift S} phi_sigma) *) +(* <= C1 2^{-k} cw(&(nearest-edge offset) + 1/2) energy_f(P) mass_Eh(P). *) +(* Specializes CARLESON_ALPHA_PAIR at rho = (&edgeoff + 1/2) 2^{-k}: *) +(* TILE_DIST_TO_ *) +(* CELL supplies rho <= dist(x, x_sigma) for x in S; 2^k rho = &edgeoff+1/2 *) +(* folds *) +(* cw(2^k rho) = cw(&edgeoff+1/2). This is the per-tile hypothesis of *) +(* ALPHA_SCALE_ *) +(* BOUND_ABSTRACT (with f a = the alpha norm, g a = edgeoff, B = C1 2^{-k} *) +(* energy mass). *) +let CARLESON_ALPHA_EDGE = prove + (`?C1. &0 <= C1 /\ !(f:real->complex) (k:int) (nI:int) (nJ:int) S E h + (P:(int#int#int)->bool) q M. + FINITE P /\ (k,nI,nJ) IN P /\ (q + M <= nI \/ nI <= q - &1) /\ + S SUBSET {x | x IN E /\ h x IN tile_J (k,nI,nJ)} /\ + S SUBSET {x | real_of_int q * &2 zpow (--k) <= x /\ x < real_of_int (q + M) + * &2 zpow (--k)} /\ + (\x. norm(phi_sigma (k,nI,nJ) carleson_phi x)) real_integrable_on S /\ + (\x. (cw_tile (k,nI,nJ) x) pow 2) real_integrable_on S /\ + cw_tile (k,nI,nJ) real_integrable_on S /\ + (\z. phi_sigma (k,nI,nJ) carleson_phi (drop z)) absolutely_integrable_on + (IMAGE lift S) /\ + (!t. cw_tile t real_integrable_on {x | x IN E /\ h x IN tile_J t}) + ==> norm(carleson_ip f (k,nI,nJ) * + integral (IMAGE lift S) (\z. phi_sigma (k,nI,nJ) carleson_phi + (drop z))) + <= C1 * inv(&2 zpow k) * + cw(&(num_of_int(if q + M <= nI then nI - (q + M) else (q - &1) - + nI)) + &1 / &2) * + energy_f f P * mass_Eh E h P`, + MP_TAC CARLESON_ALPHA_PAIR THEN + DISCH_THEN(X_CHOOSE_THEN + `C1:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "PAIR"))) THEN + EXISTS_TAC `C1:real` THEN ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC + [`f:real->complex`;`k:int`;`nI:int`;`nJ:int`;`S:real->bool`;`E:real->bool`; + `h:real->real`;`P:(int#int#int)->bool`;`q:int`;`M:int`] THEN + DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN + ABBREV_TAC `eo = num_of_int(if q + M <= nI then nI - (q + M) else (q - &1) - + nI)` THEN + USE_THEN "PAIR" (fun th -> MP_TAC(SPECL + [`f:real->complex`; `(k,nI,nJ):int#int#int`; `S:real->bool`; + `E:real->bool`; + `h:real->real`; `P:(int#int#int)->bool`; + `(&eo + &1 / &2) * inv(&2 zpow k)`] th)) THEN + SUBGOAL_THEN `&0 < &2 zpow k` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[tile_k] THEN + SUBGOAL_THEN `&2 zpow k * (&eo + &1 / &2) * inv(&2 zpow k) = &eo + &1 / &2` + (fun th -> REWRITE_TAC[th]) THENL + [MATCH_MP_TAC(REAL_FIELD `&0 < p ==> p * (e * inv p) = e`) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [REAL_ARITH_TAC; REWRITE_TAC[REAL_LE_INV_EQ] THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE]]; + X_GEN_TAC `x:real` THEN DISCH_TAC THEN REWRITE_TAC[tile_xmid] THEN + SUBGOAL_THEN + `&0 <= (if q + M <= nI then nI - (q + M) else (q - &1) - nI):int` + ASSUME_TAC THENL + [FIRST_X_ASSUM(DISJ_CASES_TAC o check (fun th -> is_disj(concl th))) THEN + COND_CASES_TAC THEN ASM_INT_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `&eo = real_of_int(if q + M <= nI then nI - (q + M) else (q - &1) - nI)` + SUBST1_TAC THENL + [EXPAND_TAC "eo" THEN + ASM_MESON_TAC[INT_OF_NUM_OF_INT; int_of_num_th]; ALL_TAC] THEN + MP_TAC(ISPECL [`k:int`; `q:int`; `M:int`; `nI:int`; + `x:real`] TILE_DIST_TO_CELL) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `S SUBSET {x | real_of_int q * &2 zpow (--k) <= x /\ + x < real_of_int (q + M) * &2 zpow (--k)}` THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN + DISCH_THEN(MP_TAC o SPEC `x:real`) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[GSYM real_div] THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ] THEN + REAL_ARITH_TAC]);; + +(* Tile-INDEXED reformulation of CARLESON_ALPHA_EDGE: the same per-tile edge *) +(* bound stated with a single tile index s (so tile_k s appears in the *) +(* exponent *) +(* and FST(SND s) is the tile's I-index), instead of the destructured *) +(* (k,nI,nJ). *) +(* Proved by destructuring s ONCE at the top via FORALL_PAIR_THM and *) +(* applying *) +(* CARLESON_ALPHA_EDGE. This is the convenient form for summing over a tree. *) +let CARLESON_ALPHA_EDGE_TILE = prove + (`?C1. &0 <= C1 /\ + !(f:real->complex) (s:int#int#int) S E h (P:(int#int#int)->bool) q M. + FINITE P /\ s IN P /\ (q + M <= FST(SND s) \/ FST(SND s) <= q - &1) /\ + S SUBSET {x | x IN E /\ h x IN tile_J s} /\ + S SUBSET {x | real_of_int q * &2 zpow (--(tile_k s)) <= x /\ + x < real_of_int (q + M) * &2 zpow (--(tile_k s))} /\ + (\x. norm(phi_sigma s carleson_phi x)) real_integrable_on S /\ + (\x. (cw_tile s x) pow 2) real_integrable_on S /\ + cw_tile s real_integrable_on S /\ + (\z. phi_sigma s carleson_phi (drop z)) absolutely_integrable_on (IMAGE + lift S) /\ + (!t. cw_tile t real_integrable_on {x | x IN E /\ h x IN tile_J t}) + ==> norm(carleson_ip f s * + integral (IMAGE lift S) (\z. phi_sigma s carleson_phi (drop z))) + <= C1 * inv(&2 zpow (tile_k s)) * + cw(&(num_of_int(if q + M <= FST(SND s) then FST(SND s) - (q + M) + else (q - &1) - FST(SND s))) + &1 / &2) * + energy_f f P * mass_Eh E h P`, + X_CHOOSE_THEN `C1:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "EDGE")) + CARLESON_ALPHA_EDGE THEN + EXISTS_TAC `C1:real` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[FORALL_PAIR_THM; tile_k; tile_J; FST; SND] THEN + MAP_EVERY X_GEN_TAC + [`f:real->complex`; `k:int`; `nI:int`; `nJ:int`; + `S:real->bool`; `E:real->bool`; `h:real->real`; `P:(int#int#int)->bool`; + `q:int`; `M:int`] THEN + STRIP_TAC THEN + USE_THEN "EDGE" (MP_TAC o SPECL + [`f:real->complex`; `k:int`; `nI:int`; `nJ:int`; `S:real->bool`; + `E:real->bool`; `h:real->real`; `P:(int#int#int)->bool`; `q:int`; + `M:int`]) THEN + REWRITE_TAC[tile_J] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[FORALL_PAIR_THM; tile_J] THEN ASM_REWRITE_TAC[]);; + +(* 286L alpha0/alpha1 PER-SCALE bound (the concrete tile-counting assembly). *) +(* For a same-scale-k tree subset A of P whose tiles all lie OUTSIDE the *) +(* cover *) +(* cell's index-span [q,q+M) (nI >= q+M or nI <= q-1), the sum over A of the *) +(* per-tile alpha norms is bounded by C1 2^{-k} energy mass. The *) +(* nearest-edge *) +(* offset map is <= 2-to-1 (TILE_OFFSET_FIBER_CARD), the per-tile factor is *) +(* the *) +(* edge bound (CARLESON_ALPHA_EDGE_TILE), and the cw-tail collapses to <= 1 *) +(* via *) +(* ALPHA_SCALE_BOUND_ABSTRACT at N = 0 (so the tail sum 1/(1+&0)^2 = 1). The *) +(* single 2^{-k} factor is what drives the geometric series over k in *) +(* alpha0/1. *) +let CARLESON_ALPHA_SCALE = prove + (`?C1. &0 <= C1 /\ + !(f:real->complex) (k:int) E h (P:(int#int#int)->bool) A u q M + (Sc:(int#int#int)->real->bool). + FINITE P /\ ~(P = {}) /\ FINITE A /\ A SUBSET P /\ &0 <= M /\ + (!s. s IN A ==> tile_k s = k /\ tile_le s u) /\ + (!s. s IN A ==> (q + M <= FST(SND s) \/ FST(SND s) <= q - &1)) /\ + (!s. s IN A ==> + (Sc s) SUBSET {x | x IN E /\ h x IN tile_J s} /\ + (Sc s) SUBSET {x | real_of_int q * &2 zpow (--k) <= x /\ + x < real_of_int (q + M) * &2 zpow (--k)} /\ + (\x. norm(phi_sigma s carleson_phi x)) real_integrable_on (Sc s) /\ + (\x. (cw_tile s x) pow 2) real_integrable_on (Sc s) /\ + cw_tile s real_integrable_on (Sc s) /\ + (\z. phi_sigma s carleson_phi (drop z)) absolutely_integrable_on (IMAGE + lift (Sc s))) /\ + (!t. cw_tile t real_integrable_on {x | x IN E /\ h x IN tile_J t}) + ==> sum A (\s. norm(carleson_ip f s * + integral (IMAGE lift (Sc s)) + (\z. phi_sigma s carleson_phi (drop z)))) + <= C1 * inv(&2 zpow k) * energy_f f P * mass_Eh E h P`, + X_CHOOSE_THEN `C1:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "TILE")) + CARLESON_ALPHA_EDGE_TILE THEN + EXISTS_TAC `C1:real` THEN ASM_REWRITE_TAC[] THEN + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `&0 <= energy_f (f:real->complex) P /\ &0 <= mass_Eh E h P` + STRIP_ASSUME_TAC THENL + [ASM_SIMP_TAC[ENERGY_F_POS] THEN MATCH_MP_TAC MASS_EH_POS THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MP_TAC(ISPECL [`\s. num_of_int(if q + M <= FST(SND s) then FST(SND s) - (q + + M) + else (q - &1) - FST(SND(s:int#int#int)))`; + `A:(int#int#int)->bool`] UPPER_BOUND_FINITE_SET) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `Mup:num`) THEN + MP_TAC(ISPECL + [`A:(int#int#int)->bool`; + `\s. norm(carleson_ip f s * + integral (IMAGE lift ((Sc:(int#int#int)->real->bool) s)) + (\z. phi_sigma s carleson_phi (drop z)))`; + `\s. num_of_int(if q + M <= FST(SND s) then FST(SND s) - (q + M) + else (q - &1) - FST(SND(s:int#int#int)))`; + `C1 * inv(&2 zpow k) * energy_f (f:real->complex) P * mass_Eh E h P`; + `0`; + `Mup:num`] ALPHA_SCALE_BOUND_ABSTRACT) THEN + REWRITE_TAC[REAL_ARITH `(&1 + &0) pow 2 = &1`; REAL_DIV_1; REAL_MUL_RID] THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [REPEAT(MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC) THEN + ASM_REWRITE_TAC[REAL_LE_INV_EQ] THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN MATCH_MP_TAC REAL_ZPOW_LT THEN + REAL_ARITH_TAC; + X_GEN_TAC `s:int#int#int` THEN DISCH_TAC THEN + SUBGOAL_THEN `tile_k (s:int#int#int) = k` ASSUME_TAC THENL + [ASM_SIMP_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `(C1 * inv(&2 zpow k) * energy_f (f:real->complex) P * mass_Eh E h P) * + cw(&(num_of_int(if q + M <= FST(SND(s:int#int#int)) then FST(SND s) - (q + + M) + else (q - &1) - FST(SND s))) + &1 / &2) = + C1 * inv(&2 zpow k) * + cw(&(num_of_int(if q + M <= FST(SND s) then FST(SND s) - (q + M) + else (q - &1) - FST(SND s))) + &1 / &2) * + energy_f f P * mass_Eh E h P` + SUBST1_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + USE_THEN + "TILE" (fun th -> MATCH_MP_TAC(REWRITE_RULE[ASSUME `tile_k + (s:int#int#int) = k`] + (SPECL [`f:real->complex`; `s:int#int#int`; + `(Sc:(int#int#int)->real->bool) s`; + `E:real->bool`; `h:real->real`; `P:(int#int#int)->bool`; `q:int`; + `M:int`] th))) THEN + ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; + X_GEN_TAC `s:int#int#int` THEN DISCH_TAC THEN REWRITE_TAC[IN_NUMSEG] THEN + CONJ_TAC THENL [ARITH_TAC; ASM_SIMP_TAC[]]; + GEN_TAC THEN MATCH_MP_TAC TILE_OFFSET_FIBER_CARD THEN + MAP_EVERY EXISTS_TAC [`k:int`; `u:int#int#int`] THEN ASM_REWRITE_TAC[]]);; + +(* 286L alpha1 TIGHT per-scale bound. Same as CARLESON_ALPHA_SCALE but with *) +(* an *) +(* OFFSET LOWER BOUND N <= edgeoff(s) for every tile s in A (in 286L: N = *) +(* 2^{k-l_K} *) +(* because I_sigma NOT-SUBSET K* puts sigma at scaled distance >= mu K = *) +(* 2^{k-l} *) +(* from the cover cell), yielding the (1+&N)^{-2} DECAY factor. This factor *) +(* is *) +(* ESSENTIAL for alpha1: alpha1 sums over infinitely many coarse levels l < *) +(* k_tau, *) +(* and Fremlin's 2^{-k}(1+2^{k-l})^{-2} <= 2^{-3k} 2^{2l} decay (from THIS *) +(* lemma at *) +(* N=2^{k-l}) is what makes the sum over l converge. The loose N=0 *) +(* CARLESON_ALPHA_ *) +(* SCALE (no decay) DIVERGES for alpha1. Proof: REAL_LE_TRANS through *) +(* ALPHA_SCALE_ *) +(* BOUND_ABSTRACT at general N (= B/(1+&N)^2), the extra range-lower-bound *) +(* N<=g s *) +(* supplied by the new hypothesis; then reassociate. *) +let CARLESON_ALPHA_SCALE_TIGHT = prove + (`?C1. &0 <= C1 /\ + !(f:real->complex) (k:int) E h (P:(int#int#int)->bool) A u q M N + (Sc:(int#int#int)->real->bool). + FINITE P /\ ~(P = {}) /\ FINITE A /\ A SUBSET P /\ &0 <= M /\ + (!s. s IN A ==> tile_k s = k /\ tile_le s u) /\ + (!s. s IN A ==> (q + M <= FST(SND s) \/ FST(SND s) <= q - &1)) /\ + (!s. s IN A ==> N <= num_of_int(if q + M <= FST(SND s) then FST(SND s) - + (q + M) + else (q - &1) - FST(SND s))) /\ + (!s. s IN A ==> + (Sc s) SUBSET {x | x IN E /\ h x IN tile_J s} /\ + (Sc s) SUBSET {x | real_of_int q * &2 zpow (--k) <= x /\ + x < real_of_int (q + M) * &2 zpow (--k)} /\ + (\x. norm(phi_sigma s carleson_phi x)) real_integrable_on (Sc s) /\ + (\x. (cw_tile s x) pow 2) real_integrable_on (Sc s) /\ + cw_tile s real_integrable_on (Sc s) /\ + (\z. phi_sigma s carleson_phi (drop z)) absolutely_integrable_on (IMAGE + lift (Sc s))) /\ + (!t. cw_tile t real_integrable_on {x | x IN E /\ h x IN tile_J t}) + ==> sum A (\s. norm(carleson_ip f s * + integral (IMAGE lift (Sc s)) + (\z. phi_sigma s carleson_phi (drop z)))) + <= C1 * inv(&2 zpow k) * inv((&1 + &N) pow 2) * energy_f f P * + mass_Eh E h P`, + X_CHOOSE_THEN `C1:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "TILE")) + CARLESON_ALPHA_EDGE_TILE THEN + EXISTS_TAC `C1:real` THEN ASM_REWRITE_TAC[] THEN + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `&0 <= energy_f (f:real->complex) P /\ &0 <= mass_Eh E h P` + STRIP_ASSUME_TAC THENL + [ASM_SIMP_TAC[ENERGY_F_POS] THEN MATCH_MP_TAC MASS_EH_POS THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MP_TAC(ISPECL [`\s. num_of_int(if q + M <= FST(SND s) then FST(SND s) - (q + + M) + else (q - &1) - FST(SND(s:int#int#int)))`; + `A:(int#int#int)->bool`] UPPER_BOUND_FINITE_SET) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `Mup:num`) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(C1 * inv(&2 zpow k) * energy_f (f:real->complex) P * mass_Eh E h + P) * + &1 / (&1 + &N) pow 2` THEN + CONJ_TAC THENL + [MATCH_MP_TAC(ISPECL + [`A:(int#int#int)->bool`; + `\s. norm(carleson_ip f s * + integral (IMAGE lift ((Sc:(int#int#int)->real->bool) s)) + (\z. phi_sigma s carleson_phi (drop z)))`; + `\s. num_of_int(if q + M <= FST(SND s) then FST(SND s) - (q + M) + else (q - &1) - FST(SND(s:int#int#int)))`; + `C1 * inv(&2 zpow k) * energy_f (f:real->complex) P * mass_Eh E h P`; + `N:num`; + `Mup:num`] ALPHA_SCALE_BOUND_ABSTRACT) THEN + ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [REPEAT(MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC) THEN + ASM_REWRITE_TAC[REAL_LE_INV_EQ] THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN MATCH_MP_TAC REAL_ZPOW_LT THEN + REAL_ARITH_TAC; + X_GEN_TAC `s:int#int#int` THEN DISCH_TAC THEN + SUBGOAL_THEN `tile_k (s:int#int#int) = k` ASSUME_TAC THENL + [ASM_SIMP_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `(C1 * inv(&2 zpow k) * energy_f (f:real->complex) P * mass_Eh E h P) * + cw(&(num_of_int(if q + M <= FST(SND(s:int#int#int)) then FST(SND s) - + (q + M) + else (q - &1) - FST(SND s))) + &1 / &2) = + C1 * inv(&2 zpow k) * + cw(&(num_of_int(if q + M <= FST(SND s) then FST(SND s) - (q + M) + else (q - &1) - FST(SND s))) + &1 / &2) * + energy_f f P * mass_Eh E h P` + SUBST1_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + USE_THEN + "TILE" (fun th -> MATCH_MP_TAC(REWRITE_RULE[ASSUME `tile_k + (s:int#int#int) = k`] + (SPECL [`f:real->complex`; `s:int#int#int`; + `(Sc:(int#int#int)->real->bool) s`; + `E:real->bool`; `h:real->real`; `P:(int#int#int)->bool`; + `q:int`; `M:int`] th))) THEN + ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; + X_GEN_TAC `s:int#int#int` THEN DISCH_TAC THEN REWRITE_TAC[IN_NUMSEG] THEN + CONJ_TAC THENL [ASM_SIMP_TAC[]; ASM_SIMP_TAC[]]; + GEN_TAC THEN MATCH_MP_TAC TILE_OFFSET_FIBER_CARD THEN + MAP_EVERY EXISTS_TAC [`k:int`; `u:int#int#int`] THEN ASM_REWRITE_TAC[]]; + MATCH_MP_TAC REAL_EQ_IMP_LE THEN REWRITE_TAC[real_div; REAL_MUL_LID] THEN + REAL_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* 286G(d) pointwise core: the shifted weight is <= 8 w(beta) on a *) +(* half-line. *) +(* (The full self-convolution INT w(a x+b) w(x) dx <= C2 w(b) then splits *) +(* the *) +(* integral at x = -(1+b)/2a using this bound on the right piece.) *) +(* ------------------------------------------------------------------------- *) + +(* If (1+b)/2 <= 1+|y| (b>=0), then w(y) <= 8 w(b). w(y)=1/(1+|y|)^3, and *) +(* ((1+b)/2)^3 = (1+b)^3/8, so 8 w(b) = 1/((1+b)/2)^3 >= 1/(1+|y|)^3. *) +let CW_LE_8 = prove + (`!y b. &0 <= b /\ (&1 + b) / &2 <= &1 + abs y ==> cw y <= &8 * cw b`, + REPEAT STRIP_TAC THEN REWRITE_TAC[cw] THEN + SUBGOAL_THEN `abs b = b` SUBST1_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `&0 < &1 + abs y /\ &0 < &1 + b` STRIP_ASSUME_TAC THENL + [CONJ_TAC THEN MP_TAC(ISPEC `y:real` REAL_ABS_POS) THEN + ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `&8 * &1 / (&1 + b) pow 3 = &1 / ((&1 + b)/ &2) pow 3` SUBST1_TAC THENL + [REWRITE_TAC[REAL_POW_DIV] THEN + SUBGOAL_THEN `~((&1 + b) pow 3 = &0)` MP_TAC THENL + [MATCH_MP_TAC REAL_POW_NZ THEN + ASM_REAL_ARITH_TAC; CONV_TAC REAL_FIELD]; ALL_TAC] THEN + REWRITE_TAC[REAL_ARITH `&1 / x = inv x`] THEN MATCH_MP_TAC REAL_LE_INV2 THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_POW_LT THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_POW_LE2 THEN ASM_REAL_ARITH_TAC]);; + +(* 286G(d)(ii) pointwise: 0=0, x >= -(1+b)/(2a) ==> w(a x+b) <= 8 *) +(* w(b). *) +let WEIGHT_SHIFT_BOUND = prove + (`!a b x. &0 < a /\ a <= &1 /\ &0 <= b /\ --((&1 + b) / (&2 * a)) <= x + ==> cw(a * x + b) <= &8 * cw b`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CW_LE_8 THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `--((&1 + b) / &2) <= a * x` ASSUME_TAC THENL + [SUBGOAL_THEN `a * (--((&1 + b) / (&2 * a))) <= a * x` MP_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + SUBGOAL_THEN + `a * (--((&1 + b) / (&2 * a))) = --((&1 + b) / &2)` SUBST1_TAC THENL + [SUBGOAL_THEN `~(a = &0)` MP_TAC THENL + [ASM_REAL_ARITH_TAC; CONV_TAC REAL_FIELD]; + REAL_ARITH_TAC]]; ALL_TAC] THEN + SUBGOAL_THEN `a * x + b <= abs(a * x + b)` MP_TAC THENL + [REWRITE_TAC[REAL_ABS_LE]; ASM_REAL_ARITH_TAC]);; + +(* Affine-image integral of the weight: INT_R w(a x + b) dx = 1/a (a > 0). *) +(* Change of variables from CW_FULL via HAS_REAL_INTEGRAL_AFFINITY_UNIV; *) +(* this *) +(* is the "INT w(a x+b) = 1/a" step used in the 286G(d) convolution *) +(* estimate. *) +let CW_AFFINE_INTEGRAL = prove + (`!a b. &0 < a ==> ((\x. cw(a * x + b)) has_real_integral (inv a)) (:real)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`cw`; `&1`; `a:real`; + `b:real`] HAS_REAL_INTEGRAL_AFFINITY_UNIV) THEN + ASM_SIMP_TAC[CW_FULL; REAL_LT_IMP_NZ; REAL_MUL_RID] THEN + SUBGOAL_THEN `abs a = a` SUBST1_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* 286G(d)(i) left-piece scalar bound: (1/a) w((1+b)/(2a)) <= 8 w(b). *) +(* (In the convolution's left piece, INT_{-inf}^{-gamma} w(x)w(ax+b) <= *) +(* w(gamma) INT w(ax+b) = w(gamma)/a = (1/a) w((1+b)/2a) <= 8 w(b).) *) +(* ------------------------------------------------------------------------- *) + +(* Polynomial core: d(1+b)^2 <= 4(1+d)^3 when (1+b)/2 <= d (so *) +(* (1+b)^2<=4d^2, *) +(* d(1+b)^2 <= 4d^3 <= 4(1+d)^3). *) +let CW_POLY_CORE = prove + (`!d b. &0 <= b /\ &0 < d /\ (&1 + b) / &2 <= d + ==> d * (&1 + b) pow 2 <= &4 * (&1 + d) pow 3`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&4 * d pow 3` THEN CONJ_TAC THENL + [SUBGOAL_THEN `&4 * d pow 3 = d * (&2 * d) pow 2` SUBST1_TAC THENL + [REWRITE_TAC[REAL_POW_MUL; REAL_POW_2] THEN + CONV_TAC REAL_RING; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; MATCH_MP_TAC REAL_POW_LE2 THEN + ASM_REAL_ARITH_TAC]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [REAL_ARITH_TAC; MATCH_MP_TAC REAL_POW_LE2 THEN ASM_REAL_ARITH_TAC]);; + +(* Abstracted form: (2d/(1+b)) w-profile(d) <= 8 w-profile(b). Common *) +(* denominator (1+b)^3(1+d)^3 + REAL_LE_DIV2_EQ reduces to 2*CW_POLY_CORE. *) +let CW_SCALE_LEFT_ABS = prove + (`!d b. &0 <= b /\ &0 < d /\ (&1 + b) / &2 <= d + ==> (&2 * d / (&1 + b)) * (&1 / (&1 + d) pow 3) <= &8 * (&1 / (&1 + b) pow + 3)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&0 < &1 + b /\ &0 < &1 + d` STRIP_ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `~(&1 + b = &0) /\ ~(&1 + d = &0)` STRIP_ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `(&2 * d / (&1 + b)) * (&1 / (&1 + d) pow 3) = + (&2 * d * (&1 + b) pow 2) / ((&1 + b) pow 3 * (&1 + d) pow 3)` + SUBST1_TAC THENL + [MAP_EVERY UNDISCH_TAC [`~(&1 + b = &0)`; `~(&1 + d = &0)`] THEN + CONV_TAC REAL_FIELD; + ALL_TAC] THEN + SUBGOAL_THEN + `&8 * (&1 / (&1 + b) pow 3) = + (&8 * (&1 + d) pow 3) / ((&1 + b) pow 3 * (&1 + d) pow 3)` + SUBST1_TAC THENL + [MAP_EVERY UNDISCH_TAC [`~(&1 + b = &0)`; `~(&1 + d = &0)`] THEN + CONV_TAC REAL_FIELD; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < (&1 + b) pow 3 * (&1 + d) pow 3` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC THEN MATCH_MP_TAC REAL_POW_LT THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LE_DIV2_EQ] THEN + MP_TAC(ISPECL [`d:real`; `b:real`] CW_POLY_CORE) THEN ASM_REWRITE_TAC[] THEN + REAL_ARITH_TAC);; + +(* Concrete: (1/a) w((1+b)/(2a)) <= 8 w(b) (0=0). d := (1+b)/(2a), *) +(* then 2d/(1+b) = 1/a. *) +let CW_SCALE_LEFT = prove + (`!a b. &0 < a /\ a <= &1 /\ &0 <= b + ==> inv a * cw((&1 + b) / (&2 * a)) <= &8 * cw b`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`(&1 + b) / (&2 * a)`; `b:real`] CW_SCALE_LEFT_ABS) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LT_DIV THEN ASM_REAL_ARITH_TAC; + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_ARITH `&0 < a ==> &0 < &2 * a`] THEN + SUBGOAL_THEN `(&1 + b) / &2 * (&2 * a) = (&1 + b) * a` SUBST1_TAC THENL + [UNDISCH_TAC `&0 < a` THEN CONV_TAC REAL_FIELD; ALL_TAC] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REAL_ARITH_TAC]; ALL_TAC] THEN + REWRITE_TAC[cw] THEN + SUBGOAL_THEN `abs((&1 + b) / (&2 * a)) = (&1 + b) / (&2 * a) /\ abs b = b` + STRIP_ASSUME_TAC THENL + [CONJ_TAC THEN REWRITE_TAC[REAL_ABS_REFL] THENL + [MATCH_MP_TAC REAL_LE_DIV THEN + ASM_REAL_ARITH_TAC; ASM_REAL_ARITH_TAC]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_THM_TAC THEN + AP_TERM_TAC THEN + SUBGOAL_THEN `&2 * (&1 + b) / (&2 * a) / (&1 + b) = inv a` SUBST1_TAC THENL + [SUBGOAL_THEN `~(&1 + b = &0)` MP_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + UNDISCH_TAC `&0 < a` THEN CONV_TAC REAL_FIELD; ALL_TAC] THEN + REFL_TAC);; + +(* cw antitone on the negative side: x < -g (g >= 0) ==> cw x <= cw g. *) +let CW_ANTITONE_NEG = prove + (`!x g. &0 <= g /\ x < --g ==> cw x <= cw g`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CW_ANTITONE THEN + SUBGOAL_THEN `abs g = g` SUBST1_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_REAL_ARITH_TAC);; + +(* 286G(d) POINTWISE convolution bound, valid on ALL of R (cleaner than *) +(* Fremlin's half-line split): at each x, either x >= -gamma (right, w(a *) +(* x+b) <= 8 w(b)) or x < -gamma (left, w(x) <= w(gamma)); both RHS terms >= *) +(* 0. *) +let CW_CONV_PTWISE = prove + (`!a b x. &0 < a /\ a <= &1 /\ &0 <= b + ==> cw x * cw(a * x + b) + <= &8 * cw b * cw x + cw((&1 + b) / (&2 * a)) * cw(a * x + b)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `&0 <= &8 * cw b * cw x /\ &0 <= cw((&1 + b) / (&2 * a)) * cw(a * x + b)` + STRIP_ASSUME_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [REAL_ARITH_TAC; MATCH_MP_TAC REAL_LE_MUL THEN + SIMP_TAC[CW_POS; REAL_LT_IMP_LE]]; + MATCH_MP_TAC REAL_LE_MUL THEN + SIMP_TAC[CW_POS; REAL_LT_IMP_LE]]; ALL_TAC] THEN + SUBGOAL_THEN `&0 <= (&1 + b) / (&2 * a)` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_DIV THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_CASES_TAC `--((&1 + b) / (&2 * a)) <= x` THENL + [MP_TAC(ISPECL [`a:real`;`b:real`;`x:real`] WEIGHT_SHIFT_BOUND) THEN + ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN + SUBGOAL_THEN `cw x * cw(a * x + b) <= &8 * cw b * cw x` MP_TAC THENL + [ONCE_REWRITE_TAC[REAL_ARITH `&8 * cw b * cw x = cw x * &8 * cw b`] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN + ASM_SIMP_TAC[CW_POS; REAL_LT_IMP_LE]; ALL_TAC] THEN + ASM_REAL_ARITH_TAC; + SUBGOAL_THEN `cw x <= cw((&1 + b) / (&2 * a))` ASSUME_TAC THENL + [MATCH_MP_TAC CW_ANTITONE_NEG THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `cw x * cw(a * x + b) <= cw((&1 + b) / (&2 * a)) * cw(a * x + b)` MP_TAC + THENL + [MATCH_MP_TAC REAL_LE_RMUL THEN + ASM_SIMP_TAC[CW_POS; REAL_LT_IMP_LE]; ALL_TAC] THEN + ASM_REAL_ARITH_TAC]);; + +(* The weight is continuous (hence measurable): cw x = 1/(1+|x|)^3, *) +(* denominator *) +(* never zero. Needed for the product integrability in the convolution. *) +(* The product w(x) w(a x+b) is integrable on R: measurable (continuous) and *) +(* bounded by the integrable w(x) (since w(a x+b) <= 1). *) +let CW_PROD_INTEGRABLE = prove + (`!a b. (\x. cw x * cw(a * x + b)) real_integrable_on (:real)`, + REPEAT GEN_TAC THEN + MATCH_MP_TAC REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN + EXISTS_TAC `cw` THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_IMP_REAL_MEASURABLE_ON THEN + MP_TAC(BETA_RULE(ISPECL [`cw`; `(\x. cw(a * x + b))`; + `(:real)`] REAL_CONTINUOUS_ON_MUL)) THEN + DISCH_THEN MATCH_MP_TAC THEN + REWRITE_TAC[CW_CONTINUOUS; CW_SHIFT_CONTINUOUS]; + MATCH_MP_TAC HAS_REAL_INTEGRAL_INTEGRABLE THEN EXISTS_TAC `&1` THEN + REWRITE_TAC[CW_FULL]; + X_GEN_TAC `x:real` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + MP_TAC(SPEC `x:real` CW_POS) THEN MP_TAC(SPEC `a * x + b:real` CW_POS) THEN + MP_TAC(SPEC `a * x + b:real` CW_LE_1) THEN STRIP_TAC THEN STRIP_TAC THEN + STRIP_TAC THEN + SUBGOAL_THEN + `abs(cw x * cw(a * x + b)) = cw x * cw(a * x + b)` SUBST1_TAC THENL + [REWRITE_TAC[REAL_ABS_REFL] THEN MATCH_MP_TAC REAL_LE_MUL THEN + ASM_REAL_ARITH_TAC; ALL_TAC] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REAL_ARITH_TAC]);; + +(* The integral of the CW_CONV_PTWISE right-hand side: INT [8w(b)w(x) + *) +(* w(gamma)w(a x+b)] = 8 w(b) + w(gamma)/a. *) +let CW_CONV_RHS_INTEGRAL = prove + (`!a b. &0 < a + ==> ((\x. &8 * cw b * cw x + cw((&1 + b) / (&2 * a)) * cw(a * x + b)) + has_real_integral (&8 * cw b + cw((&1 + b) / (&2 * a)) * inv a)) + (:real)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_ADD THEN CONJ_TAC THENL + [MP_TAC(ISPECL [`\x. cw b * cw x`; `cw b * &1`; `(:real)`; + `&8`] HAS_REAL_INTEGRAL_LMUL) THEN + REWRITE_TAC[REAL_ARITH `&8 * cw b * cw x = &8 * (cw b * cw x)`; + REAL_ARITH `&8 * cw b * &1 = &8 * cw b`] THEN + DISCH_THEN MATCH_MP_TAC THEN + MP_TAC(ISPECL [`cw`; `&1`; `(:real)`; `cw b`] HAS_REAL_INTEGRAL_LMUL) THEN + REWRITE_TAC[CW_FULL]; + MATCH_MP_TAC HAS_REAL_INTEGRAL_LMUL THEN + ASM_SIMP_TAC[CW_AFFINE_INTEGRAL]]);; + +(* 286G(d): the weight SELF-CONVOLUTION bound INT_R w(x) w(a x+b) dx <= 16 *) +(* w(b) *) +(* for 0 < a <= 1, b >= 0 (C2 = 16). Integrate the whole-line pointwise *) +(* bound *) +(* CW_CONV_PTWISE (REAL/HAS_REAL_INTEGRAL_LE) and evaluate the RHS integral *) +(* (CW_CONV_RHS_INTEGRAL); the w(gamma)/a term is <= 8 w(b) by *) +(* CW_SCALE_LEFT. *) +let CW_CONVOLUTION = prove + (`!a b. &0 < a /\ a <= &1 /\ &0 <= b + ==> real_integral (:real) (\x. cw x * cw(a * x + b)) <= &16 * cw b`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&8 * cw b + cw((&1 + b) / (&2 * a)) * inv a` THEN CONJ_TAC THENL + [MP_TAC(ISPECL [`\x. cw x * cw(a * x + b)`; + `\x. &8 * cw b * cw x + cw((&1 + b) / (&2 * a)) * cw(a * x + b)`; + `(:real)`; + `real_integral (:real) (\x. cw x * cw(a * x + b))`; + `&8 * cw b + cw((&1 + b) / (&2 * a)) * inv a`] HAS_REAL_INTEGRAL_LE) + THEN + ASM_SIMP_TAC[GSYM REAL_INTEGRABLE_INTEGRAL; CW_PROD_INTEGRABLE; + CW_CONV_RHS_INTEGRAL] THEN + DISCH_THEN MATCH_MP_TAC THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC(REWRITE_RULE[] (SPEC_ALL CW_CONV_PTWISE)) THEN + ASM_REWRITE_TAC[]; + MP_TAC(ISPECL [`a:real`; `b:real`] CW_SCALE_LEFT) THEN + ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[REAL_ARITH `cw((&1 + b) / (&2 * a)) * inv a = + inv a * cw((&1 + b) / (&2 * a))`] THEN + REAL_ARITH_TAC]);; + +(* Reflection identity for the convolution integrand (w even, x |-> -x): *) +(* INT w(x)w(a x+b) = INT w(x)w(a x + -b). *) +let CW_CONV_REFLECT = prove + (`!a b. real_integral (:real) (\x. cw x * cw(a * x + b)) = + real_integral (:real) (\x. cw x * cw(a * x + --b))`, + REPEAT GEN_TAC THEN + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_INTEGRAL_REFLECT_UNIV] THEN + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:real` THEN + REWRITE_TAC[] THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [CW_EVEN] THEN + AP_TERM_TAC THEN + GEN_REWRITE_TAC RAND_CONV [GSYM CW_EVEN] THEN + AP_TERM_TAC THEN REAL_ARITH_TAC);; + +(* 286G(d) for ALL real beta (C2 = 16): reduce b<0 to -b>0 by *) +(* CW_CONV_REFLECT, with cw b = cw(-b). *) +let CW_CONVOLUTION_GEN = prove + (`!a b. &0 < a /\ a <= &1 + ==> real_integral (:real) (\x. cw x * cw(a * x + b)) <= &16 * cw b`, + REPEAT STRIP_TAC THEN DISJ_CASES_TAC(REAL_ARITH `&0 <= b \/ &0 <= --b`) THENL + [ASM_SIMP_TAC[CW_CONVOLUTION]; + ONCE_REWRITE_TAC[CW_CONV_REFLECT] THEN + SUBGOAL_THEN `cw b = cw(--b)` SUBST1_TAC THENL + [REWRITE_TAC[CW_EVEN]; ALL_TAC] THEN + ASM_SIMP_TAC[CW_CONVOLUTION]]);; + +(* ------------------------------------------------------------------------- *) +(* Hermite-Hadamard lower bound (for 286G(b)): a convex integrable function *) +(* on [a,b] has INT_[a,b] f >= f(midpoint)*(b-a). Proved by the midpoint- *) +(* reflection: 2 INT f = INT [f(x)+f(a+b-x)] >= INT 2 f(m) = 2 f(m)(b-a). *) +(* ------------------------------------------------------------------------- *) + +(* Reflection about the midpoint maps [a,b] to itself. *) +let REAL_REFLECT_IMAGE_INTERVAL = prove + (`!a b. IMAGE (\x. inv(-- &1) * (x - (a + b))) (real_interval[a,b]) = + real_interval[a,b]`, + REPEAT GEN_TAC THEN REWRITE_TAC[EXTENSION; IN_IMAGE; IN_REAL_INTERVAL] THEN + X_GEN_TAC `y:real` THEN REWRITE_TAC[REAL_INV_NEG; REAL_INV_1] THEN + EQ_TAC THENL + [STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + STRIP_TAC THEN EXISTS_TAC `a + b - y:real` THEN CONJ_TAC THENL + [REAL_ARITH_TAC; ASM_REAL_ARITH_TAC]]);; + +(* INT_[a,b] f = INT_[a,b] f(a+b-x) (midpoint reflection, via affinity *) +(* m=-1). *) +let HAS_REAL_INTEGRAL_MIDREFLECT = prove + (`!f i a b. (f has_real_integral i) (real_interval[a,b]) + ==> ((\x. f(a + b - x)) has_real_integral i) (real_interval[a,b])`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o SPECL [`--(&1):real`; `a + b:real`] o MATCH_MP + (REWRITE_RULE[IMP_CONJ] HAS_REAL_INTEGRAL_AFFINITY)) THEN + REWRITE_TAC[REAL_ARITH `~(--(&1) = &0)`; REAL_REFLECT_IMAGE_INTERVAL] THEN + REWRITE_TAC[REAL_ABS_NEG; REAL_ABS_NUM; REAL_INV_1; REAL_MUL_LID] THEN + REWRITE_TAC[REAL_ARITH `--(&1) * x + (a + b) = a + b - x`]);; + +(* Midpoint convexity: f convex, m+t, m-t in s ==> 2 f(m) <= f(m+t)+f(m-t). *) +let CW_MIDPOINT_CONVEX = prove + (`!f s m t. f real_convex_on s /\ (m + t) IN s /\ (m - t) IN s + ==> &2 * f m <= f(m + t) + f(m - t)`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`m + t:real`; `m - t:real`; `&1 / &2`; + `&1 / &2`] o + REWRITE_RULE[real_convex_on]) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `&1 / &2 * (m + t) + &1 / &2 * (m - t) = m` SUBST1_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN REAL_ARITH_TAC);; + +let REFLSUM_INTEGRABLE = prove + (`!f a b. f real_integrable_on (real_interval[a,b]) + ==> (\x. f x + f(a + b - x)) real_integrable_on (real_interval[a,b])`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRABLE_ADD THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + MATCH_MP_TAC HAS_REAL_INTEGRAL_INTEGRABLE THEN + EXISTS_TAC `real_integral (real_interval[a,b]) f` THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_MIDREFLECT THEN + ASM_SIMP_TAC[REAL_INTEGRABLE_INTEGRAL]]);; + +let REFLSUM_INTEGRAL = prove + (`!f a b. a <= b /\ f real_integrable_on (real_interval[a,b]) + ==> real_integral (real_interval[a,b]) (\x. f x + f(a + b - x)) = + &2 * real_integral (real_interval[a,b]) f`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `((\x. f x + f(a + b - x)) has_real_integral + (real_integral (real_interval[a,b]) f + real_integral + (real_interval[a,b]) f)) + (real_interval[a,b])` MP_TAC THENL + [MATCH_MP_TAC HAS_REAL_INTEGRAL_ADD THEN CONJ_TAC THENL + [ASM_SIMP_TAC[REAL_INTEGRABLE_INTEGRAL]; + MATCH_MP_TAC HAS_REAL_INTEGRAL_MIDREFLECT THEN + ASM_SIMP_TAC[REAL_INTEGRABLE_INTEGRAL]]; + ALL_TAC] THEN + DISCH_THEN(SUBST1_TAC o MATCH_MP REAL_INTEGRAL_UNIQUE) THEN REAL_ARITH_TAC);; + +let HERMITE_HADAMARD_LOWER = prove + (`!f a b. a <= b /\ f real_convex_on (real_interval[a,b]) /\ + f real_integrable_on (real_interval[a,b]) + ==> f((a + b) / &2) * (b - a) <= real_integral (real_interval[a,b]) f`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(REAL_ARITH `&2 * (fm * ba) <= &2 * q ==> fm * ba <= q`) THEN + ASM_SIMP_TAC[GSYM REFLSUM_INTEGRAL] THEN + SUBGOAL_THEN `&2 * f((a + b) / &2) * (b - a) = + real_integral (real_interval[a,b]) (\x. &2 * f((a + b) / &2))` + SUBST1_TAC THENL + [ASM_SIMP_TAC[REAL_INTEGRAL_CONST] THEN REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_INTEGRAL_LE THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC HAS_REAL_INTEGRAL_INTEGRABLE THEN + EXISTS_TAC `(&2 * f((a + b) / &2)) * (b - a)` THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_CONST THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC REFLSUM_INTEGRABLE THEN ASM_REWRITE_TAC[]; + X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN STRIP_TAC THEN + MP_TAC(ISPECL [`f:real->real`; `real_interval[a,b]`; `(a + b) / &2`; + `x - (a + b) / &2`] + CW_MIDPOINT_CONVEX) THEN + ASM_REWRITE_TAC[IN_REAL_INTERVAL; + REAL_ARITH `(a + b) / &2 + (x - (a + b) / &2) = x`; + REAL_ARITH `(a + b) / &2 - (x - (a + b) / &2) = a + b - x`] THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; REAL_ARITH_TAC]]);; + +(* Convexity template: \x. C inv((p + q x)^3) is convex on any [a,b] where *) +(* p + q x > 0 (C >= 0). Second derivative C*12*inv((p+q x)^5)*q^2 >= 0 *) +(* (REAL_CONVEX_ON_SECOND_DERIVATIVE). This is the engine for w_sigma being *) +(* convex on an interval missing x_sigma (286G(b)). *) +let INV_CUBE_CONVEX = prove + (`!C p q a b. &0 <= C /\ a < b /\ (!x. a <= x /\ x <= b ==> &0 < p + q * x) + ==> (\x. C * inv((p + q * x) pow 3)) real_convex_on (real_interval[a,b])`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`(\x. C * inv((p + q * x) pow 3)):real->real`; + `(\x. C * (-- &3 * inv((p + q * x) pow 4) * q)):real->real`; + `(\x. C * (&12 * inv((p + q * x) pow 5) * q * q)):real->real`; + `real_interval[a,b]`] REAL_CONVEX_ON_SECOND_DERIVATIVE) THEN + REWRITE_TAC[IS_REALINTERVAL_INTERVAL] THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [REWRITE_TAC[NOT_EXISTS_THM] THEN X_GEN_TAC `c:real` THEN + REWRITE_TAC[EXTENSION; IN_REAL_INTERVAL; IN_SING; NOT_FORALL_THM] THEN + ASM_CASES_TAC `c = a:real` THENL + [EXISTS_TAC `b:real` THEN ASM_REAL_ARITH_TAC; + EXISTS_TAC `a:real` THEN ASM_REAL_ARITH_TAC]; + X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN STRIP_TAC THEN + SUBGOAL_THEN `&0 < p + q * x` ASSUME_TAC THENL + [ASM_SIMP_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC HAS_REAL_DERIVATIVE_ATREAL_WITHIN THEN REAL_DIFF_TAC THEN + SUBGOAL_THEN `~(p + q * x = &0)` MP_TAC THENL + [ASM_SIMP_TAC[REAL_LT_IMP_NZ]; ALL_TAC] THEN CONV_TAC REAL_FIELD; + X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN STRIP_TAC THEN + SUBGOAL_THEN `&0 < p + q * x` ASSUME_TAC THENL + [ASM_SIMP_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC HAS_REAL_DERIVATIVE_ATREAL_WITHIN THEN REAL_DIFF_TAC THEN + SUBGOAL_THEN `~(p + q * x = &0)` MP_TAC THENL + [ASM_SIMP_TAC[REAL_LT_IMP_NZ]; ALL_TAC] THEN CONV_TAC REAL_FIELD]; + DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN + X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN STRIP_TAC THEN + SUBGOAL_THEN `&0 < p + q * x` ASSUME_TAC THENL + [ASM_SIMP_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_LE_SQUARE] THEN + REWRITE_TAC[REAL_LE_INV_EQ] THEN MATCH_MP_TAC REAL_POW_LE THEN + ASM_REAL_ARITH_TAC]);; + +(* --- 286Gd building blocks (toward the two-sided weight sum sum_n w(x-n) *) +(* <= 2) --- *) + +(* cw is convex on any unit interval [c,c+1] on the positive half-line (c >= *) +(* 0): there cw x = 1/(1+x)^3 = the INV_CUBE_CONVEX template (C=1, p=1, q=1, *) +(* 1+x > 0). *) +let CWTILE_CONVEX_RIGHT = prove + (`!(s:int#int#int) a b. a < b /\ tile_xmid s <= a + ==> cw_tile s real_convex_on (real_interval[a,b])`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_CONVEX_ON_EQ THEN + EXISTS_TAC `\x. &2 zpow (tile_k s) * + inv(((&1 - &2 zpow (tile_k s) * tile_xmid s) + &2 zpow + (tile_k s) * x) pow 3)` THEN + REWRITE_TAC[IS_REALINTERVAL_INTERVAL] THEN CONJ_TAC THENL + [X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN STRIP_TAC THEN + REWRITE_TAC[cw_tile; cw] THEN + SUBGOAL_THEN `abs(&2 zpow (tile_k s) * (x - tile_xmid s)) = + &2 zpow (tile_k s) * (x - tile_xmid s)` SUBST1_TAC THENL + [REWRITE_TAC[REAL_ABS_REFL] THEN MATCH_MP_TAC REAL_LE_MUL THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LT_IMP_LE THEN MATCH_MP_TAC REAL_ZPOW_LT THEN + REAL_ARITH_TAC; + ASM_REAL_ARITH_TAC]; ALL_TAC] THEN + REWRITE_TAC[REAL_ARITH `&1 / x = inv x`] THEN AP_TERM_TAC THEN + AP_TERM_TAC THEN + AP_THM_TAC THEN AP_TERM_TAC THEN REAL_ARITH_TAC; + MATCH_MP_TAC INV_CUBE_CONVEX THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LT_IMP_LE THEN MATCH_MP_TAC REAL_ZPOW_LT THEN + REAL_ARITH_TAC; + X_GEN_TAC `x:real` THEN STRIP_TAC THEN + SUBGOAL_THEN `&0 < &2 zpow (tile_k s)` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `(&1 - &2 zpow (tile_k s) * tile_xmid s) + &2 zpow (tile_k s) * x = + &1 + &2 zpow (tile_k s) * (x - tile_xmid s)` SUBST1_TAC + THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `&0 <= &2 zpow (tile_k s) * (x - tile_xmid s)` MP_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN + ASM_REAL_ARITH_TAC; + REAL_ARITH_TAC]]]);; + +let CWTILE_CONVEX_LEFT = prove + (`!(s:int#int#int) a b. a < b /\ b <= tile_xmid s + ==> cw_tile s real_convex_on (real_interval[a,b])`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_CONVEX_ON_EQ THEN + EXISTS_TAC `\x. &2 zpow (tile_k s) * + inv(((&1 + &2 zpow (tile_k s) * tile_xmid s) + (--(&2 zpow + (tile_k s))) * x) pow 3)` THEN + REWRITE_TAC[IS_REALINTERVAL_INTERVAL] THEN CONJ_TAC THENL + [X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN STRIP_TAC THEN + REWRITE_TAC[cw_tile; cw] THEN + SUBGOAL_THEN `&0 < &2 zpow (tile_k s)` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `abs(&2 zpow (tile_k s) * (x - tile_xmid s)) = + --(&2 zpow (tile_k s) * (x - tile_xmid s))` SUBST1_TAC THENL + [REWRITE_TAC[REAL_ARITH `abs y = --y <=> y <= &0`] THEN + ONCE_REWRITE_TAC[REAL_ARITH `y * z <= &0 <=> &0 <= y * (--z)`] THEN + MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[REAL_ARITH `&1 / x = inv x`] THEN AP_TERM_TAC THEN + AP_TERM_TAC THEN + AP_THM_TAC THEN AP_TERM_TAC THEN REAL_ARITH_TAC; + MATCH_MP_TAC INV_CUBE_CONVEX THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LT_IMP_LE THEN MATCH_MP_TAC REAL_ZPOW_LT THEN + REAL_ARITH_TAC; + X_GEN_TAC `x:real` THEN STRIP_TAC THEN + SUBGOAL_THEN `&0 < &2 zpow (tile_k s)` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `(&1 + &2 zpow (tile_k s) * tile_xmid s) + (--(&2 zpow (tile_k s))) * x + = + &1 + &2 zpow (tile_k s) * (tile_xmid s - x)` SUBST1_TAC + THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `&0 <= &2 zpow (tile_k s) * (tile_xmid s - x)` MP_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN + ASM_REAL_ARITH_TAC; + REAL_ARITH_TAC]]]);; +let CWTILE_CONTINUOUS = prove + (`!(s:int#int#int). cw_tile s real_continuous_on (:real)`, + GEN_TAC THEN + SUBGOAL_THEN `cw_tile s = + (\x. &2 zpow (tile_k s) * cw(&2 zpow (tile_k s) * x + (--(&2 zpow (tile_k + s) * tile_xmid s))))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; cw_tile] THEN GEN_TAC THEN AP_TERM_TAC THEN + AP_TERM_TAC THEN + REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(BETA_RULE(ISPECL [`\x:real. &2 zpow (tile_k s)`; + `\x. cw(&2 zpow (tile_k s) * x + (--(&2 zpow (tile_k s) * tile_xmid s)))`; + `(:real)`] + REAL_CONTINUOUS_ON_MUL)) THEN + DISCH_THEN MATCH_MP_TAC THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_CONST; CW_SHIFT_CONTINUOUS]);; + +let CWTILE_INTEGRABLE = prove + (`!(s:int#int#int) a b. cw_tile s real_integrable_on (real_interval[a,b])`, + REPEAT GEN_TAC THEN MATCH_MP_TAC REAL_INTEGRABLE_CONTINUOUS THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `(:real)` THEN + REWRITE_TAC[CWTILE_CONTINUOUS; SUBSET_UNIV]);; + +(* 286Gc for cw_tile: on an interval [a,b] lying on ONE side of x_s, the *) +(* tile *) +(* weight integral is at least its midpoint value times the length -- the *) +(* midpoint-rule underestimate for the convex w_sigma. Instantiate the *) +(* existing HERMITE_HADAMARD_LOWER at f := cw_tile s (convex via *) +(* CWTILE_CONVEX_ *) +(* RIGHT/LEFT, integrable via CWTILE_INTEGRABLE). The 286Gc input to the *) +(* 286Gg *) +(* integral kernel bound (int_{I_tau} w_sigma >= w_sigma(x_tau) muI_tau). *) +let CWTILE_BOUNDS = prove + (`!s x. &0 <= cw_tile s x /\ cw_tile s x <= &2 zpow tile_k s`, + REPEAT GEN_TAC THEN REWRITE_TAC[cw_tile] THEN + SUBGOAL_THEN `&0 < &2 zpow tile_k s` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(SPEC `&2 zpow tile_k s * (x - tile_xmid s)` CW_POS) THEN + MP_TAC(SPEC `&2 zpow tile_k s * (x - tile_xmid s)` CW_LE_1) THEN + STRIP_TAC THEN STRIP_TAC THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN ASM_REAL_ARITH_TAC; + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REAL_ARITH_TAC]);; + +(* A constant is real-integrable on any real-measurable set (c * the &1 *) +(* integrand). *) +let REAL_INTEGRABLE_ON_CONST_MEASURABLE = prove + (`!c s. real_measurable s ==> (\x:real. c) real_integrable_on s`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\x:real. &1`; `c:real`; + `s:real->bool`] REAL_INTEGRABLE_LMUL) THEN + ASM_REWRITE_TAC[REAL_MUL_RID; GSYM REAL_MEASURABLE]);; + +let CWTILE_INTEGRABLE_MEASURABLE = prove + (`!s Sc. real_measurable Sc ==> cw_tile s real_integrable_on Sc`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN + EXISTS_TAC `(\x. &2 zpow tile_k s):real->real` THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC REAL_MEASURABLE_ON_MEASURABLE_SUBSET THEN + EXISTS_TAC `(:real)` THEN ASM_REWRITE_TAC[SUBSET_UNIV] THEN + MATCH_MP_TAC CONTINUOUS_IMP_REAL_MEASURABLE_ON THEN + REWRITE_TAC[CWTILE_CONTINUOUS]; + MATCH_MP_TAC REAL_INTEGRABLE_ON_CONST_MEASURABLE THEN ASM_REWRITE_TAC[]; + GEN_TAC THEN DISCH_TAC THEN + MP_TAC(SPECL [`s:int#int#int`; `x:real`] CWTILE_BOUNDS) THEN + REAL_ARITH_TAC]);; + +(* 286J part(b): int_A w_tau <= C mu A when w_tau <= C on the measurable set *) +(* A. *) +(* REAL_INTEGRAL_LE against the constant C (int_A C = C mu A via *) +(* has_real_measure *) +(* + HAS_REAL_INTEGRAL_LMUL); cw_tile integrable on A by CWTILE_INTEGRABLE_ *) +(* MEASURABLE. Bounds the peak/annulus terms of the R = union_k R_k decomp. *) +let CWTILE_INTEGRAL_LE_MEASURE = prove + (`!s A C. real_measurable A /\ &0 <= C /\ (!x. x IN A ==> cw_tile s x <= C) + ==> real_integral A (cw_tile s) <= C * real_measure A`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `((\x:real. C) has_real_integral (C * real_measure A)) A` ASSUME_TAC THENL + [MP_TAC(ISPECL [`\x:real. &1`; `real_measure A`; `A:real->bool`; `C:real`] + HAS_REAL_INTEGRAL_LMUL) THEN + ASM_SIMP_TAC[GSYM has_real_measure; GSYM HAS_REAL_MEASURE_MEASURE] THEN + REWRITE_TAC[REAL_MUL_RID]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `real_integral A (\x:real. C)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_LE THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CWTILE_INTEGRABLE_MEASURABLE THEN ASM_REWRITE_TAC[]; + ASM_MESON_TAC[real_integrable_on]; + ASM_SIMP_TAC[]]; + MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + ASM_REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* 286J part(b): the two product bounds for the annulus decomposition of *) +(* int_{E cap g^-1[J_tau]} w_tau. (i) peak: int_A w_tau <= muJ_tau mu A on *) +(* any *) +(* measurable A. (ii) annulus: on A avoiding I^(k)_tau, int_A w_tau <= *) +(* (1+2^{k-1})^{-3} muJ_tau mu A = 2^{k_tau} cw(2^{k-1}) mu A. *) +(* ------------------------------------------------------------------------- *) +let CWTILE_INTEGRAL_LE_MUJ_MEASURE = prove + (`!tau A. real_measurable A + ==> real_integral A (cw_tile tau) <= &2 zpow (tile_k tau) * real_measure + A`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CWTILE_INTEGRAL_LE_MEASURE THEN + ASM_REWRITE_TAC[CWTILE_LE_MUJ] THEN + MATCH_MP_TAC REAL_ZPOW_LE THEN REAL_ARITH_TAC);; + +let CWTILE_INTEGRAL_ANNULUS_BOUND = prove + (`!tau k A. + real_measurable A /\ (!x. x IN A ==> ~(x IN tile_Idil tau k)) + ==> real_integral A (cw_tile tau) <= + (&2 zpow (tile_k tau) * cw (&2 zpow (&k - &1))) * real_measure A`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CWTILE_INTEGRAL_LE_MEASURE THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LE THEN REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LT_IMP_LE THEN REWRITE_TAC[CW_POS]]; + X_GEN_TAC `x:real` THEN DISCH_TAC THEN + MATCH_MP_TAC CWTILE_OUTSIDE_IDIL_BOUND THEN ASM_SIMP_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* 286J part(b) K-truncated integral bound (Fremlin mt286.tex 862-870). For *) +(* measurable S: int_{S cap I^(K)_tau} w_tau <= muJ_tau mu(S cap I^(0)) + *) +(* sum_{k !K. real_integral (S INTER tile_Idil tau K) (cw_tile tau) <= + &2 zpow (tile_k tau) * real_measure (S INTER tile_Idil tau 0) + + sum {k | k < K} (\k. &2 zpow (tile_k tau) * cw (&2 zpow (&k - &1)) + * + real_measure (S INTER tile_Idil tau (k+1)))`, + GEN_TAC THEN GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THENL + [SUBGOAL_THEN `{k | k < 0} = {}` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY; LT]; ALL_TAC] THEN + REWRITE_TAC[SUM_CLAUSES; REAL_ADD_RID] THEN + MATCH_MP_TAC CWTILE_INTEGRAL_LE_MUJ_MEASURE THEN + MATCH_MP_TAC REAL_MEASURABLE_INTER THEN + ASM_REWRITE_TAC[TILE_IDIL_MEASURABLE]; + ALL_TAC] THEN + ABBREV_TAC `ANN = (S INTER tile_Idil tau (SUC K)) DIFF tile_Idil tau K` THEN + SUBGOAL_THEN + `S INTER tile_Idil tau (SUC K) = (S INTER tile_Idil tau K) UNION ANN` + ASSUME_TAC THENL + [EXPAND_TAC "ANN" THEN + MP_TAC(ISPECL [`tau:int#int#int`; `K:num`; `SUC K`] TILE_IDIL_MONO) THEN + ANTS_TAC THENL [ARITH_TAC; ALL_TAC] THEN ASM SET_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `real_integral (S INTER tile_Idil tau (SUC K)) (cw_tile tau) = + real_integral (S INTER tile_Idil tau K) (cw_tile tau) + + real_integral ANN (cw_tile tau)` SUBST1_TAC THENL + [ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_UNION THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_INTEGRAL THEN + MATCH_MP_TAC CWTILE_INTEGRABLE_MEASURABLE THEN + MATCH_MP_TAC REAL_MEASURABLE_INTER THEN + ASM_REWRITE_TAC[TILE_IDIL_MEASURABLE]; + MATCH_MP_TAC REAL_INTEGRABLE_INTEGRAL THEN + MATCH_MP_TAC CWTILE_INTEGRABLE_MEASURABLE THEN EXPAND_TAC "ANN" THEN + MATCH_MP_TAC REAL_MEASURABLE_DIFF THEN + ASM_SIMP_TAC[TILE_IDIL_MEASURABLE; REAL_MEASURABLE_INTER]; + EXPAND_TAC "ANN" THEN + MATCH_MP_TAC REAL_NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{}:real->bool` THEN + REWRITE_TAC[REAL_NEGLIGIBLE_EMPTY] THEN ASM SET_TAC[]]; ALL_TAC] THEN + SUBGOAL_THEN `{k | k < SUC K} = K INSERT {k | k < K}` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_INSERT; IN_ELIM_THM] THEN + ARITH_TAC; ALL_TAC] THEN + SIMP_TAC[SUM_CLAUSES; FINITE_NUMSEG_LT; IN_ELIM_THM; LT_REFL] THEN + MATCH_MP_TAC(REAL_ARITH + `iK <= b + s /\ ann <= kt ==> iK + ann <= b + kt + s`) THEN + CONJ_TAC THENL [FIRST_ASSUM ACCEPT_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(&2 zpow (tile_k tau) * cw (&2 zpow (&K - &1))) * real_measure + ANN` THEN + CONJ_TAC THENL + [MATCH_MP_TAC CWTILE_INTEGRAL_ANNULUS_BOUND THEN CONJ_TAC THENL + [EXPAND_TAC "ANN" THEN MATCH_MP_TAC REAL_MEASURABLE_DIFF THEN + ASM_SIMP_TAC[TILE_IDIL_MEASURABLE; REAL_MEASURABLE_INTER]; + EXPAND_TAC "ANN" THEN REWRITE_TAC[IN_DIFF] THEN + MESON_TAC[]]; ALL_TAC] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LE THEN REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LT_IMP_LE THEN REWRITE_TAC[CW_POS]; ALL_TAC] THEN + MATCH_MP_TAC REAL_MEASURE_SUBSET THEN REPEAT CONJ_TAC THENL + [EXPAND_TAC "ANN" THEN MATCH_MP_TAC REAL_MEASURABLE_DIFF THEN + ASM_SIMP_TAC[TILE_IDIL_MEASURABLE; REAL_MEASURABLE_INTER]; + ASM_SIMP_TAC[TILE_IDIL_MEASURABLE; REAL_MEASURABLE_INTER]; + EXPAND_TAC "ANN" THEN REWRITE_TAC[ADD1] THEN ASM SET_TAC[]]);; + +(* helper: int_S (if x in A then w else 0) = int_{S cap A} w (ETA_AX *) +(* collapses the RESTRICT_INTER eta-expanded integrand). *) +let CWTILE_RESTRICT_INTER_EQ = prove + (`!tau A S. real_integral S (\x. if x IN A then cw_tile tau x else &0) = + real_integral (S INTER A) (cw_tile tau)`, + REPEAT GEN_TAC THEN REWRITE_TAC[REAL_INTEGRAL_RESTRICT_INTER; ETA_AX] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[INTER_COMM]);; + +(* 286J part(b) monotone-convergence limit: int_{S cap I^(K)_tau} w_tau -> *) +(* int_S w_tau as K->inf, for measurable S. REAL_DOMINATED_CONVERGENCE with *) +(* f_K = w_tau restricted to I^(K)_tau, dominated by w_tau, converging *) +(* pointwise *) +(* (each x eventually in I^(K) by TILE_IDIL_EXHAUSTS + TILE_IDIL_MONO). *) +let CWTILE_KTRUNC_LIMIT = prove + (`!tau S. real_measurable S + ==> ((\K. real_integral (S INTER tile_Idil tau K) (cw_tile tau)) + ---> real_integral S (cw_tile tau)) sequentially`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`\K x. if x IN tile_Idil tau K then cw_tile tau x else &0`; + `cw_tile tau`; `cw_tile tau`; + `S:real->bool`] REAL_DOMINATED_CONVERGENCE) THEN + REWRITE_TAC[CWTILE_RESTRICT_INTER_EQ] THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [GEN_TAC THEN REWRITE_TAC[REAL_INTEGRABLE_RESTRICT_INTER; ETA_AX] THEN + MATCH_MP_TAC CWTILE_INTEGRABLE_MEASURABLE THEN + ONCE_REWRITE_TAC[INTER_COMM] THEN + MATCH_MP_TAC REAL_MEASURABLE_INTER THEN + ASM_REWRITE_TAC[TILE_IDIL_MEASURABLE]; + MATCH_MP_TAC CWTILE_INTEGRABLE_MEASURABLE THEN ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN + MP_TAC(SPECL [`tau:int#int#int`; `x:real`] CW_TILE_POS) THEN + REAL_ARITH_TAC; + X_GEN_TAC `x:real` THEN DISCH_TAC THEN + MP_TAC(ISPECL [`tau:int#int#int`; `x:real`] TILE_IDIL_EXHAUSTS) THEN + DISCH_THEN(X_CHOOSE_TAC `K0:num`) THEN + MATCH_MP_TAC REALLIM_EVENTUALLY THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `K0:num` THEN + X_GEN_TAC `K:num` THEN DISCH_TAC THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `~(x IN tile_Idil tau K)` THEN REWRITE_TAC[] THEN + MP_TAC(ISPECL [`tau:int#int#int`; `K0:num`; `K:num`] TILE_IDIL_MONO) THEN + ASM_REWRITE_TAC[] THEN ASM SET_TAC[]]; + SIMP_TAC[]]);; + + +(* ========================================================================= *) +(* 286J part (b) contrapositive (Fremlin mt286.tex 871-883, the "either ... *) +(* or ..." step, run as: if the peak term < gam/8 and every annulus falls *) +(* below its R_{k+1} threshold, then int_{E cap g^-1[J_tau]} w_tau <= *) +(* gam/4). *) +(* First the K-truncated bound <= gam/4 (KTRUNC_BOUND + ANNULUS_TERM_BOUND + *) +(* SUM_ZPOW_QUARTER), then pass K->inf (KTRUNC_LIMIT + REALLIM_UBOUND). *) +(* ========================================================================= *) + +(* K-truncated: int_{S cap I^(K)} w_tau <= gam/4 under the smallness hyps. *) +let CWTILE_KTRUNC_LE_QUARTER = prove + (`!tau S gam K. real_measurable S /\ &0 <= gam /\ + &2 zpow (tile_k tau) * real_measure (S INTER tile_Idil tau 0) <= gam / &8 + /\ + (!k. &2 zpow (tile_k tau) * real_measure (S INTER tile_Idil tau (k+1)) + <= &2 zpow (&2 * &k - &7) * gam) + ==> real_integral (S INTER tile_Idil tau K) (cw_tile tau) <= gam / &4`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`tau:int#int#int`; `S:real->bool`] CWTILE_KTRUNC_BOUND) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&2 zpow (tile_k tau) * real_measure (S INTER tile_Idil tau 0) + + sum {k | k < K} (\k. &2 zpow (tile_k tau) * cw (&2 zpow (&k - &1)) * + real_measure (S INTER tile_Idil tau (k+1)))` THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `gam / &8 + sum {k | k < K} (\k. &2 zpow (--(&k) - &4) * gam)` + THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_ADD2 THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC SUM_LE THEN REWRITE_TAC[FINITE_NUMSEG_LT; IN_ELIM_THM] THEN + X_GEN_TAC `k:num` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[REAL_ARITH `a * b * c = b * (a * c):real`] THEN + MATCH_MP_TAC CWTILE_ANNULUS_TERM_BOUND THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LE THEN REAL_ARITH_TAC; + MATCH_MP_TAC REAL_MEASURE_POS_LE THEN + MATCH_MP_TAC REAL_MEASURABLE_INTER THEN + ASM_REWRITE_TAC[TILE_IDIL_MEASURABLE]]; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]]; + REWRITE_TAC[SUM_RMUL] THEN + MATCH_MP_TAC(REAL_ARITH `s * gam <= gam / &8 ==> gam/ &8 + s * gam <= gam / + &4`) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(&1 / &8) * gam` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_RMUL THEN ASM_REWRITE_TAC[SUM_ZPOW_QUARTER]; + REAL_ARITH_TAC]]);; + +(* the limit: int_S w_tau <= gam/4 (REALLIM_UBOUND on KTRUNC_LIMIT). *) +let CWTILE_MASS_SMALL = prove + (`!tau S gam. real_measurable S /\ &0 <= gam /\ + &2 zpow (tile_k tau) * real_measure (S INTER tile_Idil tau 0) <= gam / &8 + /\ + (!k. &2 zpow (tile_k tau) * real_measure (S INTER tile_Idil tau (k+1)) + <= &2 zpow (&2 * &k - &7) * gam) + ==> real_integral S (cw_tile tau) <= gam / &4`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(ISPEC `sequentially` REALLIM_UBOUND) THEN + EXISTS_TAC `\K. real_integral (S INTER tile_Idil tau K) (cw_tile tau)` THEN + ASM_SIMP_TAC[CWTILE_KTRUNC_LIMIT; TRIVIAL_LIMIT_SEQUENTIALLY] THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `0` THEN + X_GEN_TAC `K:num` THEN DISCH_TAC THEN + MATCH_MP_TAC CWTILE_KTRUNC_LE_QUARTER THEN ASM_REWRITE_TAC[]);; + + +(* ========================================================================= *) +(* 286J part (b) R_k dichotomy (Fremlin mt286.tex 846-883): if the region *) +(* integral exceeds gam/4 (as it does for every tau in the greedy R, by the *) +(* witness), then muJ_tau mu(S cap I^(m)_tau) >= 2^{2m-9} gam for some m -- *) +(* i.e. *) +(* tau in R_m. Contrapositive of CWTILE_MASS_SMALL: if no such m then the *) +(* peak *) +(* term (m=0) is < 2^{-9}gam <= gam/8 and every annulus (m=k+1) is < *) +(* 2^{2k-7} *) +(* gam, so int_S w_tau <= gam/4, contradiction. *) +(* ========================================================================= *) +let CWTILE_MASS_DICHOTOMY = prove + (`!tau S gam. real_measurable S /\ &0 <= gam /\ + gam / &4 < real_integral S (cw_tile tau) + ==> ?m. &2 zpow (&2 * &m - &9) * gam + <= &2 zpow (tile_k tau) * real_measure (S INTER tile_Idil tau m)`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `?m. &2 zpow (&2 * &m - &9) * gam + <= &2 zpow (tile_k tau) * real_measure (S INTER tile_Idil tau m)` + THENL + [ASM_REWRITE_TAC[]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o REWRITE_RULE[NOT_EXISTS_THM; REAL_NOT_LE]) THEN + DISCH_TAC THEN + SUBGOAL_THEN `real_integral S (cw_tile tau) <= gam / &4` MP_TAC THENL + [MATCH_MP_TAC CWTILE_MASS_SMALL THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [(* peak: 2^{k_tau} mu(S cap I^0) <= gam/8 *) + FIRST_X_ASSUM(MP_TAC o SPEC `0`) THEN + SUBGOAL_THEN `&2 * &0 - &9 = --(&9):int` SUBST1_TAC THENL + [INT_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `t <= gam/ &8 ==> a < t ==> a <= gam/ &8`) THEN + ONCE_REWRITE_TAC[REAL_ARITH `&2 zpow (--(&9)) * gam = gam * &2 zpow + (--(&9))`] THEN + GEN_REWRITE_TAC RAND_CONV [REAL_ARITH `gam / &8 = gam * (&1 / &8)`] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[REAL_ZPOW_NEG; REAL_ZPOW_NUM] THEN + CONV_TAC REAL_RAT_REDUCE_CONV; + (* annulus: !k. 2^{k_tau} mu(S cap I^(k+1)) <= 2^{2k-7} gam *) + X_GEN_TAC `k:num` THEN + FIRST_X_ASSUM(MP_TAC o SPEC `k + 1`) THEN + MATCH_MP_TAC(REAL_ARITH `t = u ==> a < t ==> a <= u`) THEN + AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[GSYM INT_OF_NUM_ADD] THEN INT_ARITH_TAC]; + ASM_REAL_ARITH_TAC]);; + + +(* ========================================================================= *) +(* Helpers for 286J(c): a finite int-image set is bounded above; hence a *) +(* finite nonempty family has a scale-maximal member. *) +(* ========================================================================= *) +(* ========================================================================= *) +(* Integer order theory: a non-empty integer predicate bounded above has a *) +(* MAXIMAL element. (INT_WOP applied to y |-> P(b - y): the least such y >= *) +(* 0 *) +(* gives the greatest b - y.) Needed for 286K a-i: on each achievable tree *) +(* value the root scales k_tau are bounded above (TREE_KBOUND), so a *) +(* maximal- *) +(* scale representative exists. *) +(* ========================================================================= *) +let INT_HAS_MAX = prove + (`!P b:int. (?x. P x) /\ (!x. P x ==> x <= b) + ==> ?m. P m /\ (!x. P x ==> x <= m)`, + REPEAT STRIP_TAC THEN + MP_TAC(INST [`\y:int. P(b - y):bool`,`P:int->bool`] INT_WOP) THEN + REWRITE_TAC[] THEN + SUBGOAL_THEN `?z:int. &0 <= z /\ P(b - z)` (fun th -> REWRITE_TAC[th]) THENL + [EXISTS_TAC `b - x:int` THEN + SUBGOAL_THEN `x:int <= b` ASSUME_TAC THENL [ASM_SIMP_TAC[]; ALL_TAC] THEN + ASM_SIMP_TAC[INT_ARITH `b - (b - x):int = x`] THEN + ASM_INT_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `y0:int` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `b - y0:int` THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `z:int` THEN DISCH_TAC THEN + SUBGOAL_THEN `z:int <= b` ASSUME_TAC THENL [ASM_SIMP_TAC[]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `b - z:int`) THEN + ASM_SIMP_TAC[INT_ARITH `b - (b - z):int = z`] THEN ASM_INT_ARITH_TAC);; + +let INT_FINITE_BOUNDED = prove + (`!S:int->bool. FINITE S ==> ?b. !x. x IN S ==> x <= b`, + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN CONJ_TAC THENL + [EXISTS_TAC `&0:int` THEN REWRITE_TAC[NOT_IN_EMPTY]; + REPEAT STRIP_TAC THEN EXISTS_TAC `if b:int < x then x else b` THEN + REWRITE_TAC[IN_INSERT] THEN X_GEN_TAC `y:int` THEN STRIP_TAC THENL + [ASM_REWRITE_TAC[] THEN COND_CASES_TAC THEN ASM_INT_ARITH_TAC; + FIRST_X_ASSUM(MP_TAC o SPEC `y:int`) THEN ASM_REWRITE_TAC[] THEN + COND_CASES_TAC THEN ASM_INT_ARITH_TAC]]);; + +let SCALE_MAX_ELEMENT = prove + (`!(sc:A->int) S. FINITE S /\ ~(S = {}) + ==> ?m. m IN S /\ (!t. t IN S ==> sc t <= sc m)`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(X_CHOOSE_TAC `a:A` o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) + THEN + MP_TAC(ISPEC `IMAGE (sc:A->int) S` INT_FINITE_BOUNDED) THEN + ASM_SIMP_TAC[FINITE_IMAGE] THEN + DISCH_THEN(X_CHOOSE_TAC `b:int`) THEN + MP_TAC(ISPECL [`\y:int. y IN IMAGE (sc:A->int) S`; `b:int`] INT_HAS_MAX) THEN + BETA_TAC THEN ANTS_TAC THENL + [CONJ_TAC THENL + [REWRITE_TAC[IN_IMAGE] THEN + EXISTS_TAC `sc(a:A):int` THEN EXISTS_TAC `a:A` THEN ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `M:int` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `m:A` STRIP_ASSUME_TAC o + GEN_REWRITE_RULE I [IN_IMAGE]) THEN + EXISTS_TAC `m:A` THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `t:A` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `sc(t:A):int`) THEN + REWRITE_TAC[IN_IMAGE] THEN + ANTS_TAC THENL [EXISTS_TAC `t:A` THEN + ASM_REWRITE_TAC[]; ASM_INT_ARITH_TAC]);; + +(* ========================================================================= *) +(* GREEDY CAPTURE (Fremlin 286J(c) q-map, abstract). Given a finite S, a *) +(* SYMMETRIC "meet" relation mt, and a scale sc, there is a subfamily M of S *) +(* that is pairwise NON-meeting, together with a capture map q : S -> M such *) +(* that every s in S meets its root q s, and sc(q s) >= sc s (the root is at *) +(* least as coarse). This is Fremlin's q with M = {q j : j <= n} = the *) +(* roots. *) +(* Proof: strong induction on CARD S. Pick a scale-MAXIMAL m in S *) +(* (coarsest); *) +(* it becomes a root. Split S into A = { s : s meets m } (captured by m) and *) +(* B = S \ A (never meets m). Recurse on B (smaller: m in A so B PSUBSET S) *) +(* to get MB pairwise-non-meeting + qB. Set M = m INSERT MB, and q s = m if *) +(* s in A else qB s. Pairwise-non-meeting: MB members don't meet (IH); m *) +(* does *) +(* not meet any MB member (MB SUBSET B, and B members don't meet m). *) +(* Coarseness: *) +(* for s in A, sc(q s) = sc m >= sc s by maximality; for s in B, IH. *) +(* ========================================================================= *) +let GREEDY_CAPTURE_N = prove + (`!n (mt:A->A->bool) (sc:A->int) S. + CARD S = n /\ FINITE S /\ (!a b. mt a b ==> mt b a) /\ (!a. mt a a) + ==> ?M q. M SUBSET S /\ + (!s. s IN S ==> q s IN M) /\ + (!m. m IN M ==> m IN S) /\ + (!s. s IN S ==> mt s (q s) /\ sc s <= sc(q s)) /\ + (!m1 m2. m1 IN M /\ m2 IN M /\ ~(m1 = m2) ==> ~mt m1 m2)`, + MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + MAP_EVERY X_GEN_TAC [`mt:A->A->bool`; `sc:A->int`; `S:A->bool`] THEN + STRIP_TAC THEN + ASM_CASES_TAC `S:A->bool = {}` THENL + [EXISTS_TAC `{}:A->bool` THEN EXISTS_TAC `(\s:A. s):A->A` THEN + ASM_REWRITE_TAC[NOT_IN_EMPTY; EMPTY_SUBSET]; + ALL_TAC] THEN + MP_TAC(ISPECL [`sc:A->int`; `S:A->bool`] SCALE_MAX_ELEMENT) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `m:A` STRIP_ASSUME_TAC) THEN + ABBREV_TAC `B = {s:A | s IN S /\ ~(mt:A->A->bool) s m}` THEN + SUBGOAL_THEN `FINITE(B:A->bool)` ASSUME_TAC THENL + [EXPAND_TAC "B" THEN MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `S:A->bool` THEN ASM_REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN + MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `~((m:A) IN B)` ASSUME_TAC THENL + [EXPAND_TAC "B" THEN REWRITE_TAC[IN_ELIM_THM] THEN + ASM_MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `(B:A->bool) SUBSET S` ASSUME_TAC THENL + [EXPAND_TAC "B" THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN + MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `CARD(B:A->bool) < n` ASSUME_TAC THENL + [EXPAND_TAC "n" THEN MATCH_MP_TAC CARD_PSUBSET THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[PSUBSET] THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[]; ASM_MESON_TAC[]]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `CARD(B:A->bool)`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPECL [`mt:A->A->bool`; `sc:A->int`; `B:A->bool`]) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `MB:A->bool` + (X_CHOOSE_THEN `qB:A->A` STRIP_ASSUME_TAC)) THEN + EXISTS_TAC `(m:A) INSERT MB` THEN + EXISTS_TAC `\s:A. if (mt:A->A->bool) s m then m else (qB:A->A) s` THEN + REWRITE_TAC[IN_INSERT] THEN REPEAT CONJ_TAC THENL + [(* M SUBSET S *) + REWRITE_TAC[SUBSET; IN_INSERT] THEN X_GEN_TAC `x:A` THEN STRIP_TAC THENL + [ASM_REWRITE_TAC[]; ASM_MESON_TAC[SUBSET]]; + (* q s IN M *) + X_GEN_TAC `s:A` THEN DISCH_TAC THEN COND_CASES_TAC THENL + [REWRITE_TAC[]; DISJ2_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + EXPAND_TAC "B" THEN ASM_REWRITE_TAC[IN_ELIM_THM]]; + (* m IN M ==> m IN S *) + X_GEN_TAC `x:A` THEN STRIP_TAC THENL + [ASM_REWRITE_TAC[]; ASM_MESON_TAC[SUBSET]]; + (* mt s (q s) /\ sc s <= sc(q s) *) + X_GEN_TAC `s:A` THEN DISCH_TAC THEN COND_CASES_TAC THENL + [ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[]; + SUBGOAL_THEN `(s:A) IN B` ASSUME_TAC THENL + [EXPAND_TAC "B" THEN ASM_REWRITE_TAC[IN_ELIM_THM]; ALL_TAC] THEN + ASM_SIMP_TAC[]]; + (* pairwise non-meeting: m does not meet any MB member (MB SUBSET B, B *) + (* members don't meet m, mt symmetric); MB members pairwise don't (IH). *) + SUBGOAL_THEN `!x:A. x IN MB ==> ~(mt:A->A->bool) m x` ASSUME_TAC THENL + [X_GEN_TAC `x:A` THEN DISCH_TAC THEN + SUBGOAL_THEN `(x:A) IN B` ASSUME_TAC THENL + [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN + UNDISCH_TAC `(x:A) IN B` THEN EXPAND_TAC "B" THEN + REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN + ASM_MESON_TAC[]; ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`m1:A`; `m2:A`] THEN STRIP_TAC THEN + ASM_MESON_TAC[]]);; + +(* Corollary: drop the CARD parameter (Fremlin's q-map on a finite family). *) +let GREEDY_CAPTURE = prove + (`!(mt:A->A->bool) (sc:A->int) S. + FINITE S /\ (!a b. mt a b ==> mt b a) /\ (!a. mt a a) + ==> ?M q. M SUBSET S /\ + (!s. s IN S ==> q s IN M) /\ + (!m. m IN M ==> m IN S) /\ + (!s. s IN S ==> mt s (q s) /\ sc s <= sc(q s)) /\ + (!m1 m2. m1 IN M /\ m2 IN M /\ ~(m1 = m2) ==> ~mt m1 m2)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`CARD(S:A->bool)`; `mt:A->A->bool`; `sc:A->int`; `S:A->bool`] + GREEDY_CAPTURE_N) THEN + ASM_REWRITE_TAC[]);; + + +(* ========================================================================= *) +(* 286J(c) geometry. Two facts feeding the Vitali q-map measure bound *) +(* (Fremlin mt286.tex 915-934). *) +(* ========================================================================= *) + +(* base-2 zpow is additive (unconditional; the general REAL_ZPOW_ADD carries *) +(* a ~(x=&0) side condition). *) +let ZPOW2_ADD = prove + (`!a b:int. &2 zpow a * &2 zpow b = &2 zpow (a + b)`, + SIMP_TAC[GSYM REAL_ZPOW_ADD; REAL_OF_NUM_EQ; ARITH_EQ]);; + +(* Fremlin's I^(k)_{tau_l} SUBSET I^(k+2)_{tau_{q(l)}} (line 915): if the *) +(* two k-dilates MEET and t is at least as coarse as s (tile_k t <= tile_k *) +(* s, so I^(k)_t is at least as wide), then I^(k)_s sits inside the *) +(* 4x-widened I^(k+2)_t. Half-widths h_s = 2^(k-k_s-1) <= h_t = 2^(k-k_t-1); *) +(* for y in I^(k)_s and a meet-point p, |y-x_t| <= |y-x_s|+|x_s-p|+|p-x_t| < *) +(* 2 h_s + h_t <= 3 h_t < 4 h_t = half-width of I^(k+2)_t. *) +let RK_GAMMUI_BRIDGE = prove + (`!ktau (k:num) gam M. + &2 zpow (&2 * &k - &9) * gam <= &2 zpow ktau * M + ==> gam * &2 zpow (--ktau) <= &2 zpow (&9 - &2 * &k) * M`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`&2 zpow (--ktau) * &2 zpow (&9 - &2 * &k)`; + `&2 zpow (&2 * &k - &9) * gam`; + `&2 zpow ktau * M`] REAL_LE_LMUL) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THEN + MATCH_MP_TAC REAL_ZPOW_LE THEN REAL_ARITH_TAC; + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN + `(&2 zpow (--ktau) * &2 zpow (&9 - &2 * &k)) * &2 zpow (&2 * &k - &9) * gam + = + gam * &2 zpow (--ktau) /\ + (&2 zpow (--ktau) * &2 zpow (&9 - &2 * &k)) * &2 zpow ktau * M = + &2 zpow (&9 - &2 * &k) * M` + (fun th -> REWRITE_TAC[th]) THEN + CONJ_TAC THENL + [ONCE_REWRITE_TAC[REAL_ARITH `(a * b) * c * gam = gam * (a * (b * c)):real`] + THEN + REWRITE_TAC[ZPOW2_ADD] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + INT_ARITH_TAC; + ONCE_REWRITE_TAC[REAL_ARITH `(a * b) * c * M = b * (a * c) * M:real`] THEN + REWRITE_TAC[ZPOW2_ADD] THEN + SUBGOAL_THEN `--ktau + ktau = &0:int` SUBST1_TAC THENL + [INT_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_ZPOW_0; REAL_MUL_LID]]);; + + +(* ========================================================================= *) +(* 286J(c) measure bricks. *) +(* ========================================================================= *) + +(* Sum of measures of a pairwise-disjoint finite family of measurable *) +(* subsets of a measurable E is at most muE (mu(UNIONS)=sum via *) +(* DISJOINT_UNIONS_IMAGE, UNIONS SUBSET E monotone). *) +let SUM_MEASURE_DISJOINT_LE = prove + (`!(f:A->real->bool) S E. + FINITE S /\ real_measurable E /\ + (!x. x IN S ==> real_measurable (f x) /\ (f x) SUBSET E) /\ + (!x y. x IN S /\ y IN S /\ ~(x = y) ==> DISJOINT (f x) (f y)) + ==> sum S (\x. real_measure (f x)) <= real_measure E`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:A->real->bool`; `S:A->bool`] + REAL_MEASURE_DISJOINT_UNIONS_IMAGE) THEN + ASM_SIMP_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC REAL_MEASURE_SUBSET THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC REAL_MEASURABLE_UNIONS THEN + ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE]; + ASM_REWRITE_TAC[]; + REWRITE_TAC[UNIONS_SUBSET; FORALL_IN_IMAGE] THEN ASM_SIMP_TAC[]]);; + + + +(* ========================================================================= *) +(* 286J(c) ABSTRACT per-k bound (Fremlin mt286.tex 927-934). Given the *) +(* greedy *) +(* capture data -- roots M SUBSET Rk, capture map q:Rk->M -- and the *) +(* geometric *) +(* + measure facts (each I_t inside the coarse container Ione4(q t); the I_t *) +(* pairwise disjoint; each container measure = 2^{k+2} muI_m; the R_k *) +(* threshold *) +(* gam muI_m <= 2^{9-2k} muS_m; the S_m pairwise disjoint subsets of E), we *) +(* get *) +(* gam * sum_{Rk} muI <= 2^{11-k} muE. *) +(* Chain: regroup sum_{Rk} muI = sum_{M} sum_{fiber} muI [SUM_GROUP]; per *) +(* fiber *) +(* <= muIone4(q=m) = 2^{k+2} muI_m [SUM_MEASURE_DISJOINT_LE]; so gam*sum <= *) +(* 2^{k+2} sum_M gam muI_m <= 2^{k+2} 2^{9-2k} sum_M muS_m <= *) +(* 2^{k+2}2^{9-2k}muE. *) +(* ========================================================================= *) +let CARLESON_RK_MEASURE_ABSTRACT = prove + (`!(Rk:A->bool) (M:A->bool) (q:A->A) (Ione:A->real->bool) + (Ione4:A->real->bool) + (Sset:A->real->bool) (muI:A->real) (k:num) gam E. + FINITE Rk /\ real_measurable E /\ &0 <= gam /\ + (!t. t IN Rk ==> q t IN M) /\ M SUBSET Rk /\ + (!t. t IN Rk ==> Ione t SUBSET Ione4 (q t)) /\ + (!t1 t2. t1 IN Rk /\ t2 IN Rk /\ q t1 = q t2 /\ ~(t1 = t2) + ==> DISJOINT (Ione t1) (Ione t2)) /\ + (!t. t IN Rk ==> real_measurable (Ione t) /\ real_measure(Ione t) = muI t) + /\ + (!m. m IN M ==> real_measurable(Ione4 m) /\ + real_measure(Ione4 m) = &2 zpow (&k + &2) * muI m) /\ + (!m. m IN M ==> gam * muI m <= &2 zpow (&9 - &2 * &k) * real_measure(Sset + m)) /\ + (!m. m IN M ==> real_measurable(Sset m) /\ Sset m SUBSET E) /\ + (!m1 m2. m1 IN M /\ m2 IN M /\ ~(m1 = m2) ==> DISJOINT (Sset m1) (Sset + m2)) + ==> gam * sum Rk muI <= &2 zpow (&11 - &k) * real_measure E`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`q:A->A`; `muI:A->real`; `Rk:A->bool`; + `M:A->bool`] SUM_GROUP) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + ASM_SIMP_TAC[]; + ALL_TAC] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + (* per-fiber: sum {t | q t = m} muI <= 2^{k+2} muI m *) + SUBGOAL_THEN + `!m:A. m IN M ==> sum {x:A | x IN Rk /\ q x = m} muI + <= &2 zpow (&k + &2) * muI m` + ASSUME_TAC THENL + [X_GEN_TAC `m:A` THEN DISCH_TAC THEN + SUBGOAL_THEN `real_measure(Ione4(m:A)) = &2 zpow (&k + &2) * muI m` + (SUBST1_TAC o SYM) THENL [ASM_SIMP_TAC[]; ALL_TAC] THEN + (* first: the measure-form fiber bound (matches SUM_MEASURE_DISJOINT_LE) *) + SUBGOAL_THEN + `sum {x:A | x IN Rk /\ q x = m} (\x. real_measure(Ione x:real->bool)) + <= real_measure(Ione4(m:A))` + MP_TAC THENL + [MATCH_MP_TAC SUM_MEASURE_DISJOINT_LE THEN + ASM_SIMP_TAC[FINITE_RESTRICT] THEN CONJ_TAC THENL + [X_GEN_TAC `t:A` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN + CONJ_TAC THENL + [ASM_SIMP_TAC[]; + FIRST_X_ASSUM(SUBST1_TAC o SYM o + check(fun th -> is_eq(concl th) && + rand(concl th) = `m:A`)) THEN + FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]; + MAP_EVERY X_GEN_TAC [`t1:A`; `t2:A`] THEN REWRITE_TAC[IN_ELIM_THM] THEN + STRIP_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[]]; + ALL_TAC] THEN + (* convert the summand muI -> real_measure o Ione via SUM_EQ *) + MATCH_MP_TAC(REAL_ARITH `s = s2 ==> s2 <= b ==> s <= b`) THEN + MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `t:A` THEN + REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN ASM_SIMP_TAC[]; + ALL_TAC] THEN + (* gam * sum_M fiber <= gam * sum_M 2^{k+2} muI m *) + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `gam * sum M (\m:A. &2 zpow (&k + &2) * muI m)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC SUM_LE THEN CONJ_TAC THENL + [MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `Rk:A->bool` THEN + ASM_REWRITE_TAC[]; ASM_SIMP_TAC[]]; + ALL_TAC] THEN + (* regroup gam * sum_M 2^{k+2} muI = 2^{k+2} * (gam * sum_M muI) *) + REWRITE_TAC[SUM_LMUL] THEN + (* key: gam * sum_M muI <= 2^{9-2k} muE *) + SUBGOAL_THEN + `gam * sum M (muI:A->real) <= &2 zpow (&9 - &2 * &k) * real_measure E` + ASSUME_TAC THENL + [REWRITE_TAC[GSYM SUM_LMUL] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum M (\m:A. &2 zpow (&9 - &2 * &k) * real_measure(Sset m))` + THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE THEN CONJ_TAC THENL + [MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `Rk:A->bool` THEN + ASM_REWRITE_TAC[]; ASM_SIMP_TAC[]]; + REWRITE_TAC[SUM_LMUL] THEN MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LE THEN REAL_ARITH_TAC; + MATCH_MP_TAC SUM_MEASURE_DISJOINT_LE THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `Rk:A->bool` THEN + ASM_REWRITE_TAC[]]]; + ALL_TAC] THEN + (* gam * 2^{k+2} * sum muI = 2^{k+2} * (gam * sum muI) <= 2^{k+2} 2^{9-2k} *) + (* muE *) + SUBGOAL_THEN `gam * &2 zpow (&k + &2) * sum M (muI:A->real) = + &2 zpow (&k + &2) * (gam * sum M muI)` SUBST1_TAC THENL + [REWRITE_TAC[REAL_MUL_AC]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&2 zpow (&k + &2) * (&2 zpow (&9 - &2 * &k) * real_measure E)` + THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LE THEN REAL_ARITH_TAC; ASM_REWRITE_TAC[]]; + REWRITE_TAC[REAL_MUL_ASSOC; ZPOW2_ADD] THEN + MATCH_MP_TAC REAL_EQ_IMP_LE THEN AP_THM_TAC THEN AP_TERM_TAC THEN + AP_TERM_TAC THEN INT_ARITH_TAC]);; + + +(* ========================================================================= *) +(* 286J(c) base-interval containment (Fremlin mt286.tex 915-916), valid for *) +(* ALL k >= 0 (Fremlin's R_k has k in N, so the m=0 / R_0 case must be *) +(* covered *) +(* -- TILE_I_SUBSET_IDIL needs k >= 1, so we prove the composed containment *) +(* I_t SUBSET I^(k+2)_r directly from the level-k meet, using the base *) +(* band). *) +(* ========================================================================= *) + +(* y in the base cell I_t is within half its width of the centre x_t. *) +let TILE_I_BAND = prove + (`!(a:int) (b:int) (c:int) y. + y IN tile_I(a,b,c) ==> abs(y - tile_xmid(a,b,c)) <= &2 zpow (--a - &1)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[tile_I; tile_xmid; dyho; dyho_mid; IN_ELIM_THM] THEN + STRIP_TAC THEN + SUBGOAL_THEN `&2 zpow (--a) = &2 zpow (--a - &1) * &2` ASSUME_TAC THENL + [SIMP_TAC[REAL_ZPOW_SUB; REAL_OF_NUM_EQ; ARITH_EQ; REAL_ZPOW_1] THEN + CONV_TAC REAL_FIELD; ALL_TAC] THEN + ABBREV_TAC `P = &2 zpow (--a)` THEN ABBREV_TAC `H = &2 zpow (--a - &1)` THEN + SUBGOAL_THEN + `(real_of_int b + &1 / &2) * P = real_of_int b * P + H` SUBST1_TAC THENL + [ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; ALL_TAC] THEN + ASM_REAL_ARITH_TAC);; + +(* tile-form of the band (t as an abstract tile). *) +let TILE_I_BAND_TILE = prove + (`!(t:int#int#int) y. + y IN tile_I t ==> abs(y - tile_xmid t) <= &2 zpow (--(tile_k t) - &1)`, + MATCH_MP_TAC(MESON[PAIR_SURJECTIVE] + `(!a b c. P((a,b,c):int#int#int)) ==> (!s. P s)`) THEN + REWRITE_TAC[tile_k; TILE_I_BAND]);; + +(* Base containment for ALL k: level-k meet + coarser root r => I_t SUBSET *) +(* I^(k+2)_r. half-widths: base of I_t is 2^{-k_t-1} <= 2^{k-k_t-1} (the *) +(* level-k *) +(* half-width, k>=0); the meet + coarser gives centres within 2h_r; target *) +(* 2^{k+2-k_r-1}=4 h_r absorbs 2h_t + h_r <= 3 h_r. *) +let TILE_I_SUBSET_IDIL4_ALLK = prove + (`!(t:int#int#int) (r:int#int#int) k. + tile_k r <= tile_k t /\ ~(tile_Idil t k INTER tile_Idil r k = {}) + ==> tile_I t SUBSET tile_Idil r (k + 2)`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [GSYM MEMBER_NOT_EMPTY]) THEN + REWRITE_TAC[IN_INTER; tile_Idil; IN_ELIM_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `p:real` STRIP_ASSUME_TAC) THEN + REWRITE_TAC[SUBSET] THEN X_GEN_TAC `y:real` THEN DISCH_TAC THEN + REWRITE_TAC[tile_Idil; IN_ELIM_THM] THEN + (* base band on y: |y - x_t| <= 2^{-k_t-1} *) + SUBGOAL_THEN + `abs(y - tile_xmid t) <= &2 zpow (--(tile_k t) - &1)` MP_TAC THENL + [ASM_SIMP_TAC[TILE_I_BAND_TILE]; ALL_TAC] THEN + DISCH_TAC THEN + (* half-width facts: 2^{-k_t-1} <= 2^{k-k_t-1}, 2^{k-k_t-1} <= 2^{k-k_r-1} *) + SUBGOAL_THEN `&2 zpow (--(tile_k t) - &1) <= &2 zpow (&k - tile_k t - &1)` + ASSUME_TAC THENL + [MATCH_MP_TAC ZPOW2_MONOE THEN INT_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `&2 zpow (&k - tile_k t - &1) <= &2 zpow (&k - tile_k r - &1)` + ASSUME_TAC THENL + [MATCH_MP_TAC ZPOW2_MONOE THEN ASM_INT_ARITH_TAC; ALL_TAC] THEN + (* target half-width = 4 * 2^{k-k_r-1} *) + SUBGOAL_THEN `&2 zpow (&(k + 2) - tile_k r - &1) = + &4 * &2 zpow (&k - tile_k r - &1)` + SUBST1_TAC THENL + [REWRITE_TAC[GSYM INT_OF_NUM_ADD] THEN + SUBGOAL_THEN `(&k + &2) - tile_k r - &1 = (&k - tile_k r - &1) + &2:int` + SUBST1_TAC THENL [INT_ARITH_TAC; ALL_TAC] THEN + SIMP_TAC[REAL_ZPOW_ADD; REAL_OF_NUM_EQ; ARITH_EQ] THEN + REWRITE_TAC[REAL_ZPOW_NUM] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_REAL_ARITH_TAC);; + +let CWTILE_SQ_INTEGRABLE_MEASURABLE = prove + (`!s Sc. real_measurable Sc ==> (\x. (cw_tile s x) pow 2) real_integrable_on + Sc`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN + EXISTS_TAC `(\x. (&2 zpow tile_k s) pow 2):real->real` THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC REAL_MEASURABLE_ON_MEASURABLE_SUBSET THEN + EXISTS_TAC `(:real)` THEN ASM_REWRITE_TAC[SUBSET_UNIV] THEN + MATCH_MP_TAC CONTINUOUS_IMP_REAL_MEASURABLE_ON THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_POW THEN + REWRITE_TAC[ETA_AX; CWTILE_CONTINUOUS]; + MATCH_MP_TAC REAL_INTEGRABLE_ON_CONST_MEASURABLE THEN ASM_REWRITE_TAC[]; + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[REAL_ABS_POW] THEN + MATCH_MP_TAC REAL_POW_LE2 THEN + MP_TAC(SPECL [`s:int#int#int`; `x:real`] CWTILE_BOUNDS) THEN + REAL_ARITH_TAC]);; + +let CWTILE_MIDPOINT_LOWER = prove + (`!(s:int#int#int) a b. a < b /\ (tile_xmid s <= a \/ b <= tile_xmid s) + ==> cw_tile s ((a + b) / &2) * (b - a) <= + real_integral (real_interval[a,b]) (cw_tile s)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC HERMITE_HADAMARD_LOWER THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; CWTILE_INTEGRABLE] THENL + [MATCH_MP_TAC CWTILE_CONVEX_RIGHT THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC CWTILE_CONVEX_LEFT THEN ASM_REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* 286G(e), analytic crux: the cross-tile weight correlation. *) +(* *) +(* When k_sigma <= k_tau, the whole-line correlation of the two tile weight *) +(* profiles is controlled by the larger (coarser) weight sampled at the *) +(* finer tile's centre: INT_R w_sigma w_tau <= 16 w_sigma(x_tau). *) +(* Via the change of variables u = 2^k_tau (x - x_tau), this reduces to the *) +(* convolution bound CW_CONVOLUTION_GEN with contraction alpha = 2^(k_s-k_t) *) +(* in (0,1] and offset beta = 2^k_s (x_tau - x_sigma). *) +(* ------------------------------------------------------------------------- *) + +let SCALE_INV_ID = prove + (`!ks kt iI. ~(kt = &0) ==> (ks * kt) * (inv kt * iI) = ks * iI`, + REPEAT STRIP_TAC THEN + MP_TAC(SPEC `kt:real` REAL_MUL_RINV) THEN ASM_REWRITE_TAC[] THEN + CONV_TAC REAL_RING);; +let CW_CROSS_ABSTRACT = prove + (`!ks kt xs xt. + &0 < ks /\ &0 < kt /\ ks <= kt + ==> real_integral (:real) + (\x. (ks * cw(ks * (x - xs))) * (kt * cw(kt * (x - xt)))) + <= &16 * (ks * cw(ks * (xt - xs)))`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`ks * inv kt:real`; + `ks * (xt - xs):real`] CW_CONVOLUTION_GEN) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[REAL_LT_INV_EQ]; + SUBGOAL_THEN `ks * inv kt <= kt * inv kt` MP_TAC THENL + [MATCH_MP_TAC REAL_LE_RMUL THEN + ASM_SIMP_TAC[REAL_LE_INV_EQ; REAL_LT_IMP_LE]; + ASM_SIMP_TAC[REAL_MUL_RINV; REAL_LT_IMP_NZ]]]; + DISCH_TAC] THEN + ABBREV_TAC `iI = real_integral (:real) + (\x. cw x * cw((ks * inv kt) * x + ks * (xt - xs)))` THEN + SUBGOAL_THEN + `((\x. cw x * cw((ks * inv kt) * x + ks * (xt - xs))) has_real_integral iI) + (:real)` + ASSUME_TAC THENL + [EXPAND_TAC "iI" THEN + MATCH_MP_TAC REAL_INTEGRABLE_INTEGRAL THEN REWRITE_TAC[CW_PROD_INTEGRABLE]; + ALL_TAC] THEN + SUBGOAL_THEN + `((\x. cw(kt * (x - xt)) * cw(ks * (x - xs))) has_real_integral (inv kt * + iI)) (:real)` + ASSUME_TAC THENL + [SUBGOAL_THEN + `(\x. (\y:real. cw y * cw((ks * inv kt) * y + ks * (xt - xs))) + (kt * x + --(kt * xt))) + = (\x. cw(kt * (x - xt)) * cw(ks * (x - xs)))` + (fun th -> SUBST1_TAC(SYM th)) THENL + [REWRITE_TAC[FUN_EQ_THM] THEN BETA_TAC THEN X_GEN_TAC `x:real` THEN + BINOP_TAC THENL + [AP_TERM_TAC THEN REAL_ARITH_TAC; + AP_TERM_TAC THEN MAP_EVERY UNDISCH_TAC [`&0 < kt`] THEN + CONV_TAC REAL_FIELD]; + ALL_TAC] THEN + SUBGOAL_THEN `inv kt * iI = inv(abs kt) * iI` SUBST1_TAC THENL + [ASM_SIMP_TAC[REAL_ARITH `&0 < kt ==> abs kt = kt`]; ALL_TAC] THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_AFFINITY_UNIV THEN + ASM_SIMP_TAC[REAL_LT_IMP_NZ]; + ALL_TAC] THEN + SUBGOAL_THEN + `real_integral (:real) + (\x. (ks * cw(ks * (x - xs))) * (kt * cw(kt * (x - xt)))) + = (ks * kt) * (inv kt * iI)` SUBST1_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + SUBGOAL_THEN + `(\x. (ks * cw(ks * (x - xs))) * (kt * cw(kt * (x - xt)))) + = (\x. (ks * kt) * (cw(kt * (x - xt)) * cw(ks * (x - xs))))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_LMUL THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + ASM_SIMP_TAC[SCALE_INV_ID; REAL_LT_IMP_NZ] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `ks * &16 * cw (ks * (xt - xs))` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE]; + REAL_ARITH_TAC]);; + +let CWTILE_CROSS = prove + (`!(s:int#int#int) (t:int#int#int). + tile_k s <= tile_k t + ==> real_integral (:real) (\x. cw_tile s x * cw_tile t x) + <= &16 * cw_tile s (tile_xmid t)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[cw_tile] THEN + MP_TAC(SPECL + [`&2 zpow tile_k s`; `&2 zpow tile_k t`; + `tile_xmid s`; `tile_xmid t`] CW_CROSS_ABSTRACT) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; + MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; + MATCH_MP_TAC ZPOW2_MONOE THEN ASM_REWRITE_TAC[]]; + REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* 286G(e), the inner-product form: the cross-tile CORRELATION of the tile *) +(* test functions. This is the analytic keystone 286I/286J/286L all rest on. *) +(* *) +(* |(phi_sigma | phi_tau)| <= C 2^(-k_s/2) 2^(-k_t/2) w_sigma(x_tau) *) +(* (when k_s <= k_t). *) +(* *) +(* Route: norm(INT phi_s cnj phi_t) <= INT norm(phi_s) norm(phi_t) *) +(* (INTEGRAL_NORM_BOUND_INTEGRAL) <= C1^2 2^(-k_s/2) 2^(-k_t/2) INT w_s w_t *) +(* (PHISIG_CW pointwise, twice) <= C1^2 2^(-k_s/2) 2^(-k_t/2) 16 w_s(x_t) *) +(* (CWTILE_CROSS). The 2^(k_t/2) INT_{I_t} w_s form Fremlin states then *) +(* follows at the mass/energy stage via CWTILE_MIDPOINT_LOWER (286G b). *) +(* ------------------------------------------------------------------------- *) + +(* phi_sigma of the concrete base test function is Schwartz. *) +let PHISIG_CARLESON_SCHWARTZ = prove + (`!(s:int#int#int). schwartz (phi_sigma s carleson_phi)`, + GEN_TAC THEN MATCH_MP_TAC PHISIG_SCHWARTZ THEN + REWRITE_TAC[CARLESON_PHI_SCHWARTZ]);; + +(* The phi_sigma Sc-conditions (i, iv) of CARLESON_ALPHA_SCALE. phi_sigma s *) +(* carleson_phi is Schwartz (PHISIG_CARLESON_SCHWARTZ), hence continuous and *) +(* bounded *) +(* (SCHWARTZ_CONT / SCHWARTZ_BOUNDED); so norm(phi_sigma) is *) +(* real-integrable, and *) +(* phi_sigma itself is absolutely integrable, on any real-measurable Sc. *) +(* Same *) +(* bounded-measurable route as cw_tile (must come AFTER *) +(* PHISIG_CARLESON_SCHWARTZ). *) +let PHISIG_NORM_INTEGRABLE_MEASURABLE = prove + (`!s Sc. real_measurable Sc + ==> (\x. norm(phi_sigma s carleson_phi x)) real_integrable_on Sc`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `phi_sigma s carleson_phi` SCHWARTZ_BOUNDED) THEN + REWRITE_TAC[PHISIG_CARLESON_SCHWARTZ] THEN + DISCH_THEN(X_CHOOSE_TAC `B:real`) THEN + MATCH_MP_TAC REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN + EXISTS_TAC `(\x. B):real->real` THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC REAL_MEASURABLE_ON_MEASURABLE_SUBSET THEN + EXISTS_TAC `(:real)` THEN ASM_REWRITE_TAC[SUBSET_UNIV] THEN + MATCH_MP_TAC CONTINUOUS_IMP_REAL_MEASURABLE_ON THEN + REWRITE_TAC[IMAGE_LIFT_UNIV; REAL_CONTINUOUS_ON; o_DEF] THEN + REWRITE_TAC[IMAGE_LIFT_UNIV] THEN + MATCH_MP_TAC CONTINUOUS_ON_LIFT_NORM_COMPOSE THEN + MP_TAC(ISPEC `phi_sigma s carleson_phi` SCHWARTZ_CONT) THEN + REWRITE_TAC[PHISIG_CARLESON_SCHWARTZ]; + MATCH_MP_TAC REAL_INTEGRABLE_ON_CONST_MEASURABLE THEN ASM_REWRITE_TAC[]; + GEN_TAC THEN DISCH_TAC THEN ASM_SIMP_TAC[REAL_ABS_NORM]]);; + +let PHISIG_ABS_INTEGRABLE_MEASURABLE = prove + (`!s Sc. real_measurable Sc + ==> (\z. phi_sigma s carleson_phi (drop z)) absolutely_integrable_on + (IMAGE lift Sc)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `phi_sigma s carleson_phi` SCHWARTZ_BOUNDED) THEN + REWRITE_TAC[PHISIG_CARLESON_SCHWARTZ] THEN + DISCH_THEN(X_CHOOSE_TAC `B:real`) THEN + MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE THEN + EXISTS_TAC `(\z:real^1. lift B)` THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_ON_MEASURABLE_SUBSET THEN + EXISTS_TAC `(:real^1)` THEN + REWRITE_TAC[SUBSET_UNIV; GSYM REAL_MEASURABLE_MEASURABLE] THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC CONTINUOUS_IMP_MEASURABLE_ON THEN + MP_TAC(ISPEC `phi_sigma s carleson_phi` SCHWARTZ_CONT) THEN + REWRITE_TAC[PHISIG_CARLESON_SCHWARTZ]; + REWRITE_TAC[INTEGRABLE_ON_CONST] THEN DISJ2_TAC THEN + ASM_REWRITE_TAC[GSYM REAL_MEASURABLE_MEASURABLE]; + X_GEN_TAC `z:real^1` THEN DISCH_TAC THEN ASM_REWRITE_TAC[LIFT_DROP]]);; + +(* --- 286L Sc-domain MEASURABILITY (the last prerequisite for the Sc-conds) *) +(* --- *) + +(* The preimage h^-1[dyho k n] of a dyadic interval under a measurable h is *) +(* real-lebesgue-measurable. dyho k n = {y | c <= y < d}, so the preimage is *) +(* the *) +(* INTER of two halfspace preimages (h x >= c) and (h x < d). *) +let H_PREIMAGE_DYHO_LEBESGUE = prove + (`!(h:real->real) k n. h real_measurable_on (:real) + ==> real_lebesgue_measurable {x | h x IN dyho k n}`, + REPEAT STRIP_TAC THEN REWRITE_TAC[dyho; IN_ELIM_THM] THEN + SUBGOAL_THEN + `{x | real_of_int n * &2 zpow k <= (h:real->real) x /\ + h x < (real_of_int n + &1) * &2 zpow k} = + {x | (h:real->real) x >= real_of_int n * &2 zpow k} INTER + {x | (h:real->real) x < (real_of_int n + &1) * &2 zpow k}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM] THEN GEN_TAC THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LEBESGUE_MEASURABLE_INTER THEN + CONJ_TAC THEN FIRST_ASSUM MP_TAC THENL + [REWRITE_TAC[REAL_MEASURABLE_ON_PREIMAGE_HALFSPACE_GE] THEN + DISCH_THEN(ACCEPT_TAC o SPEC `real_of_int n * &2 zpow k`); + REWRITE_TAC[REAL_MEASURABLE_ON_PREIMAGE_HALFSPACE_LT] THEN + DISCH_THEN(ACCEPT_TAC o SPEC `(real_of_int n + &1) * &2 zpow k`)]);; + +(* THE Sc-domain measurability: Sc = {x | x IN E /\ h x IN tile_J s} INTER *) +(* dyho a p is real-measurable, given E real-lebesgue-measurable and h *) +(* real-measurable. Sc SUBSET dyho a p is bounded; Sc = E INTER h^-1[tile_J *) +(* s] INTER dyho a p is a triple INTER of lebesgue-measurable sets; bounded *) +(* + lebesgue => measurable. *) +let SC_MEASURABLE = prove + (`!(h:real->real) E s a p. + real_lebesgue_measurable E /\ h real_measurable_on (:real) + ==> real_measurable ({x | x IN E /\ h x IN tile_J s} INTER dyho a p)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `real_bounded ({x | x IN E /\ + (h:real->real) x IN tile_J s} INTER dyho a p)` + ASSUME_TAC THENL + [MATCH_MP_TAC REAL_BOUNDED_SUBSET THEN + EXISTS_TAC `real_interval[real_of_int p * &2 zpow a, + (real_of_int p + &1) * &2 zpow a]` THEN + REWRITE_TAC[REAL_BOUNDED_REAL_INTERVAL] THEN + REWRITE_TAC[SUBSET; IN_INTER; dyho; IN_ELIM_THM; IN_REAL_INTERVAL] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[GSYM REAL_LEBESGUE_MEASURABLE_IFF_MEASURABLE] THEN + SUBGOAL_THEN + `{x | x IN E /\ (h:real->real) x IN tile_J s} INTER dyho a p = + (E INTER {x | (h:real->real) x IN tile_J s}) INTER dyho a p` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM] THEN + MESON_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LEBESGUE_MEASURABLE_INTER THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LEBESGUE_MEASURABLE_INTER THEN ASM_REWRITE_TAC[] THEN + SPEC_TAC(`s:int#int#int`,`s:int#int#int`) THEN + REWRITE_TAC[FORALL_PAIR_THM; tile_J] THEN REPEAT GEN_TAC THEN + MATCH_MP_TAC H_PREIMAGE_DYHO_LEBESGUE THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_MEASURABLE_IMP_REAL_LEBESGUE_MEASURABLE THEN + REWRITE_TAC[DYHO_MEASURABLE]]);; + +(* General Sc-measurability with an arbitrary dyadic frequency interval dyho *) +(* kk nn *) +(* (the alpha_sK domain uses the RIGHT HALF tile_Jr, a dyho-cell -- *) +(* SC_MEASURABLE *) +(* above is stated for tile_J). Same bounded + triple-lebesgue-INTER route. *) +let SC_MEASURABLE_DYHO = prove + (`!(h:real->real) E kk nn a p. + real_lebesgue_measurable E /\ h real_measurable_on (:real) + ==> real_measurable ({x | x IN E /\ h x IN dyho kk nn} INTER dyho a p)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `real_bounded ({x | x IN E /\ + (h:real->real) x IN dyho kk nn} INTER dyho a p)` + ASSUME_TAC THENL + [MATCH_MP_TAC REAL_BOUNDED_SUBSET THEN + EXISTS_TAC `real_interval[real_of_int p * &2 zpow a, + (real_of_int p + &1) * &2 zpow a]` THEN + REWRITE_TAC[REAL_BOUNDED_REAL_INTERVAL] THEN + REWRITE_TAC[SUBSET; IN_INTER; dyho; IN_ELIM_THM; IN_REAL_INTERVAL] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[GSYM REAL_LEBESGUE_MEASURABLE_IFF_MEASURABLE] THEN + SUBGOAL_THEN + `{x | x IN E /\ (h:real->real) x IN dyho kk nn} INTER dyho a p = + (E INTER {x | (h:real->real) x IN dyho kk nn}) INTER dyho a p` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM] THEN + MESON_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LEBESGUE_MEASURABLE_INTER THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LEBESGUE_MEASURABLE_INTER THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC H_PREIMAGE_DYHO_LEBESGUE THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_MEASURABLE_IMP_REAL_LEBESGUE_MEASURABLE THEN + REWRITE_TAC[DYHO_MEASURABLE]]);; + +(* tile_Jr corollary: the right-half domain is measurable. *) +let SC_MEASURABLE_JR = prove + (`!(h:real->real) E s a p. + real_lebesgue_measurable E /\ h real_measurable_on (:real) + ==> real_measurable ({x | x IN E /\ h x IN tile_Jr s} INTER dyho a p)`, + REWRITE_TAC[FORALL_PAIR_THM; tile_Jr] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC SC_MEASURABLE_DYHO THEN ASM_REWRITE_TAC[]);; + +(* --- K1 (finite-cover reduction) foundational bricks --- *) +(* K1a: phi_sigma is absolutely integrable on the lift of ANY real-lebesgue- *) +(* measurable set (even unbounded / infinite-measure), since phi_sigma is *) +(* Schwartz hence L^1 on the whole line (SCHWARTZ_ABSINT) and a lebesgue- *) +(* measurable subset of an absolutely-integrable domain inherits it. This is *) +(* the *) +(* unbounded-region companion to PHISIG_ABS_INTEGRABLE_MEASURABLE (which *) +(* needs *) +(* FINITE measure). Needed so the full-region tile integral int_{E cap *) +(* h^-1[Jr]} *) +(* phi_s makes sense and admits the countable cover-decomposition. *) +let PHISIG_ABSINT_LEBESGUE = prove + (`!s Sc. real_lebesgue_measurable Sc + ==> (\z. phi_sigma s carleson_phi (drop z)) absolutely_integrable_on + (IMAGE lift Sc)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN + EXISTS_TAC `(:real^1)` THEN + REWRITE_TAC[SUBSET_UNIV] THEN CONJ_TAC THENL + [MATCH_MP_TAC SCHWARTZ_ABSINT THEN + REWRITE_TAC[ETA_AX; PHISIG_CARLESON_SCHWARTZ]; + ASM_REWRITE_TAC[GSYM REAL_LEBESGUE_MEASURABLE]]);; + +(* K1b: the full tile region {x | x IN E /\ h x IN tile_Jr s} is *) +(* real-lebesgue- measurable (E leb-meas INTER the h-preimage of the dyadic *) +(* cell tile_Jr). *) +let REGION_LEBESGUE = prove + (`!(E:real->bool) (h:real->real) s. + real_lebesgue_measurable E /\ h real_measurable_on (:real) + ==> real_lebesgue_measurable {x | x IN E /\ h x IN tile_Jr s}`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `s:int#int#int` PAIR_SURJECTIVE) THEN + DISCH_THEN(X_CHOOSE_THEN `k:int` (X_CHOOSE_THEN + `sn:int#int` SUBST1_TAC)) THEN + MP_TAC(ISPEC `sn:int#int` PAIR_SURJECTIVE) THEN + DISCH_THEN(X_CHOOSE_THEN `nI:int` (X_CHOOSE_THEN `nJ:int` SUBST1_TAC)) THEN + REWRITE_TAC[tile_Jr] THEN + SUBGOAL_THEN + `{x | x IN E /\ (h:real->real) x IN dyho (k - &1) (&2 * nJ + &1)} = + E INTER {x | h x IN dyho (k - &1) (&2 * nJ + &1)}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LEBESGUE_MEASURABLE_INTER THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC H_PREIMAGE_DYHO_LEBESGUE THEN ASM_REWRITE_TAC[]);; + +(* K1c: the cover-index set {(a,p) | in_kcover P a p} is COUNTABLE (a subset *) +(* of int#int), and the cover cells UNION to the whole line (covering, *) +(* KCOVER_EXISTS). These feed the countable cover-decomposition int_{region} *) +(* phi = lim of the finite partial covers (INTEGRAL_COUNTABLE_UNIONS_ALT) *) +(* used in K1's limit-passing. *) +let KCOVER_INDEX_COUNTABLE = prove + (`!P:(int#int#int)->bool. COUNTABLE {ap:int#int | in_kcover P (FST ap) (SND + ap)}`, + GEN_TAC THEN MATCH_MP_TAC COUNTABLE_SUBSET THEN + EXISTS_TAC `(:int#int)` THEN REWRITE_TAC[SUBSET_UNIV] THEN + REWRITE_TAC[GSYM CROSS_UNIV] THEN MATCH_MP_TAC COUNTABLE_CROSS THEN + REWRITE_TAC[INT_COUNTABLE]);; + +let KCOVER_UNIONS_UNIV = prove + (`!P:(int#int#int)->bool. FINITE P /\ ~(P = {}) + ==> UNIONS {dyho (FST ap) (SND ap) | ap IN {ap:int#int | in_kcover P (FST + ap) (SND ap)}} + = (:real)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[EXTENSION; IN_UNIV; IN_UNIONS; IN_ELIM_THM] THEN + X_GEN_TAC `x:real` THEN + MP_TAC(ISPEC `P:(int#int#int)->bool` KCOVER_EXISTS) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `x:real`) THEN + DISCH_THEN(X_CHOOSE_THEN `a:int` (X_CHOOSE_THEN + `q:int` STRIP_ASSUME_TAC)) THEN + EXISTS_TAC `dyho a q` THEN ASM_REWRITE_TAC[] THEN + EXISTS_TAC `(a:int,q:int)` THEN REWRITE_TAC[IN_ELIM_THM] THEN + ASM_REWRITE_TAC[]);; + +(* 286L(e) near-complete: the inner set E cap h^-1[J_ups] cap K has measure *) +(* <= *) +(* 2 * 2^a * mass/w(3/2) = 2 gamma' mu K/w(3/2). Assembles GK_WEIGHT_ON_K *) +(* (w_ups >= *) +(* w(3/2)/(2*2^a) on K), MASS_TERM_LE_GEN (int_{E cap h^-1[J_ups]} w_ups <= *) +(* mass), the *) +(* subset step int_A <= int_full (REAL_INTEGRAL_SUBSET_LE, cw_tile > 0), *) +(* SC_MEASURABLE + *) +(* CWTILE_INTEGRABLE_MEASURABLE (A measurable + w_ups integrable), via *) +(* GK_INNER_MEASURE. *) +let GK_INNER_MEASURE_BOUND = prove + (`!(ups:int#int#int) (sig:int#int#int) E h P a p. + tile_k ups = --(a + &1) /\ tile_le sig ups /\ sig IN P /\ + tile_I sig SUBSET dyho_star (a + &1) (p div &2) /\ + real_lebesgue_measurable E /\ h real_measurable_on (:real) /\ + (!t. cw_tile t real_integrable_on {x | x IN E /\ h x IN tile_J t}) + ==> real_measure ({x | x IN E /\ h x IN tile_J ups} INTER dyho a p) + <= &2 * &2 zpow a * mass_Eh E h P / cw(&3 / &2)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC GK_INNER_MEASURE THEN EXISTS_TAC `ups:int#int#int` THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC SC_MEASURABLE THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC CWTILE_INTEGRABLE_MEASURABLE THEN + MATCH_MP_TAC SC_MEASURABLE THEN + ASM_REWRITE_TAC[]; + X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN + STRIP_TAC THEN + MATCH_MP_TAC GK_WEIGHT_ON_K THEN + MAP_EVERY EXISTS_TAC [`sig:int#int#int`; `p:int`] THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `real_integral {x | x IN E /\ h x IN tile_J ups} (cw_tile ups)` + THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_SUBSET_LE THEN REPEAT CONJ_TAC THENL + [SET_TAC[]; + MATCH_MP_TAC CWTILE_INTEGRABLE_MEASURABLE THEN + MATCH_MP_TAC SC_MEASURABLE THEN + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN + REWRITE_TAC[CW_TILE_POS]]; + MATCH_MP_TAC MASS_TERM_LE_GEN THEN EXISTS_TAC `sig:int#int#int` THEN + ASM_REWRITE_TAC[]]]);; + +(* 286L(e) at the COVER level (stated purely from in_kcover): for a cover *) +(* cell dyho a p *) +(* whose parent is coarser than tau (W2 case 2^{a+1} <= 2^{-k_tau}, i.e. 2 *) +(* mu K <= *) +(* mu I_tau), with tau a lower bound of P (tile_le s tau for all s in P), *) +(* there is an *) +(* interpolated upsilon whose inner set E cap h^-1[J_ups] cap K has measure *) +(* <= 2 gamma' *) +(* mu K/w(3/2). Wraps KCOVER_PARENT_WITNESS (sigma) + GK_UPSILON (upsilon) + *) +(* GK_INNER_MEASURE_BOUND. This is the G_K-measure input to the alpha2 int *) +(* v2 estimate. *) +let GK_MEASURE_BOUND_STRONG = prove + (`!(P:(int#int#int)->bool) E h a p tau. + in_kcover P a p /\ (!s. s IN P ==> tile_le s tau) /\ + &2 zpow (a + &1) <= &2 zpow (--(tile_k tau)) /\ + real_lebesgue_measurable E /\ h real_measurable_on (:real) /\ + (!t. cw_tile t real_integrable_on {x | x IN E /\ h x IN tile_J t}) + ==> ?ups. tile_le ups tau /\ tile_k ups = --(a + &1) /\ + real_measure ({x | x IN E /\ h x IN tile_J ups} INTER dyho a p) + <= &2 * &2 zpow a * mass_Eh E h P / cw(&3 / &2)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`P:(int#int#int)->bool`; `a:int`; + `p:int`] KCOVER_PARENT_WITNESS) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN + `sig:int#int#int` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`P:(int#int#int)->bool`; `a:int`; `p:int`; `sig:int#int#int`; + `tau:int#int#int`] + GK_UPSILON) THEN + ASM_SIMP_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN + `ups:int#int#int` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `ups:int#int#int` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC GK_INNER_MEASURE_BOUND THEN + EXISTS_TAC `sig:int#int#int` THEN ASM_REWRITE_TAC[]);; + +(* --- 286L(c) alpha0 CAPSTONE: the per-scale cover-cell bound --- *) +(* Instantiates CARLESON_ALPHA_SCALE at the cover cell dyho a p (in_kcover P *) +(* a p) *) +(* with q = p*M, M = 2^{a+k}, Sc s = E cap h^-1[J_s^r] cap dyho a p. Every *) +(* ALPHA_ *) +(* SCALE hypothesis is discharged from the cover: outside-span *) +(* (KCOVER_TILE_OUTSIDE_ *) +(* SPAN), Sc SUBSET tile_J-domain (TILE_JR_SUBSET_J), Sc SUBSET k-span = *) +(* dyho a p *) +(* (DYHO_SPAN_INTERVAL), 4 integrability (SC_MEASURABLE_JR + the *) +(* *_INTEGRABLE_ *) +(* MEASURABLE lemmas); the cw_tile-on-h^-1[J_t] hyp is threaded. Gives the *) +(* per-scale *) +(* C1 2^{-k} energy mass feeding ALPHA_CELL_GEOM_SUM. *) +let ALPHA_CELL_PER_SCALE = prove + (`?C1. &0 <= C1 /\ + !(f:real->complex) k E h (P:(int#int#int)->bool) a p u M. + FINITE P /\ ~(P = {}) /\ in_kcover P a p /\ --k <= a /\ + &2 zpow (a + k) = real_of_int M /\ + real_lebesgue_measurable E /\ h real_measurable_on (:real) /\ + (!s. s IN P ==> tile_I s SUBSET tile_I u) /\ + (!t. cw_tile t real_integrable_on {x | x IN E /\ h x IN tile_J t}) + ==> sum {s | s IN P /\ tile_k s = k /\ tile_le s u} + (\s. norm(carleson_ip f s * + integral (IMAGE lift ({x | x IN E /\ h x IN tile_Jr s} INTER + dyho a p)) + (\z. phi_sigma s carleson_phi (drop z)))) + <= C1 * inv(&2 zpow k) * energy_f f P * mass_Eh E h P`, + X_CHOOSE_THEN `C1:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "AS")) + CARLESON_ALPHA_SCALE THEN + EXISTS_TAC `C1:real` THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&1 <= (M:int)` ASSUME_TAC THENL + [MP_TAC(ISPECL [`a:int`; `k:int`; `M:int`] ZPOW_SPAN_POS) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; SIMP_TAC[]]; + ALL_TAC] THEN + USE_THEN "AS" (MP_TAC o BETA_RULE o ISPECL + [`f:real->complex`; `k:int`; `E:real->bool`; `h:real->real`; + `P:(int#int#int)->bool`; + `{s | s IN P /\ tile_k s = k /\ tile_le s u}`; + `u:int#int#int`; `p * M:int`; `M:int`; + `\s:int#int#int. {x | x IN E /\ h x IN tile_Jr s} INTER dyho a p`]) THEN + ANTS_TAC THENL + [REWRITE_TAC[IN_ELIM_THM] THEN REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + ASM_SIMP_TAC[FINITE_RESTRICT]; + SET_TAC[]; + MP_TAC(INT_ARITH `&1 <= (M:int) ==> &0 <= M`) THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + SIMP_TAC[]; + X_GEN_TAC `s:int#int#int` THEN STRIP_TAC THEN + MP_TAC(ISPECL [`P:(int#int#int)->bool`; `a:int`; `p:int`; `k:int`; + `s:int#int#int`; `M:int`] KCOVER_TILE_OUTSIDE_SPAN) THEN + ASM_REWRITE_TAC[]; + X_GEN_TAC `s:int#int#int` THEN STRIP_TAC THEN REPEAT CONJ_TAC THENL + [MP_TAC(ISPEC `s:int#int#int` TILE_JR_SUBSET_J) THEN SET_TAC[]; + MP_TAC(ISPECL [`a:int`; `p:int`; `k:int`; + `M:int`] DYHO_SPAN_INTERVAL) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> REWRITE_TAC[GSYM th]) THEN + SET_TAC[]; + MATCH_MP_TAC PHISIG_NORM_INTEGRABLE_MEASURABLE THEN + MATCH_MP_TAC SC_MEASURABLE_JR THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC CWTILE_SQ_INTEGRABLE_MEASURABLE THEN + MATCH_MP_TAC SC_MEASURABLE_JR THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC CWTILE_INTEGRABLE_MEASURABLE THEN + MATCH_MP_TAC SC_MEASURABLE_JR THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC PHISIG_ABS_INTEGRABLE_MEASURABLE THEN + MATCH_MP_TAC SC_MEASURABLE_JR THEN ASM_REWRITE_TAC[]]; + ASM_REWRITE_TAC[]]; + DISCH_THEN ACCEPT_TAC]);; + +(* --- 286L(c-i) alpha1: the TIGHT per-scale-slice bound --- *) +(* Fremlin 286L(c-i): for a cover cell dyho a p and scale k, the scale-k *) +(* slice of the *) +(* cell tile-set has alpha-sum <= C1 2^{-k}(1+2^{k-l})^{-2} energy mass, l = *) +(* l_K = -a. *) +(* Here (1+2^{k-l})^{-2} = inv((1+M)^2), M = 2^{a+k} the cell's index span, *) +(* because the *) +(* tile escapes the TRIPLED cell so its offset N >= M. Same skeleton as *) +(* ALPHA_CELL_ *) +(* PER_SCALE (instantiate at q = pM, Sc s = E cap h^-1[Jr_s] cap dyho a p) *) +(* but calling *) +(* CARLESON_ALPHA_SCALE_TIGHT with N = num_of_int M and discharging BOTH the *) +(* span- *) +(* exclusion (KCOVER_TILE_OFFSET_TIGHT part 1) and the offset lower bound N *) +(* <= num_of_ *) +(* int(offset) (part 2 + NUM_OF_INT_LE); the conclusion's inv((1+&N)^2) *) +(* rewrites to *) +(* inv((1+real_of_int M)^2) via ROI_NUM_OF_INT. This extra inv((1+M)^2) = *) +(* 2^{-2(a+k)} *) +(* decay is what makes the alpha1 double geometric series (over coarse *) +(* levels a AND *) +(* scales k) converge -- the alpha0 loose bound would DIVERGE over the *) +(* coarse levels. *) +let ALPHA_CELL_PER_SCALE_TIGHT = prove + (`?C1. &0 <= C1 /\ + !(f:real->complex) k E h (P:(int#int#int)->bool) a p u M. + FINITE P /\ ~(P = {}) /\ in_kcover P a p /\ --k <= a /\ + &2 zpow (a + k) = real_of_int M /\ + real_lebesgue_measurable E /\ h real_measurable_on (:real) /\ + (!s. s IN P ==> tile_I s SUBSET tile_I u) /\ + (!t. cw_tile t real_integrable_on {x | x IN E /\ h x IN tile_J t}) + ==> sum {s | s IN P /\ tile_k s = k /\ tile_le s u} + (\s. norm(carleson_ip f s * + integral (IMAGE lift ({x | x IN E /\ h x IN tile_Jr s} INTER + dyho a p)) + (\z. phi_sigma s carleson_phi (drop z)))) + <= C1 * inv(&2 zpow k) * inv((&1 + real_of_int M) pow 2) * + energy_f f P * mass_Eh E h P`, + X_CHOOSE_THEN `C1:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "AST")) + CARLESON_ALPHA_SCALE_TIGHT THEN + EXISTS_TAC `C1:real` THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&1 <= (M:int)` ASSUME_TAC THENL + [MP_TAC(ISPECL [`a:int`; `k:int`; `M:int`] ZPOW_SPAN_POS) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `&(num_of_int M) = real_of_int M` ASSUME_TAC THENL + [MATCH_MP_TAC ROI_NUM_OF_INT THEN ASM_INT_ARITH_TAC; ALL_TAC] THEN + USE_THEN "AST" (MP_TAC o BETA_RULE o ISPECL + [`f:real->complex`; `k:int`; `E:real->bool`; `h:real->real`; + `P:(int#int#int)->bool`; + `{s | s IN P /\ tile_k s = k /\ tile_le s u}`; + `u:int#int#int`; `p * M:int`; `M:int`; `num_of_int M`; + `\s:int#int#int. {x | x IN E /\ h x IN tile_Jr s} INTER dyho a p`]) THEN + ANTS_TAC THENL + [REWRITE_TAC[IN_ELIM_THM] THEN REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + ASM_SIMP_TAC[FINITE_RESTRICT]; + SET_TAC[]; + MP_TAC(INT_ARITH `&1 <= (M:int) ==> &0 <= M`) THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + SIMP_TAC[]; + X_GEN_TAC `s:int#int#int` THEN STRIP_TAC THEN + MP_TAC(ISPECL [`P:(int#int#int)->bool`; `a:int`; `p:int`; `k:int`; + `s:int#int#int`; `M:int`] KCOVER_TILE_OFFSET_TIGHT) THEN + ASM_REWRITE_TAC[] THEN SIMP_TAC[]; + X_GEN_TAC `s:int#int#int` THEN STRIP_TAC THEN + MATCH_MP_TAC NUM_OF_INT_LE THEN CONJ_TAC THENL + [ASM_INT_ARITH_TAC; + MP_TAC(ISPECL [`P:(int#int#int)->bool`; `a:int`; `p:int`; `k:int`; + `s:int#int#int`; `M:int`] KCOVER_TILE_OFFSET_TIGHT) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[]]; + X_GEN_TAC `s:int#int#int` THEN STRIP_TAC THEN REPEAT CONJ_TAC THENL + [MP_TAC(ISPEC `s:int#int#int` TILE_JR_SUBSET_J) THEN SET_TAC[]; + MP_TAC(ISPECL [`a:int`; `p:int`; `k:int`; + `M:int`] DYHO_SPAN_INTERVAL) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> REWRITE_TAC[GSYM th]) THEN + SET_TAC[]; + MATCH_MP_TAC PHISIG_NORM_INTEGRABLE_MEASURABLE THEN + MATCH_MP_TAC SC_MEASURABLE_JR THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC CWTILE_SQ_INTEGRABLE_MEASURABLE THEN + MATCH_MP_TAC SC_MEASURABLE_JR THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC CWTILE_INTEGRABLE_MEASURABLE THEN + MATCH_MP_TAC SC_MEASURABLE_JR THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC PHISIG_ABS_INTEGRABLE_MEASURABLE THEN + MATCH_MP_TAC SC_MEASURABLE_JR THEN ASM_REWRITE_TAC[]]; + ASM_REWRITE_TAC[]]; + UNDISCH_TAC `&(num_of_int M) = real_of_int M` THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN DISCH_THEN ACCEPT_TAC]);; + +(* 286L(d) alpha1 per-scale-slice in CUBIC form: fold TIGHT_DECAY_BOUND into *) +(* ALPHA_CELL_ *) +(* PER_SCALE_TIGHT to replace inv(2^k) inv((1+M)^2) by inv(2^{2a}) inv(8^k). *) +(* The *) +(* inv(2^{2a}) factor is CONSTANT in k (pulls out of the coming k-sum); *) +(* inv(8^k) is the *) +(* cubic tail summed over k >= k_tau by ABSTRACT_SCALE_GEOM_SUM8. *) +let ALPHA_CELL1_PERSCALE_BOUND = prove + (`?C1. &0 <= C1 /\ + !(f:real->complex) k E h (P:(int#int#int)->bool) a p u M. + FINITE P /\ ~(P = {}) /\ in_kcover P a p /\ --k <= a /\ + &2 zpow (a + k) = real_of_int M /\ + real_lebesgue_measurable E /\ h real_measurable_on (:real) /\ + (!s. s IN P ==> tile_I s SUBSET tile_I u) /\ + (!t. cw_tile t real_integrable_on {x | x IN E /\ h x IN tile_J t}) + ==> sum {s | s IN P /\ tile_k s = k /\ tile_le s u} + (\s. norm(carleson_ip f s * + integral (IMAGE lift ({x | x IN E /\ h x IN tile_Jr s} INTER + dyho a p)) + (\z. phi_sigma s carleson_phi (drop z)))) + <= (C1 * energy_f f P * mass_Eh E h P * inv(&2 zpow (&2 * a))) * + inv(&8 zpow k)`, + X_CHOOSE_THEN `C1:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "PST")) + ALPHA_CELL_PER_SCALE_TIGHT THEN + EXISTS_TAC `C1:real` THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&1 <= (M:int)` ASSUME_TAC THENL + [MP_TAC(ISPECL [`a:int`; `k:int`; `M:int`] ZPOW_SPAN_POS) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `&0 <= energy_f (f:real->complex) P /\ &0 <= mass_Eh E h P` + STRIP_ASSUME_TAC THENL + [ASM_SIMP_TAC[ENERGY_F_POS] THEN MATCH_MP_TAC MASS_EH_POS THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `C1 * inv(&2 zpow k) * inv((&1 + real_of_int M) pow 2) * + energy_f (f:real->complex) P * mass_Eh E h P` THEN + CONJ_TAC THENL + [USE_THEN "PST" (MP_TAC o ISPECL + [`f:real->complex`; `k:int`; `E:real->bool`; `h:real->real`; + `P:(int#int#int)->bool`; `a:int`; `p:int`; `u:int#int#int`; + `M:int`]) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; DISCH_THEN ACCEPT_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN + `(C1 * energy_f (f:real->complex) P * mass_Eh E h P * inv(&2 zpow (&2 * a))) + * + inv(&8 zpow k) = + C1 * inv(&2 zpow k) * + (inv(&2 zpow (&2 * a)) * inv(&2 zpow (&2 * k))) * + energy_f f P * mass_Eh E h P` + SUBST1_TAC THENL + [SUBGOAL_THEN + `inv(&8 zpow k) = inv(&2 zpow k) * inv(&2 zpow (&2 * k))` SUBST1_TAC THENL + [REWRITE_TAC[GSYM REAL_INV_MUL] THEN AP_TERM_TAC THEN + SIMP_TAC[GSYM REAL_ZPOW_ADD; REAL_ARITH `~(&2 = &0)`] THEN + SUBGOAL_THEN `k + &2 * k = &3 * k:int` SUBST1_TAC THENL + [INT_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[ZPOW_2_3]; + ALL_TAC] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_LE_INV_EQ] THEN MATCH_MP_TAC REAL_ZPOW_LE THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + ONCE_REWRITE_TAC[REAL_ARITH + `a * e * m <= b * e * m <=> (e * m) * a <= (e * m) * b`] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC TIGHT_DECAY_BOUND THEN ASM_REWRITE_TAC[]);; + +(* --- 286L(c-ii) alpha0: chaining the per-scale bound over scales, per *) +(* cover cell --- *) + +(* A cover-cell scale span M = 2^{a+k} (k >= --a) is an integer >= 1: *) +(* witness for k. *) +let SPAN_INT_EXISTS = prove + (`!a k:int. --k <= a ==> ?M:int. &2 zpow (a + k) = real_of_int M`, + REPEAT STRIP_TAC THEN MP_TAC(SPEC `a + k:int` DYADIC_SCALE_INT) THEN + ANTS_TAC THENL [ASM_INT_ARITH_TAC; + DISCH_THEN(X_CHOOSE_THEN `M:int` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `M:int` THEN + ASM_REWRITE_TAC[]]);; + +(* ~(--k<=a) => the scale-k slice of the cell tile-set is empty (--a<=k <=> *) +(* --k<=a). *) +let SPAN_INT_EMPTY = prove + (`!a k:int. ~(--k <= a) ==> ~(--a <= k)`, INT_ARITH_TAC);; + +(* Monotonicity: the scale-k slice sum <= the ALPHA_SCALE tile-set sum *) +(* (nonneg terms). *) +let SUM_SLICE_LE = prove + (`!(f:real->complex) E h P a p k u. + FINITE (P:(int#int#int)->bool) + ==> sum {s | s IN {s | s IN P /\ tile_le s u /\ --a <= tile_k s} /\ tile_k + s = k} + (\s. norm(carleson_ip f s * + integral (IMAGE lift ({x | x IN E /\ h x IN tile_Jr s} INTER + dyho a p)) + (\z. phi_sigma s carleson_phi (drop z)))) + <= sum {s | s IN P /\ tile_k s = k /\ tile_le s u} + (\s. norm(carleson_ip f s * + integral (IMAGE lift ({x | x IN E /\ h x IN tile_Jr s} INTER + dyho a p)) + (\z. phi_sigma s carleson_phi (drop z))))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_SUBSET THEN + ASM_SIMP_TAC[FINITE_RESTRICT] THEN + REWRITE_TAC[IN_DIFF; IN_ELIM_THM] THEN CONJ_TAC THEN GEN_TAC THEN + STRIP_TAC THENL + [FIRST_X_ASSUM(MP_TAC o check (is_neg o concl)) THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[NORM_POS_LE]]);; + +(* Per-scale-slice bound: for a cover cell dyho a p, the scale-k slice of *) +(* its tile-set *) +(* has alpha-sum <= C1 energy mass * 2^{-k}. k >= --a: reduce to *) +(* ALPHA_CELL_PER_SCALE *) +(* (SUM_SLICE_LE + SPAN_INT_EXISTS witness); k < --a: the slice is empty *) +(* (SPAN_INT_EMPTY), sum 0 <= RHS. *) +let ALPHA_CELL_PERSCALE_BOUND = prove + (`?C1. &0 <= C1 /\ + !(f:real->complex) E h (P:(int#int#int)->bool) a p u k. + FINITE P /\ ~(P = {}) /\ in_kcover P a p /\ + real_lebesgue_measurable E /\ h real_measurable_on (:real) /\ + (!s. s IN P ==> tile_I s SUBSET tile_I u) /\ + (!t. cw_tile t real_integrable_on {x | x IN E /\ h x IN tile_J t}) /\ + &0 <= energy_f f P /\ &0 <= mass_Eh E h P + ==> sum {s | s IN {s | s IN P /\ tile_le s u /\ --a <= tile_k s} /\ + tile_k s = k} + (\s. norm(carleson_ip f s * + integral (IMAGE lift ({x | x IN E /\ h x IN tile_Jr s} INTER + dyho a p)) + (\z. phi_sigma s carleson_phi (drop z)))) + <= (C1 * energy_f f P * mass_Eh E h P) * inv(&2 zpow k)`, + X_CHOOSE_THEN `C1:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "PS")) + ALPHA_CELL_PER_SCALE THEN + EXISTS_TAC `C1:real` THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + ASM_CASES_TAC `--(k:int) <= a` THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `C1 * inv(&2 zpow k) * energy_f (f:real->complex) P * mass_Eh E + h P` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `sum {s | s IN P /\ tile_k s = k /\ tile_le s u} + (\s. norm(carleson_ip (f:real->complex) s * + integral (IMAGE lift ({x | x IN E /\ h x IN tile_Jr s} INTER + dyho a p)) + (\z. phi_sigma s carleson_phi (drop z))))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_SLICE_LE THEN ASM_REWRITE_TAC[]; + SUBGOAL_THEN + `?M:int. &2 zpow (a + k) = + real_of_int M` (X_CHOOSE_TAC `M:int`) THENL + [MATCH_MP_TAC SPAN_INT_EXISTS THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + USE_THEN "PS" (MP_TAC o ISPECL + [`f:real->complex`; `k:int`; `E:real->bool`; `h:real->real`; + `P:(int#int#int)->bool`; `a:int`; `p:int`; `u:int#int#int`; + `M:int`]) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; DISCH_THEN MATCH_ACCEPT_TAC]]; + REAL_ARITH_TAC]; + SUBGOAL_THEN + `{s | s IN {s | s IN P /\ tile_le s u /\ --a <= tile_k s} /\ tile_k s = k} + = {}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN + X_GEN_TAC `s:int#int#int` THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP SPAN_INT_EMPTY) THEN + STRIP_TAC THEN UNDISCH_TAC `--a <= tile_k (s:int#int#int)` THEN + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUM_CLAUSES] THEN + MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[]]; + REWRITE_TAC[REAL_LE_INV_EQ] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN + MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC]]]);; + +(* 286L(d) alpha1 per-scale-slice (CUBIC, nested-set form for the geom *) +(* engine): the *) +(* scale-k slice of the cover cell's tile-set <= (C1 E mass inv(2^{2a})) *) +(* inv(8^k). Same *) +(* case split as ALPHA_CELL_PERSCALE_BOUND (k>=--a: SUM_SLICE_LE + *) +(* ALPHA_CELL1_PERSCALE_ *) +(* BOUND; k<--a: empty slice via SPAN_INT_EMPTY), but the CUBIC 8^k RHS. *) +let ALPHA_CELL1_PERSCALE_SLICE = prove + (`?C1. &0 <= C1 /\ + !(f:real->complex) E h (P:(int#int#int)->bool) a p u k. + FINITE P /\ ~(P = {}) /\ in_kcover P a p /\ + real_lebesgue_measurable E /\ h real_measurable_on (:real) /\ + (!s. s IN P ==> tile_I s SUBSET tile_I u) /\ + (!t. cw_tile t real_integrable_on {x | x IN E /\ h x IN tile_J t}) /\ + &0 <= energy_f f P /\ &0 <= mass_Eh E h P + ==> sum {s | s IN {s | s IN P /\ tile_le s u /\ --a <= tile_k s} /\ + tile_k s = k} + (\s. norm(carleson_ip f s * + integral (IMAGE lift ({x | x IN E /\ h x IN tile_Jr s} INTER + dyho a p)) + (\z. phi_sigma s carleson_phi (drop z)))) + <= (C1 * energy_f f P * mass_Eh E h P * inv(&2 zpow (&2 * a))) * + inv(&8 zpow k)`, + X_CHOOSE_THEN `C1:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "PB")) + ALPHA_CELL1_PERSCALE_BOUND THEN + EXISTS_TAC `C1:real` THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + ASM_CASES_TAC `--(k:int) <= a` THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `sum {s | s IN P /\ tile_k s = k /\ tile_le s u} + (\s. norm(carleson_ip (f:real->complex) s * + integral (IMAGE lift ({x | x IN E /\ h x IN tile_Jr s} INTER + dyho a p)) + (\z. phi_sigma s carleson_phi (drop z))))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_SLICE_LE THEN ASM_REWRITE_TAC[]; + SUBGOAL_THEN + `?M:int. &2 zpow (a + k) = real_of_int M` (X_CHOOSE_TAC `M:int`) THENL + [MATCH_MP_TAC SPAN_INT_EXISTS THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + USE_THEN "PB" (MP_TAC o ISPECL + [`f:real->complex`; `k:int`; `E:real->bool`; `h:real->real`; + `P:(int#int#int)->bool`; `a:int`; `p:int`; `u:int#int#int`; + `M:int`]) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; DISCH_THEN MATCH_ACCEPT_TAC]]; + SUBGOAL_THEN + `{s | s IN {s | s IN P /\ tile_le s u /\ --a <= tile_k s} /\ tile_k s = k} + = {}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN + X_GEN_TAC `s:int#int#int` THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP SPAN_INT_EMPTY) THEN + STRIP_TAC THEN UNDISCH_TAC `--a <= tile_k (s:int#int#int)` THEN + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUM_CLAUSES] THEN + MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [REPEAT(MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC) THEN + ASM_REWRITE_TAC[REAL_LE_INV_EQ] THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN MATCH_MP_TAC REAL_ZPOW_LT THEN + REAL_ARITH_TAC; + REWRITE_TAC[REAL_LE_INV_EQ] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN + MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC]]]);; + +(* 286L(d) alpha1 PER-CELL total: for a cover cell (coarser than tau, so *) +(* W1), the whole *) +(* cell tile-set alpha-sum <= (8/7) C1 E mass inv(2^{2a}) inv(8^{k_tau}). *) +(* Cubic geometric *) +(* engine ABSTRACT_SCALE_GEOM_SUM8 at sc = tile_k, LOWER BOUND L = tile_k u *) +(* = k_tau (from *) +(* tile_le s u => tile_k u <= tile_k s, TILE_LE_SCALE -- k_tau is *) +(* INDEPENDENT of the cover *) +(* level a, the key to the outer coarse-level sum). Fed by *) +(* ALPHA_CELL1_PERSCALE_SLICE. *) +let ALPHA_CELL1_GEOM_SUM = prove + (`?C1. &0 <= C1 /\ + !(f:real->complex) E h (P:(int#int#int)->bool) a p u. + FINITE P /\ ~(P = {}) /\ in_kcover P a p /\ + real_lebesgue_measurable E /\ h real_measurable_on (:real) /\ + (!s. s IN P ==> tile_I s SUBSET tile_I u) /\ + (!t. cw_tile t real_integrable_on {x | x IN E /\ h x IN tile_J t}) + ==> sum {s | s IN P /\ tile_le s u /\ --a <= tile_k s} + (\s. norm(carleson_ip f s * + integral (IMAGE lift ({x | x IN E /\ h x IN tile_Jr s} INTER + dyho a p)) + (\z. phi_sigma s carleson_phi (drop z)))) + <= (&8 / &7) * (C1 * energy_f f P * mass_Eh E h P * inv(&2 zpow (&2 * + a))) * + inv(&8 zpow (tile_k u))`, + X_CHOOSE_THEN `C1:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "PS")) + ALPHA_CELL1_PERSCALE_SLICE THEN + EXISTS_TAC `C1:real` THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&0 <= energy_f (f:real->complex) P /\ &0 <= mass_Eh E h P` + STRIP_ASSUME_TAC THENL + [ASM_SIMP_TAC[ENERGY_F_POS] THEN MATCH_MP_TAC MASS_EH_POS THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC ABSTRACT_SCALE_GEOM_SUM8 THEN + EXISTS_TAC `tile_k:int#int#int->int` THEN + ASM_SIMP_TAC[FINITE_RESTRICT] THEN + CONJ_TAC THENL + [REPEAT(MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC) THEN + ASM_REWRITE_TAC[REAL_LE_INV_EQ] THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN MATCH_MP_TAC REAL_ZPOW_LT THEN + REAL_ARITH_TAC; + GEN_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN + MATCH_MP_TAC TILE_LE_SCALE THEN ASM_REWRITE_TAC[]]);; + +(* 286L(c-ii) alpha0 per-cell total: the whole cover-cell tile-set alpha-sum *) +(* is bounded *) +(* 2 C1 energy mass * mu(dyho a p). ALPHA_CELL_GEOM_SUM (geometric over k >= *) +(* --a) fed *) +(* by ALPHA_CELL_PERSCALE_BOUND. This is Fremlin's per-K quantity g(K) <= D *) +(* mu K. *) +let ALPHA_CELL_TOTAL = prove + (`?C1. &0 <= C1 /\ + !(f:real->complex) E h (P:(int#int#int)->bool) a p u. + FINITE P /\ ~(P = {}) /\ in_kcover P a p /\ + real_lebesgue_measurable E /\ h real_measurable_on (:real) /\ + (!s. s IN P ==> tile_I s SUBSET tile_I u) /\ + (!t. cw_tile t real_integrable_on {x | x IN E /\ h x IN tile_J t}) + ==> sum {s | s IN P /\ tile_le s u /\ --a <= tile_k s} + (\s. norm(carleson_ip f s * + integral (IMAGE lift ({x | x IN E /\ h x IN tile_Jr s} INTER + dyho a p)) + (\z. phi_sigma s carleson_phi (drop z)))) + <= (&2 * C1 * energy_f f P * mass_Eh E h P) * real_measure (dyho a + p)`, + X_CHOOSE_THEN `C1:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "PB")) + ALPHA_CELL_PERSCALE_BOUND THEN + EXISTS_TAC `C1:real` THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&0 <= energy_f (f:real->complex) P /\ &0 <= mass_Eh E h P` + STRIP_ASSUME_TAC THENL + [ASM_SIMP_TAC[ENERGY_F_POS] THEN MATCH_MP_TAC MASS_EH_POS THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `(&2 * C1 * energy_f (f:real->complex) P * mass_Eh E h P) * real_measure + (dyho a p) + = (&2 * (C1 * energy_f f P * mass_Eh E h P)) * real_measure (dyho a p)` + SUBST1_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC ALPHA_CELL_GEOM_SUM THEN + REPEAT CONJ_TAC THEN + FIRST + [MATCH_MP_TAC FINITE_RESTRICT THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[]; MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[]]; + REWRITE_TAC[IN_ELIM_THM] THEN + X_GEN_TAC `s:int#int#int` THEN STRIP_TAC THEN FIRST_ASSUM ACCEPT_TAC; + (GEN_TAC THEN + USE_THEN "PB" (MP_TAC o ISPECL + [`f:real->complex`; `E:real->bool`; `h:real->real`; + `P:(int#int#int)->bool`; `a:int`; `p:int`; `u:int#int#int`; + `k:int`]) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; DISCH_THEN MATCH_ACCEPT_TAC])]);; + +(* Two Schwartz functions pair to an integrable product f cnj g: f is a *) +(* bounded measurable factor, cnj g is absolutely integrable. *) +let SCHWARTZ_CNJ_PRODUCT_INTEGRABLE = prove + (`!(f:real->complex) (g:real->complex). schwartz f /\ schwartz g + ==> (\z:real^1. f(drop z) * cnj(g(drop z))) integrable_on (:real^1)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MP_TAC(ISPECL + [`(*):complex->complex->complex`; + `\z:real^1. f(drop z):complex`; + `\z:real^1. cnj(g(drop z)):complex`; + `(:real^1)`] ABSOLUTELY_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT) THEN + REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + REWRITE_TAC[BILINEAR_COMPLEX_MUL] THEN + CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_IMP_MEASURABLE THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + ASM_SIMP_TAC[SCHWARTZ_ABSINT]; ALL_TAC] THEN + CONJ_TAC THENL + [MP_TAC(MATCH_MP SCHWARTZ_BOUNDED (ASSUME `schwartz (f:real->complex)`)) + THEN + DISCH_THEN(X_CHOOSE_TAC `B:real`) THEN + REWRITE_TAC[BOUNDED_POS] THEN EXISTS_TAC `abs B + &1` THEN + REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV] THEN CONJ_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + X_GEN_TAC `z:real^1` THEN + MP_TAC(SPEC `drop(z:real^1)` (ASSUME `!x. norm((f:real->complex) x) <= B`)) + THEN + REAL_ARITH_TAC; + SUBGOAL_THEN + `(\z:real^1. cnj((g:real->complex)(drop z))) = + cnj o (\z:real^1. g(drop z))` + SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM; o_THM]; ALL_TAC] THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_LINEAR THEN + ASM_SIMP_TAC[SCHWARTZ_ABSINT; LINEAR_CNJ]]);; + +(* The product norm(phi_s) norm(phi_t) is integrable (both in L^2, Hoelder). *) +let PHISIG_NORMPROD_INTEGRABLE = prove + (`!(s:int#int#int) (t:int#int#int). + (\z. lift(norm(phi_sigma s carleson_phi (drop z)) * + norm(phi_sigma t carleson_phi (drop z)))) integrable_on + (:real^1)`, + REPEAT GEN_TAC THEN + MP_TAC(ISPECL [`(:real^1)`; `&2`; `&2`; + `\z:real^1. phi_sigma s carleson_phi (drop z)`; + `\z:real^1. phi_sigma t carleson_phi (drop z)`] LSPACE_INTEGRABLE_PRODUCT) + THEN + REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + REWRITE_TAC[REAL_ARITH `&0 < &2`; REAL_ARITH `inv(&2) + inv(&2) = &1`] THEN + CONJ_TAC THEN MATCH_MP_TAC SCHWARTZ_L2 THEN + REWRITE_TAC[ETA_AX; PHISIG_CARLESON_SCHWARTZ]);; + +(* Pointwise: norm(phi_s x) norm(phi_t x) <= C1^2 2^(-k_s/2) 2^(-k_t/2) *) +(* w_s(x) w_t(x) (PHISIG_CW = 286E(c-iii) multiplied in each factor). *) +let PHISIG_PROD_CW = prove + (`?C1. &0 <= C1 /\ !(s:int#int#int) (t:int#int#int) x. + norm(phi_sigma s carleson_phi x) * norm(phi_sigma t carleson_phi x) + <= (C1 * C1) * (inv(sqrt(&2 zpow (tile_k s))) * inv(sqrt(&2 zpow (tile_k + t)))) * + (cw_tile s x * cw_tile t x)`, + MP_TAC PHISIG_CW THEN DISCH_THEN(X_CHOOSE_THEN + `C1:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `C1:real` THEN ASM_REWRITE_TAC[] THEN REPEAT GEN_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(C1 * inv(sqrt(&2 zpow (tile_k s))) * cw_tile s x) * + (C1 * inv(sqrt(&2 zpow (tile_k t))) * cw_tile t x)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REWRITE_TAC[NORM_POS_LE]; ALL_TAC] THEN + MATCH_MP_TAC REAL_EQ_IMP_LE THEN CONV_TAC REAL_RING);; + +(* The weight product w_s w_t is real-integrable on R: measurable *) +(* (continuous), dominated by the integrable (2^ks 2^kt) w_t (since *) +(* 0<=w_s<=1). *) +let CW_PROD_INTEGRABLE_ABSTRACT = prove + (`!ks kt xs xt. &0 < ks /\ &0 < kt + ==> (\x. (ks * cw(ks * (x - xs))) * (kt * cw(kt * (x - xt)))) + real_integrable_on (:real)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN + EXISTS_TAC `\x. (ks * kt) * cw(kt * (x - xt))` THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_IMP_REAL_MEASURABLE_ON THEN + SUBGOAL_THEN + `(\x. (ks * cw(ks * (x - xs))) * (kt * cw(kt * (x - xt)))) = + (\x. (ks * cw(ks * x + (--(ks * xs)))) * (kt * cw(kt * x + (--(kt * + xt)))))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + REPEAT(AP_THM_TAC ORELSE AP_TERM_TAC ORELSE BINOP_TAC) THEN + TRY(AP_TERM_TAC THEN REAL_ARITH_TAC) THEN REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_MUL THEN CONJ_TAC THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_LMUL THEN REWRITE_TAC[CW_SHIFT_CONTINUOUS]; + REWRITE_TAC[] THEN MATCH_MP_TAC REAL_INTEGRABLE_LMUL THEN + SUBGOAL_THEN + `(\x. cw(kt * (x - xt))) = + (\x. cw(kt * x + (--(kt * xt))))` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN AP_TERM_TAC THEN + REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[real_integrable_on] THEN EXISTS_TAC `inv kt:real` THEN + MATCH_MP_TAC CW_AFFINE_INTEGRAL THEN ASM_REWRITE_TAC[]; + X_GEN_TAC `x:real` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + SUBGOAL_THEN `&0 <= ks * cw(ks * (x - xs)) /\ ks * cw(ks * (x - xs)) <= ks` + STRIP_ASSUME_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN + MP_TAC(SPEC `ks * (x - xs):real` CW_POS) THEN REAL_ARITH_TAC; + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; CW_LE_1]]; ALL_TAC] THEN + SUBGOAL_THEN `&0 <= kt * cw(kt * (x - xt))` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN + MP_TAC(SPEC `kt * (x - xt):real` CW_POS) THEN + REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `abs((ks * cw(ks * (x - xs))) * (kt * cw(kt * (x - xt)))) = + (ks * cw(ks * (x - xs))) * (kt * cw(kt * (x - xt)))` + SUBST1_TAC THENL + [REWRITE_TAC[REAL_ABS_REFL] THEN MATCH_MP_TAC REAL_LE_MUL THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `ks * (kt * cw(kt * (x - xt)))` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_RMUL THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_EQ_IMP_LE THEN CONV_TAC REAL_RING]]);; + +let CWTILE_PROD_INTEGRABLE = prove + (`!(s:int#int#int) (t:int#int#int). + (\x. cw_tile s x * cw_tile t x) real_integrable_on (:real)`, + REPEAT GEN_TAC THEN REWRITE_TAC[cw_tile] THEN + MATCH_MP_TAC CW_PROD_INTEGRABLE_ABSTRACT THEN + CONJ_TAC THEN MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC);; + +(* real^1 <-> real bridge for the weight product integral. *) +let CWTILE_PROD_INTEGRAL_BRIDGE = prove + (`!(s:int#int#int) (t:int#int#int). + integral (:real^1) (\z. lift(cw_tile s (drop z) * cw_tile t (drop z))) = + lift(real_integral (:real) (\x. cw_tile s x * cw_tile t x))`, + REPEAT GEN_TAC THEN + MP_TAC(MATCH_MP REAL_INTEGRAL (SPECL [`s:int#int#int`; + `t:int#int#int`] CWTILE_PROD_INTEGRABLE)) THEN + REWRITE_TAC[IMAGE_LIFT_UNIV] THEN DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN + REWRITE_TAC[LIFT_DROP; o_DEF]);; + +let CWTILE_PROD_LIFT_INTEGRABLE = prove + (`!(s:int#int#int) (t:int#int#int). + (\z:real^1. lift(cw_tile s (drop z) * cw_tile t (drop z))) integrable_on + (:real^1)`, + REPEAT GEN_TAC THEN + MP_TAC(SPECL [`s:int#int#int`; `t:int#int#int`] CWTILE_PROD_INTEGRABLE) THEN + REWRITE_TAC[REAL_INTEGRABLE_ON; IMAGE_LIFT_UNIV; o_DEF]);; + +let CWTILE_PROD_CMUL_LIFT_INTEGRABLE = prove + (`!(s:int#int#int) (t:int#int#int) c. + (\z:real^1. lift(c * (cw_tile s (drop z) * cw_tile t (drop z)))) + integrable_on (:real^1)`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN + `(\z:real^1. lift(c * (cw_tile s (drop z) * cw_tile t (drop z)))) = + (\z:real^1. c % lift(cw_tile s (drop z) * cw_tile t (drop z)))` + SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM; LIFT_CMUL]; ALL_TAC] THEN + MATCH_MP_TAC INTEGRABLE_CMUL THEN REWRITE_TAC[CWTILE_PROD_LIFT_INTEGRABLE]);; + +let CWTILE_PROD_CMUL_BRIDGE = prove + (`!(s:int#int#int) (t:int#int#int) c. + c * real_integral (:real) (\x. cw_tile s x * cw_tile t x) + = drop(integral (:real^1) + (\z. lift(c * (cw_tile s (drop z) * cw_tile t (drop z)))))`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN + `(\z:real^1. lift(c * (cw_tile s (drop z) * cw_tile t (drop z)))) = + (\z:real^1. c % lift(cw_tile s (drop z) * cw_tile t (drop z)))` + SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM; LIFT_CMUL]; ALL_TAC] THEN + MP_TAC(ISPECL [`\z:real^1. lift(cw_tile s (drop z) * cw_tile t (drop z))`; + `c:real`; `(:real^1)`] INTEGRAL_CMUL) THEN + REWRITE_TAC[CWTILE_PROD_LIFT_INTEGRABLE] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[DROP_CMUL; CWTILE_PROD_INTEGRAL_BRIDGE; LIFT_DROP]);; + +(* The correlation with the weight-integral on the right (pre-CWTILE_CROSS). *) +let PHISIG_CORR_WEIGHT = prove + (`?C. &0 <= C /\ !(s:int#int#int) (t:int#int#int). + norm(integral (:real^1) + (\z. phi_sigma s carleson_phi (drop z) * cnj(phi_sigma t carleson_phi + (drop z)))) + <= (C * (inv(sqrt(&2 zpow (tile_k s))) * inv(sqrt(&2 zpow (tile_k t))))) * + real_integral (:real) (\x. cw_tile s x * cw_tile t x)`, + MP_TAC PHISIG_PROD_CW THEN DISCH_THEN(X_CHOOSE_THEN + `C1:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `C1 * C1:real` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`s:int#int#int`; `t:int#int#int`] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `drop(integral (:real^1) + (\z. lift(norm(phi_sigma s carleson_phi (drop z)) * + norm(phi_sigma t carleson_phi (drop z)))))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN + REWRITE_TAC[PHISIG_NORMPROD_INTEGRABLE] THEN CONJ_TAC THENL + [MATCH_MP_TAC SCHWARTZ_CNJ_PRODUCT_INTEGRABLE THEN + REWRITE_TAC[ETA_AX; PHISIG_CARLESON_SCHWARTZ]; + REWRITE_TAC[LIFT_DROP; COMPLEX_NORM_MUL; COMPLEX_NORM_CNJ; + REAL_LE_REFL]]; + ALL_TAC] THEN + REWRITE_TAC[CWTILE_PROD_CMUL_BRIDGE] THEN + MATCH_MP_TAC INTEGRAL_DROP_LE THEN + REWRITE_TAC[PHISIG_NORMPROD_INTEGRABLE; + CWTILE_PROD_CMUL_LIFT_INTEGRABLE] THEN + REWRITE_TAC[IN_UNIV] THEN GEN_TAC THEN REWRITE_TAC[LIFT_DROP] THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`s:int#int#int`; `t:int#int#int`; + `drop(x:real^1)`]) THEN + REWRITE_TAC[REAL_MUL_ASSOC]);; + +(* 286G(e): the cross-tile correlation inner-product bound. *) +let PHISIG_CROSS_CORRELATION = prove + (`?C. &0 <= C /\ !(s:int#int#int) (t:int#int#int). tile_k s <= tile_k t + ==> norm(integral (:real^1) + (\z. phi_sigma s carleson_phi (drop z) * cnj(phi_sigma t + carleson_phi (drop z)))) + <= (C * (inv(sqrt(&2 zpow (tile_k s))) * inv(sqrt(&2 zpow (tile_k + t))))) * + cw_tile s (tile_xmid t)`, + MP_TAC PHISIG_CORR_WEIGHT THEN DISCH_THEN(X_CHOOSE_THEN + `C:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `&16 * C` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[] THEN + REAL_ARITH_TAC; ALL_TAC] THEN + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(C * (inv(sqrt(&2 zpow (tile_k s))) * inv(sqrt(&2 zpow (tile_k + t))))) * + real_integral (:real) (\x. cw_tile s x * cw_tile t x)` THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `&0 <= C * inv (sqrt (&2 zpow tile_k s)) * inv (sqrt (&2 zpow tile_k t))` + ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_MUL THEN + REWRITE_TAC[REAL_LE_INV_EQ] THEN CONJ_TAC THEN + MATCH_MP_TAC SQRT_POS_LE THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN MATCH_MP_TAC REAL_ZPOW_LT THEN + REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(C * inv (sqrt (&2 zpow tile_k s)) * inv (sqrt (&2 zpow tile_k + t))) * + (&16 * cw_tile s (tile_xmid t))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[CWTILE_CROSS]; + MATCH_MP_TAC REAL_EQ_IMP_LE THEN CONV_TAC REAL_RING]);; + +(* ------------------------------------------------------------------------- *) +(* Toward 286J: the 286G(b) TILE form -- the sampled weight at the finer *) +(* tile's centre, times mu(I_tau), lower-bounds the weight's integral over *) +(* I_tau. This is how Fremlin passes from the pointwise w_sigma(x_tau) form *) +(* of 286G(e) to his INT_{I_tau} w_sigma form: with the I_tau (same J, hence *) +(* same k) disjoint, sum_tau INT_{I_tau} w_sigma <= INT_R w_sigma = 1. *) +(* ------------------------------------------------------------------------- *) + +(* The half-open dyadic cell and its closure differ by (at most) two points, *) +(* so the tile weight integrates to the same value over either. *) +let CWTILE_INTEGRAL_DYHO_CLOSED = prove + (`!(s:int#int#int) k n. + real_integral (dyho k n) (cw_tile s) = + real_integral (real_interval[real_of_int n * &2 zpow k, + (real_of_int n + &1) * &2 zpow k]) (cw_tile + s)`, + REPEAT GEN_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_SPIKE_SET THEN + MATCH_MP_TAC REAL_NEGLIGIBLE_SUBSET THEN + EXISTS_TAC `{real_of_int n * &2 zpow k, (real_of_int n + &1) * &2 zpow k}` + THEN + CONJ_TAC THENL + [REWRITE_TAC[REAL_NEGLIGIBLE_INSERT; REAL_NEGLIGIBLE_SING]; + REWRITE_TAC[dyho; real_interval; SUBSET; IN_UNION; IN_DIFF; IN_ELIM_THM; + IN_INSERT; NOT_IN_EMPTY] THEN REAL_ARITH_TAC]);; + +(* 286G(b), tile form: w_sigma(x_tau) mu(I_tau) <= INT_{I_tau} w_sigma, when *) +(* the centre x_sigma lies outside the open cell I_tau (so w_sigma is convex *) +(* there and Hermite-Hadamard applies). mu(I_tau) = 2^(-k_tau). *) +let CWTILE_TILE_I_MIDPOINT = prove + (`!(s:int#int#int) (kt:int) (nIt:int) (nJt:int). + (tile_xmid s <= real_of_int nIt * &2 zpow (--kt) \/ + (real_of_int nIt + &1) * &2 zpow (--kt) <= tile_xmid s) + ==> cw_tile s (tile_xmid (kt,nIt,nJt)) * (&2 zpow (--kt)) + <= real_integral (tile_I (kt,nIt,nJt)) (cw_tile s)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[tile_I; tile_xmid; dyho_mid; CWTILE_INTEGRAL_DYHO_CLOSED] THEN + ABBREV_TAC `a = real_of_int nIt * &2 zpow (--kt)` THEN + ABBREV_TAC `b = (real_of_int nIt + &1) * &2 zpow (--kt)` THEN + DISCH_TAC THEN + SUBGOAL_THEN `(real_of_int nIt + &1 / &2) * &2 zpow (--kt) = (a + b) / &2 /\ + &2 zpow (--kt) = b - a` + (CONJUNCTS_THEN SUBST1_TAC) THENL + [MAP_EVERY EXPAND_TAC ["a"; "b"] THEN CONJ_TAC THEN + REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC CWTILE_MIDPOINT_LOWER THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `&0 < &2 zpow (--kt)` MP_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + MAP_EVERY EXPAND_TAC ["a"; "b"] THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* 286Gg: the integral kernel bound. For distinct spatial cells with *) +(* k_s <= k_t, || <= C3 sqrt(muI_s) sqrt(muJ_t) int_{I_t} w_s. *) +(* sqrt(muI_s) = inv(sqrt 2^ks), sqrt(muJ_t) = sqrt 2^kt. Combines the *) +(* pointwise PHISIG_CROSS_CORRELATION with 286Gc CWTILE_TILE_I_MIDPOINT *) +(* (whose *) +(* one-sidedness hypothesis is supplied by TILE_ONESIDE_ENDPOINTS) via the *) +(* algebraic reshaping GG_RESHAPE. *) +(* ------------------------------------------------------------------------- *) + +let PHISIG_286GG = prove + (`?C3. &0 <= C3 /\ + !(ks:int) nIs nJs (kt:int) nIt nJt. ks <= kt /\ + ~(tile_I (ks,nIs,nJs) = tile_I (kt,nIt,nJt)) + ==> norm(integral (:real^1) + (\z. phi_sigma (ks,nIs,nJs) carleson_phi (drop z) * + cnj(phi_sigma (kt,nIt,nJt) carleson_phi (drop z)))) + <= C3 * inv(sqrt(&2 zpow ks)) * sqrt(&2 zpow kt) * + real_integral (tile_I (kt,nIt,nJt)) (cw_tile (ks,nIs,nJs))`, + MP_TAC PHISIG_CROSS_CORRELATION THEN + DISCH_THEN(X_CHOOSE_THEN `C:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `C:real` THEN ASM_REWRITE_TAC[] THEN + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(C * (inv(sqrt(&2 zpow (tile_k (ks,nIs,nJs)))) * + inv(sqrt(&2 zpow (tile_k (kt,nIt,nJt)))))) * + cw_tile (ks,nIs,nJs) (tile_xmid (kt,nIt,nJt))` THEN + CONJ_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[tile_k] THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[tile_k] THEN + ONCE_REWRITE_TAC[REAL_RING + `(C * inv a * inv b) * w = (C * inv a) * (inv b * w):real`] THEN + ONCE_REWRITE_TAC[REAL_RING + `C * inv a * b * i = (C * inv a) * (b * i):real`] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_INV THEN MATCH_MP_TAC SQRT_POS_LE THEN + MATCH_MP_TAC REAL_ZPOW_LE THEN REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC GG_RESHAPE THEN CONJ_TAC THENL + [SIMP_TAC[REAL_LT_IMP_LE; CW_TILE_POS]; ALL_TAC] THEN + MP_TAC(ISPECL [`(ks,nIs,nJs):int#int#int`; `kt:int`; `nIt:int`; `nJt:int`] + CWTILE_TILE_I_MIDPOINT) THEN + DISCH_THEN MATCH_MP_TAC THEN + REWRITE_TAC[tile_xmid] THEN + MP_TAC(ISPECL [`--kt:int`; `--ks:int`; `nIt:int`; `nIs:int`] + TILE_ONESIDE_ENDPOINTS) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [ASM_INT_ARITH_TAC; + REWRITE_TAC[GSYM tile_I] THEN + ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN ASM_REWRITE_TAC[]]; + DISCH_THEN(fun th -> REWRITE_TAC[th])] THEN + POP_ASSUM MP_TAC THEN REWRITE_TAC[tile_I]]);; + +(* ------------------------------------------------------------------------- *) +(* Tile geometry for 286J's same-frequency-interval sum: J_sigma = J_tau *) +(* forces k_sigma = k_tau, and distinct tiles with a common J have DISJOINT *) +(* spatial intervals I. (Grounded in dyadic-cell injectivity DYHO_INJ.) *) +(* ------------------------------------------------------------------------- *) + +(* Base 2 dilation is strictly monotone, hence injective, in the exponent. *) +let ZPOW2_INJ = prove + (`!k1 k2:int. &2 zpow k1 = &2 zpow k2 ==> k1 = k2`, + REPEAT GEN_TAC THEN + DISJ_CASES_THEN MP_TAC (INT_ARITH `k1:int = k2 \/ k1 < k2 \/ k2 < k1`) THENL + [DISCH_TAC THEN ASM_REWRITE_TAC[]; + STRIP_TAC THEN DISCH_TAC THENL + [MP_TAC(SPECL [`k1:int`;`k2:int`] ZPOW2_MONOE_LT); + MP_TAC(SPECL [`k2:int`;`k1:int`] ZPOW2_MONOE_LT)] THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC]);; + +(* Dyadic cells: equal length forces equal scale; then equal cells force *) +(* equal index (else they would be disjoint yet share their left endpoint). *) +let DYHO_EQ_IMP_SCALE = prove + (`!k1 n1 k2 n2. dyho k1 n1 = dyho k2 n2 ==> k1 = k2`, + REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC ZPOW2_INJ THEN + MP_TAC(SPECL [`k1:int`; `n1:int`] DYHO_MEASURE) THEN + MP_TAC(SPECL [`k2:int`; `n2:int`] DYHO_MEASURE) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; + +let DYHO_INJ = prove + (`!k1 n1 k2 n2. dyho k1 n1 = dyho k2 n2 ==> k1 = k2 /\ n1 = n2`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN `k1:int = k2` SUBST_ALL_TAC THENL + [ASM_MESON_TAC[DYHO_EQ_IMP_SCALE]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `n1:int = n2` THEN ASM_REWRITE_TAC[] THEN + MP_TAC(SPECL [`k2:int`;`n1:int`;`n2:int`] DYHO_DISJOINT_SAMESCALE) THEN + ASM_REWRITE_TAC[DISJOINT; EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN + DISCH_THEN(MP_TAC o SPEC `real_of_int n1 * &2 zpow k2`) THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(SPECL [`k2:int`; `n1:int`] DYHO_NONEMPTY) THEN + ASM_REWRITE_TAC[]);; + +(* --- 286L(c-ii) alpha0 FULL BOUND: summed over all coarse cover cells --- *) +(* Fremlin's |alpha0| <= (7/2) C1 gamma gamma' mu I_tau, here as the crude *) +(* constant *) +(* 2*14 = 28: sum over the cover family S (index pairs) of each cover cell's *) +(* alpha-sum *) +(* <= 2 C1 energy mass * 14 * 2^{-kt} = 2 C1 energy mass * mu Ihat_tau. *) +(* Composes *) +(* ALPHA_CELL_TOTAL (per cover cell: g(K) <= 2 C1 E M mu K) over S via *) +(* SUM_LE + SUM_ *) +(* LMUL, then the a-ii KCOVER_COARSE_MEASURE_BOUND (sum mu K <= 14 mu I_tau) *) +(* after *) +(* reindexing sum_S mu(cell ap) = sum over IMAGE-cell-S (SUM_IMAGE + *) +(* DYHO_INJ). *) +let KCOVER_SUBSET_IHAT_WIDE = prove + (`!P:(int#int#int)->bool a p kt nt. + (!s. s IN P ==> tile_I s SUBSET dyho (--kt) nt) /\ + &2 zpow a <= &2 zpow (--kt) /\ in_kcover P a p + ==> dyho a p SUBSET + real_interval[dyho_mid (--kt) nt - &7 * &2 zpow (--kt), + dyho_mid (--kt) nt + &7 * &2 zpow (--kt)]`, + REPEAT STRIP_TAC THEN REWRITE_TAC[SUBSET; IN_REAL_INTERVAL] THEN + X_GEN_TAC `y:real` THEN DISCH_TAC THEN + MP_TAC(ISPECL [`a:int`; `p:int`; `kt:int`; + `nt:int`] KCOVER_STAR_MEETS_ITAU_CONTAIN) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN MATCH_MP_TAC KCOVER_PARENT_MEETS_ITAU_GEN THEN + MAP_EVERY EXISTS_TAC [`P:(int#int#int)->bool`] THEN ASM_REWRITE_TAC[]; + DISCH_THEN(MP_TAC o SPEC `y:real`) THEN ASM_REWRITE_TAC[] THEN + REAL_ARITH_TAC]);; + +(* Total measure of the coarse cover cells (l_K >= kt) <= 14 * 2^{-kt}. Same *) +(* engine as KCOVER_COARSE_MEASURE_BOUND but with the relaxed 2^a <= *) +(* 2^{-kt}. *) +let KCOVER_COARSE_MEASURE_BOUND_WIDE = prove + (`!P:(int#int#int)->bool S kt nt. + FINITE S /\ + (!s. s IN P ==> tile_I s SUBSET dyho (--kt) nt) /\ + (!ap. ap IN S ==> in_kcover P (FST ap) (SND ap) /\ + &2 zpow (FST ap) <= &2 zpow (--kt)) + ==> sum (IMAGE (\ap. dyho (FST ap) (SND ap)) S) (\c. real_measure c) + <= &14 * &2 zpow (--kt)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`P:(int#int#int)->bool`; `S:(int#int)->bool`; + `real_interval[dyho_mid (--kt) nt - &7 * &2 zpow (--kt), + dyho_mid (--kt) nt + &7 * &2 zpow (--kt)]`] + KCOVER_MEASURE_SUM_LE) THEN + SUBGOAL_THEN + `real_measure(real_interval[dyho_mid (--kt) nt - &7 * &2 zpow (--kt), + dyho_mid (--kt) nt + &7 * &2 zpow (--kt)]) + = &14 * &2 zpow (--kt)` + (fun th -> REWRITE_TAC[th]) THENL + [REWRITE_TAC[REAL_MEASURE_REAL_INTERVAL] THEN + SUBGOAL_THEN `&0 < &2 zpow (--kt)` MP_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[REAL_MEASURABLE_REAL_INTERVAL] THEN CONJ_TAC THEN + X_GEN_TAC `ap:int#int` THEN DISCH_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `ap:int#int`) THEN ASM_SIMP_TAC[]; + MATCH_MP_TAC KCOVER_SUBSET_IHAT_WIDE THEN + MAP_EVERY EXISTS_TAC [`P:(int#int#int)->bool`] THEN + ASM_SIMP_TAC[] THEN FIRST_X_ASSUM(MP_TAC o SPEC `ap:int#int`) THEN + ASM_SIMP_TAC[]]);; + +(* alpha0 TOTAL, boundary-inclusive: gate 2^{FST ap} <= 2^{-kt} (l_K >= kt). *) +(* Identical to ALPHA0_TOTAL but over the wider cover, via KCOVER_COARSE_ *) +(* MEASURE_BOUND_WIDE (ALPHA_CELL_TOTAL is gate-free, so applies at l_K = *) +(* kt). *) +let ALPHA0_TOTAL_WIDE = prove + (`?C1. &0 <= C1 /\ + !(f:real->complex) E h (P:(int#int#int)->bool) S kt nt u. + FINITE P /\ ~(P = {}) /\ + real_lebesgue_measurable E /\ h real_measurable_on (:real) /\ + (!s. s IN P ==> tile_I s SUBSET tile_I u) /\ + (!s. s IN P ==> tile_I s SUBSET dyho (--kt) nt) /\ + (!t. cw_tile t real_integrable_on {x | x IN E /\ h x IN tile_J t}) /\ + FINITE S /\ + (!ap. ap IN S ==> in_kcover P (FST ap) (SND ap) /\ + &2 zpow (FST ap) <= &2 zpow (--kt)) + ==> sum S (\ap. sum {s | s IN P /\ tile_le s u /\ --(FST ap) <= tile_k s} + (\s. norm(carleson_ip f s * + integral (IMAGE lift ({x | x IN E /\ h x IN + tile_Jr s} INTER + dyho (FST ap) (SND ap))) + (\z. phi_sigma s carleson_phi (drop + z))))) + <= (&2 * C1 * energy_f f P * mass_Eh E h P) * (&14 * &2 zpow + (--kt))`, + X_CHOOSE_THEN + `C1:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "CT")) + ALPHA_CELL_TOTAL THEN + EXISTS_TAC `C1:real` THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&0 <= energy_f (f:real->complex) P /\ &0 <= mass_Eh E h P` + STRIP_ASSUME_TAC THENL + [ASM_SIMP_TAC[ENERGY_F_POS] THEN MATCH_MP_TAC MASS_EH_POS THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum S (\ap. (&2 * C1 * energy_f (f:real->complex) P * mass_Eh E h + P) * + real_measure (dyho (FST ap) (SND ap)))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `ap:int#int` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + USE_THEN "CT" (MP_TAC o ISPECL + [`f:real->complex`; `E:real->bool`; `h:real->real`; + `P:(int#int#int)->bool`; + `FST(ap:int#int)`; `SND(ap:int#int)`; `u:int#int#int`]) THEN + ANTS_TAC THENL [ASM_SIMP_TAC[]; DISCH_THEN MATCH_ACCEPT_TAC]; + ONCE_REWRITE_TAC[SUM_LMUL] THEN MATCH_MP_TAC REAL_LE_LMUL THEN + CONJ_TAC THENL + [REPEAT(MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + SUBGOAL_THEN + `sum S (\ap. real_measure (dyho (FST ap) (SND ap))) = + sum (IMAGE (\ap:int#int. dyho (FST ap) (SND ap)) S) (\c. real_measure + c)` + SUBST1_TAC THENL + [MATCH_MP_TAC EQ_SYM THEN + MP_TAC(ISPECL [`\ap:int#int. dyho (FST ap) (SND ap)`; + `\c:real->bool. real_measure c`; + `S:(int#int)->bool`] SUM_IMAGE) THEN + ANTS_TAC THENL + [REWRITE_TAC[FORALL_PAIR_THM] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP DYHO_INJ) THEN SIMP_TAC[PAIR_EQ]; + REWRITE_TAC[o_DEF]]; + ALL_TAC] THEN + MATCH_MP_TAC KCOVER_COARSE_MEASURE_BOUND_WIDE THEN + MAP_EVERY EXISTS_TAC [`P:(int#int#int)->bool`; `nt:int`] THEN + ASM_REWRITE_TAC[]]]);; + +(* --- 286L(d) alpha1 FULL BOUND: summed over the W1 cover --- *) + +(* 286L(a-iv) COUNT form: at most 14 cover cells at a fixed level m. Each *) +(* cover cell *) +(* dyho m q has measure 2^m and they are distinct (DYHO_INJ) so CARD S = *) +(* CARD(IMAGE *) +(* (dyho m) S); the measure sum = CARD * 2^m <= 14 * 2^m *) +(* (KCOVER_LEVEL_MEASURE_BOUND), *) +(* cancel 2^m > 0. (Fremlin's sharp a-iv count is 3; our 14 is cruder, *) +(* immaterial.) *) +(* DYHO_INJ supplies the required injectivity for CARD_IMAGE_INJ. *) +let KCOVER_LEVEL_CARD = prove + (`!P:(int#int#int)->bool S m kt nt. + FINITE S /\ &2 zpow (--kt) <= &2 zpow m /\ + (!s. s IN P ==> tile_I s SUBSET dyho (--kt) nt) /\ + (!q. q IN S ==> in_kcover P m q) + ==> &(CARD S) <= &14`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&0 < &2 zpow m` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `CARD (IMAGE (\q. dyho m q) S) = CARD (S:int->bool)` ASSUME_TAC THENL + [MATCH_MP_TAC CARD_IMAGE_INJ THEN ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC [`q1:int`; `q2:int`] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP DYHO_INJ) THEN SIMP_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `&(CARD (S:int->bool)) * &2 zpow m <= &14 * &2 zpow m` MP_TAC THENL + [MP_TAC(ISPECL [`P:(int#int#int)->bool`; `S:int->bool`; `m:int`; `kt:int`; + `nt:int`] + KCOVER_LEVEL_MEASURE_BOUND) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REAL_ARITH `a = b ==> a <= c ==> b <= c`) THEN + SUBGOAL_THEN + `sum (IMAGE (\q. dyho m q) S) (\c. real_measure c) = + sum (IMAGE (\q. dyho m q) S) (\c. &2 zpow m)` SUBST1_TAC THENL + [MATCH_MP_TAC SUM_EQ THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN + X_GEN_TAC `q:int` THEN DISCH_TAC THEN + REWRITE_TAC[DYHO_MEASURE]; ALL_TAC] THEN + SIMP_TAC[SUM_CONST; FINITE_IMAGE; ASSUME `FINITE(S:int->bool)`] THEN + ASM_REWRITE_TAC[REAL_MUL_SYM]; + ASM_SIMP_TAC[REAL_LE_RMUL_EQ]]);; + +(* Per-level count for the alpha1 coarse-level sum: <=14 cover cells at each *) +(* level m. *) +(* Projects the fiber {ap IN S | FST ap = m} (pairs) to its SND-indices *) +(* (injective, *) +(* since FST is fixed) then KCOVER_LEVEL_CARD. Empty fiber => CARD 0. The *) +(* 2^{-kt}<=2^m *) +(* side-condition of KCOVER_LEVEL_CARD comes from a witness cell in the *) +(* (nonempty) fiber. *) +let ALPHA1_LEVEL_COUNT = prove + (`!P:(int#int#int)->bool S kt nt m. + FINITE S /\ + (!s. s IN P ==> tile_I s SUBSET dyho (--kt) nt) /\ + (!ap. ap IN S ==> in_kcover P (FST ap) (SND ap) /\ + &2 zpow (--kt) < &2 zpow (FST ap)) + ==> &(CARD {ap | ap IN S /\ FST ap = m}) <= &14`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `{ap:int#int | ap IN S /\ FST ap = m} = {}` THENL + [ASM_REWRITE_TAC[CARD_CLAUSES] THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `&2 zpow (--kt) <= &2 zpow m` ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC o REWRITE_RULE[GSYM MEMBER_NOT_EMPTY]) THEN + REWRITE_TAC[IN_ELIM_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `ap:int#int` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `ap:int#int`) THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `CARD {ap:int#int | ap IN S /\ FST ap = m} = + CARD (IMAGE SND {ap:int#int | ap IN S /\ FST ap = m})` SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC CARD_IMAGE_INJ THEN + ASM_SIMP_TAC[FINITE_RESTRICT] THEN + REWRITE_TAC[FORALL_PAIR_THM; IN_ELIM_THM] THEN + MAP_EVERY X_GEN_TAC [`p1:int`; `p2:int`; `p1':int`; `p2':int`] THEN + REWRITE_TAC[PAIR_EQ] THEN STRIP_TAC THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC KCOVER_LEVEL_CARD THEN + MAP_EVERY EXISTS_TAC [`P:(int#int#int)->bool`; `m:int`; `kt:int`; + `nt:int`] THEN + ASM_SIMP_TAC[FINITE_IMAGE; FINITE_RESTRICT] THEN + REWRITE_TAC[FORALL_IN_IMAGE; IN_ELIM_THM; FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC [`aa:int`; `pp:int`] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(aa,pp):int#int`) THEN ASM_REWRITE_TAC[] THEN + SIMP_TAC[]);; + +(* The alpha1 constant-collapse identity: inv(8^kt) inv(4^{-kt+1}) = inv(4) *) +(* 2^{-kt} *) +(* (both sides = 2^{-kt-2}). With the (8/7)(14)(4/3) prefactor this gives *) +(* 16/3. All *) +(* via 8^kt = 2^{3kt}, 4^{-kt+1} = 2^{2(-kt+1)} (ZPOW_2_3/ZPOW_2_2), combine *) +(* exponents. *) +let ZPOW_ALPHA1_ARITH = prove + (`!kt:int. inv(&8 zpow kt) * inv(&4 zpow (--kt + &1)) = inv(&4) * &2 zpow + (--kt)`, + GEN_TAC THEN + SUBGOAL_THEN `&8 zpow kt = &2 zpow (&3 * kt)` SUBST1_TAC THENL + [REWRITE_TAC[ZPOW_2_3]; ALL_TAC] THEN + SUBGOAL_THEN + `&4 zpow (--kt + &1) = &2 zpow (&2 * (--kt + &1))` SUBST1_TAC THENL + [REWRITE_TAC[ZPOW_2_2]; ALL_TAC] THEN + REWRITE_TAC[GSYM REAL_INV_MUL] THEN + SIMP_TAC[GSYM REAL_ZPOW_ADD; REAL_ARITH `~(&2 = &0)`] THEN + SUBGOAL_THEN `inv(&4) = &2 zpow (-- &2)` SUBST1_TAC THENL + [REWRITE_TAC[REAL_ZPOW_NEG; REAL_ZPOW_POW] THEN + CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN + SIMP_TAC[GSYM REAL_ZPOW_ADD; REAL_ARITH `~(&2 = &0)`] THEN + REWRITE_TAC[GSYM REAL_ZPOW_NEG] THEN AP_TERM_TAC THEN INT_ARITH_TAC);; + +(* THE FULL alpha1 bound (Fremlin 286L(d)): sum over the W1 cover (cells *) +(* with mu K > *) +(* mu I_tau, i.e. 2^{-kt} < 2^{FST ap}) of each cover cell's alpha-sum <= *) +(* (16/3) C1 *) +(* energy mass 2^{-kt} = (16/3) C1 gamma gamma' mu I_tau (Fremlin's sharp *) +(* 8/7; 16/3 *) +(* immaterial). DOUBLE geometric: per cell g(a,p) <= (8/7) C1 E mass *) +(* inv(4^a) inv(8^kt) *) +(* (ALPHA_CELL1_GEOM_SUM, cubic k-sum), then sum over cover levels a *) +(* (quadratic, <=14 *) +(* cells/level via ALPHA1_LEVEL_COUNT) with LEVEL_WEIGHTED_SUM_LE: sum *) +(* inv(4^{FST ap}) *) +(* <= 14 (4/3) inv(4^{-kt+1}); collapse via ZPOW_ALPHA1_ARITH. W1 level *) +(* bound -kt+1 <= *) +(* FST ap from ZPOW2_LT_REV on 2^{-kt} < 2^{FST ap}. *) +let ALPHA1_TOTAL = prove + (`?C1. &0 <= C1 /\ + !(f:real->complex) E h (P:(int#int#int)->bool) S kt nt u. + FINITE P /\ ~(P = {}) /\ + real_lebesgue_measurable E /\ h real_measurable_on (:real) /\ + (!s. s IN P ==> tile_I s SUBSET tile_I u) /\ + (!s. s IN P ==> tile_I s SUBSET dyho (--kt) nt) /\ + (!t. cw_tile t real_integrable_on {x | x IN E /\ h x IN tile_J t}) /\ + tile_k u = kt /\ FINITE S /\ + (!ap. ap IN S ==> in_kcover P (FST ap) (SND ap) /\ + &2 zpow (--kt) < &2 zpow (FST ap)) + ==> sum S (\ap. sum {s | s IN P /\ tile_le s u /\ --(FST ap) <= tile_k s} + (\s. norm(carleson_ip f s * + integral (IMAGE lift ({x | x IN E /\ h x IN + tile_Jr s} INTER + dyho (FST ap) (SND ap))) + (\z. phi_sigma s carleson_phi (drop + z))))) + <= C1 * energy_f f P * mass_Eh E h P * &2 zpow (--kt)`, + X_CHOOSE_THEN `Cg:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "CG")) + ALPHA_CELL1_GEOM_SUM THEN + EXISTS_TAC `&16 / &3 * Cg` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [REAL_ARITH_TAC; ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&0 <= energy_f (f:real->complex) P /\ &0 <= mass_Eh E h P` + STRIP_ASSUME_TAC THENL + [ASM_SIMP_TAC[ENERGY_F_POS] THEN MATCH_MP_TAC MASS_EH_POS THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `sum S (\ap:int#int. ((&8 / &7) * (Cg * energy_f (f:real->complex) P * + mass_Eh E h P * + inv(&8 zpow kt))) * inv(&4 zpow (FST ap)))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `ap:int#int` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + USE_THEN "CG" (MP_TAC o ISPECL + [`f:real->complex`; `E:real->bool`; `h:real->real`; + `P:(int#int#int)->bool`; + `FST(ap:int#int)`; `SND(ap:int#int)`; `u:int#int#int`]) THEN + ANTS_TAC THENL [ASM_SIMP_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `a = b ==> x <= a ==> x <= b`) THEN + ASM_REWRITE_TAC[GSYM ZPOW_2_2] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[SUM_LMUL] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `((&8 / &7) * (Cg * energy_f (f:real->complex) P * mass_Eh E h P * inv(&8 + zpow kt))) * + (&14 * (&4 / &3) * inv(&4 zpow (--kt + &1)))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [REPEAT(MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC) THEN + ASM_REWRITE_TAC[REAL_LE_INV_EQ] THEN TRY REAL_ARITH_TAC THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN MATCH_MP_TAC REAL_ZPOW_LT THEN + REAL_ARITH_TAC; + MP_TAC(ISPECL [`S:(int#int)->bool`; `FST:int#int->int`; `--kt + &1:int`; + `&14:real`] + LEVEL_WEIGHTED_SUM_LE) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [REAL_ARITH_TAC; + X_GEN_TAC `ap:int#int` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `ap:int#int`) THEN ASM_REWRITE_TAC[] THEN + STRIP_TAC THEN + SUBGOAL_THEN `(--kt:int) < FST(ap:int#int)` MP_TAC THENL + [MATCH_MP_TAC ZPOW2_LT_REV THEN ASM_REWRITE_TAC[]; INT_ARITH_TAC]; + X_GEN_TAC `m:int` THEN + MATCH_MP_TAC ALPHA1_LEVEL_COUNT THEN + MAP_EVERY EXISTS_TAC [`P:(int#int#int)->bool`; `kt:int`; + `nt:int`] THEN + ASM_REWRITE_TAC[]]; + DISCH_THEN MATCH_ACCEPT_TAC]]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_EQ_IMP_LE THEN + ONCE_REWRITE_TAC[REAL_ARITH + `((&8 / &7) * (Cg * e * m * i8)) * (&14 * (&4 / &3) * i4) = + (Cg * e * m) * ((&8 / &7) * &14 * (&4 / &3)) * (i8 * i4)`] THEN + REWRITE_TAC[ZPOW_ALPHA1_ARITH] THEN REAL_ARITH_TAC);; + +(* 286J geometry: same frequency interval => same height. *) +let TILE_J_EQ_IMP_K = prove + (`!(s:int#int#int) (t:int#int#int). tile_J s = tile_J t ==> tile_k s = tile_k + t`, + REWRITE_TAC[FORALL_PAIR_THM; tile_J; tile_k] THEN + REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP DYHO_INJ) THEN + SIMP_TAC[]);; + +(* 286J geometry: distinct tiles sharing a frequency interval have disjoint *) +(* I. *) +let TILE_SAMEJ_DISTINCT_DISJOINT_I = prove + (`!(s:int#int#int) (t:int#int#int). + ~(s = t) /\ tile_J s = tile_J t ==> DISJOINT (tile_I s) (tile_I t)`, + REWRITE_TAC[FORALL_PAIR_THM; tile_J; tile_I; PAIR_EQ] THEN + MAP_EVERY X_GEN_TAC + [`ks:int`;`nIs:int`;`nJs:int`;`kt:int`;`nIt:int`;`nJt:int`] THEN + STRIP_TAC THEN + MP_TAC(SPECL [`ks:int`;`nJs:int`;`kt:int`;`nJt:int`] DYHO_INJ) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN + SUBGOAL_THEN `~(nIs:int = nIt)` ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC o check (is_neg o concl)) THEN ASM_REWRITE_TAC[] THEN + INT_ARITH_TAC; ALL_TAC] THEN + UNDISCH_TAC `ks:int = kt` THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN + MATCH_MP_TAC DYHO_DISJOINT_SAMESCALE THEN ASM_REWRITE_TAC[]);; + +(* 286Fc geometry, half 1: for coarser-scale s (ks flaky *) +(* count). *) +let JR_NEST_LT = prove + (`!ks kt nJs nJt. + ks < kt /\ ~(dyho (ks - &1) (&2 * nJs + &1) INTER dyho (kt - &1) (&2 * nJt + + &1) = {}) + ==> dyho (ks - &1) (&2 * nJs + &1) SUBSET dyho (kt - &1) (&2 * nJt + &1)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`ks - &1:int`; `&2 * nJs + &1:int`; `kt - &1:int`; + `&2 * nJt + &1:int`] DYHO_TRICHOTOMY) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THENL + [FIRST_ASSUM ACCEPT_TAC; + FIRST_X_ASSUM(MP_TAC o MATCH_MP DYHO_SUBSET_SCALE) THEN ASM_INT_ARITH_TAC; + FIRST_X_ASSUM(MP_TAC o REWRITE_RULE[GSYM DISJOINT]) THEN + ASM_MESON_TAC[DISJOINT]]);; + +(* 286Fc geometry, half 2: with J^r_s SUBSET J^r_t (ks 1<=kt-ks needs a :int *) +(* hint). *) +let JL_IN_JR_LT = prove + (`!ks kt nJs nJt. + ks < kt /\ dyho (ks - &1) (&2 * nJs + &1) SUBSET dyho (kt - &1) (&2 * nJt + + &1) + ==> dyho (ks - &1) (&2 * nJs) SUBSET dyho (kt - &1) (&2 * nJt + &1)`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(X_CHOOSE_THEN `M':int` STRIP_ASSUME_TAC o + MATCH_MP ZPOW_POS_EVEN_INT2 o MATCH_MP (INT_ARITH `ks:int < kt ==> &1 <= kt + - ks`)) THEN + MP_TAC(ISPECL [`ks - &1:int`; `kt - &1:int`; `&2 * M':int`; + `&2 * nJt + &1:int`; + `&2 * nJs + &1:int`] DYHO_SUBCELL_IFF) THEN + SUBST1_TAC(INT_ARITH `(kt - &1) - (ks - &1):int = kt - ks`) THEN + ANTS_TAC THENL [ASM_INT_ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + MP_TAC(ISPECL [`ks - &1:int`; `kt - &1:int`; `&2 * M':int`; + `&2 * nJt + &1:int`; + `&2 * nJs:int`] DYHO_SUBCELL_IFF) THEN + SUBST1_TAC(INT_ARITH `(kt - &1) - (ks - &1):int = kt - ks`) THEN + ANTS_TAC THENL [ASM_INT_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN + CONJ_TAC THENL + [MATCH_MP_TAC ODD_PROD_HALF_LE THEN ASM_REWRITE_TAC[]; ASM_INT_ARITH_TAC]);; + +(* 286Fc J^l-disjointness, directional (ks disjoint J^l. J^r_s SUBSET J^r_t (JR_NEST_LT), J^l_s SUBSET J^r_t *) +(* (JL_IN_JR_LT), and J^l_t is disjoint from its sibling J^r_t *) +(* (DYHO_DISJOINT_ *) +(* SAMESCALE at scale kt-1), so J^l_s cap J^l_t SUBSET J^r_t cap J^l_t = *) +(* empty. *) +let TILE_JL_DISJOINT_LT = prove + (`!ks kt nJs nJt. + ks < kt /\ ~(dyho (ks - &1) (&2 * nJs + &1) INTER dyho (kt - &1) (&2 * nJt + + &1) = {}) + ==> dyho (ks - &1) (&2 * nJs) INTER dyho (kt - &1) (&2 * nJt) = {}`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`ks:int`; `kt:int`; `nJs:int`; `nJt:int`] JR_NEST_LT) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`ks:int`; `kt:int`; `nJs:int`; `nJt:int`] JL_IN_JR_LT) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`kt - &1:int`; `&2 * nJt:int`; `&2 * nJt + &1:int`] + DYHO_DISJOINT_SAMESCALE) THEN + ANTS_TAC THENL [INT_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[DISJOINT] THEN ASM SET_TAC[]);; + +(* Symmetric version: k_s <> k_t (either order) => J^l disjoint. *) +let TILE_JL_DISJOINT = prove + (`!ks kt nJs nJt. + ~(ks = kt) /\ ~(dyho (ks - &1) (&2 * nJs + &1) INTER dyho (kt - &1) (&2 * + nJt + &1) = {}) + ==> dyho (ks - &1) (&2 * nJs) INTER dyho (kt - &1) (&2 * nJt) = {}`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `ks:int < kt \/ kt < ks` DISJ_CASES_TAC THENL + [ASM_INT_ARITH_TAC; ALL_TAC; ALL_TAC] THENL + [MATCH_MP_TAC TILE_JL_DISJOINT_LT THEN ASM_REWRITE_TAC[]; + ONCE_REWRITE_TAC[INTER_COMM] THEN + MATCH_MP_TAC TILE_JL_DISJOINT_LT THEN ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[INTER_COMM] THEN ASM_REWRITE_TAC[]]);; + +(* The right frequency-half is nonempty. *) +let TILE_JR_NONEMPTY = prove + (`!s:int#int#int. ~(tile_Jr s = {})`, + REWRITE_TAC[FORALL_PAIR_THM; tile_Jr; GSYM MEMBER_NOT_EMPTY] THEN + MESON_TAC[DYHO_NONEMPTY]);; + +(* 286L (i) frequency-nesting: for two tree tiles s, s' <=_r tau at scales *) +(* k_s <= k_s', the right-halves nest J^r_s SUBSET J^r_s'. (tile_Jr(k,.) = *) +(* dyho(k-1)(.) so the FINER scale k_s' gives the LONGER right-half; both *) +(* contain *) +(* J^r_tau so they meet, and DYHO_MEET_NEST closes it.) This makes *) +(* {s <=_r tau : g(x) IN J^r_s} an UP-SET in k_s -- the structural fact *) +(* behind *) +(* Fremlin's "g(x) IN J^r_sigma iff k_sigma >= m" threshold in part (i). *) +let TILE_TREE_JR_NEST = prove + (`!s s' tau. tile_ler s tau /\ tile_ler s' tau /\ tile_k s <= tile_k s' + ==> tile_Jr s SUBSET tile_Jr s'`, + REWRITE_TAC[FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC + [`ks:int`;`nIs:int`;`nJs:int`; `ks':int`;`nIs':int`;`nJs':int`; + `kt:int`;`nIt:int`;`nJt:int`] THEN + REWRITE_TAC[tile_ler; tile_Jr; tile_k] THEN STRIP_TAC THEN + MATCH_MP_TAC DYHO_MEET_NEST THEN CONJ_TAC THENL + [UNDISCH_TAC `(ks:int) <= ks'` THEN INT_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[DISJOINT; GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN + MP_TAC(ISPEC `(kt:int,nIt:int,nJt:int)` TILE_JR_NONEMPTY) THEN + REWRITE_TAC[tile_Jr; GSYM MEMBER_NOT_EMPTY] THEN + DISCH_THEN(X_CHOOSE_TAC `y:real`) THEN EXISTS_TAC `y:real` THEN + CONJ_TAC THENL + [UNDISCH_TAC `dyho (kt - &1) (&2 * nJt + &1) SUBSET dyho (ks - &1) (&2 * nJs + + &1)` THEN + REWRITE_TAC[SUBSET] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + UNDISCH_TAC `dyho (kt - &1) (&2 * nJt + &1) SUBSET dyho (ks' - &1) (&2 * + nJs' + &1)` THEN + REWRITE_TAC[SUBSET] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* M4 (A-tree): the tile-tree containments feeding the step-(iv) band hyps. *) +(* For sigma <=_r tau (so J^r_tau SUBSET J^r_sigma, k_tau <= k_sigma) and *) +(* J_tau SUBSET Jhat = dyho m nhat (the length-2^m containing interval): *) +(* KEEP (k_sigma <= m): J^l_sigma SUBSET Jhat (feeds PHISIG_CPSI_KEEP_GEOM); *) +(* KILL (k_sigma > m): Jhat SUBSET J^r_sigma (feeds the sharp-support kill). *) +(* All via DYHO_MEET_NEST at the shared cell J^r_tau (TILE_JR_NONEMPTY). *) +(* ------------------------------------------------------------------------- *) + +(* J^l_sigma SUBSET J_sigma (left half in parent; DYHO_PARENT at p = 2 nJ). *) +let TILE_JL_SUBSET_J = prove + (`!s:int#int#int. tile_Jl s SUBSET tile_J s`, + MATCH_MP_TAC(MESON[PAIR_SURJECTIVE] + `(!k nI nJ. P (k,nI,nJ)) ==> (!s. P s)`) THEN + MAP_EVERY X_GEN_TAC [`k:int`;`nI:int`;`nJ:int`] THEN + REWRITE_TAC[tile_J; tile_Jl] THEN + MP_TAC(ISPECL [`k - &1:int`; `&2 * nJ:int`] DYHO_PARENT) THEN + SUBGOAL_THEN `(k - &1) + &1:int = k` SUBST1_TAC THENL + [INT_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `(&2 * nJ) div &2 = nJ:int` SUBST1_TAC THENL + [INT_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[]);; + +(* J_sigma SUBSET Jhat when k_sigma <= m: J_sigma (scale k_sigma) meets Jhat *) +(* (scale m) at the shared J^r_tau, and is finer, so DYHO_MEET_NEST. *) +let TILE_TREE_J_IN_JHAT = prove + (`!(s:int#int#int) (tau:int#int#int) m nhat. + tile_ler s tau /\ tile_J tau SUBSET dyho m nhat /\ tile_k s <= m + ==> tile_J s SUBSET dyho m nhat`, + MATCH_MP_TAC(MESON[PAIR_SURJECTIVE] + `(!k nI nJ tau m nhat. P (k,nI,nJ) tau m nhat) + ==> (!s tau m nhat. P s tau m nhat)`) THEN + MAP_EVERY X_GEN_TAC [`k:int`;`nI:int`;`nJ:int`] THEN REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "ler") + (CONJUNCTS_THEN2 (LABEL_TAC "jh") (LABEL_TAC "km"))) THEN + REWRITE_TAC[tile_J] THEN MATCH_MP_TAC DYHO_MEET_NEST THEN CONJ_TAC THENL + [USE_THEN "km" MP_TAC THEN REWRITE_TAC[tile_k] THEN + INT_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `tile_Jr tau SUBSET dyho m nhat` (LABEL_TAC "jr_jh") THENL + [MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `tile_J tau` THEN + CONJ_TAC THENL [REWRITE_TAC[TILE_JR_SUBSET_J]; USE_THEN + "jh" ACCEPT_TAC]; ALL_TAC] THEN + SUBGOAL_THEN `tile_Jr tau SUBSET dyho k nJ` (LABEL_TAC "jr_j") THENL + [MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `tile_Jr (k,nI,nJ)` THEN + CONJ_TAC THENL + [USE_THEN "ler" MP_TAC THEN REWRITE_TAC[tile_ler] THEN SIMP_TAC[]; + REWRITE_TAC[tile_Jr] THEN + MATCH_ACCEPT_TAC DYHO_JR_SUBSET_J]; ALL_TAC] THEN + MP_TAC(ISPEC `tau:int#int#int` TILE_JR_NONEMPTY) THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + DISCH_THEN(X_CHOOSE_TAC `x:real`) THEN + REWRITE_TAC[SET_RULE `~DISJOINT s t <=> ?x. x IN s /\ x IN t`] THEN + EXISTS_TAC `x:real` THEN CONJ_TAC THENL + [USE_THEN "jr_j" MP_TAC THEN REWRITE_TAC[SUBSET] THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + USE_THEN "jr_jh" MP_TAC THEN REWRITE_TAC[SUBSET] THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]);; + +(* KEEP tree containment: J^l_sigma SUBSET Jhat (via J^l_sigma SUBSET *) +(* J_sigma SUBSET Jhat). *) +let TILE_TREE_JHAT_KEEP = prove + (`!(s:int#int#int) (tau:int#int#int) m nhat. + tile_ler s tau /\ tile_J tau SUBSET dyho m nhat /\ tile_k s <= m + ==> tile_Jl s SUBSET dyho m nhat`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `tile_J s` THEN REWRITE_TAC[TILE_JL_SUBSET_J] THEN + MATCH_MP_TAC TILE_TREE_J_IN_JHAT THEN + EXISTS_TAC `tau:int#int#int` THEN ASM_REWRITE_TAC[]);; + +(* KILL tree containment: Jhat SUBSET J^r_sigma when k_sigma > m. Jhat *) +(* (scale *) +(* m) meets J^r_sigma (scale k_sigma-1 >= m) at the shared J^r_tau, Jhat *) +(* finer. *) +let TILE_TREE_JHAT_KILL = prove + (`!(s:int#int#int) (tau:int#int#int) m nhat. + tile_ler s tau /\ tile_J tau SUBSET dyho m nhat /\ m < tile_k s + ==> dyho m nhat SUBSET tile_Jr s`, + MATCH_MP_TAC(MESON[PAIR_SURJECTIVE] + `(!k nI nJ tau m nhat. P (k,nI,nJ) tau m nhat) + ==> (!s tau m nhat. P s tau m nhat)`) THEN + MAP_EVERY X_GEN_TAC [`k:int`;`nI:int`;`nJ:int`] THEN REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "ler") + (CONJUNCTS_THEN2 (LABEL_TAC "jh") (LABEL_TAC "km"))) THEN + REWRITE_TAC[tile_Jr] THEN MATCH_MP_TAC DYHO_MEET_NEST THEN CONJ_TAC THENL + [USE_THEN "km" MP_TAC THEN REWRITE_TAC[tile_k] THEN + INT_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `tile_Jr tau SUBSET dyho m nhat` (LABEL_TAC "jr_jh") THENL + [MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `tile_J tau` THEN + CONJ_TAC THENL [REWRITE_TAC[TILE_JR_SUBSET_J]; USE_THEN + "jh" ACCEPT_TAC]; ALL_TAC] THEN + SUBGOAL_THEN + `tile_Jr tau SUBSET dyho (k - &1) (&2 * nJ + &1)` (LABEL_TAC "jr_jr") THENL + [USE_THEN "ler" MP_TAC THEN REWRITE_TAC[tile_ler; tile_Jr] THEN + SIMP_TAC[]; ALL_TAC] THEN + MP_TAC(ISPEC `tau:int#int#int` TILE_JR_NONEMPTY) THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + DISCH_THEN(X_CHOOSE_TAC `x:real`) THEN + REWRITE_TAC[SET_RULE `~DISJOINT s t <=> ?x. x IN s /\ x IN t`] THEN + EXISTS_TAC `x:real` THEN CONJ_TAC THENL + [USE_THEN "jr_jh" MP_TAC THEN REWRITE_TAC[SUBSET] THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + USE_THEN "jr_jr" MP_TAC THEN REWRITE_TAC[SUBSET] THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* M4 (A-tree) capstones: the tree-level per-tile step-(iv) identities. *) +(* Given sigma <=_r tau and J_tau SUBSET Jhat = dyho m nhat, the KEEP/KILL *) +(* pointwise identities hold with anchor yhat = dyho_mid m nhat (midpoint of *) +(* Jhat). These are the direct inputs to step (B) (the transform identity). *) +(* ------------------------------------------------------------------------- *) + +(* KILL band (Fremlin (h)(iii) arithmetic): for z in the sharp support *) +(* [tile_ymid s +- (1/5)2^k], the anchor dyho_mid m nhat is >= (3/5)2^m *) +(* away. From dyho m nhat SUBSET tile_Jr s (DYHO_SUBSET_ENDPOINTS at scales *) +(* m, k-1 gives (2nJ+1)2^{k-1} <= nhat 2^m, i.e. Jhat's left edge >= *) +(* J^r_sigma's), and 2^k = 2*2^{k-1} >= 2*2^m; the (1/20)2^k + (1/2)2^m >= *) +(* (3/5)2^m closes it. *) +let TILE_TREE_KILL_BAND = prove + (`!(s:int#int#int) m nhat. + dyho m nhat SUBSET tile_Jr s /\ m < tile_k s + ==> (!z. tile_ymid s - &1 / &5 * &2 zpow (tile_k s) <= z /\ + z <= tile_ymid s + &1 / &5 * &2 zpow (tile_k s) + ==> &3 * &2 zpow m / &5 <= abs(z - dyho_mid m nhat))`, + MATCH_MP_TAC(MESON[PAIR_SURJECTIVE] + `(!k nI nJ m nhat. P (k,nI,nJ) m nhat) ==> (!s m nhat. P s m nhat)`) THEN + MAP_EVERY X_GEN_TAC [`k:int`;`nI:int`;`nJ:int`;`m:int`;`nhat:int`] THEN + REWRITE_TAC[tile_Jr; tile_ymid; tile_k] THEN STRIP_TAC THEN + X_GEN_TAC `z:real` THEN STRIP_TAC THEN + MP_TAC(ISPECL [`m:int`; `k - &1:int`; `nhat:int`; `&2 * nJ + &1:int`] + DYHO_SUBSET_ENDPOINTS) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN ASM_INT_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(MP_TAC o CONJUNCT1) THEN DISCH_TAC THEN + REWRITE_TAC[dyho_mid] THEN + MP_TAC(ISPEC `k:int` ZPOWK_HALF) THEN + MP_TAC(ISPECL [`m:int`; `k - &1:int`] ZPOW2_MONOE) THEN + ANTS_TAC THENL [ASM_INT_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `&0 < &2 zpow m /\ &0 < &2 zpow (k - &1)` STRIP_ASSUME_TAC THENL + [CONJ_TAC THEN MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[dyho_mid; int_add_th; int_mul_th; + int_of_num_th]) THEN + REPEAT STRIP_TAC THEN ASM_REAL_ARITH_TAC);; + +(* KEEP tree identity: sigma <=_r tau /\ J_tau SUBSET Jhat /\ k_sigma <= m *) +(* ==> phihat_sigma * cpsi(m, midpt Jhat) = phihat_sigma. *) +(* TILE_TREE_JHAT_KEEP *) +(* (J^l_sigma SUBSET Jhat) then PHISIG_CPSI_KEEP_GEOM. *) +let PHISIG_CPSI_KEEP_TREE = prove + (`!(s:int#int#int) (tau:int#int#int) m nhat y. + tile_ler s tau /\ tile_J tau SUBSET dyho m nhat /\ tile_k s <= m + ==> fourier (phi_sigma s carleson_phi) y * cpsi m (dyho_mid m nhat) y = + fourier (phi_sigma s carleson_phi) y`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC PHISIG_CPSI_KEEP_GEOM THEN + MATCH_MP_TAC TILE_TREE_JHAT_KEEP THEN + EXISTS_TAC `tau:int#int#int` THEN ASM_REWRITE_TAC[]);; + +(* KILL tree identity: sigma <=_r tau /\ J_tau SUBSET Jhat /\ m < k_sigma *) +(* ==> phihat_sigma * cpsi(m, midpt Jhat) = 0. TILE_TREE_JHAT_KILL (Jhat *) +(* SUBSET *) +(* J^r_sigma) then TILE_TREE_KILL_BAND (the band) then *) +(* PHISIG_CPSI_KILL_CLOSED. *) +let PHISIG_CPSI_KILL_TREE = prove + (`!(s:int#int#int) (tau:int#int#int) m nhat y. + tile_ler s tau /\ tile_J tau SUBSET dyho m nhat /\ m < tile_k s + ==> fourier (phi_sigma s carleson_phi) y * cpsi m (dyho_mid m nhat) y = + Cx(&0)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC PHISIG_CPSI_KILL_CLOSED THEN + MATCH_MP_TAC TILE_TREE_KILL_BAND THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC TILE_TREE_JHAT_KILL THEN + EXISTS_TAC `tau:int#int#int` THEN ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* M4 STEP (B) = Fremlin 286(h)(iv)/(v) transform identity: gt_m^ = cpsi *) +(* gt^. *) +(* For the m-cutoff tree sub-sum gt_m (only tiles with k_sigma <= m) and the *) +(* full tree sum ftilde = gt, with J_tau SUBSET Jhat = dyho m nhat: *) +(* fourier(gt_m) y = cpsi m (dyho_mid m nhat) y * fourier(gt) y. *) +(* FTILDE_FHAT pushes both transforms onto the tiles; VSUM_COMPLEX_LMUL *) +(* pulls *) +(* cpsi into the full sum; VSUM_SUPERSET drops the k>m terms (KILL_TREE = 0) *) +(* and VSUM_EQ keeps the k<=m terms (KEEP_TREE: phihat*cpsi = phihat). *) +let FTILDE_CPSI_FHAT = prove + (`!(c:(int#int#int)->complex) (P:(int#int#int)->bool) tau m nhat y. + FINITE P /\ tile_J tau SUBSET dyho m nhat + ==> fourier (\x. vsum {s | s IN P /\ tile_ler s tau /\ tile_k s <= m} + (\s. c s * phi_sigma s carleson_phi x)) y = + cpsi m (dyho_mid m nhat) y * + fourier (\x. vsum {s | s IN P /\ tile_ler s tau} + (\s. c s * phi_sigma s carleson_phi x)) y`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `FINITE {s:int#int#int | s IN P /\ tile_ler s tau /\ tile_k s <= m} /\ + FINITE {s:int#int#int | s IN P /\ tile_ler s tau}` + STRIP_ASSUME_TAC THENL + [CONJ_TAC THEN MATCH_MP_TAC FINITE_RESTRICT THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_SIMP_TAC[FTILDE_FHAT] THEN + ASM_SIMP_TAC[GSYM VSUM_COMPLEX_LMUL] THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC + `vsum {s:int#int#int | s IN P /\ tile_ler s tau /\ tile_k s <= m} + (\x. cpsi m (dyho_mid m nhat) y * c x * fourier (phi_sigma x + carleson_phi) y)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC VSUM_SUPERSET THEN CONJ_TAC THENL + [SET_TAC[]; + X_GEN_TAC `s:int#int#int` THEN REWRITE_TAC[IN_ELIM_THM] THEN + STRIP_TAC THEN + BETA_TAC THEN + SUBGOAL_THEN `m < tile_k s` ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC o check (is_neg o concl)) THEN + ASM_REWRITE_TAC[] THEN INT_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `fourier (phi_sigma s carleson_phi) y * cpsi m (dyho_mid m nhat) y = + Cx(&0)` + MP_TAC THENL + [MATCH_MP_TAC PHISIG_CPSI_KILL_TREE THEN + EXISTS_TAC `tau:int#int#int` THEN + ASM_REWRITE_TAC[]; + REWRITE_TAC[COMPLEX_VEC_0] THEN CONV_TAC COMPLEX_RING]]; + MATCH_MP_TAC VSUM_EQ THEN X_GEN_TAC `s:int#int#int` THEN + REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN BETA_TAC THEN + SUBGOAL_THEN + `fourier (phi_sigma s carleson_phi) y * cpsi m (dyho_mid m nhat) y = + fourier (phi_sigma s carleson_phi) y` + MP_TAC THENL + [MATCH_MP_TAC PHISIG_CPSI_KEEP_TREE THEN EXISTS_TAC `tau:int#int#int` THEN + ASM_REWRITE_TAC[]; + CONV_TAC COMPLEX_RING]]);; + +(* Tile-level restatement of TILE_JL_DISJOINT (on tile_Jr/tile_Jl/tile_k). *) +let TILE_JL_DISJOINT_T = prove + (`!(s:int#int#int) (t:int#int#int). + ~(tile_k s = tile_k t) /\ ~(tile_Jr s INTER tile_Jr t = {}) + ==> tile_Jl s INTER tile_Jl t = {}`, + REWRITE_TAC[FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC + [`ks:int`;`nIs:int`;`nJs:int`;`kt:int`;`nIt:int`;`nJt:int`] THEN + REWRITE_TAC[tile_Jr; tile_Jl; tile_k] THEN REWRITE_TAC[TILE_JL_DISJOINT]);; + +(* ------------------------------------------------------------------------- *) +(* 286Fc / 286E(b-iv): TREE FREQUENCY ORTHOGONALITY. Two tree tiles s, t *) +(* (both <=_r tau, so J^r_tau SUBSET J^r_s cap J^r_t is nonempty) at *) +(* DIFFERENT *) +(* scales (k_s <> k_t) have ORTHOGONAL test functions, because their left *) +(* frequency-halves J^l are disjoint (TILE_JL_DISJOINT_T) and phi_sigma^ is *) +(* supported in J^l (PHISIG_CARLESON_ORTHO_JL). This is the fact that makes *) +(* the alpha3 off-diagonal-J block VANISH on the tree, so ||g~||_2^2 reduces *) +(* to *) +(* the diagonal-J block (CARLESON_DIAGBLOCK_LE). *) +(* ------------------------------------------------------------------------- *) +let PHISIG_TREE_ORTHO = prove + (`!(s:int#int#int) (t:int#int#int) tau. + tile_ler s tau /\ tile_ler t tau /\ ~(tile_k s = tile_k t) + ==> integral (:real^1) + (\z. phi_sigma s carleson_phi (drop z) * + cnj(phi_sigma t carleson_phi (drop z))) = Cx(&0)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC PHISIG_CARLESON_ORTHO_JL THEN + REWRITE_TAC[DISJOINT] THEN + MATCH_MP_TAC TILE_JL_DISJOINT_T THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN + MP_TAC(ISPEC `tau:int#int#int` TILE_JR_NONEMPTY) THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + DISCH_THEN(X_CHOOSE_TAC `y:real`) THEN EXISTS_TAC `y:real` THEN + RULE_ASSUM_TAC(REWRITE_RULE[tile_ler]) THEN ASM SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Tile frequency intervals are nonempty (dyho always contains its left *) +(* edge). *) +(* ------------------------------------------------------------------------- *) +let TILE_J_NONEMPTY = prove + (`!s:int#int#int. ~(tile_J s = {})`, + REWRITE_TAC[FORALL_PAIR_THM; tile_J; GSYM MEMBER_NOT_EMPTY] THEN + MESON_TAC[DYHO_NONEMPTY]);; + + +(* ========================================================================= *) +(* 286J(c) tile helpers. The product-meet relation mt s t = "the k-dilates *) +(* meet AND the frequency cells meet" is what GREEDY_CAPTURE consumes; it is *) +(* symmetric + reflexive, and its negation forces the g^-1[J] cap I^(k) *) +(* region *) +(* products to be disjoint (Fremlin mt286.tex 936-940). *) +(* ========================================================================= *) + +(* dyho cells are nonempty (their left endpoint n*2^k lies in [n *) +(* 2^k,(n+1)2^k)). *) + +(* the tile centre lies in every dilate (|x_s - x_s| = 0 < half-width). *) +let TILE_XMID_IN_IDIL = prove + (`!s:int#int#int k. tile_xmid s IN tile_Idil s k`, + REWRITE_TAC[tile_Idil; IN_ELIM_THM; REAL_SUB_REFL; REAL_ABS_NUM] THEN + REPEAT GEN_TAC THEN MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC);; + +(* the frequency cell tile_J s is a dyho, hence nonempty. *) + +(* product-meet is symmetric. *) +let TILE_PRODMEET_SYM = prove + (`!k s t:int#int#int. + (~(tile_Idil s k INTER tile_Idil t k = {}) /\ + ~(tile_J s INTER tile_J t = {})) + ==> (~(tile_Idil t k INTER tile_Idil s k = {}) /\ + ~(tile_J t INTER tile_J s = {}))`, + REPEAT GEN_TAC THEN REWRITE_TAC[INTER_COMM] THEN SIMP_TAC[]);; + +(* product-meet is reflexive (centre in the dilate; J nonempty). *) +let TILE_PRODMEET_REFL = prove + (`!k s:int#int#int. + ~(tile_Idil s k INTER tile_Idil s k = {}) /\ + ~(tile_J s INTER tile_J s = {})`, + REPEAT GEN_TAC THEN REWRITE_TAC[INTER_IDEMPOT] THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + EXISTS_TAC `tile_xmid s` THEN REWRITE_TAC[TILE_XMID_IN_IDIL]; + REWRITE_TAC[TILE_J_NONEMPTY]]);; + +(* ~mt s t => the region products g^-1[J] cap I^(k) are disjoint. Either the *) +(* I^(k)'s are disjoint (kills the I^(k)-factor) or the J's are disjoint (no *) +(* x *) +(* has h x in both J's). (Fremlin lines 936-940: product tiles disjoint => *) +(* g^-1[J_l] cap I^(k)_l disjoint from g^-1[J_m] cap I^(k)_m.) *) +let TILE_PRODMEET_SSET_DISJOINT = prove + (`!(E:real->bool) (h:real->real) k s t:int#int#int. + ~(~(tile_Idil s k INTER tile_Idil t k = {}) /\ + ~(tile_J s INTER tile_J t = {})) + ==> DISJOINT ({x | x IN E /\ h x IN tile_J s} INTER tile_Idil s k) + ({x | x IN E /\ h x IN tile_J t} INTER tile_Idil t k)`, + REPEAT GEN_TAC THEN REWRITE_TAC[DE_MORGAN_THM] THEN STRIP_TAC THEN + POP_ASSUM MP_TAC THEN + REWRITE_TAC[DISJOINT; EXTENSION; IN_INTER; IN_ELIM_THM; NOT_IN_EMPTY] THEN + MESON_TAC[]);; + +(* J-nesting for the alpha2/alpha3 G_K containment (Fremlin 286L step c). *) +(* Two *) +(* tiles both above tau (J_tau SUBSET both) with k_s <= k_ups nest forward: *) +(* J_s SUBSET J_ups. Since J_tau (nonempty) sits in both dyho's, DYHO_NEST *) +(* at any *) +(* shared point (the left edge of J_tau) gives the coarser-scale *) +(* containment. *) +let TILE_J_SUBSET_TILE_J = prove + (`!(s:int#int#int) ups tau. + tile_J tau SUBSET tile_J s /\ tile_J tau SUBSET tile_J ups /\ + tile_k s <= tile_k ups + ==> tile_J s SUBSET tile_J ups`, + REWRITE_TAC[FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC + [`ks:int`;`nIs:int`;`nJs:int`;`ku:int`;`nIu:int`;`nJu:int`; + `kt:int`;`nIt:int`;`nJt:int`] THEN + REWRITE_TAC[tile_J; tile_k] THEN STRIP_TAC THEN + MATCH_MP_TAC DYHO_NEST THEN + EXISTS_TAC `real_of_int nJt * &2 zpow kt` THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET]) THEN + REWRITE_TAC[DYHO_NONEMPTY]);; + +(* Hence the RIGHT half J^r_s also lands inside J_ups (J^r_s SUBSET J_s *) +(* SUBSET *) +(* J_ups). This is the step-c containment that puts the W2 per-tile regions *) +(* E cap h^-1[J^r_s] cap K inside the single cell E cap h^-1[J_ups] cap K = *) +(* G_K, *) +(* so SUM_INTEGRAL_LE_MEASURE (over the common domain G_K) applies. *) +let TILE_JR_SUBSET_TILE_J = prove + (`!(s:int#int#int) ups tau. + tile_J tau SUBSET tile_J s /\ tile_J tau SUBSET tile_J ups /\ + tile_k s <= tile_k ups + ==> tile_Jr s SUBSET tile_J ups`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `tile_J (s:int#int#int)` THEN + REWRITE_TAC[TILE_JR_SUBSET_J] THEN + MATCH_MP_TAC TILE_J_SUBSET_TILE_J THEN + EXISTS_TAC `tau:int#int#int` THEN ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* 286L(f-i): the J^r frequency-disjointness gate for the W2 (alpha2) sum. *) +(* If sigma has the coarser frequency scale (k_sig <= k_ups - 1) and J_tau *) +(* is *) +(* included in J_sig (true for every sig >= tau in P) while J^r_tau is NOT *) +(* included in J^r_ups (true for every ups NOT in the tree T_tau), then the *) +(* right halves J^r_sig, J^r_ups are disjoint. Proof: J^r_sig SUBSET J_sig *) +(* (TILE_JR_SUBSET_J); if J^r_sig, J^r_ups met at y then y IN J_sig, and *) +(* since k_sig <= k_ups - 1 = scale(J^r_ups) the laminar nesting DYHO_NEST *) +(* forces J_sig SUBSET J^r_ups, whence J^r_tau SUBSET J_tau SUBSET J_sig *) +(* SUBSET J^r_ups, contradicting the tree hypothesis. *) +(* ------------------------------------------------------------------------- *) +let TILE_JR_FREQ_DISJOINT = prove + (`!(sig:int#int#int) (ups:int#int#int) tau. + tile_J tau SUBSET tile_J sig /\ ~(tile_Jr tau SUBSET tile_Jr ups) /\ + tile_k sig <= tile_k ups - &1 + ==> tile_Jr sig INTER tile_Jr ups = {}`, + REWRITE_TAC[FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC + [`ks:int`;`nIs:int`;`nJs:int`;`ku:int`;`nIu:int`;`nJu:int`; + `kt:int`;`nIt:int`;`nJt:int`] THEN + REWRITE_TAC[tile_J; tile_Jr; tile_k] THEN STRIP_TAC THEN + REWRITE_TAC[EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN + X_GEN_TAC `y:real` THEN STRIP_TAC THEN + SUBGOAL_THEN `y IN dyho ks nJs` ASSUME_TAC THENL + [MP_TAC(ISPEC `(ks:int,nIs:int,nJs:int)` TILE_JR_SUBSET_J) THEN + REWRITE_TAC[tile_Jr; tile_J; SUBSET] THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `dyho ks nJs SUBSET dyho (ku - &1) (&2 * nJu + &1)` ASSUME_TAC THENL + [MATCH_MP_TAC DYHO_NEST THEN EXISTS_TAC `y:real` THEN ASM_REWRITE_TAC[] THEN + ASM_INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `dyho (kt - &1) (&2 * nJt + &1) SUBSET dyho (ku - &1) (&2 * nJu + &1)` + (fun th -> ASM_MESON_TAC[th; TILE_JR_SUBSET_J; tile_J; tile_Jr; + SUBSET_TRANS]) THEN + MP_TAC(ISPEC `(kt:int,nIt:int,nJt:int)` TILE_JR_SUBSET_J) THEN + REWRITE_TAC[tile_Jr; tile_J] THEN ASM SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* 286L(f-ii): the single-scale collapse. Two W2 tiles sigma, sigma' -- each *) +(* below tau (tile_le, true for every member of P) but outside the tree *) +(* T_tau *) +(* (~tile_ler .. tau, the W2 defining condition) -- whose right frequency- *) +(* halves J^r share a common point t must have the SAME scale. Hence, for *) +(* any *) +(* fixed x, all W2 tiles sigma with h(x) IN J^r_sigma collapse to one *) +(* frequency *) +(* scale k, so v2(x) is a single-scale sum and V2_SLICE_BOUND applies. *) +(* Proof: the tile order unfolds tile_le/tile_ler to J_tau SUBSET J_s and *) +(* ~(J^r_tau SUBSET J^r_s); TILE_JR_FREQ_DISJOINT (applied both *) +(* orientations) *) +(* then rules out k_s <= k_s'-1 and k_s' <= k_s-1, forcing k_s = k_s'. *) +(* ------------------------------------------------------------------------- *) +let TILE_JR_COLLAPSE = prove + (`!s s' tau t. + tile_le s tau /\ tile_le s' tau /\ + ~(tile_ler s tau) /\ ~(tile_ler s' tau) /\ + t IN tile_Jr s /\ t IN tile_Jr s' + ==> tile_k s = tile_k s'`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `tile_J tau SUBSET tile_J s /\ tile_J tau SUBSET tile_J s' /\ + ~(tile_Jr tau SUBSET tile_Jr s) /\ + ~(tile_Jr tau SUBSET tile_Jr s')` + STRIP_ASSUME_TAC THENL + [REPEAT CONJ_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[tile_le; tile_ler]) THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC(INT_ARITH `~(a:int <= b - &1) /\ ~(b <= a - &1) ==> a = b`) THEN + CONJ_TAC THEN DISCH_TAC THENL + [MP_TAC(ISPECL [`s:int#int#int`; `s':int#int#int`; `tau:int#int#int`] + TILE_JR_FREQ_DISJOINT); + MP_TAC(ISPECL [`s':int#int#int`; `s:int#int#int`; `tau:int#int#int`] + TILE_JR_FREQ_DISJOINT)] THEN + ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* W2-slice structure: for a set A of W2 tiles all sharing a common *) +(* frequency *) +(* point t in their J^r, the collapse (TILE_JR_COLLAPSE) forces one common *) +(* scale k, and same-scale tree tiles have distinct I-indices *) +(* (TILE_TREE_FST_SND_INJ) so FST o SND is injective on A. These are exactly *) +(* the two hypotheses V2_SLICE_BOUND needs. Packaged so the pointwise v2 *) +(* bound below applies without re-deriving them. *) +(* ------------------------------------------------------------------------- *) +let TILE_JR_SLICE_INJ = prove + (`!A tau t. + (!s. s IN A ==> tile_le s tau /\ ~(tile_ler s tau) /\ t IN tile_Jr s) + ==> (!u1 u2. u1 IN A /\ u2 IN A /\ FST(SND u1) = FST(SND(u2:int#int#int)) + ==> u1 = u2) /\ + (?k. !s. s IN A ==> tile_k s = k)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + ASM_CASES_TAC `A:(int#int#int)->bool = {}` THENL + [CONJ_TAC THENL + [ASM_REWRITE_TAC[NOT_IN_EMPTY]; + EXISTS_TAC `&0:int` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY]]; + ALL_TAC] THEN + FIRST_X_ASSUM(fun th -> ASSUME_TAC th) THEN + FIRST_ASSUM(X_CHOOSE_TAC `s0:int#int#int` o + REWRITE_RULE[GSYM MEMBER_NOT_EMPTY]) THEN + SUBGOAL_THEN `!s. s IN A ==> tile_k s = tile_k (s0:int#int#int)` + ASSUME_TAC THENL + [X_GEN_TAC `s1:int#int#int` THEN DISCH_TAC THEN + MATCH_MP_TAC TILE_JR_COLLAPSE THEN + MAP_EVERY EXISTS_TAC [`tau:int#int#int`; `t:real`] THEN + FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `s1:int#int#int` th) THEN + MP_TAC(SPEC `s0:int#int#int` th)) THEN + ASM_SIMP_TAC[]; + ALL_TAC] THEN + CONJ_TAC THENL + [MAP_EVERY X_GEN_TAC [`u1:int#int#int`; `u2:int#int#int`] THEN + STRIP_TAC THEN + MP_TAC(ISPECL [`A:(int#int#int)->bool`; `tile_k (s0:int#int#int)`; + `tau:int#int#int`; `u1:int#int#int`; `u2:int#int#int`] + TILE_TREE_FST_SND_INJ) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN X_GEN_TAC `r:int#int#int` THEN DISCH_TAC THEN + CONJ_TAC THENL + [FIRST_X_ASSUM(fun th -> MATCH_MP_TAC th) THEN ASM_REWRITE_TAC[]; + FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `r:int#int#int` th)) THEN + ASM_SIMP_TAC[]]; + DISCH_THEN ACCEPT_TAC]; + EXISTS_TAC `tile_k (s0:int#int#int)` THEN ASM_REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* 286L(f-ii)+(f-iii): the pointwise v2 bound. For any finite slice A of W2 *) +(* tiles (each tile_le tau, outside T_tau, and with t = h(x) in J^r) the *) +(* correlation sum sum_A |(f|phi_s) phi_s(x)| <= 2 C1 energy_f f P -- the *) +(* collapse to one scale (TILE_JR_SLICE_INJ) reduces it to the single-scale *) +(* V2_SLICE_BOUND. This is the pointwise engine of |alpha2| <= int v2. *) +(* ------------------------------------------------------------------------- *) +let V2_POINTWISE_COLLAPSE = prove + (`?C1. &0 <= C1 /\ + !f P A tau t x. + FINITE P /\ FINITE A /\ A SUBSET P /\ + (!s. s IN A ==> tile_le s tau /\ ~(tile_ler s tau) /\ t IN tile_Jr s) + ==> sum A (\s. norm(carleson_ip f s * phi_sigma s carleson_phi x)) + <= &2 * C1 * energy_f f P`, + X_CHOOSE_TAC `C1:real` V2_SLICE_BOUND THEN EXISTS_TAC `C1:real` THEN + POP_ASSUM STRIP_ASSUME_TAC THEN ASM_REWRITE_TAC[] THEN + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&0 <= energy_f (f:real->complex) P` ASSUME_TAC THENL + [MATCH_MP_TAC ENERGY_F_POS THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL [`A:(int#int#int)->bool`; `tau:int#int#int`; `t:real`] + TILE_JR_SLICE_INJ) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_TAC `k:int`)) THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`f:real->complex`; `P:(int#int#int)->bool`; `A:(int#int#int)->bool`; + `k:int`; `x:real`]) THEN + ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Per-tile "move the norm inside the integral" brick for the |alpha2| <= *) +(* int v2 step. norm(cip . int_{lift A} phi) = |cip| norm(int phi) <= *) +(* |cip| int_A |phi| = int_A (|cip| |phi|), for measurable A. The complex *) +(* norm-of-integral bound is INTEGRAL_NORM_BOUND_INTEGRAL (norm(int f) <= *) +(* drop(int g) when norm(f) <= drop g); the real_integral / vector integral *) +(* bridge is REAL_INTEGRAL (integrability from PHISIG_NORM_INTEGRABLE_ *) +(* MEASURABLE) and REAL_INTEGRABLE_ON (for the dominating g). This is the *) +(* per-summand step; summing over the W2 slice + V2_POINTWISE_COLLAPSE gives *) +(* the pointwise v2 <= 2 C1 gamma inside int_{G_K}. *) +(* ------------------------------------------------------------------------- *) +let PHISIG_NORM_INTEGRAL_BOUND = prove + (`!(f:real->complex) s A. + real_measurable A + ==> norm(carleson_ip f s * + integral (IMAGE lift A) (\z. phi_sigma s carleson_phi (drop z))) + <= real_integral A + (\x. norm(carleson_ip f s) * norm(phi_sigma s carleson_phi x))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[COMPLEX_NORM_MUL] THEN + SUBGOAL_THEN + `real_integral A + (\x. norm(carleson_ip f s) * norm(phi_sigma s carleson_phi x)) = + norm(carleson_ip (f:real->complex) s) * + real_integral A (\x. norm(phi_sigma s carleson_phi x))` + SUBST1_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_LMUL THEN + MATCH_MP_TAC PHISIG_NORM_INTEGRABLE_MEASURABLE THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [REWRITE_TAC[NORM_POS_LE]; ALL_TAC] THEN + MP_TAC(ISPECL [`s:int#int#int`; `A:real->bool`] + PHISIG_NORM_INTEGRABLE_MEASURABLE) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + ASM_SIMP_TAC[REAL_INTEGRAL] THEN + MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MP_TAC(ISPECL [`s:int#int#int`; `A:real->bool`] + PHISIG_ABS_INTEGRABLE_MEASURABLE) THEN + ASM_REWRITE_TAC[]; + FIRST_X_ASSUM(MP_TAC o REWRITE_RULE[REAL_INTEGRABLE_ON]) THEN + REWRITE_TAC[]; + REWRITE_TAC[o_DEF; LIFT_DROP; NORM_LIFT] THEN X_GEN_TAC `z:real^1` THEN + DISCH_TAC THEN REAL_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* The pointwise cap for the alpha2 int-v2 bound, packaged exactly as *) +(* SUM_INTEGRAL_LE_MEASURE consumes it. For x IN G_K the tiles s of the W2 *) +(* slice whose region {y | h y IN J^r_s} INTER K contains x all have h(x) IN *) +(* J^r_s -- a common-frequency slice at t = h(x) -- so their summed *) +(* |cip.phi| *) +(* is <= 2 C1 gamma by V2_POINTWISE_COLLAPSE. SUM_RESTRICT_SET rewrites the *) +(* indicator-sum over A as the plain sum over {s IN A | x IN region s}, on *) +(* which V2_POINTWISE_COLLAPSE (with A := that set) applies. *) +(* ------------------------------------------------------------------------- *) +let V2_POINTWISE_CAP = prove + (`?C1. &0 <= C1 /\ + !(f:real->complex) (P:(int#int#int)->bool) A tau E h a p x. + FINITE P /\ FINITE A /\ A SUBSET P /\ + (!s. s IN A ==> tile_le s tau /\ ~(tile_ler s tau)) + ==> sum A (\s. if x IN {y | y IN E /\ h y IN tile_Jr s} INTER dyho a p + then norm(carleson_ip f s) * + norm(phi_sigma s carleson_phi x) + else &0) + <= &2 * C1 * energy_f f P`, + X_CHOOSE_TAC `C1:real` V2_POINTWISE_COLLAPSE THEN EXISTS_TAC `C1:real` THEN + POP_ASSUM STRIP_ASSUME_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[GSYM COMPLEX_NORM_MUL] THEN + REWRITE_TAC[GSYM SUM_RESTRICT_SET] THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`f:real->complex`; `P:(int#int#int)->bool`; + `{s | s IN A /\ x IN {y | y IN E /\ h y IN tile_Jr s} INTER dyho a p}`; + `tau:int#int#int`; `(h:real->real) x`; `x:real`]) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + MATCH_MP_TAC FINITE_RESTRICT THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN + X_GEN_TAC `s:int#int#int` THEN STRIP_TAC THEN + FIRST_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET]) THEN ASM_REWRITE_TAC[]; + X_GEN_TAC `s:int#int#int` THEN + GEN_REWRITE_TAC (LAND_CONV) [IN_ELIM_THM] THEN + REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN STRIP_TAC THEN + SUBGOAL_THEN `tile_le s tau /\ ~(tile_ler (s:int#int#int) tau)` + STRIP_ASSUME_TAC THENL + [FIRST_X_ASSUM(fun th -> MATCH_MP_TAC th) THEN ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]]]; + DISCH_THEN ACCEPT_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* 286L alpha2 PER-CELL bound (abstract in the enclosing set G). The sum *) +(* over *) +(* a W2 slice A of the tile correlations norm(cip.INT_{E cap h^-1[J^r_s] cap *) +(* K} *) +(* phi_s) is <= 2 C1 gamma mu G, provided every per-tile region sits inside *) +(* a *) +(* single measurable G (in the application G = G_K, via *) +(* TILE_JR_SUBSET_TILE_J). *) +(* Chain: per-tile PHISIG_NORM_INTEGRAL_BOUND (norm(cip.INT) <= int_region *) +(* |cip||phi|) under SUM_LE, then SUM_INTEGRAL_LE_MEASURE (interchange + *) +(* measure) *) +(* with the pointwise cap V2_POINTWISE_CAP (2 C1 gamma). This is the alpha2 *) +(* measure-theoretic core, ready to instantiate G := G_K and sum over the *) +(* cover. *) +(* ------------------------------------------------------------------------- *) +let ALPHA2_CELL_ABSTRACT = prove + (`?C1. &0 <= C1 /\ + !(f:real->complex) (P:(int#int#int)->bool) A tau E h a p G. + FINITE P /\ FINITE A /\ A SUBSET P /\ real_measurable G /\ + (!s. s IN A ==> tile_le s tau /\ ~(tile_ler s tau) /\ + ({x | x IN E /\ h x IN tile_Jr s} INTER dyho a p) SUBSET G) /\ + real_lebesgue_measurable E /\ h real_measurable_on (:real) + ==> sum A (\s. norm(carleson_ip f s * + integral (IMAGE lift + ({x | x IN E /\ h x IN tile_Jr s} INTER dyho a p)) + (\z. phi_sigma s carleson_phi (drop z)))) + <= (&2 * C1 * energy_f f P) * real_measure G`, + X_CHOOSE_TAC `C1:real` V2_POINTWISE_CAP THEN EXISTS_TAC `C1:real` THEN + POP_ASSUM STRIP_ASSUME_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `sum A (\s. real_integral + ({x | x IN E /\ h x IN tile_Jr s} INTER dyho a p) + (\x. norm(carleson_ip (f:real->complex) s) * + norm(phi_sigma s carleson_phi x)))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `s:int#int#int` THEN DISCH_TAC THEN BETA_TAC THEN + MATCH_MP_TAC PHISIG_NORM_INTEGRAL_BOUND THEN + MATCH_MP_TAC SC_MEASURABLE_JR THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`A:(int#int#int)->bool`; `G:real->bool`; + `\s:int#int#int. {x | x IN E /\ h x IN tile_Jr s} INTER dyho a p`; + `\s:int#int#int x. norm(carleson_ip (f:real->complex) s) * + norm(phi_sigma s carleson_phi x)`; + `&2 * C1 * energy_f (f:real->complex) P`] SUM_INTEGRAL_LE_MEASURE) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [X_GEN_TAC `s:int#int#int` THEN DISCH_TAC THEN CONJ_TAC THENL + [FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `s:int#int#int` th)) THEN + ASM_SIMP_TAC[]; + MATCH_MP_TAC REAL_INTEGRABLE_LMUL THEN + MATCH_MP_TAC PHISIG_NORM_INTEGRABLE_MEASURABLE THEN + MATCH_MP_TAC SC_MEASURABLE_JR THEN ASM_REWRITE_TAC[]]; + X_GEN_TAC `x:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`f:real->complex`; `P:(int#int#int)->bool`; `A:(int#int#int)->bool`; + `tau:int#int#int`; `E:real->bool`; `h:real->real`; `a:int`; `p:int`; + `x:real`]) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN X_GEN_TAC `s:int#int#int` THEN DISCH_TAC THEN + FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `s:int#int#int` th)) THEN + ASM_SIMP_TAC[]; + REWRITE_TAC[]]]; + DISCH_THEN(fun th -> MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC (rand(concl th)) THEN + CONJ_TAC THENL [MATCH_ACCEPT_TAC th; ALL_TAC]) THEN + REWRITE_TAC[REAL_LE_REFL]]);; + +(* ------------------------------------------------------------------------- *) +(* 286L alpha2 PER-CELL bound (concrete G_K). Instantiates ALPHA2_CELL_ *) +(* ABSTRACT at G := G_K = E cap h^-1[J_ups] cap dyho a p (ups from *) +(* GK_MEASURE_ *) +(* BOUND_STRONG, tile_le ups tau, k_ups = -(a+1)) and chains its measure *) +(* bound. *) +(* The W2 tile set is {s IN P | tile_le s tau /\ ~tile_ler s tau /\ k_s < *) +(* -a} *) +(* (s below tau, outside T_tau, coarser than l_K = -a). Each region E cap *) +(* h^-1[J^r_s] cap K lands in G_K via TILE_JR_SUBSET_TILE_J (J^r_s SUBSET *) +(* J_ups: *) +(* J_tau SUBSET J_s,J_ups from tile_le, and k_s < -a i.e. k_s <= -a-1 = *) +(* k_ups). *) +(* Result: per-cell alpha2 sum <= (2 C1 energy)(2 2^a mass/w(3/2)). *) +(* NB G_K measurability uses SC_MEASURABLE (full tile_J ups), NOT *) +(* SC_MEASURABLE_ *) +(* JR (that is for the per-tile RIGHT-half regions). *) +(* ------------------------------------------------------------------------- *) +let ALPHA2_CELL = prove + (`?C1. &0 <= C1 /\ + !(f:real->complex) (P:(int#int#int)->bool) tau E h a p. + FINITE P /\ in_kcover P a p /\ (!s. s IN P ==> tile_le s tau) /\ + &2 zpow (a + &1) <= &2 zpow (--(tile_k tau)) /\ + real_lebesgue_measurable E /\ h real_measurable_on (:real) /\ + (!t. cw_tile t real_integrable_on {x | x IN E /\ h x IN tile_J t}) + ==> sum {s | s IN P /\ tile_le s tau /\ ~(tile_ler s tau) /\ + tile_k s < --a} + (\s. norm(carleson_ip f s * + integral (IMAGE lift + ({x | x IN E /\ h x IN tile_Jr s} INTER dyho a p)) + (\z. phi_sigma s carleson_phi (drop z)))) + <= (&2 * C1 * energy_f f P) * + (&2 * &2 zpow a * mass_Eh E h P / cw(&3 / &2))`, + X_CHOOSE_TAC `C1:real` ALPHA2_CELL_ABSTRACT THEN EXISTS_TAC `C1:real` THEN + POP_ASSUM(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "ABS")) THEN + ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`P:(int#int#int)->bool`; `E:real->bool`; `h:real->real`; + `a:int`; `p:int`; + `tau:int#int#int`] GK_MEASURE_BOUND_STRONG) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `ups:int#int#int` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(&2 * C1 * energy_f (f:real->complex) P) * + real_measure ({x | x IN E /\ h x IN tile_J ups} INTER dyho a p)` + THEN + CONJ_TAC THENL + [USE_THEN "ABS" (MP_TAC o SPECL + [`f:real->complex`; `P:(int#int#int)->bool`; + `{s | s IN P /\ tile_le s tau /\ ~(tile_ler s tau) /\ tile_k s < --a}`; + `tau:int#int#int`; `E:real->bool`; `h:real->real`; `a:int`; `p:int`; + `{x | x IN E /\ h x IN tile_J ups} INTER dyho a p`]) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC FINITE_RESTRICT THEN ASM_REWRITE_TAC[]; + SET_TAC[]; + MATCH_MP_TAC SC_MEASURABLE THEN ASM_REWRITE_TAC[]; + X_GEN_TAC `s:int#int#int` THEN REWRITE_TAC[IN_ELIM_THM] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(SET_RULE + `(!x. x IN A ==> x IN B) ==> (A INTER C) SUBSET (B INTER C)`) THEN + X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`s:int#int#int`; `ups:int#int#int`; `tau:int#int#int`] + TILE_JR_SUBSET_TILE_J) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [UNDISCH_TAC `tile_le s tau` THEN REWRITE_TAC[tile_le] THEN + SIMP_TAC[]; + UNDISCH_TAC `tile_le ups tau` THEN REWRITE_TAC[tile_le] THEN + SIMP_TAC[]; + ASM_INT_ARITH_TAC]; + REWRITE_TAC[SUBSET] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[]]]; + REWRITE_TAC[]]; + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC[ENERGY_F_POS] THEN + REAL_ARITH_TAC]; + ASM_REWRITE_TAC[]]]);; + +(* ------------------------------------------------------------------------- *) +(* 286L alpha2 TOTAL: the whole W2 correlation sum over the cover. Sums *) +(* ALPHA2_CELL over the cover cells ap IN S (each l_K > k_tau, i.e. 2^{a+1} *) +(* <= *) +(* 2^{-k_tau}), factoring the s-independent (2 C1 energy)(2 mass/w(3/2)) out *) +(* (SUM_LMUL) and collapsing sum_{ap} 2^{FST ap} = sum mu(dyho(FST ap)(SND *) +(* ap)) *) +(* <= 14 2^{-k_tau} (KCOVER_COARSE_MEASURE_BOUND, 286L a-iii; SUM_IMAGE *) +(* reindex *) +(* via DYHO_INJ). Result |alpha2| <= 28 C1 energy mass 2^{-k_tau}/w(3/2), *) +(* the *) +(* 28/w(3/2) C7-summand. Same outer-sum skeleton as *) +(* ALPHA0_TOTAL/ALPHA1_TOTAL, *) +(* with the W2 tile-set restriction (tile_k s < --FST ap, i.e. k_s < l_K). *) +(* NB the ~(P={}) hypothesis is needed for MASS_EH_POS (mass >= 0); without *) +(* it *) +(* an undischarged ~(P={}) subgoal surfaces downstream as a spurious *) +(* MATCH_MP_ *) +(* TAC "No match". *) +(* ------------------------------------------------------------------------- *) +let ALPHA2_TOTAL = prove + (`?C1. &0 <= C1 /\ + !(f:real->complex) E h (P:(int#int#int)->bool) S kt nt tau. + FINITE P /\ ~(P = {}) /\ tile_k tau = kt /\ + (!s. s IN P ==> tile_le s tau) /\ + real_lebesgue_measurable E /\ h real_measurable_on (:real) /\ + (!s. s IN P ==> tile_I s SUBSET dyho (--kt) nt) /\ + (!t. cw_tile t real_integrable_on {x | x IN E /\ h x IN tile_J t}) /\ + FINITE S /\ + (!ap. ap IN S ==> in_kcover P (FST ap) (SND ap) /\ + &2 zpow (FST ap + &1) <= &2 zpow (--kt)) + ==> sum S (\ap. sum {s | s IN P /\ tile_le s tau /\ ~(tile_ler s tau) /\ + tile_k s < --(FST ap)} + (\s. norm(carleson_ip f s * + integral (IMAGE lift ({x | x IN E /\ h x IN + tile_Jr s} INTER + dyho (FST ap) (SND ap))) + (\z. phi_sigma s carleson_phi (drop + z))))) + <= ((&2 * C1 * energy_f f P) * (&2 * mass_Eh E h P / cw(&3 / &2))) * + (&14 * &2 zpow (--kt))`, + X_CHOOSE_THEN + `C1:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "CELL")) ALPHA2_CELL THEN + EXISTS_TAC `C1:real` THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&0 <= energy_f (f:real->complex) P /\ &0 <= mass_Eh E h P` + STRIP_ASSUME_TAC THENL + [ASM_SIMP_TAC[ENERGY_F_POS] THEN MATCH_MP_TAC MASS_EH_POS THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `sum S (\ap. ((&2 * C1 * energy_f (f:real->complex) P) * + (&2 * mass_Eh E h P / cw(&3 / &2))) * + real_measure (dyho (FST ap) (SND ap)))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `ap:int#int` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + REWRITE_TAC[DYHO_MEASURE] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(&2 * C1 * energy_f (f:real->complex) P) * + (&2 * &2 zpow (FST(ap:int#int)) * mass_Eh E h P / cw(&3 / &2))` + THEN + CONJ_TAC THENL + [USE_THEN "CELL" (MP_TAC o ISPECL + [`f:real->complex`; `P:(int#int#int)->bool`; `tau:int#int#int`; + `E:real->bool`; `h:real->real`; `FST(ap:int#int)`; + `SND(ap:int#int)`]) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN CONJ_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `ap:int#int`) THEN ASM_SIMP_TAC[]; + DISCH_THEN ACCEPT_TAC]; + REAL_ARITH_TAC]; + ONCE_REWRITE_TAC[SUM_LMUL] THEN MATCH_MP_TAC REAL_LE_LMUL THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC]; + MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LE_DIV THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; CW_POS]]]; + SUBGOAL_THEN + `sum S (\ap. real_measure (dyho (FST ap) (SND ap))) = + sum (IMAGE (\ap:int#int. dyho (FST ap) (SND ap)) S) (\c. real_measure + c)` + SUBST1_TAC THENL + [MATCH_MP_TAC EQ_SYM THEN + MP_TAC(ISPECL [`\ap:int#int. dyho (FST ap) (SND ap)`; + `\c:real->bool. real_measure c`; + `S:(int#int)->bool`] SUM_IMAGE) THEN + ANTS_TAC THENL + [REWRITE_TAC[FORALL_PAIR_THM] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP DYHO_INJ) THEN SIMP_TAC[PAIR_EQ]; + REWRITE_TAC[o_DEF]]; + ALL_TAC] THEN + MATCH_MP_TAC KCOVER_COARSE_MEASURE_BOUND THEN + MAP_EVERY EXISTS_TAC [`P:(int#int#int)->bool`; `nt:int`] THEN + ASM_REWRITE_TAC[]]]);; + +(* ------------------------------------------------------------------------- *) +(* 286J's per-column analytic bound: for a finite tile set with pairwise *) +(* disjoint spatial intervals I, the weights integrate additively over their *) +(* union, so sum_tau INT_{I_tau} w_sigma = INT_{UNION I_tau} w_sigma <= *) +(* INT_R w_sigma = 1. (In 286J, the tau ranging over a fixed frequency *) +(* interval J have disjoint I -- TILE_SAMEJ_DISTINCT_DISJOINT_I.) *) +(* ------------------------------------------------------------------------- *) + +(* The tile weight is integrable on any (half-open) spatial cell I_tau. *) +let CWTILE_INTEGRABLE_TILE_I = prove + (`!(s:int#int#int) (t:int#int#int). cw_tile s real_integrable_on (tile_I t)`, + REWRITE_TAC[FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC + [`ks:int`;`nIs:int`;`nJs:int`;`kt:int`;`nIt:int`;`nJt:int`] THEN + REWRITE_TAC[tile_I] THEN + MP_TAC(ISPECL + [`cw_tile (ks,nIs,nJs)`; + `real_interval[real_of_int nIt * &2 zpow (--kt), + (real_of_int nIt + &1) * &2 zpow (--kt)]`; + `dyho (--kt) nIt`] REAL_INTEGRABLE_SPIKE_SET) THEN + REWRITE_TAC[CWTILE_INTEGRABLE] THEN DISCH_THEN MATCH_MP_TAC THEN + MATCH_MP_TAC REAL_NEGLIGIBLE_SUBSET THEN + EXISTS_TAC `{real_of_int nIt * &2 zpow (--kt), + (real_of_int nIt + &1) * &2 zpow (--kt)}` THEN + CONJ_TAC THENL + [REWRITE_TAC[REAL_NEGLIGIBLE_INSERT; REAL_NEGLIGIBLE_SING]; + REWRITE_TAC[dyho; real_interval; SUBSET; IN_UNION; IN_DIFF; IN_ELIM_THM; + IN_INSERT; NOT_IN_EMPTY] THEN REAL_ARITH_TAC]);; + +(* When the added cell is disjoint from all others, it meets their union in *) +(* {}. *) +let TILE_I_INTER_UNIONS_EMPTY = prove + (`!(x:int#int#int) (P:(int#int#int)->bool). + ~(x IN P) /\ + (!t1 t2. t1 IN x INSERT P /\ t2 IN x INSERT P /\ ~(t1 = t2) + ==> DISJOINT (tile_I t1) (tile_I t2)) + ==> tile_I x INTER UNIONS (IMAGE tile_I P) = {}`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `!w:int#int#int. w IN P ==> DISJOINT (tile_I x) (tile_I w)` + ASSUME_TAC THENL + [X_GEN_TAC `w:int#int#int` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`x:int#int#int`; `w:int#int#int`]) THEN + ASM_REWRITE_TAC[IN_INSERT] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_MESON_TAC[]; ALL_TAC] THEN + REWRITE_TAC[EXTENSION; IN_INTER; IN_UNIONS; IN_IMAGE; NOT_IN_EMPTY] THEN + X_GEN_TAC `y:real` THEN + REWRITE_TAC[TAUT `~(a /\ b) <=> a ==> ~b`] THEN DISCH_TAC THEN + REWRITE_TAC[NOT_EXISTS_THM] THEN X_GEN_TAC `u:real->bool` THEN + REWRITE_TAC[DE_MORGAN_THM; TAUT `~(a /\ b) <=> a ==> ~b`] THEN + DISCH_THEN(X_CHOOSE_THEN `w:int#int#int` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `w:int#int#int`) THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[DISJOINT; IN_INTER; NOT_IN_EMPTY]);; + +(* Finite additivity of the tile weight over a disjoint family of cells I. *) +let CWTILE_HAS_INTEGRAL_UNIONS = prove + (`!(sig:int#int#int) (P:(int#int#int)->bool). + FINITE P /\ + (!t1 t2. t1 IN P /\ t2 IN P /\ ~(t1 = t2) ==> DISJOINT (tile_I t1) (tile_I + t2)) + ==> (cw_tile sig has_real_integral + sum P (\t. real_integral (tile_I t) (cw_tile sig))) + (UNIONS (IMAGE tile_I P))`, + GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + CONJ_TAC THENL + [REWRITE_TAC[SUM_CLAUSES; IMAGE_CLAUSES; UNIONS_0; HAS_REAL_INTEGRAL_EMPTY]; + ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`x:int#int#int`; `P:(int#int#int)->bool`] THEN + STRIP_TAC THEN DISCH_TAC THEN + ASM_SIMP_TAC[SUM_CLAUSES; IMAGE_CLAUSES; UNIONS_INSERT] THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_UNION THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_INTEGRAL THEN + REWRITE_TAC[CWTILE_INTEGRABLE_TILE_I]; + FIRST_X_ASSUM(MATCH_MP_TAC o + check (fun th -> is_imp(concl th) || is_forall(concl th))) THEN + ASM_MESON_TAC[IN_INSERT]; + ASM_SIMP_TAC[TILE_I_INTER_UNIONS_EMPTY; REAL_NEGLIGIBLE_EMPTY]]);; + +(* 286J per-column bound: sum_tau INT_{I_tau} w_sigma <= INT_R w_sigma = 1. *) +let CWTILE_SUM_DISJOINT_I_LE_1 = prove + (`!(sig:int#int#int) (P:(int#int#int)->bool). + FINITE P /\ + (!t1 t2. t1 IN P /\ t2 IN P /\ ~(t1 = t2) ==> DISJOINT (tile_I t1) (tile_I + t2)) + ==> sum P (\t. real_integral (tile_I t) (cw_tile sig)) <= &1`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(ISPECL + [`cw_tile sig`; `UNIONS (IMAGE (tile_I:(int#int#int)->real->bool) P)`; + `(:real)`; + `sum P (\t. real_integral (tile_I t) (cw_tile sig))`; `&1`] + HAS_REAL_INTEGRAL_SUBSET_LE) THEN + REWRITE_TAC[SUBSET_UNIV] THEN + ASM_SIMP_TAC[CWTILE_HAS_INTEGRAL_UNIONS; CW_TILE_FULL] THEN + MP_TAC(SPEC `sig:int#int#int` CW_TILE_POS) THEN + MESON_TAC[REAL_LT_IMP_LE]);; + +(* ------------------------------------------------------------------------- *) +(* The tile-centre lies in its own spatial cell; hence for two distinct *) +(* tiles *) +(* sharing a frequency interval (whose cells are disjoint) the centre of one *) +(* is outside the other's cell -- the side condition CWTILE_MIDPOINT_TILE_I *) +(* (286G b) needs to apply Hermite-Hadamard over that cell. *) +(* ------------------------------------------------------------------------- *) + +let TILE_XMID_IN_I = prove + (`!(s:int#int#int). tile_xmid s IN tile_I s`, + REWRITE_TAC[FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC [`k:int`;`nI:int`;`nJ:int`] THEN + REWRITE_TAC[tile_xmid; tile_I; dyho_mid; dyho; IN_ELIM_THM] THEN + SUBGOAL_THEN `&0 < &2 zpow (--k)` MP_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + REAL_ARITH_TAC);; + +(* 286G(b), tile form keyed on the geometric side condition x_sigma NOTIN *) +(* I_t: *) +(* w_sigma(x_tau) mu(I_tau) <= INT_{I_tau} w_sigma. (mu(I_tau) = *) +(* 2^(-k_tau).) *) +let CWTILE_MIDPOINT_TILE_I = prove + (`!(s:int#int#int) (t:int#int#int). ~(tile_xmid s IN tile_I t) + ==> cw_tile s (tile_xmid t) * (&2 zpow (--(tile_k t))) + <= real_integral (tile_I t) (cw_tile s)`, + REWRITE_TAC[FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC + [`ks:int`;`nIs:int`;`nJs:int`;`kt:int`;`nIt:int`;`nJt:int`] THEN + REWRITE_TAC[tile_k] THEN DISCH_TAC THEN + MP_TAC(SPECL [`(ks,nIs,nJs):int#int#int`; `kt:int`; `nIt:int`; `nJt:int`] + CWTILE_TILE_I_MIDPOINT) THEN + DISCH_THEN MATCH_MP_TAC THEN + POP_ASSUM MP_TAC THEN + REWRITE_TAC[tile_I; tile_xmid; dyho; IN_ELIM_THM; DE_MORGAN_THM; + REAL_NOT_LE; REAL_NOT_LT] THEN + REAL_ARITH_TAC);; + +(* For distinct tiles with a common frequency interval, one centre is *) +(* outside the other's cell (the cells are disjoint, *) +(* TILE_SAMEJ_DISTINCT_DISJOINT_I). *) +let TILE_XMID_NOT_IN_OTHER_I = prove + (`!(s:int#int#int) (t:int#int#int). ~(s = t) /\ tile_J s = tile_J t + ==> ~(tile_xmid s IN tile_I t)`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`s:int#int#int`; + `t:int#int#int`] TILE_SAMEJ_DISTINCT_DISJOINT_I) THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(SPEC `s:int#int#int` TILE_XMID_IN_I) THEN + REWRITE_TAC[DISJOINT; EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN + ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* 286J, off-diagonal correlation: for two distinct tiles sharing a *) +(* frequency *) +(* interval, |(phi_s | phi_t)| <= C INT_{I_t} w_sigma, and the column-sum *) +(* over *) +(* all such t is <= C. These assemble the pointwise correlation (286Ge), *) +(* the 286G(b) midpoint bound, and the disjoint-cell weight sum. *) +(* ------------------------------------------------------------------------- *) + +(* inv(sqrt 2^k)^2 = 2^(-k): the k_s = k_t collapse of 286Ge's prefactor. *) +let INV_SQRT_ZPOW_SQ = prove + (`!k:int. inv(sqrt(&2 zpow k)) * inv(sqrt(&2 zpow k)) = &2 zpow (--k)`, + GEN_TAC THEN + SUBGOAL_THEN `&0 < &2 zpow k` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[GSYM REAL_INV_MUL; GSYM REAL_POW_2] THEN + ASM_SIMP_TAC[SQRT_POW_2; REAL_LT_IMP_LE; REAL_ZPOW_NEG]);; + +(* The correlation is symmetric in modulus: |(phi_s|phi_t)| = *) +(* |(phi_t|phi_s)| *) +(* (lproduct s f g = cnj(lproduct s g f), and cnj preserves norm). Used to *) +(* symmetrize 286J's double sum after the AM-GM step. *) +let PHISIG_CORR_SYM = prove + (`!(s:int#int#int) (t:int#int#int). + norm(integral (:real^1) (\z. phi_sigma s carleson_phi (drop z) * + cnj(phi_sigma t carleson_phi (drop z)))) = + norm(integral (:real^1) (\z. phi_sigma t carleson_phi (drop z) * + cnj(phi_sigma s carleson_phi (drop z))))`, + REPEAT GEN_TAC THEN + REWRITE_TAC[GSYM lproduct] THEN + MP_TAC(ISPECL [`(:real^1)`; `\z:real^1. phi_sigma s carleson_phi (drop z)`; + `\z:real^1. phi_sigma t carleson_phi (drop z)`] LPRODUCT_SYM) + THEN + REWRITE_TAC[] THEN + ANTS_TAC THENL + [MATCH_MP_TAC SCHWARTZ_CNJ_PRODUCT_INTEGRABLE THEN + REWRITE_TAC[ETA_AX; PHISIG_CARLESON_SCHWARTZ]; ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[COMPLEX_NORM_CNJ]);; + +(* Scale-order-free cross-correlation bound: the 286G(e) estimate holds for *) +(* EVERY *) +(* tile pair (not just k_s <= k_t) once the weight is symmetrised to *) +(* w_s(x_t) + *) +(* w_t(x_s). For k_s <= k_t, PHISIG_CROSS_CORRELATION gives the w_s(x_t) *) +(* term *) +(* (w_t(x_s) >= 0 is slack); for k_t <= k_s, swap the correlation by *) +(* PHISIG_CORR_SYM and use the w_t(x_s) term. A convenient per-pair kernel *) +(* with no *) +(* scale-casing, used inside the 286L tree estimate. (It does NOT by itself *) +(* give a *) +(* convergent global double-sum bound for arbitrary P -- see *) +(* CARLESON_BLOCK_SPLIT.) *) +let PHISIG_CORR_TERM_LE = prove + (`?C. &0 <= C /\ !(s:int#int#int) (t:int#int#int). ~(s = t) /\ tile_J s = + tile_J t + ==> norm(integral (:real^1) + (\z. phi_sigma s carleson_phi (drop z) * cnj(phi_sigma t + carleson_phi (drop z)))) + <= C * real_integral (tile_I t) (cw_tile s)`, + MP_TAC PHISIG_CROSS_CORRELATION THEN + DISCH_THEN(X_CHOOSE_THEN `C:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `C:real` THEN ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC [`s:int#int#int`; `t:int#int#int`] THEN STRIP_TAC THEN + SUBGOAL_THEN `tile_k s = tile_k t` ASSUME_TAC THENL + [MATCH_MP_TAC TILE_J_EQ_IMP_K THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(C * (inv(sqrt(&2 zpow (tile_k s))) * inv(sqrt(&2 zpow (tile_k + t))))) * + cw_tile s (tile_xmid t)` THEN + CONJ_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[INT_LE_REFL]; ALL_TAC] THEN + FIRST_ASSUM SUBST1_TAC THEN REWRITE_TAC[INV_SQRT_ZPOW_SQ] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `C * (cw_tile s (tile_xmid t) * &2 zpow (--(tile_k t)))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_EQ_IMP_LE THEN CONV_TAC REAL_RING; + MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC CWTILE_MIDPOINT_TILE_I THEN + MATCH_MP_TAC TILE_XMID_NOT_IN_OTHER_I THEN ASM_REWRITE_TAC[]]);; + +(* Column-sum: sum_{t in P, J_t = J_s, t<>s} |(phi_s | phi_t)| <= C. *) +let PHISIG_COLSUM_LE = prove + (`?C. &0 <= C /\ !(s:int#int#int) (P:(int#int#int)->bool). FINITE P + ==> sum {t | t IN P /\ tile_J t = tile_J s /\ ~(t = s)} + (\t. norm(integral (:real^1) + (\z. phi_sigma s carleson_phi (drop z) * + cnj(phi_sigma t carleson_phi (drop z))))) + <= C`, + MP_TAC PHISIG_CORR_TERM_LE THEN + DISCH_THEN(X_CHOOSE_THEN `C:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `C:real` THEN ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC [`s:int#int#int`; `P:(int#int#int)->bool`] THEN + DISCH_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum {t | t IN P /\ tile_J t = tile_J s /\ ~(t = s)} + (\t. C * real_integral (tile_I t) (cw_tile s))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE THEN + ASM_SIMP_TAC[FINITE_RESTRICT; IN_ELIM_THM] THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[SUM_LMUL] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC CWTILE_SUM_DISJOINT_I_LE_1 THEN + ASM_SIMP_TAC[FINITE_RESTRICT] THEN + REWRITE_TAC[IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC TILE_SAMEJ_DISTINCT_DISJOINT_I THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* 286J diagonal term: (phi_sigma | phi_sigma) = ||phi_sigma||_2^2 = a fixed *) +(* constant (the tile map preserves the L^2 norm, PHISIG_CARLESON_L2). This *) +(* is the sigma = tau contribution to 286J's column sum. *) +(* ------------------------------------------------------------------------- *) + +(* norm(phi_sigma)^2 is integrable (Schwartz). *) +let PHISIG_CARLESON_NORMSQ_INT = prove + (`!(s:int#int#int). + (\x:real^1. lift(norm(phi_sigma s carleson_phi (drop x)) pow 2)) + integrable_on (:real^1)`, + GEN_TAC THEN MATCH_MP_TAC SCHWARTZ_NORMSQ_INTEGRABLE THEN + REWRITE_TAC[ETA_AX; PHISIG_CARLESON_SCHWARTZ]);; + +(* The weighted-integral value is the (sigma-independent) squared L^2 norm. *) +let PHISIG_DIAG_INTSQ = prove + (`!(s:int#int#int). + abs(drop(integral (:real^1) (\x. lift(norm(phi_sigma s carleson_phi (drop + x)) pow 2)))) + = (lnorm (:real^1) (&2) (\z. carleson_phi (drop z))) rpow &2`, + GEN_TAC THEN + MP_TAC(ISPECL [`(:real^1)`; `&2`; + `\z:real^1. phi_sigma s carleson_phi (drop z)`] + LNORM_RPOW) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC SCHWARTZ_L2 THEN + REWRITE_TAC[ETA_AX; PHISIG_CARLESON_SCHWARTZ]; + REAL_ARITH_TAC]; + ALL_TAC] THEN + BETA_TAC THEN REWRITE_TAC[GSYM RPOW_POW] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + SUBGOAL_THEN `lnorm (:real^1) (&2) (\z. phi_sigma s carleson_phi (drop z)) = + lnorm (:real^1) (&2) (\z. carleson_phi (drop z))` + SUBST1_TAC THENL [REWRITE_TAC[PHISIG_CARLESON_L2]; ALL_TAC] THEN + REWRITE_TAC[REAL_ABS_REFL] THEN MATCH_MP_TAC RPOW_POS_LE THEN + MATCH_MP_TAC LNORM_POS_LE THEN MATCH_MP_TAC SCHWARTZ_L2 THEN + REWRITE_TAC[CARLESON_PHI_SCHWARTZ]);; + +(* The diagonal self-correlation is a fixed nonnegative constant D. *) +let PHISIG_DIAG_CONST = prove + (`?D. &0 <= D /\ !(s:int#int#int). + norm(integral (:real^1) + (\z. phi_sigma s carleson_phi (drop z) * cnj(phi_sigma s carleson_phi + (drop z)))) + = D`, + EXISTS_TAC `(lnorm (:real^1) (&2) (\z. carleson_phi (drop z))) rpow &2` THEN + CONJ_TAC THENL + [MATCH_MP_TAC RPOW_POS_LE THEN MATCH_MP_TAC LNORM_POS_LE THEN + MATCH_MP_TAC SCHWARTZ_L2 THEN REWRITE_TAC[CARLESON_PHI_SCHWARTZ]; + ALL_TAC] THEN + GEN_TAC THEN + SUBGOAL_THEN + `integral (:real^1) + (\z. phi_sigma s carleson_phi (drop z) * cnj(phi_sigma s carleson_phi + (drop z))) = + lproduct (:real^1) (\z. phi_sigma s carleson_phi (drop z)) + (\z. phi_sigma s carleson_phi (drop z))` + SUBST1_TAC THENL [REWRITE_TAC[lproduct]; ALL_TAC] THEN + MP_TAC(MATCH_MP (BETA_RULE(ISPECL + [`(:real^1)`; + `\z:real^1. phi_sigma s carleson_phi (drop z)`] LPRODUCT_SELF)) + (SPEC `s:int#int#int` PHISIG_CARLESON_NORMSQ_INT)) THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[COMPLEX_NORM_CX; PHISIG_DIAG_INTSQ]);; + +(* 286J inner column factor: sum_{t in P, J_t = J_s} |(phi_s | phi_t)| <= *) +(* C3. *) +(* Split the diagonal t = s (value D, PHISIG_DIAG_CONST) from the *) +(* off-diagonal *) +(* (bound C, PHISIG_COLSUM_LE); C3 = C + D. *) +let PHISIG_INNER_FACTOR_LE = prove + (`?C3. &0 <= C3 /\ !(s:int#int#int) (P:(int#int#int)->bool). FINITE P + ==> sum {t | t IN P /\ tile_J t = tile_J s} + (\t. norm(integral (:real^1) + (\z. phi_sigma s carleson_phi (drop z) * + cnj(phi_sigma t carleson_phi (drop z))))) + <= C3`, + MP_TAC PHISIG_COLSUM_LE THEN DISCH_THEN(X_CHOOSE_THEN + `C:real` STRIP_ASSUME_TAC) THEN + MP_TAC PHISIG_DIAG_CONST THEN DISCH_THEN(X_CHOOSE_THEN + `D:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `C + D:real` THEN CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`s:int#int#int`; `P:(int#int#int)->bool`] THEN + DISCH_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum ({t | t IN P /\ tile_J t = tile_J s /\ ~(t = s)} UNION {s}) + (\t. norm(integral (:real^1) + (\z. phi_sigma s carleson_phi (drop z) * + cnj(phi_sigma t carleson_phi (drop z)))))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN + ASM_SIMP_TAC[FINITE_UNION; FINITE_RESTRICT; FINITE_SING] THEN + CONJ_TAC THENL + [REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_UNION; IN_SING] THEN MESON_TAC[]; + REWRITE_TAC[IN_UNION; IN_ELIM_THM; IN_DIFF] THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[NORM_POS_LE]]; + ALL_TAC] THEN + SUBGOAL_THEN + `sum ({t | t IN P /\ tile_J t = tile_J s /\ ~(t = s)} UNION {s}) + (\t. norm(integral (:real^1) + (\z. phi_sigma s carleson_phi (drop z) * + cnj(phi_sigma t carleson_phi (drop z))))) = + sum {t | t IN P /\ tile_J t = tile_J s /\ ~(t = s)} + (\t. norm(integral (:real^1) + (\z. phi_sigma s carleson_phi (drop z) * + cnj(phi_sigma t carleson_phi (drop z))))) + + sum {s} + (\t. norm(integral (:real^1) + (\z. phi_sigma s carleson_phi (drop z) * + cnj(phi_sigma t carleson_phi (drop z)))))` + SUBST1_TAC THENL + [MATCH_MP_TAC SUM_UNION THEN + ASM_SIMP_TAC[FINITE_RESTRICT; FINITE_SING] THEN + REWRITE_TAC[DISJOINT; EXTENSION; IN_INTER; IN_ELIM_THM; IN_SING; + NOT_IN_EMPTY] THEN + MESON_TAC[]; ALL_TAC] THEN + REWRITE_TAC[SUM_SING] THEN + MATCH_MP_TAC(REAL_ARITH `a <= C /\ b = D ==> a + b <= C + D`) THEN + ASM_SIMP_TAC[]);; + +(* 286J inner reduction: summing the column bound against any nonnegative *) +(* weight a_s^2 gives sum_s a_s^2 (sum_{t:J_t=J_s} |(phi_s|phi_t)|) <= *) +(* C3 sum_s a_s^2. (Termwise REAL_LE_LMUL by PHISIG_INNER_FACTOR_LE, *) +(* a_s^2>=0.) *) +let PHISIG_286J_STEP3 = prove + (`?C3. &0 <= C3 /\ !(a:(int#int#int)->real) (P:(int#int#int)->bool). FINITE P + ==> sum P (\s. (a s) pow 2 * + sum {t | t IN P /\ tile_J t = tile_J s} + (\t. norm(integral (:real^1) + (\z. phi_sigma s carleson_phi (drop z) * + cnj(phi_sigma t carleson_phi (drop z)))))) + <= C3 * sum P (\s. (a s) pow 2)`, + MP_TAC PHISIG_INNER_FACTOR_LE THEN + DISCH_THEN(X_CHOOSE_THEN `C3:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `C3:real` THEN ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC [`a:(int#int#int)->real`; `P:(int#int#int)->bool`] THEN + DISCH_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum P (\s. ((a:(int#int#int)->real) s) pow 2 * C3)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `s:int#int#int` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_LE_POW_2]; ASM_SIMP_TAC[]]; + REWRITE_TAC[SUM_RMUL] THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN + REAL_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* 286J, the first inequality: the finite double sum over frequency-matched *) +(* tile pairs is controlled by the diagonal l^2 mass. *) +(* sum_{(s,t) in PxP, J_s=J_t} a_s |(phi_s|phi_t)| a_t <= C3 sum_s a_s^2. *) +(* Fremlin's proof: AM-GM symmetrization + the column bound (286Ge/286Gb). *) +(* ------------------------------------------------------------------------- *) + +(* Weighted AM-GM: u K v <= 1/2 (u^2 K + v^2 K) for K >= 0. (K(u-v)^2 >= 0.) *) +let AMGM_WEIGHTED = prove + (`!u v K:real. &0 <= K ==> u * K * v <= &1 / &2 * (u pow 2 * K + v pow 2 * + K)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&0 <= K * (u - v) pow 2` MP_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[REAL_LE_POW_2]; ALL_TAC] THEN + MP_TAC(REAL_RING + `K * (u - v) pow 2 = (u pow 2 * K + v pow 2 * K) - &2 * (u * K * v)`) THEN + REAL_ARITH_TAC);; + +(* Symmetrization swap for the a_t^2-weighted double sum (SUM_SUM_RESTRICT *) +(* on the symmetric relation J_s = J_t, then the correlation is *) +(* |.|-symmetric). *) +let PHISIG_286J_YSWAP = prove + (`!(a:(int#int#int)->real) (P:(int#int#int)->bool). FINITE P + ==> sum P (\s. sum {t | t IN P /\ tile_J t = tile_J s} + (\t. (a t) pow 2 * + norm(integral (:real^1) + (\z. phi_sigma s carleson_phi (drop z) * + cnj(phi_sigma t carleson_phi (drop z)))))) + = sum P (\t. (a t) pow 2 * + sum {s | s IN P /\ tile_J s = tile_J t} + (\s. norm(integral (:real^1) + (\z. phi_sigma t carleson_phi (drop z) * + cnj(phi_sigma s carleson_phi (drop + z))))))`, + REPEAT STRIP_TAC THEN + MP_TAC(BETA_RULE(ISPECL + [`\x y:int#int#int. tile_J y = tile_J x`; + `\s t:int#int#int. (a t) pow 2 * + norm(integral (:real^1) + (\z. phi_sigma s carleson_phi (drop z) * + cnj(phi_sigma t carleson_phi (drop z))))`; + `P:(int#int#int)->bool`; `P:(int#int#int)->bool`] SUM_SUM_RESTRICT)) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `t:int#int#int` THEN DISCH_TAC THEN + REWRITE_TAC[SUM_LMUL] THEN AP_TERM_TAC THEN + SUBGOAL_THEN `{x | x IN P /\ tile_J t = tile_J x} = + {s | s IN P /\ tile_J s = tile_J t}` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN MESON_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `s:int#int#int` THEN DISCH_TAC THEN + REWRITE_TAC[PHISIG_CORR_SYM]);; + +(* The a_s^2-weighted half of the symmetrized double sum (diagonal weight). *) +let PHISIG_286J_XBOUND = prove + (`?C3. &0 <= C3 /\ !(a:(int#int#int)->real) (P:(int#int#int)->bool). FINITE P + ==> sum P (\s. sum {t | t IN P /\ tile_J t = tile_J s} + (\t. (a s) pow 2 * + norm(integral (:real^1) + (\z. phi_sigma s carleson_phi (drop z) * + cnj(phi_sigma t carleson_phi (drop z)))))) + <= C3 * sum P (\s. (a s) pow 2)`, + MP_TAC PHISIG_286J_STEP3 THEN DISCH_THEN(X_CHOOSE_THEN + `C3:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `C3:real` THEN ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC [`a:(int#int#int)->real`; `P:(int#int#int)->bool`] THEN + DISCH_TAC THEN + SUBGOAL_THEN + `!s:int#int#int. sum {t | t IN P /\ tile_J t = tile_J s} + (\t. (a s) pow 2 * + norm(integral (:real^1) + (\z. phi_sigma s carleson_phi (drop z) * + cnj(phi_sigma t carleson_phi (drop z))))) = + (a s) pow 2 * sum {t | t IN P /\ tile_J t = tile_J s} + (\t. norm(integral (:real^1) + (\z. phi_sigma s carleson_phi (drop z) * + cnj(phi_sigma t carleson_phi (drop z)))))` + (fun th -> REWRITE_TAC[th]) THENL + [GEN_TAC THEN REWRITE_TAC[SUM_LMUL]; ALL_TAC] THEN + ASM_SIMP_TAC[]);; + +(* The a_t^2-weighted half, reduced to the diagonal one via the swap. *) +let PHISIG_286J_YBOUND = prove + (`?C3. &0 <= C3 /\ !(a:(int#int#int)->real) (P:(int#int#int)->bool). FINITE P + ==> sum P (\s. sum {t | t IN P /\ tile_J t = tile_J s} + (\t. (a t) pow 2 * + norm(integral (:real^1) + (\z. phi_sigma s carleson_phi (drop z) * + cnj(phi_sigma t carleson_phi (drop z)))))) + <= C3 * sum P (\s. (a s) pow 2)`, + MP_TAC PHISIG_286J_STEP3 THEN DISCH_THEN(X_CHOOSE_THEN + `C3:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `C3:real` THEN ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC [`a:(int#int#int)->real`; `P:(int#int#int)->bool`] THEN + DISCH_TAC THEN + ASM_SIMP_TAC[PHISIG_286J_YSWAP]);; + +(* 286J first inequality (all-real form). *) +let PHISIG_286J_BILINEAR = prove + (`?C3. &0 <= C3 /\ !(a:(int#int#int)->real) (P:(int#int#int)->bool). FINITE P + ==> sum P (\s. sum {t | t IN P /\ tile_J t = tile_J s} + (\t. a s * + norm(integral (:real^1) + (\z. phi_sigma s carleson_phi (drop z) * + cnj(phi_sigma t carleson_phi (drop z)))) * a + t)) + <= C3 * sum P (\s. (a s) pow 2)`, + MP_TAC PHISIG_286J_XBOUND THEN DISCH_THEN(X_CHOOSE_THEN + `C3:real` STRIP_ASSUME_TAC) THEN + MP_TAC PHISIG_286J_YBOUND THEN DISCH_THEN(X_CHOOSE_THEN + `C3':real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `&1 / &2 * (C3 + C3')` THEN CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`a:(int#int#int)->real`; `P:(int#int#int)->bool`] THEN + DISCH_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `sum P (\s. sum {t | t IN P /\ tile_J t = tile_J s} + (\t. &1 / &2 * ((a s) pow 2 * + norm(integral (:real^1) + (\z. phi_sigma s carleson_phi (drop z) * + cnj(phi_sigma t carleson_phi (drop z)))) + + (a t) pow 2 * + norm(integral (:real^1) + (\z. phi_sigma s carleson_phi (drop z) * + cnj(phi_sigma t carleson_phi (drop z)))))))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `s:int#int#int` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + MATCH_MP_TAC SUM_LE THEN ASM_SIMP_TAC[FINITE_RESTRICT] THEN + X_GEN_TAC `t:int#int#int` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + MATCH_MP_TAC AMGM_WEIGHTED THEN REWRITE_TAC[NORM_POS_LE]; + ALL_TAC] THEN + SUBGOAL_THEN + `sum P (\s. sum {t | t IN P /\ tile_J t = tile_J s} + (\t. &1 / &2 * ((a s) pow 2 * + norm(integral (:real^1) + (\z. phi_sigma s carleson_phi (drop z) * + cnj(phi_sigma t carleson_phi (drop z)))) + + (a t) pow 2 * + norm(integral (:real^1) + (\z. phi_sigma s carleson_phi (drop z) * + cnj(phi_sigma t carleson_phi (drop z))))))) + = &1 / &2 * (sum P (\s. sum {t | t IN P /\ tile_J t = tile_J s} + (\t. (a s) pow 2 * + norm(integral (:real^1) + (\z. phi_sigma s carleson_phi (drop z) * + cnj(phi_sigma t carleson_phi (drop z)))))) + + sum P (\s. sum {t | t IN P /\ tile_J t = tile_J s} + (\t. (a t) pow 2 * + norm(integral (:real^1) + (\z. phi_sigma s carleson_phi (drop z) * + cnj(phi_sigma t carleson_phi (drop z)))))))` + SUBST1_TAC THENL + [REWRITE_TAC[REAL_ADD_LDISTRIB] THEN + ASM_SIMP_TAC[SUM_ADD; FINITE_RESTRICT] THEN REWRITE_TAC[SUM_LMUL] THEN + ASM_SIMP_TAC[GSYM SUM_ADD; FINITE_RESTRICT] THEN + REWRITE_TAC[REAL_ADD_LDISTRIB]; + ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH + `X <= C3 * S /\ Y <= C3' * S + ==> &1 / &2 * (X + Y) <= (&1 / &2 * (C3 + C3')) * S`) THEN + ASM_SIMP_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* 286J, the Bessel identity for the second inequality: *) +(* (f | sum_s (f|phi_s) phi_s) = sum_s |(f|phi_s)|^2. *) +(* Combined with Cauchy-Schwarz this gives sum_s |(f|phi_s)|^2 <= *) +(* ||sum_s (f|phi_s) phi_s||_2 ||f||_2. *) +(* ------------------------------------------------------------------------- *) + +(* Per-term: (f | (f|phi_s) phi_s) = |(f|phi_s)|^2. *) +let CARLESON_IP_SELFTERM = prove + (`!(f:real->complex) (s:int#int#int). + (\z:real^1. f(drop z) * cnj(phi_sigma s carleson_phi (drop z))) + integrable_on (:real^1) + ==> lproduct (:real^1) (\z. f(drop z)) + (\z. carleson_ip f s * phi_sigma s carleson_phi (drop z)) = + Cx(norm(carleson_ip f s) pow 2)`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[LPRODUCT_RMUL] THEN + REWRITE_TAC[carleson_ip; CX_POW; COMPLEX_MUL_CNJ]);; + +(* The Bessel identity itself (finite tile set P). *) +let CARLESON_BESSEL_IP = prove + (`!(f:real->complex) (P:(int#int#int)->bool). + FINITE P /\ + (!s. s IN P ==> (\z:real^1. f(drop z) * cnj(phi_sigma s carleson_phi (drop + z))) + integrable_on (:real^1)) + ==> lproduct (:real^1) (\z. f(drop z)) + (\z. vsum P (\s. carleson_ip f s * phi_sigma s carleson_phi (drop + z))) = + Cx(sum P (\s. norm(carleson_ip f s) pow 2))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`(:real^1)`; `\z:real^1. (f:real->complex)(drop z)`; + `\(s:int#int#int) (z:real^1). carleson_ip f s * phi_sigma s carleson_phi + (drop z)`; + `P:(int#int#int)->bool`] LPRODUCT_RSUM) THEN + BETA_TAC THEN ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN X_GEN_TAC `s:int#int#int` THEN DISCH_TAC THEN + SUBGOAL_THEN + `(\x. (f:real->complex)(drop x) * cnj(carleson_ip f s * phi_sigma s + carleson_phi (drop x))) = + (\x. cnj(carleson_ip f s) * (f(drop x) * cnj(phi_sigma s carleson_phi + (drop x))))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; CNJ_MUL] THEN + CONV_TAC COMPLEX_RING; ALL_TAC] THEN + MATCH_MP_TAC INTEGRABLE_COMPLEX_LMUL THEN ASM_SIMP_TAC[]; ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN + SUBGOAL_THEN + `!s:int#int#int. s IN P ==> + lproduct (:real^1) (\z. f(drop z)) + (\z. carleson_ip f s * phi_sigma s carleson_phi (drop z)) = + Cx(norm(carleson_ip f s) pow 2)` + (fun th -> ASM_SIMP_TAC[th; VSUM_CX]) THEN + X_GEN_TAC `s:int#int#int` THEN DISCH_TAC THEN + MATCH_MP_TAC CARLESON_IP_SELFTERM THEN ASM_SIMP_TAC[]);; + +(* The reconstruction sum sum_s (f|phi_s) phi_s lies in L^2 (finite sum of *) +(* complex-scalar multiples of the Schwartz phi_s). *) +let CARLESON_RECON_L2 = prove + (`!(f:real->complex) (P:(int#int#int)->bool). FINITE P + ==> (\z. vsum P (\s. carleson_ip f s * phi_sigma s carleson_phi (drop z))) + IN lspace (:real^1) (&2)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC LSPACE_VSUM THEN + ASM_REWRITE_TAC[REAL_ARITH `&0 < &2`] THEN + X_GEN_TAC `s:int#int#int` THEN DISCH_TAC THEN + MATCH_MP_TAC LSPACE_COMPLEX_LMUL THEN + MATCH_MP_TAC SCHWARTZ_L2 THEN + REWRITE_TAC[ETA_AX; PHISIG_CARLESON_SCHWARTZ]);; + +(* 286J, the second inequality: sum_s |(f|phi_s)|^2 <= *) +(* ||f||_2 ||sum_s (f|phi_s) phi_s||_2. (Bessel identity + Cauchy-Schwarz, *) +(* using that the diagonal l^2 mass is real and nonnegative.) *) +let CARLESON_286J_SECOND = prove + (`!(f:real->complex) (P:(int#int#int)->bool). + (\z. f(drop z)) IN lspace (:real^1) (&2) /\ FINITE P + ==> sum P (\s. norm(carleson_ip f s) pow 2) + <= lnorm (:real^1) (&2) (\z. f(drop z)) * + lnorm (:real^1) (&2) + (\z. vsum P (\s. carleson_ip f s * phi_sigma s carleson_phi (drop + z)))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `!s:int#int#int. (\z:real^1. f(drop z) * cnj(phi_sigma s carleson_phi (drop + z))) + integrable_on (:real^1)` + ASSUME_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC L2_CNJ_PRODUCT_INTEGRABLE THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SCHWARTZ_L2 THEN + REWRITE_TAC[ETA_AX; PHISIG_CARLESON_SCHWARTZ]; ALL_TAC] THEN + SUBGOAL_THEN + `sum P (\s. norm(carleson_ip f s) pow 2) = + norm(lproduct (:real^1) (\z. f(drop z)) + (\z. vsum P (\s. carleson_ip f s * phi_sigma s carleson_phi (drop + z))))` + SUBST1_TAC THENL + [ASM_SIMP_TAC[CARLESON_BESSEL_IP; COMPLEX_NORM_CX] THEN + CONV_TAC SYM_CONV THEN REWRITE_TAC[REAL_ABS_REFL] THEN + MATCH_MP_TAC SUM_POS_LE THEN REWRITE_TAC[REAL_LE_POW_2]; ALL_TAC] THEN + MATCH_MP_TAC LPRODUCT_CAUCHY_SCHWARZ THEN + ASM_SIMP_TAC[CARLESON_RECON_L2] THEN + MATCH_MP_TAC L2_CNJ_PRODUCT_INTEGRABLE THEN + ASM_SIMP_TAC[CARLESON_RECON_L2]);; + +(* ------------------------------------------------------------------------- *) +(* Toward 286K(b): expanding the L^2 pairing of the reconstruction sum *) +(* g = sum_s (f|phi_s) phi_s against itself. The OUTER expansion peels the *) +(* first argument's sum (LPRODUCT_LSUM + LPRODUCT_LMUL). *) +(* ------------------------------------------------------------------------- *) + +(* Integrability of phi_s cnj(g) and (c_s phi_s) cnj(g) (both L^2 factors). *) +let CARLESON_PHISIG_RECON_INT = prove + (`!(f:real->complex) (P:(int#int#int)->bool) (s:int#int#int). + FINITE P /\ (\z. f(drop z)) IN lspace (:real^1) (&2) + ==> (\z:real^1. phi_sigma s carleson_phi (drop z) * + cnj(vsum P (\t. carleson_ip f t * phi_sigma t carleson_phi + (drop z)))) + integrable_on (:real^1)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC L2_CNJ_PRODUCT_INTEGRABLE THEN + CONJ_TAC THENL + [MATCH_MP_TAC SCHWARTZ_L2 THEN + REWRITE_TAC[ETA_AX; PHISIG_CARLESON_SCHWARTZ]; + REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC CARLESON_RECON_L2 THEN + ASM_REWRITE_TAC[]]);; + +let CARLESON_SCALPHISIG_RECON_INT = prove + (`!(f:real->complex) (P:(int#int#int)->bool) (s:int#int#int). + FINITE P /\ (\z. f(drop z)) IN lspace (:real^1) (&2) + ==> (\z:real^1. (carleson_ip f s * phi_sigma s carleson_phi (drop z)) * + cnj(vsum P (\t. carleson_ip f t * phi_sigma t carleson_phi + (drop z)))) + integrable_on (:real^1)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC L2_CNJ_PRODUCT_INTEGRABLE THEN + CONJ_TAC THENL + [MATCH_MP_TAC LSPACE_COMPLEX_LMUL THEN MATCH_MP_TAC SCHWARTZ_L2 THEN + REWRITE_TAC[ETA_AX; PHISIG_CARLESON_SCHWARTZ]; + REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC CARLESON_RECON_L2 THEN + ASM_REWRITE_TAC[]]);; + +(* (g | g) = sum_s (f|phi_s) (phi_s | g), g = sum_s (f|phi_s) phi_s. *) +let CARLESON_NORMSQ_OUTER = prove + (`!(f:real->complex) (P:(int#int#int)->bool). FINITE P /\ (\z. f(drop z)) IN + lspace (:real^1) (&2) + ==> lproduct (:real^1) + (\z. vsum P (\s. carleson_ip f s * phi_sigma s carleson_phi (drop + z))) + (\z. vsum P (\s. carleson_ip f s * phi_sigma s carleson_phi (drop + z))) = + vsum P (\s. carleson_ip f s * + lproduct (:real^1) (\z. phi_sigma s carleson_phi (drop z)) + (\z. vsum P (\t. carleson_ip f t * phi_sigma t carleson_phi (drop + z))))`, + REPEAT STRIP_TAC THEN + MP_TAC(BETA_RULE(ISPECL + [`(:real^1)`; + `\(s:int#int#int) (z:real^1). carleson_ip f s * phi_sigma s carleson_phi + (drop z)`; + `\z:real^1. vsum P (\t. carleson_ip f t * phi_sigma t carleson_phi (drop + z))`; + `P:(int#int#int)->bool`] LPRODUCT_LSUM)) THEN + ASM_SIMP_TAC[CARLESON_SCALPHISIG_RECON_INT] THEN DISCH_THEN SUBST1_TAC THEN + MATCH_MP_TAC VSUM_EQ THEN X_GEN_TAC `s:int#int#int` THEN DISCH_TAC THEN + REWRITE_TAC[] THEN + MATCH_MP_TAC LPRODUCT_LMUL THEN ASM_SIMP_TAC[CARLESON_PHISIG_RECON_INT]);; + +(* Integrability of phi_s cnj((f|phi_t) phi_t), both L^2. *) +let CARLESON_PHISIG_SCALPHISIG_INT = prove + (`!(f:real->complex) (s:int#int#int) (t:int#int#int). + (\z:real^1. phi_sigma s carleson_phi (drop z) * + cnj(carleson_ip f t * phi_sigma t carleson_phi (drop z))) + integrable_on (:real^1)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC L2_CNJ_PRODUCT_INTEGRABLE THEN + CONJ_TAC THENL + [MATCH_MP_TAC SCHWARTZ_L2 THEN + REWRITE_TAC[ETA_AX; PHISIG_CARLESON_SCHWARTZ]; + MATCH_MP_TAC LSPACE_COMPLEX_LMUL THEN MATCH_MP_TAC SCHWARTZ_L2 THEN + REWRITE_TAC[ETA_AX; PHISIG_CARLESON_SCHWARTZ]]);; + +(* INNER expansion: (phi_s | g) = sum_t cnj(f|phi_t) (phi_s | phi_t). *) +let CARLESON_NORMSQ_INNER = prove + (`!(f:real->complex) (P:(int#int#int)->bool) (s:int#int#int). FINITE P + ==> lproduct (:real^1) (\z. phi_sigma s carleson_phi (drop z)) + (\z. vsum P (\t. carleson_ip f t * phi_sigma t carleson_phi (drop + z))) = + vsum P (\t. cnj(carleson_ip f t) * + lproduct (:real^1) (\z. phi_sigma s carleson_phi (drop z)) + (\z. phi_sigma t carleson_phi (drop z)))`, + REPEAT STRIP_TAC THEN + MP_TAC(BETA_RULE(ISPECL + [`(:real^1)`; + `\z:real^1. phi_sigma s carleson_phi (drop z)`; + `\(t:int#int#int) (z:real^1). carleson_ip f t * phi_sigma t carleson_phi + (drop z)`; + `P:(int#int#int)->bool`] LPRODUCT_RSUM)) THEN + ASM_SIMP_TAC[CARLESON_PHISIG_SCALPHISIG_INT] THEN DISCH_THEN SUBST1_TAC THEN + MATCH_MP_TAC VSUM_EQ THEN X_GEN_TAC `t:int#int#int` THEN DISCH_TAC THEN + REWRITE_TAC[] THEN + MATCH_MP_TAC LPRODUCT_RMUL THEN BETA_TAC THEN + MATCH_MP_TAC SCHWARTZ_CNJ_PRODUCT_INTEGRABLE THEN + REWRITE_TAC[ETA_AX; PHISIG_CARLESON_SCHWARTZ]);; + +(* 286K(b) expansion: ||g||_2^2 pairing = sum_s sum_t (f|phi_s) cnj(f|phi_t) *) +(* (phi_s | phi_t). (Fremlin: alpha^2 = sum_{s,t} *) +(* (f|phi_s)(phi_s|phi_t)(phi_t|f).) *) +let CARLESON_NORMSQ_DOUBLE = prove + (`!(f:real->complex) (P:(int#int#int)->bool). FINITE P /\ (\z. f(drop z)) IN + lspace (:real^1) (&2) + ==> lproduct (:real^1) + (\z. vsum P (\s. carleson_ip f s * phi_sigma s carleson_phi (drop + z))) + (\z. vsum P (\s. carleson_ip f s * phi_sigma s carleson_phi (drop + z))) = + vsum P (\s. vsum P (\t. + carleson_ip f s * cnj(carleson_ip f t) * + lproduct (:real^1) (\z. phi_sigma s carleson_phi (drop z)) + (\z. phi_sigma t carleson_phi (drop z))))`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[CARLESON_NORMSQ_OUTER] THEN + MATCH_MP_TAC VSUM_EQ THEN X_GEN_TAC `s:int#int#int` THEN DISCH_TAC THEN + REWRITE_TAC[] THEN + ASM_SIMP_TAC[CARLESON_NORMSQ_INNER] THEN + ASM_SIMP_TAC[GSYM VSUM_COMPLEX_LMUL] THEN + MATCH_MP_TAC VSUM_EQ THEN X_GEN_TAC `t:int#int#int` THEN DISCH_TAC THEN + CONV_TAC COMPLEX_RING);; + +(* ------------------------------------------------------------------------- *) +(* 286K(b), the diagonal (J_s = J_t) block bound. Taking norms termwise *) +(* (triangle) and applying 286J (PHISIG_286J_BILINEAR) bounds the frequency- *) +(* matched block by C3 sum_s |(f|phi_s)|^2 -- Fremlin's "first term <= C3 *) +(* alpha". *) +(* ------------------------------------------------------------------------- *) + +(* Termwise triangle bound reducing the complex block to the all-real 286J *) +(* sum. *) +let CARLESON_DIAGBLOCK_TRIANGLE = prove + (`!(f:real->complex) (P:(int#int#int)->bool). FINITE P + ==> norm(vsum P (\s. vsum {t | t IN P /\ tile_J t = tile_J s} (\t. + carleson_ip f s * cnj(carleson_ip f t) * + lproduct (:real^1) (\z. phi_sigma s carleson_phi (drop z)) + (\z. phi_sigma t carleson_phi (drop z))))) + <= sum P (\s. sum {t | t IN P /\ tile_J t = tile_J s} (\t. + norm(carleson_ip f s) * + norm(integral (:real^1) (\z. phi_sigma s carleson_phi (drop z) + * + cnj(phi_sigma t carleson_phi (drop + z)))) * + norm(carleson_ip f t)))`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum P (\s. norm(vsum {t | t IN P /\ tile_J t = tile_J s} (\t. + carleson_ip f s * cnj(carleson_ip f t) * + lproduct (:real^1) (\z. phi_sigma s carleson_phi (drop z)) + (\z. phi_sigma t carleson_phi (drop z)))))` + THEN + CONJ_TAC THENL + [MATCH_MP_TAC VSUM_NORM_LE THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `s:int#int#int` THEN DISCH_TAC THEN REWRITE_TAC[REAL_LE_REFL]; + MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `s:int#int#int` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + MATCH_MP_TAC VSUM_NORM_LE THEN ASM_SIMP_TAC[FINITE_RESTRICT] THEN + X_GEN_TAC `t:int#int#int` THEN DISCH_TAC THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CNJ; lproduct] THEN + MATCH_MP_TAC REAL_EQ_IMP_LE THEN REWRITE_TAC[REAL_MUL_AC]]);; + +(* The block bound proper: ||diagonal block|| <= C3 sum_s |(f|phi_s)|^2. *) +let CARLESON_DIAGBLOCK_LE = prove + (`?C3. &0 <= C3 /\ !(f:real->complex) (P:(int#int#int)->bool). FINITE P + ==> norm(vsum P (\s. vsum {t | t IN P /\ tile_J t = tile_J s} (\t. + carleson_ip f s * cnj(carleson_ip f t) * + lproduct (:real^1) (\z. phi_sigma s carleson_phi (drop z)) + (\z. phi_sigma t carleson_phi (drop z))))) + <= C3 * sum P (\s. norm(carleson_ip f s) pow 2)`, + MP_TAC PHISIG_286J_BILINEAR THEN + DISCH_THEN(X_CHOOSE_THEN `C3:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `C3:real` THEN ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC [`f:real->complex`; `P:(int#int#int)->bool`] THEN + DISCH_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum P (\s. sum {t | t IN P /\ tile_J t = tile_J s} (\t. + norm(carleson_ip f s) * + norm(integral (:real^1) (\z. phi_sigma s carleson_phi (drop z) + * + cnj(phi_sigma t carleson_phi (drop + z)))) * + norm(carleson_ip f t)))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC CARLESON_DIAGBLOCK_TRIANGLE THEN ASM_REWRITE_TAC[]; + FIRST_X_ASSUM(MP_TAC o SPECL [`\s:int#int#int. norm(carleson_ip f s)`; + `P:(int#int#int)->bool`]) THEN + ASM_REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* 286L (off-diagonal): the block over frequency-DISTINCT tile pairs (J_t /= *) +(* J_s) -- the complement of the 286J diagonal. Its norm reduces (termwise *) +(* triangle, exactly as CARLESON_DIAGBLOCK_TRIANGLE) to the real double sum *) +(* sum_s sum_{t: J_t/=J_s} |(f|phi_s)| || |(f|phi_t)|, *) +(* which the 286G(e) cross-correlation decay + the maximal-cover Schur *) +(* argument *) +(* then bound. This is the entry point of the W0..W3 estimate. *) +let CARLESON_OFFBLOCK_TRIANGLE = prove + (`!(f:real->complex) (P:(int#int#int)->bool). FINITE P + ==> norm(vsum P (\s. vsum {t | t IN P /\ ~(tile_J t = tile_J s)} (\t. + carleson_ip f s * cnj(carleson_ip f t) * + lproduct (:real^1) (\z. phi_sigma s carleson_phi (drop z)) + (\z. phi_sigma t carleson_phi (drop z))))) + <= sum P (\s. sum {t | t IN P /\ ~(tile_J t = tile_J s)} (\t. + norm(carleson_ip f s) * + norm(integral (:real^1) (\z. phi_sigma s carleson_phi (drop z) + * + cnj(phi_sigma t carleson_phi (drop + z)))) * + norm(carleson_ip f t)))`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum P (\s. norm(vsum {t | t IN P /\ ~(tile_J t = tile_J s)} (\t. + carleson_ip f s * cnj(carleson_ip f t) * + lproduct (:real^1) (\z. phi_sigma s carleson_phi (drop z)) + (\z. phi_sigma t carleson_phi (drop z)))))` + THEN + CONJ_TAC THENL + [MATCH_MP_TAC VSUM_NORM_LE THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `s:int#int#int` THEN DISCH_TAC THEN REWRITE_TAC[REAL_LE_REFL]; + MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `s:int#int#int` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + MATCH_MP_TAC VSUM_NORM_LE THEN ASM_SIMP_TAC[FINITE_RESTRICT] THEN + X_GEN_TAC `t:int#int#int` THEN DISCH_TAC THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CNJ; lproduct] THEN + MATCH_MP_TAC REAL_EQ_IMP_LE THEN REWRITE_TAC[REAL_MUL_AC]]);; + +(* Substituting the scale-order-free correlation bound *) +(* (PHISIG_CROSS_CORR_SYM) *) +(* into the off-diagonal real sum replaces the abstract || by *) +(* the *) +(* explicit weight kernel inv(2^{k_s/2}) inv(2^{k_t/2}) (w_s(x_t)+w_t(x_s)). *) +(* The off-diagonal sum is now PURELY GEOMETRIC. Termwise: multiply the *) +(* per-pair *) +(* correlation bound by the nonnegative coefficients |(f|phi_s)|, *) +(* |(f|phi_t)| *) +(* (normalise both sides to (|a_s| |a_t|) * factor via REAL_MUL_AC, then *) +(* REAL_LE_ *) +(* LMUL on the nonneg |a_s||a_t|), summed by SUM_LE twice + SUM_LMUL. *) +let CARLESON_BLOCK_SPLIT = prove + (`!(f:real->complex) (P:(int#int#int)->bool). FINITE P + ==> vsum P (\s. vsum P (\t. + carleson_ip f s * cnj(carleson_ip f t) * + lproduct (:real^1) (\z. phi_sigma s carleson_phi (drop z)) + (\z. phi_sigma t carleson_phi (drop z)))) = + vsum P (\s. vsum {t | t IN P /\ tile_J t = tile_J s} (\t. + carleson_ip f s * cnj(carleson_ip f t) * + lproduct (:real^1) (\z. phi_sigma s carleson_phi (drop z)) + (\z. phi_sigma t carleson_phi (drop z)))) + + vsum P (\s. vsum {t | t IN P /\ ~(tile_J t = tile_J s)} (\t. + carleson_ip f s * cnj(carleson_ip f t) * + lproduct (:real^1) (\z. phi_sigma s carleson_phi (drop z)) + (\z. phi_sigma t carleson_phi (drop z))))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `vsum P (\s:int#int#int. vsum {t | t IN P /\ tile_J t = tile_J s} (\t. + carleson_ip (f:real->complex) s * cnj(carleson_ip f t) * + lproduct (:real^1) (\z. phi_sigma s carleson_phi (drop z)) + (\z. phi_sigma t carleson_phi (drop z)))) + + vsum P (\s. vsum {t | t IN P /\ ~(tile_J t = tile_J s)} (\t. + carleson_ip f s * cnj(carleson_ip f t) * + lproduct (:real^1) (\z. phi_sigma s carleson_phi (drop z)) + (\z. phi_sigma t carleson_phi (drop z)))) = + vsum P (\s. vsum {t | t IN P /\ tile_J t = tile_J s} (\t. + carleson_ip f s * cnj(carleson_ip f t) * + lproduct (:real^1) (\z. phi_sigma s carleson_phi (drop z)) + (\z. phi_sigma t carleson_phi (drop z))) + + vsum {t | t IN P /\ ~(tile_J t = tile_J s)} (\t. + carleson_ip f s * cnj(carleson_ip f t) * + lproduct (:real^1) (\z. phi_sigma s carleson_phi (drop z)) + (\z. phi_sigma t carleson_phi (drop z))))` + SUBST1_TAC THENL + [ASM_SIMP_TAC[VSUM_ADD]; ALL_TAC] THEN + MATCH_MP_TAC VSUM_EQ THEN X_GEN_TAC `s:int#int#int` THEN DISCH_TAC THEN + REWRITE_TAC[] THEN + MP_TAC(ISPECL [`P:(int#int#int)->bool`; + `\t:int#int#int. tile_J t = tile_J s`; + `\t. carleson_ip (f:real->complex) s * cnj(carleson_ip f t) * + lproduct (:real^1) (\z. phi_sigma s carleson_phi (drop z)) + (\z. phi_sigma t carleson_phi (drop z))`; + `\t. carleson_ip (f:real->complex) s * cnj(carleson_ip f t) * + lproduct (:real^1) (\z. phi_sigma s carleson_phi (drop z)) + (\z. phi_sigma t carleson_phi (drop z))`] + VSUM_CASES) THEN + ASM_REWRITE_TAC[COND_ID] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[]);; + +(* Assembly (valid for ANY finite P): the Gram double-sum norm is <= C3*mass *) +(* + *) +(* norm(off-diagonal block). norm-triangle on CARLESON_BLOCK_SPLIT + *) +(* DIAGBLOCK_LE. *) +(* This is a TRUE reduction, but it does NOT by itself finish 286K: the *) +(* off-diagonal *) +(* norm is only controllable on stopping-time TREES (see *) +(* CARLESON_BLOCK_SPLIT note), *) +(* where the ENERGY bound replaces a (false, for general P) global C7*mass *) +(* bound. *) +(* Kept as a reusable identity; the actual 286K/286L endgame runs on *) +(* ENERGY_DECOMP *) +(* trees + the single-tree energy x mass factorization (286L), not on this *) +(* line. *) +let CARLESON_NORMSQ_DOUBLE_LE = prove + (`?C3. &0 <= C3 /\ !(f:real->complex) (P:(int#int#int)->bool). FINITE P + ==> norm(vsum P (\s. vsum P (\t. + carleson_ip f s * cnj(carleson_ip f t) * + lproduct (:real^1) (\z. phi_sigma s carleson_phi (drop z)) + (\z. phi_sigma t carleson_phi (drop z))))) + <= C3 * sum P (\s. norm(carleson_ip f s) pow 2) + + norm(vsum P (\s. vsum {t | t IN P /\ ~(tile_J t = tile_J s)} (\t. + carleson_ip f s * cnj(carleson_ip f t) * + lproduct (:real^1) (\z. phi_sigma s carleson_phi (drop z)) + (\z. phi_sigma t carleson_phi (drop z)))))`, + MP_TAC CARLESON_DIAGBLOCK_LE THEN + DISCH_THEN(X_CHOOSE_THEN `C3:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `C3:real` THEN ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC [`f:real->complex`; `P:(int#int#int)->bool`] THEN + DISCH_TAC THEN + ASM_SIMP_TAC[CARLESON_BLOCK_SPLIT] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `norm(vsum P (\s. vsum {t | t IN P /\ tile_J t = tile_J s} (\t. + carleson_ip (f:real->complex) s * cnj(carleson_ip f t) * + lproduct (:real^1) (\z. phi_sigma s carleson_phi (drop z)) + (\z. phi_sigma t carleson_phi (drop z))))) + + norm(vsum P (\s. vsum {t | t IN P /\ ~(tile_J t = tile_J s)} (\t. + carleson_ip f s * cnj(carleson_ip f t) * + lproduct (:real^1) (\z. phi_sigma s carleson_phi (drop z)) + (\z. phi_sigma t carleson_phi (drop z)))))` + THEN + CONJ_TAC THENL + [REWRITE_TAC[NORM_TRIANGLE]; + MATCH_MP_TAC REAL_LE_ADD2 THEN ASM_SIMP_TAC[REAL_LE_REFL]]);; + +(* ------------------------------------------------------------------------- *) +(* 286L(g): the alpha3 ENERGY / L^2 input. For a TREE (all tiles <=_r tau), *) +(* the reconstruction g~ = sum ip_s phi_s has ||g~||_2^2 <= C3 gamma^2 *) +(* 2^{-k_tau}. The off-diagonal-J block of ||g~||_2^2 VANISHES on the tree *) +(* (286Fc: different-scale tree tiles are orthogonal, PHISIG_TREE_ORTHO), so *) +(* only the diagonal-J block survives (<= C3 sum|ip|^2, *) +(* CARLESON_DIAGBLOCK_LE), *) +(* and sum_{tree}|ip|^2 <= gamma^2 2^{-k_tau} (FTILDE_ENERGY_SUM). *) +(* ------------------------------------------------------------------------- *) +let CARLESON_DIAGBLOCK_TRIANGLE_C = prove + (`!(c:(int#int#int)->complex) (P:(int#int#int)->bool). FINITE P + ==> norm(vsum P (\s. vsum {t | t IN P /\ tile_J t = tile_J s} (\t. + c s * cnj(c t) * + lproduct (:real^1) (\z. phi_sigma s carleson_phi (drop z)) + (\z. phi_sigma t carleson_phi (drop z))))) + <= sum P (\s. sum {t | t IN P /\ tile_J t = tile_J s} (\t. + norm(c s) * + norm(integral (:real^1) (\z. phi_sigma s carleson_phi (drop z) + * + cnj(phi_sigma t carleson_phi (drop + z)))) * + norm(c t)))`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum P (\s. norm(vsum {t | t IN P /\ tile_J t = tile_J s} (\t. + (c:(int#int#int)->complex) s * cnj(c t) * + lproduct (:real^1) (\z. phi_sigma s carleson_phi (drop z)) + (\z. phi_sigma t carleson_phi (drop z)))))` + THEN + CONJ_TAC THENL + [MATCH_MP_TAC VSUM_NORM_LE THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `s:int#int#int` THEN DISCH_TAC THEN REWRITE_TAC[REAL_LE_REFL]; + MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `s:int#int#int` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + MATCH_MP_TAC VSUM_NORM_LE THEN ASM_SIMP_TAC[FINITE_RESTRICT] THEN + X_GEN_TAC `t:int#int#int` THEN DISCH_TAC THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CNJ; lproduct] THEN + MATCH_MP_TAC REAL_EQ_IMP_LE THEN REWRITE_TAC[REAL_MUL_AC]]);; + +let CARLESON_DIAGBLOCK_LE_C = prove + (`?C3. &0 <= C3 /\ !(c:(int#int#int)->complex) (P:(int#int#int)->bool). FINITE + P + ==> norm(vsum P (\s. vsum {t | t IN P /\ tile_J t = tile_J s} (\t. + c s * cnj(c t) * + lproduct (:real^1) (\z. phi_sigma s carleson_phi (drop z)) + (\z. phi_sigma t carleson_phi (drop z))))) + <= C3 * sum P (\s. norm(c s) pow 2)`, + MP_TAC PHISIG_286J_BILINEAR THEN + DISCH_THEN(X_CHOOSE_THEN `C3:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `C3:real` THEN ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC [`c:(int#int#int)->complex`; + `P:(int#int#int)->bool`] THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum P (\s. sum {t | t IN P /\ tile_J t = tile_J s} (\t. + norm((c:(int#int#int)->complex) s) * + norm(integral (:real^1) (\z. phi_sigma s carleson_phi (drop z) + * + cnj(phi_sigma t carleson_phi (drop + z)))) * + norm(c t)))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC CARLESON_DIAGBLOCK_TRIANGLE_C THEN ASM_REWRITE_TAC[]; + FIRST_X_ASSUM(MP_TAC o SPECL [`\s:int#int#int. + norm((c:(int#int#int)->complex) s)`; + `P:(int#int#int)->bool`]) THEN + ASM_REWRITE_TAC[]]);; + +let CARLESON_BLOCK_SPLIT_C = prove + (`!(c:(int#int#int)->complex) (P:(int#int#int)->bool). FINITE P + ==> vsum P (\s. vsum P (\t. + c s * cnj(c t) * + lproduct (:real^1) (\z. phi_sigma s carleson_phi (drop z)) + (\z. phi_sigma t carleson_phi (drop z)))) = + vsum P (\s. vsum {t | t IN P /\ tile_J t = tile_J s} (\t. + c s * cnj(c t) * + lproduct (:real^1) (\z. phi_sigma s carleson_phi (drop z)) + (\z. phi_sigma t carleson_phi (drop z)))) + + vsum P (\s. vsum {t | t IN P /\ ~(tile_J t = tile_J s)} (\t. + c s * cnj(c t) * + lproduct (:real^1) (\z. phi_sigma s carleson_phi (drop z)) + (\z. phi_sigma t carleson_phi (drop z))))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `vsum P (\s:int#int#int. vsum {t | t IN P /\ tile_J t = tile_J s} (\t. + (c:(int#int#int)->complex) s * cnj(c t) * + lproduct (:real^1) (\z. phi_sigma s carleson_phi (drop z)) + (\z. phi_sigma t carleson_phi (drop z)))) + + vsum P (\s. vsum {t | t IN P /\ ~(tile_J t = tile_J s)} (\t. + c s * cnj(c t) * + lproduct (:real^1) (\z. phi_sigma s carleson_phi (drop z)) + (\z. phi_sigma t carleson_phi (drop z)))) = + vsum P (\s. vsum {t | t IN P /\ tile_J t = tile_J s} (\t. + c s * cnj(c t) * + lproduct (:real^1) (\z. phi_sigma s carleson_phi (drop z)) + (\z. phi_sigma t carleson_phi (drop z))) + + vsum {t | t IN P /\ ~(tile_J t = tile_J s)} (\t. + c s * cnj(c t) * + lproduct (:real^1) (\z. phi_sigma s carleson_phi (drop z)) + (\z. phi_sigma t carleson_phi (drop z))))` + SUBST1_TAC THENL + [ASM_SIMP_TAC[VSUM_ADD]; ALL_TAC] THEN + MATCH_MP_TAC VSUM_EQ THEN X_GEN_TAC `s:int#int#int` THEN DISCH_TAC THEN + REWRITE_TAC[] THEN + MP_TAC(ISPECL [`P:(int#int#int)->bool`; + `\t:int#int#int. tile_J t = tile_J s`; + `\t. (c:(int#int#int)->complex) s * cnj(c t) * + lproduct (:real^1) (\z. phi_sigma s carleson_phi (drop z)) + (\z. phi_sigma t carleson_phi (drop z))`; + `\t. (c:(int#int#int)->complex) s * cnj(c t) * + lproduct (:real^1) (\z. phi_sigma s carleson_phi (drop z)) + (\z. phi_sigma t carleson_phi (drop z))`] + VSUM_CASES) THEN + ASM_REWRITE_TAC[COND_ID] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[]);; + +let FTILDE_OFFBLOCK_ZERO_C = prove + (`!(c:(int#int#int)->complex) (P:(int#int#int)->bool) tau. + FINITE P /\ (!s. s IN P ==> tile_ler s tau) + ==> vsum P (\s. vsum {t | t IN P /\ ~(tile_J t = tile_J s)} + (\t. c s * cnj(c t) * + lproduct (:real^1) (\z. phi_sigma s carleson_phi + (drop z)) + (\z. phi_sigma t carleson_phi + (drop z)))) = vec 0`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC VSUM_EQ_0 THEN + X_GEN_TAC `s:int#int#int` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + MATCH_MP_TAC VSUM_EQ_0 THEN X_GEN_TAC `t:int#int#int` THEN + REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN + SUBGOAL_THEN `lproduct (:real^1) (\z. phi_sigma s carleson_phi (drop z)) + (\z. phi_sigma t carleson_phi (drop z)) = + Cx(&0)` + (fun th -> REWRITE_TAC[th; COMPLEX_MUL_RZERO; COMPLEX_VEC_0]) THEN + REWRITE_TAC[lproduct] THEN MATCH_MP_TAC PHISIG_TREE_ORTHO THEN + EXISTS_TAC `tau:int#int#int` THEN ASM_SIMP_TAC[] THEN + DISCH_TAC THEN UNDISCH_TAC `~(tile_J t = tile_J s)` THEN REWRITE_TAC[] THEN + MATCH_MP_TAC TILE_TREE_SAMESCALE_J THEN EXISTS_TAC `tau:int#int#int` THEN + ASM_SIMP_TAC[TILE_LER_IMP_LE]);; + +let FTILDE_DOUBLE_LE_C = prove + (`?C3. &0 <= C3 /\ + !(c:(int#int#int)->complex) (P:(int#int#int)->bool) tau. + FINITE P /\ (!s. s IN P ==> tile_ler s tau) + ==> norm(vsum P (\s. vsum P (\t. + c s * cnj(c t) * + lproduct (:real^1) (\z. phi_sigma s carleson_phi (drop z)) + (\z. phi_sigma t carleson_phi (drop z))))) + <= C3 * sum P (\s. norm(c s) pow 2)`, + X_CHOOSE_THEN + `C3:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "DB")) + CARLESON_DIAGBLOCK_LE_C THEN + EXISTS_TAC `C3:real` THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`c:(int#int#int)->complex`; + `P:(int#int#int)->bool`] CARLESON_BLOCK_SPLIT_C) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN + MP_TAC(ISPECL [`c:(int#int#int)->complex`; `P:(int#int#int)->bool`; + `tau:int#int#int`] FTILDE_OFFBLOCK_ZERO_C) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN + REWRITE_TAC[VECTOR_ADD_RID] THEN USE_THEN "DB" MATCH_MP_TAC THEN + ASM_REWRITE_TAC[]);; + +let CARLESON_NORMSQ_REAL = prove + (`!(f:real->complex) (P:(int#int#int)->bool). + FINITE P /\ (\z. f(drop z)) IN lspace (:real^1) (&2) + ==> Cx(drop(integral (:real^1) + (\z. lift(norm(vsum P (\s. carleson_ip f s * phi_sigma s + carleson_phi (drop z))) pow 2)))) = + vsum P (\s. vsum P (\t. carleson_ip f s * cnj(carleson_ip f t) * + lproduct (:real^1) (\z. phi_sigma s carleson_phi (drop z)) + (\z. phi_sigma t carleson_phi (drop z))))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC + `lproduct (:real^1) + (\z. vsum P (\s. carleson_ip (f:real->complex) s * phi_sigma s + carleson_phi (drop z))) + (\z. vsum P (\s. carleson_ip f s * phi_sigma s carleson_phi (drop z)))` + THEN + CONJ_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC LPRODUCT_SELF THEN + MP_TAC(ISPECL [`f:real->complex`; + `P:(int#int#int)->bool`] CARLESON_RECON_L2) THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[lspace; IN_ELIM_THM; RPOW_POW] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC CARLESON_NORMSQ_DOUBLE THEN ASM_REWRITE_TAC[]]);; + +(* 286L(g), integral form: ||g~||_2^2 = INT_R |g~|^2 <= C3 gamma^2 *) +(* 2^{-k_tau} *) +(* for the tree g~ = sum_{s <=_r tau} ip_s phi_s. The integral (nonneg real) *) +(* equals *) +(* Re/norm of the double sum (CARLESON_NORMSQ_REAL), which FTILDE_L2 bounds. *) +(* This is the ||g~||_2^2 bound used by the alpha3 Cauchy-Schwarz step. *) +let SCHWARTZ_ZERO = prove + (`schwartz (\x:real. Cx(&0))`, + REWRITE_TAC[schwartz] THEN EXISTS_TAC `\n:num x:real. Cx(&0)` THEN + REWRITE_TAC[FUN_EQ_THM] THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[GSYM COMPLEX_VEC_0; HAS_VECTOR_DERIVATIVE_CONST]; + REPEAT GEN_TAC THEN EXISTS_TAC `&0` THEN + REWRITE_TAC[COMPLEX_NORM_0; REAL_MUL_RZERO; REAL_LE_REFL]]);; + +let SCHWARTZ_VSUM = prove + (`!(g:A->real->complex) s. FINITE s /\ (!a. a IN s ==> schwartz(g a)) + ==> schwartz(\x. vsum s (\a. g a x))`, + GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + REWRITE_TAC[VSUM_CLAUSES; ETA_AX; FORALL_IN_INSERT] THEN CONJ_TAC THENL + [DISCH_THEN(K ALL_TAC) THEN REWRITE_TAC[COMPLEX_VEC_0; SCHWARTZ_ZERO]; + MAP_EVERY X_GEN_TAC [`e:A`; `s:A->bool`] THEN + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[VSUM_CLAUSES] THEN + MATCH_MP_TAC SCHWARTZ_ADD THEN ASM_SIMP_TAC[ETA_AX]]);; + +let QUADRATIC_NONNEG_DISC = prove + (`!A B C. &0 <= A /\ &0 <= C /\ (!y. &0 <= A * y pow 2 + &2 * B * y + C) + ==> B pow 2 <= A * C`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `A = &0` THENL + [SUBGOAL_THEN `B = &0` ASSUME_TAC THENL + [MATCH_MP_TAC(REAL_ARITH `~(&0 < abs B) ==> B = &0`) THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `--(C + &1) / (&2 * B):real`) THEN + ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_LID] THEN + ASM_SIMP_TAC[REAL_FIELD `&0 < abs B ==> &2 * B * --(C + &1) / (&2 * B) + + C = --(&1)`] THEN + REAL_ARITH_TAC; + ASM_REWRITE_TAC[REAL_MUL_LZERO] THEN + REWRITE_TAC[REAL_ARITH `&0 pow 2 = &0`; REAL_LE_REFL]]; + SUBGOAL_THEN `&0 < A` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `--B / A:real`) THEN + ASM_SIMP_TAC[REAL_FIELD + `&0 < A ==> A * (--B / A) pow 2 + &2 * B * --B / A + C = C - B pow 2 / A`] + THEN + DISCH_TAC THEN SUBGOAL_THEN `B pow 2 / A <= C` MP_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ] THEN REWRITE_TAC[REAL_MUL_SYM]]);; + +(* int_A (v - t)^2 as a quadratic in t. *) +let INTEGRAL_SHIFT_SQ_EXPAND = prove + (`!(v:real->real) A t. + real_measurable A /\ v real_integrable_on A /\ (\x. v x pow 2) + real_integrable_on A + ==> real_integral A (\x. (v x - t) pow 2) = + real_integral A (\x. v x pow 2) - &2 * t * real_integral A v + + t pow 2 * real_measure A`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\x. ((v:real->real) x - t) pow 2) = + (\x. (v x pow 2 + (-- &2 * t) * v x) + t pow 2 * &1)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `(\x. (v:real->real) x pow 2 + (-- &2 * t) * v x) real_integrable_on A` + ASSUME_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_ADD THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_INTEGRABLE_LMUL THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `(\x. t pow 2 * &1) real_integrable_on A` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_LMUL THEN + ASM_SIMP_TAC[CONST_INTEGRABLE_MEASURABLE]; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_INTEGRAL_ADD; REAL_INTEGRABLE_LMUL; REAL_INTEGRAL_LMUL; + CONST_INTEGRABLE_MEASURABLE] THEN + REAL_ARITH_TAC);; + +(* (v - t)^2 is integrable on A. *) +let INTEGRABLE_SHIFT_SQ = prove + (`!(v:real->real) A t. + real_measurable A /\ v real_integrable_on A /\ (\x. v x pow 2) + real_integrable_on A + ==> (\x. (v x - t) pow 2) real_integrable_on A`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\x. ((v:real->real) x - t) pow 2) = + (\x. (v x pow 2 + (-- &2 * t) * v x) + t pow 2 * &1)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_INTEGRABLE_ADD THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_ADD THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_INTEGRABLE_LMUL THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_INTEGRABLE_LMUL THEN + ASM_SIMP_TAC[CONST_INTEGRABLE_MEASURABLE]]);; + +let REAL_INTEGRAL_CS_MEASURE = prove + (`!(v:real->real) A. + real_measurable A /\ v real_integrable_on A /\ + (\x. v x pow 2) real_integrable_on A /\ (!x. &0 <= v x) + ==> real_integral A v <= + sqrt(real_measure A) * sqrt(real_integral A (\x. v x pow 2))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&0 <= real_measure A` ASSUME_TAC THENL + [ASM_SIMP_TAC[REAL_MEASURE_POS_LE]; ALL_TAC] THEN + SUBGOAL_THEN + `&0 <= real_integral A (\x. (v:real->real) x pow 2)` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_POS THEN ASM_REWRITE_TAC[] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_LE_POW_2]; ALL_TAC] THEN + SUBGOAL_THEN `&0 <= real_integral A (v:real->real)` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_POS THEN ASM_SIMP_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `real_integral A (v:real->real) pow 2 <= + real_measure A * real_integral A (\x. v x pow 2)` + ASSUME_TAC THENL + [MP_TAC(ISPECL + [`real_measure A`; `--(real_integral A (v:real->real))`; + `real_integral A (\x. (v:real->real) x pow 2)`] QUADRATIC_NONNEG_DISC) + THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [X_GEN_TAC `t:real` THEN + SUBGOAL_THEN + `real_measure A * t pow 2 + &2 * (--(real_integral A (v:real->real))) * + t + + real_integral A (\x. v x pow 2) = + real_integral A (\x. (v x - t) pow 2)` + SUBST1_TAC THENL + [ASM_SIMP_TAC[INTEGRAL_SHIFT_SQ_EXPAND] THEN + REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_INTEGRAL_POS THEN + ASM_SIMP_TAC[INTEGRABLE_SHIFT_SQ] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_LE_POW_2]; + REWRITE_TAC[REAL_POW_NEG; ARITH] THEN DISCH_TAC THEN + ASM_REWRITE_TAC[]]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sqrt(real_integral A (v:real->real) pow 2)` THEN CONJ_TAC THENL + [ASM_SIMP_TAC[POW_2_SQRT; REAL_LE_REFL]; ALL_TAC] THEN + ASM_SIMP_TAC[GSYM SQRT_MUL] THEN MATCH_MP_TAC SQRT_MONO_LE THEN + ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* The coefficient-general NORMSQ + maximal-function chain, culminating in *) +(* the *) +(* zeta-ready FTILDE_MAX_L2_NORM_C. For gt = sum_{tree} c_s phi_s (any *) +(* complex *) +(* c), the H-L maximal function gt-star satisfies ||gt-star||_2 <= sqrt(8 *) +(* C3) *) +(* sqrt(sum|c_s|^2). Instantiating c_s = zeta_s (f|phi_s) with |zeta_s|=1 *) +(* gives *) +(* sum|c_s|^2 = sum|(f|phi_s)|^2, so the bound is the same as the no-phase *) +(* case; *) +(* this is the version alpha3 (i)/(h) actually consume (Fremlin's gt carries *) +(* the *) +(* unimodular phases zeta_s). Every lemma below is a verbatim c-for-(f|phi) *) +(* copy *) +(* of its no-phase counterpart (the chain is coefficient-opaque). *) +(* ------------------------------------------------------------------------- *) + +let CARLESON_RECON_L2_C = prove + (`!(c:(int#int#int)->complex) (P:(int#int#int)->bool). FINITE P + ==> (\z. vsum P (\s. c s * phi_sigma s carleson_phi (drop z))) + IN lspace (:real^1) (&2)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC LSPACE_VSUM THEN + ASM_REWRITE_TAC[REAL_ARITH `&0 < &2`] THEN + X_GEN_TAC `s:int#int#int` THEN DISCH_TAC THEN + MATCH_MP_TAC LSPACE_COMPLEX_LMUL THEN + MATCH_MP_TAC SCHWARTZ_L2 THEN + REWRITE_TAC[ETA_AX; PHISIG_CARLESON_SCHWARTZ]);; + +let CARLESON_PHISIG_RECON_INT_C = prove + (`!(c:(int#int#int)->complex) (P:(int#int#int)->bool) (s:int#int#int). FINITE + P + ==> (\z:real^1. phi_sigma s carleson_phi (drop z) * + cnj(vsum P (\t. c t * phi_sigma t carleson_phi (drop z)))) + integrable_on (:real^1)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC L2_CNJ_PRODUCT_INTEGRABLE THEN + CONJ_TAC THENL + [MATCH_MP_TAC SCHWARTZ_L2 THEN + REWRITE_TAC[ETA_AX; PHISIG_CARLESON_SCHWARTZ]; + REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC CARLESON_RECON_L2_C THEN + ASM_REWRITE_TAC[]]);; + +let CARLESON_SCALPHISIG_RECON_INT_C = prove + (`!(c:(int#int#int)->complex) (P:(int#int#int)->bool) (s:int#int#int). FINITE + P + ==> (\z:real^1. (c s * phi_sigma s carleson_phi (drop z)) * + cnj(vsum P (\t. c t * phi_sigma t carleson_phi (drop z)))) + integrable_on (:real^1)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC L2_CNJ_PRODUCT_INTEGRABLE THEN + CONJ_TAC THENL + [MATCH_MP_TAC LSPACE_COMPLEX_LMUL THEN MATCH_MP_TAC SCHWARTZ_L2 THEN + REWRITE_TAC[ETA_AX; PHISIG_CARLESON_SCHWARTZ]; + REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC CARLESON_RECON_L2_C THEN + ASM_REWRITE_TAC[]]);; + +let CARLESON_PHISIG_SCALPHISIG_INT_C = prove + (`!(c:(int#int#int)->complex) (s:int#int#int) (t:int#int#int). + (\z:real^1. phi_sigma s carleson_phi (drop z) * + cnj(c t * phi_sigma t carleson_phi (drop z))) + integrable_on (:real^1)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC L2_CNJ_PRODUCT_INTEGRABLE THEN + CONJ_TAC THENL + [MATCH_MP_TAC SCHWARTZ_L2 THEN + REWRITE_TAC[ETA_AX; PHISIG_CARLESON_SCHWARTZ]; + MATCH_MP_TAC LSPACE_COMPLEX_LMUL THEN MATCH_MP_TAC SCHWARTZ_L2 THEN + REWRITE_TAC[ETA_AX; PHISIG_CARLESON_SCHWARTZ]]);; + +let CARLESON_NORMSQ_OUTER_C = prove + (`!(c:(int#int#int)->complex) (P:(int#int#int)->bool). FINITE P + ==> lproduct (:real^1) + (\z. vsum P (\s. c s * phi_sigma s carleson_phi (drop z))) + (\z. vsum P (\s. c s * phi_sigma s carleson_phi (drop z))) = + vsum P (\s. c s * + lproduct (:real^1) (\z. phi_sigma s carleson_phi (drop z)) + (\z. vsum P (\t. c t * phi_sigma t carleson_phi (drop z))))`, + REPEAT STRIP_TAC THEN + MP_TAC(BETA_RULE(ISPECL + [`(:real^1)`; + `\(s:int#int#int) (z:real^1). (c:(int#int#int)->complex) s * phi_sigma s + carleson_phi (drop z)`; + `\z:real^1. vsum P (\t. (c:(int#int#int)->complex) t * phi_sigma t + carleson_phi (drop z))`; + `P:(int#int#int)->bool`] LPRODUCT_LSUM)) THEN + ASM_SIMP_TAC[CARLESON_SCALPHISIG_RECON_INT_C] THEN DISCH_THEN SUBST1_TAC THEN + MATCH_MP_TAC VSUM_EQ THEN X_GEN_TAC `s:int#int#int` THEN DISCH_TAC THEN + REWRITE_TAC[] THEN + MATCH_MP_TAC LPRODUCT_LMUL THEN ASM_SIMP_TAC[CARLESON_PHISIG_RECON_INT_C]);; + +let CARLESON_NORMSQ_INNER_C = prove + (`!(c:(int#int#int)->complex) (P:(int#int#int)->bool) (s:int#int#int). FINITE + P + ==> lproduct (:real^1) (\z. phi_sigma s carleson_phi (drop z)) + (\z. vsum P (\t. c t * phi_sigma t carleson_phi (drop z))) = + vsum P (\t. cnj(c t) * + lproduct (:real^1) (\z. phi_sigma s carleson_phi (drop z)) + (\z. phi_sigma t carleson_phi (drop z)))`, + REPEAT STRIP_TAC THEN + MP_TAC(BETA_RULE(ISPECL + [`(:real^1)`; + `\z:real^1. phi_sigma s carleson_phi (drop z)`; + `\(t:int#int#int) (z:real^1). (c:(int#int#int)->complex) t * phi_sigma t + carleson_phi (drop z)`; + `P:(int#int#int)->bool`] LPRODUCT_RSUM)) THEN + ASM_SIMP_TAC[CARLESON_PHISIG_SCALPHISIG_INT_C] THEN DISCH_THEN + SUBST1_TAC THEN + MATCH_MP_TAC VSUM_EQ THEN X_GEN_TAC `t:int#int#int` THEN DISCH_TAC THEN + REWRITE_TAC[] THEN + MATCH_MP_TAC LPRODUCT_RMUL THEN BETA_TAC THEN + MATCH_MP_TAC SCHWARTZ_CNJ_PRODUCT_INTEGRABLE THEN + REWRITE_TAC[ETA_AX; PHISIG_CARLESON_SCHWARTZ]);; + +let CARLESON_NORMSQ_DOUBLE_C = prove + (`!(c:(int#int#int)->complex) (P:(int#int#int)->bool). FINITE P + ==> lproduct (:real^1) + (\z. vsum P (\s. c s * phi_sigma s carleson_phi (drop z))) + (\z. vsum P (\s. c s * phi_sigma s carleson_phi (drop z))) = + vsum P (\s. vsum P (\t. + c s * cnj(c t) * + lproduct (:real^1) (\z. phi_sigma s carleson_phi (drop z)) + (\z. phi_sigma t carleson_phi (drop z))))`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[CARLESON_NORMSQ_OUTER_C] THEN + MATCH_MP_TAC VSUM_EQ THEN X_GEN_TAC `s:int#int#int` THEN DISCH_TAC THEN + REWRITE_TAC[] THEN + ASM_SIMP_TAC[CARLESON_NORMSQ_INNER_C] THEN + ASM_SIMP_TAC[GSYM VSUM_COMPLEX_LMUL] THEN + MATCH_MP_TAC VSUM_EQ THEN X_GEN_TAC `t:int#int#int` THEN DISCH_TAC THEN + CONV_TAC COMPLEX_RING);; + +let CARLESON_NORMSQ_REAL_C = prove + (`!(c:(int#int#int)->complex) (P:(int#int#int)->bool). FINITE P + ==> Cx(drop(integral (:real^1) + (\z. lift(norm(vsum P (\s. c s * phi_sigma s carleson_phi (drop + z))) pow 2)))) = + vsum P (\s. vsum P (\t. c s * cnj(c t) * + lproduct (:real^1) (\z. phi_sigma s carleson_phi (drop z)) + (\z. phi_sigma t carleson_phi (drop z))))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC + `lproduct (:real^1) + (\z. vsum P (\s. (c:(int#int#int)->complex) s * phi_sigma s carleson_phi + (drop z))) + (\z. vsum P (\s. c s * phi_sigma s carleson_phi (drop z)))` THEN + CONJ_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC LPRODUCT_SELF THEN + MP_TAC(ISPECL [`c:(int#int#int)->complex`; + `P:(int#int#int)->bool`] CARLESON_RECON_L2_C) THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[lspace; IN_ELIM_THM; RPOW_POW] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC CARLESON_NORMSQ_DOUBLE_C THEN ASM_REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* 286K part (b): the H_j estimate atoms. *) +(* *) +(* Fremlin's H_j = sum_{sigma in P'_j} (sum_{tau in P', J_sig SUBSET *) +(* J^l_tau} *) +(* ||)^2 <= 2 C3^2 C4 gam^2 muI_tauj. These are *) +(* the pure arithmetic/structural building blocks; the tile-geometry (tree *) +(* disjointness a-iii, per-scale weight-tail 286Gh) is supplied at instant- *) +(* iation. Layers: (1) termwise product via PHISIG_286GG*COEFF collapse *) +(* (sqrt2^kt sqrt(2^-kt)=1); (2) inner tau-sum <= (C3 gam) inv(sqrt2^ks) *) +(* int_II w via SUM_COVER_INTEGRAL_LE; (3) outer squaring; (4) scale-regroup *) +(* by k_sigma + geometric collapse (SUM_INV_ZPOW_GE_SCALED) -> 2 C4 2^-L. *) +(* ------------------------------------------------------------------------- *) + +(* J_sigma SUBSET J^l_tau ==> k_sigma <= k_tau (sigma coarser-or-equal *) +(* scale). *) +let TILE_JL_SUBSET_KLE = prove + (`!(s:int#int#int) t. tile_J s SUBSET tile_Jl t ==> tile_k s <= tile_k t`, + MATCH_MP_TAC(MESON[PAIR_SURJECTIVE] + `(!ks nIs nJs kt nIt nJt. + P ((ks,nIs,nJs):int#int#int) ((kt,nIt,nJt):int#int#int)) + ==> (!s t. P s t)`) THEN + MAP_EVERY X_GEN_TAC + [`ks:int`;`nIs:int`;`nJs:int`;`kt:int`;`nIt:int`;`nJt:int`] THEN + REWRITE_TAC[tile_J; tile_Jl; tile_k] THEN + DISCH_THEN(MP_TAC o MATCH_MP DYHO_SUBSET_SCALE) THEN INT_ARITH_TAC);; + +(* Layer 1: termwise product bound. PHISIG_286GG * COEFF_LE_ENERGY_MASS *) +(* collapse via sqrt2^kt sqrt(2^-kt)=1 (SQRT_ZPOW_NEG_MUL). *) +let HJ_TERM_ARITH = prove + (`!C3 gam ks kt A B W:real. + &0 <= C3 /\ &0 <= gam /\ &0 <= A /\ &0 <= B /\ &0 <= W /\ + A <= C3 * inv(sqrt(&2 zpow ks)) * sqrt(&2 zpow kt) * W /\ + B <= gam * sqrt(&2 zpow (--kt)) + ==> A * B <= (C3 * gam) * inv(sqrt(&2 zpow ks)) * W`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(C3 * inv(sqrt(&2 zpow ks)) * sqrt(&2 zpow kt) * W) * + (gam * sqrt(&2 zpow (--kt)))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_EQ_IMP_LE THEN + MP_TAC(SPEC `kt:int` SQRT_ZPOW_NEG_MUL) THEN CONV_TAC REAL_RING]);; + +(* Layer 2: inner tau-sum bound (structural). termwise HJ_TERM_ARITH + *) +(* SUM_LE + SUM_LMUL + SUM_COVER_INTEGRAL_LE (the disjoint-cover integral). *) +let HJ_INNER_SUM = prove + (`!(C3:real) gam ks (kf:int#int#int->int) (Ai:(int#int#int)->real) + (Bi:(int#int#int)->real) (G:(int#int#int)->(real->bool)) v II + (S:(int#int#int)->bool). + &0 <= C3 /\ &0 <= gam /\ FINITE S /\ + (!t. t IN S ==> &0 <= Ai t) /\ (!t. t IN S ==> &0 <= Bi t) /\ + (!t. t IN S ==> Ai t <= C3 * inv(sqrt(&2 zpow ks)) * + sqrt(&2 zpow (kf t)) * real_integral (G t) v) /\ + (!t. t IN S ==> Bi t <= gam * sqrt(&2 zpow (--(kf t)))) /\ + (!t. t IN S ==> v real_integrable_on (G t) /\ G t SUBSET II) /\ + (!t t'. t IN S /\ t' IN S /\ G t = G t' ==> t = t') /\ + (!t t'. t IN S /\ t' IN S /\ ~(t = t') + ==> real_negligible (G t INTER G t')) /\ + v real_integrable_on II /\ (!x. &0 <= v x) + ==> sum S (\t. Ai t * Bi t) + <= (C3 * gam) * inv(sqrt(&2 zpow ks)) * real_integral II v`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum S (\t. (C3 * gam) * inv(sqrt(&2 zpow ks)) * + real_integral ((G:(int#int#int)->(real->bool)) t) v)` + THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `t:int#int#int` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + MATCH_MP_TAC HJ_TERM_ARITH THEN + EXISTS_TAC `(kf:int#int#int->int) t` THEN + ASM_SIMP_TAC[] THEN + MATCH_MP_TAC REAL_INTEGRAL_POS THEN ASM_SIMP_TAC[]; + REWRITE_TAC[SUM_LMUL] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INV THEN MATCH_MP_TAC SQRT_POS_LE THEN + MATCH_MP_TAC REAL_ZPOW_LE THEN REAL_ARITH_TAC; + MATCH_MP_TAC SUM_COVER_INTEGRAL_LE THEN ASM_REWRITE_TAC[]]]]);; + +(* Squaring core: (C inv(sqrt2^k) R)^2 = C^2 2^-k R^2 (INV_SQRT_ZPOW_SQ). *) +let HJ_SQ_ARITH = prove + (`!C k R:real. + ((C:real) * inv(sqrt(&2 zpow k)) * R) pow 2 + = (C pow 2) * (&2 zpow (--k)) * (R pow 2)`, + REPEAT GEN_TAC THEN MP_TAC(SPEC `k:int` INV_SQRT_ZPOW_SQ) THEN + CONV_TAC REAL_RING);; + +(* Layer 3: outer sum with squaring. monotone REAL_POW_LE2 + HJ_SQ_ARITH. *) +let HJ_OUTER_SQ = prove + (`!(C3:real) gam (kf:(int#int#int)->int) (inr:(int#int#int)->real) + (R:(int#int#int)->real) (Sp:(int#int#int)->bool). + &0 <= C3 /\ &0 <= gam /\ FINITE Sp /\ + (!s. s IN Sp ==> &0 <= inr s) /\ (!s. s IN Sp ==> &0 <= R s) /\ + (!s. s IN Sp ==> inr s <= (C3 * gam) * inv(sqrt(&2 zpow (kf s))) * R s) + ==> sum Sp (\s. (inr s) pow 2) + <= (C3 * gam) pow 2 * + sum Sp (\s. (&2 zpow (--(kf s))) * (R s) pow 2)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[GSYM SUM_LMUL] THEN + MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `s:int#int#int` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `((C3 * gam) * inv(sqrt(&2 zpow (kf(s:int#int#int)))) * R s) pow + 2` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_POW_LE2 THEN ASM_SIMP_TAC[]; + REWRITE_TAC[HJ_SQ_ARITH; REAL_LE_REFL]]);; + +(* Weight-tail-integral <= its full integral: R^2 <= R when 0<=R<=1. *) +let SQ_LE_SELF = prove + (`!R:real. &0 <= R /\ R <= &1 ==> R pow 2 <= R`, + REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_POW_2] THEN + GEN_REWRITE_TAC (RAND_CONV) [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[]);; + +(* Layer 4: scale-regroup by k_sigma + geometric collapse. R^2<=R *) +(* (SQ_LE_SELF) *) +(* + SUM_GROUP into scale-groups + per-scale weight-tail bound (286Gh, <= *) +(* C4) + *) +(* SUM_INV_ZPOW_GE_SCALED (sum_{k>=L} c 2^-k <= 2c 2^-L). *) +let HJ_SCALE_COLLAPSE = prove + (`!(kf:(int#int#int)->int) (R:(int#int#int)->real) (Sp:(int#int#int)->bool) + (C4:real) (L:int). + FINITE Sp /\ &0 <= C4 /\ + (!s. s IN Sp ==> &0 <= R s /\ R s <= &1) /\ + (!s. s IN Sp ==> L <= kf s) /\ + (!k. sum {s | s IN Sp /\ kf s = k} R <= C4) + ==> sum Sp (\s. (&2 zpow (--(kf s))) * (R s) pow 2) + <= &2 * C4 * inv(&2 zpow L)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum Sp (\s. (&2 zpow (--(kf(s:int#int#int)))) * R s)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `s:int#int#int` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LE THEN REAL_ARITH_TAC; + MATCH_MP_TAC SQ_LE_SELF THEN ASM_SIMP_TAC[]]; + ALL_TAC] THEN + MP_TAC(ISPECL [`kf:(int#int#int)->int`; + `\s:int#int#int. (&2 zpow (--(kf s))) * R s`; + `Sp:(int#int#int)->bool`; `IMAGE (kf:(int#int#int)->int) Sp`] + SUM_GROUP) THEN + ASM_REWRITE_TAC[SUBSET_REFL] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum (IMAGE (kf:(int#int#int)->int) Sp) + (\k. C4 * inv(&2 zpow k))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN + X_GEN_TAC `k:int` THEN REWRITE_TAC[IN_IMAGE] THEN DISCH_TAC THEN + REWRITE_TAC[] THEN + REWRITE_TAC[SUM_LMUL; REAL_ZPOW_NEG] THEN + GEN_REWRITE_TAC (RAND_CONV) [REAL_MUL_SYM] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INV THEN MATCH_MP_TAC REAL_ZPOW_LE THEN + REAL_ARITH_TAC; + ASM_SIMP_TAC[]]; + MATCH_MP_TAC SUM_INV_ZPOW_GE_SCALED THEN + ASM_SIMP_TAC[FINITE_IMAGE] THEN + REWRITE_TAC[FORALL_IN_IMAGE] THEN ASM_SIMP_TAC[]]);; + +(* H_j composite: chains HJ_OUTER_SQ + HJ_SCALE_COLLAPSE into the exact *) +(* Fremlin shape sum_{sig in P'_j} (inner sig)^2 <= (C3 gam)^2 (2 C4 2^-L). *) +(* With L=k_tauj and the per-sig inner bound from HJ_INNER_SUM, this is *) +(* H_j <= 2 C3^2 C4 gam^2 muI_tauj (muI_tauj = 2^-L). *) +let HJ_FULL_BOUND = prove + (`!(C3:real) gam (kf:(int#int#int)->int) (inr:(int#int#int)->real) + (R:(int#int#int)->real) (Sp:(int#int#int)->bool) (C4:real) (L:int). + &0 <= C3 /\ &0 <= gam /\ FINITE Sp /\ &0 <= C4 /\ + (!s. s IN Sp ==> &0 <= inr s) /\ + (!s. s IN Sp ==> &0 <= R s /\ R s <= &1) /\ + (!s. s IN Sp ==> inr s <= (C3 * gam) * inv(sqrt(&2 zpow (kf s))) * R s) /\ + (!s. s IN Sp ==> L <= kf s) /\ + (!k. sum {s | s IN Sp /\ kf s = k} R <= C4) + ==> sum Sp (\s. (inr s) pow 2) + <= (C3 * gam) pow 2 * (&2 * C4 * inv(&2 zpow L))`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(C3 * gam) pow 2 * + sum Sp (\s. (&2 zpow (--(kf(s:int#int#int)))) * (R s) pow 2)` + THEN + CONJ_TAC THENL + [MATCH_MP_TAC HJ_OUTER_SQ THEN ASM_SIMP_TAC[]; + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_LE_POW_2]; + MATCH_MP_TAC HJ_SCALE_COLLAPSE THEN ASM_SIMP_TAC[]]]);; + +(* ------------------------------------------------------------------------- *) +(* 286K(a-iii) spatial-interval disjointness -- the clean geometric core. *) +(* Two dyadic cells I_a = dyho a p (finer, a<=b) and I_b = dyho b q: if I_a *) +(* is *) +(* NOT contained in I_b, they are DISJOINT. (Dyadic laminarity DYHO_TRICHOT- *) +(* OMY: I_b inside I_a needs a=b [DYHO_SUBSET_SCALE] then q=p *) +(* [DYHO_SAMESCALE_ *) +(* SUBSET_EQ], putting I_a inside I_b -- contra.) Fremlin uses this (with *) +(* the *) +(* stopping-time-supplied ~(I_sig SUBSET I_tauj)) to conclude I_sig, I_tauj *) +(* disjoint, hence the H_j interval-cover disjointness. *) +(* ------------------------------------------------------------------------- *) +let DYHO_FINER_NOT_SUBSET_DISJOINT = prove + (`!a b p q:int. + a <= b /\ ~(dyho a p SUBSET dyho b q) + ==> DISJOINT (dyho a p) (dyho b q)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`a:int`; `p:int`; `b:int`; `q:int`] DYHO_TRICHOTOMY) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP DYHO_SUBSET_SCALE) THEN + DISCH_TAC THEN + SUBGOAL_THEN `a:int = b` ASSUME_TAC THENL [ASM_INT_ARITH_TAC; ALL_TAC] THEN + UNDISCH_TAC `~(dyho a p SUBSET dyho b q)` THEN REWRITE_TAC[] THEN + UNDISCH_TAC `dyho b q SUBSET dyho a p` THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o MATCH_MP DYHO_SAMESCALE_SUBSET_EQ) THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[SUBSET_REFL]);; + +(* Tile-level a-iii: sigma finer-or-equal spatial (k_tauj <= k_sig) with *) +(* I_sig NOT SUBSET I_tauj ==> I_sig, I_tauj disjoint. *) +(* DYHO_FINER_NOT_SUBSET_ *) +(* DISJOINT at the tile exponents (--k_sig <= --k_tauj since k_tauj <= *) +(* k_sig). *) +let TILE_I_FINER_NOT_SUBSET_DISJOINT = prove + (`!(sig:int#int#int) (tauj:int#int#int). + tile_k tauj <= tile_k sig /\ ~(tile_I sig SUBSET tile_I tauj) + ==> DISJOINT (tile_I sig) (tile_I tauj)`, + MATCH_MP_TAC(MESON[PAIR_SURJECTIVE] + `(!ks nIs nJs kt nIt nJt. + P ((ks,nIs,nJs):int#int#int) ((kt,nIt,nJt):int#int#int)) + ==> (!s t. P s t)`) THEN + MAP_EVERY X_GEN_TAC + [`ksig:int`;`nIsig:int`;`nJsig:int`;`ktj:int`;`nItj:int`;`nJtj:int`] THEN + REWRITE_TAC[tile_I; tile_k] THEN STRIP_TAC THEN + MATCH_MP_TAC DYHO_FINER_NOT_SUBSET_DISJOINT THEN + ASM_REWRITE_TAC[] THEN ASM_INT_ARITH_TAC);; + +(* Tree L^2 bound for a general coefficient c (the zeta-carrying *) +(* reconstruction). *) +let FTILDE_L2_NORM_C = prove + (`?C3. &0 <= C3 /\ + !(c:(int#int#int)->complex) (P:(int#int#int)->bool) tau. FINITE P + ==> drop(integral (:real^1) + (\z. lift(norm(vsum {s | s IN P /\ tile_ler s tau} + (\s. c s * phi_sigma s carleson_phi (drop z))) pow + 2))) + <= C3 * sum {s | s IN P /\ tile_ler s tau} (\s. norm(c s) pow 2)`, + X_CHOOSE_THEN + `C3:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "DBL")) FTILDE_DOUBLE_LE_C + THEN + EXISTS_TAC `C3:real` THEN CONJ_TAC THENL + [FIRST_ASSUM ACCEPT_TAC; ALL_TAC] THEN + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `norm(vsum {s | s IN P /\ tile_ler s tau} + (\s. vsum {s | s IN P /\ tile_ler s tau} (\t. + (c:(int#int#int)->complex) s * cnj(c t) * + lproduct (:real^1) (\z. phi_sigma s carleson_phi (drop z)) + (\z. phi_sigma t carleson_phi (drop z)))))` THEN + CONJ_TAC THENL + [MP_TAC(ISPECL [`c:(int#int#int)->complex`; + `{s | s IN P /\ tile_ler s tau}`] + CARLESON_NORMSQ_REAL_C) THEN + ASM_SIMP_TAC[FINITE_RESTRICT] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[COMPLEX_NORM_CX; REAL_ABS_LE]; + USE_THEN "DBL" (MP_TAC o SPECL + [`c:(int#int#int)->complex`; `{s | s IN P /\ tile_ler s tau}`; + `tau:int#int#int`]) THEN + ASM_SIMP_TAC[FINITE_RESTRICT] THEN REWRITE_TAC[IN_ELIM_THM] THEN + DISCH_THEN MATCH_MP_TAC THEN MESON_TAC[]]);; + +let FTILDE_SCHWARTZ_C = prove + (`!(c:(int#int#int)->complex) (P:(int#int#int)->bool) tau. FINITE P + ==> schwartz(\x. vsum {s | s IN P /\ tile_ler s tau} + (\s. c s * phi_sigma s carleson_phi x))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SCHWARTZ_VSUM THEN + ASM_SIMP_TAC[FINITE_RESTRICT; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN + BETA_TAC THEN MATCH_MP_TAC SCHWARTZ_CMUL THEN REWRITE_TAC[ETA_AX] THEN + MATCH_MP_TAC PHISIG_SCHWARTZ THEN REWRITE_TAC[CARLESON_PHI_SCHWARTZ]);; + +(* M4 brick: the m-truncated tree reconstruction gt_m = sum over the *) +(* sub-tree *) +(* s IN P, s <=_r tau, tile_k s <= m of c_s phi_sigma (Fremlin 286(h)) is *) +(* Schwartz -- same argument as FTILDE_SCHWARTZ_C, the index set being a *) +(* further finite restriction, for general complex coefficients c_s. *) +let GTM_SCHWARTZ = prove + (`!(c:(int#int#int)->complex) (P:(int#int#int)->bool) tau m. FINITE P + ==> schwartz(\x. vsum {s | s IN P /\ tile_ler s tau /\ tile_k s <= m} + (\s. c s * phi_sigma s carleson_phi x))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SCHWARTZ_VSUM THEN + ASM_SIMP_TAC[FINITE_RESTRICT; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN + BETA_TAC THEN MATCH_MP_TAC SCHWARTZ_CMUL THEN REWRITE_TAC[ETA_AX] THEN + MATCH_MP_TAC PHISIG_SCHWARTZ THEN REWRITE_TAC[CARLESON_PHI_SCHWARTZ]);; + +(* M4 STEP (C), transform side: (gt * psicheck)^ = sqrt2pi * gt_m^ *) +(* everywhere. *) +(* 283M FOURIER_CONVOLUTION gives (gt*psicheck)^ = sqrt2pi gt^ psicheck^; *) +(* PSICHECK_FOURIER: psicheck^ = cpsi; FTILDE_CPSI_FHAT (step B): gt_m^ = *) +(* cpsi *) +(* gt^. So (gt*psicheck)^ = sqrt2pi gt^ cpsi = sqrt2pi gt_m^. This is the *) +(* analytic heart of gt_m = (1/sqrt2pi)(gt*psicheck); the *) +(* everywhere-equality *) +(* of the FUNCTIONS themselves then follows by Fourier injectivity once *) +(* convol gt psicheck is known Schwartz (CONVOL_SCHWARTZ, next). *) +let FTILDE_CONVOL_FHAT = prove + (`!(c:(int#int#int)->complex) (P:(int#int#int)->bool) tau m nhat w. + FINITE P /\ tile_J tau SUBSET dyho m nhat + ==> fourier (convol (\x. vsum {s | s IN P /\ tile_ler s tau} + (\s. c s * phi_sigma s carleson_phi x)) + (psicheck (&3 * &2 zpow m) (dyho_mid m nhat) + carleson_phi)) w = + Cx(sqrt(&2 * pi)) * + fourier (\x. vsum {s | s IN P /\ tile_ler s tau /\ tile_k s <= m} + (\s. c s * phi_sigma s carleson_phi x)) w`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`\x. vsum {s | s IN P /\ tile_ler s tau} + (\s. c s * phi_sigma s carleson_phi x)`; + `psicheck (&3 * &2 zpow m) (dyho_mid m nhat) carleson_phi`; + `w:real`] FOURIER_CONVOLUTION) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC FTILDE_SCHWARTZ_C THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC PSICHECK_SCHWARTZ THEN + REWRITE_TAC[CARLESON_PHI_SCHWARTZ] THEN + MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC THENL + [REAL_ARITH_TAC; MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC]]; + DISCH_THEN SUBST1_TAC] THEN + REWRITE_TAC[PSICHECK_FOURIER] THEN + MP_TAC(ISPECL [`c:(int#int#int)->complex`; `P:(int#int#int)->bool`; + `tau:int#int#int`; `m:int`; `nhat:int`; + `w:real`] FTILDE_CPSI_FHAT) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[COMPLEX_MUL_AC]);; + +(* M4 STEP (C) COMPLETE = Fremlin 286(h)(v): gt_m = (1/sqrt2pi)(gt * *) +(* psicheck) *) +(* as an EVERYWHERE equality (here in the form convol gt psicheck = sqrt2pi *) +(* gt_m). CONVOL_SCHWARTZ_EQ (the Fourier-uniqueness bridge) instantiated at *) +(* cf=gt, cg=psicheck, gtm=gt_m; the same-transform hypothesis is exactly *) +(* FTILDE_CONVOL_FHAT. Schwartzness: FTILDE_SCHWARTZ_C (gt), *) +(* PSICHECK_SCHWARTZ *) +(* (psicheck), GTM_SCHWARTZ (gt_m). *) +let FTILDE_CONVOL_EQ = prove + (`!(c:(int#int#int)->complex) (P:(int#int#int)->bool) tau m nhat x. + FINITE P /\ tile_J tau SUBSET dyho m nhat + ==> convol (\x. vsum {s | s IN P /\ tile_ler s tau} + (\s. c s * phi_sigma s carleson_phi x)) + (psicheck (&3 * &2 zpow m) (dyho_mid m nhat) carleson_phi) x = + Cx(sqrt(&2 * pi)) * + vsum {s | s IN P /\ tile_ler s tau /\ tile_k s <= m} + (\s. c s * phi_sigma s carleson_phi x)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`\x. vsum {s | s IN P /\ tile_ler s tau} + (\s. c s * phi_sigma s carleson_phi x)`; + `psicheck (&3 * &2 zpow m) (dyho_mid m nhat) carleson_phi`; + `\x. vsum {s | s IN P /\ tile_ler s tau /\ tile_k s <= m} + (\s. c s * phi_sigma s carleson_phi x)`] + CONVOL_SCHWARTZ_EQ) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [MATCH_MP_TAC FTILDE_SCHWARTZ_C THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC PSICHECK_SCHWARTZ THEN + REWRITE_TAC[CARLESON_PHI_SCHWARTZ] THEN + MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC THENL + [REAL_ARITH_TAC; MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC]; + MATCH_MP_TAC GTM_SCHWARTZ THEN ASM_REWRITE_TAC[]; + GEN_TAC THEN MATCH_MP_TAC FTILDE_CONVOL_FHAT THEN ASM_REWRITE_TAC[]]; + DISCH_THEN(MP_TAC o SPEC `x:real`) THEN BETA_TAC THEN SIMP_TAC[]]);; + +(* ========================================================================= *) +(* CARLESON_GTILDE_MAXIMAL = Fremlin 286L part (h) [(vi) concrete]. The *) +(* m-cutoff tree sub-sum gt_m (= vsum over s <=_r tau with tile_k s <= m) is *) +(* pointwise dominated by Cgm times the Hardy-Littlewood maximal function of *) +(* the full tree sum g~, at ANY x' within 2^{-m} of x. This is the deepest *) +(* analytic ingredient of the alpha3 (W3, sigma <=_r tau) correlation *) +(* estimate: *) +(* it converts the m-scale local reconstruction into a maximal-function *) +(* bound *) +(* that the 286A H-L L^2 theorem then controls. Cgm = C1 int cw1 / sqrt2pi *) +(* is *) +(* m-INDEPENDENT (the 2^m dilation cancels, CW1_DILATE_INTEGRAL_VALUE). *) +(* Assembled by instantiating GTM_MAXIMAL_ABSTRACT with the everywhere *) +(* convolution identity FTILDE_CONVOL_EQ (gt_m = (1/sqrt2pi) gt * psicheck) *) +(* and the tent domination CARLESON_PHI_CW1 (|phi| <= C1 cw1). *) +(* ========================================================================= *) +let CARLESON_GTILDE_MAXIMAL = prove + (`?Cgm. &0 <= Cgm /\ + !(c:(int#int#int)->complex) (P:(int#int#int)->bool) tau m nhat x x'. + FINITE P /\ tile_J tau SUBSET dyho m nhat /\ + &0 < &2 zpow m /\ abs(x - x') <= &2 zpow(--m) + ==> norm(vsum {s | s IN P /\ tile_ler s tau /\ tile_k s <= m} + (\s. c s * phi_sigma s carleson_phi x)) + <= Cgm * hl_maximal (\z. norm(vsum {s | s IN P /\ tile_ler s tau} + (\s. c s * phi_sigma s carleson_phi + z))) x'`, + X_CHOOSE_THEN `C1:real` STRIP_ASSUME_TAC CARLESON_PHI_CW1 THEN + EXISTS_TAC `C1 * real_integral (:real) cw1 / sqrt(&2 * pi)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_DIV THEN REWRITE_TAC[CW1_INTEGRAL_POS] THEN + MATCH_MP_TAC SQRT_POS_LE THEN MP_TAC PI_POS THEN REAL_ARITH_TAC; + ALL_TAC] THEN + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`\z. vsum {s | s IN P /\ tile_ler s tau} + (\s. (c:(int#int#int)->complex) s * phi_sigma s carleson_phi z)`; + `vsum {s | s IN P /\ tile_ler s tau /\ tile_k s <= m} + (\s. (c:(int#int#int)->complex) s * phi_sigma s carleson_phi x)`; + `m:int`; `nhat:int`; `x:real`; `x':real`; + `C1:real`] GTM_MAXIMAL_ABSTRACT) THEN + BETA_TAC THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC FTILDE_SCHWARTZ_C THEN ASM_REWRITE_TAC[]; + MP_TAC(ISPECL [`c:(int#int#int)->complex`; `P:(int#int#int)->bool`; + `tau:int#int#int`; `m:int`; `nhat:int`; + `x:real`] FTILDE_CONVOL_EQ) THEN + ASM_REWRITE_TAC[]]);; + +(* Two tiny arithmetic/norm rules used by GTM_DIFF_BOUND, stated *) +(* context-free (NORM_ARITH / REAL_ARITH break on the nonlinear *) +(* Cgm*hl_maximal atoms once the big tile assumptions are in scope, so *) +(* factor them out). *) +let NORM_SUB_TRIANGLE_ADD = prove + (`!a b:complex. norm(a - b) <= norm a + norm b`, REPEAT GEN_TAC THEN + CONV_TAC NORM_ARITH);; + +(* 286L (h) -> (i) difference form: the two-scale telescoped cutoff sub-sum *) +(* g~_{m2} - g~_{m1} (= Fremlin's g~_{l_L-1} - g~_{m-1} at m1=m-1, m2=l_L-1) *) +(* is *) +(* bounded by 2 Cgm g~*(x') whenever x' is within 2^{-m1},2^{-m2} of x. Two *) +(* applications of CARLESON_GTILDE_MAXIMAL (triangle inequality). This is *) +(* the *) +(* pointwise engine of part (i): v3(x) collapses to such a difference, so *) +(* v3(x) <= 2 Cgm g~*(x'). *) +let SCALE_BAND_MEM = prove + (`!m1 m2 P tau x. + m1 <= m2 + ==> ((x IN P /\ tile_ler x tau /\ m1 < tile_k x /\ tile_k x <= m2) <=> + (x IN P /\ tile_ler x tau /\ tile_k x <= m2) /\ + ~(x IN P /\ tile_ler x tau /\ tile_k x <= m1))`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + ASM_CASES_TAC `(x:int#int#int) IN P` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `tile_ler x tau` THEN ASM_REWRITE_TAC[] THEN + ASM_INT_ARITH_TAC);; + +(* The scale-band vsum equals the difference of the two cutoff sub-sums *) +(* g~_{m2} - g~_{m1} (VSUM_DIFF on the set-difference SCALE_BAND_MEM). *) +let VSUM_SCALE_BAND = prove + (`!(c:(int#int#int)->complex) P tau m1 m2 x. + FINITE P /\ m1 <= m2 + ==> vsum {s | s IN P /\ tile_ler s tau /\ m1 < tile_k s /\ tile_k s <= m2} + (\s. c s * phi_sigma s carleson_phi x) = + vsum {s | s IN P /\ tile_ler s tau /\ tile_k s <= m2} + (\s. c s * phi_sigma s carleson_phi x) - + vsum {s | s IN P /\ tile_ler s tau /\ tile_k s <= m1} + (\s. c s * phi_sigma s carleson_phi x)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `{s | s IN P /\ tile_ler s tau /\ m1 < tile_k s /\ tile_k s <= m2} = + {s | s IN P /\ tile_ler s tau /\ tile_k s <= m2} DIFF + {s | s IN P /\ tile_ler s tau /\ tile_k s <= m1}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_DIFF; IN_ELIM_THM] THEN GEN_TAC THEN + MATCH_MP_TAC SCALE_BAND_MEM THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC VSUM_DIFF THEN CONJ_TAC THENL + [MATCH_MP_TAC FINITE_RESTRICT THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN ASM_INT_ARITH_TAC]);; + +(* 286L (i) SCALE-BAND MAXIMAL BOUND: any tree scale-band {m1 < k_s <= m2} *) +(* sub-sum (= Fremlin's v3(x) after the g(x) IN J^r_s <=> k_s >= m collapse, *) +(* with m1 = m-1, m2 = l_L-1) is dominated by 2 Cgm g~*(x'), for x' within *) +(* 2^{-m1},2^{-m2} of x. = VSUM_SCALE_BAND (band = difference) + *) +(* GTM_DIFF_BOUND (difference <= 2 Cgm gstar). *) +let TILE_SET_MIN_SCALE = prove + (`!(A:(int#int#int)->bool). FINITE A ==> ~(A = {}) + ==> ?s0. s0 IN A /\ (!s. s IN A ==> tile_k s0 <= tile_k s)`, + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN CONJ_TAC THENL + [SIMP_TAC[]; ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`e:int#int#int`; `A:(int#int#int)->bool`] THEN + STRIP_TAC THEN DISCH_TAC THEN + ASM_CASES_TAC `A:(int#int#int)->bool = {}` THENL + [EXISTS_TAC `e:int#int#int` THEN + ASM_REWRITE_TAC[IN_INSERT; NOT_IN_EMPTY] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[INT_LE_REFL]; + FIRST_X_ASSUM(MP_TAC o check(is_imp o concl)) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `s1:int#int#int` STRIP_ASSUME_TAC) THEN + ASM_CASES_TAC `tile_k e <= tile_k (s1:int#int#int)` THENL + [EXISTS_TAC `e:int#int#int` THEN ASM_REWRITE_TAC[IN_INSERT] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[INT_LE_REFL] THEN + MATCH_MP_TAC INT_LE_TRANS THEN EXISTS_TAC `tile_k (s1:int#int#int)` THEN + ASM_SIMP_TAC[]; + EXISTS_TAC `s1:int#int#int` THEN ASM_REWRITE_TAC[IN_INSERT] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THENL + [ASM_INT_ARITH_TAC; ASM_SIMP_TAC[]]]]);; + +(* 286L (i) SLICE = BAND: the W3 pointwise slice {s <=_r tau : k_s < lL, *) +(* g(x) IN *) +(* J^r_s} (nonempty case) equals a scale-band {s <=_r tau : m <= k_s < lL}, *) +(* m = its *) +(* min scale. Forward: m is the min. Backward: from the min element s0 (with *) +(* g(x) IN J^r_s0) and TILE_TREE_JR_NEST (J^r_s0 SUBSET J^r_s since k_s0 <= *) +(* k_s), *) +(* g(x) IN J^r_s. This is the g(x) IN J^r_sigma <=> k_sigma >= m collapse of *) +(* Fremlin *) +(* part (i), reducing v3(x) to a scale-band sum that V3_BAND_BOUND controls. *) +let V3_SLICE_IS_BAND = prove + (`!(P:(int#int#int)->bool) tau lL y. + FINITE P /\ + ~({s | s IN P /\ tile_ler s tau /\ tile_k s < lL /\ y IN tile_Jr s} = {}) + ==> ?m. m <= lL - &1 /\ + {s | s IN P /\ tile_ler s tau /\ tile_k s < lL /\ y IN tile_Jr s} + = + {s | s IN P /\ tile_ler s tau /\ m <= tile_k s /\ tile_k s < lL}`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `{s | s IN P /\ tile_ler s tau /\ tile_k s < lL /\ y IN tile_Jr + s}` + TILE_SET_MIN_SCALE) THEN + ANTS_TAC THENL [ASM_SIMP_TAC[FINITE_RESTRICT]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `s0:int#int#int` MP_TAC) THEN + REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN + EXISTS_TAC `tile_k (s0:int#int#int)` THEN CONJ_TAC THENL + [ASM_INT_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `s:int#int#int` THEN + EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `s:int#int#int`) THEN + ASM_REWRITE_TAC[IN_ELIM_THM]; + MP_TAC(ISPECL [`s0:int#int#int`; `s:int#int#int`; `tau:int#int#int`] + TILE_TREE_JR_NEST) THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET] THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]);; + +(* Reindex the half-open scale-band {m <= k_s < lL} to the V3_BAND_BOUND *) +(* form {m-1 < k_s <= lL-1} (integer discreteness). *) +let SCALE_BAND_REINDEX = prove + (`!(P:(int#int#int)->bool) tau m lL. + {s | s IN P /\ tile_ler s tau /\ m <= tile_k s /\ tile_k s < lL} = + {s | s IN P /\ tile_ler s tau /\ m - &1 < tile_k s /\ tile_k s <= lL - + &1}`, + REPEAT GEN_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN + GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_INT_ARITH_TAC);; + +(* A cutoff sub-sum BELOW k_tau is empty (tree tiles have k_s >= k_tau, *) +(* TILE_LER_SCALE), so it vanishes. Handles the lower cutoff g~_{m-1} when *) +(* the *) +(* min band-scale m equals k_tau (m-1 < k_tau). *) +let GTM_CUTOFF_EMPTY = prove + (`!(c:(int#int#int)->complex) P tau m1 x. + m1 < tile_k tau + ==> vsum {s | s IN P /\ tile_ler s tau /\ tile_k s <= m1} + (\s. c s * phi_sigma s carleson_phi x) = vec 0`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `{s | s IN P /\ tile_ler s tau /\ tile_k s <= m1} = {}` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN + X_GEN_TAC `s:int#int#int` THEN STRIP_TAC THEN + MP_TAC(ISPECL [`s:int#int#int`; `tau:int#int#int`] TILE_LER_SCALE) THEN + ASM_REWRITE_TAC[] THEN ASM_INT_ARITH_TAC; + REWRITE_TAC[VSUM_CLAUSES]]);; + +(* J_tau sits in a length-2^m dyadic interval for any m >= k_tau *) +(* (DYHO_COARSEN); supplies CARLESON_GTILDE_MAXIMAL's dyho-containment *) +(* witness without threading it. *) +let TILE_J_COARSEN_EXISTS = prove + (`!tau m. tile_k tau <= m ==> ?nhat. tile_J tau SUBSET dyho m nhat`, + REWRITE_TAC[FORALL_PAIR_THM] THEN REPEAT GEN_TAC THEN + REWRITE_TAC[tile_k; tile_J] THEN DISCH_TAC THEN + EXISTS_TAC `p2 div &2 pow num_of_int (m - p1)` THEN + MATCH_MP_TAC DYHO_COARSEN THEN ASM_REWRITE_TAC[]);; + +(* Single-cutoff maximal bound needing only k_tau <= m: norm(g~_m(x)) <= Cgm *) +(* g~*(x') *) +(* for |x-x'| <= 2^{-m}. = CARLESON_GTILDE_MAXIMAL with the dyho witness *) +(* supplied *) +(* internally (TILE_J_COARSEN_EXISTS). *) +let GTM_CUTOFF_COARSEN = prove + (`?Cgm. &0 <= Cgm /\ + !(c:(int#int#int)->complex) (P:(int#int#int)->bool) tau m x x'. + FINITE P /\ tile_k tau <= m /\ abs(x - x') <= &2 zpow(--m) + ==> norm(vsum {s | s IN P /\ tile_ler s tau /\ tile_k s <= m} + (\s. c s * phi_sigma s carleson_phi x)) + <= Cgm * hl_maximal (\z. norm(vsum {s | s IN P /\ tile_ler s tau} + (\s. c s * phi_sigma s carleson_phi + z))) x'`, + X_CHOOSE_THEN `Cgm:real` STRIP_ASSUME_TAC CARLESON_GTILDE_MAXIMAL THEN + EXISTS_TAC `Cgm:real` THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`tau:int#int#int`; `m:int`] TILE_J_COARSEN_EXISTS) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `nhat:int`) THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + EXISTS_TAC `nhat:int` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC);; + +(* 286L (i) v3 POINTWISE BOUND: the W3 pointwise slice sum -- {s <=_r tau : *) +(* k_s < lL, *) +(* x IN J^r_s} weighted by c_s phi_s(x) -- is <= 2 Cgm g~*(x) at the point x *) +(* itself. *) +(* This is Fremlin's v3(x) <= C1 g~*(x') at x'=x (|x-x|=0). Route: nonempty *) +(* slice = *) +(* scale-band {m <= k_s < lL} (V3_SLICE_IS_BAND, up-set via *) +(* TILE_TREE_JR_NEST) = *) +(* reindexed {m-1 < k_s <= lL-1} = g~_{lL-1} - g~_{m-1} (VSUM_SCALE_BAND); *) +(* triangle + *) +(* two GTM_CUTOFF bounds (COARSEN when m-1 >= k_tau, else the cutoff is *) +(* EMPTY). The *) +(* positivity 0 <= Cgm g~* is bootstrapped from the lL-1 cutoff bound (norm *) +(* >= 0), so *) +(* the conditional HL_MAXIMAL_POS is not needed. *) +let AVG_OVER_CELL = prove + (`!vx (K:real) g L. + &0 < real_measure L /\ real_measurable L /\ g real_integrable_on L /\ + (!x'. x' IN L ==> vx <= K * g x') + ==> vx <= (K / real_measure L) * real_integral L g`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `vx * real_measure L <= K * real_integral L g` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `real_integral L (\x'. K * g x')` THEN CONJ_TAC THENL + [MP_TAC(ISPECL [`L:real->bool`; + `vx:real`] CONST_INTEGRABLE_MEASURABLE) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV) [GSYM th]) THEN + MATCH_MP_TAC REAL_INTEGRAL_LE THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_INTEGRABLE_LMUL THEN ASM_REWRITE_TAC[]; + ASM_SIMP_TAC[REAL_INTEGRAL_LMUL; REAL_LE_REFL]]; + ALL_TAC] THEN + SUBGOAL_THEN `(K / real_measure L) * real_integral L g = + (K * real_integral L g) / real_measure L` SUBST1_TAC THENL + [MP_TAC(MATCH_MP REAL_LT_IMP_NZ (ASSUME `&0 < real_measure L`)) THEN + CONV_TAC REAL_FIELD; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ]);; + +(* V3_POINTWISE with the MEMBERSHIP point y DECOUPLED from the eval point x *) +(* (and the *) +(* maximal point x'). In the (j) integral layer the W3-slice indicator is *) +(* chi{h(x) IN J^r_s} -- membership at h(x), the summand phi_s evaluated at *) +(* x -- so *) +(* the slice's y = h(x) differs from x. V3_SLICE_IS_BAND already takes an *) +(* arbitrary *) +(* y, so the proof is verbatim V3_POINTWISE_GEN with y in the slice. *) +let V3_POINTWISE_HGEN = prove + (`?Cgm. &0 <= Cgm /\ + !(c:(int#int#int)->complex) (P:(int#int#int)->bool) tau lL x x' y. + FINITE P /\ tile_k tau < lL /\ abs(x - x') <= &2 zpow(--(lL - &1)) + ==> norm(vsum {s | s IN P /\ tile_ler s tau /\ tile_k s < lL /\ y IN + tile_Jr s} + (\s. c s * phi_sigma s carleson_phi x)) + <= &2 * Cgm * hl_maximal (\z. norm(vsum {s | s IN P /\ tile_ler s + tau} + (\s. c s * phi_sigma s carleson_phi + z))) x'`, + X_CHOOSE_THEN `Cgm:real` STRIP_ASSUME_TAC GTM_CUTOFF_COARSEN THEN + EXISTS_TAC `Cgm:real` THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + ABBREV_TAC `H = hl_maximal (\z. norm(vsum {s | s IN P /\ tile_ler s tau} + (\s. (c:(int#int#int)->complex) s * phi_sigma s + carleson_phi z))) x'` THEN + SUBGOAL_THEN + `norm(vsum {s | s IN P /\ tile_ler s tau /\ tile_k s <= lL - &1} + (\s. (c:(int#int#int)->complex) s * phi_sigma s carleson_phi x)) + <= Cgm * H` + ASSUME_TAC THENL + [EXPAND_TAC "H" THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `&0 <= Cgm * H` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `norm(vsum {s | s IN P /\ tile_ler s tau /\ tile_k s <= lL - &1} + (\s. (c:(int#int#int)->complex) s * phi_sigma s carleson_phi x))` + THEN + ASM_REWRITE_TAC[NORM_POS_LE]; ALL_TAC] THEN + ASM_CASES_TAC + `{s | s IN P /\ tile_ler s tau /\ tile_k s < lL /\ y IN tile_Jr s} = {}` + THENL + [ASM_REWRITE_TAC[VSUM_CLAUSES; NORM_0] THEN + REWRITE_TAC[REAL_ARITH `&2 * a = a + a`] THEN MATCH_MP_TAC REAL_LE_ADD THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL [`P:(int#int#int)->bool`; `tau:int#int#int`; `lL:int`; + `y:real`] + V3_SLICE_IS_BAND) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN + `m:int` (CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC)) THEN + ONCE_REWRITE_TAC[SCALE_BAND_REINDEX] THEN + MP_TAC(ISPECL [`c:(int#int#int)->complex`; `P:(int#int#int)->bool`; + `tau:int#int#int`; + `m - &1:int`; `lL - &1:int`; `x:real`] VSUM_SCALE_BAND) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN ASM_INT_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `norm(vsum {s | s IN P /\ tile_ler s tau /\ tile_k s <= lL - &1} + (\s. (c:(int#int#int)->complex) s * phi_sigma s carleson_phi x)) + + + norm(vsum {s | s IN P /\ tile_ler s tau /\ tile_k s <= m - &1} + (\s. (c:(int#int#int)->complex) s * phi_sigma s carleson_phi x))` + THEN + CONJ_TAC THENL [REWRITE_TAC[NORM_SUB_TRIANGLE_ADD]; ALL_TAC] THEN + REWRITE_TAC[REAL_ARITH `&2 * a = a + a`] THEN + MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THENL + [FIRST_ASSUM ACCEPT_TAC; + ASM_CASES_TAC `tile_k tau <= m - &1` THENL + [MP_TAC(ISPECL + [`c:(int#int#int)->complex`; `P:(int#int#int)->bool`; + `tau:int#int#int`; + `m - &1:int`; `x:real`; `x':real`] + (CONJUNCT2(ASSUME `&0 <= Cgm /\ + (!(c:(int#int#int)->complex) P tau m x x'. + FINITE P /\ tile_k tau <= m /\ abs(x - x') <= &2 zpow(--m) + ==> norm(vsum {s | s IN P /\ tile_ler s tau /\ tile_k s <= m} + (\s. c s * phi_sigma s carleson_phi x)) <= + Cgm * hl_maximal (\z. norm(vsum {s | s IN P /\ tile_ler s tau} + (\s. c s * phi_sigma s carleson_phi z))) x')`))) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&2 zpow(--(lL - &1))` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC ZPOW2_MONOE THEN ASM_INT_ARITH_TAC; + EXPAND_TAC "H" THEN DISCH_THEN(fun th -> ASM_REWRITE_TAC[th])]; + MP_TAC(ISPECL [`c:(int#int#int)->complex`; `P:(int#int#int)->bool`; + `tau:int#int#int`; `m - &1:int`; + `x:real`] GTM_CUTOFF_EMPTY) THEN + ANTS_TAC THENL [ASM_INT_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[NORM_0] THEN + ASM_REWRITE_TAC[]]]);; + +(* alpha3 (j) CELL CORE (abstract): the norm of a finite vsum of *) +(* tile-integrals over *) +(* per-tile regions region_s SUBSET G is <= int_G Kfun, given the POINTWISE *) +(* cap *) +(* norm(vsum(if x IN region_s then ff_s x else 0)) <= Kfun x on G. This is *) +(* the *) +(* cancellation-preserving |alpha3-cell| <= int_G v3 step (UNLIKE alpha2's *) +(* sum-of- *) +(* norms). Route: INTEGRAL_RESTRICT rewrites each int_{region_s} ff_s = *) +(* int_G(if.. *) +(* then ff_s else 0) (region_s SUBSET G), INTEGRAL_VSUM pulls the vsum *) +(* inside *) +(* (INTEGRABLE_RESTRICT for each restricted integrand), *) +(* INTEGRAL_NORM_BOUND_INTEGRAL *) +(* bounds norm(int vsum) <= int norm(vsum) <= int_G Kfun (the cap; *) +(* REAL_INTEGRABLE_ON *) +(* bridges Kfun to the vector integrand lift o Kfun o drop). In the *) +(* application *) +(* ff_s = \x. c_s phi_sigma_s(x), region_s = {x IN E | h x IN J^r_s} INTER *) +(* dyho a p, *) +(* Kfun = 2 Cgm g~*(x') (V3_POINTWISE_HGEN, membership y = h x). *) +let ALPHA3_CELL_CORE = prove + (`!(A:(int#int#int)->bool) (ff:(int#int#int)->real->complex) region G Kfun. + FINITE A /\ + (!s. s IN A ==> region s SUBSET G /\ + (\z. ff s (drop z)) integrable_on (IMAGE lift (region s))) /\ + Kfun real_integrable_on G /\ + (!x. x IN G ==> norm(vsum A (\s. if x IN region s then ff s x else + Cx(&0))) <= Kfun x) + ==> norm(vsum A (\s. integral (IMAGE lift (region s)) (\z. ff s (drop + z)))) + <= real_integral G Kfun`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `!s. s IN A ==> + integral (IMAGE lift (region s)) (\z. (ff:(int#int#int)->real->complex) s + (drop z)) = + integral (IMAGE lift G) (\z. if drop z IN region s then ff s (drop z) + else vec 0)` + (fun th -> ASM_SIMP_TAC[th]) THENL + [REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\z. (ff:(int#int#int)->real->complex) s (drop z)`; + `IMAGE lift (region(s:int#int#int))`; + `IMAGE lift G`] INTEGRAL_RESTRICT) THEN + ANTS_TAC THENL + [REWRITE_TAC[SUBSET; IN_IMAGE_LIFT_DROP] THEN ASM SET_TAC[]; ALL_TAC] THEN + REWRITE_TAC[IN_IMAGE_LIFT_DROP] THEN DISCH_THEN(SUBST1_TAC o GSYM) THEN + REFL_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `!s. s IN A ==> + (\z. if drop z IN region s then (ff:(int#int#int)->real->complex) s (drop + z) else vec 0) + integrable_on (IMAGE lift G)` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\z. (ff:(int#int#int)->real->complex) s (drop z)`; + `IMAGE lift (region(s:int#int#int))`; + `IMAGE lift G`] INTEGRABLE_RESTRICT) THEN + ANTS_TAC THENL + [REWRITE_TAC[SUBSET; IN_IMAGE_LIFT_DROP] THEN ASM SET_TAC[]; ALL_TAC] THEN + REWRITE_TAC[IN_IMAGE_LIFT_DROP] THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN ASM_SIMP_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL + [`\s z. if drop z IN region s then (ff:(int#int#int)->real->complex) s (drop + z) else vec 0`; + `IMAGE lift G`; `A:(int#int#int)->bool`] INTEGRAL_VSUM) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o GSYM) THEN + ASM_SIMP_TAC[REAL_INTEGRAL] THEN + MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN + REWRITE_TAC[o_DEF] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_VSUM THEN ASM_REWRITE_TAC[]; + UNDISCH_TAC `Kfun real_integrable_on G` THEN + REWRITE_TAC[REAL_INTEGRABLE_ON; o_DEF]; + X_GEN_TAC `z:real^1` THEN REWRITE_TAC[IN_IMAGE_LIFT_DROP; LIFT_DROP] THEN + DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `drop(z:real^1)`) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REAL_ARITH `a = b ==> a <= K ==> b <= K`) THEN + AP_TERM_TAC THEN MATCH_MP_TAC VSUM_EQ THEN X_GEN_TAC `s:int#int#int` THEN + DISCH_TAC THEN REWRITE_TAC[] THEN COND_CASES_TAC THEN + REWRITE_TAC[COMPLEX_VEC_0]]);; + +(* Two points of one dyadic cell dyho a p are within 2^{a+1} (each < 2^a *) +(* from the mid, *) +(* DYHO_MID_DIST; triangle). = the |x-x'| <= 2^{-(lL-1)} = 2^{a+1} (lL=-a) *) +(* that *) +(* V3_POINTWISE_HGEN needs for x, x' both in the cover cell L = dyho a p. *) +let DYHO_PAIR_DIST = prove + (`!a p x y. x IN dyho a p /\ y IN dyho a p ==> abs(x - y) <= &2 zpow(a + &1)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`a:int`; `p:int`; `x:real`] DYHO_MID_DIST) THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`a:int`; `p:int`; `y:real`] DYHO_MID_DIST) THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `&2 zpow(a + &1) = &2 * &2 zpow a` SUBST1_TAC THENL + [SIMP_TAC[REAL_ZPOW_ADD; REAL_OF_NUM_EQ; ARITH_EQ; REAL_ZPOW_1] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + REAL_ARITH_TAC);; + +(* alpha3 (i) CONSTANT cell cap: for x, x' both in the cover cell dyho a p *) +(* (lL = -a), *) +(* the W3 slice sum at eval x, membership h(x), is <= 2 Cgm g~*(x'). = *) +(* V3_POINTWISE_ *) +(* HGEN with |x-x'| <= 2^{a+1} (DYHO_PAIR_DIST). Holds for ALL x' in the *) +(* cell, so *) +(* AVG_OVER_CELL then averages to the constant (2Cgm/muK) int_K g~* cap the *) +(* (j) layer *) +(* (ALPHA3_CELL_CORE) consumes. *) +let V3_CELL_PTWISE = prove + (`?Cgm. &0 <= Cgm /\ + !(c:(int#int#int)->complex) (P:(int#int#int)->bool) tau a p x x' h. + FINITE P /\ tile_k tau < --a /\ x IN dyho a p /\ x' IN dyho a p + ==> norm(vsum {s | s IN P /\ tile_ler s tau /\ tile_k s < --a /\ + (h:real->real) x IN tile_Jr s} + (\s. c s * phi_sigma s carleson_phi x)) + <= &2 * Cgm * hl_maximal (\w. norm(vsum {s | s IN P /\ tile_ler s + tau} + (\s. c s * phi_sigma s carleson_phi + w))) x'`, + X_CHOOSE_THEN + `Cgm:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "PW")) + V3_POINTWISE_HGEN THEN + EXISTS_TAC `Cgm:real` THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + USE_THEN "PW" (MP_TAC o SPECL + [`c:(int#int#int)->complex`; `P:(int#int#int)->bool`; `tau:int#int#int`; + `--a:int`; `x:real`; `x':real`; `(h:real->real) x`]) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `&2 zpow (--(--a - &1)) = &2 zpow (a + &1)` SUBST1_TAC THENL + [AP_TERM_TAC THEN INT_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPECL [`a:int`; `p:int`; `x:real`; `x':real`] DYHO_PAIR_DIST) THEN + ASM_REWRITE_TAC[]; + REWRITE_TAC[]]);; + +let FTILDE_MAX_L2_C = prove + (`?C3. &0 <= C3 /\ + !(c:(int#int#int)->complex) (P:(int#int#int)->bool) tau. FINITE P + ==> (\x. hl_maximal + (\x. norm(vsum {s | s IN P /\ tile_ler s tau} + (\s. c s * phi_sigma s carleson_phi x))) x pow 2) + real_integrable_on (:real) /\ + real_integral (:real) + (\x. hl_maximal + (\x. norm(vsum {s | s IN P /\ tile_ler s tau} + (\s. c s * phi_sigma s carleson_phi x))) x pow 2) + <= &8 * C3 * sum {s | s IN P /\ tile_ler s tau} (\s. norm(c s) pow + 2)`, + X_CHOOSE_THEN `C3:real` STRIP_ASSUME_TAC FTILDE_L2_NORM_C THEN + EXISTS_TAC `C3:real` THEN CONJ_TAC THENL + [FIRST_ASSUM ACCEPT_TAC; ALL_TAC] THEN + REPEAT GEN_TAC THEN STRIP_TAC THEN + ABBREV_TAC + `G = \x. vsum {s | s IN P /\ tile_ler s tau} + (\s. (c:(int#int#int)->complex) s * phi_sigma s carleson_phi + x)` THEN + SUBGOAL_THEN `schwartz (G:real->complex)` ASSUME_TAC THENL + [EXPAND_TAC "G" THEN MATCH_MP_TAC FTILDE_SCHWARTZ_C THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `(\x. abs(norm((G:real->complex) x))) real_integrable_on (:real) /\ + (\x. norm((G:real->complex) x) pow 2) real_integrable_on (:real) /\ + (?M. !x. abs(norm((G:real->complex) x)) <= M)` + STRIP_ASSUME_TAC THENL + [REPEAT CONJ_TAC THENL + [REWRITE_TAC[REAL_ABS_NORM; REAL_INTEGRABLE_ON; o_DEF; IMAGE_LIFT_UNIV; + LIFT_DROP] THEN + MP_TAC(MATCH_MP SCHWARTZ_ABSINT (ASSUME `schwartz (G:real->complex)`)) + THEN + REWRITE_TAC[absolutely_integrable_on] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o REWRITE_RULE[o_DEF]) THEN REWRITE_TAC[NORM_LIFT]; + REWRITE_TAC[REAL_INTEGRABLE_ON; o_DEF; IMAGE_LIFT_UNIV; LIFT_DROP] THEN + REWRITE_TAC[MATCH_MP SCHWARTZ_NORMSQ_INTEGRABLE (ASSUME `schwartz + (G:real->complex)`)]; + REWRITE_TAC[REAL_ABS_NORM] THEN + MATCH_MP_TAC SCHWARTZ_BOUNDED THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + MP_TAC(ISPEC `\x. norm((G:real->complex) x)` HARDY_LITTLEWOOD_MAXIMAL_L2) + THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN EXISTS_TAC `M:real` THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + STRIP_TAC THEN + SUBGOAL_THEN + `(\x. norm(vsum {s | s IN P /\ tile_ler s tau} + (\s. (c:(int#int#int)->complex) s * phi_sigma s carleson_phi x))) + = + (\x. norm((G:real->complex) x))` + ASSUME_TAC THENL [EXPAND_TAC "G" THEN REWRITE_TAC[]; ALL_TAC] THEN + CONJ_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&8 * real_integral (:real) (\x. norm((G:real->complex) x) pow 2)` + THEN + CONJ_TAC THENL + [FIRST_ASSUM(fun th -> ACCEPT_TAC(BETA_RULE th)); + REWRITE_TAC[REAL_ARITH `&8 * C3 * a = &8 * (C3 * a)`] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `real_integral (:real) (\x. norm((G:real->complex) x) pow 2) = + drop(integral (:real^1) (\z. lift(norm(G(drop z)) pow 2)))` + SUBST1_TAC THENL + [ASM_SIMP_TAC[REAL_INTEGRAL; o_DEF; IMAGE_LIFT_UNIV; LIFT_DROP]; + ALL_TAC] THEN + EXPAND_TAC "G" THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]);; + +let SCHWARTZ_HLMAX_INTEGRABLE = prove + (`!(G:real->complex) A. schwartz G /\ real_measurable A + ==> hl_maximal (\x. norm(G x)) real_integrable_on A`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(X_CHOOSE_TAC `M:real` o MATCH_MP SCHWARTZ_BOUNDED) THEN + SUBGOAL_THEN + `(\t. abs(norm((G:real->complex) t))) real_integrable_on (:real)` + ASSUME_TAC THENL + [REWRITE_TAC[REAL_ABS_NORM; REAL_INTEGRABLE_ON; o_DEF; IMAGE_LIFT_UNIV; + LIFT_DROP] THEN + MP_TAC(MATCH_MP SCHWARTZ_ABSINT (ASSUME `schwartz (G:real->complex)`)) THEN + REWRITE_TAC[absolutely_integrable_on] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o REWRITE_RULE[o_DEF]) THEN + REWRITE_TAC[NORM_LIFT]; ALL_TAC] THEN + SUBGOAL_THEN + `hl_maximal (\x. norm((G:real->complex) x)) real_measurable_on A` + ASSUME_TAC THENL + [MATCH_MP_TAC REAL_MEASURABLE_ON_MEASURABLE_SUBSET THEN + EXISTS_TAC `(:real)` THEN ASM_REWRITE_TAC[SUBSET_UNIV] THEN + MATCH_MP_TAC HL_MAXIMAL_MEASURABLE THEN EXISTS_TAC `M:real` THEN + BETA_TAC THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[REAL_ABS_NORM]]; ALL_TAC] THEN + SUBGOAL_THEN `(\x. M) real_integrable_on A` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_ON_CONST_MEASURABLE THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `!x. abs(hl_maximal (\x. norm((G:real->complex) x)) x) <= (\x. M) x` + ASSUME_TAC THENL + [GEN_TAC THEN REWRITE_TAC[] THEN + MP_TAC(ISPECL [`\x. norm((G:real->complex) x)`; `M:real`; + `x:real`] HL_MAXIMAL_POS) THEN + ANTS_TAC THENL [BETA_TAC THEN ASM_REWRITE_TAC[REAL_ABS_NORM]; ALL_TAC] THEN + MP_TAC(ISPECL [`\x. norm((G:real->complex) x)`; + `M:real`] HL_MAXIMAL_BOUNDED) THEN + ANTS_TAC THENL [BETA_TAC THEN ASM_REWRITE_TAC[REAL_ABS_NORM]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `x:real`) THEN REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN + EXISTS_TAC `(\x. M):real->real` THEN ASM_REWRITE_TAC[]);; + +(* alpha3 (i) CELL CAP (constant): for x in the cover cell dyho a p, the W3 *) +(* slice sum *) +(* is <= (2Cgm / mu(dyho a p)) int_{dyho a p} g~* -- a CONSTANT in x (no *) +(* x-dependence). *) +(* = AVG_OVER_CELL averaging V3_CELL_PTWISE over x' in the cell; g~* *) +(* integrable there *) +(* (SCHWARTZ_HLMAX_INTEGRABLE o FTILDE_SCHWARTZ_C), mu > 0 (DYHO_MEASURE). *) +(* The constant *) +(* value is exactly the Kfun needed by the (j) integral layer *) +(* ALPHA3_CELL_CORE. *) +let V3_CELL_CAP = prove + (`?Cgm. &0 <= Cgm /\ + !(c:(int#int#int)->complex) (P:(int#int#int)->bool) tau a p x h. + FINITE P /\ tile_k tau < --a /\ x IN dyho a p + ==> norm(vsum {s | s IN P /\ tile_ler s tau /\ tile_k s < --a /\ + (h:real->real) x IN tile_Jr s} + (\s. c s * phi_sigma s carleson_phi x)) + <= ((&2 * Cgm) / real_measure(dyho a p)) * + real_integral (dyho a p) + (\z. hl_maximal (\w. norm(vsum {s | s IN P /\ tile_ler s tau} + (\s. c s * phi_sigma s carleson_phi + w))) z)`, + X_CHOOSE_THEN + `Cgm:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "PT")) + V3_CELL_PTWISE THEN + EXISTS_TAC `Cgm:real` THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC AVG_OVER_CELL THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[DYHO_MEASURE] THEN MATCH_MP_TAC REAL_ZPOW_LT THEN + REAL_ARITH_TAC; + REWRITE_TAC[DYHO_MEASURABLE]; + ONCE_REWRITE_TAC[ETA_AX] THEN + MATCH_MP_TAC SCHWARTZ_HLMAX_INTEGRABLE THEN + REWRITE_TAC[DYHO_MEASURABLE] THEN + MATCH_MP_TAC FTILDE_SCHWARTZ_C THEN ASM_REWRITE_TAC[]; + X_GEN_TAC `x':real` THEN DISCH_TAC THEN BETA_TAC THEN + ONCE_REWRITE_TAC[REAL_MUL_ASSOC] THEN + USE_THEN "PT" (MP_TAC o REWRITE_RULE[REAL_MUL_ASSOC] o SPECL + [`c:(int#int#int)->complex`; `P:(int#int#int)->bool`; `tau:int#int#int`; + `a:int`; `p:int`; `x:real`; `x':real`]) THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]);; + +(* Three set-equalities for V3_CAP_REGION's region-slice reduction (proven *) +(* by pure *) +(* ASM_REWRITE + TAUT -- MESON runs away "Too deep" on these set-builders). *) +(* h is the *) +(* FREE global (matching V3_CELL_CAP); do NOT bind it (a bound var gets *) +(* primed by STRIP). *) +let V3CAP_SET1 = prove + (`!P tau a p x E h. x IN dyho a p ==> + {s | s IN {s | s IN P /\ tile_ler s tau /\ tile_k s < --a} /\ + x IN {y | y IN E /\ h y IN tile_Jr s} INTER dyho a p} = + {s | s IN P /\ tile_ler s tau /\ tile_k s < --a /\ x IN E /\ h x IN tile_Jr + s}`, + REPEAT STRIP_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INTER] THEN + X_GEN_TAC `s:int#int#int` THEN ASM_REWRITE_TAC[] THEN CONV_TAC TAUT);; + +let V3CAP_SET2 = prove + (`!P tau a x E. x IN E ==> + {s | s IN P /\ tile_ler s tau /\ tile_k s < --a /\ x IN E /\ h x IN tile_Jr + s} = + {s | s IN P /\ tile_ler s tau /\ tile_k s < --a /\ h x IN tile_Jr s}`, + REPEAT STRIP_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN GEN_TAC THEN + ASM_REWRITE_TAC[]);; + +let V3CAP_SET3 = prove + (`!P tau a x E. ~(x IN E) ==> + {s:int#int#int | s IN P /\ tile_ler s tau /\ tile_k s < --a /\ x IN E /\ h x + IN tile_Jr s} = {}`, + REPEAT STRIP_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN + GEN_TAC THEN ASM_REWRITE_TAC[]);; + +(* alpha3 (j) REGION-slice cap: the if-region form of V3_CELL_CAP. For x in *) +(* the cover *) +(* cell dyho a p, norm(vsum{W3-tiles}(if x IN region_s *) +(* [E-cap-hinv-Jr-cap-cell] then *) +(* c_s phi_s x else 0)) <= (2Cgm/muK) int_K g~* (the CONSTANT cap). *) +(* VSUM_RESTRICT_SET *) +(* (after GSYM COMPLEX_VEC_0 so else = vec 0) flattens the if-vsum to the *) +(* slice; V3CAP_ *) +(* SET1 reduces the region membership (x in dyho a p); ASM_CASES x IN E: x *) +(* IN E -> V3CAP_ *) +(* SET2 + V3_CELL_CAP, else -> V3CAP_SET3 empty + positivity from *) +(* V3_CELL_CAP's norm>=0. *) +(* This is exactly the pointwise cap ALPHA3_CELL_CORE consumes. *) +let V3_CAP_REGION = prove + (`?Cgm. &0 <= Cgm /\ + !(c:(int#int#int)->complex) (P:(int#int#int)->bool) tau E h a p x. + FINITE P /\ tile_k tau < --a /\ x IN dyho a p + ==> norm(vsum {s | s IN P /\ tile_ler s tau /\ tile_k s < --a} + (\s. if x IN {y | y IN E /\ h y IN tile_Jr s} INTER dyho a + p + then c s * phi_sigma s carleson_phi x else Cx(&0))) + <= ((&2 * Cgm) / real_measure(dyho a p)) * + real_integral (dyho a p) + (\z. hl_maximal (\w. norm(vsum {s | s IN P /\ tile_ler s tau} + (\s. c s * phi_sigma s carleson_phi + w))) z)`, + X_CHOOSE_THEN + `Cgm:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "CAP")) V3_CELL_CAP THEN + EXISTS_TAC `Cgm:real` THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[GSYM COMPLEX_VEC_0] THEN REWRITE_TAC[GSYM VSUM_RESTRICT_SET] THEN + FIRST_ASSUM(SUBST1_TAC o MATCH_MP (SPEC_ALL V3CAP_SET1)) THEN + ASM_CASES_TAC `x IN (E:real->bool)` THENL + [FIRST_ASSUM(SUBST1_TAC o MATCH_MP (SPEC_ALL V3CAP_SET2)) THEN + USE_THEN "CAP" (MP_TAC o SPECL + [`c:(int#int#int)->complex`; `P:(int#int#int)->bool`; `tau:int#int#int`; + `a:int`; `p:int`; `x:real`]) THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[]; + FIRST_ASSUM(SUBST1_TAC o MATCH_MP (SPEC_ALL V3CAP_SET3)) THEN + REWRITE_TAC[VSUM_CLAUSES; NORM_0] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `norm(vsum {s | s IN P /\ tile_ler s tau /\ tile_k s < --a /\ h + x IN tile_Jr s} + (\s. (c:(int#int#int)->complex) s * phi_sigma s + carleson_phi x))` THEN + REWRITE_TAC[NORM_POS_LE] THEN + USE_THEN "CAP" (MP_TAC o SPECL + [`c:(int#int#int)->complex`; `P:(int#int#int)->bool`; `tau:int#int#int`; + `a:int`; `p:int`; `x:real`]) THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[]]);; + +let SCHWARTZ_HLMAX_SQ_INTEGRABLE = prove + (`!(G:real->complex) A. schwartz G /\ real_measurable A + ==> (\x. hl_maximal (\x. norm(G x)) x pow 2) real_integrable_on A`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(X_CHOOSE_TAC `M:real` o MATCH_MP SCHWARTZ_BOUNDED) THEN + SUBGOAL_THEN + `(\t. abs(norm((G:real->complex) t))) real_integrable_on (:real)` + ASSUME_TAC THENL + [REWRITE_TAC[REAL_ABS_NORM; REAL_INTEGRABLE_ON; o_DEF; IMAGE_LIFT_UNIV; + LIFT_DROP] THEN + MP_TAC(MATCH_MP SCHWARTZ_ABSINT (ASSUME `schwartz (G:real->complex)`)) THEN + REWRITE_TAC[absolutely_integrable_on] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o REWRITE_RULE[o_DEF]) THEN + REWRITE_TAC[NORM_LIFT]; ALL_TAC] THEN + SUBGOAL_THEN + `hl_maximal (\x. norm((G:real->complex) x)) real_measurable_on A` + ASSUME_TAC THENL + [MATCH_MP_TAC REAL_MEASURABLE_ON_MEASURABLE_SUBSET THEN + EXISTS_TAC `(:real)` THEN ASM_REWRITE_TAC[SUBSET_UNIV] THEN + MATCH_MP_TAC HL_MAXIMAL_MEASURABLE THEN EXISTS_TAC `M:real` THEN + BETA_TAC THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[REAL_ABS_NORM]]; ALL_TAC] THEN + MATCH_MP_TAC REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN + EXISTS_TAC `(\x. M pow 2):real->real` THEN REWRITE_TAC[] THEN + REPEAT CONJ_TAC THENL + [ONCE_REWRITE_TAC[REAL_POW_2] THEN MATCH_MP_TAC REAL_MEASURABLE_ON_MUL THEN + ASM_REWRITE_TAC[ETA_AX]; + MATCH_MP_TAC REAL_INTEGRABLE_ON_CONST_MEASURABLE THEN ASM_REWRITE_TAC[]; + GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN `abs(hl_maximal (\x. norm((G:real->complex) x)) x pow 2) = + hl_maximal (\x. norm(G x)) x pow 2` + SUBST1_TAC THENL + [REWRITE_TAC[REAL_ABS_REFL; REAL_LE_POW_2]; ALL_TAC] THEN + MP_TAC(ISPECL [`\x. norm((G:real->complex) x)`; `M:real`; + `x:real`] HL_MAXIMAL_POS) THEN + ANTS_TAC THENL [BETA_TAC THEN ASM_REWRITE_TAC[REAL_ABS_NORM]; ALL_TAC] THEN + MP_TAC(ISPECL [`\x. norm((G:real->complex) x)`; + `M:real`] HL_MAXIMAL_BOUNDED) THEN + ANTS_TAC THENL [BETA_TAC THEN ASM_REWRITE_TAC[REAL_ABS_NORM]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `x:real`) THEN BETA_TAC THEN DISCH_TAC THEN + DISCH_TAC THEN + MP_TAC(ISPECL [`2`; `hl_maximal (\x. norm((G:real->complex) x)) x`; + `M:real`] REAL_POW_LE2) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; DISCH_THEN ACCEPT_TAC]]);; +let FTILDE_MAX_INT_CS_C = prove + (`!(c:(int#int#int)->complex) (P:(int#int#int)->bool) tau A. FINITE P /\ + real_measurable A + ==> real_integral A (hl_maximal (\x. norm(vsum {s | s IN P /\ tile_ler s + tau} + (\s. c s * phi_sigma s + carleson_phi x)))) + <= sqrt(real_measure A) * + sqrt(real_integral A (\x. hl_maximal (\x. norm(vsum {s | s IN P /\ + tile_ler s tau} + (\s. c s * phi_sigma s + carleson_phi x))) x pow + 2))`, + REPEAT STRIP_TAC THEN + ABBREV_TAC `G = \x. vsum {s | s IN P /\ tile_ler s tau} + (\s. (c:(int#int#int)->complex) s * phi_sigma s + carleson_phi x)` THEN + SUBGOAL_THEN `schwartz (G:real->complex)` ASSUME_TAC THENL + [EXPAND_TAC "G" THEN MATCH_MP_TAC FTILDE_SCHWARTZ_C THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `(\x. norm(vsum {s | s IN P /\ tile_ler s tau} + (\s. (c:(int#int#int)->complex) s * phi_sigma s carleson_phi x))) + = + (\x. norm((G:real->complex) x))` + ASSUME_TAC THENL [EXPAND_TAC "G" THEN REWRITE_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`hl_maximal (\x. norm((G:real->complex) x))`; + `A:real->bool`] REAL_INTEGRAL_CS_MEASURE) THEN + REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + MATCH_MP_TAC SCHWARTZ_HLMAX_INTEGRABLE THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC SCHWARTZ_HLMAX_SQ_INTEGRABLE THEN ASM_REWRITE_TAC[]; + GEN_TAC THEN + FIRST_ASSUM(X_CHOOSE_TAC `M:real` o MATCH_MP SCHWARTZ_BOUNDED) THEN + MATCH_MP_TAC HL_MAXIMAL_POS THEN EXISTS_TAC `M:real` THEN BETA_TAC THEN + CONJ_TAC THENL + [REWRITE_TAC[REAL_ABS_NORM; REAL_INTEGRABLE_ON; o_DEF; IMAGE_LIFT_UNIV; + LIFT_DROP] THEN + MP_TAC(MATCH_MP SCHWARTZ_ABSINT (ASSUME `schwartz (G:real->complex)`)) + THEN + REWRITE_TAC[absolutely_integrable_on] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o REWRITE_RULE[o_DEF]) THEN REWRITE_TAC[NORM_LIFT]; + ASM_REWRITE_TAC[REAL_ABS_NORM]]]);; + +(* ------------------------------------------------------------------------- *) +(* alpha3 (j) capstone: for the tree reconstruction gt = sum_{tree} c_s *) +(* phi_s *) +(* and any measurable A, int_A gt-star <= sqrt(mu A) sqrt(8 C B) whenever *) +(* sum|c_s|^2 <= B. FTILDE_MAX_L2_B first bounds int_R (gt-star)^2 <= 8 C B *) +(* (FTILDE_MAX_L2_C + monotonicity); ALPHA3_MAXIMAL_BOUND then chains the *) +(* continuous Cauchy step (FTILDE_MAX_INT_CS_C) with int_A (gt-star)^2 <= *) +(* int_R (gt-star)^2 (REAL_INTEGRAL_SUBSET_LE) and monotone sqrt. With A = *) +(* Ihat, *) +(* mu A = 7 2^{-k_tau}, B = energy^2 2^{-k_tau} (FTILDE_ENERGY_SUM at c=zeta *) +(* ip), *) +(* this is Fremlin's int_Ihat gt-star <= sqrt(7 muI_tau) sqrt(8 C3) energy *) +(* 2^{-k_tau/2}, the analytic heart of the alpha3 (j) bound. *) +(* ------------------------------------------------------------------------- *) + +let FTILDE_MAX_L2_B = prove + (`?C. &0 <= C /\ + !(c:(int#int#int)->complex) (P:(int#int#int)->bool) tau B. FINITE P /\ + sum {s | s IN P /\ tile_ler s tau} (\s. norm(c s) pow 2) <= B + ==> real_integral (:real) + (\x. hl_maximal (\x. norm(vsum {s | s IN P /\ tile_ler s tau} + (\s. c s * phi_sigma s carleson_phi + x))) x pow 2) + <= &8 * C * B`, + X_CHOOSE_THEN + `C3:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "MAX")) + FTILDE_MAX_L2_C THEN + EXISTS_TAC `C3:real` THEN CONJ_TAC THENL + [FIRST_ASSUM ACCEPT_TAC; ALL_TAC] THEN + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&8 * C3 * sum {s | s IN P /\ tile_ler s tau} (\s. + norm((c:(int#int#int)->complex) s) pow 2)` THEN + CONJ_TAC THENL + [USE_THEN "MAX" (MP_TAC o SPECL + [`c:(int#int#int)->complex`; `P:(int#int#int)->bool`; + `tau:int#int#int`]) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; DISCH_THEN(ACCEPT_TAC o CONJUNCT2)]; + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[]]]);; + +let ALPHA3_MAXIMAL_BOUND = prove + (`?C. &0 <= C /\ + !(c:(int#int#int)->complex) (P:(int#int#int)->bool) tau A B. + FINITE P /\ real_measurable A /\ + sum {s | s IN P /\ tile_ler s tau} (\s. norm(c s) pow 2) <= B + ==> real_integral A (hl_maximal (\x. norm(vsum {s | s IN P /\ tile_ler s + tau} + (\s. c s * phi_sigma s + carleson_phi x)))) + <= sqrt(real_measure A) * sqrt(&8 * C * B)`, + X_CHOOSE_THEN + `C3:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "B")) FTILDE_MAX_L2_B THEN + X_CHOOSE_THEN + `C4:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "MAX")) + FTILDE_MAX_L2_C THEN + EXISTS_TAC `C3:real` THEN CONJ_TAC THENL + [FIRST_ASSUM ACCEPT_TAC; ALL_TAC] THEN + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `sqrt(real_measure A) * + sqrt(real_integral A + (\x. hl_maximal + (\x. norm(vsum {s | s IN P /\ tile_ler s tau} + (\s. (c:(int#int#int)->complex) s * + phi_sigma s carleson_phi x))) x pow 2))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC FTILDE_MAX_INT_CS_C THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC SQRT_POS_LE THEN MATCH_MP_TAC REAL_MEASURE_POS_LE THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC SQRT_MONO_LE THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `real_integral (:real) + (\x. hl_maximal + (\x. norm(vsum {s | s IN P /\ tile_ler s tau} + (\s. (c:(int#int#int)->complex) s * + phi_sigma s carleson_phi x))) x pow 2)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_SUBSET_LE THEN REWRITE_TAC[SUBSET_UNIV] THEN + CONJ_TAC THENL + [MATCH_MP_TAC SCHWARTZ_HLMAX_SQ_INTEGRABLE THEN REWRITE_TAC[ETA_AX] THEN + CONJ_TAC THENL [MATCH_MP_TAC FTILDE_SCHWARTZ_C THEN + ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]]; ALL_TAC] THEN + CONJ_TAC THENL + [USE_THEN "MAX" (MP_TAC o SPECL + [`c:(int#int#int)->complex`; `P:(int#int#int)->bool`; + `tau:int#int#int`]) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; DISCH_THEN(ACCEPT_TAC o CONJUNCT1)]; + REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_LE_POW_2]]; + USE_THEN "B" (MP_TAC o SPECL + [`c:(int#int#int)->complex`; `P:(int#int#int)->bool`; `tau:int#int#int`; + `B:real`]) THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Tile-order J-monotonicity. If sigma >=_r tau (tile_ler s tau) and sigma *) +(* is the finer scale (k_tau <= k_s) then J_tau SUBSET J_s. Proof: from *) +(* J^r_tau SUBSET J^r_sigma (tile_ler) and J^r_tau nonempty *) +(* (TILE_JR_NONEMPTY) *) +(* pick y in J^r_tau; then y IN J_tau and y IN J_sigma (TILE_JR_SUBSET_J), *) +(* so *) +(* J_tau, J_sigma meet, and with k_tau <= k_s the laminar nesting DYHO_MEET_ *) +(* NEST forces J_tau SUBSET J_sigma. This is the containment the alpha3 cell *) +(* (ALPHA3_CELL) feeds to TILE_JR_SUBSET_TILE_J. *) +(* ------------------------------------------------------------------------- *) +let TILE_LER_J_SUBSET = prove + (`!(s:int#int#int) tau. + tile_ler s tau /\ tile_k tau <= tile_k s + ==> tile_J tau SUBSET tile_J s`, + REWRITE_TAC[FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC + [`ks:int`;`nIs:int`;`nJs:int`;`kt:int`;`nIt:int`;`nJt:int`] THEN + REWRITE_TAC[tile_ler; tile_J; tile_Jr; tile_k] THEN STRIP_TAC THEN + MATCH_MP_TAC DYHO_MEET_NEST THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ISPEC `(kt:int,nIt:int,nJt:int)` TILE_JR_NONEMPTY) THEN + REWRITE_TAC[tile_Jr; GSYM MEMBER_NOT_EMPTY] THEN + DISCH_THEN(X_CHOOSE_TAC `y:real`) THEN + REWRITE_TAC[DISJOINT; EXTENSION; IN_INTER; NOT_IN_EMPTY; + NOT_FORALL_THM; NOT_IMP] THEN + EXISTS_TAC `y:real` THEN CONJ_TAC THENL + [MP_TAC(ISPEC `(kt:int,nIt:int,nJt:int)` TILE_JR_SUBSET_J) THEN + REWRITE_TAC[tile_Jr; tile_J; SUBSET] THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + MP_TAC(ISPEC `(ks:int,nIs:int,nJs:int)` TILE_JR_SUBSET_J) THEN + REWRITE_TAC[tile_Jr; tile_J; SUBSET] THEN + DISCH_THEN MATCH_MP_TAC THEN + UNDISCH_TAC `dyho (kt - &1) (&2 * nJt + &1) SUBSET + dyho (ks - &1) (&2 * nJs + &1)` THEN + REWRITE_TAC[SUBSET] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* 286L alpha3 CELL: the concrete per-cell W3 bound. For a single cover cell *) +(* dyho a p (level l_K = -a, coarser than tau: k_tau < -a) with the *) +(* auxiliary *) +(* tile ups at scale k_ups = -(a+1), the norm of the vector sum of the tile *) +(* integrals over the right-half cells is <= the constant cell cap (from *) +(* V3_CAP_REGION) times mu(G_K). This is ALPHA3_CELL_CORE instantiated with *) +(* ff_s = \x. c_s phi_sigma_s, region_s = {x IN E | h x IN J^r_s} INTER *) +(* dyho, *) +(* G = {x IN E | h x IN J_ups} INTER dyho, and Kfun = the V3_CELL_CAP *) +(* constant. *) +(* The four ANTS: FINITE (FINITE_RESTRICT); per-tile region SUBSET G_K *) +(* (TILE_JR_SUBSET_TILE_J via TILE_LER_J_SUBSET + tile_le ups -> *) +(* J_tau<=J_ups) *) +(* + region-integ (INTEGRABLE_COMPLEX_LMUL o *) +(* PHISIG_ABS_INTEGRABLE_MEASURABLE); *) +(* Kfun real_integrable (CONST_INTEGRABLE_MEASURABLE); pointwise cap *) +(* (V3_CAP_REGION). Unlike alpha2's sum-of-norms, the sum stays INSIDE the *) +(* norm -- the cancellation-preserving form the maximal bound needs. *) +(* ------------------------------------------------------------------------- *) +let ALPHA3_CELL = prove + (`?Cgm. &0 <= Cgm /\ + !(c:(int#int#int)->complex) (P:(int#int#int)->bool) tau E h a p ups. + FINITE P /\ (!s. s IN P ==> tile_le s tau) /\ tile_k tau < --a /\ + tile_le ups tau /\ tile_k ups = --(a + &1) /\ + real_lebesgue_measurable E /\ h real_measurable_on (:real) + ==> norm(vsum {s | s IN P /\ tile_ler s tau /\ tile_k s < --a} + (\s. c s * integral (IMAGE lift + ({x | x IN E /\ h x IN tile_Jr s} INTER dyho a p)) + (\z. phi_sigma s carleson_phi (drop z)))) <= + (((&2 * Cgm) / real_measure(dyho a p)) * + real_integral (dyho a p)(\z. hl_maximal + (\w. norm(vsum {s | s IN P /\ tile_ler s tau} + (\s. c s * phi_sigma s carleson_phi w))) z)) * + real_measure ({x | x IN E /\ h x IN tile_J ups} INTER dyho a p)`, + X_CHOOSE_THEN `Cgm:real` (LABEL_TAC "CR") V3_CAP_REGION THEN + EXISTS_TAC `Cgm:real` THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[]; ALL_TAC] THEN + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `real_measurable ({x | x IN E /\ h x IN tile_J ups} INTER dyho a p)` + ASSUME_TAC THENL + [MATCH_MP_TAC SC_MEASURABLE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `real_integral ({x | x IN E /\ h x IN tile_J ups} INTER dyho a p) + (\x. (&2 * Cgm) / real_measure (dyho a p) * + real_integral (dyho a p) + (\z. hl_maximal + (\w. norm(vsum {s | s IN P /\ tile_ler s tau} + (\s. c s * phi_sigma s carleson_phi w))) + z))` THEN + CONJ_TAC THENL + [ALL_TAC; + ASM_SIMP_TAC[CONST_INTEGRABLE_MEASURABLE; REAL_LE_REFL]] THEN + SUBGOAL_THEN + `!s:int#int#int. (\z. phi_sigma s carleson_phi (drop z)) integrable_on + IMAGE lift ({x | x IN E /\ h x IN tile_Jr s} INTER dyho a p)` + (LABEL_TAC "INTG") THENL + [GEN_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC PHISIG_ABS_INTEGRABLE_MEASURABLE THEN + MATCH_MP_TAC SC_MEASURABLE_JR THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + ASM_SIMP_TAC[GSYM INTEGRAL_COMPLEX_LMUL] THEN + MP_TAC(ISPECL + [`{s | s IN P /\ tile_ler s tau /\ tile_k s < --a}`; + `\(s:int#int#int) (x:real). c s * phi_sigma s carleson_phi x`; + `\s:int#int#int. {x | x IN E /\ h x IN tile_Jr s} INTER dyho a p`; + `{x | x IN E /\ h x IN tile_J ups} INTER dyho a p`; + `\x:real. (&2 * Cgm) / real_measure (dyho a p) * + real_integral (dyho a p) + (\z. hl_maximal + (\w. norm(vsum {s | s IN P /\ tile_ler s tau} + (\s. c s * phi_sigma s carleson_phi w))) z)`] + ALPHA3_CELL_CORE) THEN + REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC FINITE_RESTRICT THEN ASM_REWRITE_TAC[]; + X_GEN_TAC `s:int#int#int` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN + CONJ_TAC THENL + [MATCH_MP_TAC(SET_RULE + `(!x. x IN A ==> x IN B) ==> (A INTER C) SUBSET (B INTER C)`) THEN + X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`s:int#int#int`; `ups:int#int#int`; `tau:int#int#int`] + TILE_JR_SUBSET_TILE_J) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [MATCH_MP_TAC TILE_LER_J_SUBSET THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC TILE_LER_SCALE THEN ASM_REWRITE_TAC[]; + UNDISCH_TAC `tile_le ups tau` THEN REWRITE_TAC[tile_le] THEN + SIMP_TAC[]; + ASM_INT_ARITH_TAC]; + REWRITE_TAC[SUBSET] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[]]; + MP_TAC(SPEC `s:int#int#int` (ASSUME + `!s. (\z. phi_sigma s carleson_phi (drop z)) integrable_on + IMAGE lift ({x | x IN E /\ h x IN tile_Jr s} INTER dyho a p)`)) + THEN + DISCH_THEN(MP_TAC o SPEC `(c:(int#int#int)->complex) s` o + MATCH_MP INTEGRABLE_COMPLEX_LMUL) THEN + REWRITE_TAC[]]; + ASM_SIMP_TAC[CONST_INTEGRABLE_MEASURABLE]; + X_GEN_TAC `x:real` THEN DISCH_TAC THEN + USE_THEN "CR" (MP_TAC o SPECL + [`c:(int#int#int)->complex`; `P:(int#int#int)->bool`; `tau:int#int#int`; + `E:real->bool`; `h:real->real`; `a:int`; `p:int`; + `x:real`] o CONJUNCT2) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `x IN {x | x IN E /\ h x IN tile_J ups} INTER dyho a p` THEN + REWRITE_TAC[IN_INTER] THEN SIMP_TAC[]; + REWRITE_TAC[]]]);; + +(* ------------------------------------------------------------------------- *) +(* The alpha3 cell mass-fold arithmetic (abstract). With gk (= mu G_K) <= *) +(* 2 t m / w (the GK_MEASURE_BOUND_STRONG bound, t = mu K = 2^a, m = mass, w *) +(* = *) +(* w(3/2)) the per-cell factor (2 Cgm / t) mu G_K collapses to 4 Cgm m / w *) +(* -- *) +(* the 2^a cancels 1/mu K -- giving a CELL-INDEPENDENT constant. *) +(* ------------------------------------------------------------------------- *) +let GTM_CELL_ARITH = prove + (`!Cgm Iv gk t m w. + &0 <= Cgm /\ &0 <= Iv /\ &0 <= m /\ &0 < t /\ &0 < w /\ + gk <= &2 * t * m / w + ==> ((&2 * Cgm) / t * Iv) * gk <= ((&4 * Cgm) * m / w) * Iv`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `((&2 * Cgm) / t * Iv) * (&2 * t * m / w)` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_DIV THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN + MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + MATCH_MP_TAC REAL_EQ_IMP_LE THEN + SUBGOAL_THEN `~(t = &0) /\ ~(w = &0)` STRIP_ASSUME_TAC THENL + [ASM_SIMP_TAC[REAL_LT_IMP_NZ]; ALL_TAC] THEN + ONCE_REWRITE_TAC[REAL_ARITH + `(((&2 * Cgm) / t * Iv) * &2 * t * m / w):real = + (&2 * Cgm) * (t * inv t) * (&2 * Iv * m / w)`] THEN + ASM_SIMP_TAC[REAL_MUL_RINV; REAL_MUL_RID] THEN REAL_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* 286L alpha3 CELL, mass form. Folds GK_MEASURE_BOUND_STRONG (mu G_K <= *) +(* 2 * 2^a * mass / w(3/2)) into ALPHA3_CELL: the 2^a in the G_K measure *) +(* bound *) +(* cancels the 1/mu K = 1/2^a in the cell cap, leaving the CELL-INDEPENDENT *) +(* constant 4 Cgm mass / w(3/2) times int_K g~* (g~* the H-L maximal fn of *) +(* the *) +(* tree reconstruction gt = sum_{tree} c_s phi_s). This is the *) +(* per-cover-cell *) +(* summand ALPHA3_TOTAL adds over the maximal cover. Requires ~(P={}) (for *) +(* MASS_EH_POS) and in_kcover P a p (for mu K = 2^a via KCOVER_MEASURE). *) +(* ------------------------------------------------------------------------- *) +let ALPHA3_CELL_MASS = prove + (`?Cgm. &0 <= Cgm /\ + !(c:(int#int#int)->complex) (P:(int#int#int)->bool) tau E h a p. + FINITE P /\ ~(P = {}) /\ in_kcover P a p /\ (!s. s IN P ==> tile_le s + tau) /\ + tile_k tau < --a /\ real_lebesgue_measurable E /\ + h real_measurable_on (:real) /\ + (!t. cw_tile t real_integrable_on {x | x IN E /\ h x IN tile_J t}) + ==> norm(vsum {s | s IN P /\ tile_ler s tau /\ tile_k s < --a} + (\s. c s * integral (IMAGE lift + ({x | x IN E /\ h x IN tile_Jr s} INTER dyho a p)) + (\z. phi_sigma s carleson_phi (drop z)))) <= + ((&4 * Cgm) * mass_Eh E h P / cw(&3 / &2)) * + real_integral (dyho a p)(\z. hl_maximal + (\w. norm(vsum {s | s IN P /\ tile_ler s tau} + (\s. c s * phi_sigma s carleson_phi w))) z)`, + X_CHOOSE_THEN `Cgm:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "CELL")) + ALPHA3_CELL THEN + EXISTS_TAC `Cgm:real` THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + ABBREV_TAC + `G = \x. vsum {s | s IN P /\ tile_ler s tau} + (\s. (c:(int#int#int)->complex) s * phi_sigma s carleson_phi + x)` THEN + SUBGOAL_THEN `schwartz (G:real->complex)` ASSUME_TAC THENL + [EXPAND_TAC "G" THEN MATCH_MP_TAC FTILDE_SCHWARTZ_C THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `&2 zpow (a + &1) <= &2 zpow (--(tile_k tau))` ASSUME_TAC THENL + [MATCH_MP_TAC ZPOW2_MONOE THEN ASM_INT_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPECL [`P:(int#int#int)->bool`; `E:real->bool`; `h:real->real`; + `a:int`; `p:int`; + `tau:int#int#int`] GK_MEASURE_BOUND_STRONG) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `ups:int#int#int` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `real_integral (dyho a p)(\z. hl_maximal + (\w. norm(vsum {s | s IN P /\ tile_ler s tau} + (\s. (c:(int#int#int)->complex) s * phi_sigma s + carleson_phi w))) z) = + real_integral (dyho a p)(\z. hl_maximal (\w. norm((G:real->complex) w)) z)` + SUBST1_TAC THENL + [AP_TERM_TAC THEN ABS_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN + AP_TERM_TAC THEN EXPAND_TAC "G" THEN REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `(((&2 * Cgm) / real_measure(dyho a p)) * + real_integral (dyho a p)(\z. hl_maximal (\w. norm((G:real->complex) w)) + z)) * + real_measure ({x | x IN E /\ h x IN tile_J ups} INTER dyho a p)` THEN + CONJ_TAC THENL + [USE_THEN "CELL" (MP_TAC o SPECL + [`c:(int#int#int)->complex`; `P:(int#int#int)->bool`; `tau:int#int#int`; + `E:real->bool`; `h:real->real`; `a:int`; `p:int`; + `ups:int#int#int`]) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + EXPAND_TAC "G" THEN REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `&0 <= mass_Eh E h (P:(int#int#int)->bool)` ASSUME_TAC THENL + [MP_TAC(ISPECL [`E:real->bool`;`h:real->real`;`P:(int#int#int)->bool`] + MASS_EH_POS) THEN + ANTS_TAC THENL + [CONJ_TAC THEN FIRST_ASSUM ACCEPT_TAC; DISCH_THEN ACCEPT_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < &2 zpow a` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `real_measure (dyho a p) = &2 zpow a` ASSUME_TAC THENL + [MP_TAC(ISPECL [`P:(int#int#int)->bool`;`a:int`;`p:int`] KCOVER_MEASURE) + THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + FIRST_ASSUM(X_CHOOSE_TAC `M:real` o MATCH_MP SCHWARTZ_BOUNDED) THEN + SUBGOAL_THEN + `(\x. abs(norm((G:real->complex) x))) real_integrable_on (:real)` + ASSUME_TAC THENL + [REWRITE_TAC[REAL_ABS_NORM; REAL_INTEGRABLE_ON; o_DEF; IMAGE_LIFT_UNIV; + LIFT_DROP] THEN + MP_TAC(MATCH_MP SCHWARTZ_ABSINT (ASSUME `schwartz (G:real->complex)`)) THEN + REWRITE_TAC[absolutely_integrable_on] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o REWRITE_RULE[o_DEF]) THEN REWRITE_TAC[NORM_LIFT]; + ALL_TAC] THEN + SUBGOAL_THEN + `&0 <= real_integral (dyho a p)(\z. hl_maximal (\w. norm((G:real->complex) + w)) z)` + ASSUME_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_POS THEN CONJ_TAC THENL + [ONCE_REWRITE_TAC[ETA_AX] THEN + MATCH_MP_TAC SCHWARTZ_HLMAX_INTEGRABLE THEN + ASM_REWRITE_TAC[DYHO_MEASURABLE]; + X_GEN_TAC `z:real` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + MATCH_MP_TAC HL_MAXIMAL_POS THEN EXISTS_TAC `M:real` THEN + CONJ_TAC THENL + [MP_TAC(ASSUME `(\x. abs(norm((G:real->complex) x))) real_integrable_on + (:real)`) THEN + REWRITE_TAC[REAL_ABS_NORM]; + ASM_REWRITE_TAC[REAL_ABS_NORM]]]; + ALL_TAC] THEN + MATCH_MP_TAC GTM_CELL_ARITH THEN ASM_REWRITE_TAC[] THEN + MP_TAC(SPEC `&3 / &2` CW_POS) THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* 286L alpha3 COVER SUM. Sums ALPHA3_CELL_MASS over the maximal cover cells *) +(* ap IN S (each with l_K = -FST ap > k_tau, i.e. 2^{FST ap+1} <= *) +(* 2^{-k_tau}): *) +(* sum_{ap} norm(vsum {W3-slice tiles at ap}(c_s int_{region} phi_s)) *) +(* <= (4 C1 mass/w(3/2)) * int_Ihat_tau g~*, *) +(* g~* = H-L maximal of gt = sum_{tree} c_s phi_s, Ihat_tau = [x_tau +- 7 *) +(* 2^{-k_tau}]. Route: SUM_LE bounds each cell by ALPHA3_CELL_MASS (c := *) +(* carleson_ip f; the k_tau < -FST ap gate from 2^{FST ap+1}<=2^{-k_tau} via *) +(* ZPOW2_LE_REV); SUM_LMUL pulls the cell-independent 4 C1 mass/w out; *) +(* SUM_COVER_INTEGRAL_LE (G c = dyho(FST c)(SND c)) bounds sum int_K g~* <= *) +(* int_Ihat g~* -- its 6 hyps: FINITE S, dyho-injectivity *) +(* (DYHO_INJ+PAIR_EQ), *) +(* per-cell g~*-integrable (SCHWARTZ_HLMAX_INTEGRABLE) + dyho SUBSET Ihat *) +(* (KCOVER_SUBSET_IHAT), pairwise dyho INTER dyho = {} (KCOVER_DISJOINT + *) +(* REAL_NEGLIGIBLE_EMPTY), g~* integrable on Ihat (real_interval), g~* >= 0 *) +(* (HL_MAXIMAL_POS). This is the alpha3 (j) cover assembly; ALPHA3_MAXIMAL_ *) +(* BOUND then bounds int_Ihat g~* by sqrt(mu Ihat) sqrt(8 C3 energy^2 *) +(* 2^{-ktau}). *) +(* ------------------------------------------------------------------------- *) +let ALPHA3_COVER_SUM_C = prove + (`?C1. &0 <= C1 /\ + !(c:(int#int#int)->complex) E h (P:(int#int#int)->bool) S kt nt tau. + FINITE P /\ ~(P = {}) /\ tile_k tau = kt /\ + (!s. s IN P ==> tile_le s tau) /\ + real_lebesgue_measurable E /\ h real_measurable_on (:real) /\ + (!s. s IN P ==> tile_I s SUBSET dyho (--kt) nt) /\ + (!t. cw_tile t real_integrable_on {x | x IN E /\ h x IN tile_J t}) /\ + FINITE S /\ + (!ap. ap IN S ==> in_kcover P (FST ap) (SND ap) /\ + &2 zpow (FST ap + &1) <= &2 zpow (--kt)) + ==> sum S (\ap. norm(vsum {s | s IN P /\ tile_ler s tau /\ tile_k s < + --(FST ap)} + (\s. c s * + integral (IMAGE lift ({x | x IN E /\ h x IN + tile_Jr s} INTER + dyho (FST ap) (SND ap))) + (\z. phi_sigma s carleson_phi (drop + z))))) + <= ((&4 * C1) * mass_Eh E h P / cw(&3 / &2)) * + real_integral + (real_interval[dyho_mid (--kt) nt - &7 * &2 zpow (--kt), + dyho_mid (--kt) nt + &7 * &2 zpow (--kt)]) + (\z. hl_maximal (\w. norm(vsum {s | s IN P /\ tile_ler s tau} + (\s. c s * phi_sigma s carleson_phi w))) z)`, + X_CHOOSE_THEN `Cgm:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "CM")) + ALPHA3_CELL_MASS THEN + EXISTS_TAC `Cgm:real` THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + ABBREV_TAC + `Gs = \w. vsum {s | s IN P /\ tile_ler s tau} + (\s. (c:(int#int#int)->complex) s * phi_sigma s carleson_phi + w)` THEN + SUBGOAL_THEN `schwartz (Gs:real->complex)` ASSUME_TAC THENL + [EXPAND_TAC "Gs" THEN MATCH_MP_TAC FTILDE_SCHWARTZ_C THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `sum S (\ap. ((&4 * Cgm) * mass_Eh E h P / cw(&3 / &2)) * + real_integral (dyho (FST ap) (SND ap)) + (\z. hl_maximal (\w. norm((Gs:real->complex) w)) z))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `ap:int#int` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + SUBGOAL_THEN `in_kcover P (FST(ap:int#int)) (SND ap) /\ + &2 zpow (FST ap + &1) <= &2 zpow (--kt)` STRIP_ASSUME_TAC + THENL + [FIRST_X_ASSUM(fun th -> if is_forall(concl th) && + can (find_term (fun tm -> tm = `in_kcover`)) (concl th) && + not(can (find_term (fun tm -> tm = `phi_sigma`)) (concl th)) + then MATCH_MP_TAC th else NO_TAC) THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBST1_TAC(SYM(ASSUME + `(\w. vsum {s | s IN P /\ tile_ler s tau} + (\s. (c:(int#int#int)->complex) s * phi_sigma s carleson_phi + w)) = Gs`)) THEN + CONV_TAC(DEPTH_CONV BETA_CONV) THEN + USE_THEN "CM" (MP_TAC o SPECL + [`c:(int#int#int)->complex`; `P:(int#int#int)->bool`; `tau:int#int#int`; + `E:real->bool`; `h:real->real`; `FST(ap:int#int)`; + `SND(ap:int#int)`]) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`FST(ap:int#int) + &1`; `--kt:int`] ZPOW2_LE_REV) THEN + ASM_REWRITE_TAC[] THEN ASM_INT_ARITH_TAC; + DISCH_THEN ACCEPT_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN + `real_integral + (real_interval[dyho_mid (--kt) nt - &7 * &2 zpow (--kt), + dyho_mid (--kt) nt + &7 * &2 zpow (--kt)]) + (\z. hl_maximal (\w. norm(vsum {s | s IN P /\ tile_ler s tau} + (\s. (c:(int#int#int)->complex) s * phi_sigma s carleson_phi w))) + z) = + real_integral + (real_interval[dyho_mid (--kt) nt - &7 * &2 zpow (--kt), + dyho_mid (--kt) nt + &7 * &2 zpow (--kt)]) + (\z. hl_maximal (\w. norm((Gs:real->complex) w)) z)` + SUBST1_TAC THENL + [AP_TERM_TAC THEN ABS_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN + AP_TERM_TAC THEN EXPAND_TAC "Gs" THEN REWRITE_TAC[]; ALL_TAC] THEN + ONCE_REWRITE_TAC[SUM_LMUL] THEN MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [REAL_ARITH_TAC; ASM_REWRITE_TAC[]]; + MATCH_MP_TAC REAL_LE_DIV THEN CONJ_TAC THENL + [MATCH_MP_TAC MASS_EH_POS THEN ASM_REWRITE_TAC[]; + MP_TAC(SPEC `&3 / &2` CW_POS) THEN REAL_ARITH_TAC]]; + ALL_TAC] THEN + FIRST_ASSUM(X_CHOOSE_TAC `M:real` o MATCH_MP SCHWARTZ_BOUNDED) THEN + SUBGOAL_THEN + `(\x. abs(norm((Gs:real->complex) x))) real_integrable_on (:real)` + ASSUME_TAC THENL + [REWRITE_TAC[REAL_ABS_NORM; REAL_INTEGRABLE_ON; o_DEF; IMAGE_LIFT_UNIV; + LIFT_DROP] THEN + MP_TAC(MATCH_MP SCHWARTZ_ABSINT (ASSUME `schwartz (Gs:real->complex)`)) + THEN + REWRITE_TAC[absolutely_integrable_on] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o REWRITE_RULE[o_DEF]) THEN REWRITE_TAC[NORM_LIFT]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`\ap:int#int. dyho (FST ap) (SND ap)`; `S:(int#int)->bool`; + `\z. hl_maximal (\w. norm((Gs:real->complex) w)) z`; + `real_interval[dyho_mid (--kt) nt - &7 * &2 zpow (--kt), + dyho_mid (--kt) nt + &7 * &2 zpow (--kt)]`] + SUM_COVER_INTEGRAL_LE) THEN + REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + REWRITE_TAC[FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC [`a1:int`;`p1:int`;`a2:int`;`p2:int`] THEN + REWRITE_TAC[] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP DYHO_INJ) THEN SIMP_TAC[PAIR_EQ]; + X_GEN_TAC `cc:int#int` THEN DISCH_TAC THEN CONJ_TAC THENL + [ONCE_REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC SCHWARTZ_HLMAX_INTEGRABLE THEN + ASM_REWRITE_TAC[DYHO_MEASURABLE]; + MATCH_MP_TAC KCOVER_SUBSET_IHAT THEN + MAP_EVERY EXISTS_TAC [`P:(int#int#int)->bool`] THEN + ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `cc:int#int` o + check(fun th -> is_forall(concl th) && + can (find_term (fun tm -> tm = `in_kcover`)) (concl th) && + not(can (find_term (fun tm -> tm = `phi_sigma`)) (concl th)))) THEN + ASM_SIMP_TAC[]]; + MAP_EVERY X_GEN_TAC [`cc:int#int`; `cc':int#int`] THEN STRIP_TAC THEN + SUBGOAL_THEN + `dyho (FST(cc:int#int)) (SND cc) INTER dyho (FST(cc':int#int)) (SND cc') = + {}` + (fun th -> REWRITE_TAC[th; REAL_NEGLIGIBLE_EMPTY]) THEN + REWRITE_TAC[GSYM DISJOINT] THEN MATCH_MP_TAC KCOVER_DISJOINT THEN + EXISTS_TAC `P:(int#int#int)->bool` THEN REPEAT CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `cc:int#int`) THEN ASM_SIMP_TAC[]; + FIRST_X_ASSUM(MP_TAC o SPEC `cc':int#int`) THEN ASM_SIMP_TAC[]; + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o MATCH_MP DYHO_INJ) THEN + UNDISCH_TAC `~(cc:int#int = cc')` THEN + MP_TAC(ISPEC `cc:int#int` PAIR_SURJECTIVE) THEN + DISCH_THEN(X_CHOOSE_THEN `a1:int` (X_CHOOSE_THEN + `p1:int` SUBST1_TAC)) THEN + MP_TAC(ISPEC `cc':int#int` PAIR_SURJECTIVE) THEN + DISCH_THEN(X_CHOOSE_THEN `a2:int` (X_CHOOSE_THEN + `p2:int` SUBST1_TAC)) THEN + REWRITE_TAC[PAIR_EQ] THEN INT_ARITH_TAC]; + ONCE_REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC SCHWARTZ_HLMAX_INTEGRABLE THEN + ASM_REWRITE_TAC[REAL_MEASURABLE_REAL_INTERVAL]; + X_GEN_TAC `z:real` THEN REWRITE_TAC[] THEN + MATCH_MP_TAC HL_MAXIMAL_POS THEN EXISTS_TAC `M:real` THEN + CONJ_TAC THENL + [MP_TAC(ASSUME `(\x. abs(norm((Gs:real->complex) x))) real_integrable_on + (:real)`) THEN + REWRITE_TAC[REAL_ABS_NORM]; + ASM_REWRITE_TAC[REAL_ABS_NORM]]]);; + +(* ------------------------------------------------------------------------- *) +(* ALPHA3_TOTAL_C: zeta-general alpha3 total. Same collapse as ALPHA3_TOTAL *) +(* but with arbitrary c whose norm matches carleson_ip f (phase-invariance), *) +(* so the energy input sum norm(c s)^2 = sum norm(ip s)^2 <= energy^2 *) +(* 2^{-kt}. *) +(* This is the W3-block bound the k-assembly needs (W3 keeps the zeta *) +(* phase). *) +(* ------------------------------------------------------------------------- *) +let ALPHA3_TOTAL_C = prove + (`?C1 C3. &0 <= C1 /\ &0 <= C3 /\ + !(c:(int#int#int)->complex) (f:real->complex) E h (P:(int#int#int)->bool) S + kt nt tau. + FINITE P /\ ~(P = {}) /\ tile_k tau = kt /\ + (!s. s IN P ==> tile_le s tau) /\ + real_lebesgue_measurable E /\ h real_measurable_on (:real) /\ + (!s. s IN P ==> tile_I s SUBSET dyho (--kt) nt) /\ + (!t. cw_tile t real_integrable_on {x | x IN E /\ h x IN tile_J t}) /\ + (!s. norm(c s) = norm(carleson_ip f s)) /\ + FINITE S /\ + (!ap. ap IN S ==> in_kcover P (FST ap) (SND ap) /\ + &2 zpow (FST ap + &1) <= &2 zpow (--kt)) + ==> sum S (\ap. norm(vsum {s | s IN P /\ tile_ler s tau /\ tile_k s < + --(FST ap)} + (\s. c s * + integral (IMAGE lift ({x | x IN E /\ h x IN + tile_Jr s} INTER + dyho (FST ap) (SND ap))) + (\z. phi_sigma s carleson_phi (drop + z))))) + <= ((&4 * C1) * mass_Eh E h P / cw(&3 / &2)) * + (sqrt(&112 * C3) * energy_f f P * &2 zpow (--kt))`, + X_CHOOSE_THEN `C1:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "CV")) + ALPHA3_COVER_SUM_C THEN + X_CHOOSE_THEN `C3:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "MX")) + ALPHA3_MAXIMAL_BOUND THEN + MAP_EVERY EXISTS_TAC [`C1:real`; `C3:real`] THEN + ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `((&4 * C1) * mass_Eh E h P / cw(&3 / &2)) * + real_integral + (real_interval[dyho_mid (--kt) nt - &7 * &2 zpow (--kt), + dyho_mid (--kt) nt + &7 * &2 zpow (--kt)]) + (\z. hl_maximal (\w. norm(vsum {s | s IN P /\ tile_ler s tau} + (\s. (c:(int#int#int)->complex) s * phi_sigma s carleson_phi + w))) z)` THEN + CONJ_TAC THENL + [USE_THEN "CV" (MP_TAC o SPECL + [`c:(int#int#int)->complex`; `E:real->bool`; `h:real->real`; + `P:(int#int#int)->bool`; `S:(int#int)->bool`; + `kt:int`; `nt:int`; `tau:int#int#int`]) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; DISCH_THEN ACCEPT_TAC]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [REAL_ARITH_TAC; ASM_REWRITE_TAC[]]; + MATCH_MP_TAC REAL_LE_DIV THEN CONJ_TAC THENL + [MATCH_MP_TAC MASS_EH_POS THEN ASM_REWRITE_TAC[]; + MP_TAC(SPEC `&3 / &2` CW_POS) THEN REAL_ARITH_TAC]]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `sqrt(real_measure(real_interval[dyho_mid (--kt) nt - &7 * &2 zpow (--kt), + dyho_mid (--kt) nt + &7 * &2 zpow (--kt)])) + * + sqrt(&8 * C3 * ((energy_f (f:real->complex) P) pow 2 * &2 zpow (--kt)))` + THEN + CONJ_TAC THENL + [ONCE_REWRITE_TAC[ETA_AX] THEN + USE_THEN "MX" (MP_TAC o SPECL + [`c:(int#int#int)->complex`; `P:(int#int#int)->bool`; `tau:int#int#int`; + `real_interval[dyho_mid (--kt) nt - &7 * &2 zpow (--kt), + dyho_mid (--kt) nt + &7 * &2 zpow (--kt)]`; + `(energy_f (f:real->complex) P) pow 2 * &2 zpow (--kt)`]) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[REAL_MEASURABLE_REAL_INTERVAL] THEN + SUBST1_TAC(SYM(ASSUME `tile_k tau = kt`)) THEN + SUBGOAL_THEN + `sum {s | s IN P /\ tile_ler s tau} (\s. norm((c:(int#int#int)->complex) + s) pow 2) = + sum {s | s IN P /\ tile_ler s tau} (\s. norm(carleson_ip + (f:real->complex) s) pow 2)` + SUBST1_TAC THENL + [MATCH_MP_TAC SUM_EQ THEN ASM_SIMP_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC FTILDE_ENERGY_SUM THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_MUL_ASSOC]]; + ALL_TAC] THEN + SUBGOAL_THEN + `real_measure(real_interval[dyho_mid (--kt) nt - &7 * &2 zpow (--kt), + dyho_mid (--kt) nt + &7 * &2 zpow (--kt)]) + = &14 * &2 zpow (--kt)` + SUBST1_TAC THENL + [REWRITE_TAC[REAL_MEASURE_REAL_INTERVAL] THEN + SUBGOAL_THEN `&0 < &2 zpow (--kt)` MP_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `sqrt(&14 * &2 zpow (--kt)) * + sqrt(&8 * C3 * ((energy_f (f:real->complex) P) pow 2 * &2 zpow (--kt))) = + sqrt(&112 * C3) * energy_f f P * &2 zpow (--kt)` + (fun th -> REWRITE_TAC[th; REAL_LE_REFL]) THEN + SUBGOAL_THEN `&0 <= &2 zpow (--kt) /\ &0 <= energy_f (f:real->complex) P` + STRIP_ASSUME_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC REAL_LT_IMP_LE THEN MATCH_MP_TAC REAL_ZPOW_LT THEN + REAL_ARITH_TAC; + MATCH_MP_TAC ENERGY_F_POS THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN + REWRITE_TAC[GSYM SQRT_MUL] THEN + SUBGOAL_THEN + `(&14 * &2 zpow (--kt)) * &8 * C3 * ((energy_f (f:real->complex) P) pow 2 * + &2 zpow (--kt)) = + (&112 * C3) * (energy_f f P * &2 zpow (--kt)) pow 2` + SUBST1_TAC THENL + [REWRITE_TAC[REAL_POW_MUL] THEN REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[SQRT_MUL] THEN AP_TERM_TAC THEN + MATCH_MP_TAC POW_2_SQRT THEN MATCH_MP_TAC REAL_LE_MUL THEN + ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* 286L(k) assembly brick 1: the abstract 4-way combination. If the 286L LHS *) +(* is bounded by |a0|+|a1|+|a2|+|a3| and each |a_j| <= C_j * base, then it *) +(* is *) +(* bounded by (C0+C1+C2+C3) * base -- so C7 is taken as the sum of the four *) +(* alpha-total constants (the 286L theorem is EXISTS C7, so no need to match *) +(* Fremlin's exact 7/2 + 8/7 + 28/w(3/2) + 4 sqrt(14 C3)/w(3/2) closed *) +(* form). *) +(* ------------------------------------------------------------------------- *) +let INTEGRAL_UNIONS_FINITE_C = prove + (`!(ff:real^1->complex) (D:(real^1->bool)->bool). + FINITE D /\ + (!s. s IN D ==> ff integrable_on s) /\ + (!s s'. s IN D /\ s' IN D /\ ~(s = s') ==> negligible (s INTER s')) + ==> integral (UNIONS D) ff = vsum D (\s. integral s ff)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN + MATCH_MP_TAC HAS_INTEGRAL_UNIONS THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `s:real^1->bool` THEN DISCH_TAC THEN + ASM_SIMP_TAC[GSYM INTEGRABLE_INTEGRAL]);; + +(* K2 core: cover-decomposition of a tile integral over a FINITE *) +(* disjoint-ish *) +(* cover. integral region ff = vsum_{c in S} integral(region INTER Gc c) ff. *) +let COMPLEX_UNIT_PHASE = prove + (`!z:complex. ?w. norm w = &1 /\ w * z = Cx(norm z)`, + GEN_TAC THEN ASM_CASES_TAC `z = Cx(&0)` THENL + [EXISTS_TAC `Cx(&1)` THEN + ASM_REWRITE_TAC[COMPLEX_NORM_CX; COMPLEX_MUL_RZERO; COMPLEX_NORM_0] THEN + CONV_TAC REAL_RAT_REDUCE_CONV; + EXISTS_TAC `cnj z / Cx(norm z)` THEN CONJ_TAC THENL + [REWRITE_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_CNJ; COMPLEX_NORM_CX; + REAL_ABS_NORM] THEN + MATCH_MP_TAC REAL_DIV_REFL THEN ASM_REWRITE_TAC[COMPLEX_NORM_ZERO]; + REWRITE_TAC[complex_div] THEN + ONCE_REWRITE_TAC[COMPLEX_RING `(a * b) * c = (c * a) * b:complex`] THEN + REWRITE_TAC[GSYM complex_div] THEN ASM_SIMP_TAC[COMPLEX_MUL_CNJ] THEN + REWRITE_TAC[GSYM CX_POW; complex_div; GSYM CX_INV; GSYM CX_MUL] THEN + AP_TERM_TAC THEN + MATCH_MP_TAC(REAL_FIELD `~(n = &0) ==> n pow 2 * inv n = n`) THEN + ASM_REWRITE_TAC[COMPLEX_NORM_ZERO]]]);; + +(* Cx pulls out of a finite vsum. *) +let VSUM_CX_PULL = prove + (`!f (P:A->bool). FINITE P ==> vsum P (\s. Cx(f s)) = Cx(sum P f)`, + GEN_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[VSUM_CLAUSES; SUM_CLAUSES] THEN + REWRITE_TAC[GSYM CX_ADD; COMPLEX_VEC_0; CX_DEF]);; + +let ZETA_REALIFY = prove + (`!(P:A->bool) (z:A->complex). + FINITE P + ==> ?w. (!s. norm(w s) = &1) /\ + sum P (\s. norm(z s)) = norm(vsum P (\s. w s * z s))`, + REPEAT STRIP_TAC THEN + MP_TAC(GEN `s:A` (ISPEC `(z:A->complex) s` COMPLEX_UNIT_PHASE)) THEN + REWRITE_TAC[SKOLEM_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `w:A->complex` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `w:A->complex` THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[VSUM_CX_PULL] THEN REWRITE_TAC[COMPLEX_NORM_CX] THEN + CONV_TAC SYM_CONV THEN REWRITE_TAC[REAL_ABS_REFL] THEN + MATCH_MP_TAC SUM_POS_LE THEN REWRITE_TAC[NORM_POS_LE]);; + +(* ------------------------------------------------------------------------- *) +(* 286L(b) 4-way norm-block split: for a finite index set partitioned into 4 *) +(* pairwise-disjoint blocks W0,W1,W2,W3, the norm of the whole vsum is *) +(* bounded *) +(* by the sum of the four block norms. = Fremlin's |sum_{P x K}| <= *) +(* |a0|+|a1|+ *) +(* |a2|+|a3| step (each a_j = the W_j double-sum), keeping every block as a *) +(* norm-of-sum -- crucially W3 stays norm(vsum{W3}) matching ALPHA3_TOTAL *) +(* (an *) +(* early sum-of-norms flatten of W3 would reverse the alpha3 inequality). *) +(* VSUM_UNION collapses the 4-fold union; NORM_TRIANGLE thrice. *) +(* ------------------------------------------------------------------------- *) +let S_DICHOTOMY_SPLIT = prove + (`!(S:(int#int)->bool) kt (g:(int#int)->real). + FINITE S + ==> sum S g = + sum {ap | ap IN S /\ &2 zpow (FST ap) <= &2 zpow (--kt)} g + + sum {ap | ap IN S /\ &2 zpow (--kt) < &2 zpow (FST ap)} g`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`g:(int#int)->real`; + `{ap:int#int | ap IN S /\ &2 zpow (FST ap) <= &2 zpow (--kt)}`; + `{ap:int#int | ap IN S /\ &2 zpow (--kt) < &2 zpow (FST ap)}`] SUM_UNION) + THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[FINITE_RESTRICT] THEN + REWRITE_TAC[DISJOINT; EXTENSION; IN_INTER; IN_ELIM_THM; NOT_IN_EMPTY] THEN + GEN_TAC THEN REAL_ARITH_TAC; + DISCH_THEN(SUBST1_TAC o SYM) THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_UNION; IN_ELIM_THM] THEN + X_GEN_TAC `ap:int#int` THEN + ASM_CASES_TAC `(ap:int#int) IN S` THEN ASM_REWRITE_TAC[] THEN + REAL_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* 286L(k) W0+W1 bridge: the combined alpha0 + alpha1 sum-of-norms bound. *) +(* Summed over the WHOLE cover S, the W0/W1 tile-slice {tile_le s tau /\ *) +(* --FST ap <= tile_k s} (the l_K >= k_s "coarse-relative" tiles) is bounded *) +(* by the S-dichotomy split into S>= (l_K >= kt, -> ALPHA0_TOTAL_WIDE) and *) +(* S< (l_K < kt, -> ALPHA1_TOTAL, which needs tile_k tau = kt). Both use the *) +(* SUM-of-norms shape (the zeta unimodular phase washes out, |zeta|=1), so *) +(* the bare carleson_ip f is correct here. The combined constant is *) +(* 28*C0 + C1 (C0 the WIDE-alpha0 constant, C1 the alpha1 constant); the *) +(* algebra (2*C0*e*m)*14*t + C1*e*m*t = (28*C0+C1)*e*m*t is a REAL_RING *) +(* identity (nonlinear in C0/C1/e/m, so not REAL_ARITH). *) +(* ------------------------------------------------------------------------- *) +let W01_BRIDGE = prove + (`?C. &0 <= C /\ + !(f:real->complex) E h (P:(int#int#int)->bool) S kt nt tau. + FINITE P /\ ~(P = {}) /\ tile_k tau = kt /\ + (!s. s IN P ==> tile_le s tau) /\ + real_lebesgue_measurable E /\ h real_measurable_on (:real) /\ + (!s. s IN P ==> tile_I s SUBSET dyho (--kt) nt) /\ + (!t. cw_tile t real_integrable_on {x | x IN E /\ h x IN tile_J t}) /\ + FINITE S /\ (!ap. ap IN S ==> in_kcover P (FST ap) (SND ap)) + ==> sum S (\ap. sum {s | s IN P /\ tile_le s tau /\ --(FST ap) <= tile_k + s} + (\s. norm(carleson_ip f s * + integral (IMAGE lift ({x | x IN E /\ h x IN + tile_Jr s} INTER + dyho (FST ap) (SND ap))) + (\z. phi_sigma s carleson_phi (drop + z))))) + <= C * energy_f f P * mass_Eh E h P * &2 zpow (--kt)`, + X_CHOOSE_THEN + `C0:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "A0")) + ALPHA0_TOTAL_WIDE THEN + X_CHOOSE_THEN + `C1:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "A1")) ALPHA1_TOTAL THEN + EXISTS_TAC `&28 * C0 + C1` THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`S:(int#int)->bool`; `kt:int`; + `\ap. sum {s | s IN P /\ tile_le s tau /\ --(FST ap) <= tile_k s} + (\s. norm(carleson_ip (f:real->complex) s * + integral (IMAGE lift ({x | x IN E /\ h x IN tile_Jr s} INTER + dyho (FST ap) (SND ap))) + (\z. phi_sigma s carleson_phi (drop z))))`] + S_DICHOTOMY_SPLIT) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `(&2 * C0 * energy_f (f:real->complex) P * mass_Eh E h P) * &14 * &2 zpow + (--kt) + + C1 * energy_f (f:real->complex) P * mass_Eh E h P * &2 zpow (--kt)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THENL + [USE_THEN "A0" (MP_TAC o SPECL + [`f:real->complex`; `E:real->bool`; `h:real->real`; + `P:(int#int#int)->bool`; + `{ap:int#int | ap IN S /\ &2 zpow (FST ap) <= &2 zpow (--kt)}`; + `kt:int`; `nt:int`; `tau:int#int#int`]) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [ASM_MESON_TAC[tile_le]; + ASM_SIMP_TAC[FINITE_RESTRICT]; + REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[]]; + DISCH_TAC THEN FIRST_X_ASSUM ACCEPT_TAC]; + USE_THEN "A1" (MP_TAC o SPECL + [`f:real->complex`; `E:real->bool`; `h:real->real`; + `P:(int#int#int)->bool`; + `{ap:int#int | ap IN S /\ &2 zpow (--kt) < &2 zpow (FST ap)}`; + `kt:int`; `nt:int`; `tau:int#int#int`]) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [ASM_MESON_TAC[tile_le]; + ASM_SIMP_TAC[FINITE_RESTRICT]; + REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[]]; + DISCH_TAC THEN FIRST_X_ASSUM ACCEPT_TAC]]; + MATCH_MP_TAC REAL_EQ_IMP_LE THEN CONV_TAC REAL_RING]);; + +(* ------------------------------------------------------------------------- *) +(* 286L(k) W2 bridge: the W2 block (sigma NOT in the tree T_tau, mu K < mu *) +(* I_s) *) +(* summed over the WHOLE cover S. The W2 tile-slice {tile_le s tau /\ *) +(* ~tile_ler s tau /\ tile_k s < --FST ap} is EMPTY on cells failing the *) +(* alpha2 *) +(* gate 2^{FSTap+1}<=2^{-kt} (there --FST ap <= kt <= tile_k s, *) +(* contradicting *) +(* tile_k s < --FST ap by the tree scale TILE_LE_SCALE), so SUM_SUPERSET *) +(* collapses S to the gated subset, on which ALPHA2_TOTAL applies. Sum-of- *) +(* norms (the zeta phase washes out), so BARE carleson_ip f. C = 56 *) +(* C2/cw(3/2). *) +(* ------------------------------------------------------------------------- *) +let W2_BRIDGE = prove + (`?C. &0 <= C /\ + !(f:real->complex) E h (P:(int#int#int)->bool) S kt nt tau. + FINITE P /\ ~(P = {}) /\ tile_k tau = kt /\ + (!s. s IN P ==> tile_le s tau) /\ + real_lebesgue_measurable E /\ h real_measurable_on (:real) /\ + (!s. s IN P ==> tile_I s SUBSET dyho (--kt) nt) /\ + (!t. cw_tile t real_integrable_on {x | x IN E /\ h x IN tile_J t}) /\ + FINITE S /\ (!ap. ap IN S ==> in_kcover P (FST ap) (SND ap)) + ==> sum S (\ap. sum {s | s IN P /\ tile_le s tau /\ ~(tile_ler s tau) /\ + tile_k s < --(FST ap)} + (\s. norm(carleson_ip f s * + integral (IMAGE lift ({x | x IN E /\ h x IN + tile_Jr s} INTER + dyho (FST ap) (SND ap))) + (\z. phi_sigma s carleson_phi (drop + z))))) + <= C * energy_f f P * mass_Eh E h P * &2 zpow (--kt)`, + X_CHOOSE_THEN + `C2:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "A2")) ALPHA2_TOTAL THEN + EXISTS_TAC `&56 * C2 / cw(&3 / &2)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LE_DIV THEN CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; MP_TAC(SPEC `&3 / &2` CW_POS) THEN + REAL_ARITH_TAC]]; + ALL_TAC] THEN + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`\ap. sum {s | s IN P /\ tile_le s tau /\ ~(tile_ler s tau) /\ + tile_k s < --(FST(ap:int#int))} + (\s. norm(carleson_ip (f:real->complex) s * + integral (IMAGE lift ({x | x IN E /\ h x IN tile_Jr s} INTER + dyho (FST ap) (SND ap))) + (\z. phi_sigma s carleson_phi (drop z))))`; + `{ap:int#int | ap IN S /\ &2 zpow (FST ap + &1) <= &2 zpow (--kt)}`; + `S:(int#int)->bool`] + SUM_SUPERSET) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN MESON_TAC[]; + X_GEN_TAC `ap:int#int` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN + REWRITE_TAC[] THEN MATCH_MP_TAC SUM_EQ_0 THEN + X_GEN_TAC `s:int#int#int` THEN + REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN + SUBGOAL_THEN `--(FST(ap:int#int)) <= kt` ASSUME_TAC THENL + [SUBGOAL_THEN `&2 zpow (--kt) < &2 zpow (FST(ap:int#int) + &1)` + (MP_TAC o MATCH_MP ZPOW2_LT_REV) THENL + [ASM_MESON_TAC[REAL_NOT_LE]; INT_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN `tile_k tau <= tile_k(s:int#int#int)` MP_TAC THENL + [MATCH_MP_TAC TILE_LE_SCALE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_INT_ARITH_TAC]; + DISCH_THEN SUBST1_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `((&2 * C2 * energy_f (f:real->complex) P) * (&2 * mass_Eh E h P / cw(&3 / + &2))) * + (&14 * &2 zpow (--kt))` THEN + CONJ_TAC THENL + [USE_THEN "A2" (MP_TAC o SPECL + [`f:real->complex`; `E:real->bool`; `h:real->real`; + `P:(int#int#int)->bool`; + `{ap:int#int | ap IN S /\ &2 zpow (FST ap + &1) <= &2 zpow (--kt)}`; + `kt:int`; `nt:int`; `tau:int#int#int`]) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [ASM_SIMP_TAC[FINITE_RESTRICT]; + REWRITE_TAC[IN_ELIM_THM] THEN ASM_MESON_TAC[]]; + DISCH_THEN ACCEPT_TAC]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_EQ_IMP_LE THEN + MP_TAC(SPEC `&3 / &2` CW_POS) THEN CONV_TAC REAL_FIELD);; + +(* ------------------------------------------------------------------------- *) +(* 286L(k) W3 bridge: the W3 block (sigma IN the tree T_tau, mu K < mu I_s) *) +(* summed over the WHOLE cover S. Like W2 but the W3-slice keeps the *) +(* NORM-OF-SUM (cancellation), so it uses the zeta-general ALPHA3_TOTAL_C *) +(* with *) +(* the arbitrary coefficient c (whose norm matches carleson_ip f -- the *) +(* unimodular phase absorbed into c). Off-gate the W3-slice vsum is empty *) +(* (VSUM over {} -> 0, norm 0), SUM_SUPERSET collapses to the gated subset. *) +(* C = 4 C1 sqrt(112 C3)/cw(3/2). h is kept FREE (matches ALPHA3_TOTAL_C). *) +(* ------------------------------------------------------------------------- *) +let W3_BRIDGE = prove + (`?C. &0 <= C /\ + !(c:(int#int#int)->complex) (f:real->complex) E h (P:(int#int#int)->bool) S + kt nt tau. + FINITE P /\ ~(P = {}) /\ tile_k tau = kt /\ + (!s. s IN P ==> tile_le s tau) /\ + real_lebesgue_measurable E /\ h real_measurable_on (:real) /\ + (!s. s IN P ==> tile_I s SUBSET dyho (--kt) nt) /\ + (!t. cw_tile t real_integrable_on {x | x IN E /\ h x IN tile_J t}) /\ + (!s. norm(c s) = norm(carleson_ip f s)) /\ + FINITE S /\ (!ap. ap IN S ==> in_kcover P (FST ap) (SND ap)) + ==> sum S (\ap. norm(vsum {s | s IN P /\ tile_ler s tau /\ tile_k s < + --(FST ap)} + (\s. c s * + integral (IMAGE lift ({x | x IN E /\ h x IN + tile_Jr s} INTER + dyho (FST ap) (SND ap))) + (\z. phi_sigma s carleson_phi (drop + z))))) + <= C * energy_f f P * mass_Eh E h P * &2 zpow (--kt)`, + X_CHOOSE_THEN `C1:real` (X_CHOOSE_THEN `C3:real` + (CONJUNCTS_THEN2 ASSUME_TAC (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "A3")))) + ALPHA3_TOTAL_C THEN + EXISTS_TAC `(&4 * C1) * sqrt(&112 * C3) / cw(&3 / &2)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [REAL_ARITH_TAC; ASM_REWRITE_TAC[]]; + MATCH_MP_TAC REAL_LE_DIV THEN CONJ_TAC THENL + [MATCH_MP_TAC SQRT_POS_LE THEN ASM_REAL_ARITH_TAC; + MP_TAC(SPEC `&3 / &2` CW_POS) THEN REAL_ARITH_TAC]]; + ALL_TAC] THEN + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`\ap. norm(vsum {s | s IN P /\ tile_ler s tau /\ tile_k s < + --(FST(ap:int#int))} + (\s. (c:(int#int#int)->complex) s * + integral (IMAGE lift ({x | x IN E /\ h x IN tile_Jr s} INTER + dyho (FST ap) (SND ap))) + (\z. phi_sigma s carleson_phi (drop z))))`; + `{ap:int#int | ap IN S /\ &2 zpow (FST ap + &1) <= &2 zpow (--kt)}`; + `S:(int#int)->bool`] + SUM_SUPERSET) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN MESON_TAC[]; + X_GEN_TAC `ap:int#int` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN + REWRITE_TAC[] THEN + SUBGOAL_THEN + `~(&2 zpow (FST(ap:int#int) + &1) <= &2 zpow (--kt))` ASSUME_TAC THENL + [UNDISCH_TAC `~((ap:int#int) IN S /\ &2 zpow (FST ap + &1) <= &2 zpow + (--kt))` THEN + UNDISCH_TAC `(ap:int#int) IN S` THEN CONV_TAC TAUT; + ALL_TAC] THEN + SUBGOAL_THEN `--(FST(ap:int#int)) <= kt` ASSUME_TAC THENL + [UNDISCH_TAC `~(&2 zpow (FST(ap:int#int) + &1) <= &2 zpow (--kt))` THEN + REWRITE_TAC[REAL_NOT_LE] THEN + DISCH_THEN(MP_TAC o MATCH_MP ZPOW2_LT_REV) THEN INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `{s | s IN P /\ tile_ler s tau /\ tile_k s < --(FST(ap:int#int))} = {}` + (fun th -> REWRITE_TAC[th; VSUM_CLAUSES; NORM_0]) THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN + X_GEN_TAC `s:int#int#int` THEN STRIP_TAC THEN + SUBGOAL_THEN `tile_k tau <= tile_k(s:int#int#int)` MP_TAC THENL + [MATCH_MP_TAC TILE_LE_SCALE THEN MATCH_MP_TAC TILE_LER_IMP_LE THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_INT_ARITH_TAC]; + DISCH_THEN SUBST1_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `((&4 * C1) * mass_Eh E (h:real->real) P / cw(&3 / &2)) * + (sqrt(&112 * C3) * energy_f (f:real->complex) P * &2 zpow (--kt))` THEN + CONJ_TAC THENL + [USE_THEN "A3" (MP_TAC o ISPECL + [`c:(int#int#int)->complex`; `f:real->complex`; `E:real->bool`; + `h:real->real`; `P:(int#int#int)->bool`; + `{ap:int#int | ap IN S /\ &2 zpow (FST ap + &1) <= &2 zpow (--kt)}`; + `kt:int`; `nt:int`; `tau:int#int#int`]) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [ASM_SIMP_TAC[FINITE_RESTRICT]; + X_GEN_TAC `ap2:int#int` THEN REWRITE_TAC[IN_ELIM_THM] THEN + STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(fun th -> if is_forall(concl th) && + can (find_term (fun tm -> tm = `in_kcover`)) (concl th) && + not(can (find_term (fun tm -> tm = `phi_sigma`)) (concl th)) + then MATCH_MP_TAC th else NO_TAC) THEN ASM_REWRITE_TAC[]]; + DISCH_THEN ACCEPT_TAC]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_EQ_IMP_LE THEN + MP_TAC(SPEC `&3 / &2` CW_POS) THEN CONV_TAC REAL_FIELD);; + +(* ------------------------------------------------------------------------- *) +(* 286L(k) wiring brick: the complex-vsum W-partition split (analog of *) +(* W_SUM_SPLIT). Splits an inner tile-vsum over {s in P | tile_le s tau} *) +(* into the W01 slice (--a<=tile_k s), W2 slice (tile_k s<--a /\ ~tile_ler), *) +(* and W3 slice (tile_k s<--a /\ tile_ler), via the W_TRICHOTOMY partition + *) +(* VSUM_UNION (twice). *) +(* ------------------------------------------------------------------------- *) +let VSUM_W_SPLIT = prove + (`!(P:(int#int#int)->bool) tau a (g:(int#int#int)->complex). + FINITE P + ==> vsum {s | s IN P /\ tile_le s tau} g = + vsum {s | s IN P /\ tile_le s tau /\ --a <= tile_k s} g + + vsum {s | s IN P /\ tile_le s tau /\ tile_k s < --a /\ ~(tile_ler s + tau)} g + + vsum {s | s IN P /\ tile_le s tau /\ tile_k s < --a /\ tile_ler s tau} + g`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `{s | s IN P /\ tile_le s tau} = + {s | s IN P /\ tile_le s tau /\ --a <= tile_k s} UNION + ({s | s IN P /\ tile_le s tau /\ tile_k s < --a /\ ~(tile_ler s tau)} UNION + {s | s IN P /\ tile_le s tau /\ tile_k s < --a /\ tile_ler s tau})` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_UNION; IN_ELIM_THM] THEN + X_GEN_TAC `s:int#int#int` THEN + MP_TAC(INT_ARITH `--a <= tile_k s \/ tile_k s < --a`) THEN + MAP_EVERY ASM_CASES_TAC + [`s IN (P:(int#int#int)->bool)`; `tile_le s tau`; `tile_ler s tau`; + `--a <= tile_k s`] THEN + ASM_REWRITE_TAC[] THEN INT_ARITH_TAC; + ALL_TAC] THEN + W(fun (asl,w) -> MP_TAC(PART_MATCH (lhs o rand) VSUM_UNION (lhs w))) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `P:(int#int#int)->bool` THEN + ASM_REWRITE_TAC[] THEN SET_TAC[]; + MATCH_MP_TAC FINITE_UNION_IMP THEN CONJ_TAC THEN + MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `P:(int#int#int)->bool` THEN + ASM_REWRITE_TAC[] THEN SET_TAC[]; + REWRITE_TAC[DISJOINT; EXTENSION; IN_INTER; IN_UNION; IN_ELIM_THM; + NOT_IN_EMPTY] THEN + GEN_TAC THEN INT_ARITH_TAC]; + DISCH_THEN SUBST1_TAC] THEN + AP_TERM_TAC THEN + MP_TAC(ISPECL + [`g:(int#int#int)->complex`; + `{s | s IN P /\ tile_le s tau /\ tile_k s < --a /\ ~(tile_ler s tau)}`; + `{s | s IN P /\ tile_le s tau /\ tile_k s < --a /\ tile_ler s tau}`] + VSUM_UNION) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `P:(int#int#int)->bool` THEN + ASM_REWRITE_TAC[] THEN SET_TAC[]; + MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `P:(int#int#int)->bool` THEN + ASM_REWRITE_TAC[] THEN SET_TAC[]; + REWRITE_TAC[DISJOINT; EXTENSION; IN_INTER; IN_ELIM_THM; + NOT_IN_EMPTY] THEN + GEN_TAC THEN MESON_TAC[]]; + DISCH_THEN SUBST1_TAC] THEN + REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* 286L(k) wiring brick: the per-cover-cell 3-way bound. For a FIXED cover *) +(* cell (parametrized by a = FST ap) and coefficient c whose norm matches *) +(* carleson_ip f, the norm of the whole inner tile-vsum is bounded by the *) +(* W01 *) +(* sum-of-norms + W2 sum-of-norms + W3 norm-of-sum -- the three shapes the *) +(* bridges consume. Route: rewrite vsum P = vsum{tile_le} (tree hyp); *) +(* VSUM_W_SPLIT; fold the W3 slice {tile_le/\tk<-a/\ler}={ler/\tk<-a} via *) +(* TILE_LER_IMP_LE; NORM_TRIANGLE twice; VSUM_NORM on the W01/W2 blocks + *) +(* phase-invariance norm(c s)=norm(cf s) inside the sums. *) +(* ------------------------------------------------------------------------- *) +let L286_PER_AP_GEN = prove + (`!(c:(int#int#int)->complex) (cf:(int#int#int)->complex) + (P:(int#int#int)->bool) tau a wf. + FINITE P /\ (!s. s IN P ==> tile_le s tau) /\ + (!s. norm(c s) = norm(cf s)) + ==> norm(vsum P (\s. c s * wf s)) + <= sum {s | s IN P /\ tile_le s tau /\ --a <= tile_k s} + (\s. norm(cf s * wf s)) + + sum {s | s IN P /\ tile_le s tau /\ tile_k s < --a /\ ~(tile_ler s + tau)} + (\s. norm(cf s * wf s)) + + norm(vsum {s | s IN P /\ tile_ler s tau /\ tile_k s < --a} + (\s. c s * wf s))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `vsum P (\s. (c:(int#int#int)->complex) s * wf s) = + vsum {s | s IN P /\ tile_le s tau /\ --a <= tile_k s} (\s. c s * wf s) + + vsum {s | s IN P /\ tile_le s tau /\ tile_k s < --a /\ ~(tile_ler s tau)} + (\s. c s * wf s) + + vsum {s | s IN P /\ tile_ler s tau /\ tile_k s < --a} (\s. c s * wf s)` + SUBST1_TAC THENL + [MP_TAC(ISPECL [`P:(int#int#int)->bool`; `tau:int#int#int`; `a:int`; + `\s. (c:(int#int#int)->complex) s * wf s`] VSUM_W_SPLIT) + THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `{s | s IN P /\ tile_le s tau} = P` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN ASM_MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `{s | s IN P /\ tile_le s tau /\ tile_k s < --a /\ tile_ler s tau} = + {s | s IN P /\ tile_ler s tau /\ tile_k s < --a}` + (fun th -> REWRITE_TAC[th]) THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN GEN_TAC THEN + EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[TILE_LER_IMP_LE]; + ALL_TAC] THEN + W(fun (asl,ww) -> MP_TAC(PART_MATCH lhand NORM_TRIANGLE (lhand ww))) THEN + MATCH_MP_TAC(REAL_ARITH + `na <= na' /\ nbc <= nb' + nc' + ==> (x <= na + nbc ==> x <= na' + nb' + nc')`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum {s | s IN P /\ tile_le s tau /\ --a <= tile_k s} + (\s. norm((c:(int#int#int)->complex) s * wf s))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC VSUM_NORM THEN ASM_SIMP_TAC[FINITE_RESTRICT]; + MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC SUM_EQ THEN + X_GEN_TAC `s:int#int#int` THEN REWRITE_TAC[IN_ELIM_THM] THEN + STRIP_TAC THEN + REWRITE_TAC[COMPLEX_NORM_MUL] THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + W(fun (asl,ww) -> MP_TAC(PART_MATCH lhand NORM_TRIANGLE (lhand ww))) THEN + MATCH_MP_TAC(REAL_ARITH `nb <= nb' ==> (x <= nb + nc ==> x <= nb' + nc)`) + THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum {s | s IN P /\ tile_le s tau /\ tile_k s < --a /\ ~(tile_ler + s tau)} + (\s. norm((c:(int#int#int)->complex) s * wf s))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC VSUM_NORM THEN ASM_SIMP_TAC[FINITE_RESTRICT]; + MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC SUM_EQ THEN + X_GEN_TAC `s:int#int#int` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN + REWRITE_TAC[COMPLEX_NORM_MUL] THEN ASM_REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* 286L(k) ABSTRACT k-assembly. Given a unit phase w with the ZETA-realify *) +(* identity, and the three W-block bounds B01/B2/B3, the 286L LHS (sum_s *) +(* norm(cf_s * vsum_S wf)) is bounded by B01 + B2 + B3. All terms stay *) +(* compact *) +(* (wf s ap), so no giant-lambda slowdown. Route: rewrite LHS via realify -> *) +(* norm(vsum_s w_s cf_s vsum_S wf); pull w inside (VSUM_COMPLEX_LMUL); *) +(* VSUM_SWAP *) +(* (ap outside); VSUM_NORM_LE with the per-ap 3-way L286_PER_AP_GEN bound; *) +(* SUM_ADD split into the three block-sums; REAL_LE_ADD2. *) +(* ------------------------------------------------------------------------- *) +let CARLESON_286L_ABSTRACT = prove + (`!(cf:(int#int#int)->complex) (w:(int#int#int)->complex) + (wf:(int#int#int)->(int#int)->complex) (P:(int#int#int)->bool) + (S:(int#int)->bool) + tau (a0:(int#int)->int) B01 B2 B3. + FINITE P /\ FINITE S /\ (!s. s IN P ==> tile_le s tau) /\ + (!s. norm(w s) = &1) /\ + sum P (\s. norm(cf s * vsum S (\ap. wf s ap))) = + norm(vsum P (\s. w s * (cf s * vsum S (\ap. wf s ap)))) /\ + sum S (\ap. sum {s | s IN P /\ tile_le s tau /\ --(a0 ap) <= tile_k s} + (\s. norm(cf s * wf s ap))) <= B01 /\ + sum S (\ap. sum {s | s IN P /\ tile_le s tau /\ tile_k s < --(a0 ap) /\ + ~(tile_ler s tau)} + (\s. norm(cf s * wf s ap))) <= B2 /\ + sum S (\ap. norm(vsum {s | s IN P /\ tile_ler s tau /\ tile_k s < --(a0 + ap)} + (\s. (w s * cf s) * wf s ap))) <= B3 + ==> sum P (\s. norm(cf s * vsum S (\ap. wf s ap))) <= B01 + B2 + B3`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + FIRST_X_ASSUM(fun th -> + if is_eq(concl th) && can (find_term (fun t -> t = `norm:complex->real`)) + (rand(concl th)) + then ONCE_REWRITE_TAC[th] else NO_TAC) THEN + SUBGOAL_THEN + `vsum P (\s. (w:(int#int#int)->complex) s * (cf s * vsum S (\ap. wf s ap))) + = + vsum P (\s. vsum S (\ap. (w s * cf s) * + (wf:(int#int#int)->(int#int)->complex) s ap))` + SUBST1_TAC THENL + [MATCH_MP_TAC VSUM_EQ THEN X_GEN_TAC `s:int#int#int` THEN DISCH_TAC THEN + REWRITE_TAC[COMPLEX_MUL_ASSOC] THEN + MP_TAC(ISPECL [`(w:(int#int#int)->complex) s * cf s`; + `\ap. (wf:(int#int#int)->(int#int)->complex) s ap`; + `S:(int#int)->bool`] VSUM_COMPLEX_LMUL) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[]; + ALL_TAC] THEN + MP_TAC(ISPECL [`\s ap. ((w:(int#int#int)->complex) s * cf s) * + (wf:(int#int#int)->(int#int)->complex) s ap`; + `P:(int#int#int)->bool`; `S:(int#int)->bool`] VSUM_SWAP) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `sum (S:(int#int)->bool) (\(ap:int#int). + sum {s | s IN P /\ tile_le s tau /\ --((a0:(int#int)->int) ap) <= tile_k + s} + (\s. norm((cf:(int#int#int)->complex) s * + (wf:(int#int#int)->(int#int)->complex) s ap)) + + (sum {s | s IN P /\ tile_le s tau /\ tile_k s < --((a0:(int#int)->int) + ap) /\ + ~(tile_ler s tau)} + (\s. norm(cf s * wf s ap)) + + norm(vsum {s | s IN P /\ tile_ler s tau /\ tile_k s < + --((a0:(int#int)->int) ap)} + (\s. ((w:(int#int#int)->complex) s * cf s) * wf s ap))))` + THEN + CONJ_TAC THENL + [MATCH_MP_TAC VSUM_NORM_LE THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `ap:int#int` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + MP_TAC(ISPECL + [`\s. (w:(int#int#int)->complex) s * cf s`; + `cf:(int#int#int)->complex`; `P:(int#int#int)->bool`; `tau:int#int#int`; + `(a0:(int#int)->int) ap`; + `\s. (wf:(int#int#int)->(int#int)->complex) s ap`] L286_PER_AP_GEN) THEN + ASM_REWRITE_TAC[] THEN + ANTS_TAC THENL + [GEN_TAC THEN REWRITE_TAC[COMPLEX_NORM_MUL] THEN + ASM_REWRITE_TAC[REAL_MUL_LID]; + DISCH_THEN ACCEPT_TAC]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`\(ap:int#int). sum {s | s IN P /\ tile_le s tau /\ --((a0:(int#int)->int) + ap) <= tile_k s} + (\s. norm((cf:(int#int#int)->complex) s * + (wf:(int#int#int)->(int#int)->complex) s ap))`; + `\(ap:int#int). + sum {s | s IN P /\ tile_le s tau /\ tile_k s < --((a0:(int#int)->int) + ap) /\ + ~(tile_ler s tau)} + (\s. norm((cf:(int#int#int)->complex) s * wf s ap)) + + norm(vsum {s | s IN P /\ tile_ler s tau /\ tile_k s < + --((a0:(int#int)->int) ap)} + (\s. ((w:(int#int#int)->complex) s * cf s) * wf s ap))`; + `S:(int#int)->bool`] SUM_ADD) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + MP_TAC(ISPECL + [`\(ap:int#int). sum {s | s IN P /\ tile_le s tau /\ tile_k s < + --((a0:(int#int)->int) ap) /\ + ~(tile_ler s tau)} + (\s. norm((cf:(int#int#int)->complex) s * wf s ap))`; + `\(ap:int#int). norm(vsum {s | s IN P /\ tile_ler s tau /\ tile_k s < + --((a0:(int#int)->int) ap)} + (\s. ((w:(int#int#int)->complex) s * cf s) * wf s ap))`; + `S:(int#int)->bool`] SUM_ADD) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + MATCH_MP_TAC(REAL_ARITH `a <= x /\ b <= y /\ c <= z ==> a + b + c <= x + y + + z`) THEN + ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* CARLESON_286L_FINITE: the finite-cover (post-K2) form of Fremlin 286L. *) +(* The 286L correlation LHS -- with the tile integral over the FULL region *) +(* already expanded as vsum_{ap in S} int_{region cap dyho ap} (K2) -- is *) +(* bounded by C7 * energy * mass * 2^{-kt}. Instantiates *) +(* CARLESON_286L_ABSTRACT *) +(* (cf := carleson_ip f, wf := the cover-cell integral, w from ZETA_REALIFY, *) +(* a0 := FST, B0j := Cj*energy*mass*2^{-kt}), discharging the ANTS: realify *) +(* (ZETA), B01 (W01_BRIDGE), B2 (W2_BRIDGE, after a slice-conjunct reorder *) +(* to *) +(* ~ler-before-tile_k<), B3 (W3_BRIDGE, c = w_s*carleson_ip f s, *) +(* BETA-reduced). *) +(* C7 = Cw + Cv + Cz (the three W-block constants). This is the k-assembly *) +(* endgame: only K1 (infinite-cover -> finite S) remains for the full 286L. *) +(* ------------------------------------------------------------------------- *) +let CARLESON_286L_FINITE = prove + (`?C7. &0 <= C7 /\ + !(f:real->complex) E h (P:(int#int#int)->bool) S kt nt tau. + FINITE P /\ ~(P = {}) /\ tile_k tau = kt /\ + (!s. s IN P ==> tile_le s tau) /\ + real_lebesgue_measurable E /\ h real_measurable_on (:real) /\ + (!s. s IN P ==> tile_I s SUBSET dyho (--kt) nt) /\ + (!t. cw_tile t real_integrable_on {x | x IN E /\ h x IN tile_J t}) /\ + FINITE S /\ (!ap. ap IN S ==> in_kcover P (FST ap) (SND ap)) + ==> sum P (\s. norm(carleson_ip f s * + vsum S (\ap. integral (IMAGE lift + ({x | x IN E /\ h x IN tile_Jr s} INTER dyho + (FST ap) (SND ap))) + (\z. phi_sigma s carleson_phi (drop z))))) + <= C7 * energy_f f P * mass_Eh E h P * &2 zpow (--kt)`, + X_CHOOSE_THEN + `Cw:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "BW01")) W01_BRIDGE THEN + X_CHOOSE_THEN + `Cv:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "BW2")) W2_BRIDGE THEN + X_CHOOSE_THEN + `Cz:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "BW3")) W3_BRIDGE THEN + EXISTS_TAC `Cw + Cv + Cz:real` THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`P:(int#int#int)->bool`; + `\s. carleson_ip (f:real->complex) s * + vsum S (\(ap:int#int). integral (IMAGE lift + ({x | x IN E /\ h x IN tile_Jr s} INTER dyho (FST + ap) (SND ap))) + (\z. phi_sigma s carleson_phi (drop z)))`] + ZETA_REALIFY) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `w:(int#int#int)->complex` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `!s. norm((w:(int#int#int)->complex) s * carleson_ip (f:real->complex) s) = + norm(carleson_ip f s)` + ASSUME_TAC THENL + [GEN_TAC THEN REWRITE_TAC[COMPLEX_NORM_MUL] THEN + ASM_REWRITE_TAC[REAL_MUL_LID]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`carleson_ip (f:real->complex)`; `w:(int#int#int)->complex`; + `\s (ap:int#int). integral (IMAGE lift + ({x | x IN E /\ h x IN tile_Jr s} INTER dyho (FST ap) (SND ap))) + (\z. phi_sigma s carleson_phi (drop z))`; + `P:(int#int#int)->bool`; `S:(int#int)->bool`; `tau:int#int#int`; + `FST:(int#int)->int`; + `Cw * energy_f (f:real->complex) P * mass_Eh E h P * &2 zpow (--kt)`; + `Cv * energy_f (f:real->complex) P * mass_Eh E h P * &2 zpow (--kt)`; + `Cz * energy_f (f:real->complex) P * mass_Eh E h P * &2 zpow (--kt)`] + CARLESON_286L_ABSTRACT) THEN + REWRITE_TAC[] THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [FIRST_ASSUM ACCEPT_TAC; + FIRST_ASSUM ACCEPT_TAC; + FIRST_ASSUM ACCEPT_TAC; + FIRST_ASSUM ACCEPT_TAC; + FIRST_X_ASSUM(fun th -> if is_eq(concl th) && + can (find_term (fun t -> t = `norm:complex->real`)) (rand(concl th)) + then MP_TAC th else NO_TAC) THEN + CONV_TAC(DEPTH_CONV BETA_CONV) THEN REWRITE_TAC[COMPLEX_MUL_ASSOC] THEN + DISCH_THEN ACCEPT_TAC; + USE_THEN "BW01" (MP_TAC o SPECL + [`f:real->complex`; `E:real->bool`; `h:real->real`; + `P:(int#int#int)->bool`; + `S:(int#int)->bool`; `kt:int`; `nt:int`; `tau:int#int#int`]) THEN + ANTS_TAC THENL [REPEAT CONJ_TAC THEN FIRST_ASSUM ACCEPT_TAC; DISCH_THEN + ACCEPT_TAC]; + SUBGOAL_THEN + `!ap:int#int. + {s | s IN P /\ tile_le s tau /\ tile_k s < --(FST ap) /\ ~(tile_ler s + tau)} = + {s:int#int#int | s IN P /\ tile_le s tau /\ ~(tile_ler s tau) /\ + tile_k s < --(FST ap)}` + (fun th -> REWRITE_TAC[th]) THENL + [GEN_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN GEN_TAC THEN + CONV_TAC TAUT; + ALL_TAC] THEN + USE_THEN "BW2" (MP_TAC o SPECL + [`f:real->complex`; `E:real->bool`; `h:real->real`; + `P:(int#int#int)->bool`; + `S:(int#int)->bool`; `kt:int`; `nt:int`; `tau:int#int#int`]) THEN + ANTS_TAC THENL [REPEAT CONJ_TAC THEN FIRST_ASSUM ACCEPT_TAC; DISCH_THEN + ACCEPT_TAC]; + USE_THEN "BW3" (MP_TAC o CONV_RULE(DEPTH_CONV BETA_CONV) o SPECL + [`\s. (w:(int#int#int)->complex) s * carleson_ip (f:real->complex) s`; + `f:real->complex`; `E:real->bool`; `h:real->real`; + `P:(int#int#int)->bool`; + `S:(int#int)->bool`; `kt:int`; `nt:int`; `tau:int#int#int`]) THEN + ANTS_TAC THENL [REPEAT CONJ_TAC THEN FIRST_ASSUM ACCEPT_TAC; DISCH_THEN + ACCEPT_TAC]]; + SUBGOAL_THEN + `(Cw + Cv + Cz) * energy_f (f:real->complex) P * mass_Eh E h P * &2 zpow + (--kt) = + Cw * energy_f f P * mass_Eh E h P * &2 zpow (--kt) + + Cv * energy_f f P * mass_Eh E h P * &2 zpow (--kt) + + Cz * energy_f f P * mass_Eh E h P * &2 zpow (--kt)` + SUBST1_TAC THENL [CONV_TAC REAL_RING; DISCH_THEN ACCEPT_TAC]]);; + +(* ------------------------------------------------------------------------- *) +(* K1: the finite-cover reduction that upgrades CARLESON_286L_FINITE to the *) +(* full-region 286L that 286M consumes. The tile integral over the FULL *) +(* region E cap g^-1[Jr_s] equals the LIMIT of its integrals over the finite *) +(* partial covers UNIONS(enum[0..n]) of the (countable) maximal cover Cal K, *) +(* and each finite-partial-cover integral is the vsum of the piecewise *) +(* integrals over region INTER dyho(cover cell). Passing *) +(* CARLESON_286L_FINITE *) +(* (whose RHS is uniform in the finite S) to the limit then gives the full *) +(* 286L. *) +(* ------------------------------------------------------------------------- *) + +(* Set-algebra helper: IMAGE lift commutes with the region-cover union. *) +let LIFT_REGION_COVER_UNIONS = prove + (`!(region:real->bool) (g:A->real->bool) (Iset:A->bool). + UNIONS {IMAGE lift (region INTER g m) | m IN Iset} = + IMAGE lift (region INTER UNIONS {g m | m IN Iset})`, + REPEAT GEN_TAC THEN REWRITE_TAC[EXTENSION] THEN X_GEN_TAC `z:real^1` THEN + REWRITE_TAC[UNIONS_GSPEC; IN_IMAGE; IN_INTER; IN_ELIM_THM] THEN + MESON_TAC[]);; + +(* K1d: per-sigma, the full-region tile integral is the sequential limit of *) +(* the finite-partial-cover integrals. Via INTEGRAL_COUNTABLE_UNIONS_ALT *) +(* with *) +(* s m = IMAGE lift(region_s INTER dyho(enum m)); the covering hypothesis *) +(* UNIONS(cover) = R collapses region_s INTER R = region_s. *) +let REGION_INTEGRAL_LIMIT = prove + (`!(f:real->complex) E (h:real->real) s enum. + real_lebesgue_measurable E /\ h real_measurable_on (:real) /\ + UNIONS {dyho (FST(enum m)) (SND(enum m)) | m IN (:num)} = (:real) + ==> ((\n. integral (IMAGE lift ({x | x IN E /\ h x IN tile_Jr s} INTER + UNIONS {dyho (FST(enum m)) (SND(enum m)) | m IN 0..n})) + (\z. phi_sigma s carleson_phi (drop z))) + --> integral (IMAGE lift {x | x IN E /\ h x IN tile_Jr s}) + (\z. phi_sigma s carleson_phi (drop z))) sequentially`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`(\z. phi_sigma s carleson_phi (drop z)):real^1->complex`; + `\m. IMAGE lift ({x | x IN E /\ h x IN tile_Jr s} INTER + dyho (FST((enum:num->int#int) m)) (SND(enum m)))`] + INTEGRAL_COUNTABLE_UNIONS_ALT) THEN + REWRITE_TAC[LIFT_REGION_COVER_UNIONS] THEN + ASM_REWRITE_TAC[INTER_UNIV] THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC PHISIG_ABSINT_LEBESGUE THEN + MATCH_MP_TAC REGION_LEBESGUE THEN ASM_REWRITE_TAC[]; + GEN_TAC THEN REWRITE_TAC[GSYM REAL_LEBESGUE_MEASURABLE] THEN + MATCH_MP_TAC REAL_LEBESGUE_MEASURABLE_INTER THEN CONJ_TAC THENL + [MATCH_MP_TAC REGION_LEBESGUE THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_MEASURABLE_IMP_REAL_LEBESGUE_MEASURABLE THEN + REWRITE_TAC[DYHO_MEASURABLE]]]; + DISCH_THEN(ACCEPT_TAC o CONJUNCT2)]);; + +(* Distinct cover cells give disjoint region-pieces (region INTER dyho). *) +let KCOVER_PIECE_DISJOINT = prove + (`!P (region:real->bool) ap aq. + in_kcover P (FST ap) (SND ap) /\ in_kcover P (FST aq) (SND aq) /\ ~(ap = + aq) + ==> (region INTER dyho (FST ap) (SND ap)) INTER + (region INTER dyho (FST aq) (SND aq)) = {}`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `~(dyho (FST(ap:int#int)) (SND ap) = dyho (FST(aq:int#int)) (SND aq))` + ASSUME_TAC THENL + [DISCH_TAC THEN FIRST_X_ASSUM(STRIP_ASSUME_TAC o MATCH_MP DYHO_INJ) THEN + UNDISCH_TAC `~(ap:int#int = aq)` THEN REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[GSYM PAIR] THEN ASM_REWRITE_TAC[PAIR_EQ]; + MP_TAC(ISPECL [`P:(int#int#int)->bool`; `FST(ap:int#int)`; + `FST(aq:int#int)`; + `SND(ap:int#int)`; `SND(aq:int#int)`] KCOVER_DISJOINT) THEN + ASM_REWRITE_TAC[DISJOINT] THEN SET_TAC[]]);; + +(* K1e reindex: the vsum over the IMAGE family collapses (via VSUM_IMAGE_ *) +(* NONZERO) to a vsum over the index set S, because distinct cover pairs *) +(* give disjoint pieces, so any collision forces an empty piece with zero *) +(* integral. *) +let REGION_VSUM_REINDEX = prove + (`!(E:real->bool) (hh:real->real) t (P:(int#int#int)->bool) + (S:(int#int)->bool). + real_lebesgue_measurable E /\ hh real_measurable_on (:real) /\ + FINITE S /\ (!ap. ap IN S ==> in_kcover P (FST ap) (SND ap)) + ==> vsum (IMAGE (\ap. IMAGE lift ({x | x IN E /\ hh x IN tile_Jr t} INTER + dyho (FST ap) (SND ap))) S) + (\s. integral s (\z. phi_sigma t carleson_phi (drop z))) + = vsum S (\ap. integral (IMAGE lift ({x | x IN E /\ hh x IN tile_Jr t} + INTER + dyho (FST ap) (SND ap))) + (\z. phi_sigma t carleson_phi (drop z)))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`\s:real^1->bool. integral s (\z. phi_sigma t carleson_phi (drop z))`; + `\ap. IMAGE lift ({x | x IN E /\ hh x IN tile_Jr t} INTER + dyho (FST ap) (SND ap))`; + `S:(int#int)->bool`] VSUM_IMAGE_NONZERO) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC [`ap:int#int`; `aq:int#int`] THEN + REWRITE_TAC[] THEN STRIP_TAC THEN + SUBGOAL_THEN + `({x | x IN E /\ hh x IN tile_Jr t} INTER dyho (FST(ap:int#int)) (SND ap)) + INTER + ({x | x IN E /\ hh x IN tile_Jr t} INTER dyho (FST(aq:int#int)) (SND aq)) + = {}` + ASSUME_TAC THENL + [MATCH_MP_TAC KCOVER_PIECE_DISJOINT THEN + EXISTS_TAC `P:(int#int#int)->bool` THEN ASM_SIMP_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `{x | x IN E /\ hh x IN tile_Jr t} INTER dyho (FST(ap:int#int)) (SND ap) = + {x | x IN E /\ hh x IN tile_Jr t} INTER dyho (FST(aq:int#int)) (SND aq)` + ASSUME_TAC THENL + [ASM_MESON_TAC[INJECTIVE_IMAGE; LIFT_EQ]; ALL_TAC] THEN + SUBGOAL_THEN + `IMAGE lift ({x | x IN E /\ hh x IN tile_Jr t} INTER dyho + (FST(ap:int#int)) (SND ap)) = {}` + (fun th -> REWRITE_TAC[th; INTEGRAL_EMPTY]) THEN + REWRITE_TAC[IMAGE_EQ_EMPTY] THEN + UNDISCH_TAC + `({x | x IN E /\ hh x IN tile_Jr t} INTER dyho (FST(ap:int#int)) (SND ap)) + INTER + ({x | x IN E /\ hh x IN tile_Jr t} INTER dyho (FST(aq:int#int)) (SND aq)) + = {}` THEN + ASM_REWRITE_TAC[INTER_IDEMPOT] THEN SIMP_TAC[]; + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[o_DEF]]);; + +(* K1e core: over a FINITE cover S of cover pairs, the finite-partial-cover *) +(* tile integral = vsum over S of the piecewise integrals region INTER dyho. *) +(* = INTEGRAL_UNIONS_FINITE_C (finite pairwise-negligible union) + REINDEX. *) +let REGION_FINITE_DECOMP = prove + (`!(E:real->bool) (hh:real->real) t (P:(int#int#int)->bool) + (S:(int#int)->bool). + real_lebesgue_measurable E /\ hh real_measurable_on (:real) /\ + FINITE S /\ (!ap. ap IN S ==> in_kcover P (FST ap) (SND ap)) + ==> integral (IMAGE lift ({x | x IN E /\ hh x IN tile_Jr t} INTER + UNIONS {dyho (FST ap) (SND ap) | ap IN S})) + (\z. phi_sigma t carleson_phi (drop z)) + = vsum S (\ap. integral (IMAGE lift ({x | x IN E /\ hh x IN tile_Jr t} + INTER + dyho (FST ap) (SND ap))) + (\z. phi_sigma t carleson_phi (drop z)))`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[GSYM LIFT_REGION_COVER_UNIONS] THEN + REWRITE_TAC[SIMPLE_IMAGE] THEN + W(MP_TAC o PART_MATCH (lhs o rand) INTEGRAL_UNIONS_FINITE_C o lhs o snd) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[FINITE_IMAGE] THEN CONJ_TAC THENL + [REWRITE_TAC[FORALL_IN_IMAGE] THEN X_GEN_TAC `ap:int#int` THEN + DISCH_TAC THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC PHISIG_ABSINT_LEBESGUE THEN + MATCH_MP_TAC REAL_LEBESGUE_MEASURABLE_INTER THEN CONJ_TAC THENL + [MATCH_MP_TAC REGION_LEBESGUE THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_MEASURABLE_IMP_REAL_LEBESGUE_MEASURABLE THEN + REWRITE_TAC[DYHO_MEASURABLE]]; + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN + X_GEN_TAC `ap:int#int` THEN DISCH_TAC THEN + REWRITE_TAC[FORALL_IN_IMAGE] THEN + X_GEN_TAC `aq:int#int` THEN DISCH_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN `~(ap:int#int = aq)` ASSUME_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `({x | x IN E /\ hh x IN tile_Jr t} INTER dyho (FST(ap:int#int)) (SND + ap)) INTER + ({x | x IN E /\ hh x IN tile_Jr t} INTER dyho (FST(aq:int#int)) (SND + aq)) = {}` + ASSUME_TAC THENL + [MATCH_MP_TAC KCOVER_PIECE_DISJOINT THEN + EXISTS_TAC `P:(int#int#int)->bool` THEN ASM_SIMP_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `IMAGE lift ({x | x IN E /\ hh x IN tile_Jr t} INTER dyho + (FST(ap:int#int)) (SND ap)) INTER + IMAGE lift ({x | x IN E /\ hh x IN tile_Jr t} INTER dyho + (FST(aq:int#int)) (SND aq)) = + IMAGE lift (({x | x IN E /\ hh x IN tile_Jr t} INTER dyho (FST ap) (SND + ap)) INTER + ({x | x IN E /\ hh x IN tile_Jr t} INTER dyho (FST aq) (SND + aq)))` + SUBST1_TAC THENL + [MATCH_MP_TAC(GSYM IMAGE_INTER_INJ) THEN REWRITE_TAC[LIFT_EQ]; + ASM_REWRITE_TAC[IMAGE_CLAUSES; NEGLIGIBLE_EMPTY]]]; + DISCH_THEN SUBST1_TAC THEN + MP_TAC(ISPECL [`E:real->bool`; `hh:real->real`; `t:int#int#int`; + `P:(int#int#int)->bool`; `S:(int#int)->bool`] + REGION_VSUM_REINDEX) THEN + ASM_REWRITE_TAC[]]);; + +(* Limit-inheritance: a sequential limit inherits a uniform upper bound. *) +let SEQ_LE_LIMIT = prove + (`!(gg:num->real) l b. (gg ---> l) sequentially /\ (!n. gg n <= b) ==> l <= + b`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(ISPECL [`sequentially`; `gg:num->real`; `l:real`; `b:real`] + REALLIM_UBOUND) THEN + ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; EVENTUALLY_SEQUENTIALLY] THEN + EXISTS_TAC `0` THEN ASM_SIMP_TAC[]);; + +(* The cover-cell family reindexes cleanly through enum, over any index set *) +(* J. *) +let COVER_ENUM_REINDEX = prove + (`!(enum:num->int#int) (J:num->bool). + {dyho (FST ap) (SND ap) | ap IN IMAGE enum J} = + {dyho (FST(enum m)) (SND(enum m)) | m IN J}`, + REPEAT GEN_TAC THEN REWRITE_TAC[SIMPLE_IMAGE; GSYM IMAGE_o; o_DEF]);; + +(* K1e limit: for finite P, the sum of norms over the finite-partial-cover *) +(* tile *) +(* integrals converges to the sum over the full-region tile integrals. Via *) +(* REALLIM_SUM over P; each summand converges by *) +(* LIM_COMPLEX_LMUL(REGION_INTEGRAL_ *) +(* LIMIT) + LIM_NORM + TENDSTO_REAL. *) +let SUM_NORM_REGION_LIMIT = prove + (`!(cf:(int#int#int)->complex) E (h:real->real) (P:(int#int#int)->bool) enum. + FINITE P /\ + real_lebesgue_measurable E /\ h real_measurable_on (:real) /\ + UNIONS {dyho (FST(enum m)) (SND(enum m)) | m IN (:num)} = (:real) + ==> ((\n. sum P (\s. norm(cf s * + integral (IMAGE lift ({x | x IN E /\ h x IN tile_Jr s} INTER + UNIONS {dyho (FST(enum m)) (SND(enum m)) | m IN 0..n})) + (\z. phi_sigma s carleson_phi (drop z))))) + ---> sum P (\s. norm(cf s * + integral (IMAGE lift {x | x IN E /\ h x IN tile_Jr s}) + (\z. phi_sigma s carleson_phi (drop z))))) sequentially`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REALLIM_SUM THEN + ASM_REWRITE_TAC[] THEN X_GEN_TAC `s:int#int#int` THEN DISCH_TAC THEN + REWRITE_TAC[TENDSTO_REAL; o_DEF] THEN + MATCH_MP_TAC LIM_NORM THEN + MATCH_MP_TAC LIM_COMPLEX_LMUL THEN + MP_TAC(ISPECL [`(\x. Cx(&0)):real->complex`; `E:real->bool`; `h:real->real`; + `s:int#int#int`; + `enum:num->int#int`] REGION_INTEGRAL_LIMIT) THEN + ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* CARLESON_286L (full-region form; Fremlin 286L). The correlation sum over *) +(* the tree P, with the tile integrals taken over the FULL region *) +(* E cap g^-1[Jr_s] (unbounded), is bounded by C7 * energy * mass * 2^{-kt}. *) +(* This is what 286M consumes. Upgrades CARLESON_286L_FINITE (finite S) to *) +(* the infinite maximal cover via the K1 finite-reduction: enumerate the *) +(* cover-index set (COUNTABLE_AS_IMAGE), decompose each full-region integral *) +(* as *) +(* the limit of finite-partial-cover integrals (REGION_INTEGRAL_LIMIT), *) +(* which *) +(* each split as a vsum over the finite cover (REGION_FINITE_DECOMP) bounded *) +(* uniformly by CARLESON_286L_FINITE, and inherit the bound in the limit *) +(* (SEQ_LE_LIMIT + SUM_NORM_REGION_LIMIT). *) +(* ------------------------------------------------------------------------- *) +let CARLESON_286L = prove + (`?C7. &0 <= C7 /\ + !(f:real->complex) E h (P:(int#int#int)->bool) kt nt tau. + FINITE P /\ ~(P = {}) /\ tile_k tau = kt /\ + (!s. s IN P ==> tile_le s tau) /\ + real_lebesgue_measurable E /\ h real_measurable_on (:real) /\ + (!s. s IN P ==> tile_I s SUBSET dyho (--kt) nt) /\ + (!t. cw_tile t real_integrable_on {x | x IN E /\ h x IN tile_J t}) + ==> sum P (\s. norm(carleson_ip f s * + integral (IMAGE lift {x | x IN E /\ h x IN tile_Jr s}) + (\z. phi_sigma s carleson_phi (drop z)))) + <= C7 * energy_f f P * mass_Eh E h P * &2 zpow (--kt)`, + X_CHOOSE_THEN `C7:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "FIN")) + CARLESON_286L_FINITE THEN + EXISTS_TAC `C7:real` THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `~({ap:int#int | in_kcover P (FST ap) (SND ap)} = {})` ASSUME_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + MP_TAC(ISPEC `P:(int#int#int)->bool` KCOVER_EXISTS) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `&0`) THEN + DISCH_THEN(X_CHOOSE_THEN `a:int` (X_CHOOSE_THEN + `q:int` STRIP_ASSUME_TAC)) THEN + EXISTS_TAC `(a:int,q:int)` THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `?enum. {ap:int#int | in_kcover P (FST ap) (SND ap)} = IMAGE enum (:num)` + (X_CHOOSE_TAC `enum:num->int#int`) THENL + [MATCH_MP_TAC COUNTABLE_AS_IMAGE THEN + ASM_REWRITE_TAC[KCOVER_INDEX_COUNTABLE]; ALL_TAC] THEN + SUBGOAL_THEN + `UNIONS {dyho (FST(enum m)) (SND(enum m)) | m IN (:num)} = (:real)` + ASSUME_TAC THENL + [MP_TAC(ISPEC `P:(int#int#int)->bool` KCOVER_UNIONS_UNIV) THEN + ASM_REWRITE_TAC[COVER_ENUM_REINDEX]; + ALL_TAC] THEN + SUBGOAL_THEN + `!m:num. in_kcover P (FST(enum m)) (SND(enum m))` + ASSUME_TAC THENL + [GEN_TAC THEN + UNDISCH_TAC `{ap:int#int | in_kcover P (FST ap) (SND ap)} = IMAGE enum + (:num)` THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE; IN_UNIV] THEN + DISCH_THEN(MP_TAC o SPEC `(enum:num->int#int) m`) THEN + REWRITE_TAC[] THEN DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN + EXISTS_TAC `m:num` THEN REFL_TAC; + ALL_TAC] THEN + MATCH_MP_TAC SEQ_LE_LIMIT THEN + EXISTS_TAC + `\n. sum P (\s. norm(carleson_ip (f:real->complex) s * + integral (IMAGE lift ({x | x IN E /\ h x IN tile_Jr s} INTER + UNIONS {dyho (FST(enum m)) (SND(enum m)) | m IN 0..n})) + (\z. phi_sigma s carleson_phi (drop z))))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_NORM_REGION_LIMIT THEN ASM_REWRITE_TAC[]; + X_GEN_TAC `n:num` THEN REWRITE_TAC[] THEN + SUBGOAL_THEN + `!s:int#int#int. + integral (IMAGE lift ({x | x IN E /\ h x IN tile_Jr s} INTER + UNIONS {dyho (FST(enum m)) (SND(enum m)) | m IN 0..n})) + (\z. phi_sigma s carleson_phi (drop z)) = + vsum (IMAGE enum (0..n)) + (\ap. integral (IMAGE lift ({x | x IN E /\ h x IN tile_Jr s} INTER + dyho (FST ap) (SND ap))) + (\z. phi_sigma s carleson_phi (drop z)))` + (fun th -> REWRITE_TAC[th]) THENL + [GEN_TAC THEN + MP_TAC(ISPECL [`E:real->bool`; `h:real->real`; `s:int#int#int`; + `P:(int#int#int)->bool`; + `IMAGE (enum:num->int#int) (0..n)`] + REGION_FINITE_DECOMP) THEN + REWRITE_TAC[COVER_ENUM_REINDEX] THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG] THEN + REWRITE_TAC[FORALL_IN_IMAGE] THEN ASM_REWRITE_TAC[]; + DISCH_THEN(SUBST1_TAC o SYM) THEN REFL_TAC]; + ALL_TAC] THEN + USE_THEN "FIN" (MP_TAC o SPECL + [`f:real->complex`; `E:real->bool`; `h:real->real`; + `P:(int#int#int)->bool`; + `IMAGE (enum:num->int#int) (0..n)`; `kt:int`; `nt:int`; + `tau:int#int#int`]) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG] THEN + REWRITE_TAC[FORALL_IN_IMAGE] THEN ASM_REWRITE_TAC[]; + DISCH_THEN ACCEPT_TAC]]);; + +(* ========================================================================= *) +(* Fremlin 286M-286V: mass and energy budgets and the analytic endgame. *) +(* ========================================================================= *) + +(* The 286J mass-budget as a predicate on (f,E,h,C5): if mass_Eh E h P <= *) +(* gam^2 *) +(* then a finite R0 removes enough that gam^2 sum_R0 muI <= C5 and the *) +(* residual *) +(* mass mass_Eh(P\R0+) <= gam^2/4. (Fremlin 286J with muE<=1 already *) +(* applied.) *) +let carleson_mass_budget = new_definition + `carleson_mass_budget (f:real->complex) E (h:real->real) C5 <=> + !P gam. FINITE P /\ &0 < gam /\ + (!t. cw_tile t real_integrable_on {x | x IN E /\ h x IN tile_J t}) + /\ + mass_Eh E h P <= gam pow 2 + ==> ?R0. FINITE R0 /\ + gam pow 2 * sum R0 (\t. &2 zpow (--(tile_k t))) <= C5 /\ + (~(P DIFF tile_upset R0 = {}) + ==> mass_Eh E h (P DIFF tile_upset R0) <= gam pow 2 / + &4)`;; + +(* The 286K energy-budget as a predicate on (f,C6): energy_f f P <= gam *) +(* yields a finite R1 with gam^2 sum_R1 muI <= C6 and energy_f(P\R1+) <= *) +(* gam/2. *) +let carleson_energy_budget = new_definition + `carleson_energy_budget (f:real->complex) C6 <=> + !P gam. FINITE P /\ &0 < gam /\ energy_f f P <= gam + ==> ?R1. FINITE R1 /\ + gam pow 2 * sum R1 (\t. &2 zpow (--(tile_k t))) <= C6 /\ + energy_f f (P DIFF tile_upset R1) <= gam / &2`;; + +(* energy of the empty tile-set is 0 (sup of the all-zero index set). *) +let ENERGY_F_EMPTY = prove + (`!f:real->complex. energy_f f {} = &0`, + GEN_TAC THEN REWRITE_TAC[energy_f] THEN + SUBGOAL_THEN `!t:int#int#int. {s | s IN {} /\ tile_ler s t} = {}` + (fun th -> REWRITE_TAC[th]) THENL + [GEN_TAC THEN REWRITE_TAC[NOT_IN_EMPTY; EMPTY_GSPEC]; ALL_TAC] THEN + REWRITE_TAC[SUM_CLAUSES; SQRT_0; REAL_MUL_RZERO] THEN + SUBGOAL_THEN + `{&0 | t:int#int#int | t IN (:int#int#int)} = {&0}` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_SING; IN_UNIV] THEN + GEN_TAC THEN EQ_TAC THENL + [STRIP_TAC THEN ASM_REWRITE_TAC[]; + DISCH_TAC THEN ASM_REWRITE_TAC[] THEN MESON_TAC[]]; + REWRITE_TAC[SUP_SING]]);; + +(* 286M part (a): the single COMBINE step from the two budget predicates. *) +(* Given both budgets, and sqrt(mass) + energy of P both <= gam, produce R *) +(* with the combined budget gam^2 sum_R muI <= C5+C6, energy(P\R+)<=gam/2, *) +(* and (guarded by nonemptiness, since mass_Eh is a sup) *) +(* sqrt(mass(P\R+))<=gam/2. The mass guard dodges the empty-sup: when P\R+ *) +(* empties, the iteration stops. *) +let CARLESON_286M_STEP = prove + (`!(f:real->complex) E (h:real->real) P gam C5 C6. + carleson_mass_budget f E h C5 /\ carleson_energy_budget f C6 /\ + FINITE P /\ &0 < gam /\ + (!t. cw_tile t real_integrable_on {x | x IN E /\ h x IN tile_J t}) /\ + ~(P = {}) /\ + sqrt(mass_Eh E h P) <= gam /\ energy_f f P <= gam + ==> ?R. FINITE R /\ + gam pow 2 * sum R (\t. &2 zpow (--(tile_k t))) <= C5 + C6 /\ + energy_f f (P DIFF tile_upset R) <= gam / &2 /\ + (~(P DIFF tile_upset R = {}) + ==> sqrt(mass_Eh E h (P DIFF tile_upset R)) <= gam / &2)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[carleson_mass_budget; carleson_energy_budget] THEN STRIP_TAC THEN + SUBGOAL_THEN `mass_Eh E h P <= gam pow 2` ASSUME_TAC THENL + [SUBGOAL_THEN `&0 <= mass_Eh E h P` ASSUME_TAC THENL + [MATCH_MP_TAC MASS_EH_POS THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `mass_Eh E h P = sqrt(mass_Eh E h P) pow 2` SUBST1_TAC THENL + [ASM_SIMP_TAC[SQRT_POW_2]; ALL_TAC] THEN + MATCH_MP_TAC REAL_POW_LE2 THEN ASM_SIMP_TAC[SQRT_POS_LE]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`P:(int#int#int)->bool`; `gam:real`] o + check (fun th -> can (find_term (fun t -> t = `mass_Eh`)) (concl th) && + is_forall(concl th))) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `R0:(int#int#int)->bool` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `energy_f (f:real->complex) (P DIFF tile_upset R0) <= gam` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `energy_f (f:real->complex) P` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC ENERGY_MONO THEN ASM_REWRITE_TAC[] THEN + SET_TAC[]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`P DIFF tile_upset R0:(int#int#int)->bool`; + `gam:real`] o + check (fun th -> can (find_term (fun t -> t = `energy_f`)) (concl th) && + is_forall(concl th))) THEN + ASM_SIMP_TAC[FINITE_DIFF] THEN + DISCH_THEN(X_CHOOSE_THEN `R1:(int#int#int)->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `R0 UNION R1:(int#int#int)->bool` THEN + REWRITE_TAC[FINITE_UNION] THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `gam pow 2 * (sum R0 (\t. &2 zpow (--(tile_k t))) + + sum R1 (\t:int#int#int. &2 zpow (--(tile_k t))))` + THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_LE_POW_2]; ALL_TAC] THEN + MATCH_MP_TAC SUM_UNION_LE_POS THEN ASM_REWRITE_TAC[] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_LE_INV_EQ] THEN + MATCH_MP_TAC REAL_ZPOW_LE THEN REAL_ARITH_TAC; + REWRITE_TAC[REAL_ADD_LDISTRIB] THEN MATCH_MP_TAC REAL_LE_ADD2 THEN + ASM_REWRITE_TAC[]]; + ASM_REWRITE_TAC[TILE_UPSET_UNION_DIFF]; + DISCH_TAC THEN + SUBGOAL_THEN `~(P DIFF tile_upset R0 = {})` ASSUME_TAC THENL + [UNDISCH_TAC `~(P DIFF tile_upset (R0 UNION R1) = {})` THEN + REWRITE_TAC[TILE_UPSET_UNION_DIFF] THEN SET_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `mass_Eh E h (P DIFF tile_upset R0) <= gam pow 2 / &4` + ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sqrt(gam pow 2 / &4)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SQRT_MONO_LE THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `mass_Eh E h (P DIFF tile_upset R0)` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MASS_MONO THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[TILE_UPSET_UNION_DIFF] THEN SET_TAC[]; + SUBGOAL_THEN `gam pow 2 / &4 = (gam / &2) pow 2` SUBST1_TAC THENL + [REWRITE_TAC[REAL_POW_DIV] THEN CONV_TAC REAL_FIELD; ALL_TAC] THEN + MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC POW_2_SQRT THEN + ASM_REAL_ARITH_TAC]]);; + +(* tile_I tau is a dyho cell at scale --(tile_k tau) (its spatial index). *) +let TILE_I_AS_DYHO = prove + (`!tau:int#int#int. ?nt. tile_I tau = dyho (--(tile_k tau)) nt`, + MATCH_MP_TAC(MESON[PAIR_SURJECTIVE] + `(!k nI nJ. P ((k,nI,nJ):int#int#int)) ==> (!s. P s)`) THEN + MAP_EVERY X_GEN_TAC [`k:int`;`nI:int`;`nJ:int`] THEN + REWRITE_TAC[tile_I; tile_k] THEN EXISTS_TAC `nI:int` THEN REWRITE_TAC[]);; + +(* 286M part (b), per-tree bound. For the tree T_tau = {sigma in P : *) +(* tile_le sigma tau} (sigma at-or-above tau), the correlation sum is *) +(* <= C7 * energy_f f P * mass_Eh E h P * 2^(-k_tau). *) +(* CARLESON_286L at (f, T_tau, k_tau, nI_tau, tau) bounds by the T_tau *) +(* energy/mass; *) +(* ENERGY_MONO/MASS_MONO (T_tau SUBSET P) lift to P. Empty tree: LHS = 0 <= *) +(* RHS. *) +let CARLESON_286M_TREE = prove + (`?C7. &0 <= C7 /\ + !(f:real->complex) E h (P:(int#int#int)->bool) (tau:int#int#int). + FINITE P /\ ~(P = {}) /\ + real_lebesgue_measurable E /\ h real_measurable_on (:real) /\ + (!t. cw_tile t real_integrable_on {x | x IN E /\ h x IN tile_J t}) + ==> sum {s | s IN P /\ tile_le s tau} + (\s. norm(carleson_ip f s * + integral (IMAGE lift {x | x IN E /\ h x IN tile_Jr s}) + (\z. phi_sigma s carleson_phi (drop z)))) + <= C7 * energy_f f P * mass_Eh E h P * &2 zpow (--(tile_k tau))`, + X_CHOOSE_THEN `C7:real` STRIP_ASSUME_TAC CARLESON_286L THEN + EXISTS_TAC `C7:real` THEN ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC + [`f:real->complex`; `E:real->bool`; `h:real->real`; `P:(int#int#int)->bool`; + `tau:int#int#int`] THEN STRIP_TAC THEN + ABBREV_TAC `Tt = {s:int#int#int | s IN P /\ tile_le s tau}` THEN + SUBGOAL_THEN `FINITE(Tt:(int#int#int)->bool)` ASSUME_TAC THENL + [EXPAND_TAC "Tt" THEN ASM_SIMP_TAC[FINITE_RESTRICT]; ALL_TAC] THEN + SUBGOAL_THEN `(Tt:(int#int#int)->bool) SUBSET P` ASSUME_TAC THENL + [EXPAND_TAC "Tt" THEN SET_TAC[]; ALL_TAC] THEN + ASM_CASES_TAC `Tt:(int#int#int)->bool = {}` THENL + [ASM_REWRITE_TAC[SUM_CLAUSES] THEN + REPEAT(MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC) THENL + [ASM_REWRITE_TAC[]; + ASM_SIMP_TAC[ENERGY_F_POS]; + MATCH_MP_TAC MASS_EH_POS THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LT_IMP_LE THEN MATCH_MP_TAC REAL_ZPOW_LT THEN + REAL_ARITH_TAC]; + ALL_TAC] THEN + X_CHOOSE_TAC `nt:int` (SPEC `tau:int#int#int` TILE_I_AS_DYHO) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `C7 * energy_f f (Tt:(int#int#int)->bool) * mass_Eh E h Tt * + &2 zpow (--(tile_k tau))` THEN + CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPECL + [`f:real->complex`; `E:real->bool`; `h:real->real`; + `Tt:(int#int#int)->bool`; + `tile_k(tau:int#int#int)`; `nt:int`; `tau:int#int#int`] o + check(is_forall o concl)) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [EXPAND_TAC "Tt" THEN REWRITE_TAC[IN_ELIM_THM] THEN SIMP_TAC[]; + X_GEN_TAC `s:int#int#int` THEN EXPAND_TAC "Tt" THEN + REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN + MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `tile_I(tau:int#int#int)` THEN + CONJ_TAC THENL + [UNDISCH_TAC `tile_le (s:int#int#int) tau` THEN + REWRITE_TAC[tile_le] THEN STRIP_TAC THEN ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[SUBSET_REFL]]]; + DISCH_THEN(fun th -> REWRITE_TAC[th])]; + SUBGOAL_THEN + `energy_f f (Tt:(int#int#int)->bool) <= energy_f f P` ASSUME_TAC THENL + [MATCH_MP_TAC ENERGY_MONO THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `mass_Eh E h (Tt:(int#int#int)->bool) <= mass_Eh E h P` ASSUME_TAC THENL + [MATCH_MP_TAC MASS_MONO THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `&0 <= energy_f f (Tt:(int#int#int)->bool)` ASSUME_TAC THENL + [ASM_SIMP_TAC[ENERGY_F_POS]; ALL_TAC] THEN + SUBGOAL_THEN `&0 <= mass_Eh E h (Tt:(int#int#int)->bool)` ASSUME_TAC THENL + [MATCH_MP_TAC MASS_EH_POS THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN MATCH_MP_TAC REAL_ZPOW_LT THEN + REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LE_RMUL THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN MATCH_MP_TAC REAL_ZPOW_LT THEN + REAL_ARITH_TAC]]);; + +(* 286M part (b), single-level bound. The tiles removed at one stopping-time *) +(* level are P cap R+ (= P INTER tile_upset R); their correlation sum is *) +(* <= sum_{tau in R} C7 * energy_f f P * mass_Eh E h P * 2^(-k_tau). *) +(* Cover P cap R+ by the trees {sigma in P : tile_le sigma tau} (tau in R): *) +(* SUM_SUBSET (nonneg, subset) -> SUM_UNIONS_LE_SUM -> SUM_LE + *) +(* CARLESON_286M_TREE. *) +let CARLESON_286M_LEVEL = prove + (`?C7. &0 <= C7 /\ + !(f:real->complex) E h (P:(int#int#int)->bool) R. + FINITE P /\ ~(P = {}) /\ FINITE R /\ + real_lebesgue_measurable E /\ h real_measurable_on (:real) /\ + (!t. cw_tile t real_integrable_on {x | x IN E /\ h x IN tile_J t}) + ==> sum (P INTER tile_upset R) + (\s. norm(carleson_ip f s * + integral (IMAGE lift {x | x IN E /\ h x IN tile_Jr s}) + (\z. phi_sigma s carleson_phi (drop z)))) + <= sum R (\tau. C7 * energy_f f P * mass_Eh E h P * + &2 zpow (--(tile_k tau)))`, + X_CHOOSE_THEN `C7:real` STRIP_ASSUME_TAC CARLESON_286M_TREE THEN + EXISTS_TAC `C7:real` THEN ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC + [`f:real->complex`; `E:real->bool`; `h:real->real`; `P:(int#int#int)->bool`; + `R:(int#int#int)->bool`] THEN + STRIP_TAC THEN + ABBREV_TAC + `phi = \s. norm(carleson_ip (f:real->complex) s * + integral (IMAGE lift {x | x IN E /\ h x IN tile_Jr s}) + (\z. phi_sigma s carleson_phi (drop z)))` THEN + SUBGOAL_THEN `!s:int#int#int. &0 <= phi s` ASSUME_TAC THENL + [EXPAND_TAC "phi" THEN REWRITE_TAC[NORM_POS_LE]; ALL_TAC] THEN + SUBGOAL_THEN + `P INTER tile_upset R SUBSET + UNIONS (IMAGE (\tau. {s:int#int#int | s IN P /\ tile_le s tau}) R)` + ASSUME_TAC THENL + [REWRITE_TAC[SUBSET; IN_INTER; tile_upset; IN_ELIM_THM; IN_UNIONS; + IN_IMAGE] THEN + REPEAT STRIP_TAC THEN + EXISTS_TAC `{s:int#int#int | s IN P /\ tile_le s t}` THEN + CONJ_TAC THENL + [EXISTS_TAC `t:int#int#int` THEN + REWRITE_TAC[]; REWRITE_TAC[IN_ELIM_THM]] THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `FINITE(UNIONS (IMAGE (\tau. {s:int#int#int | s IN P /\ tile_le s tau}) R))` + ASSUME_TAC THENL + [REWRITE_TAC[FINITE_UNIONS; FORALL_IN_IMAGE] THEN + ASM_SIMP_TAC[FINITE_IMAGE; FINITE_RESTRICT]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `sum (UNIONS (IMAGE (\tau. {s:int#int#int | s IN P /\ tile_le s tau}) R)) + (phi:(int#int#int)->real)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_SUBSET THEN REPEAT CONJ_TAC THENL + [ASM_SIMP_TAC[FINITE_INTER]; + ASM_REWRITE_TAC[]; + X_GEN_TAC `x:int#int#int` THEN REWRITE_TAC[IN_DIFF] THEN ASM SET_TAC[]; + X_GEN_TAC `x:int#int#int` THEN DISCH_TAC THEN ASM_REWRITE_TAC[]]; + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `sum R (\tau. sum {s:int#int#int | s IN P /\ tile_le s tau} + (phi:(int#int#int)->real))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_UNIONS_LE_SUM THEN + ASM_SIMP_TAC[FINITE_RESTRICT]; ALL_TAC] THEN + MATCH_MP_TAC SUM_LE THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `tau:int#int#int` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + EXPAND_TAC "phi" THEN ASM_SIMP_TAC[]]);; + +(* 286M part (b): after M stopping-time steps at gam=2^k, the residual P' *) +(* has *) +(* energy/mass down by 2^-M and the removed part is bounded by the geometric *) +(* partial sum. Induction on the step-count M (no explicit sequence). *) +let M286_STEPS = prove + (`?C7. &0 <= C7 /\ + !M (f:real->complex) E h (P:(int#int#int)->bool) C5 C6 k. + carleson_mass_budget f E h C5 /\ carleson_energy_budget f C6 /\ + &0 <= C5 /\ &0 <= C6 /\ FINITE P /\ + (!t. cw_tile t real_integrable_on {x | x IN E /\ h x IN tile_J t}) /\ + real_lebesgue_measurable E /\ h real_measurable_on (:real) /\ + energy_f f P <= &2 pow k /\ sqrt(mass_Eh E h P) <= &2 pow k + ==> ?P'. P' SUBSET P /\ FINITE P' /\ + energy_f f P' <= &2 pow k * inv(&2) pow M /\ + (~(P' = {}) ==> sqrt(mass_Eh E h P') <= &2 pow k * inv(&2) pow + M) /\ + sum (P DIFF P') + (\s. norm(carleson_ip f s * + integral (IMAGE lift {x | x IN E /\ h x IN tile_Jr s}) + (\z. phi_sigma s carleson_phi (drop z)))) + <= C7 * (C5 + C6) * + sum {n | n < M} (\n. min (&2 pow k * inv(&2) pow n) + (inv(&2 pow k) * &2 pow n))`, + X_CHOOSE_THEN `C7:real` STRIP_ASSUME_TAC CARLESON_286M_LEVEL THEN + EXISTS_TAC `C7:real` THEN ASM_REWRITE_TAC[] THEN INDUCT_TAC THENL + [REPEAT STRIP_TAC THEN EXISTS_TAC `P:(int#int#int)->bool` THEN + ASM_REWRITE_TAC[SUBSET_REFL; DIFF_EQ_EMPTY; SUM_CLAUSES; real_pow; + REAL_MUL_RID; CONJUNCT1 LT; EMPTY_GSPEC] THEN + REWRITE_TAC[REAL_MUL_RZERO; REAL_LE_REFL]; + ALL_TAC] THEN + REPEAT GEN_TAC THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`f:real->complex`; `E:real->bool`; `h:real->real`; `P:(int#int#int)->bool`; + `C5:real`; `C6:real`; `k:num`] o + check(fun th -> is_forall(concl th) && + can (find_term (fun tm -> tm = `carleson_mass_budget`)) (concl th))) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `P1:(int#int#int)->bool` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `sum {n | n < SUC M} (\n. min (&2 pow k * inv(&2) pow n) (inv(&2 pow k) * &2 + pow n)) + = sum {n | n < M} (\n. min (&2 pow k * inv(&2) pow n) (inv(&2 pow k) * &2 + pow n)) + + min (&2 pow k * inv(&2) pow M) (inv(&2 pow k) * &2 pow M)` + ASSUME_TAC THENL + [SUBGOAL_THEN `{n | n < SUC M} = M INSERT {n | n < M}` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_INSERT; IN_ELIM_THM] THEN + ARITH_TAC; ALL_TAC] THEN + SIMP_TAC[SUM_CLAUSES; FINITE_NUMSEG_LT; IN_ELIM_THM; LT_REFL] THEN + REWRITE_TAC[REAL_ADD_AC]; ALL_TAC] THEN + SUBGOAL_THEN `&0 <= &2 pow k * inv(&2) pow M` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THEN MATCH_MP_TAC REAL_POW_LE THEN + TRY(MATCH_MP_TAC REAL_LE_INV) THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `&0 <= inv(&2 pow k) * &2 pow M` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THEN + TRY(MATCH_MP_TAC REAL_LE_INV) THEN MATCH_MP_TAC REAL_POW_LE THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `&0 <= min (&2 pow k * inv(&2) pow M) (inv(&2 pow k) * &2 pow M)` + ASSUME_TAC THENL [ASM_REWRITE_TAC[REAL_LE_MIN]; ALL_TAC] THEN + SUBGOAL_THEN + `&2 pow k * inv(&2) pow (SUC M) = (&2 pow k * inv(&2) pow M) / &2` + ASSUME_TAC THENL + [REWRITE_TAC[real_pow] THEN CONV_TAC REAL_FIELD; ALL_TAC] THEN + ASM_CASES_TAC `P1:(int#int#int)->bool = {}` THENL + [(* P1 = {} : residual empty, removed part = P DIFF P1, extra term nonneg *) + EXISTS_TAC `P1:(int#int#int)->bool` THEN + ASM_REWRITE_TAC[EMPTY_SUBSET; FINITE_EMPTY] THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[ENERGY_F_EMPTY] THEN + MATCH_MP_TAC REAL_LE_DIV THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `C7 * (C5 + C6) * + sum {n | n < M} (\n. min (&2 pow k * inv(&2) pow n) (inv(&2 pow k) * &2 + pow n))` THEN + CONJ_TAC THENL + [FIRST_X_ASSUM(fun th -> if is_imp(concl th) then ALL_TAC else NO_TAC) + THEN + UNDISCH_TAC `sum (P DIFF P1) + (\s. norm(carleson_ip f s * + integral (IMAGE lift {x | x IN E /\ h x IN tile_Jr s}) + (\z. phi_sigma s carleson_phi (drop z)))) + <= C7 * (C5 + C6) * + sum {n | n < M} (\n. min (&2 pow k * inv(&2) pow n) (inv(&2 pow k) + * &2 pow n))` THEN + ASM_REWRITE_TAC[DIFF_EMPTY]; + REWRITE_TAC[REAL_ADD_LDISTRIB] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= e ==> x <= x + e`) THEN + MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC[REAL_LE_ADD]]]; + (* P1 nonempty : apply STEP at gam = 2^k (1/2)^M *) + SUBGOAL_THEN + `sqrt(mass_Eh E h P1) <= &2 pow k * inv(&2) pow M` ASSUME_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o check(fun th -> is_imp(concl th) && + can (find_term (fun tm -> tm = `mass_Eh`)) (concl th))) THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `&0 < &2 pow k * inv(&2) pow M` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LT_MUL THEN REWRITE_TAC[REAL_LT_POW2] THEN + MATCH_MP_TAC REAL_POW_LT THEN MATCH_MP_TAC REAL_LT_INV THEN REAL_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(ISPECL + [`f:real->complex`; `E:real->bool`; `h:real->real`; + `P1:(int#int#int)->bool`; + `&2 pow k * inv(&2) pow M`; `C5:real`; `C6:real`] CARLESON_286M_STEP) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `R:(int#int#int)->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `P1 DIFF tile_upset R:(int#int#int)->bool` THEN + SUBGOAL_THEN + `(P1 DIFF tile_upset R:(int#int#int)->bool) SUBSET P` ASSUME_TAC THENL + [MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `P1:(int#int#int)->bool` THEN + ASM_REWRITE_TAC[] THEN SET_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `FINITE(P1 DIFF tile_upset R:(int#int#int)->bool)` ASSUME_TAC THENL + [MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `P:(int#int#int)->bool` THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `P DIFF (P1 DIFF tile_upset R) = + (P DIFF P1) UNION (P1 INTER tile_upset R)` SUBST1_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + W(MP_TAC o PART_MATCH (lhand o rand) SUM_UNION o lhand o snd) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[FINITE_DIFF; FINITE_INTER] THEN + REWRITE_TAC[DISJOINT] THEN ASM SET_TAC[]; ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[REAL_ADD_LDISTRIB] THEN + MATCH_MP_TAC REAL_LE_ADD2 THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum R (\tau. C7 * energy_f f P1 * mass_Eh E h P1 * + &2 zpow (--(tile_k tau)))` THEN + CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPECL + [`f:real->complex`; `E:real->bool`; `h:real->real`; + `P1:(int#int#int)->bool`; + `R:(int#int#int)->bool`] o + check(fun th -> is_forall(concl th) && + can (find_term (fun tm -> tm = `tile_upset`)) (concl th))) THEN + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUM_LMUL] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `C7 * ((C5 + C6) * min (inv(&2 pow k * inv(&2) pow M)) + (&2 pow k * inv(&2) pow M))` THEN + CONJ_TAC THENL + [REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THEN + TRY(FIRST_ASSUM ACCEPT_TAC) THEN + MATCH_MP_TAC LEVEL_PROD_BOUND THEN REPEAT CONJ_TAC THENL + [ASM_SIMP_TAC[ENERGY_F_POS]; + MATCH_MP_TAC MASS_EH_POS THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC SUM_POS_LE THEN REWRITE_TAC[REAL_LE_INV_EQ] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_ZPOW_LE THEN REAL_ARITH_TAC; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC MASS_LE_1 THEN ASM_REWRITE_TAC[]; + SUBGOAL_THEN + `mass_Eh E h P1 = sqrt(mass_Eh E h P1) pow 2` SUBST1_TAC THENL + [MATCH_MP_TAC(GSYM SQRT_POW_2) THEN MATCH_MP_TAC MASS_EH_POS THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC REAL_POW_LE2 THEN CONJ_TAC THENL + [MATCH_MP_TAC SQRT_POS_LE THEN MATCH_MP_TAC MASS_EH_POS THEN + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]]; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]]; + SUBGOAL_THEN + `min (inv (&2 pow k * inv (&2) pow M)) (&2 pow k * inv (&2) pow M) = + min (&2 pow k * inv (&2) pow M) (inv (&2 pow k) * &2 pow M)` + SUBST1_TAC THENL + [GEN_REWRITE_TAC (RAND_CONV) [REAL_MIN_SYM] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[REAL_INV_MUL; REAL_INV_INV; GSYM REAL_POW_INV; + REAL_INV_POW]; + REWRITE_TAC[REAL_LE_REFL]]]]]);; + + +(* Archimedean choice for the 286M finish: for finite P, eventually *) +(* 2^k(1/2)^M *) +(* is below energy_f f {sigma} for EVERY nonzero-coefficient sigma in P *) +(* (there *) +(* are finitely many, with a positive minimum energy). Feeds the finish: the *) +(* M-step residual then has all coefficients zero, so its correlation sum is *) +(* 0. *) +let M286_ARCH = prove + (`!(f:real->complex) (P:(int#int#int)->bool) k. + FINITE P + ==> ?M. !s. s IN P /\ ~(carleson_ip f s = Cx(&0)) + ==> &2 pow k * inv(&2) pow M < energy_f f {s}`, + REPEAT STRIP_TAC THEN + ABBREV_TAC `Pnz = {s:int#int#int | s IN P /\ ~(carleson_ip f s = Cx(&0))}` + THEN + SUBGOAL_THEN `FINITE(Pnz:(int#int#int)->bool)` ASSUME_TAC THENL + [EXPAND_TAC "Pnz" THEN ASM_SIMP_TAC[FINITE_RESTRICT]; ALL_TAC] THEN + ASM_CASES_TAC `Pnz:(int#int#int)->bool = {}` THENL + [EXISTS_TAC `0` THEN X_GEN_TAC `s:int#int#int` THEN + UNDISCH_TAC `Pnz:(int#int#int)->bool = {}` THEN EXPAND_TAC "Pnz" THEN + REWRITE_TAC[EXTENSION; NOT_IN_EMPTY; IN_ELIM_THM] THEN + DISCH_THEN(MP_TAC o SPEC `s:int#int#int`) THEN MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `!s. s IN Pnz ==> &0 < energy_f (f:real->complex) {s}` ASSUME_TAC THENL + [X_GEN_TAC `s:int#int#int` THEN EXPAND_TAC "Pnz" THEN + REWRITE_TAC[IN_ELIM_THM] THEN + STRIP_TAC THEN REWRITE_TAC[ENERGY_SING] THEN MATCH_MP_TAC REAL_LT_MUL THEN + CONJ_TAC THENL + [MATCH_MP_TAC SQRT_POS_LT THEN MATCH_MP_TAC REAL_ZPOW_LT THEN + REAL_ARITH_TAC; + REWRITE_TAC[NORM_POS_LT; COMPLEX_VEC_0] THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + ABBREV_TAC `e0 = inf (IMAGE (\s. energy_f (f:real->complex) {s}) Pnz)` THEN + SUBGOAL_THEN `&0 < e0` ASSUME_TAC THENL + [EXPAND_TAC "e0" THEN + MP_TAC(ISPEC `IMAGE (\s. energy_f (f:real->complex) {s}) Pnz` INF_FINITE) + THEN + ASM_SIMP_TAC[FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN + DISCH_THEN(MP_TAC o CONJUNCT1) THEN REWRITE_TAC[IN_IMAGE] THEN + DISCH_THEN(X_CHOOSE_THEN `s0:int#int#int` STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MP_TAC(SPEC `&2 pow k / e0` REAL_ARCH_POW2) THEN + DISCH_THEN(X_CHOOSE_TAC `M:num`) THEN EXISTS_TAC `M:num` THEN + X_GEN_TAC `s:int#int#int` THEN STRIP_TAC THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `e0:real` THEN CONJ_TAC THENL + [SUBGOAL_THEN `&0 < &2 pow M` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_POW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `&2 pow k * inv(&2) pow M = &2 pow k / &2 pow M` SUBST1_TAC THENL + [REWRITE_TAC[real_div; REAL_POW_INV]; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LT_LDIV_EQ] THEN + UNDISCH_TAC `&2 pow k / e0 < &2 pow M` THEN + ASM_SIMP_TAC[REAL_LT_LDIV_EQ] THEN REAL_ARITH_TAC; + EXPAND_TAC "e0" THEN + MP_TAC(ISPEC `IMAGE (\s. energy_f (f:real->complex) {s}) Pnz` INF_FINITE) + THEN + ASM_SIMP_TAC[FINITE_IMAGE; IMAGE_EQ_EMPTY] THEN + DISCH_THEN(MP_TAC o CONJUNCT2) THEN REWRITE_TAC[FORALL_IN_IMAGE] THEN + DISCH_THEN MATCH_MP_TAC THEN + UNDISCH_TAC `{s:int#int#int | s IN P /\ ~(carleson_ip f s = Cx(&0))} = Pnz` + THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[IN_ELIM_THM] THEN + ASM_REWRITE_TAC[]]);; + +(* CARLESON_286M for finite P: sum over P of |* int| <= C8*(C5+C6), *) +(* C8=4C7. M286_STEPS after M steps + M286_ARCH pick M so residual coeffs *) +(* all vanish (sum_{P'}=0) + TWO_SIDED_MIN_GEOM bounds the geometric partial *) +(* sum by 4. *) +let CARLESON_286M_FINITE = prove + (`?C8. &0 <= C8 /\ + !(f:real->complex) E h (P:(int#int#int)->bool) C5 C6 k. + carleson_mass_budget f E h C5 /\ carleson_energy_budget f C6 /\ + &0 <= C5 /\ &0 <= C6 /\ FINITE P /\ + (!t. cw_tile t real_integrable_on {x | x IN E /\ h x IN tile_J t}) /\ + real_lebesgue_measurable E /\ h real_measurable_on (:real) /\ + energy_f f P <= &2 pow k /\ sqrt(mass_Eh E h P) <= &2 pow k + ==> sum P (\s. norm(carleson_ip f s * + integral (IMAGE lift {x | x IN E /\ h x IN tile_Jr s}) + (\z. phi_sigma s carleson_phi (drop z)))) + <= C8 * (C5 + C6)`, + X_CHOOSE_THEN `C7:real` STRIP_ASSUME_TAC M286_STEPS THEN + EXISTS_TAC `&4 * C7` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[] THEN + REAL_ARITH_TAC; ALL_TAC] THEN + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:real->complex`; `P:(int#int#int)->bool`; + `k:num`] M286_ARCH) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `M:num`) THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`M:num`; `f:real->complex`; `E:real->bool`; `h:real->real`; + `P:(int#int#int)->bool`; + `C5:real`; `C6:real`; `k:num`] o check(is_forall o concl)) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `P':(int#int#int)->bool` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `sum P' (\s. norm(carleson_ip (f:real->complex) s * + integral (IMAGE lift {x | x IN E /\ h x IN tile_Jr s}) + (\z. phi_sigma s carleson_phi (drop z)))) = &0` + ASSUME_TAC THENL + [MATCH_MP_TAC SUM_EQ_0 THEN X_GEN_TAC `s:int#int#int` THEN DISCH_TAC THEN + BETA_TAC THEN + SUBGOAL_THEN `carleson_ip (f:real->complex) s = Cx(&0)` + (fun th -> REWRITE_TAC[th; COMPLEX_MUL_LZERO; COMPLEX_NORM_0]) THEN + REWRITE_TAC[GSYM COMPLEX_NORM_ZERO] THEN + MATCH_MP_TAC(REAL_ARITH `~(&0 < n) /\ &0 <= n ==> n = &0`) THEN + REWRITE_TAC[NORM_POS_LE] THEN DISCH_TAC THEN + SUBGOAL_THEN + `&2 pow k * inv(&2) pow M < energy_f (f:real->complex) {s}` MP_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o check(fun th -> is_forall(concl th) && + can (find_term (fun tm -> tm = `energy_f`)) (concl th))) THEN + CONJ_TAC THENL + [ASM_MESON_TAC[SUBSET]; + REWRITE_TAC[GSYM COMPLEX_NORM_ZERO] THEN ASM_REAL_ARITH_TAC]; + SUBGOAL_THEN + `energy_f (f:real->complex) {s} <= energy_f f P'` MP_TAC THENL + [MATCH_MP_TAC ENERGY_MONO THEN + ASM_REWRITE_TAC[SING_SUBSET]; ALL_TAC] THEN + ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN `P = (P DIFF P') UNION P':(int#int#int)->bool` SUBST1_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + W(MP_TAC o PART_MATCH (lhand o rand) SUM_UNION o lhand o snd) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[FINITE_DIFF] THEN REWRITE_TAC[DISJOINT] THEN SET_TAC[]; + ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN + ASM_REWRITE_TAC[REAL_ADD_RID] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `C7 * (C5 + C6) * + sum {n | n < M} (\n. min (&2 pow k * inv(&2) pow n) (inv(&2 pow k) * &2 pow + n))` THEN + CONJ_TAC THENL + [FIRST_ASSUM ACCEPT_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `sum {n | n < M} (\n. min (&2 pow k * inv(&2) pow n) (inv(&2 pow k) * &2 pow + n)) + <= &4` + ASSUME_TAC THENL + [MATCH_MP_TAC TWO_SIDED_MIN_GEOM THEN + REWRITE_TAC[FINITE_NUMSEG_LT]; ALL_TAC] THEN + SUBGOAL_THEN `(&4 * C7) * (C5 + C6) = (C7 * (C5 + C6)) * &4` SUBST1_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + ASM_REWRITE_TAC[]]);; + +(* 286M part (c): the Lacey-Thiele lemma for the FULL tile set. For any *) +(* finite *) +(* P (whence for the whole countable Q, taking sups), the correlation sum is *) +(* <= C8*(C5+C6) -- no energy/mass normalization hypothesis: each finite P *) +(* picks *) +(* its own k with energy_f f P <= 2^k and sqrt(mass_Eh E h P) <= 2^k (energy *) +(* is *) +(* finite by ENERGY_LE, mass <= 1 by MASS_LE_1, so REAL_ARCH_POW2 supplies *) +(* k). *) +let CARLESON_286M = prove + (`?C8. &0 <= C8 /\ + !(f:real->complex) E h (P:(int#int#int)->bool) C5 C6. + carleson_mass_budget f E h C5 /\ carleson_energy_budget f C6 /\ + &0 <= C5 /\ &0 <= C6 /\ FINITE P /\ + (!t. cw_tile t real_integrable_on {x | x IN E /\ h x IN tile_J t}) /\ + real_lebesgue_measurable E /\ h real_measurable_on (:real) + ==> sum P (\s. norm(carleson_ip f s * + integral (IMAGE lift {x | x IN E /\ h x IN tile_Jr s}) + (\z. phi_sigma s carleson_phi (drop z)))) + <= C8 * (C5 + C6)`, + X_CHOOSE_THEN `C8:real` STRIP_ASSUME_TAC CARLESON_286M_FINITE THEN + EXISTS_TAC `C8:real` THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + ASM_CASES_TAC `P:(int#int#int)->bool = {}` THENL + [ASM_REWRITE_TAC[SUM_CLAUSES] THEN MATCH_MP_TAC REAL_LE_MUL THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `?k:num. energy_f (f:real->complex) P <= &2 pow k /\ + sqrt(mass_Eh E h P) <= &2 pow k` STRIP_ASSUME_TAC THENL + [MP_TAC(SPEC `energy_f (f:real->complex) P + sqrt(mass_Eh E h P)` + REAL_ARCH_POW2) THEN + DISCH_THEN(X_CHOOSE_TAC `k:num`) THEN EXISTS_TAC `k:num` THEN + SUBGOAL_THEN `&0 <= energy_f (f:real->complex) P` ASSUME_TAC THENL + [ASM_SIMP_TAC[ENERGY_F_POS]; ALL_TAC] THEN + SUBGOAL_THEN `&0 <= sqrt(mass_Eh E h P)` ASSUME_TAC THENL + [MATCH_MP_TAC SQRT_POS_LE THEN MATCH_MP_TAC MASS_EH_POS THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`f:real->complex`; `E:real->bool`; `h:real->real`; `P:(int#int#int)->bool`; + `C5:real`; `C6:real`; `k:num`] o check(is_forall o concl)) THEN + ASM_REWRITE_TAC[]);; + +(* ========================================================================= *) +(* 286N (Fremlin): drop the muE<=1, ||f||=1 normalization from 286M via the *) +(* dilation sigma |-> sigma* = (k_sigma+kk, nI, nJ). Foundational pieces. *) +(* ========================================================================= *) + +(* Tile-star scaling arithmetic: sigma* = (k+kk, nI, nJ) shifts the scale by *) +(* kk, dilating the spatial midpoint by 2^-kk and the frequency midpoint by *) +(* 2^kk (and mJ = 2^k by 2^kk). *) +let STARARITH = prove + (`!(kk:int) k nI nJ. + &2 zpow (tile_k (k + kk, nI, nJ)) = &2 zpow kk * &2 zpow (tile_k(k,nI,nJ)) + /\ + tile_xmid (k + kk, nI, nJ) = &2 zpow (--kk) * tile_xmid(k,nI,nJ) /\ + tile_ymid (k + kk, nI, nJ) = &2 zpow kk * tile_ymid(k,nI,nJ)`, + REPEAT GEN_TAC THEN REWRITE_TAC[tile_k; tile_xmid; tile_ymid; dyho_mid] THEN + SUBGOAL_THEN + `&2 zpow (k + kk) = &2 zpow kk * &2 zpow k /\ + &2 zpow (--(k + kk)) = &2 zpow (--kk) * &2 zpow (--k) /\ + &2 zpow ((k + kk) - &1) = &2 zpow kk * &2 zpow (k - &1)` + STRIP_ASSUME_TAC THENL + [SIMP_TAC[GSYM REAL_ZPOW_ADD; REAL_OF_NUM_EQ; ARITH_EQ] THEN + REPEAT CONJ_TAC THEN AP_TERM_TAC THEN INT_ARITH_TAC; + ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_MUL_AC]]);; + +(* Two REAL_FIELD arithmetic facts (universally quantified so MATCH_MP_TAC *) +(* can instantiate them to the abbreviated local constants). *) +let ARGEQ_LEMMA = prove + (`!A B M x x0. A * B = &1 /\ &0 < A + ==> (A * M) * (x - B * x0):real = M * (A * x - x0)`, + REPEAT GEN_TAC THEN CONV_TAC REAL_FIELD);; + +let SQRTEQ_LEMMA = prove + (`!A B M. A * B = &1 /\ &0 < A ==> M:real = B * (A * M)`, + REPEAT GEN_TAC THEN CONV_TAC REAL_FIELD);; + +(* The phi dilation identity (Fremlin 286N core): phi_sigma(2^kk x) = *) +(* 2^{-kk/2} phi_{sigma*}(x) where sigma* = (k+kk, nI, nJ). *) +let PHISIG_DILATE = prove + (`!(phi:real->complex) kk k nI nJ x. + phi_sigma (k,nI,nJ) phi (&2 zpow kk * x) = + Cx(sqrt(&2 zpow (--kk))) * phi_sigma (k + kk, nI, nJ) phi x`, + REPEAT GEN_TAC THEN REWRITE_TAC[phi_sigma; phimst] THEN + MP_TAC(SPECL [`kk:int`;`k:int`;`nI:int`;`nJ:int`] STARARITH) THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + ABBREV_TAC `A = &2 zpow kk` THEN ABBREV_TAC `B = &2 zpow (--kk)` THEN + ABBREV_TAC `M = &2 zpow (tile_k(k,nI,nJ))` THEN + ABBREV_TAC `y0 = tile_ymid(k,nI,nJ)` THEN + ABBREV_TAC `x0 = tile_xmid(k,nI,nJ)` THEN + SUBGOAL_THEN `&0 < A /\ &0 < B` STRIP_ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["A"; "B"] THEN CONJ_TAC THEN + MATCH_MP_TAC REAL_ZPOW_LT THEN + REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `A * B = &1` ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["A"; "B"] THEN + SIMP_TAC[GSYM REAL_ZPOW_ADD; REAL_OF_NUM_EQ; ARITH_EQ; INT_ADD_RINV; + REAL_ZPOW_0]; + ALL_TAC] THEN + SUBGOAL_THEN + `(A * M) * (x - B * x0):real = M * (A * x - x0)` SUBST1_TAC THENL + [MATCH_MP_TAC ARGEQ_LEMMA THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `sqrt M = sqrt B * sqrt(A * M)` SUBST1_TAC THENL + [REWRITE_TAC[GSYM SQRT_MUL] THEN AP_TERM_TAC THEN + MATCH_MP_TAC SQRTEQ_LEMMA THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `Cx(A * y0) * Cx x = Cx y0 * Cx(A * x)` SUBST1_TAC THENL + [REWRITE_TAC[GSYM CX_MUL] THEN AP_TERM_TAC THEN + REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[CX_MUL; COMPLEX_MUL_AC]);; + +(* ========================================================================= *) +(* 286N dilation infrastructure (Fremlin 286N: drop muE<=1, ||f||=1 via the *) +(* tile permutation sigma|->sigma* + the L^2 dilation *) +(* ftilde(x)=2^{kk/2}f(2^{kk}x)). *) +(* ========================================================================= *) + +(* Measurability preserved under affine reparametrization on the line. The *) +(* approximating sequence g_n(cz+b) is continuous and converges off the *) +(* affine *) +(* preimage of the negligible exceptional set (negligible: linear image + *) +(* translation). *) +let MEASURABLE_ON_DILATE = prove + (`!(f:real^1->real^N) c b. ~(c = &0) /\ f measurable_on (:real^1) + ==> (\z. f(c % z + b)) measurable_on (:real^1)`, + REPEAT GEN_TAC THEN REWRITE_TAC[measurable_on; IN_UNIV] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (X_CHOOSE_THEN `k:real^1->bool` (X_CHOOSE_THEN `g:num->real^1->real^N` + STRIP_ASSUME_TAC))) THEN + EXISTS_TAC `IMAGE (\z:real^1. inv c % (z - b)) k` THEN + EXISTS_TAC `\n z. (g:num->real^1->real^N) n (c % z + b)` THEN + REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [SUBGOAL_THEN + `(\z:real^1. inv c % (z - b)) = + (\y. (--(inv c % b)) + y) o (\z. inv c % z)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; o_THM] THEN GEN_TAC THEN + REWRITE_TAC[VECTOR_SUB_LDISTRIB] THEN VECTOR_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[IMAGE_o] THEN MATCH_MP_TAC NEGLIGIBLE_TRANSLATION THEN + MATCH_MP_TAC NEGLIGIBLE_LINEAR_IMAGE THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[linear] THEN CONJ_TAC THEN VECTOR_ARITH_TAC; + GEN_TAC THEN + SUBGOAL_THEN + `(\z:real^1. g (n:num) (c % z + b)) = + (g n:real^1->real^N) o (\z. c % z + b)` + SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM; o_THM]; ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL + [SIMP_TAC[CONTINUOUS_ON_ADD; CONTINUOUS_ON_CMUL; CONTINUOUS_ON_ID; + CONTINUOUS_ON_CONST]; + ASM_MESON_TAC[CONTINUOUS_ON_SUBSET; SUBSET_UNIV]]; + X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `c % x + b:real^1`) THEN + ANTS_TAC THENL + [DISCH_TAC THEN + UNDISCH_TAC `~(x IN IMAGE (\z:real^1. inv c % (z - b)) k)` THEN + REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `c % x + b:real^1` THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `inv c % ((c % x + b) - b):real^1 = (inv c * c) % x` SUBST1_TAC THENL + [VECTOR_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_MUL_LINV; VECTOR_MUL_LID]; + REWRITE_TAC[]]]);; + +(* The normalized dilate has the same L^2 norm-square integral (Jacobian *) +(* 2^{-kk} cancels the sqrt(c)^2 = c prefactor). *) +let L2_DILATE_NORMSQ = prove + (`!(ff:real^1->complex) c. &0 < c /\ + (\z. lift(norm(ff z) pow 2)) integrable_on (:real^1) + ==> integral (:real^1) + (\z. lift(norm(Cx(sqrt c) * ff(c % z)) pow 2)) = + integral (:real^1) (\z. lift(norm(ff z) pow 2))`, + REPEAT STRIP_TAC THEN + ABBREV_TAC `gg = \z:real^1. lift(norm((ff:real^1->complex) z) pow 2)` THEN + SUBGOAL_THEN + `(\z:real^1. lift(norm(Cx(sqrt c) * (ff:real^1->complex)(c % z)) pow 2)) = + (\z. c % (gg:real^1->real^1) (c % z + vec 0))` + SUBST1_TAC THENL + [EXPAND_TAC "gg" THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `z:real^1` THEN + REWRITE_TAC[VECTOR_ADD_RID] THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX; REAL_POW_MUL] THEN + REWRITE_TAC[GSYM LIFT_CMUL] THEN AP_TERM_TAC THEN + SUBGOAL_THEN `abs(sqrt c) pow 2 = c` SUBST1_TAC THENL + [REWRITE_TAC[REAL_POW2_ABS] THEN MATCH_MP_TAC SQRT_POW_2 THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN `(gg:real^1->real^1) integrable_on (:real^1)` ASSUME_TAC THENL + [EXPAND_TAC "gg" THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_SIMP_TAC[INTEGRAL_CMUL; INTEGRABLE_DILATE_UNIV; REAL_LT_IMP_NZ] THEN + ASM_SIMP_TAC[INTEGRAL_DILATE_UNIV; REAL_LT_IMP_NZ] THEN + REWRITE_TAC[VECTOR_MUL_ASSOC] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < c ==> abs c = c`; REAL_MUL_RINV; + REAL_LT_IMP_NZ; + VECTOR_MUL_LID]);; + +(* Hence the normalized dilate stays in L^2. *) +let L2_DILATE_LSPACE = prove + (`!(ff:real^1->complex) c. &0 < c /\ ff IN lspace (:real^1) (&2) + ==> (\z. Cx(sqrt c) * ff(c % z)) IN lspace (:real^1) (&2)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[lspace; IN_ELIM_THM] THEN + RULE_ASSUM_TAC(REWRITE_RULE[lspace; IN_ELIM_THM; RPOW_POW]) THEN + FIRST_X_ASSUM(CONJUNCTS_THEN ASSUME_TAC) THEN CONJ_TAC THENL + [MP_TAC(ISPECL [`\z:real^1. Cx(sqrt c)`; + `\z:real^1. (ff:real^1->complex)(c % z)`; + `(:real^1)`] MEASURABLE_ON_COMPLEX_MUL) THEN + REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + REWRITE_TAC[MEASURABLE_ON_CONST] THEN + SUBGOAL_THEN + `(\z:real^1. (ff:real^1->complex)(c % z)) = (\z. ff(c % z + vec 0))` + SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM; VECTOR_ADD_RID]; ALL_TAC] THEN + MATCH_MP_TAC MEASURABLE_ON_DILATE THEN ASM_SIMP_TAC[REAL_LT_IMP_NZ]; + REWRITE_TAC[RPOW_POW] THEN + SUBGOAL_THEN + `(\z:real^1. lift(norm(Cx(sqrt c) * (ff:real^1->complex)(c % z)) pow 2)) = + (\z. c % (\w. lift(norm(ff w) pow 2)) (c % z + vec 0))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `z:real^1` THEN + REWRITE_TAC[VECTOR_ADD_RID; COMPLEX_NORM_MUL; COMPLEX_NORM_CX; + REAL_POW_MUL] THEN + REWRITE_TAC[GSYM LIFT_CMUL] THEN AP_TERM_TAC THEN + SUBGOAL_THEN `abs(sqrt c) pow 2 = c` SUBST1_TAC THENL + [REWRITE_TAC[REAL_POW2_ABS] THEN MATCH_MP_TAC SQRT_POW_2 THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[]]; + ALL_TAC] THEN + MATCH_MP_TAC INTEGRABLE_CMUL THEN MATCH_MP_TAC INTEGRABLE_DILATE_UNIV THEN + ASM_SIMP_TAC[REAL_LT_IMP_NZ]]);; + +(* ========================================================================= *) +(* 286N core: the Carleson coefficient is dilation-invariant under the tile *) +(* permutation sigma |-> sigma* = (k+kk, nI, nJ) paired with the L^2 *) +(* dilation *) +(* ftilde(x) = 2^{kk/2} f(2^{kk} x): (f | phi_sigma) = (ftilde | *) +(* phi_sigstar). *) +(* ========================================================================= *) + +(* scalar Jacobian identity: 2^{kk} * sqrt(2^{-kk}) = sqrt(2^{kk}). Both *) +(* sides *) +(* nonneg with equal squares (2^kk)^2 2^-kk = 2^kk (uses 2^kk 2^-kk = 1). *) +let ZPOW_JAC_SQRT = prove + (`!kk:int. &2 zpow kk * sqrt(&2 zpow (--kk)) = sqrt(&2 zpow kk)`, + GEN_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SQRT_UNIQUE THEN + SUBGOAL_THEN `&0 < &2 zpow kk /\ &0 < &2 zpow (--kk)` STRIP_ASSUME_TAC THENL + [CONJ_TAC THEN MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE; SQRT_POS_LE]; + REWRITE_TAC[REAL_POW_MUL] THEN + ASM_SIMP_TAC[SQRT_POW_2; REAL_LT_IMP_LE] THEN + SUBGOAL_THEN `&2 zpow kk * &2 zpow (--kk) = &1` (fun th -> MP_TAC th) THENL + [SIMP_TAC[GSYM REAL_ZPOW_ADD; REAL_OF_NUM_EQ; ARITH_EQ; INT_ADD_RINV; + REAL_ZPOW_0]; + CONV_TAC REAL_RING]]);; + +(* 286N core dilation invariance of the Carleson coefficient. *) +(* (f | phi_(k,nI,nJ)) = (ftilde | phi_(k+kk,nI,nJ)) where *) +(* ftilde(x) = 2^{kk/2} f(2^{kk} x). *) +(* carleson_ip = integral f*cnj(phi_sigma); change of variables x = 2^kk u *) +(* (INTEGRAL_DILATE_UNIV, Jacobian inv 2^kk) + PHISIG_DILATE (phi_sigma(2^kk *) +(* u) *) +(* = 2^{-kk/2} phi_sigstar(u)) + ZPOW_JAC_SQRT collapses the scalars. *) +let CARLESON_IP_DILATE = prove + (`!(f:real->complex) kk k nI nJ. + (\z. f(drop z)) IN lspace (:real^1) (&2) + ==> carleson_ip f (k,nI,nJ) = + carleson_ip (\x. Cx(sqrt(&2 zpow kk)) * f(&2 zpow kk * x)) (k + kk, + nI, nJ)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[carleson_ip; lproduct] THEN + SUBGOAL_THEN `&0 < &2 zpow kk` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `(\x. (Cx (sqrt (&2 zpow kk)) * (f:real->complex) (&2 zpow kk * drop x)) * + cnj (phi_sigma (k + kk,nI,nJ) carleson_phi (drop x))) = + (\x. Cx(&2 zpow kk) * + (\u. f(drop u) * cnj(phi_sigma (k,nI,nJ) carleson_phi (drop u))) + (&2 zpow kk % x))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:real^1` THEN + REWRITE_TAC[DROP_CMUL] THEN + MP_TAC(SPECL [`carleson_phi`; `kk:int`; `k:int`; `nI:int`; `nJ:int`; + `drop x`] + PHISIG_DILATE) THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[CNJ_MUL; CNJ_CX] THEN + SUBGOAL_THEN `Cx(sqrt(&2 zpow kk)) = + Cx(&2 zpow kk) * Cx(sqrt(&2 zpow (--kk)))` SUBST1_TAC THENL + [REWRITE_TAC[GSYM CX_MUL] THEN AP_TERM_TAC THEN + ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN + REWRITE_TAC[ZPOW_JAC_SQRT]; ALL_TAC] THEN + CONV_TAC COMPLEX_RING; + ALL_TAC] THEN + SUBGOAL_THEN + `(\u:real^1. (f:real->complex)(drop u) * cnj(phi_sigma (k,nI,nJ) + carleson_phi (drop u))) + integrable_on (:real^1)` + ASSUME_TAC THENL + [MATCH_MP_TAC L2_CNJ_PRODUCT_INTEGRABLE THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC SCHWARTZ_L2 THEN + REWRITE_TAC[ETA_AX; PHISIG_CARLESON_SCHWARTZ]; + ALL_TAC] THEN + SUBGOAL_THEN + `(\x:real^1. (f:real->complex)(drop(&2 zpow kk % x)) * + cnj(phi_sigma (k,nI,nJ) carleson_phi (drop(&2 zpow kk % x)))) + integrable_on (:real^1)` + ASSUME_TAC THENL + [MP_TAC(ISPECL + [`\u:real^1. (f:real->complex)(drop u) * cnj(phi_sigma (k,nI,nJ) + carleson_phi (drop u))`; + `&2 zpow kk`; `vec 0:real^1`] INTEGRABLE_DILATE_UNIV) THEN + ASM_SIMP_TAC[REAL_LT_IMP_NZ; VECTOR_ADD_RID]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`\x:real^1. (f:real->complex)(drop(&2 zpow kk % x)) * + cnj(phi_sigma (k,nI,nJ) carleson_phi (drop(&2 zpow kk % x)))`; + `(:real^1)`; `Cx(&2 zpow kk)`] INTEGRAL_COMPLEX_LMUL) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + MP_TAC(ISPECL + [`\u:real^1. (f:real->complex)(drop u) * cnj(phi_sigma (k,nI,nJ) + carleson_phi (drop u))`; + `&2 zpow kk`; `vec 0:real^1`] INTEGRAL_DILATE_UNIV) THEN + ASM_SIMP_TAC[REAL_LT_IMP_NZ; VECTOR_ADD_RID] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[COMPLEX_CMUL] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < c ==> abs c = c`] THEN + REWRITE_TAC[COMPLEX_MUL_ASSOC; GSYM CX_MUL] THEN + ASM_SIMP_TAC[REAL_MUL_RINV; REAL_LT_IMP_NZ] THEN + REWRITE_TAC[COMPLEX_MUL_LID; CX_MUL]);; + +(* ========================================================================= *) +(* 286N: dyadic-cell dilation. dyho(a+c) n = 2^c-dilate of dyho a n; hence *) +(* the *) +(* tile frequency-cells scale under sigma |-> sigma* = (k+kk, nI, nJ): *) +(* tile_J sigma* = 2^kk-dilate of tile_J sigma, *) +(* tile_Jr sigma* = 2^kk-dilate of tile_Jr sigma. *) +(* ========================================================================= *) + +let DYHO_DILATE = prove + (`!a c n. dyho (a + c) n = IMAGE (\x:real. &2 zpow c * x) (dyho a n)`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `&0 < &2 zpow c` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[dyho; EXTENSION; IN_IMAGE; IN_ELIM_THM] THEN GEN_TAC THEN + ASM_SIMP_TAC[REAL_ZPOW_ADD; REAL_OF_NUM_EQ; ARITH_EQ] THEN + EQ_TAC THEN STRIP_TAC THENL + [EXISTS_TAC `x / &2 zpow c` THEN + ASM_SIMP_TAC[REAL_DIV_LMUL; REAL_LT_IMP_NZ; REAL_LE_RDIV_EQ; + REAL_LT_LDIV_EQ] THEN + ONCE_REWRITE_TAC[REAL_ARITH `(a * b) * c:real = c * a * b`] THEN + ASM_SIMP_TAC[REAL_LE_LMUL_EQ; REAL_LT_LMUL_EQ] THEN ASM_REAL_ARITH_TAC; + ASM_REWRITE_TAC[] THEN CONJ_TAC THEN + ONCE_REWRITE_TAC[REAL_ARITH `a * b * c:real = c * a * b`] THEN + ASM_SIMP_TAC[REAL_LT_LMUL_EQ; REAL_LE_LMUL_EQ]]);; + +let TILE_JR_STAR = prove + (`!kk k nI nJ. tile_Jr (k + kk, nI, nJ) = + IMAGE (\y:real. &2 zpow kk * y) (tile_Jr (k,nI,nJ))`, + REPEAT GEN_TAC THEN REWRITE_TAC[tile_Jr] THEN + SUBGOAL_THEN `(k + kk) - &1:int = (k - &1) + kk` SUBST1_TAC THENL + [INT_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[DYHO_DILATE]);; + +let TILE_JR_STAR_MEM = prove + (`!kk k nI nJ w. (&2 zpow kk * w) IN tile_Jr (k + kk, nI, nJ) <=> w IN tile_Jr + (k,nI,nJ)`, + REPEAT GEN_TAC THEN REWRITE_TAC[TILE_JR_STAR; IN_IMAGE] THEN + SUBGOAL_THEN `&0 < &2 zpow kk` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + EQ_TAC THENL + [STRIP_TAC THEN + SUBGOAL_THEN `w:real = x` (fun th -> ASM_REWRITE_TAC[th]) THEN + MATCH_MP_TAC REAL_EQ_LCANCEL_IMP THEN EXISTS_TAC `&2 zpow kk` THEN + ASM_SIMP_TAC[REAL_LT_IMP_NZ]; + DISCH_TAC THEN EXISTS_TAC `w:real` THEN ASM_REWRITE_TAC[]]);; + +let REGION_STAR = prove + (`!(E:real->bool) (h:real->real) kk k nI nJ. + {y | y IN E /\ h y IN tile_Jr (k,nI,nJ)} = + IMAGE (\x. &2 zpow kk * x) + {x | (&2 zpow kk * x) IN E /\ + (&2 zpow kk * h(&2 zpow kk * x)) IN tile_Jr (k + kk, nI, nJ)}`, + REPEAT GEN_TAC THEN REWRITE_TAC[TILE_JR_STAR_MEM] THEN + SUBGOAL_THEN `&0 < &2 zpow kk` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM] THEN X_GEN_TAC `y:real` THEN + EQ_TAC THEN STRIP_TAC THENL + [EXISTS_TAC `y / &2 zpow kk` THEN + ASM_SIMP_TAC[REAL_DIV_LMUL; REAL_LT_IMP_NZ]; + ASM_REWRITE_TAC[]]);; + +(* ========================================================================= *) +(* 286N: integral over a c-dilated set. int_{IMAGE (c%) T} Ff = c * int_T *) +(* Ff(c%z) for c>0. (Set version of INTEGRAL_DILATE_UNIV, from *) +(* HAS_INTEGRAL_AFFINITY at m=inv c, translation 0.) Feeds the 286N region- *) +(* integral dilation. *) +(* ========================================================================= *) +let INTEGRAL_DILATE_SET = prove + (`!(Ff:real^1->complex) a (Tset:real^1->bool). + &0 < a /\ (\z. Ff(a % z)) integrable_on Tset + ==> integral (IMAGE (\z:real^1. a % z) Tset) Ff = Cx a * integral Tset + (\z. Ff(a % z))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\z:real^1. (Ff:real^1->complex)(a % z)`; + `integral Tset (\z:real^1. (Ff:real^1->complex)(a % z))`; + `Tset:real^1->bool`; `inv(a:real)`; + `vec 0:real^1`] HAS_INTEGRAL_AFFINITY) THEN + ASM_SIMP_TAC[REAL_LT_IMP_NZ; REAL_INV_EQ_0; VECTOR_MUL_RZERO; VECTOR_ADD_RID; + VECTOR_NEG_0] THEN + ANTS_TAC THENL [MATCH_MP_TAC INTEGRABLE_INTEGRAL THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[VECTOR_MUL_ASSOC] THEN + ASM_SIMP_TAC[REAL_MUL_RINV; REAL_LT_IMP_NZ; VECTOR_MUL_LID; + REAL_INV_INV] THEN + REWRITE_TAC[DIMINDEX_1; REAL_POW_1; REAL_ABS_INV] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < a ==> abs a = a`; REAL_INV_INV] THEN + DISCH_THEN(MP_TAC o MATCH_MP INTEGRAL_UNIQUE) THEN + REWRITE_TAC[ETA_AX; COMPLEX_CMUL] THEN DISCH_THEN SUBST1_TAC THEN REFL_TAC);; + +(* ========================================================================= *) +(* 286N: phi_sigma is absolutely integrable on ANY lebesgue-measurable *) +(* region *) +(* (not just finite-measure ones). phi_sigma carleson_phi is Schwartz, hence *) +(* absolutely integrable on the whole line (SCHWARTZ_ABSINT); restrict to *) +(* any *) +(* lebesgue-measurable subset (ABSOLUTELY_INTEGRABLE_ON_LEBESGUE_MEASURABLE_ *) +(* SUBSET). The unbounded-region companion of *) +(* PHISIG_ABS_INTEGRABLE_MEASURABLE. *) +(* ========================================================================= *) +let PHISIG_ABS_INTEGRABLE_LEBESGUE = prove + (`!s Sc. real_lebesgue_measurable Sc + ==> (\z. phi_sigma s carleson_phi (drop z)) absolutely_integrable_on + (IMAGE lift Sc)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN + EXISTS_TAC `(:real^1)` THEN REWRITE_TAC[SUBSET_UNIV] THEN CONJ_TAC THENL + [MATCH_MP_TAC SCHWARTZ_ABSINT THEN + REWRITE_TAC[ETA_AX; PHISIG_CARLESON_SCHWARTZ]; + ASM_MESON_TAC[REAL_LEBESGUE_MEASURABLE]]);; + +(* ------------------------------------------------------------------------- *) +(* 286N region-integral dilation: int_{sigma-region for (E,h)} phi_sigma *) +(* = sqrt(2^kk) * int_{sigma*-region for the dilated data} phi_sigma*. *) +(* Chains REGION_STAR (region set-id) + lift-dilation commute + INTEGRAL_ *) +(* DILATE_SET (Jacobian 2^kk) + PHISIG_DILATE (phi_sigma(2^kk .) = 2^{-kk/2} *) +(* phi_sigstar) + ZPOW_JAC_SQRT (2^kk sqrt(2^-kk)=sqrt(2^kk)). *) +(* ------------------------------------------------------------------------- *) +let REGION_INTEGRAL_STAR = prove + (`!(E:real->bool) (h:real->real) kk k nI nJ. + real_lebesgue_measurable {x | (&2 zpow kk * x) IN E /\ + (&2 zpow kk * h(&2 zpow kk * x)) IN tile_Jr (k + kk, nI, nJ)} + ==> integral (IMAGE lift {y | y IN E /\ h y IN tile_Jr (k,nI,nJ)}) + (\z. phi_sigma (k,nI,nJ) carleson_phi (drop z)) = + Cx(sqrt(&2 zpow kk)) * + integral (IMAGE lift {x | (&2 zpow kk * x) IN E /\ + (&2 zpow kk * h(&2 zpow kk * x)) IN tile_Jr (k + kk, nI, nJ)}) + (\z. phi_sigma (k + kk, nI, nJ) carleson_phi (drop z))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&0 < &2 zpow kk` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REGION_STAR] THEN + ABBREV_TAC `Rstar = {x | (&2 zpow kk * x) IN E /\ + (&2 zpow kk * h(&2 zpow kk * x)) IN tile_Jr (k + kk, nI, nJ)}` THEN + SUBGOAL_THEN + `IMAGE lift (IMAGE (\x:real. &2 zpow kk * x) Rstar) = + IMAGE (\z:real^1. &2 zpow kk % z) (IMAGE lift Rstar)` + SUBST1_TAC THENL + [REWRITE_TAC[GSYM IMAGE_o; o_DEF] THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + REWRITE_TAC[o_THM; LIFT_CMUL]; ALL_TAC] THEN + MP_TAC(ISPECL + [`\z:real^1. phi_sigma (k,nI,nJ) carleson_phi (drop z)`; + `&2 zpow kk`; `IMAGE lift Rstar`] INTEGRAL_DILATE_SET) THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `(\z:real^1. phi_sigma (k,nI,nJ) carleson_phi (drop (&2 zpow kk % z))) = + (\z. Cx(sqrt(&2 zpow (--kk))) * phi_sigma (k + kk, nI, nJ) carleson_phi + (drop z))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `z:real^1` THEN + REWRITE_TAC[DROP_CMUL] THEN + REWRITE_TAC[PHISIG_DILATE]; ALL_TAC] THEN + ANTS_TAC THENL + [MATCH_MP_TAC INTEGRABLE_COMPLEX_LMUL THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC PHISIG_ABS_INTEGRABLE_LEBESGUE THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN + MP_TAC(BETA_RULE(ISPECL + [`\z:real^1. phi_sigma (k + kk, nI, nJ) carleson_phi (drop z)`; + `IMAGE lift Rstar`; + `Cx(sqrt(&2 zpow (--kk)))`] INTEGRAL_COMPLEX_LMUL)) THEN + ANTS_TAC THENL + [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC PHISIG_ABS_INTEGRABLE_LEBESGUE THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[COMPLEX_MUL_ASSOC; GSYM CX_MUL; ZPOW_JAC_SQRT]);; + +(* ========================================================================= *) +(* 286N per-term dilation (COMBINES CARLESON_IP_DILATE + *) +(* REGION_INTEGRAL_STAR): *) +(* the 286M summand for sigma over (f,E,h) = sqrt(2^kk) * the summand for *) +(* sigma* over the dilated data (ftilde, Etilde, htilde). The |ip| factor is *) +(* invariant (CARLESON_IP_DILATE); the |int| factor carries sqrt(2^kk) *) +(* (REGION_INTEGRAL_STAR); a nonneg real scalar pulls out of the norm. *) +(* ========================================================================= *) +let CARLESON_TERM_DILATE = prove + (`!(f:real->complex) E (h:real->real) kk k nI nJ. + (\z. f(drop z)) IN lspace (:real^1) (&2) /\ + real_lebesgue_measurable {x | (&2 zpow kk * x) IN E /\ + (&2 zpow kk * h(&2 zpow kk * x)) IN tile_Jr (k + kk, nI, nJ)} + ==> norm(carleson_ip f (k,nI,nJ) * + integral (IMAGE lift {y | y IN E /\ h y IN tile_Jr (k,nI,nJ)}) + (\z. phi_sigma (k,nI,nJ) carleson_phi (drop z))) = + sqrt(&2 zpow kk) * + norm(carleson_ip (\x. Cx(sqrt(&2 zpow kk)) * f(&2 zpow kk * x)) (k + + kk, nI, nJ) * + integral (IMAGE lift {x | (&2 zpow kk * x) IN E /\ + (&2 zpow kk * h(&2 zpow kk * x)) IN tile_Jr (k + kk, nI, nJ)}) + (\z. phi_sigma (k + kk, nI, nJ) carleson_phi (drop z)))`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`f:real->complex`; `kk:int`; `k:int`; `nI:int`; + `nJ:int`] CARLESON_IP_DILATE) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + MP_TAC(SPECL [`E:real->bool`; `h:real->real`; `kk:int`; `k:int`; `nI:int`; + `nJ:int`] + REGION_INTEGRAL_STAR) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[COMPLEX_MUL_AC] THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX] THEN + SUBGOAL_THEN `abs(sqrt(&2 zpow kk)) = sqrt(&2 zpow kk)` SUBST1_TAC THENL + [REWRITE_TAC[REAL_ABS_REFL] THEN MATCH_MP_TAC SQRT_POS_LE THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN MATCH_MP_TAC REAL_ZPOW_LT THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[REAL_MUL_AC]);; + +(* ========================================================================= *) +(* 286N: the tile permutation sigma |-> sigma* = (k+kk, nI, nJ) is a *) +(* bijection *) +(* of the tile universe :int#int#int, so the tile-sum reindexes. *) +(* ========================================================================= *) + +let TILE_STAR_INJ = prove + (`!(kk:int) s t:int#int#int. + (\u:int#int#int. (FST u + kk, FST(SND u), SND(SND u))) s = + (\u. (FST u + kk, FST(SND u), SND(SND u))) t ==> s = t`, + GEN_TAC THEN REWRITE_TAC[FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC [`a:int`;`b:int`;`c:int`;`d:int`;`e:int`;`g:int`] THEN + REWRITE_TAC[PAIR_EQ] THEN STRIP_TAC THEN + REPEAT CONJ_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o check (fun th -> can (find_term (fun tm -> tm = + `kk:int`)) (concl th))) THEN + INT_ARITH_TAC);; + +let TILE_STAR_SUM_REINDEX = prove + (`!(g:(int#int#int)->real) (P:(int#int#int)->bool) kk. + sum (IMAGE (\u:int#int#int. (FST u + kk, FST(SND u), SND(SND u))) P) g = + sum P (\s. g((FST s + kk, FST(SND s), SND(SND s))))`, + REPEAT GEN_TAC THEN + W(MP_TAC o PART_MATCH (lhand o rand) SUM_IMAGE o lhand o snd) THEN + ANTS_TAC THENL + [REPEAT STRIP_TAC THEN MATCH_MP_TAC TILE_STAR_INJ THEN + EXISTS_TAC `kk:int` THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[o_DEF]);; + +(* ========================================================================= *) +(* 286N core sum-dilation identity: the whole 286M correlation sum for *) +(* (f,E,h) over a finite tile set P equals sqrt(2^kk) times the sum for the *) +(* dilated data (ftilde x = sqrt(2^kk) f(2^kk x), Etilde = 2^-kk E, htilde x *) +(* = *) +(* 2^kk h(2^kk x)) over the star-shifted tiles s* = (k+kk,nI,nJ). Termwise *) +(* via *) +(* CARLESON_TERM_DILATE (each summand scales by sqrt(2^kk), tile s -> star *) +(* s); the *) +(* per-s real_lebesgue_measurable side-condition is supplied as a *) +(* hypothesis. *) +(* This is the reusable heart of 286N (drop the muE<=1, ||f||=1 *) +(* normalization). *) +(* ========================================================================= *) +let CARLESON_SUM_DILATE = prove + (`!f E h kk P. + (\z. f(drop z)) IN lspace (:real^1) (&2) /\ FINITE P /\ + (!s. s IN P ==> real_lebesgue_measurable + {x | &2 zpow kk * x IN E /\ + &2 zpow kk * h (&2 zpow kk * x) IN + tile_Jr (FST s + kk, FST(SND s), SND(SND s))}) + ==> sum P (\s. norm(carleson_ip f s * + integral (IMAGE lift {y | y IN E /\ h y IN tile_Jr s}) + (\z. phi_sigma s carleson_phi (drop z)))) + = sqrt(&2 zpow kk) * + sum P (\s. norm(carleson_ip (\x. Cx(sqrt(&2 zpow kk)) * f(&2 zpow kk + * x)) + (FST s + kk, FST(SND s), SND(SND s)) * + integral (IMAGE lift + {x | &2 zpow kk * x IN E /\ + &2 zpow kk * h (&2 zpow kk * x) IN + tile_Jr (FST s + kk, FST(SND s), SND(SND s))}) + (\z. phi_sigma (FST s + kk, FST(SND s), SND(SND s)) + carleson_phi (drop z))))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM SUM_LMUL] THEN + MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `s:int#int#int` THEN DISCH_TAC THEN + REWRITE_TAC[] THEN + MP_TAC(ISPEC `s:int#int#int` PAIR_SURJECTIVE) THEN + DISCH_THEN(X_CHOOSE_THEN `k:int` (X_CHOOSE_THEN + `rs:int#int` SUBST_ALL_TAC)) THEN + MP_TAC(ISPEC `rs:int#int` PAIR_SURJECTIVE) THEN + DISCH_THEN(X_CHOOSE_THEN `nI:int` (X_CHOOSE_THEN + `nJ:int` SUBST_ALL_TAC)) THEN + REWRITE_TAC[FST; SND] THEN + MATCH_MP_TAC CARLESON_TERM_DILATE THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(k,nI,nJ):int#int#int`) THEN + ASM_REWRITE_TAC[FST; SND]);; + +(* ========================================================================= *) +(* 286K off-diagonal Gram structure: the frequency-cell J-ordering *) +(* dichotomy. *) +(* If two tiles have overlapping left-half J-cells (so may be *) +(* nonzero, 286E b-iii) but distinct J-cells, then one J-cell sits inside *) +(* the *) +(* other's LEFT half: J_s SUBSET J^l_t OR J_t SUBSET J^l_s. (Dyadic *) +(* laminarity DYHO_TRICHOTOMY on the J^l pair + finer-inside-coarser *) +(* DYHO_NEST.) *) +(* ========================================================================= *) + +(* dyadic left child: dyho(k-1)(2n) [= left half] is inside its parent dyho *) +(* k n *) +let DYHO_LEFT_CHILD = prove + (`!k n. dyho (k - &1) (&2 * n) SUBSET dyho k n`, + REPEAT GEN_TAC THEN REWRITE_TAC[dyho; SUBSET; IN_ELIM_THM] THEN + X_GEN_TAC `x:real` THEN REWRITE_TAC[int_mul_th; int_of_num_th] THEN + SIMP_TAC[REAL_ZPOW_SUB; REAL_OF_NUM_EQ; ARITH_EQ; REAL_ZPOW_1] THEN + SUBGOAL_THEN `&0 < &2 zpow k` MP_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[real_div] THEN CONV_TAC REAL_FIELD);; + +(* Jl_s SUBSET Jl_t with distinct J-cells forces the scale strict ks < kt. *) +let JLSUBSET_KSLT = prove + (`dyho (ks - &1) (&2 * nJs) SUBSET dyho (kt - &1) (&2 * nJt) /\ + ~(dyho ks nJs = dyho kt nJt) ==> ks:int < kt`, + STRIP_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP DYHO_SUBSET_SCALE) THEN + DISCH_TAC THEN + ASM_CASES_TAC `ks:int = kt` THENL + [FIRST_X_ASSUM SUBST_ALL_TAC THEN + SUBGOAL_THEN `nJs:int = nJt` (fun th -> ASM_MESON_TAC[th]) THEN + MP_TAC(ISPECL [`kt - &1:int`; `&2 * nJt:int`; + `&2 * nJs:int`] DYHO_SAMESCALE_SUBSET_EQ) THEN + ASM_REWRITE_TAC[] THEN INT_ARITH_TAC; + ASM_INT_ARITH_TAC]);; + +(* the branch step: Jl_s SUBSET Jl_t (distinct J) ==> J_s SUBSET Jl_t. *) +let JL_LIFT_TO_J = prove + (`dyho (ks - &1) (&2 * nJs) SUBSET dyho (kt - &1) (&2 * nJt) /\ + ~(dyho ks nJs = dyho kt nJt) ==> dyho ks nJs SUBSET dyho (kt - &1) (&2 * + nJt)`, + STRIP_TAC THEN + SUBGOAL_THEN `ks:int < kt` ASSUME_TAC THENL + [ASM_MESON_TAC[JLSUBSET_KSLT]; ALL_TAC] THEN + MATCH_MP_TAC DYHO_NEST THEN + EXISTS_TAC `real_of_int (&2 * nJs) * &2 zpow (ks - &1)` THEN + REPEAT CONJ_TAC THENL + [ASM_INT_ARITH_TAC; + MP_TAC(ISPECL [`ks:int`; `nJs:int`] DYHO_LEFT_CHILD) THEN + REWRITE_TAC[SUBSET] THEN + DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[DYHO_NONEMPTY]; + FIRST_X_ASSUM(fun th -> if can (find_term (fun tm -> tm = `kt - &1:int`)) + (concl th) && + (not(is_neg(concl th))) then MP_TAC th else + NO_TAC) THEN + REWRITE_TAC[SUBSET] THEN DISCH_THEN MATCH_MP_TAC THEN + REWRITE_TAC[DYHO_NONEMPTY]]);; + +(* the dichotomy, in raw dyho form. *) +let DYHO_JL_OFFDIAG_DICHOTOMY = prove + (`!ks kt nJs nJt. + ~(dyho ks nJs = dyho kt nJt) /\ + ~(DISJOINT (dyho (ks - &1) (&2 * nJs)) (dyho (kt - &1) (&2 * nJt))) + ==> dyho ks nJs SUBSET dyho (kt - &1) (&2 * nJt) \/ + dyho kt nJt SUBSET dyho (ks - &1) (&2 * nJs)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(ISPECL [`ks - &1:int`; `&2 * nJs:int`; `kt - &1:int`; + `&2 * nJt:int`] DYHO_TRICHOTOMY) THEN + STRIP_TAC THENL + [DISJ1_TAC THEN MATCH_MP_TAC JL_LIFT_TO_J THEN ASM_REWRITE_TAC[]; + DISJ2_TAC THEN MATCH_MP_TAC JL_LIFT_TO_J THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL [ASM_REWRITE_TAC[]; CONV_TAC SYM_CONV THEN + ASM_REWRITE_TAC[]]; + ASM_MESON_TAC[]]);; + +(* tile-form dichotomy: distinct J-cells with overlapping left-halves are *) +(* J^l-nested one way or the other. Feeds the 286K off-diagonal Gram block *) +(* split into the J_s SUBSET J^l_t and J_t SUBSET J^l_s sub-blocks. *) +let TILE_JL_OFFDIAG_DICHOTOMY = prove + (`!s t:int#int#int. + ~(tile_J s = tile_J t) /\ ~(DISJOINT (tile_Jl s) (tile_Jl t)) + ==> tile_J s SUBSET tile_Jl t \/ tile_J t SUBSET tile_Jl s`, + REPEAT GEN_TAC THEN + MP_TAC(ISPEC `s:int#int#int` PAIR_SURJECTIVE) THEN + MP_TAC(ISPEC `t:int#int#int` PAIR_SURJECTIVE) THEN + DISCH_THEN(REPEAT_TCL CHOOSE_THEN SUBST1_TAC) THEN + DISCH_THEN(REPEAT_TCL CHOOSE_THEN SUBST1_TAC) THEN + POP_ASSUM_LIST(K ALL_TAC) THEN + MP_TAC(ISPEC `y':int#int` PAIR_SURJECTIVE) THEN + MP_TAC(ISPEC `y:int#int` PAIR_SURJECTIVE) THEN + DISCH_THEN(REPEAT_TCL CHOOSE_THEN SUBST1_TAC) THEN + DISCH_THEN(REPEAT_TCL CHOOSE_THEN SUBST1_TAC) THEN + REWRITE_TAC[tile_J; tile_Jl; DYHO_JL_OFFDIAG_DICHOTOMY]);; + +(* ========================================================================= *) +(* 286K H_j inner (per-sigma) sum, in TILE form. For a fixed sigma and a *) +(* finite tile-set Tt of "coarser" tiles (k_sigma <= k_t, distinct I-cells) *) +(* whose I-cells form a pairwise-negligible cover inside II, the inner sum *) +(* sum_t || * || *) +(* is <= (C3 gam) inv(sqrt 2^{k_sigma}) int_II w_sigma. Instantiates the *) +(* abstract HJ_INNER_SUM with Ai=|| (PHISIG_286GG_TILE), *) +(* Bi=|ip_t| *) +(* (COEFF_LE_ENERGY_MASS), G=tile_I, v=cw_tile sigma. *) +(* ========================================================================= *) + +(* tile-form of 286Gg (cross-correlation kernel bound), stated on sigma,t. *) +let PHISIG_286GG_TILE = prove + (`?C3. &0 <= C3 /\ + !(s:int#int#int) (t:int#int#int). tile_k s <= tile_k t /\ ~(tile_I s = + tile_I t) + ==> norm(integral (:real^1) + (\z. phi_sigma s carleson_phi (drop z) * + cnj(phi_sigma t carleson_phi (drop z)))) + <= C3 * inv(sqrt(&2 zpow (tile_k s))) * sqrt(&2 zpow (tile_k t)) * + real_integral (tile_I t) (cw_tile s)`, + X_CHOOSE_THEN `C3:real` STRIP_ASSUME_TAC PHISIG_286GG THEN + EXISTS_TAC `C3:real` THEN ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC [`s:int#int#int`; `t:int#int#int`] THEN + MP_TAC(ISPEC `s:int#int#int` PAIR_SURJECTIVE) THEN + MP_TAC(ISPEC `t:int#int#int` PAIR_SURJECTIVE) THEN + DISCH_THEN(REPEAT_TCL CHOOSE_THEN SUBST1_TAC) THEN + DISCH_THEN(REPEAT_TCL CHOOSE_THEN SUBST1_TAC) THEN + MP_TAC(ISPEC `y':int#int` PAIR_SURJECTIVE) THEN + MP_TAC(ISPEC `y:int#int` PAIR_SURJECTIVE) THEN + DISCH_THEN(REPEAT_TCL CHOOSE_THEN SUBST1_TAC) THEN + DISCH_THEN(REPEAT_TCL CHOOSE_THEN SUBST1_TAC) THEN + REWRITE_TAC[tile_k] THEN ASM_REWRITE_TAC[]);; + +let HJ_INNER_TILE = prove + (`?C3. &0 <= C3 /\ + !(f:real->complex) sigma (Tt:(int#int#int)->bool) (P:(int#int#int)->bool) + gam II. + &0 <= gam /\ FINITE Tt /\ FINITE P /\ energy_f f P <= gam /\ + (!t. t IN Tt ==> t IN P) /\ + (!t. t IN Tt ==> tile_k sigma <= tile_k t /\ ~(tile_I sigma = tile_I t)) + /\ + (!t. t IN Tt ==> tile_I t SUBSET II) /\ + (!t t'. t IN Tt /\ t' IN Tt /\ tile_I t = tile_I t' ==> t = t') /\ + (!t t'. t IN Tt /\ t' IN Tt /\ ~(t = t') ==> real_negligible (tile_I t + INTER tile_I t')) /\ + (!t. t IN Tt ==> cw_tile sigma real_integrable_on tile_I t) /\ + cw_tile sigma real_integrable_on II + ==> sum Tt (\t. norm(integral (:real^1) + (\z. phi_sigma sigma carleson_phi (drop z) * + cnj(phi_sigma t carleson_phi (drop z)))) * + norm(carleson_ip f t)) + <= (C3 * gam) * inv(sqrt(&2 zpow (tile_k sigma))) * + real_integral II (cw_tile sigma)`, + X_CHOOSE_THEN `C3:real` STRIP_ASSUME_TAC PHISIG_286GG_TILE THEN + EXISTS_TAC `C3:real` THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`C3:real`; `gam:real`; `tile_k sigma`; `tile_k:(int#int#int)->int`; + `\t. norm(integral (:real^1) + (\z. phi_sigma sigma carleson_phi (drop z) * + cnj(phi_sigma t carleson_phi (drop z))))`; + `\t. norm(carleson_ip (f:real->complex) t)`; + `tile_I:(int#int#int)->(real->bool)`; `cw_tile sigma`; `II:real->bool`; + `Tt:(int#int#int)->bool`] HJ_INNER_SUM) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + REWRITE_TAC[NORM_POS_LE]; + REWRITE_TAC[NORM_POS_LE]; + X_GEN_TAC `t:int#int#int` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o check (fun th -> can (find_term (fun tm -> + tm = `real_integral`)) (concl th))) THEN + ASM_SIMP_TAC[]; + X_GEN_TAC `t:int#int#int` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + MATCH_MP_TAC COEFF_LE_ENERGY_MASS THEN + EXISTS_TAC `P:(int#int#int)->bool` THEN + ASM_SIMP_TAC[]; + ASM_SIMP_TAC[]; + ASM_MESON_TAC[]; + ASM_MESON_TAC[]; + ASM_REWRITE_TAC[]; + GEN_TAC THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN REWRITE_TAC[CW_TILE_POS]]; + REWRITE_TAC[]]);; + +(* ========================================================================= *) +(* 286K off-diagonal block Cauchy-Schwarz reduction. For any nonneg inr, *) +(* sum_s || * inr_s <= sqrt(delta_f f P) * sqrt(sum_s inr_s^2). *) +(* (Fremlin: sum_sigma ||(inner tau-sum) <= sqrt(alpha) *) +(* sqrt(H).) *) +(* SUM_CAUCHY_SCHWARZ on (|ip_s|, inr_s) + sqrt-monotone + SQRT_MUL. *) +(* ========================================================================= *) +let OFFBLOCK_CS = prove + (`!(f:real->complex) (P:(int#int#int)->bool) (inr:(int#int#int)->real). + FINITE P /\ (!s. s IN P ==> &0 <= inr s) + ==> sum P (\s. norm(carleson_ip f s) * inr s) + <= sqrt(delta_f f P) * sqrt(sum P (\s. inr s pow 2))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`P:(int#int#int)->bool`; + `\s. norm(carleson_ip (f:real->complex) s)`; + `inr:(int#int#int)->real`] SUM_CAUCHY_SCHWARZ) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + REWRITE_TAC[delta_f] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sqrt(sum P (\s. norm(carleson_ip (f:real->complex) s) pow 2) * + sum P (\s. inr s pow 2))` THEN + CONJ_TAC THENL + [SUBGOAL_THEN `sum P (\s. norm(carleson_ip (f:real->complex) s) * inr s) = + sqrt((sum P (\s. norm(carleson_ip f s) * inr s)) pow 2)` + SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC POW_2_SQRT THEN + MATCH_MP_TAC SUM_POS_LE THEN + ASM_SIMP_TAC[REAL_LE_MUL; NORM_POS_LE]; ALL_TAC] THEN + MATCH_MP_TAC SQRT_MONO_LE THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[SQRT_MUL; REAL_LE_REFL]]);; + +(* ========================================================================= *) +(* 286K H_j square-sum (per-tree), abstract form. Given, for each sigma in a *) +(* finite tree Sp, a nonneg inner-sum value bounded by (C3 gam) inv(sqrt *) +(* 2^ks) *) +(* R sigma with R sigma in [0,1] (R sigma = int_{II sigma} w_sigma, supplied *) +(* by *) +(* HJ_INNER_TILE at the use site), all scales >= L, per-scale weight-tail *) +(* <=C4: *) +(* sum_sigma (inner-sum)^2 <= (C3 gam)^2 * 2 C4 * inv(2^L). *) +(* Just MATCH_MP_TAC HJ_FULL_BOUND with inr = the inner tau-sum, R = the *) +(* weight *) +(* integral, kf = tile_k. (The per-sigma inner bound is left as a hypothesis *) +(* so *) +(* the H_j square-sum is decoupled from the HJ_INNER_TILE geometry.) *) +(* ========================================================================= *) +let HJ_TILE_BOUND = prove + (`!(f:real->complex) (Sp:(int#int#int)->bool) + (Tt:(int#int#int)->((int#int#int)->bool)) (II:(int#int#int)->(real->bool)) + gam (C4:real) (L:int) (C3:real). + &0 <= C3 /\ &0 <= gam /\ &0 <= C4 /\ FINITE Sp /\ + (!sigma. sigma IN Sp ==> + &0 <= sum (Tt sigma) (\t. norm(integral (:real^1) + (\z. phi_sigma sigma carleson_phi (drop z) * + cnj(phi_sigma t carleson_phi (drop z)))) * + norm(carleson_ip f t)) /\ + &0 <= real_integral (II sigma) (cw_tile sigma) /\ + real_integral (II sigma) (cw_tile sigma) <= &1 /\ + sum (Tt sigma) (\t. norm(integral (:real^1) + (\z. phi_sigma sigma carleson_phi (drop z) * + cnj(phi_sigma t carleson_phi (drop z)))) * + norm(carleson_ip f t)) <= + (C3 * gam) * inv(sqrt(&2 zpow (tile_k sigma))) * + real_integral (II sigma) (cw_tile sigma) /\ + L <= tile_k sigma) /\ + (!k. sum {sigma | sigma IN Sp /\ tile_k sigma = k} + (\sigma. real_integral (II sigma) (cw_tile sigma)) <= C4) + ==> sum Sp (\sigma. (sum (Tt sigma) (\t. norm(integral (:real^1) + (\z. phi_sigma sigma carleson_phi (drop z) * + cnj(phi_sigma t carleson_phi (drop z)))) * + norm(carleson_ip f t))) pow 2) + <= (C3 * gam) pow 2 * (&2 * C4 * inv(&2 zpow L))`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(BETA_RULE(ISPECL + [`C3:real`; `gam:real`; `tile_k:(int#int#int)->int`; + `\sigma. sum (Tt sigma) (\t. norm(integral (:real^1) + (\z. phi_sigma sigma carleson_phi (drop z) * + cnj(phi_sigma t carleson_phi (drop z)))) * + norm(carleson_ip (f:real->complex) t))`; + `\sigma. real_integral (II sigma) (cw_tile sigma)`; + `Sp:(int#int#int)->bool`; `C4:real`; `L:int`] HJ_FULL_BOUND)) THEN + REPEAT CONJ_TAC THEN + TRY(ASM_REWRITE_TAC[] THEN NO_TAC) THEN + TRY(X_GEN_TAC `sigma:int#int#int` THEN DISCH_TAC THEN ASM_SIMP_TAC[] THEN + NO_TAC));; +(* ========================================================================= *) +(* 286K Gram-bound closing arithmetic. From the block estimates alpha^2 <= *) +(* C3 alpha (diagonal) + 2 off (the two symmetric off-diagonal blocks) with *) +(* off <= 2 C3 sqrt(2 C4) alpha, conclude alpha <= C3 + 4 C3 sqrt(2 C4) = *) +(* C6/4. *) +(* (alpha = delta_f f P' = sum||^2.) GRAM_ALPHA_BOUND with K = C6/4. *) +(* ========================================================================= *) + +let LNORM2_SQ = prove + (`!(g:real^1->complex). g IN lspace (:real^1) (&2) + ==> (lnorm (:real^1) (&2) g) pow 2 = drop(integral (:real^1) (\x. + lift(norm(g x) pow 2)))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`(:real^1)`; `&2`; `g:real^1->complex`] LNORM_RPOW) THEN + ASM_REWRITE_TAC[REAL_ARITH `~(&2 = &0)`] THEN + REWRITE_TAC[RPOW_POW] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM; RPOW_POW]);; + + +(* ========================================================================= *) +(* 286N brick: the L^2 norm is invariant under the L^2 dilation *) +(* f |-> (\z. sqrt(c) f(c z)). (Fremlin 286N: ||ftilde||_2 = ||f||_2 with *) +(* ftilde(x) = 2^{k/2} f(2^k x).) lnorm^2 = int norm^2 (LNORM2_SQ), which is *) +(* dilation-invariant (L2_DILATE_NORMSQ); then a^2 = b^2 with a,b >= 0. *) +(* ========================================================================= *) +let LNORM_DILATE_EQ = prove + (`!ff c. &0 < c /\ ff IN lspace (:real^1) (&2) + ==> lnorm (:real^1) (&2) (\z. Cx(sqrt c) * ff (c % z)) = lnorm (:real^1) + (&2) ff`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\z. Cx(sqrt c) * ff (c % z)) IN lspace (:real^1) (&2)` ASSUME_TAC THENL + [ASM_SIMP_TAC[L2_DILATE_LSPACE]; ALL_TAC] THEN + SUBGOAL_THEN + `(\z. lift(norm((ff:real^1->complex) z) pow 2)) integrable_on (:real^1)` + ASSUME_TAC THENL + [MP_TAC(ISPECL [`(:real^1)`; `&2`; + `ff:real^1->complex`] LSPACE_IMP_INTEGRABLE) THEN + ASM_REWRITE_TAC[RPOW_POW]; ALL_TAC] THEN + MATCH_MP_TAC REAL_POW_EQ THEN EXISTS_TAC `2` THEN + REWRITE_TAC[ARITH_EQ] THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC LNORM_POS_LE THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC LNORM_POS_LE THEN ASM_REWRITE_TAC[]; + ASM_SIMP_TAC[LNORM2_SQ] THEN AP_TERM_TAC THEN + MP_TAC(ISPECL [`ff:real^1->complex`; `c:real`] L2_DILATE_NORMSQ) THEN + ASM_REWRITE_TAC[] THEN SIMP_TAC[]]);; + + +(* ========================================================================= *) +(* 286N assembly bricks (Fremlin mt286.tex 1879-1936). *) +(* ========================================================================= *) + +(* dilation-preimage as an image, and its measure (c > 0). *) +let DILATE_PREIMAGE_IMAGE = prove + (`!(E:real->bool) c. ~(c = &0) ==> {x | c * x IN E} = IMAGE (\x. inv c * x) + E`, + REPEAT STRIP_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE] THEN + X_GEN_TAC `y:real` THEN EQ_TAC THENL + [DISCH_TAC THEN EXISTS_TAC `c * y:real` THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `~(c = &0)` THEN CONV_TAC REAL_FIELD; + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `c * inv c * x' = x':real` SUBST1_TAC THENL + [UNDISCH_TAC `~(c = &0)` THEN CONV_TAC REAL_FIELD; ASM_REWRITE_TAC[]]]);; + +let DILATE_PREIMAGE_MEASURE = prove + (`!(E:real->bool) c. &0 < c /\ real_measurable E + ==> real_measurable {x | c * x IN E} /\ + real_measure {x | c * x IN E} = inv c * real_measure E`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(ISPECL [`E:real->bool`; `c:real`] DILATE_PREIMAGE_IMAGE) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN CONJ_TAC THENL + [ASM_SIMP_TAC[REAL_MEASURABLE_SCALING]; + ASM_SIMP_TAC[REAL_MEASURE_SCALING] THEN + SUBGOAL_THEN `abs(inv c) = inv c` SUBST1_TAC THENL + [REWRITE_TAC[REAL_ABS_INV] THEN AP_TERM_TAC THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[]]]);; + +(* the CARLESON_SUM_DILATE ftilde (real-mult form) IS the %-dilation *) +(* composed with drop (bridges to L2_DILATE_LSPACE / LNORM_DILATE_EQ). *) +let FTILDE_DROP_EQ = prove + (`!(f:real->complex) c. &0 < c + ==> (\z. (\x. Cx(sqrt c) * f(c * x))(drop z)) = + (\z. Cx(sqrt c) * (\w. f(drop w))(c % z))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `z:real^1` THEN + REWRITE_TAC[DROP_CMUL]);; + +(* a lower integer-power witness: for m > 0 there is k with 2^k < m. *) +let ZPOW2_LOWER = prove + (`!m. &0 < m ==> ?k:int. &2 zpow k < m`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`inv m:real`; `&0:int`] ZPOW2_ARCH) THEN + DISCH_THEN(X_CHOOSE_THEN `b:int` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `--b:int` THEN REWRITE_TAC[REAL_ZPOW_NEG] THEN + SUBGOAL_THEN `&0 < &2 zpow b` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `inv(&2 zpow b) < inv(inv m)` MP_TAC THENL + [MATCH_MP_TAC REAL_LT_INV2 THEN ASM_REWRITE_TAC[REAL_LT_INV_EQ]; + ASM_SIMP_TAC[REAL_INV_INV]]);; + +(* Fremlin's k with 2^{k-1} < muF <= 2^k, in the bracket form muF <= 2^k <= *) +(* 2 muF. *) +let POW2_BRACKET = prove + (`!m. &0 < m ==> ?k:int. m <= &2 zpow k /\ &2 zpow k <= &2 * m`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`m:real`; `&0:int`] ZPOW2_ARCH) THEN + DISCH_THEN(X_CHOOSE_THEN `b:int` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPEC `m:real` ZPOW2_LOWER) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `a:int` ASSUME_TAC) THEN + SUBGOAL_THEN `a:int < b` ASSUME_TAC THENL + [MATCH_MP_TAC ZPOW2_LT_REV THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(INST [`\j:int. m <= &2 zpow (a + j)`,`P:int->bool`] INT_WOP) THEN + BETA_TAC THEN + SUBGOAL_THEN + `?x:int. &0 <= x /\ m <= &2 zpow (a + x)` (fun th -> REWRITE_TAC[th]) THENL + [EXISTS_TAC `b - a:int` THEN CONJ_TAC THENL + [ASM_INT_ARITH_TAC; + SUBGOAL_THEN `a + (b - a):int = b` SUBST1_TAC THENL + [INT_ARITH_TAC; ASM_SIMP_TAC[REAL_LT_IMP_LE]]]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `j0:int` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `a + j0:int` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `j0 = &0:int` THENL + [UNDISCH_TAC `&2 zpow a < m` THEN ASM_REWRITE_TAC[INT_ADD_RID] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `~(m <= &2 zpow (a + (j0 - &1)))` ASSUME_TAC THENL + [DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `j0 - &1:int`) THEN + ASM_REWRITE_TAC[] THEN ASM_INT_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `&2 zpow (a + j0) = &2 * &2 zpow (a + (j0 - &1))` SUBST1_TAC THENL + [SUBGOAL_THEN `a + j0:int = (a + (j0 - &1)) + &1` SUBST1_TAC THENL + [INT_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[GSYM ZPOW2_ADD; REAL_ZPOW_1] THEN REAL_ARITH_TAC; + ASM_REAL_ARITH_TAC]);; + + +(* 286N brick: g |-> (\x. c g(c x)) preserves real_measurable_on (c > 0). *) +(* Bridges to the real^1 MEASURABLE_ON_DILATE via the lift/drop unfolding of *) +(* real_measurable_on; the SUM_DILATE side-condition needs gtilde *) +(* measurable. *) +let REAL_MEASURABLE_ON_DILATE_MUL = prove + (`!(h:real->real) c. &0 < c /\ h real_measurable_on (:real) + ==> (\x. c * h(c * x)) real_measurable_on (:real)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_MEASURABLE_ON_LMUL THEN + REWRITE_TAC[real_measurable_on] THEN + SUBGOAL_THEN + `lift o (\x. (h:real->real)(c * x)) o drop = (\z. (lift o h o drop)(c % z))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; o_THM; DROP_CMUL; LIFT_DROP]; ALL_TAC] THEN + SUBGOAL_THEN `IMAGE lift (:real) = (:real^1)` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_UNIV] THEN + MESON_TAC[LIFT_DROP]; ALL_TAC] THEN + MP_TAC(ISPECL [`lift o (h:real->real) o drop`; `c:real`; `vec 0:real^1`] + MEASURABLE_ON_DILATE) THEN + ASM_REWRITE_TAC[VECTOR_ADD_RID] THEN + ANTS_TAC THENL + [CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + UNDISCH_TAC `(h:real->real) real_measurable_on (:real)` THEN + REWRITE_TAC[real_measurable_on] THEN + SUBGOAL_THEN + `IMAGE lift (:real) = (:real^1)` (fun th -> REWRITE_TAC[th]) THEN + REWRITE_TAC[EXTENSION; IN_IMAGE; IN_UNIV] THEN MESON_TAC[LIFT_DROP]; + SIMP_TAC[]]);; + +(* the norm-square integral of sum ip phi is integrable (it is in L^2). *) +let RECON_NORMSQ_INTEGRABLE = prove + (`!(f:real->complex) (P:(int#int#int)->bool). FINITE P + ==> (\x. lift(norm(vsum P (\s. carleson_ip f s * phi_sigma s carleson_phi + (drop x))) pow 2)) + integrable_on (:real^1)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:real->complex`; + `P:(int#int#int)->bool`] CARLESON_RECON_L2) THEN + ASM_REWRITE_TAC[lspace; IN_ELIM_THM] THEN + DISCH_THEN(MP_TAC o CONJUNCT2) THEN REWRITE_TAC[RPOW_POW]);; + +let GRAM_NORM_EQ = prove + (`!(f:real->complex) (P:(int#int#int)->bool). + (\z. f(drop z)) IN lspace (:real^1) (&2) /\ FINITE P + ==> norm(vsum P (\s. vsum P (\t. carleson_ip f s * cnj(carleson_ip f t) * + lproduct (:real^1) (\z. phi_sigma s carleson_phi (drop z)) + (\z. phi_sigma t carleson_phi (drop z))))) + = (lnorm (:real^1) (&2) + (\z. vsum P (\s. carleson_ip f s * phi_sigma s carleson_phi (drop + z)))) pow 2`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:real->complex`; + `P:(int#int#int)->bool`] CARLESON_NORMSQ_REAL) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + MP_TAC(ISPEC `\z. vsum P (\s. carleson_ip (f:real->complex) s * phi_sigma s + carleson_phi (drop z))` + LNORM2_SQ) THEN + ASM_SIMP_TAC[CARLESON_RECON_L2] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[COMPLEX_NORM_CX; REAL_ABS_REFL] THEN + MATCH_MP_TAC INTEGRAL_DROP_POS THEN + ASM_SIMP_TAC[RECON_NORMSQ_INTEGRABLE; LIFT_DROP; REAL_LE_POW_2]);; + +let DELTA_SQ_LE_GRAM = prove + (`!(f:real->complex) (P:(int#int#int)->bool). + (\z. f(drop z)) IN lspace (:real^1) (&2) /\ FINITE P /\ + lnorm (:real^1) (&2) (\z. f(drop z)) <= &1 + ==> (delta_f f P) pow 2 + <= norm(vsum P (\s. vsum P (\t. carleson_ip f s * cnj(carleson_ip f t) + * + lproduct (:real^1) (\z. phi_sigma s carleson_phi (drop z)) + (\z. phi_sigma t carleson_phi (drop z)))))`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[GRAM_NORM_EQ] THEN REWRITE_TAC[delta_f] THEN + MP_TAC(ISPECL [`f:real->complex`; + `P:(int#int#int)->bool`] CARLESON_286J_SECOND) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(lnorm (:real^1) (&2) (\z. f(drop z)) * + lnorm (:real^1) (&2) + (\z. vsum P (\s. carleson_ip f s * phi_sigma s carleson_phi + (drop z)))) pow 2` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_POW_LE2 THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[delta_f] THEN MATCH_MP_TAC SUM_POS_LE THEN + REWRITE_TAC[REAL_LE_POW_2]; + REWRITE_TAC[REAL_POW_MUL] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_POW_1_LE THEN CONJ_TAC THENL + [MATCH_MP_TAC LNORM_POS_LE THEN ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]]; + REWRITE_TAC[REAL_LE_POW_2]]]);; + +(* ========================================================================= *) +(* 286K off-diagonal routing. The off-diagonal Gram block norm is bounded by *) +(* sum_s || * inr_s, where inr_s = sum_{t in P, J_t<>J_s} *) +(* || * || is the (combined-direction) H_j inner sum. *) +(* CARLESON_OFFBLOCK_TRIANGLE (norm(offdiag) <= sum_s sum_t *) +(* |ip_s||<..>||ip_t|) *) +(* + SUM_LMUL (pull |ip_s| out of the inner t-sum). *) +(* ========================================================================= *) +let OFFDIAG_LE_INR = prove + (`!(f:real->complex) (P:(int#int#int)->bool). FINITE P + ==> norm(vsum P (\s. vsum {t | t IN P /\ ~(tile_J t = tile_J s)} (\t. + carleson_ip f s * cnj(carleson_ip f t) * + lproduct (:real^1) (\z. phi_sigma s carleson_phi (drop z)) + (\z. phi_sigma t carleson_phi (drop z))))) + <= sum P (\s. norm(carleson_ip f s) * + sum {t | t IN P /\ ~(tile_J t = tile_J s)} (\t. + norm(integral (:real^1) (\z. phi_sigma s carleson_phi + (drop z) * + cnj(phi_sigma t carleson_phi + (drop z)))) * + norm(carleson_ip f t)))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:real->complex`; + `P:(int#int#int)->bool`] CARLESON_OFFBLOCK_TRIANGLE) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REAL_ARITH `a = b ==> x <= a ==> x <= b`) THEN + MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `s:int#int#int` THEN DISCH_TAC THEN + REWRITE_TAC[] THEN + REWRITE_TAC[GSYM SUM_LMUL] THEN MATCH_MP_TAC SUM_EQ THEN + X_GEN_TAC `t:int#int#int` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + REAL_ARITH_TAC);; + +(* ========================================================================= *) +(* 286K Gram-bound roof (combined-inr form). From alpha^2 <= C3 alpha + off *) +(* and off <= sqrt(alpha) sqrt(K alpha) (= the OFFBLOCK_CS output with the *) +(* H_j *) +(* square-sum K), conclude alpha <= C3 + sqrt K. The off-diagonal handling *) +(* uses the COMBINED inr (all J_t<>J_s) so there is a single off term (no *) +(* factor-2 sub-block split); the constant C3+sqrt K is a valid C6/4 -- 286M *) +(* only needs SOME C6. *) +(* ========================================================================= *) +let GRAM_COMBINE_SQRT = prove + (`!alpha C3 K off. + &0 <= alpha /\ &0 <= C3 /\ &0 <= K /\ + alpha pow 2 <= C3 * alpha + off /\ + off <= sqrt(alpha) * sqrt(K * alpha) + ==> alpha <= C3 + sqrt K`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&0 <= sqrt K /\ + sqrt alpha * sqrt(K * alpha) = sqrt K * alpha /\ + (C3 + sqrt K) * alpha = C3 * alpha + sqrt K * alpha` + STRIP_ASSUME_TAC THENL + [REWRITE_TAC[SQRT_POS_LE; REAL_ADD_RDISTRIB] THEN + REWRITE_TAC[SQRT_MUL] THEN + ONCE_REWRITE_TAC[REAL_ARITH `sa * sK * sa2 = sK * (sa * sa2):real`] THEN + ASM_SIMP_TAC[GSYM REAL_POW_2; SQRT_POW_2]; ALL_TAC] THEN + MATCH_MP_TAC GRAM_ALPHA_BOUND THEN + ASM_SIMP_TAC[REAL_LE_ADD; SQRT_POS_LE] THEN + ASM_REAL_ARITH_TAC);; + +(* ========================================================================= *) +(* 286K a-iii disjointness, same-J case (pure geometry). Distinct tiles with *) +(* the SAME frequency cell J have DISJOINT spatial cells I: J_s=J_t fixes k *) +(* and *) +(* nJ (DYHO_INJ), so s<>t forces nI_s<>nI_t, and same-scale dyadic I-cells *) +(* with *) +(* different index are disjoint (DYHO_DISJOINT_SAMESCALE). This is the *) +(* trivial *) +(* half of Fremlin's a-iii "distinct P'-tiles with meeting J^l have disjoint *) +(* I"; *) +(* the different-J half needs the stopping-time ordering (first remark). *) +(* ========================================================================= *) +let AIII_SAMEJ_DISJOINT = prove + (`!s t:int#int#int. ~(s = t) /\ tile_J s = tile_J t ==> DISJOINT (tile_I s) + (tile_I t)`, + REWRITE_TAC[FORALL_PAIR_THM; tile_J; tile_I] THEN + MAP_EVERY X_GEN_TAC + [`ks:int`;`nIs:int`;`nJs:int`;`kt:int`;`nIt:int`;`nJt:int`] THEN + STRIP_TAC THEN + FIRST_ASSUM(STRIP_ASSUME_TAC o MATCH_MP DYHO_INJ) THEN + FIRST_X_ASSUM(fun th -> if concl th = `ks:int = kt` then SUBST_ALL_TAC th + else NO_TAC) THEN + MATCH_MP_TAC DYHO_DISJOINT_SAMESCALE THEN + FIRST_X_ASSUM(MP_TAC o check(fun th -> is_neg(concl th))) THEN + REWRITE_TAC[PAIR_EQ] THEN ASM_REWRITE_TAC[] THEN INT_ARITH_TAC);; + +(* ========================================================================= *) +(* 286K a-iii FIRST-remark geometric core. Given the stopping-time fact *) +(* ~(tile_ler sigma tauj) [Fremlin: sigma NOT >= tau_j], the J^r-nesting *) +(* J^r_tauj SUBSET J^r_sigma, and the scale order k_tauj <= k_sigma, the *) +(* I-cells *) +(* are disjoint. (~tile_ler with the J^r-nesting forces ~(I_sigma SUBSET *) +(* I_tauj), then TILE_I_FINER_NOT_SUBSET_DISJOINT.) This isolates the pure *) +(* geometry; the stopping-time construction supplies ~tile_ler + the *) +(* J^r-nesting. *) +(* ========================================================================= *) +let ENERGY_TREE_FAMILY_FINITE = prove + (`!(P:(int#int#int)->bool). FINITE P + ==> FINITE {tile_tree P tau | tau IN (:int#int#int)}`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `{A:(int#int#int)->bool | A SUBSET P}` THEN + ASM_SIMP_TAC[FINITE_POWERSET] THEN + REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; IN_ELIM_THM; IN_UNIV] THEN + X_GEN_TAC `tau:int#int#int` THEN + REWRITE_TAC[tile_tree; SUBSET; IN_ELIM_THM] THEN MESON_TAC[]);; + +(* ========================================================================= *) +(* 286K a-iii FIRST-remark core, Fremlin-faithful J-ORDER version. Fremlin's *) +(* order is tau <= sigma <=> J_tau SUBSET J_sigma /\ I_sigma SUBSET I_tau *) +(* (286F), so our tile_le sigma tauj = (tauj <= sigma in Fremlin) uses the J *) +(* cell (not J^r). The FIRST remark deduces I disjoint from "sigma NOT >= *) +(* tauj" *) +(* (~tile_le sigma tauj) TOGETHER WITH J_tauj SUBSET J_sigma [from J_tauj *) +(* SUBSET *) +(* J^l_sigma SUBSET J_sigma]: these force ~(I_sigma SUBSET I_tauj), then *) +(* TILE_I_FINER_NOT_SUBSET_DISJOINT (k_tauj <= k_sigma). *) +(* (AIII_FIRST_CORE @earlier used tile_ler/J^r -- a true but NOT directly *) +(* usable *) +(* sibling, since J_tauj SUBSET J_sigma does NOT give J^r_tauj SUBSET *) +(* J^r_sigma.) *) +(* ========================================================================= *) +let AIII_FIRST_CORE_LE = prove + (`!sigma tauj:int#int#int. + ~(tile_le sigma tauj) /\ tile_J tauj SUBSET tile_J sigma /\ + tile_k tauj <= tile_k sigma + ==> DISJOINT (tile_I sigma) (tile_I tauj)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC TILE_I_FINER_NOT_SUBSET_DISJOINT THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN + UNDISCH_TAC `~(tile_le sigma tauj)` THEN REWRITE_TAC[tile_le] THEN + ASM_REWRITE_TAC[]);; + + +(* ========================================================================= *) +(* 286J(c) within-fiber disjointness (Fremlin mt286.tex 919-923). The base *) +(* intervals of two distinct greedy-R members that share a common coarser *) +(* root *) +(* (both finer in space, both meeting the root's frequency cell) are *) +(* disjoint. *) +(* ========================================================================= *) + +(* tile_le is antisymmetric: I and J each determine the tile's (k,index) via *) +(* DYHO_INJ, so mutual <= forces equality. *) +let TILE_LE_ANTISYM = prove + (`!s t:int#int#int. tile_le s t /\ tile_le t s ==> s = t`, + MATCH_MP_TAC(MESON[PAIR_SURJECTIVE] + `(!a b c a' b' c'. P((a,b,c):int#int#int) ((a',b',c'):int#int#int)) + ==> (!s t. P s t)`) THEN + REPEAT GEN_TAC THEN REWRITE_TAC[tile_le; tile_I; tile_J] THEN + REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ] THEN STRIP_TAC THEN + SUBGOAL_THEN `dyho (--a) b = dyho (--a') b' /\ dyho a c = dyho a' c'` + MP_TAC THENL [ASM_REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ]; ALL_TAC] THEN + DISCH_THEN(CONJUNCTS_THEN (STRIP_ASSUME_TAC o MATCH_MP DYHO_INJ)) THEN + REWRITE_TAC[PAIR_EQ] THEN ASM_INT_ARITH_TAC);; + +(* the greedy minimal-witness R is an antichain: distinct members are *) +(* tile_le-incomparable (else minimality + antisymmetry collapse them). *) +let CARLESON_JR_ANTICHAIN = prove + (`!E h c P r1 r2:int#int#int. + r1 IN carleson_jR E h c P /\ r2 IN carleson_jR E h c P /\ ~(r1 = r2) + ==> ~(tile_le r1 r2)`, + REPEAT GEN_TAC THEN REWRITE_TAC[carleson_jR; IN_ELIM_THM] THEN STRIP_TAC THEN + DISCH_TAC THEN + UNDISCH_TAC `~(r1:int#int#int = r2)` THEN REWRITE_TAC[] THEN + MATCH_MP_TAC TILE_LE_ANTISYM THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `r2:int#int#int` o + check(fun th -> is_forall(concl th) && free_in `r1:int#int#int` (concl + th))) THEN + ASM_REWRITE_TAC[]);; + +(* frequency-cell nesting reflects the scale order (J = dyho tile_k). *) +let TILE_J_SUBSET_SCALE = prove + (`!s t:int#int#int. tile_J s SUBSET tile_J t ==> tile_k s <= tile_k t`, + MATCH_MP_TAC(MESON[PAIR_SURJECTIVE] + `(!a b c a' b' c'. P((a,b,c):int#int#int)((a',b',c'):int#int#int)) + ==> (!s t. P s t)`) THEN + REPEAT GEN_TAC THEN REWRITE_TAC[tile_J; tile_k] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`a:int`;`c:int`;`a':int`;`c':int`] DYHO_SUBSET_SCALE) THEN + ASM_REWRITE_TAC[]);; + +(* antichain + nested J => disjoint I (via AIII_FIRST_CORE_LE). *) +let TILE_ANTICHAIN_JNEST_DISJOINT = prove + (`!s t:int#int#int. ~(tile_le t s) /\ tile_J s SUBSET tile_J t + ==> DISJOINT (tile_I t) (tile_I s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC AIII_FIRST_CORE_LE THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC TILE_J_SUBSET_SCALE THEN + ASM_REWRITE_TAC[]);; + +(* frequency cells are laminar (dyho trichotomy). *) +let TILE_J_TRICHOTOMY = prove + (`!s t:int#int#int. + tile_J s SUBSET tile_J t \/ tile_J t SUBSET tile_J s \/ + DISJOINT (tile_J s) (tile_J t)`, + MATCH_MP_TAC(MESON[PAIR_SURJECTIVE] + `(!a1 b1 c1 a2 b2 c2. P((a1,b1,c1):int#int#int)((a2,b2,c2):int#int#int)) + ==> (!s t. P s t)`) THEN + REPEAT GEN_TAC THEN REWRITE_TAC[tile_J; DYHO_TRICHOTOMY]);; + +(* meeting frequency cells are comparable (drop the disjoint case). *) +let TILE_J_MEET_COMPARABLE = prove + (`!s t:int#int#int. ~(tile_J s INTER tile_J t = {}) + ==> tile_J s SUBSET tile_J t \/ tile_J t SUBSET tile_J s`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MP_TAC(ISPECL [`s:int#int#int`;`t:int#int#int`] TILE_J_TRICHOTOMY) THEN + REWRITE_TAC[DISJOINT] THEN ASM_REWRITE_TAC[] THEN MESON_TAC[]);; + +(* a coarser (smaller-scale) frequency cell that meets is contained. *) +let TILE_J_MEET_COARSER_SUBSET = prove + (`!m t:int#int#int. tile_k m <= tile_k t /\ ~(tile_J m INTER tile_J t = {}) + ==> tile_J m SUBSET tile_J t`, + MATCH_MP_TAC(MESON[PAIR_SURJECTIVE] + `(!a1 b1 c1 a2 b2 c2. P((a1,b1,c1):int#int#int)((a2,b2,c2):int#int#int)) + ==> (!m t. P m t)`) THEN + REPEAT GEN_TAC THEN REWRITE_TAC[tile_J; tile_k] THEN STRIP_TAC THEN + MATCH_MP_TAC DYHO_MEET_NEST THEN ASM_REWRITE_TAC[DISJOINT]);; + +(* THE within-fiber disjointness: two distinct antichain members, both finer *) +(* than a common root m (k_m <= k_ti) and both meeting m's frequency cell, *) +(* have *) +(* disjoint base intervals. Both J_ti include J_m (COARSER_SUBSET), so they *) +(* share *) +(* the nonempty J_m hence meet hence are comparable (MEET_COMPARABLE); then *) +(* the *) +(* antichain (incomparable in tile_le) forces I-disjointness *) +(* (ANTICHAIN_JNEST). *) +let TILE_FIBER_I_DISJOINT = prove + (`!m t1 t2:int#int#int. + tile_k m <= tile_k t1 /\ tile_k m <= tile_k t2 /\ + ~(tile_J t1 INTER tile_J m = {}) /\ ~(tile_J t2 INTER tile_J m = {}) /\ + ~(tile_le t1 t2) /\ ~(tile_le t2 t1) + ==> DISJOINT (tile_I t1) (tile_I t2)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `tile_J m SUBSET tile_J t1` ASSUME_TAC THENL + [MATCH_MP_TAC TILE_J_MEET_COARSER_SUBSET THEN ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[INTER_COMM] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `tile_J m SUBSET tile_J t2` ASSUME_TAC THENL + [MATCH_MP_TAC TILE_J_MEET_COARSER_SUBSET THEN ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[INTER_COMM] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `~(tile_J t1 INTER tile_J t2 = {})` ASSUME_TAC THENL + [MP_TAC(ISPEC `m:int#int#int` TILE_J_NONEMPTY) THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN ASM SET_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL [`t1:int#int#int`;`t2:int#int#int`] TILE_J_MEET_COMPARABLE) + THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THENL + [ONCE_REWRITE_TAC[DISJOINT_SYM] THEN + MATCH_MP_TAC TILE_ANTICHAIN_JNEST_DISJOINT THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC TILE_ANTICHAIN_JNEST_DISJOINT THEN ASM_REWRITE_TAC[]]);; + + +(* ========================================================================= *) +(* region measurability with a tile dilate (companion of SC_MEASURABLE, *) +(* whose *) +(* second factor is a dyho cell): {x in E : h x in J_s} cap I^(k)_s is *) +(* bounded *) +(* (inside the interval I^(k)_s) + a triple INTER of lebesgue-measurable *) +(* sets. *) +(* ========================================================================= *) +let SC_IDIL_MEASURABLE = prove + (`!(h:real->real) E s k. + real_lebesgue_measurable E /\ h real_measurable_on (:real) + ==> real_measurable ({x | x IN E /\ h x IN tile_J s} INTER tile_Idil s + k)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `real_bounded ({x | x IN E /\ (h:real->real) x IN tile_J s} INTER tile_Idil + s k)` + ASSUME_TAC THENL + [MATCH_MP_TAC REAL_BOUNDED_SUBSET THEN + EXISTS_TAC `tile_Idil s k` THEN + REWRITE_TAC[TILE_IDIL_INTERVAL; REAL_BOUNDED_REAL_INTERVAL; INTER_SUBSET]; + ALL_TAC] THEN + ASM_SIMP_TAC[GSYM REAL_LEBESGUE_MEASURABLE_IFF_MEASURABLE] THEN + SUBGOAL_THEN + `{x | x IN E /\ (h:real->real) x IN tile_J s} INTER tile_Idil s k = + (E INTER {x | (h:real->real) x IN tile_J s}) INTER tile_Idil s k` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM] THEN + MESON_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LEBESGUE_MEASURABLE_INTER THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LEBESGUE_MEASURABLE_INTER THEN ASM_REWRITE_TAC[] THEN + SPEC_TAC(`s:int#int#int`,`s:int#int#int`) THEN + REWRITE_TAC[FORALL_PAIR_THM; tile_J] THEN REPEAT GEN_TAC THEN + MATCH_MP_TAC H_PREIMAGE_DYHO_LEBESGUE THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_MEASURABLE_IMP_REAL_LEBESGUE_MEASURABLE THEN + REWRITE_TAC[TILE_IDIL_MEASURABLE]]);; + +(* tile-form of tile_I measurability (the base cell of any abstract tile). *) +let TILE_I_MEASURABLE_TILE = prove + (`!s:int#int#int. real_measurable(tile_I s)`, + MATCH_MP_TAC(MESON[PAIR_SURJECTIVE] + `(!a b c. P((a,b,c):int#int#int)) ==> (!s. P s)`) THEN + REWRITE_TAC[TILE_I_MEASURABLE]);; + +(* ========================================================================= *) +(* 286J(c) CONCRETE per-k tile bound (Fremlin mt286.tex 898-940). For a *) +(* finite *) +(* antichain Rk of tiles, each satisfying the R_k threshold *) +(* 2^{2k-9} gam <= 2^{k_t} mu({x in E : h x in J_t} cap I^(k)_t), *) +(* the greedy q-map (GREEDY_CAPTURE, product-meet + coarsest-first in *) +(* --tile_k) *) +(* gives a product-disjoint root set M, and CARLESON_RK_MEASURE_ABSTRACT *) +(* yields *) +(* gam * sum_{t in Rk} muI_t <= 2^{11-k} muE. *) +(* Discharge legs: base-containment TILE_I_SUBSET_IDIL4_ALLK; within-fiber *) +(* disjointness TILE_FIBER_I_DISJOINT (q coarser + product-J-meet + Rk *) +(* antichain); *) +(* container measure ZPOW2_ADD; threshold RK_GAMMUI_BRIDGE; region *) +(* measurability *) +(* SC_IDIL_MEASURABLE; root-region disjointness TILE_PRODMEET_SSET_DISJOINT. *) +(* ========================================================================= *) +let CARLESON_RK_TILE = prove + (`!(Rk:(int#int#int)->bool) (E:real->bool) (h:real->real) (k:num) gam. + FINITE Rk /\ &0 <= gam /\ + real_lebesgue_measurable E /\ real_measurable E /\ + h real_measurable_on (:real) /\ + (!t1 t2. t1 IN Rk /\ t2 IN Rk /\ ~(t1 = t2) ==> ~(tile_le t1 t2)) /\ + (!t. t IN Rk + ==> &2 zpow (&2 * &k - &9) * gam + <= &2 zpow (tile_k t) * + real_measure ({x | x IN E /\ h x IN tile_J t} INTER tile_Idil + t k)) + ==> gam * sum Rk (\t. &2 zpow (--(tile_k t))) + <= &2 zpow (&11 - &k) * real_measure E`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`\s t:int#int#int. ~(tile_Idil s k INTER tile_Idil t k = {}) /\ + ~(tile_J s INTER tile_J t = {})`; + `\t:int#int#int. --(tile_k t)`; + `Rk:(int#int#int)->bool`] GREEDY_CAPTURE) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MAP_EVERY X_GEN_TAC [`u:int#int#int`; `v:int#int#int`] THEN BETA_TAC THEN + DISCH_TAC THEN MATCH_MP_TAC TILE_PRODMEET_SYM THEN ASM_REWRITE_TAC[]; + GEN_TAC THEN BETA_TAC THEN REWRITE_TAC[TILE_PRODMEET_REFL]]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `M:(int#int#int)->bool` + (X_CHOOSE_THEN `q:(int#int#int)->(int#int#int)` MP_TAC)) THEN + BETA_TAC THEN STRIP_TAC THEN + MP_TAC(ISPECL + [`Rk:(int#int#int)->bool`; `M:(int#int#int)->bool`; + `q:(int#int#int)->(int#int#int)`; + `tile_I:(int#int#int)->real->bool`; + `\t:int#int#int. tile_Idil t (k + 2)`; + `\t:int#int#int. {x | x IN E /\ h x IN tile_J t} INTER tile_Idil t k`; + `\t:int#int#int. &2 zpow (--(tile_k t))`; + `k:num`; `gam:real`; `E:real->bool`] CARLESON_RK_MEASURE_ABSTRACT) THEN + BETA_TAC THEN ASM_REWRITE_TAC[] THEN + ANTS_TAC THENL [ALL_TAC; DISCH_THEN ACCEPT_TAC] THEN + REPEAT CONJ_TAC THENL + [(* leg 1: tile_I t SUBSET tile_Idil (q t) (k+2) *) + X_GEN_TAC `t:int#int#int` THEN DISCH_TAC THEN + MATCH_MP_TAC TILE_I_SUBSET_IDIL4_ALLK THEN + FIRST_X_ASSUM(MP_TAC o SPEC `t:int#int#int` o + check(fun th -> free_in `q:(int#int#int)->(int#int#int)` (concl th))) + THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN CONJ_TAC THENL + [POP_ASSUM MP_TAC THEN INT_ARITH_TAC; ASM_REWRITE_TAC[]]; + (* leg 2: within-fiber base-I disjoint *) + MAP_EVERY X_GEN_TAC [`t1:int#int#int`; `t2:int#int#int`] THEN + STRIP_TAC THEN + MATCH_MP_TAC TILE_FIBER_I_DISJOINT THEN + EXISTS_TAC `q(t1:int#int#int):int#int#int` THEN + SUBGOAL_THEN + `(~(tile_Idil t1 k INTER tile_Idil (q t1) k = {}) /\ + ~(tile_J t1 INTER tile_J (q t1) = {})) /\ + --tile_k t1 <= --tile_k (q(t1:int#int#int))` ASSUME_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `(~(tile_Idil t2 k INTER tile_Idil (q t2) k = {}) /\ + ~(tile_J t2 INTER tile_J (q t2) = {})) /\ + --tile_k t2 <= --tile_k (q(t2:int#int#int))` ASSUME_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + REPEAT CONJ_TAC THENL + [POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN INT_ARITH_TAC; + FIRST_X_ASSUM(SUBST1_TAC o check(fun th -> is_eq(concl th))) THEN + POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN INT_ARITH_TAC; + ASM_REWRITE_TAC[]; + FIRST_X_ASSUM(fun th -> SUBST1_TAC th ORELSE SUBST1_TAC(SYM th)) THEN + ASM_REWRITE_TAC[]; + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]; + (* leg 3: tile_I measurable + measure *) + X_GEN_TAC `t:int#int#int` THEN DISCH_TAC THEN CONJ_TAC THENL + [REWRITE_TAC[TILE_I_MEASURABLE_TILE]; + SPEC_TAC(`t:int#int#int`,`u:int#int#int`) THEN + MATCH_MP_TAC(MESON[PAIR_SURJECTIVE] + `(!a b c. P((a,b,c):int#int#int)) ==> (!s. P s)`) THEN + REWRITE_TAC[TILE_I_MEASURE; tile_k]]; + (* leg 4: Ione4 measurable + measure = 2^{k+2} muI *) + X_GEN_TAC `m:int#int#int` THEN DISCH_TAC THEN + REWRITE_TAC[TILE_IDIL_MEASURABLE; TILE_IDIL_MEASURE] THEN + SUBGOAL_THEN `&(k + 2) - tile_k m = (&k + &2) + (--(tile_k m)):int` + SUBST1_TAC THENL + [REWRITE_TAC[GSYM INT_OF_NUM_ADD] THEN INT_ARITH_TAC; + REWRITE_TAC[ZPOW2_ADD]]; + (* leg 5: threshold gam muI <= 2^{9-2k} muSset via RK_GAMMUI_BRIDGE *) + X_GEN_TAC `m:int#int#int` THEN DISCH_TAC THEN + SUBGOAL_THEN `(m:int#int#int) IN Rk` ASSUME_TAC THENL + [ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN + MATCH_MP_TAC RK_GAMMUI_BRIDGE THEN + UNDISCH_TAC + `!t. t IN Rk ==> &2 zpow (&2 * &k - &9) * gam <= &2 zpow (tile_k t) * + real_measure ({x | x IN E /\ h x IN tile_J t} INTER + tile_Idil t k)` THEN + DISCH_THEN(MP_TAC o SPEC `m:int#int#int`) THEN ASM_REWRITE_TAC[]; + (* leg 6: Sset measurable + SUBSET E *) + X_GEN_TAC `m:int#int#int` THEN DISCH_TAC THEN CONJ_TAC THENL + [MATCH_MP_TAC SC_IDIL_MEASURABLE THEN ASM_REWRITE_TAC[]; SET_TAC[]]; + (* leg 7: Sset pairwise disjoint on M *) + MAP_EVERY X_GEN_TAC [`m1:int#int#int`; `m2:int#int#int`] THEN + STRIP_TAC THEN + MATCH_MP_TAC TILE_PRODMEET_SSET_DISJOINT THEN + UNDISCH_TAC + `!m1 m2. m1 IN M /\ m2 IN M /\ ~(m1 = m2) + ==> ~(~(tile_Idil m1 k INTER tile_Idil m2 k = {}) /\ + ~(tile_J m1 INTER tile_J m2 = {}))` THEN + DISCH_THEN(MP_TAC o SPECL [`m1:int#int#int`; `m2:int#int#int`]) THEN + ASM_REWRITE_TAC[]]);; + + +(* ========================================================================= *) +(* 286J(d): the geometric k-sum (Fremlin mt286.tex 944-950). gamma sum_R muI *) +(* = sum_k gamma sum_{R_k} muI <= sum_k 2^{11-k} muE <= 2^12 muE. *) +(* ========================================================================= *) + +(* 2^{11-k} as reals (k:num) = 2^11 * (1/2)^k. *) +let ZPOW_11_MINUS_K = prove + (`!k:num. &2 zpow (&11 - &k) = &2 pow 11 * inv(&2) pow k`, + GEN_TAC THEN SIMP_TAC[REAL_ZPOW_SUB; REAL_OF_NUM_EQ; ARITH_EQ] THEN + REWRITE_TAC[REAL_ZPOW_NUM; real_div; REAL_INV_POW; GSYM REAL_POW_INV]);; + +(* the abstract k-sum: a finite family R, a level assignment kof, per-level *) +(* bounds *) +(* gamma sum_{t in R, kof t = k} muI <= 2^{11-k} muE, gives the geometric *) +(* total *) +(* gamma sum_R muI <= 2^12 muE. Regroup by kof-fibers (SUM_IMAGE_GEN), bound *) +(* each *) +(* by the hypothesis, and collapse the geometric series *) +(* (SUM_HALF_POW_SCALED_LE *) +(* with c = 2^11 muE, giving <= 2 c = 2^12 muE). *) +let CARLESON_KSUM_GEOM = prove + (`!(R:A->bool) (kof:A->num) (muI:A->real) gam E. + FINITE R /\ &0 <= gam /\ &0 <= E /\ (!t. t IN R ==> &0 <= muI t) /\ + (!k. gam * sum {t | t IN R /\ kof t = k} muI <= &2 zpow (&11 - &k) * E) + ==> gam * sum R muI <= &2 pow 12 * E`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`kof:A->num`; `muI:A->real`; `R:A->bool`] SUM_IMAGE_GEN) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[GSYM SUM_LMUL] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum (IMAGE (kof:A->num) R) (\k. &2 zpow (&11 - &k) * E)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN + REWRITE_TAC[FORALL_IN_IMAGE] THEN X_GEN_TAC `t:A` THEN DISCH_TAC THEN + REWRITE_TAC[SUM_LMUL] THEN ASM_SIMP_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[ZPOW_11_MINUS_K] THEN + SUBGOAL_THEN + `sum (IMAGE (kof:A->num) R) (\k. (&2 pow 11 * inv (&2) pow k) * E) = + sum (IMAGE (kof:A->num) R) (\k. (&2 pow 11 * E) * inv (&2) pow k)` + SUBST1_TAC THENL + [MATCH_MP_TAC SUM_EQ THEN REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&2 * (&2 pow 11 * E)` THEN CONJ_TAC THENL + [MATCH_MP_TAC SUM_HALF_POW_SCALED_LE THEN ASM_SIMP_TAC[FINITE_IMAGE] THEN + MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_POW_LE THEN REAL_ARITH_TAC; + REWRITE_TAC[REAL_ARITH `&2 * (&2 pow 11 * E) = (&2 * &2 pow 11) * E`] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN ASM_REWRITE_TAC[] THEN + CONV_TAC REAL_RAT_REDUCE_CONV]);; + + +(* ========================================================================= *) +(* every witness-set member (hence every greedy-R member) carries a large *) +(* region integral (Fremlin's sigma' with int_{E cap g^-1[J]} w > gamma/4). *) +(* ========================================================================= *) +let CARLESON_JWITSET_REGION_INTEGRAL = prove + (`!E h c P t:int#int#int. + (!t. cw_tile t real_integrable_on {x | x IN E /\ h x IN tile_J t}) /\ + t IN carleson_jwitset E h c P + ==> c < real_integral {x | x IN E /\ h x IN tile_J t} (cw_tile t)`, + REPEAT GEN_TAC THEN REWRITE_TAC[carleson_jwitset; IN_ELIM_THM] THEN + STRIP_TAC THEN + FIRST_X_ASSUM(fun th -> ASSUME_TAC(SYM th) ORELSE ASSUME_TAC th) THEN + MP_TAC(ISPECL [`E:real->bool`;`h:real->real`;`c:real`;`sigma:int#int#int`] + CARLESON_JWIT_SPEC) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_MESON_TAC[]);; + +let CARLESON_JR_SUBSET_WITSET = prove + (`!E h c P:(int#int#int)->bool. + carleson_jR E h c P SUBSET carleson_jwitset E h c P`, + REWRITE_TAC[carleson_jR; SUBSET; IN_ELIM_THM] THEN MESON_TAC[]);; + +(* a real-lebesgue-measurable subset of a finite-measure set is measurable *) +(* (the region E cap g^-1[J] need not be bounded, but it sits inside E). *) +let REAL_MEASURABLE_LEBMEAS_SUBSET = prove + (`!s t. real_lebesgue_measurable s /\ real_measurable t /\ s SUBSET t + ==> real_measurable s`, + REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_MEASURABLE_MEASURABLE] THEN + MATCH_MP_TAC MEASURABLE_LEBESGUE_MEASURABLE_SUBSET THEN + EXISTS_TAC `IMAGE lift t` THEN + ASM_REWRITE_TAC[GSYM REAL_LEBESGUE_MEASURABLE; + GSYM REAL_MEASURABLE_MEASURABLE] THEN + MATCH_MP_TAC IMAGE_SUBSET THEN ASM_REWRITE_TAC[]);; + +(* RK_TILE with the frequency map h existentially bundled in the hypotheses, *) +(* so MATCH_MP_TAC determines Rk/E/k/gam from the conclusion and h is *) +(* supplied via EXISTS_TAC (a plain ISPECL is blocked when the instantiation *) +(* mentions goal- context variables). *) +let CARLESON_RK_TILE_EX = prove + (`!(Rk:(int#int#int)->bool) (E:real->bool) (k:num) gam. + FINITE Rk /\ &0 <= gam /\ + real_lebesgue_measurable E /\ real_measurable E /\ + (?h. h real_measurable_on (:real) /\ + (!t1 t2. t1 IN Rk /\ t2 IN Rk /\ ~(t1 = t2) ==> ~(tile_le t1 t2)) /\ + (!t. t IN Rk ==> &2 zpow (&2 * &k - &9) * gam <= &2 zpow (tile_k t) * + real_measure ({x | x IN E /\ h x IN tile_J t} INTER tile_Idil + t k))) + ==> gam * sum Rk (\t. &2 zpow (--(tile_k t))) + <= &2 zpow (&11 - &k) * real_measure E`, + REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC CARLESON_RK_TILE THEN + EXISTS_TAC `h:real->real` THEN ASM_REWRITE_TAC[]);; + +(* geometric k-sum with an EXISTENTIAL level assignment in the hypothesis, *) +(* so it is applied by MATCH_MP_TAC (no KFUN to instantiate; supply via *) +(* EXISTS_TAC). *) +let KSUM_GEOM_EX = prove + (`!(RR:(int#int#int)->bool) (WT:(int#int#int)->real) gg EE. + FINITE RR /\ &0 <= gg /\ &0 <= EE /\ (!t. t IN RR ==> &0 <= WT t) /\ + (?KFUN. !k. gg * sum {t | t IN RR /\ KFUN t = k} WT <= &2 zpow (&11 - &k) + * EE) + ==> gg * sum RR WT <= &2 pow 12 * EE`, + REPEAT GEN_TAC THEN STRIP_TAC THEN MATCH_MP_TAC CARLESON_KSUM_GEOM THEN + EXISTS_TAC `KFUN:(int#int#int)->num` THEN ASM_REWRITE_TAC[]);; + +(* ========================================================================= *) +(* 286J(c)+(d) COMBINED: the greedy-R measure budget gam^2 sum_R muI <= 2^12 *) +(* muE *) +(* (Fremlin mt286.tex 896-950), R = carleson_jR at threshold gam^2/4. *) +(* MATCH_MP_TAC *) +(* KSUM_GEOM_EX; supply the level assignment KFUN t = a dichotomy witness; *) +(* per fiber *) +(* CARLESON_RK_TILE. All terms spelled out (no ABBREV/SKOLEM -- *) +(* context-bound R/kof *) +(* block ISPECL of the tile lemmas). *) +(* ========================================================================= *) +let CARLESON_JR_BUDGET = prove + (`!(f:real->complex) E h P gam. + FINITE P /\ &0 < gam /\ + real_lebesgue_measurable E /\ real_measurable E /\ + h real_measurable_on (:real) /\ + (!t. cw_tile t real_integrable_on {x | x IN E /\ h x IN tile_J t}) + ==> gam pow 2 * + sum (carleson_jR E h (gam pow 2 / &4) P) (\t. &2 zpow (--(tile_k t))) + <= &2 pow 12 * real_measure E`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC KSUM_GEOM_EX THEN REPEAT CONJ_TAC THENL + [ASM_SIMP_TAC[CARLESON_JR_FINITE]; + REWRITE_TAC[REAL_LE_POW_2]; + MATCH_MP_TAC REAL_MEASURE_POS_LE THEN ASM_REWRITE_TAC[]; + X_GEN_TAC `t:int#int#int` THEN DISCH_TAC THEN + REWRITE_TAC[REAL_LE_INV_EQ] THEN MATCH_MP_TAC REAL_ZPOW_LE THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + EXISTS_TAC + `\t:int#int#int. @m. &2 zpow (&2 * &m - &9) * (gam pow 2) + <= &2 zpow (tile_k t) * + real_measure ({x | x IN E /\ h x IN tile_J t} + INTER tile_Idil t m)` THEN + X_GEN_TAC `k:num` THEN CONV_TAC(ONCE_DEPTH_CONV BETA_CONV) THEN + MATCH_MP_TAC CARLESON_RK_TILE_EX THEN + ASM_REWRITE_TAC[REAL_LE_POW_2] THEN CONJ_TAC THENL + [(* FINITE fiber *) + MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `carleson_jR E h (gam pow 2 / &4) P` THEN + ASM_SIMP_TAC[CARLESON_JR_FINITE] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN SIMP_TAC[]; + ALL_TAC] THEN + EXISTS_TAC `h:real->real` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [(* antichain *) + MAP_EVERY X_GEN_TAC [`t1:int#int#int`; `t2:int#int#int`] THEN + REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN + MATCH_MP_TAC CARLESON_JR_ANTICHAIN THEN + MAP_EVERY EXISTS_TAC + [`E:real->bool`; `h:real->real`; `gam pow 2 / &4`; + `P:(int#int#int)->bool`] THEN + ASM_REWRITE_TAC[]; + (* R_k threshold: the SELECT value satisfies the threshold and equals k *) + X_GEN_TAC `t:int#int#int` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + CONV_TAC SELECT_CONV THEN + ABBREV_TAC `g2 = gam pow 2` THEN + MATCH_MP_TAC CWTILE_MASS_DICHOTOMY THEN + REWRITE_TAC[REAL_LE_POW_2] THEN CONJ_TAC THENL + [(* region measurable: lebesgue-measurable subset of finite-measure E *) + MATCH_MP_TAC REAL_MEASURABLE_LEBMEAS_SUBSET THEN + EXISTS_TAC `E:real->bool` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `{x | x IN E /\ (h:real->real) x IN tile_J t} SUBSET E /\ + real_lebesgue_measurable {x | x IN E /\ (h:real->real) x IN tile_J t}` + (fun th -> REWRITE_TAC[th]) THEN + CONJ_TAC THENL + [SET_TAC[]; + SUBGOAL_THEN `{x | x IN E /\ (h:real->real) x IN tile_J t} = + (E INTER {x | (h:real->real) x IN tile_J t})` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM] THEN + MESON_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LEBESGUE_MEASURABLE_INTER THEN ASM_REWRITE_TAC[] THEN + SPEC_TAC(`t:int#int#int`,`t:int#int#int`) THEN + REWRITE_TAC[FORALL_PAIR_THM; tile_J] THEN REPEAT GEN_TAC THEN + MATCH_MP_TAC H_PREIMAGE_DYHO_LEBESGUE THEN ASM_REWRITE_TAC[]]; + (* gam^2/4 < int region: R member witness *) + MATCH_MP_TAC CARLESON_JWITSET_REGION_INTEGRAL THEN + EXISTS_TAC `P:(int#int#int)->bool` THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`E:real->bool`;`h:real->real`;`gam pow 2 / &4`; + `P:(int#int#int)->bool`] CARLESON_JR_SUBSET_WITSET) THEN + ASM SET_TAC[]]]);; + + +(* ========================================================================= *) +(* 286J (Fremlin's mass lemma), C5 = 2^12. The greedy R = carleson_jR at *) +(* threshold gam^2/4 gives the mass budget: for finite P with mass_Eh <= *) +(* gam^2, *) +(* the extracted R^+ removes the heavy tiles (mass residual <= gam^2/4, *) +(* CARLESON_JMASS_BOUND) while gam^2 sum_R muI <= 2^12 muE <= 2^12 (muE <= *) +(* 1, *) +(* CARLESON_JR_BUDGET). This discharges the carleson_mass_budget interface *) +(* consumed by 286M. *) +(* ========================================================================= *) +let CARLESON_286J = prove + (`?C5. &0 <= C5 /\ + !(f:real->complex) E h. + real_lebesgue_measurable E /\ real_measurable E /\ + real_measure E <= &1 /\ h real_measurable_on (:real) + ==> carleson_mass_budget f E h C5`, + EXISTS_TAC `&2 pow 12` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_POW_LE THEN REAL_ARITH_TAC; ALL_TAC] THEN + REPEAT GEN_TAC THEN STRIP_TAC THEN + REWRITE_TAC[carleson_mass_budget] THEN + MAP_EVERY X_GEN_TAC [`P:(int#int#int)->bool`; `gam:real`] THEN STRIP_TAC THEN + EXISTS_TAC `carleson_jR E h (gam pow 2 / &4) P` THEN + REPEAT CONJ_TAC THENL + [ASM_SIMP_TAC[CARLESON_JR_FINITE]; + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&2 pow 12 * real_measure E` THEN CONJ_TAC THENL + [MATCH_MP_TAC CARLESON_JR_BUDGET THEN ASM_REWRITE_TAC[]; + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_POW_LE THEN REAL_ARITH_TAC]; + MATCH_MP_TAC CARLESON_JMASS_BOUND THEN ASM_REWRITE_TAC[]]);; + +(* ========================================================================= *) +(* 286K a-iii DIFFERENT-J disjointness (Fremlin second remark, non-same-J *) +(* case). *) +(* Skeleton: given J_sigma SUBSET J^l_tau [one branch of the *) +(* meeting-dichotomy], *) +(* sigma's tree-root rho (tile_ler sigma rho), and the STOPPING-TIME fact *) +(* ~(tile_le tau rho) [tau not above sigma's root], the spatial cells are *) +(* disjoint. Chains: tile_ler->tile_le (TILE_LER_IMP_LE) gives J_rho SUBSET *) +(* J_sigma SUBSET J^l_tau SUBSET J_tau, k_rho<=k_tau; *) +(* AIII_FIRST_CORE_LE(tau,rho) *) +(* gives DISJOINT I_tau I_rho; AIII_DIFFJ_STEP lifts to DISJOINT I_sigma *) +(* I_tau *) +(* (via I_sigma SUBSET I_rho). *) +(* ========================================================================= *) + +let AIII_DIFFJ_STEP = prove + (`!sigma tau rho:int#int#int. + tile_le sigma rho /\ DISJOINT (tile_I tau) (tile_I rho) + ==> DISJOINT (tile_I sigma) (tile_I tau)`, + REPEAT GEN_TAC THEN REWRITE_TAC[tile_le] THEN STRIP_TAC THEN + REWRITE_TAC[DISJOINT] THEN + MP_TAC(ASSUME `DISJOINT (tile_I tau) (tile_I rho)`) THEN + REWRITE_TAC[DISJOINT] THEN + MP_TAC(ASSUME `tile_I sigma SUBSET tile_I rho`) THEN SET_TAC[]);; + +let AIII_DIFFJ_BRANCH = prove + (`!sigma tau rho:int#int#int. + tile_J sigma SUBSET tile_Jl tau /\ tile_ler sigma rho /\ ~(tile_le tau + rho) + ==> DISJOINT (tile_I sigma) (tile_I tau)`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP TILE_LER_IMP_LE) THEN + SUBGOAL_THEN `tile_J rho SUBSET tile_J tau` ASSUME_TAC THENL + [MP_TAC(ISPEC `tau:int#int#int` TILE_JL_SUBSET_J) THEN + RULE_ASSUM_TAC(REWRITE_RULE[tile_le]) THEN ASM SET_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `tile_k rho <= tile_k tau` ASSUME_TAC THENL + [MATCH_MP_TAC TILE_JL_SUBSET_KLE THEN + RULE_ASSUM_TAC(REWRITE_RULE[tile_le]) THEN ASM SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC AIII_DIFFJ_STEP THEN EXISTS_TAC `rho:int#int#int` THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC AIII_FIRST_CORE_LE THEN ASM_REWRITE_TAC[]);; + +(* ========================================================================= *) +(* 286K a-i scale bound: every member of a down-cone tree has scale >= the *) +(* root's scale. sigma IN tile_tree P tau (= tile_ler sigma tau) => k_tau <= *) +(* k_sigma (TILE_LER_SCALE). Hence on any NON-EMPTY achievable tree value A, *) +(* the root scales k_tau are bounded above by min_{sigma in A} k_sigma -- so *) +(* a *) +(* MAXIMAL-scale representative exists (Fremlin 286K a-i R~). *) +(* ========================================================================= *) +let TREE_KBOUND = prove + (`!P tau sigma:int#int#int. sigma IN tile_tree P tau ==> tile_k tau <= tile_k + sigma`, + REWRITE_TAC[tile_tree; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN + ASM_MESON_TAC[TILE_LER_SCALE]);; + + +(* ------------------------------------------------------------------------- *) +(* 286K(a-iii) y-ordering geometry. Fremlin's leftmost-selection point *) +(* y_sigma is the MIDPOINT of the FULL interval J_sigma (distinct from *) +(* tile_ymid, the lower-quartile y^l_sigma used for the phase in phi_sigma). *) +(* y_sigma = dyho_mid k nJ = the LEFT endpoint of J^r_sigma = *) +(* dyho(k-1)(2nJ+1), *) +(* so y_sigma lies in J^r_sigma (hence in J_sigma). The a-iii step derives *) +(* y_{tau_j} < y_{tau_l} from y_{tau_j} in J^l_sigma and y_{tau_l} in *) +(* J^r_sigma *) +(* (the left half of any dyadic interval is entirely below its right half). *) +(* This y-ordering forces j < l in the greedy sequence, hence sigma in P_l *) +(* SUBSET P_{j+1}, hence sigma NOT in {tau_j}+ -- the ordering fact a-iii *) +(* uses. *) +(* ------------------------------------------------------------------------- *) + +let tile_yfull = new_definition + `tile_yfull (k:int,nI:int,nJ:int) = dyho_mid k nJ`;; + +(* 2 zpow k = 2 * 2 zpow (k-1): the scale-halving used to relate J and *) +(* J^l/J^r. *) +let ZPOW_HALVE = prove + (`!k:int. &2 zpow k = &2 * &2 zpow (k - &1)`, + GEN_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [INT_ARITH `k:int = (k - &1) + &1`] + THEN + SIMP_TAC[REAL_ZPOW_ADD; REAL_OF_NUM_EQ; ARITH] THEN + REWRITE_TAC[REAL_ZPOW_1] THEN REAL_ARITH_TAC);; + +(* dyho_mid k nJ = (2nJ+1) * 2^(k-1) = the left endpoint of *) +(* dyho(k-1)(2nJ+1). *) +let DYHO_MID_JR_EDGE = prove + (`!k nJ:int. dyho_mid k nJ = real_of_int (&2 * nJ + &1) * &2 zpow (k - &1)`, + REPEAT GEN_TAC THEN REWRITE_TAC[dyho_mid] THEN + SUBST1_TAC(SPEC `k:int` ZPOW_HALVE) THEN + SUBGOAL_THEN + `real_of_int (&2 * nJ + &1) = &2 * real_of_int nJ + &1` SUBST1_TAC THENL + [REWRITE_TAC[REAL_OF_INT_CLAUSES]; ALL_TAC] THEN + ABBREV_TAC `z = &2 zpow (k - &1)` THEN CONV_TAC REAL_RING);; + +(* y_sigma lies in the RIGHT half-interval J^r_sigma (it is its left *) +(* endpoint). *) +let TILE_YFULL_IN_JR = prove + (`!s:int#int#int. tile_yfull s IN tile_Jr s`, + REWRITE_TAC[FORALL_PAIR_THM; tile_yfull; tile_Jr; DYHO_MID_JR_EDGE] THEN + REPEAT GEN_TAC THEN REWRITE_TAC[dyho; IN_ELIM_THM] THEN + SUBGOAL_THEN `&0 < &2 zpow (p1 - &1)` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ASM_REAL_ARITH_TAC]);; + +(* hence y_sigma lies in J_sigma (J^r_sigma SUBSET J_sigma). *) +let TILE_YFULL_IN_J = prove + (`!s:int#int#int. tile_yfull s IN tile_J s`, + GEN_TAC THEN MP_TAC(ISPEC `s:int#int#int` TILE_YFULL_IN_JR) THEN + MP_TAC(ISPEC `s:int#int#int` TILE_JR_SUBSET_J) THEN SET_TAC[]);; + +(* The left half J^l_sigma is entirely to the left of the right half *) +(* J^r_sigma. *) +let TILE_JL_LT_JR = prove + (`!s:int#int#int a b. a IN tile_Jl s /\ b IN tile_Jr s ==> a < b`, + REWRITE_TAC[FORALL_PAIR_THM; tile_Jl; tile_Jr; dyho; IN_ELIM_THM] THEN + REPEAT GEN_TAC THEN + SUBGOAL_THEN `&0 < &2 zpow (p1 - &1)` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + STRIP_TAC THEN + SUBGOAL_THEN `real_of_int (&2 * p2 + &1) = real_of_int(&2 * p2) + &1` + (fun th -> RULE_ASSUM_TAC(REWRITE_RULE[th])) THENL + [REWRITE_TAC[REAL_OF_INT_CLAUSES] THEN REAL_ARITH_TAC; ALL_TAC] THEN + ASM_REAL_ARITH_TAC);; + +(* 286K(a-iii) y-ordering: if J_{tj} SUBSET J^l_sigma (tau_j's interval lies *) +(* in *) +(* sigma's left half) and sigma <=_r tau_l (so J^r_{tl} SUBSET J^r_sigma), *) +(* then *) +(* y_{tj} < y_{tl}. This is Fremlin's y_{tau_j} < y_{tau_l}. *) +let TILE_YFULL_ORDER = prove + (`!sig tj tl:int#int#int. + tile_J tj SUBSET tile_Jl sig /\ tile_ler sig tl + ==> tile_yfull tj < tile_yfull tl`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC TILE_JL_LT_JR THEN + EXISTS_TAC `sig:int#int#int` THEN CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o CONJUNCT1 o REWRITE_RULE[tile_ler]) THEN + MP_TAC(ISPEC `tj:int#int#int` TILE_YFULL_IN_J) THEN ASM SET_TAC[]; + FIRST_X_ASSUM(MP_TAC o CONJUNCT2 o REWRITE_RULE[tile_ler]) THEN + MP_TAC(ISPEC `tl:int#int#int` TILE_YFULL_IN_JR) THEN ASM SET_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* 286K(a-i) the finite representative set R~. For every tau with P cap *) +(* T_tau *) +(* nonempty there is a tau' in R~ with the SAME tree P cap T_tau' and *) +(* k_{tau'} *) +(* >= k_tau (max scale). This lets the R_j selection-set test on the FINITE *) +(* R~ *) +(* control the sup over ALL tau (Fremlin's a-ii stopping bound energy(P_n)<= *) +(* gam/2 is a max over R~). *) +(* ------------------------------------------------------------------------- *) + +(* per-value max-scale representative existence (INT_HAS_MAX over the scales *) +(* of tiles sharing the tree-value; bounded above by any member's scale, *) +(* TREE_KBOUND). *) +let TREE_MAXSCALE_REP = prove + (`!P t0:int#int#int. FINITE P /\ ~(tile_tree P t0 = {}) + ==> ?tau. tile_tree P tau = tile_tree P t0 /\ + (!s. tile_tree P s = tile_tree P t0 ==> tile_k s <= tile_k + tau)`, + REPEAT STRIP_TAC THEN UNDISCH_TAC `~(tile_tree P (t0:int#int#int) = {})` THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + DISCH_THEN(X_CHOOSE_TAC `sig0:int#int#int`) THEN + MP_TAC(ISPECL [`\k:int. ?t:int#int#int. tile_tree P t = tile_tree P t0 /\ + tile_k t = k`; + `tile_k (sig0:int#int#int)`] INT_HAS_MAX) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [CONJ_TAC THENL + [EXISTS_TAC `tile_k (t0:int#int#int)` THEN + EXISTS_TAC `t0:int#int#int` THEN REWRITE_TAC[]; + ALL_TAC] THEN + X_GEN_TAC `k:int` THEN DISCH_THEN(X_CHOOSE_THEN + `t:int#int#int` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC TREE_KBOUND THEN EXISTS_TAC `P:(int#int#int)->bool` THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `km:int` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `t:int#int#int` THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `s:int#int#int` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `tile_k (s:int#int#int)`) THEN + ANTS_TAC THENL [EXISTS_TAC `s:int#int#int` THEN + ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]]);; + +(* the representative tile for a tree-value (SELECT of the max-scale rep). *) +let carleson_rep = new_definition + `carleson_rep P A = @tau:int#int#int. tile_tree P tau = A /\ + (!s. tile_tree P s = A ==> tile_k s <= tile_k tau)`;; + +(* R~ = image of carleson_rep over the finite family of achievable *) +(* tree-values. *) +let carleson_Rtilde = new_definition + `carleson_Rtilde P = IMAGE (carleson_rep P) {tile_tree P t | t IN + (:int#int#int)}`;; + +let CARLESON_RTILDE_FINITE = prove + (`!P:(int#int#int)->bool. FINITE P ==> FINITE (carleson_Rtilde P)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[carleson_Rtilde] THEN + MATCH_MP_TAC FINITE_IMAGE THEN ASM_SIMP_TAC[ENERGY_TREE_FAMILY_FINITE]);; + +(* rep spec: for a nonempty tree-value the rep achieves it with maximal *) +(* scale. *) +let CARLESON_REP_SPEC = prove + (`!P t0:int#int#int. FINITE P /\ ~(tile_tree P t0 = {}) + ==> tile_tree P (carleson_rep P (tile_tree P t0)) = tile_tree P t0 /\ + (!s. tile_tree P s = tile_tree P t0 + ==> tile_k s <= tile_k (carleson_rep P (tile_tree P t0)))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[carleson_rep] THEN + CONV_TAC SELECT_CONV THEN ASM_SIMP_TAC[TREE_MAXSCALE_REP]);; + +(* R~ representative property: a nonempty tree of tau is matched by a tau' *) +(* in R~ with the same tree and k_{tau'} >= k_tau (the rep itself is that *) +(* tau'). *) +let CARLESON_RTILDE_REP = prove + (`!P tau:int#int#int. FINITE P /\ ~(tile_tree P tau = {}) + ==> ?taup. taup IN carleson_Rtilde P /\ + tile_tree P taup = tile_tree P tau /\ + tile_k tau <= tile_k taup`, + REPEAT STRIP_TAC THEN + EXISTS_TAC `carleson_rep P (tile_tree P (tau:int#int#int))` THEN + MP_TAC(ISPECL [`P:(int#int#int)->bool`; + `tau:int#int#int`] CARLESON_REP_SPEC) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [REWRITE_TAC[carleson_Rtilde; IN_IMAGE] THEN + EXISTS_TAC `tile_tree P (tau:int#int#int)` THEN REWRITE_TAC[] THEN + REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `tau:int#int#int` THEN + REWRITE_TAC[IN_UNIV]; + FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* 286K(a-ii) greedy stopping-time sequence: definitions + structural facts. *) +(* Fremlin chooses tau_0,tau_1,... and P_0,P_1,... with P_0=P; R_j = the *) +(* tiles *) +(* in the finite representative set Rt whose tree still carries >= 1/4 gam^2 *) +(* muI energy; tau_j = the leftmost-y member of R_j; P_{j+1}=P_j\{tau_j}+; *) +(* stop *) +(* when R_j empties. We model P_j as ITER j (carleson_estep ...) P; estep is *) +(* the identity once R_j is empty (making the recursion total). *) +(* ------------------------------------------------------------------------- *) + +(* R_j = {tau in Rt : 1/4 gam^2 muI_tau <= Delta_f(P_j cap T_tau)} (Q = *) +(* P_j). *) +let carleson_Rset = new_definition + `carleson_Rset (f:real->complex) gam Rt Q = + {tau | tau IN Rt /\ + &1 / &4 * gam pow 2 * &2 zpow (--(tile_k tau)) <= + delta_f f (tile_tree Q tau)}`;; + +(* leftmost-y root of R_j (Fremlin: member of R_j with y_tau as far left as *) +(* possible). SELECT; well-defined when R_j is finite and non-empty. *) +let carleson_eroot = new_definition + `carleson_eroot (f:real->complex) gam Rt Q = + @tau. tau IN carleson_Rset f gam Rt Q /\ + (!s. s IN carleson_Rset f gam Rt Q ==> tile_yfull tau <= tile_yfull + s)`;; + +(* one greedy step: if R_j empty, stop (identity); else remove {root_j}+. *) +let carleson_estep = new_definition + `carleson_estep (f:real->complex) gam Rt Q = + if carleson_Rset f gam Rt Q = {} + then Q else Q DIFF tile_upset {carleson_eroot f gam Rt Q}`;; + +(* R_j SUBSET Rt (so R_j is finite when Rt is). *) +let CARLESON_RSET_SUBSET = prove + (`!f gam Rt Q. carleson_Rset f gam Rt Q SUBSET Rt`, + REWRITE_TAC[carleson_Rset; SUBSET; IN_ELIM_THM] THEN MESON_TAC[]);; + +(* estep shrinks the tile-set (P_{j+1} SUBSET P_j). *) +let CARLESON_ESTEP_SUBSET = prove + (`!f gam Rt Q. carleson_estep f gam Rt Q SUBSET Q`, + REPEAT GEN_TAC THEN REWRITE_TAC[carleson_estep] THEN + COND_CASES_TAC THEN REWRITE_TAC[SUBSET_REFL] THEN SET_TAC[]);; + +(* the leftmost-y root exists in R_j and is leftmost, when Rt finite, R_j *) +(* nonempty. *) +let CARLESON_EROOT_SPEC = prove + (`!f gam Rt Q. FINITE Rt /\ ~(carleson_Rset f gam Rt Q = {}) + ==> carleson_eroot f gam Rt Q IN carleson_Rset f gam Rt Q /\ + (!s. s IN carleson_Rset f gam Rt Q + ==> tile_yfull (carleson_eroot f gam Rt Q) <= tile_yfull s)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[carleson_eroot] THEN + CONV_TAC SELECT_CONV THEN ABBREV_TAC `RJ = carleson_Rset f gam Rt Q` THEN + SUBGOAL_THEN `FINITE(RJ:(int#int#int)->bool)` ASSUME_TAC THENL + [EXPAND_TAC "RJ" THEN MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `Rt:(int#int#int)->bool` THEN + ASM_REWRITE_TAC[CARLESON_RSET_SUBSET]; ALL_TAC] THEN + MP_TAC(ISPEC `IMAGE (tile_yfull:int#int#int->real) RJ` INF_FINITE) THEN + ASM_SIMP_TAC[FINITE_IMAGE; IMAGE_EQ_EMPTY; FORALL_IN_IMAGE] THEN + REWRITE_TAC[IN_IMAGE] THEN + DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN + `tau:int#int#int` STRIP_ASSUME_TAC) ASSUME_TAC) THEN + EXISTS_TAC `tau:int#int#int` THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `s:int#int#int` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `s:int#int#int`) THEN ASM_REWRITE_TAC[]);; + +(* the down-cone tree of tau is contained in the up-set {tau}+ *) +(* (tile_ler=>tile_le). *) +let TILE_TREE_SUBSET_UPSET = prove + (`!Q tau:int#int#int. tile_tree Q tau SUBSET tile_upset {tau}`, + REWRITE_TAC[tile_tree; tile_upset; SUBSET; IN_ELIM_THM; IN_SING] THEN + REPEAT STRIP_TAC THEN EXISTS_TAC `tau:int#int#int` THEN + ASM_SIMP_TAC[TILE_LER_IMP_LE]);; + +(* STRICT shrink: when gam>0, Rt finite and R_j nonempty, estep drops at *) +(* least *) +(* the (nonempty) tree of the root -- so P_{j+1} is a PROPER subset of P_j. *) +(* The *) +(* termination driver: the induction cannot run forever on a finite P. *) +let CARLESON_ESTEP_PSUBSET = prove + (`!f gam Rt Q. &0 < gam /\ FINITE Rt /\ ~(carleson_Rset f gam Rt Q = {}) + ==> carleson_estep f gam Rt Q PSUBSET Q`, + REPEAT STRIP_TAC THEN REWRITE_TAC[PSUBSET] THEN + CONJ_TAC THENL + [REWRITE_TAC[carleson_estep] THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[SUBSET_REFL] THEN SET_TAC[]; + ALL_TAC] THEN + ABBREV_TAC `rt = carleson_eroot f gam Rt Q` THEN + MP_TAC(ISPECL + [`f:real->complex`;`gam:real`;`Rt:(int#int#int)->bool`; + `Q:(int#int#int)->bool`] + CARLESON_EROOT_SPEC) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o CONJUNCT1) THEN + REWRITE_TAC[carleson_Rset; IN_ELIM_THM] THEN STRIP_TAC THEN + SUBGOAL_THEN `~(tile_tree Q (rt:int#int#int) = {})` MP_TAC THENL + [DISCH_TAC THEN + UNDISCH_TAC `&1 / &4 * gam pow 2 * &2 zpow (--tile_k rt) <= + delta_f f (tile_tree Q (rt:int#int#int))` THEN + ASM_REWRITE_TAC[delta_f; SUM_CLAUSES] THEN REWRITE_TAC[REAL_NOT_LE] THEN + MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC THENL + [REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_POW_LT THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC]]; + ALL_TAC] THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + DISCH_THEN(X_CHOOSE_TAC `sig:int#int#int`) THEN + SUBGOAL_THEN `(sig:int#int#int) IN Q` ASSUME_TAC THENL + [UNDISCH_TAC `(sig:int#int#int) IN tile_tree Q rt` THEN + REWRITE_TAC[tile_tree; IN_ELIM_THM] THEN SIMP_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `(sig:int#int#int) IN tile_upset {rt}` ASSUME_TAC THENL + [MP_TAC(ISPECL [`Q:(int#int#int)->bool`; + `rt:int#int#int`] TILE_TREE_SUBSET_UPSET) THEN + REWRITE_TAC[SUBSET] THEN DISCH_THEN(MP_TAC o SPEC `sig:int#int#int`) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + DISCH_TAC THEN + UNDISCH_TAC `carleson_estep f gam Rt Q = Q` THEN + REWRITE_TAC[carleson_estep] THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[EXTENSION] THEN DISCH_THEN(MP_TAC o SPEC `sig:int#int#int`) THEN + ASM_REWRITE_TAC[IN_DIFF]);; + +(* R_j is ANTITONE in Q: a smaller tile-set gives a smaller selection set. *) +(* Q' SUBSET Q (Q finite) ==> R_j(Q') SUBSET R_j(Q). Since P_{j+1} SUBSET *) +(* P_j, *) +(* this gives R_{j+1} SUBSET R_j -- Fremlin's "R_{j+1} SUBSET R_j for every *) +(* j". *) +(* (Delta_f monotone in the tree, which is monotone in the tile-set.) *) +let CARLESON_RSET_ANTITONE = prove + (`!f gam Rt Q Q'. FINITE Q /\ Q' SUBSET Q + ==> carleson_Rset f gam Rt Q' SUBSET carleson_Rset f gam Rt Q`, + REPEAT STRIP_TAC THEN REWRITE_TAC[carleson_Rset; SUBSET; IN_ELIM_THM] THEN + X_GEN_TAC `tau:int#int#int` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `delta_f f (tile_tree Q' (tau:int#int#int))` THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC DELTA_MONO THEN CONJ_TAC THENL + [ASM_MESON_TAC[TILE_TREE_FINITE]; + MATCH_MP_TAC TILE_TREE_MONO_SET THEN ASM_REWRITE_TAC[]]);; + +(* single-step leftmost-y monotonicity: if R_j nonempty AND R_{j+1} (=R_j at *) +(* a *) +(* subset Q') nonempty and R_{j+1} SUBSET R_j, the leftmost-y root cannot *) +(* move *) +(* left. root(Q') in R_j+1 SUBSET R_j and root(Q) is leftmost in R_j. This *) +(* is *) +(* Fremlin's "y_{tau_{j+1}} >= y_{tau_j}". *) +let CARLESON_EROOT_MONO_STEP = prove + (`!f gam Rt Q Q'. + FINITE Rt /\ + ~(carleson_Rset f gam Rt Q = {}) /\ ~(carleson_Rset f gam Rt Q' = {}) /\ + carleson_Rset f gam Rt Q' SUBSET carleson_Rset f gam Rt Q + ==> tile_yfull (carleson_eroot f gam Rt Q) + <= tile_yfull (carleson_eroot f gam Rt Q')`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`f:real->complex`;`gam:real`;`Rt:(int#int#int)->bool`; + `Q:(int#int#int)->bool`] + CARLESON_EROOT_SPEC) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o CONJUNCT2) THEN + DISCH_THEN(MP_TAC o SPEC `carleson_eroot f gam Rt Q'`) THEN + ANTS_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET]) THEN + MP_TAC(ISPECL + [`f:real->complex`;`gam:real`;`Rt:(int#int#int)->bool`; + `Q':(int#int#int)->bool`] + CARLESON_EROOT_SPEC) THEN ASM_REWRITE_TAC[] THEN SIMP_TAC[]; + SIMP_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* The greedy SEQUENCE P_n = ITER n (estep) P, the root/piece/selection at *) +(* stage n, and the index-monotone root-y -- the combinatorial backbone of *) +(* 286K(a-iii)'s ordering. Fremlin's y_{tau_{j+1}} >= y_{tau_j} chained: *) +(* over *) +(* active stages (R_n nonempty) the leftmost-y roots are non-decreasing, so *) +(* y_{tau_j} < y_{tau_l} forces j < l -- placing sigma (in P_l) inside *) +(* P_{j+1}. *) +(* ------------------------------------------------------------------------- *) + +(* P_n = the n-th stage of the greedy recursion (identity once R_n empties). *) +let carleson_Pseq = new_definition + `carleson_Pseq (f:real->complex) gam Rt P n = ITER n (carleson_estep f gam Rt) + P`;; + +let CARLESON_PSEQ_0 = prove + (`!f gam Rt P. carleson_Pseq f gam Rt P 0 = P`, + REWRITE_TAC[carleson_Pseq; ITER]);; + +let CARLESON_PSEQ_SUC = prove + (`!f gam Rt P n. carleson_Pseq f gam Rt P (SUC n) = + carleson_estep f gam Rt (carleson_Pseq f gam Rt P n)`, + REWRITE_TAC[carleson_Pseq; ITER]);; + +let CARLESON_PSEQ_STEP_SUBSET = prove + (`!f gam Rt P n. carleson_Pseq f gam Rt P (SUC n) SUBSET carleson_Pseq f gam + Rt P n`, + REWRITE_TAC[CARLESON_PSEQ_SUC; CARLESON_ESTEP_SUBSET]);; + +let CARLESON_PSEQ_MONO = prove + (`!f gam Rt P m n. m <= n + ==> carleson_Pseq f gam Rt P n SUBSET carleson_Pseq f gam Rt P m`, + REPEAT GEN_TAC THEN REWRITE_TAC[LE_EXISTS] THEN + DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST1_TAC) THEN + SPEC_TAC(`d:num`,`d:num`) THEN INDUCT_TAC THEN + REWRITE_TAC[ADD_CLAUSES; SUBSET_REFL] THEN + MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `carleson_Pseq f gam Rt P (m + d)` THEN + ASM_REWRITE_TAC[ADD_SUC; CARLESON_PSEQ_STEP_SUBSET]);; + +let CARLESON_PSEQ_SUBSET_P = prove + (`!f gam Rt P n. carleson_Pseq f gam Rt P n SUBSET P`, + REPEAT GEN_TAC THEN + MP_TAC(ISPECL + [`f:real->complex`;`gam:real`;`Rt:(int#int#int)->bool`; + `P:(int#int#int)->bool`; + `0`;`n:num`] CARLESON_PSEQ_MONO) THEN + REWRITE_TAC[LE_0; CARLESON_PSEQ_0]);; + +let CARLESON_PSEQ_FINITE = prove + (`!f gam Rt P n. FINITE P ==> FINITE(carleson_Pseq f gam Rt P n)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `P:(int#int#int)->bool` THEN + ASM_REWRITE_TAC[CARLESON_PSEQ_SUBSET_P]);; + +(* root at stage n; extracted piece P'_n = P_n cap T_{tau_n}; selection R_n. *) +let carleson_rootseq = new_definition + `carleson_rootseq (f:real->complex) gam Rt P n = + carleson_eroot f gam Rt (carleson_Pseq f gam Rt P n)`;; +let carleson_piece = new_definition + `carleson_piece (f:real->complex) gam Rt P n = + tile_tree (carleson_Pseq f gam Rt P n) (carleson_rootseq f gam Rt P n)`;; +let carleson_Rseq = new_definition + `carleson_Rseq (f:real->complex) gam Rt P n = + carleson_Rset f gam Rt (carleson_Pseq f gam Rt P n)`;; + +(* R_{n+1} SUBSET R_n, and R_n SUBSET R_m for m<=n. *) +let CARLESON_RSEQ_ANTITONE = prove + (`!f gam Rt P n. FINITE P + ==> carleson_Rseq f gam Rt P (SUC n) SUBSET carleson_Rseq f gam Rt P n`, + REPEAT STRIP_TAC THEN REWRITE_TAC[carleson_Rseq] THEN + MATCH_MP_TAC CARLESON_RSET_ANTITONE THEN + ASM_SIMP_TAC[CARLESON_PSEQ_FINITE; CARLESON_PSEQ_STEP_SUBSET]);; + +let CARLESON_RSEQ_MONO = prove + (`!f gam Rt P m n. FINITE P /\ m <= n + ==> carleson_Rseq f gam Rt P n SUBSET carleson_Rseq f gam Rt P m`, + REPEAT GEN_TAC THEN REWRITE_TAC[carleson_Rseq] THEN STRIP_TAC THEN + MATCH_MP_TAC CARLESON_RSET_ANTITONE THEN + ASM_SIMP_TAC[CARLESON_PSEQ_FINITE] THEN + MATCH_MP_TAC CARLESON_PSEQ_MONO THEN ASM_REWRITE_TAC[]);; + +(* R_n nonempty => R_j nonempty for all j<=n (the active stages form a *) +(* prefix). *) +let CARLESON_RSEQ_NONEMPTY_DOWN = prove + (`!f gam Rt P n j. FINITE P /\ j <= n /\ ~(carleson_Rseq f gam Rt P n = {}) + ==> ~(carleson_Rseq f gam Rt P j = {})`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`f:real->complex`;`gam:real`;`Rt:(int#int#int)->bool`; + `P:(int#int#int)->bool`; + `j:num`;`n:num`] CARLESON_RSEQ_MONO) THEN + ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);; + +(* single-step index-monotone root-y (over active stages). *) +let CARLESON_ROOTSEQ_MONO_STEP = prove + (`!f gam Rt P n. FINITE Rt /\ FINITE P /\ ~(carleson_Rseq f gam Rt P (SUC n) = + {}) + ==> tile_yfull (carleson_rootseq f gam Rt P n) + <= tile_yfull (carleson_rootseq f gam Rt P (SUC n))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[carleson_rootseq] THEN + MATCH_MP_TAC CARLESON_EROOT_MONO_STEP THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `~(carleson_Rseq f gam Rt P (SUC n) = {})` MP_TAC THENL + [ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[carleson_Rseq; GSYM CARLESON_PSEQ_SUC] THEN DISCH_TAC THEN + CONJ_TAC THENL + [MP_TAC(ISPECL + [`f:real->complex`;`gam:real`;`Rt:(int#int#int)->bool`; + `P:(int#int#int)->bool`;`n:num`] + CARLESON_RSEQ_ANTITONE) THEN ASM_REWRITE_TAC[carleson_Rseq] THEN + UNDISCH_TAC `~(carleson_Rset f gam Rt (carleson_Pseq f gam Rt P (SUC n)) = + {})` THEN + REWRITE_TAC[GSYM CARLESON_PSEQ_SUC] THEN SET_TAC[]; + MP_TAC(ISPECL + [`f:real->complex`;`gam:real`;`Rt:(int#int#int)->bool`; + `P:(int#int#int)->bool`;`n:num`] + CARLESON_RSEQ_ANTITONE) THEN ASM_REWRITE_TAC[carleson_Rseq]]);; + +(* full index-monotone root-y: m<=n, R_n nonempty => y_{tau_m}<=y_{tau_n}. *) +(* Fremlin's "y_{tau_{j+1}} >= y_{tau_j}", chained. Contrapositive: *) +(* y_{tau_j}< *) +(* y_{tau_l} => j tile_yfull (carleson_rootseq f gam Rt P m) + <= tile_yfull (carleson_rootseq f gam Rt P n)`, + REPEAT GEN_TAC THEN REWRITE_TAC[LE_EXISTS] THEN + DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `d:num` SUBST_ALL_TAC) THEN + UNDISCH_TAC `~(carleson_Rseq f gam Rt P (m + d) = {})` THEN + SPEC_TAC(`d:num`,`d:num`) THEN INDUCT_TAC THEN + REWRITE_TAC[ADD_CLAUSES; REAL_LE_REFL] THEN + DISCH_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `tile_yfull (carleson_rootseq f gam Rt P (m + d))` THEN + CONJ_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN + MP_TAC(ISPECL + [`f:real->complex`;`gam:real`;`Rt:(int#int#int)->bool`; + `P:(int#int#int)->bool`; + `SUC(m + d):num`;`m + d:num`] CARLESON_RSEQ_NONEMPTY_DOWN) THEN + ASM_REWRITE_TAC[LE] THEN DISCH_THEN MATCH_MP_TAC THEN DISJ2_TAC THEN + ARITH_TAC; + MATCH_MP_TAC CARLESON_ROOTSEQ_MONO_STEP THEN + ASM_REWRITE_TAC[ADD_SUC]]);; + +(* ------------------------------------------------------------------------- *) +(* 286K(a-iii) the ORDERING fact [star]: for sigma in the extracted piece *) +(* P'_l *) +(* (root tau_l) and an earlier active root tau_j whose interval J_{tau_j} *) +(* lies *) +(* in the LEFT half J^l_sigma, sigma is NOT >= tau_j (~tile_le sigma tau_j). *) +(* Sole sequence-dependent input to a-iii's disjointness (rest is geometry: *) +(* AIII_SAMEJ_DISJOINT + AIII_DIFFJ_BRANCH). *) +(* ------------------------------------------------------------------------- *) + +(* when R_j nonempty, P_{j+1} = P_j \ {root}+, so membership excludes the *) +(* root+. *) +let CARLESON_ESTEP_EXCLUDES_ROOT = prove + (`!f gam Rt P n sigma. + ~(carleson_Rseq f gam Rt P n = {}) /\ + sigma IN carleson_Pseq f gam Rt P (SUC n) + ==> ~(tile_le sigma (carleson_rootseq f gam Rt P n))`, + REPEAT GEN_TAC THEN + REWRITE_TAC[CARLESON_PSEQ_SUC; carleson_rootseq; carleson_estep] THEN + REWRITE_TAC[GSYM carleson_Rseq] THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[IN_DIFF; tile_upset; IN_ELIM_THM; IN_SING] THEN MESON_TAC[]);; + +(* sigma in piece n => sigma in P_n. *) +let CARLESON_PIECE_IN_PSEQ = prove + (`!f gam Rt P n sigma. sigma IN carleson_piece f gam Rt P n + ==> sigma IN carleson_Pseq f gam Rt P n`, + REPEAT GEN_TAC THEN REWRITE_TAC[carleson_piece; tile_tree; IN_ELIM_THM] THEN + SIMP_TAC[]);; + +(* sigma in piece n => sigma <=_r root_n (it is in the root's down-cone *) +(* tree). *) +let CARLESON_PIECE_LER_ROOT = prove + (`!f gam Rt P n sigma. sigma IN carleson_piece f gam Rt P n + ==> tile_ler sigma (carleson_rootseq f gam Rt P n)`, + REPEAT GEN_TAC THEN REWRITE_TAC[carleson_piece; tile_tree; IN_ELIM_THM] THEN + SIMP_TAC[]);; + +(* THE ORDERING FACT [star]. Chain: sigma in piece l => tile_ler sigma *) +(* tau_l; *) +(* TILE_YFULL_ORDER => y_{tau_j} < y_{tau_l}; ROOTSEQ_MONO contrapositive => *) +(* j sigma in P_{j+1}; ESTEP_EXCLUDES_ROOT => ~(tile_le sigma *) +(* tau_j). *) +let CARLESON_AIII_ORDER = prove + (`!f gam Rt P j l sigma. + FINITE Rt /\ FINITE P /\ + sigma IN carleson_piece f gam Rt P l /\ + ~(carleson_Rseq f gam Rt P l = {}) /\ + ~(carleson_Rseq f gam Rt P j = {}) /\ + tile_J (carleson_rootseq f gam Rt P j) SUBSET tile_Jl sigma + ==> ~(tile_le sigma (carleson_rootseq f gam Rt P j))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP CARLESON_PIECE_LER_ROOT) THEN + SUBGOAL_THEN `tile_yfull (carleson_rootseq f gam Rt P j) + < tile_yfull (carleson_rootseq f gam Rt P l)` ASSUME_TAC THENL + [MATCH_MP_TAC TILE_YFULL_ORDER THEN + EXISTS_TAC `sigma:int#int#int` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `j:num < l` ASSUME_TAC THENL + [MP_TAC(ISPECL + [`f:real->complex`;`gam:real`;`Rt:(int#int#int)->bool`; + `P:(int#int#int)->bool`; + `l:num`;`j:num`] CARLESON_ROOTSEQ_MONO) THEN + ASM_CASES_TAC `j:num < l` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `l:num <= j` ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC CARLESON_ESTEP_EXCLUDES_ROOT THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL + [`f:real->complex`;`gam:real`;`Rt:(int#int#int)->bool`; + `P:(int#int#int)->bool`; + `SUC j`;`l:num`] CARLESON_PSEQ_MONO) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[SUBSET] THEN DISCH_THEN MATCH_MP_TAC THEN + MATCH_MP_TAC CARLESON_PIECE_IN_PSEQ THEN ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* 286K(a-ii) TERMINATION: the greedy induction stops (some R_n empties). *) +(* While stages 0..n-1 are all active, each strictly shrinks the finite P *) +(* (via *) +(* CARLESON_ESTEP_PSUBSET), so CARD P_n + n <= CARD P; hence R_n is nonempty *) +(* for *) +(* at most CARD P stages -- Fremlin's "the induction must stop at a finite *) +(* stage". *) +(* ------------------------------------------------------------------------- *) + +let CARLESON_PSEQ_CARD_DECR = prove + (`!f gam Rt P n. &0 < gam /\ FINITE Rt /\ FINITE P + ==> (!j. j < n ==> ~(carleson_Rseq f gam Rt P j = {})) + ==> CARD(carleson_Pseq f gam Rt P n) + n <= CARD P`, + REPEAT GEN_TAC THEN STRIP_TAC THEN SPEC_TAC(`n:num`,`n:num`) THEN + INDUCT_TAC THENL + [REWRITE_TAC[CARLESON_PSEQ_0; ADD_CLAUSES; LE_REFL]; ALL_TAC] THEN + DISCH_TAC THEN + SUBGOAL_THEN `~(carleson_Rseq f gam Rt P n = {})` ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN REWRITE_TAC[LT] THEN + DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `CARD(carleson_Pseq f gam Rt P n) + n <= CARD P` ASSUME_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN GEN_TAC THEN DISCH_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `CARD(carleson_Pseq f gam Rt P (SUC n)) < CARD(carleson_Pseq f gam Rt P n)` + ASSUME_TAC THENL + [MATCH_MP_TAC CARD_PSUBSET THEN CONJ_TAC THENL + [REWRITE_TAC[CARLESON_PSEQ_SUC] THEN + MATCH_MP_TAC CARLESON_ESTEP_PSUBSET THEN + ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `~(carleson_Rseq f gam Rt P n = {})` THEN + REWRITE_TAC[carleson_Rseq]; ASM_SIMP_TAC[CARLESON_PSEQ_FINITE]]; + ASM_ARITH_TAC]);; + +(* SOME stage has empty selection set (the induction stops). By *) +(* contradiction: *) +(* if all R_n nonempty, CARD_DECR at n=CARD P+1 gives CARD P_{..}+(CARD *) +(* P+1)<= *) +(* CARD P, impossible. *) +let CARLESON_RSEQ_STOPS = prove + (`!f gam Rt P. &0 < gam /\ FINITE Rt /\ FINITE P + ==> ?n. carleson_Rseq f gam Rt P n = {}`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `?n. carleson_Rseq f gam Rt P n = {}` THEN + ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o REWRITE_RULE[NOT_EXISTS_THM]) THEN DISCH_TAC THEN + MP_TAC(ISPECL + [`f:real->complex`;`gam:real`;`Rt:(int#int#int)->bool`; + `P:(int#int#int)->bool`; + `SUC(CARD(P:(int#int#int)->bool))`] CARLESON_PSEQ_CARD_DECR) THEN + ASM_REWRITE_TAC[] THEN ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* 286K(a-ii) STOPPING energy bound: at a stage where R_N empties, the *) +(* residual *) +(* energy_f f P_N <= gam/2. The finite R~ selection test controls ALL tiles *) +(* (via the representative property CARLESON_RTILDE_REP), so *) +(* ENERGY_THRESHOLD *) +(* applies. This is Fremlin's a-ii closing display energy_f(P_n) <= gam/2. *) +(* ------------------------------------------------------------------------- *) + +(* tile_tree restricted to a subset. *) +let TILE_TREE_RESTRICT = prove + (`!P Q t:int#int#int. Q SUBSET P ==> tile_tree Q t = tile_tree P t INTER Q`, + REPEAT STRIP_TAC THEN SUBGOAL_THEN + `Q:(int#int#int)->bool = P INTER Q` SUBST1_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN REWRITE_TAC[TILE_TREE_INTER] THEN + SUBGOAL_THEN `(P INTER Q:(int#int#int)->bool) = Q` SUBST1_TAC THENL + [ASM SET_TAC[]; REFL_TAC]);; + +(* equal trees on P give equal trees on any subset Q. *) +let TILE_TREE_EQ_RESTRICT = prove + (`!P Q s t:int#int#int. Q SUBSET P /\ tile_tree P s = tile_tree P t + ==> tile_tree Q s = tile_tree Q t`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[TILE_TREE_RESTRICT] THEN + ASM_REWRITE_TAC[]);; + +(* tile_tree monotone in the tile-set. *) +let TILE_TREE_SUBSET_MONO = prove + (`!P Q t:int#int#int. Q SUBSET P ==> tile_tree Q t SUBSET tile_tree P t`, + REWRITE_TAC[tile_tree; SUBSET; IN_ELIM_THM] THEN MESON_TAC[]);; + +(* per-tile energy threshold at the stopping stage (Rt = R~, R_N = {}). *) +let CARLESON_STOP_TILE_THRESHOLD = prove + (`!f gam P N tau:int#int#int. + &0 < gam /\ FINITE P /\ + carleson_Rset f gam (carleson_Rtilde P) + (carleson_Pseq f gam (carleson_Rtilde P) P N) = {} + ==> &2 zpow (tile_k tau) * + delta_f f (tile_tree (carleson_Pseq f gam (carleson_Rtilde P) P N) + tau) + <= (gam / &2) pow 2`, + REPEAT STRIP_TAC THEN + ABBREV_TAC `PN = carleson_Pseq f gam (carleson_Rtilde P) P N` THEN + SUBGOAL_THEN `(PN:(int#int#int)->bool) SUBSET P` ASSUME_TAC THENL + [EXPAND_TAC "PN" THEN REWRITE_TAC[CARLESON_PSEQ_SUBSET_P]; ALL_TAC] THEN + ASM_CASES_TAC `tile_tree (PN:(int#int#int)->bool) tau = {}` THENL + [ASM_REWRITE_TAC[delta_f; SUM_CLAUSES; REAL_MUL_RZERO; REAL_LE_POW_2]; + ALL_TAC] THEN + SUBGOAL_THEN `~(tile_tree P (tau:int#int#int) = {})` ASSUME_TAC THENL + [MP_TAC(ISPECL [`P:(int#int#int)->bool`; `PN:(int#int#int)->bool`; + `tau:int#int#int`] + TILE_TREE_SUBSET_MONO) THEN ASM_REWRITE_TAC[] THEN + ASM SET_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL [`P:(int#int#int)->bool`; + `tau:int#int#int`] CARLESON_RTILDE_REP) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `taup:int#int#int` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `delta_f f (tile_tree PN (taup:int#int#int)) + < &1 / &4 * gam pow 2 * &2 zpow (--(tile_k taup))` ASSUME_TAC THENL + [MP_TAC(ASSUME `carleson_Rset f gam (carleson_Rtilde P) PN = {}`) THEN + REWRITE_TAC[EXTENSION; NOT_IN_EMPTY; carleson_Rset; IN_ELIM_THM] THEN + DISCH_THEN(MP_TAC o SPEC `taup:int#int#int`) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `tile_tree (PN:(int#int#int)->bool) tau = + tile_tree PN taup` SUBST1_TAC THENL + [MATCH_MP_TAC TILE_TREE_EQ_RESTRICT THEN + EXISTS_TAC `P:(int#int#int)->bool` THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&2 zpow (tile_k taup) * delta_f f (tile_tree PN + (taup:int#int#int))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_RMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC ZPOW2_MONOE THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[DELTA_POS]]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&2 zpow (tile_k taup) * (&1 / &4 * gam pow 2 * &2 zpow (--(tile_k + taup)))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LT_IMP_LE THEN MATCH_MP_TAC REAL_ZPOW_LT THEN + REAL_ARITH_TAC; + ASM_SIMP_TAC[REAL_LT_IMP_LE]]; + REWRITE_TAC[REAL_ZPOW_NEG] THEN + SUBGOAL_THEN `&0 < &2 zpow (tile_k taup)` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + ABBREV_TAC `z = &2 zpow (tile_k (taup:int#int#int))` THEN + SUBGOAL_THEN + `z * (&1 / &4 * gam pow 2 * inv z) = &1 / &4 * gam pow 2 * (z * inv z)` + SUBST1_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `z * inv z = &1` SUBST1_TAC THENL + [MATCH_MP_TAC REAL_MUL_RINV THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_MUL_RID] THEN CONV_TAC REAL_FIELD]);; + +(* Fremlin's a-ii stopping bound: energy_f f P_N <= gam/2 at a stopping *) +(* stage. *) +let CARLESON_STOP_ENERGY = prove + (`!f gam P N. &0 < gam /\ FINITE P /\ + carleson_Rset f gam (carleson_Rtilde P) + (carleson_Pseq f gam (carleson_Rtilde P) P N) = {} + ==> energy_f f (carleson_Pseq f gam (carleson_Rtilde P) P N) <= gam / &2`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC ENERGY_THRESHOLD THEN + CONJ_TAC THENL [ASM_SIMP_TAC[CARLESON_PSEQ_FINITE]; ALL_TAC] THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + GEN_TAC THEN MATCH_MP_TAC CARLESON_STOP_TILE_THRESHOLD THEN + ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* 286K(a-iii) the full disjointness over the extracted set P'. The least *) +(* stopping stage N (num MINIMAL), the extracted tile-set P' = UNIONS of the *) +(* active pieces, the root set R = active roots, and the a-iii disjointness: *) +(* distinct sigma,tau in P' with J^l meeting => I_sigma, I_tau disjoint. *) +(* ------------------------------------------------------------------------- *) + +(* least stopping stage N (R_N = {}, all earlier active). *) +let carleson_stopN = new_definition + `carleson_stopN f gam P = minimal n. carleson_Rseq f gam (carleson_Rtilde P) P + n = {}`;; + +let CARLESON_STOPN_SPEC = prove + (`!f gam P. &0 < gam /\ FINITE P + ==> carleson_Rseq f gam (carleson_Rtilde P) P (carleson_stopN f gam P) = + {} /\ + (!j. j < carleson_stopN f gam P + ==> ~(carleson_Rseq f gam (carleson_Rtilde P) P j = {}))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[carleson_stopN] THEN + MP_TAC(ISPEC `\n. carleson_Rseq f gam (carleson_Rtilde P) P n = {}` MINIMAL) + THEN + BETA_TAC THEN + SUBGOAL_THEN + `?n. carleson_Rseq f gam (carleson_Rtilde P) P n = {}` MP_TAC THENL + [MATCH_MP_TAC CARLESON_RSEQ_STOPS THEN ASM_SIMP_TAC[CARLESON_RTILDE_FINITE]; + DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN MESON_TAC[]]);; + +(* extracted tile-set P' = union of the active pieces; root set R = active *) +(* roots. *) +let carleson_Pextract = new_definition + `carleson_Pextract f gam P = + UNIONS (IMAGE (carleson_piece f gam (carleson_Rtilde P) P) + {j | j < carleson_stopN f gam P})`;; +let carleson_Rextract = new_definition + `carleson_Rextract f gam P = + IMAGE (carleson_rootseq f gam (carleson_Rtilde P) P) + {j | j < carleson_stopN f gam P}`;; + +let CARLESON_PEXTRACT_MEM = prove + (`!f gam P sigma. sigma IN carleson_Pextract f gam P <=> + ?j. j < carleson_stopN f gam P /\ + sigma IN carleson_piece f gam (carleson_Rtilde P) P j`, + REPEAT GEN_TAC THEN + REWRITE_TAC[carleson_Pextract; UNIONS_IMAGE; IN_ELIM_THM]);; + +let CARLESON_ACTIVE_RSEQ = prove + (`!f gam P j. &0 < gam /\ FINITE P /\ j < carleson_stopN f gam P + ==> ~(carleson_Rseq f gam (carleson_Rtilde P) P j = {})`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:real->complex`;`gam:real`;`P:(int#int#int)->bool`] + CARLESON_STOPN_SPEC) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o CONJUNCT2) THEN + DISCH_THEN(MP_TAC o SPEC `j:num`) THEN ASM_REWRITE_TAC[]);; + +(* diffj core: sigma,tau in P', J_sigma SUBSET J^l_tau ==> DISJOINT I_sigma *) +(* I_tau. sigma in piece j (root tau_j); J_{tau_j} SUBSET J_sigma SUBSET *) +(* J^l_tau; tau in piece m; CARLESON_AIII_ORDER (on tau) gives ~tile_le tau *) +(* tau_j; AIII_DIFFJ_BRANCH. *) +let CARLESON_AIII_DIFFJ = prove + (`!f gam P sigma tau. &0 < gam /\ FINITE P /\ + sigma IN carleson_Pextract f gam P /\ tau IN carleson_Pextract f gam P /\ + tile_J sigma SUBSET tile_Jl tau + ==> DISJOINT (tile_I sigma) (tile_I tau)`, + REPEAT GEN_TAC THEN REWRITE_TAC[CARLESON_PEXTRACT_MEM] THEN + DISCH_THEN(REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC) THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `m:num` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `j:num` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC AIII_DIFFJ_BRANCH THEN + EXISTS_TAC `carleson_rootseq f gam (carleson_Rtilde P) P j` THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC CARLESON_PIECE_LER_ROOT THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC CARLESON_AIII_ORDER THEN EXISTS_TAC `m:num` THEN + ASM_SIMP_TAC[CARLESON_RTILDE_FINITE; CARLESON_ACTIVE_RSEQ] THEN + MATCH_MP_TAC SUBSET_TRANS THEN EXISTS_TAC `tile_J sigma` THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `tile_ler sigma (carleson_rootseq f gam (carleson_Rtilde P) P j)` + MP_TAC THENL + [MATCH_MP_TAC CARLESON_PIECE_LER_ROOT THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o MATCH_MP TILE_LER_IMP_LE) THEN + REWRITE_TAC[tile_le] THEN STRIP_TAC THEN ASM_REWRITE_TAC[]);; + +(* full a-iii: distinct sigma,tau in P' with J^l meeting ==> DISJOINT I. *) +(* J_sigma= *) +(* J_tau -> AIII_SAMEJ; else TILE_JL_OFFDIAG_DICHOTOMY -> WLOG diffj (2 *) +(* symmetric). *) +let CARLESON_AIII_DISJOINT = prove + (`!f gam P sigma tau. &0 < gam /\ FINITE P /\ + sigma IN carleson_Pextract f gam P /\ tau IN carleson_Pextract f gam P /\ + ~(sigma = tau) /\ ~DISJOINT (tile_Jl sigma) (tile_Jl tau) + ==> DISJOINT (tile_I sigma) (tile_I tau)`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `tile_J sigma = tile_J tau` THENL + [MATCH_MP_TAC AIII_SAMEJ_DISJOINT THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL [`sigma:int#int#int`; + `tau:int#int#int`] TILE_JL_OFFDIAG_DICHOTOMY) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THENL + [MATCH_MP_TAC CARLESON_AIII_DIFFJ THEN + MAP_EVERY EXISTS_TAC [`f:real->complex`; `gam:real`; + `P:(int#int#int)->bool`] THEN + ASM_REWRITE_TAC[]; + ONCE_REWRITE_TAC[DISJOINT_SYM] THEN + MATCH_MP_TAC CARLESON_AIII_DIFFJ THEN + MAP_EVERY EXISTS_TAC [`f:real->complex`; `gam:real`; + `P:(int#int#int)->bool`] THEN + ASM_REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* 286K(a-ii) TELESCOPE: the iterated estep removals collapse -- P_N = P *) +(* DIFF *) +(* tile_upset(active roots). At the least stop stage this is P DIFF R+ (R = *) +(* Rextract), so CARLESON_STOP_ENERGY becomes Fremlin's residual energy *) +(* bound *) +(* energy_f f (P DIFF R+) <= gam/2. *) +(* ------------------------------------------------------------------------- *) + +let NUMSEG_LT_SUC = prove + (`!N. {j | j < SUC N} = N INSERT {j | j < N}`, + GEN_TAC THEN REWRITE_TAC[EXTENSION; IN_INSERT; IN_ELIM_THM] THEN ARITH_TAC);; + +let IMAGE_NUMSEG_LT_SUC = prove + (`!g N. IMAGE g {j | j < SUC N} = (g N) INSERT IMAGE g {j | j < N}`, + REWRITE_TAC[NUMSEG_LT_SUC; IMAGE_CLAUSES]);; + +let TILE_UPSET_INSERT = prove + (`!a R. tile_upset (a INSERT R) = tile_upset {a} UNION tile_upset R`, + REWRITE_TAC[tile_upset; EXTENSION; IN_UNION; IN_ELIM_THM; IN_INSERT; + NOT_IN_EMPTY] THEN + MESON_TAC[]);; + +let TILE_UPSET_EMPTY = prove + (`tile_upset {} = {}`, + REWRITE_TAC[tile_upset; NOT_IN_EMPTY; EMPTY_GSPEC]);; + +let SET_DIFF_DIFF_UNION = prove + (`!P A r. P DIFF A DIFF (r UNION {}) = P DIFF (r UNION A)`, SET_TAC[]);; + +(* clean per-step identity (R_N nonempty), keeping P_N opaque. *) +let CARLESON_PSEQ_STEP_ACTIVE = prove + (`!f gam Rt P N. ~(carleson_Rseq f gam Rt P N = {}) + ==> carleson_Pseq f gam Rt P (SUC N) = + carleson_Pseq f gam Rt P N DIFF tile_upset {carleson_rootseq f gam Rt + P N}`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[CARLESON_PSEQ_SUC; carleson_estep; carleson_rootseq] THEN + COND_CASES_TAC THENL + [UNDISCH_TAC `~(carleson_Rseq f gam Rt P N = {})` THEN + ASM_REWRITE_TAC[carleson_Rseq]; + REWRITE_TAC[]]);; + +(* the telescope over any N with all stages 0..N-1 active. *) +let CARLESON_PSEQ_TELESCOPE = prove + (`!f gam Rt P N. FINITE Rt + ==> (!j. j < N ==> ~(carleson_Rset f gam Rt (carleson_Pseq f gam Rt P j) = + {})) + ==> carleson_Pseq f gam Rt P N = + P DIFF tile_upset (IMAGE (carleson_rootseq f gam Rt P) {j | j < + N})`, + REPEAT GEN_TAC THEN DISCH_TAC THEN SPEC_TAC(`N:num`,`N:num`) THEN + INDUCT_TAC THENL + [DISCH_TAC THEN REWRITE_TAC[CARLESON_PSEQ_0] THEN + SUBGOAL_THEN `{j | j < 0} = {}:num->bool` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY; LT]; ALL_TAC] THEN + REWRITE_TAC[IMAGE_CLAUSES; TILE_UPSET_EMPTY; DIFF_EMPTY]; ALL_TAC] THEN + DISCH_TAC THEN + SUBGOAL_THEN `carleson_Pseq f gam Rt P N = + P DIFF tile_upset (IMAGE (carleson_rootseq f gam Rt P) {j | j < N})` + (LABEL_TAC "IH") THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN GEN_TAC THEN DISCH_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `~(carleson_Rseq f gam Rt P N = {})` ASSUME_TAC THENL + [REWRITE_TAC[carleson_Rseq] THEN FIRST_X_ASSUM(MP_TAC o SPEC `N:num`) THEN + REWRITE_TAC[LT] THEN DISCH_THEN MATCH_MP_TAC THEN + REWRITE_TAC[]; ALL_TAC] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP CARLESON_PSEQ_STEP_ACTIVE th]) + THEN + USE_THEN "IH" SUBST1_TAC THEN + REWRITE_TAC[IMAGE_NUMSEG_LT_SUC] THEN + ONCE_REWRITE_TAC[TILE_UPSET_INSERT] THEN + REWRITE_TAC[TILE_UPSET_EMPTY; SET_DIFF_DIFF_UNION]);; + +(* specialize to the least stop stage N: P_N = P DIFF tile_upset(Rextract). *) +let CARLESON_PEXTRACT_DIFF = prove + (`!f gam P. &0 < gam /\ FINITE P + ==> carleson_Pseq f gam (carleson_Rtilde P) P (carleson_stopN f gam P) = + P DIFF tile_upset (carleson_Rextract f gam P)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[carleson_Rextract] THEN + MP_TAC(ISPECL [`f:real->complex`; `gam:real`; `carleson_Rtilde P`; + `P:(int#int#int)->bool`; + `carleson_stopN f gam P`] CARLESON_PSEQ_TELESCOPE) THEN + ASM_SIMP_TAC[CARLESON_RTILDE_FINITE] THEN + DISCH_THEN MATCH_MP_TAC THEN + MP_TAC(ISPECL [`f:real->complex`;`gam:real`;`P:(int#int#int)->bool`] + CARLESON_STOPN_SPEC) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o CONJUNCT2) THEN + REWRITE_TAC[carleson_Rseq]);; + +(* Fremlin's residual energy bound: energy_f f (P DIFF R+) <= gam/2. *) +let CARLESON_RESIDUAL_ENERGY = prove + (`!f gam P. &0 < gam /\ FINITE P + ==> energy_f f (P DIFF tile_upset (carleson_Rextract f gam P)) <= gam / + &2`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:real->complex`;`gam:real`;`P:(int#int#int)->bool`] + CARLESON_PEXTRACT_DIFF) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC CARLESON_STOP_ENERGY THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`f:real->complex`;`gam:real`;`P:(int#int#int)->bool`] + CARLESON_STOPN_SPEC) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o CONJUNCT1) THEN + REWRITE_TAC[carleson_Rseq]);; + +(* ------------------------------------------------------------------------- *) +(* 286K piece disjointness: the extracted pieces P'_j = P_j cap T_{tau_j} at *) +(* distinct active stages are pairwise disjoint (P'_j SUBSET P_j \ P_{j+1}). *) +(* Needed for delta_f f P' = sum_j delta_f f (P'_j) (DELTA_UNIONS), the *) +(* measure *) +(* budget gam^2 sum_R muI <= 4 delta. *) +(* ------------------------------------------------------------------------- *) + +(* piece_j SUBSET P_j \ P_{j+1} (stage j active). *) +let CARLESON_PIECE_SUBSET_DIFF = prove + (`!f gam Rt P j. ~(carleson_Rseq f gam Rt P j = {}) + ==> carleson_piece f gam Rt P j SUBSET + (carleson_Pseq f gam Rt P j DIFF carleson_Pseq f gam Rt P (SUC j))`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP CARLESON_PSEQ_STEP_ACTIVE th]) + THEN + MATCH_MP_TAC(SET_RULE `s SUBSET a /\ s SUBSET u ==> s SUBSET (a DIFF (a DIFF + u))`) THEN + CONJ_TAC THENL + [REWRITE_TAC[carleson_piece; TILE_TREE_SUBSET]; + REWRITE_TAC[carleson_piece] THEN + MP_TAC(ISPECL [`carleson_Pseq f gam Rt P j`; + `carleson_rootseq f gam Rt P j`] + TILE_TREE_SUBSET_UPSET) THEN REWRITE_TAC[]]);; + +(* pieces at distinct active stages are disjoint (j DISJOINT (carleson_piece f gam Rt P j) (carleson_piece f gam Rt P l)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`f:real->complex`;`gam:real`;`Rt:(int#int#int)->bool`; + `P:(int#int#int)->bool`;`j:num`] + CARLESON_PIECE_SUBSET_DIFF) THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL + [`f:real->complex`;`gam:real`;`Rt:(int#int#int)->bool`; + `P:(int#int#int)->bool`; + `SUC j`;`l:num`] CARLESON_PSEQ_MONO) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPECL [`carleson_Pseq f gam Rt P l`; `carleson_rootseq f gam Rt P l`] + TILE_TREE_SUBSET) THEN REWRITE_TAC[GSYM carleson_piece] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[DISJOINT] THEN ASM SET_TAC[]);; + +(* per-root energy lower bound: at an active stage j the root tau_j is in *) +(* R_j, so *) +(* 1/4 gam^2 muI_{tau_j} <= Delta_f(piece_j). Feeds the measure budget *) +(* gam^2 sum_R muI <= 4 delta_f f P'. *) +let CARLESON_ROOT_ENERGY_LB = prove + (`!f gam P j. &0 < gam /\ FINITE P /\ j < carleson_stopN f gam P + ==> &1 / &4 * gam pow 2 * + &2 zpow (--(tile_k (carleson_rootseq f gam (carleson_Rtilde P) P j))) + <= delta_f f (carleson_piece f gam (carleson_Rtilde P) P j)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:real->complex`;`gam:real`;`carleson_Rtilde P`; + `carleson_Pseq f gam (carleson_Rtilde P) P j`] CARLESON_EROOT_SPEC) THEN + SUBGOAL_THEN + `~(carleson_Rseq f gam (carleson_Rtilde P) P j = {})` MP_TAC THENL + [MATCH_MP_TAC CARLESON_ACTIVE_RSEQ THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[carleson_Rseq] THEN DISCH_TAC THEN + ASM_SIMP_TAC[CARLESON_RTILDE_FINITE] THEN + DISCH_THEN(MP_TAC o CONJUNCT1) THEN + REWRITE_TAC[carleson_Rset; IN_ELIM_THM; GSYM carleson_rootseq; + GSYM carleson_piece] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[]);; + +(* delta over a disjoint IMAGE-indexed family = sum over indices: delta_f f *) +(* (UNIONS(IMAGE g II)) = sum_{i in II} delta_f f (g i), for a finite index *) +(* set II with the g i finite, nonempty, and pairwise disjoint (nonemptiness *) +(* gives g injective on II, so DELTA_UNIONS's set-sum becomes the *) +(* index-sum). *) +let DELTA_UNIONS_IMAGE = prove + (`!(f:real->complex) (g:num->(int#int#int)->bool) II. + FINITE II /\ (!i. i IN II ==> FINITE (g i)) /\ (!i. i IN II ==> ~(g i = + {})) /\ + (!i j. i IN II /\ j IN II /\ ~(i = j) ==> DISJOINT (g i) (g j)) + ==> delta_f f (UNIONS (IMAGE g II)) = sum II (\i. delta_f f (g i))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:real->complex`; + `IMAGE (g:num->(int#int#int)->bool) II`] DELTA_UNIONS) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_IMAGE] THEN + X_GEN_TAC `a:num` THEN DISCH_TAC THEN X_GEN_TAC `b:num` THEN DISCH_TAC THEN + DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN + MP_TAC(ISPECL [`g:num->(int#int#int)->bool`; + `\A:(int#int#int)->bool. delta_f f A`; + `II:num->bool`] SUM_IMAGE) THEN + ANTS_TAC THENL + [MAP_EVERY X_GEN_TAC [`a:num`; `b:num`] THEN STRIP_TAC THEN + GEN_REWRITE_TAC I [TAUT `p <=> ~ ~p`] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`a:num`;`b:num`]) THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[DISJOINT_EMPTY_REFL; MEMBER_NOT_EMPTY]; + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[o_DEF]]);; + +(* ------------------------------------------------------------------------- *) +(* 286K measure budget: gam^2 sum_{Rextract} muI <= 4 delta_f f Pextract. *) +(* The numerator of Fremlin's budget gam^2 sum_R muI <= C6 (with *) +(* delta<=C6/4). *) +(* ------------------------------------------------------------------------- *) + +(* piece_j is FINITE (SUBSET P). *) +let CARLESON_PIECE_FINITE = prove + (`!f gam Rt P j. FINITE P ==> FINITE (carleson_piece f gam Rt P j)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[carleson_piece] THEN + MATCH_MP_TAC TILE_TREE_FINITE THEN ASM_SIMP_TAC[CARLESON_PSEQ_FINITE]);; + +(* piece_j nonempty when j= 1/4 gam^2 2^{-k} > 0. *) +let CARLESON_PIECE_NONEMPTY = prove + (`!f gam P j. &0 < gam /\ FINITE P /\ j < carleson_stopN f gam P + ==> ~(carleson_piece f gam (carleson_Rtilde P) P j = {})`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:real->complex`;`gam:real`;`P:(int#int#int)->bool`;`j:num`] + CARLESON_ROOT_ENERGY_LB) THEN + ASM_REWRITE_TAC[delta_f; SUM_CLAUSES] THEN + MATCH_MP_TAC(REAL_ARITH `&0 < a ==> ~(a <= &0)`) THEN + MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC THENL + [REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_POW_LT THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC]]);; + +(* delta_f f Pextract = sum_{j delta_f f (carleson_Pextract f gam P) = + sum {j | j < carleson_stopN f gam P} + (\j. delta_f f (carleson_piece f gam (carleson_Rtilde P) P j))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[carleson_Pextract] THEN + MATCH_MP_TAC DELTA_UNIONS_IMAGE THEN + REWRITE_TAC[FINITE_NUMSEG_LT; IN_ELIM_THM] THEN + REPEAT CONJ_TAC THENL + [X_GEN_TAC `i:num` THEN DISCH_TAC THEN ASM_SIMP_TAC[CARLESON_PIECE_FINITE]; + X_GEN_TAC `i:num` THEN DISCH_TAC THEN + MATCH_MP_TAC CARLESON_PIECE_NONEMPTY THEN + ASM_REWRITE_TAC[]; + MAP_EVERY X_GEN_TAC [`a:num`;`b:num`] THEN STRIP_TAC THEN + SUBGOAL_THEN `a:num < b \/ b < a` STRIP_ASSUME_TAC THENL + [ASM_ARITH_TAC; + MATCH_MP_TAC CARLESON_PIECE_DISJOINT THEN + ASM_SIMP_TAC[CARLESON_ACTIVE_RSEQ]; + ONCE_REWRITE_TAC[DISJOINT_SYM] THEN + MATCH_MP_TAC CARLESON_PIECE_DISJOINT THEN + ASM_SIMP_TAC[CARLESON_ACTIVE_RSEQ]]]);; + +(* THE MEASURE BUDGET: gam^2 sum_{Rextract} 2^{-k} <= 4 delta_f f Pextract. *) +(* SUM_IMAGE_LE (Rextract = IMAGE rootseq) reduces to sum_{j gam pow 2 * sum (carleson_Rextract f gam P) (\t. &2 zpow (--(tile_k + t))) + <= &4 * delta_f f (carleson_Pextract f gam P)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `gam pow 2 * sum {j | j < carleson_stopN f gam P} + (\j. &2 zpow (--(tile_k (carleson_rootseq f gam (carleson_Rtilde P) P + j))))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_LE_POW_2]; ALL_TAC] THEN + REWRITE_TAC[carleson_Rextract] THEN + MP_TAC(ISPECL [`carleson_rootseq f gam (carleson_Rtilde P) P`; + `\t:int#int#int. &2 zpow (--(tile_k t))`; + `{j | j < carleson_stopN f gam P}`] + SUM_IMAGE_LE) THEN + REWRITE_TAC[FINITE_NUMSEG_LT; o_DEF] THEN DISCH_THEN MATCH_MP_TAC THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_ZPOW_LE THEN REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[CARLESON_DELTA_PEXTRACT] THEN + REWRITE_TAC[GSYM SUM_LMUL] THEN MATCH_MP_TAC SUM_LE THEN + REWRITE_TAC[FINITE_NUMSEG_LT; IN_ELIM_THM] THEN + X_GEN_TAC `j:num` THEN DISCH_TAC THEN + MP_TAC(ISPECL [`f:real->complex`;`gam:real`;`P:(int#int#int)->bool`;`j:num`] + CARLESON_ROOT_ENERGY_LB) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* 286K(b) GRAM ROOF: given the H_j square-sum bound (sum_s inr_s^2 <= K *) +(* alpha) *) +(* as a hypothesis, delta_f f P <= C3 + sqrt K. Wires the banked backbone: *) +(* DELTA_SQ_LE_GRAM (alpha^2<=norm Gram) + CARLESON_NORMSQ_DOUBLE_LE (norm *) +(* Gram *) +(* <=C3 alpha + norm offdiag) + OFFDIAG_LE_INR + OFFBLOCK_CS + *) +(* GRAM_COMBINE_SQRT. *) +(* inr_s = the off-diagonal weight-kernel row sum over {t in P, J_t<>J_s}. *) +(* ------------------------------------------------------------------------- *) + +(* Leg 1: alpha^2 <= C3 alpha + norm(offdiag). *) +let CARLESON_GRAM_LEG1 = prove + (`!(f:real->complex) (P:(int#int#int)->bool) C3. + (\z. f(drop z)) IN lspace (:real^1) (&2) /\ FINITE P /\ + lnorm (:real^1) (&2) (\z. f(drop z)) <= &1 /\ + (!f' P'. FINITE P' ==> norm(vsum P' (\s. vsum P' (\t. + carleson_ip f' s * cnj(carleson_ip f' t) * + lproduct (:real^1) (\z. phi_sigma s carleson_phi (drop z)) + (\z. phi_sigma t carleson_phi (drop z))))) + <= C3 * sum P' (\s. norm(carleson_ip f' s) pow 2) + + norm(vsum P' (\s. vsum {t | t IN P' /\ ~(tile_J t = tile_J s)} (\t. + carleson_ip f' s * cnj(carleson_ip f' t) * + lproduct (:real^1) (\z. phi_sigma s carleson_phi (drop z)) + (\z. phi_sigma t carleson_phi (drop z)))))) + ==> (delta_f f P) pow 2 <= C3 * delta_f f P + + norm(vsum P (\s. vsum {t | t IN P /\ ~(tile_J t = tile_J s)} (\t. + carleson_ip f s * cnj(carleson_ip f t) * + lproduct (:real^1) (\z. phi_sigma s carleson_phi (drop z)) + (\z. phi_sigma t carleson_phi (drop z)))))`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `norm(vsum P (\s. vsum P (\t. + carleson_ip f s * cnj(carleson_ip f t) * + lproduct (:real^1) (\z. phi_sigma s carleson_phi (drop z)) + (\z. phi_sigma t carleson_phi (drop z)))))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC DELTA_SQ_LE_GRAM THEN ASM_REWRITE_TAC[]; + FIRST_X_ASSUM(MP_TAC o SPECL [`f:real->complex`; + `P:(int#int#int)->bool`]) THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM delta_f]]);; + +(* Leg 2: norm(offdiag) <= sqrt(alpha) sqrt(K alpha). *) +let CARLESON_ROW_MEETING = prove + (`!(f:real->complex) (P:(int#int#int)->bool) s. FINITE P + ==> sum {t | t IN P /\ ~(tile_J t = tile_J s)} + (\t. norm(integral (:real^1) (\z. phi_sigma s carleson_phi (drop + z) * + cnj(phi_sigma t carleson_phi (drop z)))) * + norm(carleson_ip f t)) + = sum {t | t IN P /\ ~(tile_J t = tile_J s) /\ ~DISJOINT (tile_Jl s) + (tile_Jl t)} + (\t. norm(integral (:real^1) (\z. phi_sigma s carleson_phi (drop + z) * + cnj(phi_sigma t carleson_phi (drop z)))) * + norm(carleson_ip f t))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_SUPERSET THEN + CONJ_TAC THENL + [REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN GEN_TAC THEN STRIP_TAC THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + X_GEN_TAC `t:int#int#int` THEN REWRITE_TAC[IN_ELIM_THM] THEN + STRIP_TAC THEN + SUBGOAL_THEN + `DISJOINT (tile_Jl s) (tile_Jl (t:int#int#int))` ASSUME_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `integral (:real^1) (\z. phi_sigma s carleson_phi (drop z) * + cnj(phi_sigma t carleson_phi (drop z))) = Cx(&0)` + (fun th -> REWRITE_TAC[th; COMPLEX_NORM_0; REAL_MUL_LZERO]) THEN + MATCH_MP_TAC PHISIG_CARLESON_ORTHO_JL THEN ASM_REWRITE_TAC[]);; + +(* meeting set SUBSET block2 UNION block3 (forward dichotomy *) +(* TILE_JL_OFFDIAG_ *) +(* DICHOTOMY). block2 = {J_s SUBSET J^l_t}, block3 = {J_t SUBSET J^l_s}. *) +let CARLESON_MEETING_SUBSET = prove + (`!(P:(int#int#int)->bool) s. + {t | t IN P /\ ~(tile_J t = tile_J s) /\ ~DISJOINT (tile_Jl s) (tile_Jl + t)} SUBSET + {t | t IN P /\ tile_J s SUBSET tile_Jl t} UNION {t | t IN P /\ tile_J t + SUBSET tile_Jl s}`, + REPEAT GEN_TAC THEN REWRITE_TAC[SUBSET; IN_UNION; IN_ELIM_THM] THEN + X_GEN_TAC `t:int#int#int` THEN STRIP_TAC THEN + MP_TAC(ISPECL [`s:int#int#int`; + `t:int#int#int`] TILE_JL_OFFDIAG_DICHOTOMY) THEN + REWRITE_TAC[SUBSET] THEN ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; ALL_TAC] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[]);; + +(* the row split: inr_s <= inr2_s + inr3_s (ROW_MEETING = drop kernel-0 *) +(* terms; SUM_SUBSET_SIMPLE via MEETING_SUBSET; SUM_UNION_LE_POS; all terms *) +(* nonneg). *) +let CARLESON_ROW_SPLIT = prove + (`!(f:real->complex) (P:(int#int#int)->bool) s. FINITE P + ==> sum {t | t IN P /\ ~(tile_J t = tile_J s)} + (\t. norm(integral (:real^1) (\z. phi_sigma s carleson_phi (drop + z) * + cnj(phi_sigma t carleson_phi (drop z)))) * + norm(carleson_ip f t)) + <= sum {t | t IN P /\ tile_J s SUBSET tile_Jl t} + (\t. norm(integral (:real^1) (\z. phi_sigma s carleson_phi + (drop z) * + cnj(phi_sigma t carleson_phi (drop z)))) * + norm(carleson_ip f t)) + + sum {t | t IN P /\ tile_J t SUBSET tile_Jl s} + (\t. norm(integral (:real^1) (\z. phi_sigma s carleson_phi + (drop z) * + cnj(phi_sigma t carleson_phi (drop z)))) * + norm(carleson_ip f t))`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[CARLESON_ROW_MEETING] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum ({t | t IN P /\ tile_J s SUBSET tile_Jl t} UNION + {t | t IN P /\ tile_J t SUBSET tile_Jl s}) + (\t. norm(integral (:real^1) (\z. phi_sigma s carleson_phi (drop + z) * + cnj(phi_sigma t carleson_phi (drop z)))) * + norm(carleson_ip f t))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN + ASM_SIMP_TAC[CARLESON_MEETING_SUBSET; FINITE_UNION; FINITE_RESTRICT] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_MUL THEN + REWRITE_TAC[NORM_POS_LE]; + MATCH_MP_TAC SUM_UNION_LE_POS THEN + ASM_SIMP_TAC[FINITE_RESTRICT] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_MUL THEN + REWRITE_TAC[NORM_POS_LE]]);; + +(* ------------------------------------------------------------------------- *) +(* 286K(b) GRAM ROOF v2 (Fremlin-faithful): takes the off-diagonal bound *) +(* norm(offdiag) <= sqrt(alpha) sqrt(K alpha) DIRECTLY as hypothesis (not *) +(* via *) +(* the combined-inr sum inr^2<=K alpha, which would need the structureless *) +(* block-3 rows). Fremlin bounds norm offdiag = block2-DS + block3-DS = *) +(* 2*block2-DS by the double-sum swap symmetry, each block <= sqrt(alpha) *) +(* sqrt *) +(* (8C3^2C4 alpha), so K = 32C3^2C4. Roof = DELTA_SQ_LE_GRAM + *) +(* NORMSQ_DOUBLE_LE *) +(* (CARLESON_GRAM_LEG1) + GRAM_COMBINE_SQRT. *) +(* ------------------------------------------------------------------------- *) +let CARLESON_GRAM_BUDGET2 = prove + (`?C3. &0 <= C3 /\ + !(f:real->complex) (P:(int#int#int)->bool) K. + (\z. f(drop z)) IN lspace (:real^1) (&2) /\ FINITE P /\ + lnorm (:real^1) (&2) (\z. f(drop z)) <= &1 /\ &0 <= K /\ + norm(vsum P (\s. vsum {t | t IN P /\ ~(tile_J t = tile_J s)} (\t. + carleson_ip f s * cnj(carleson_ip f t) * + lproduct (:real^1) (\z. phi_sigma s carleson_phi (drop z)) + (\z. phi_sigma t carleson_phi (drop z))))) + <= sqrt(delta_f f P) * sqrt(K * delta_f f P) + ==> delta_f f P <= C3 + sqrt K`, + X_CHOOSE_THEN `C3:real` STRIP_ASSUME_TAC CARLESON_NORMSQ_DOUBLE_LE THEN + EXISTS_TAC `C3:real` THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC GRAM_COMBINE_SQRT THEN + EXISTS_TAC `norm(vsum P (\s. vsum {t | t IN P /\ ~(tile_J t = tile_J s)} (\t. + carleson_ip f s * cnj(carleson_ip f t) * + lproduct (:real^1) (\z. phi_sigma s carleson_phi (drop z)) + (\z. phi_sigma t carleson_phi (drop z)))))` + THEN + ASM_REWRITE_TAC[DELTA_POS] THEN + MATCH_MP_TAC CARLESON_GRAM_LEG1 THEN ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Abstract double-sum swap over a relation-restricted inner index, for a *) +(* SYMMETRIC summand g: sum_s sum_{t in P, R s t} g s t = sum_s sum_{t in P, *) +(* R t s} g s t. This is Fremlin's "Similarly" for the two off-diagonal *) +(* J-blocks *) +(* (block-2 R s t = J_s SUBSET J^l_t; block-3 R t s = J_t SUBSET J^l_s) *) +(* applied *) +(* to the swap-symmetric weight |ip_s| || |ip_t|. *) +(* SUM_RESTRICT_SET *) +(* + SUM_SWAP + the g-symmetry. *) +(* ------------------------------------------------------------------------- *) +let SUM_DOUBLE_SWAP_REL = prove + (`!(P:A->bool) (g:A->A->real) R. FINITE P /\ (!x y. g x y = g y x) + ==> sum P (\s. sum {t | t IN P /\ R s t} (\t. g s t)) + = sum P (\s. sum {t | t IN P /\ R t s} (\t. g s t))`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[SUM_RESTRICT_SET] THEN + W(fun (asl,w) -> MP_TAC(ISPECL [`\s t:A. if R s t then (g:A->A->real) s t + else &0`; + `P:A->bool`; `P:A->bool`] SUM_SWAP)) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `s:A` THEN DISCH_TAC THEN + REWRITE_TAC[] THEN + MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `t:A` THEN DISCH_TAC THEN + REWRITE_TAC[] THEN + ASM_MESON_TAC[]);; + +(* block3-weighted = block2-weighted (SUM_DOUBLE_SWAP_REL on the *) +(* swap-symmetric weight norm(ip_s) norm() norm(ip_t), R s t = *) +(* J_s SUBSET J^l_t). *) +let CARLESON_BLOCK_SYM = prove + (`!(f:real->complex) (P:(int#int#int)->bool). FINITE P + ==> sum P (\s. norm(carleson_ip f s) * + sum {t | t IN P /\ tile_J s SUBSET tile_Jl t} + (\t. norm(integral (:real^1) (\z. phi_sigma s + carleson_phi (drop z) * + cnj(phi_sigma t carleson_phi (drop z)))) * + norm(carleson_ip f t))) + = sum P (\s. norm(carleson_ip f s) * + sum {t | t IN P /\ tile_J t SUBSET tile_Jl s} + (\t. norm(integral (:real^1) (\z. phi_sigma s + carleson_phi (drop z) * + cnj(phi_sigma t carleson_phi (drop z)))) * + norm(carleson_ip f t)))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM SUM_LMUL] THEN + MP_TAC(ISPECL [`P:(int#int#int)->bool`; + `\s t:int#int#int. norm(carleson_ip f s) * + (norm(integral (:real^1) (\z. phi_sigma s carleson_phi (drop z) * + cnj(phi_sigma t carleson_phi (drop z)))) * norm(carleson_ip f + t))`; + `\s t:int#int#int. tile_J s SUBSET tile_Jl t`] SUM_DOUBLE_SWAP_REL) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN REPEAT GEN_TAC THEN + MP_TAC(ISPECL [`x:int#int#int`;`y:int#int#int`] PHISIG_CORR_SYM) THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN REAL_ARITH_TAC; + DISCH_THEN SUBST1_TAC THEN REFL_TAC]);; + +(* norm(offdiag) <= 2 * block2-weighted. OFFDIAG_LE_INR + ROW_SPLIT *) +(* (inr<=inr2+ *) +(* inr3) + CARLESON_BLOCK_SYM (block3=block2). Fremlin's 2*block2 from *) +(* "Similarly". *) +let CARLESON_OFFDIAG_2BLOCK = prove + (`!(f:real->complex) (P:(int#int#int)->bool). FINITE P + ==> norm(vsum P (\s. vsum {t | t IN P /\ ~(tile_J t = tile_J s)} (\t. + carleson_ip f s * cnj(carleson_ip f t) * + lproduct (:real^1) (\z. phi_sigma s carleson_phi (drop z)) + (\z. phi_sigma t carleson_phi (drop z))))) + <= &2 * sum P (\s. norm(carleson_ip f s) * + sum {t | t IN P /\ tile_J s SUBSET tile_Jl t} + (\t. norm(integral (:real^1) (\z. phi_sigma s + carleson_phi (drop z) * + cnj(phi_sigma t carleson_phi (drop z)))) * + norm(carleson_ip f t)))`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum P (\s. norm(carleson_ip f s) * + sum {t | t IN P /\ ~(tile_J t = tile_J s)} (\t. + norm(integral (:real^1) (\z. phi_sigma s carleson_phi + (drop z) * + cnj(phi_sigma t carleson_phi + (drop z)))) * + norm(carleson_ip f t)))` THEN + CONJ_TAC THENL [MATCH_MP_TAC OFFDIAG_LE_INR THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum P (\s. norm(carleson_ip f s) * sum {t | t IN P /\ tile_J s + SUBSET tile_Jl t} (\t. norm(integral (:real^1) (\z. phi_sigma s + carleson_phi (drop z) * cnj(phi_sigma t carleson_phi (drop z)))) * + norm(carleson_ip f t))) + sum P (\s. norm(carleson_ip f s) * sum {t | t IN + P /\ tile_J t SUBSET tile_Jl s} (\t. norm(integral (:real^1) (\z. phi_sigma + s carleson_phi (drop z) * cnj(phi_sigma t carleson_phi (drop z)))) * + norm(carleson_ip f t)))` THEN + CONJ_TAC THENL + [ASM_SIMP_TAC[GSYM SUM_ADD] THEN MATCH_MP_TAC SUM_LE THEN + ASM_REWRITE_TAC[] THEN + X_GEN_TAC `s:int#int#int` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + REWRITE_TAC[GSYM REAL_ADD_LDISTRIB] THEN MATCH_MP_TAC REAL_LE_LMUL THEN + REWRITE_TAC[NORM_POS_LE] THEN MATCH_MP_TAC CARLESON_ROW_SPLIT THEN + ASM_REWRITE_TAC[]; + ABBREV_TAC `A = sum P (\s. norm(carleson_ip f s) * sum {t | t IN P /\ + tile_J s SUBSET tile_Jl t} (\t. norm(integral (:real^1) (\z. phi_sigma s + carleson_phi (drop z) * cnj(phi_sigma t carleson_phi (drop z)))) * + norm(carleson_ip f t)))` THEN + ABBREV_TAC `B = sum P (\s. norm(carleson_ip f s) * sum {t | t IN P /\ + tile_J t SUBSET tile_Jl s} (\t. norm(integral (:real^1) (\z. phi_sigma s + carleson_phi (drop z) * cnj(phi_sigma t carleson_phi (drop z)))) * + norm(carleson_ip f t)))` THEN + SUBGOAL_THEN `A:real = B` (fun th -> REWRITE_TAC[th] THEN + REAL_ARITH_TAC) THEN + MAP_EVERY EXPAND_TAC ["A";"B"] THEN MATCH_MP_TAC CARLESON_BLOCK_SYM THEN + ASM_REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* 286K(b) H_j a-iii COVER: for sigma in piece_j (root tau_j) and t in an *) +(* active *) +(* piece_m with J_sigma SUBSET J^l_t (block-2 inner index), the fine tile's *) +(* interval I_t is disjoint from the root's interval I_{tau_j}. Fremlin *) +(* (mt286. *) +(* tex 1108-1112): J_{tau_j} SUBSET J_sigma SUBSET J^l_t, so the a-iii first *) +(* remark on (t,tau_j) gives I_t cap I_{tau_j} = empty. Chain: *) +(* PIECE_LER_ROOT *) +(* (J_{tau_j} SUBSET J_sigma) + SUBSET_TRANS + CARLESON_AIII_ORDER (~tile_le *) +(* t *) +(* tau_j) + AIII_FIRST_CORE_LE. So I_t SUBSET R\I_{tau_j} = the H_j cover *) +(* II. *) +(* ------------------------------------------------------------------------- *) +let CARLESON_TREE_COVER = prove + (`!f gam P j m sigma t. &0 < gam /\ FINITE P /\ + j < carleson_stopN f gam P /\ m < carleson_stopN f gam P /\ + sigma IN carleson_piece f gam (carleson_Rtilde P) P j /\ + t IN carleson_piece f gam (carleson_Rtilde P) P m /\ + tile_J sigma SUBSET tile_Jl t + ==> DISJOINT (tile_I t) (tile_I (carleson_rootseq f gam (carleson_Rtilde + P) P j))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `tile_J (carleson_rootseq f gam (carleson_Rtilde P) P j) SUBSET tile_J + sigma` ASSUME_TAC THENL + [MP_TAC(ISPECL [`f:real->complex`;`gam:real`;`carleson_Rtilde + P`;`P:(int#int#int)->bool`;`j:num`;`sigma:int#int#int`] + CARLESON_PIECE_LER_ROOT) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP TILE_LER_IMP_LE) THEN + REWRITE_TAC[tile_le] THEN STRIP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `tile_J (carleson_rootseq f gam (carleson_Rtilde P) P j) SUBSET tile_Jl t` + ASSUME_TAC THENL + [ASM_MESON_TAC[SUBSET_TRANS]; ALL_TAC] THEN + MATCH_MP_TAC AIII_FIRST_CORE_LE THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CARLESON_AIII_ORDER THEN EXISTS_TAC `m:num` THEN + ASM_SIMP_TAC[CARLESON_RTILDE_FINITE; CARLESON_ACTIVE_RSEQ]; + ASM_MESON_TAC[TILE_JL_SUBSET_J; SUBSET_TRANS]; + MATCH_MP_TAC TILE_JL_SUBSET_KLE THEN ASM_REWRITE_TAC[]]);; + +(* 286K(b) H_j pairwise-negligibility: distinct t,t' in P' whose J^l both *) +(* contain *) +(* J_sigma (so J^l_t meets J^l_t') have negligible I-overlap. Fremlin *) +(* mt286.tex *) +(* 1108-1112 (I_tau, I_tau' disjoint). ~DISJOINT(J^l_t)(J^l_t') from the *) +(* shared *) +(* nonempty J_sigma + CARLESON_AIII_DISJOINT + empty set negligible. *) +let CARLESON_TREE_PAIRWISE = prove + (`!f gam P sigma t t'. &0 < gam /\ FINITE P /\ + t IN carleson_Pextract f gam P /\ t' IN carleson_Pextract f gam P /\ + ~(t = t') /\ tile_J sigma SUBSET tile_Jl t /\ tile_J sigma SUBSET tile_Jl + t' + ==> real_negligible (tile_I t INTER tile_I t')`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `~DISJOINT (tile_Jl t) (tile_Jl t')` ASSUME_TAC THENL + [MP_TAC(ISPEC `sigma:int#int#int` TILE_J_NONEMPTY) THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + DISCH_THEN(X_CHOOSE_TAC `y:real`) THEN + REWRITE_TAC[DISJOINT; GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN + EXISTS_TAC `y:real` THEN + CONJ_TAC THENL + [UNDISCH_TAC `tile_J sigma SUBSET tile_Jl t` THEN REWRITE_TAC[SUBSET] THEN + DISCH_THEN(MP_TAC o SPEC `y:real`) THEN ASM_REWRITE_TAC[]; + UNDISCH_TAC `tile_J sigma SUBSET tile_Jl t'` THEN + REWRITE_TAC[SUBSET] THEN + DISCH_THEN(MP_TAC o SPEC `y:real`) THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN `DISJOINT (tile_I t) (tile_I t')` MP_TAC THENL + [MATCH_MP_TAC CARLESON_AIII_DISJOINT THEN + MAP_EVERY EXISTS_TAC [`f:real->complex`;`gam:real`;`P:(int#int#int)->bool`] + THEN + ASM_REWRITE_TAC[]; + REWRITE_TAC[DISJOINT] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[REAL_NEGLIGIBLE_EMPTY]]);; + +(* strict scale J_s SUBSET J^l_t ==> k_s < k_t (J^l is a PROPER half, so the *) +(* strict form of TILE_JL_SUBSET_KLE; DYHO_SUBSET_SCALE on dyho k_s SUBSET *) +(* dyho *) +(* (k_t-1)). And same spatial interval forces same scale (TILE_I_MEASURE + *) +(* ZPOW2_INJ). Together: J_s SUBSET J^l_t ==> ~(I_s = I_t) [k_s tile_k s < tile_k t`, + MATCH_MP_TAC(MESON[PAIR_SURJECTIVE] + `(!ks nIs nJs kt nIt nJt. P ((ks,nIs,nJs):int#int#int) + ((kt,nIt,nJt):int#int#int)) + ==> (!s t. P s t)`) THEN + MAP_EVERY X_GEN_TAC + [`ks:int`;`nIs:int`;`nJs:int`;`kt:int`;`nIt:int`;`nJt:int`] THEN + REWRITE_TAC[tile_J; tile_Jl; tile_k] THEN + DISCH_THEN(MP_TAC o MATCH_MP DYHO_SUBSET_SCALE) THEN INT_ARITH_TAC);; + +let TILE_I_EQ_SCALE = prove + (`!(s:int#int#int) t. tile_I s = tile_I t ==> tile_k s = tile_k t`, + MATCH_MP_TAC(MESON[PAIR_SURJECTIVE] + `(!ks nIs nJs kt nIt nJt. P ((ks,nIs,nJs):int#int#int) + ((kt,nIt,nJt):int#int#int)) + ==> (!s t. P s t)`) THEN + MAP_EVERY X_GEN_TAC + [`ks:int`;`nIs:int`;`nJs:int`;`kt:int`;`nIt:int`;`nJt:int`] THEN + REWRITE_TAC[tile_k] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`ks:int`;`nIs:int`;`nJs:int`] TILE_I_MEASURE) THEN + MP_TAC(ISPECL [`kt:int`;`nIt:int`;`nJt:int`] TILE_I_MEASURE) THEN + ASM_REWRITE_TAC[] THEN REPEAT DISCH_TAC THEN + SUBGOAL_THEN `&2 zpow (--ks) = &2 zpow (--kt)` MP_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o MATCH_MP ZPOW2_INJ) THEN INT_ARITH_TAC);; + +(* Pextract SUBSET P (each piece SUBSET its stage SUBSET P) + FINITE. Feeds *) +(* energy_f f Pextract <= gam via ENERGY_MONO, an HJ_INNER_TILE hypothesis. *) +let CARLESON_PEXTRACT_SUBSET = prove + (`!f gam P. carleson_Pextract f gam P SUBSET P`, + REPEAT GEN_TAC THEN + REWRITE_TAC[carleson_Pextract; UNIONS_SUBSET; FORALL_IN_IMAGE] THEN + X_GEN_TAC `j:num` THEN DISCH_TAC THEN REWRITE_TAC[carleson_piece] THEN + MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `carleson_Pseq f gam (carleson_Rtilde P) P j` THEN + REWRITE_TAC[TILE_TREE_SUBSET; CARLESON_PSEQ_SUBSET_P]);; + +let CARLESON_PEXTRACT_FINITE = prove + (`!f gam P. FINITE P ==> FINITE (carleson_Pextract f gam P)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `P:(int#int#int)->bool` THEN + ASM_REWRITE_TAC[CARLESON_PEXTRACT_SUBSET]);; + +(* 286K(b) H_j geometric sub-atoms for the HJ_INNER_TILE instantiation: *) +(* - if I_t is disjoint from a dyadic cell dyho(--k)nI = [nI *) +(* 2^{--k},(nI+1)2^{--k}), *) +(* then I_t sits in the CLOSED complement half-lines (the SUBTILE_TAIL_SUM *) +(* set); *) +(* - the tile centre x_sigma lies in its own interval I_sigma; *) +(* - cw_tile sigma is integrable on the complement half-lines when x_sigma *) +(* is *) +(* between the two cut points (CWTILE_TAIL_COMPLEMENT gives *) +(* has_real_integral). *) +(* ------------------------------------------------------------------------- *) + +(* TILE_XMID_IN_I (tile centre lies in its own interval) is proved above. *) + +let CWTILE_COMPL_INTEGRABLE = prove + (`!(sigma:int#int#int) alpha gm. + alpha <= tile_xmid sigma /\ tile_xmid sigma <= gm /\ alpha < gm + ==> cw_tile sigma real_integrable_on ({x | x <= alpha} UNION {x | gm <= + x})`, + REPEAT STRIP_TAC THEN REWRITE_TAC[real_integrable_on] THEN + EXISTS_TAC `&1 / (&2 * (&1 + &2 zpow (tile_k sigma) * (tile_xmid sigma - + alpha)) pow 2) + + &1 / (&2 * (&1 + &2 zpow (tile_k sigma) * (gm - tile_xmid sigma)) + pow 2)` THEN + MATCH_MP_TAC CWTILE_TAIL_COMPLEMENT THEN ASM_REWRITE_TAC[]);; + +(* cw_tile sigma integrable on R\I_r when x_sigma IN I_r: I_r=dyho[a,b), its *) +(* complement {x cw_tile sigma real_integrable_on ((:real) DIFF tile_I r)`, + GEN_TAC THEN + MATCH_MP_TAC(MESON[PAIR_SURJECTIVE] + `(!kr nIr nJr. P ((kr,nIr,nJr):int#int#int)) ==> (!r. P r)`) THEN + MAP_EVERY X_GEN_TAC [`kr:int`;`nIr:int`;`nJr:int`] THEN + REWRITE_TAC[tile_I; dyho; IN_ELIM_THM] THEN STRIP_TAC THEN + MP_TAC(ISPECL [`cw_tile sigma`; + `{x | x <= real_of_int nIr * &2 zpow (--kr)} UNION {x | (real_of_int nIr + + &1) * &2 zpow (--kr) <= x}`; + `(:real) DIFF {x | real_of_int nIr * &2 zpow (--kr) <= x /\ x < + (real_of_int nIr + &1) * &2 zpow (--kr)}`] + REAL_INTEGRABLE_SPIKE_SET) THEN + ANTS_TAC THENL + [MATCH_MP_TAC REAL_NEGLIGIBLE_SUBSET THEN + EXISTS_TAC `{real_of_int nIr * &2 zpow (--kr)}` THEN + REWRITE_TAC[REAL_NEGLIGIBLE_SING; SUBSET; IN_UNION; IN_DIFF; IN_UNIV; + IN_ELIM_THM; IN_SING] THEN + REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN MATCH_MP_TAC THEN + MATCH_MP_TAC CWTILE_COMPL_INTEGRABLE THEN + SUBGOAL_THEN `&0 < &2 zpow (--kr)` MP_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + ASM_REAL_ARITH_TAC);; + +(* 286K(b) H_j per-sigma inr2 bound: for sigma in piece_j (root tau_j), the *) +(* block-2 inner sum inr2_sigma <= (C3 gam) inv(sqrt 2^{k_sigma}) *) +(* int_{R\I_{tau_j}} w_sigma. HJ_INNER_TILE with Tt={t in P': J_sigma SUBSET *) +(* J^l_t}, II=R\I_{tau_j}; the 9 hyps discharge from the banked atoms: *) +(* FINITE (PEXTRACT_FINITE), k_sig<=k_t (TILE_JL_ SUBSET_KLE) /\ *) +(* ~(I_sig=I_t) (KLT+I_EQ_SCALE), I_t SUBSET II (TREE_COVER), I-inj *) +(* (AIII_DISJOINT+TILE_XMID_IN_I), pairwise-neg (TREE_PAIRWISE), cw integ on *) +(* I_t (CWTILE_INTEGRABLE_TILE_I) and on II (CARLESON_II_INTEGRABLE), energy *) +(* (PEXTRACT). *) +let CARLESON_INR2_BOUND = prove + (`?C3. &0 <= C3 /\ + !f gam0 P j gam sigma. + &0 < gam0 /\ FINITE P /\ j < carleson_stopN f gam0 P /\ &0 <= gam /\ + energy_f f (carleson_Pextract f gam0 P) <= gam /\ + sigma IN carleson_piece f gam0 (carleson_Rtilde P) P j + ==> sum {t | t IN carleson_Pextract f gam0 P /\ tile_J sigma SUBSET + tile_Jl t} + (\t. norm(integral (:real^1) (\z. phi_sigma sigma carleson_phi + (drop z) * + cnj(phi_sigma t carleson_phi (drop z)))) * + norm(carleson_ip f t)) + <= (C3 * gam) * inv(sqrt(&2 zpow (tile_k sigma))) * + real_integral ((:real) DIFF tile_I (carleson_rootseq f gam0 + (carleson_Rtilde P) P j)) + (cw_tile sigma)`, + X_CHOOSE_THEN `C3:real` STRIP_ASSUME_TAC HJ_INNER_TILE THEN + EXISTS_TAC `C3:real` THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `tile_I sigma + SUBSET tile_I (carleson_rootseq f gam0 (carleson_Rtilde P) P j)` + ASSUME_TAC THENL + [MP_TAC(ISPECL [`f:real->complex`;`gam0:real`;`carleson_Rtilde + P`;`P:(int#int#int)->bool`;`j:num`;`sigma:int#int#int`] + CARLESON_PIECE_LER_ROOT) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP TILE_LER_IMP_LE) THEN + REWRITE_TAC[tile_le] THEN STRIP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `tile_xmid sigma IN tile_I (carleson_rootseq f gam0 (carleson_Rtilde P) P + j)` + ASSUME_TAC THENL + [MP_TAC(ISPEC `sigma:int#int#int` TILE_XMID_IN_I) THEN + ASM SET_TAC[]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`f:real->complex`; `sigma:int#int#int`; + `{t | t IN carleson_Pextract f gam0 P /\ tile_J sigma SUBSET tile_Jl t}`; + `carleson_Pextract f gam0 P`; `gam:real`; + `(:real) DIFF tile_I (carleson_rootseq f gam0 (carleson_Rtilde P) P j)`]) + THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `carleson_Pextract f gam0 P` THEN + ASM_SIMP_TAC[CARLESON_PEXTRACT_FINITE; SUBSET; IN_ELIM_THM]; + ASM_SIMP_TAC[CARLESON_PEXTRACT_FINITE]; + SIMP_TAC[IN_ELIM_THM]; + X_GEN_TAC `t:int#int#int` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN + CONJ_TAC THENL + [MATCH_MP_TAC TILE_JL_SUBSET_KLE THEN ASM_REWRITE_TAC[]; + DISCH_TAC THEN + MP_TAC(ISPECL [`sigma:int#int#int`;`t:int#int#int`] TILE_JL_SUBSET_KLT) + THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`sigma:int#int#int`;`t:int#int#int`] TILE_I_EQ_SCALE) THEN + ASM_REWRITE_TAC[] THEN INT_ARITH_TAC]; + X_GEN_TAC `t:int#int#int` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `m:num` STRIP_ASSUME_TAC o + REWRITE_RULE[CARLESON_PEXTRACT_MEM]) THEN + MP_TAC(ISPECL + [`f:real->complex`;`gam0:real`;`P:(int#int#int)->bool`;`j:num`;`m:num`; + `sigma:int#int#int`;`t:int#int#int`] CARLESON_TREE_COVER) THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[DISJOINT] THEN SET_TAC[]; + MAP_EVERY X_GEN_TAC [`t:int#int#int`;`t':int#int#int`] THEN + REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN + GEN_REWRITE_TAC I [TAUT `p <=> ~ ~p`] THEN DISCH_TAC THEN + SUBGOAL_THEN `~DISJOINT (tile_Jl t) (tile_Jl t')` ASSUME_TAC THENL + [MP_TAC(ISPEC `sigma:int#int#int` TILE_J_NONEMPTY) THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + DISCH_THEN(X_CHOOSE_TAC `y:real`) THEN + REWRITE_TAC[DISJOINT; GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN + EXISTS_TAC `y:real` THEN + CONJ_TAC THENL + [UNDISCH_TAC `tile_J sigma SUBSET tile_Jl t` THEN + REWRITE_TAC[SUBSET] THEN + DISCH_THEN(MP_TAC o SPEC `y:real`) THEN ASM_REWRITE_TAC[]; + UNDISCH_TAC `tile_J sigma SUBSET tile_Jl t'` THEN + REWRITE_TAC[SUBSET] THEN + DISCH_THEN(MP_TAC o SPEC `y:real`) THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`f:real->complex`;`gam0:real`;`P:(int#int#int)->bool`;`t:int#int#int`; + `t':int#int#int`] CARLESON_AIII_DISJOINT) THEN + ASM_REWRITE_TAC[DISJOINT] THEN + MP_TAC(ISPEC `t:int#int#int` TILE_XMID_IN_I) THEN ASM SET_TAC[]; + MAP_EVERY X_GEN_TAC [`t:int#int#int`;`t':int#int#int`] THEN + REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN + MATCH_MP_TAC CARLESON_TREE_PAIRWISE THEN + MAP_EVERY EXISTS_TAC + [`f:real->complex`;`gam0:real`;`P:(int#int#int)->bool`; + `sigma:int#int#int`] THEN + ASM_REWRITE_TAC[]; + REWRITE_TAC[CWTILE_INTEGRABLE_TILE_I]; + MATCH_MP_TAC CARLESON_II_INTEGRABLE THEN ASM_REWRITE_TAC[]]);; + +(* cw_tile depends only on the (frequency-scale, spatial-index) pair (k,nI), *) +(* not *) +(* the frequency-index nJ (cw_tile s x = 2^k cw(2^k(x - x_s)), x_s = *) +(* dyho_mid(--k) *) +(* nI). Lets the per-scale H_j sum (d-scale) reindex sigma -> its spatial *) +(* sub-cell *) +(* of I_{tau_j} (SUBTILE_TAIL_SUM uses a fixed nJ). *) +let CW_TILE_NJ_INDEP = prove + (`!k nI nJ nJ'. cw_tile (k,nI,nJ) = cw_tile (k,nI,nJ')`, + REPEAT GEN_TAC THEN REWRITE_TAC[FUN_EQ_THM; cw_tile; tile_k; tile_xmid]);; + +(* in an a-iii-disjoint same-scale tile set, the spatial index nI is *) +(* injective: *) +(* same nI (+ same k) => same I => (disjoint => equal or empty; nonempty) => *) +(* same *) +(* tile. The SELECT-uniqueness the d-scale reindex (SUM_LE_INCLUDED) needs. *) +let TILE_NI_UNIQUE = prove + (`!S k. (!sig. sig IN S ==> tile_k sig = k) /\ + (!s s'. s IN S /\ s' IN S /\ ~(s = s') ==> DISJOINT (tile_I s) (tile_I + s')) + ==> !s s'. s IN S /\ s' IN S /\ FST(SND s) = FST(SND s') ==> s = s'`, + REPEAT GEN_TAC THEN STRIP_TAC THEN REPEAT GEN_TAC THEN STRIP_TAC THEN + GEN_REWRITE_TAC I [TAUT `p <=> ~ ~p`] THEN DISCH_TAC THEN + SUBGOAL_THEN `tile_I s = tile_I s'` ASSUME_TAC THENL + [SUBGOAL_THEN `tile_k s = tile_k s'` MP_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + MP_TAC(ISPEC `s:int#int#int` PAIR_SURJECTIVE) THEN + DISCH_THEN(X_CHOOSE_THEN `a0:int` (X_CHOOSE_THEN + `a1:int#int` SUBST_ALL_TAC)) THEN + MP_TAC(ISPEC `a1:int#int` PAIR_SURJECTIVE) THEN + DISCH_THEN(X_CHOOSE_THEN `a1a:int` (X_CHOOSE_THEN + `a1b:int` SUBST_ALL_TAC)) THEN + MP_TAC(ISPEC `s':int#int#int` PAIR_SURJECTIVE) THEN + DISCH_THEN(X_CHOOSE_THEN `b0:int` (X_CHOOSE_THEN + `b1:int#int` SUBST_ALL_TAC)) THEN + MP_TAC(ISPEC `b1:int#int` PAIR_SURJECTIVE) THEN + DISCH_THEN(X_CHOOSE_THEN `b1a:int` (X_CHOOSE_THEN + `b1b:int` SUBST_ALL_TAC)) THEN + REWRITE_TAC[tile_I; tile_k] THEN + RULE_ASSUM_TAC(REWRITE_RULE[FST; SND]) THEN + DISCH_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`s:int#int#int`;`s':int#int#int`]) THEN + ASM_REWRITE_TAC[DISJOINT; GSYM MEMBER_NOT_EMPTY; IN_INTER] THEN + EXISTS_TAC `tile_xmid s':real` THEN REWRITE_TAC[TILE_XMID_IN_I]);; + +(* scale relation 2^{--kt} = N 2^{--k} when 2^{k-kt}=N (spatial cell = N *) +(* sub-cells). *) +let ZPOW_SCALE_REL = prove + (`!k kt N. &2 zpow (k - kt) = &N ==> &2 zpow (--kt) = &N * &2 zpow (--k)`, + REPEAT STRIP_TAC THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + SUBGOAL_THEN + `&2 zpow (k - kt) * &2 zpow (--k) = &2 zpow ((k - kt) + (--k))` SUBST1_TAC + THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_ZPOW_ADD THEN + REAL_ARITH_TAC; ALL_TAC] THEN + AP_TERM_TAC THEN INT_ARITH_TAC);; + +(* the scale-k sub-cell at offset j (index N*nIt+j) has its midpoint inside *) +(* the *) +(* coarse cell I_{(kt,nIt,.)} = [nIt 2^{--kt},(nIt+1)2^{--kt}), for j < N. *) +(* Feeds *) +(* CWTILE_COMPL_INTEGRABLE (x_subcell between the cut points) in the d-scale *) +(* nonneg *) +(* leg. *) +let TILE_SUBCELL_MID_IN = prove + (`!k kt N nIt j:num. &2 zpow (k - kt) = &N /\ j < N + ==> real_of_int nIt * &2 zpow (--kt) <= dyho_mid (--k) (&N * nIt + &j) /\ + dyho_mid (--k) (&N * nIt + &j) <= (real_of_int nIt + &1) * &2 zpow + (--kt)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[dyho_mid] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP ZPOW_SCALE_REL th]) THEN + SUBGOAL_THEN + `real_of_int (&N * nIt + &j) = &N * real_of_int nIt + &j` SUBST1_TAC THENL + [REWRITE_TAC[REAL_OF_INT_CLAUSES]; ALL_TAC] THEN + SUBGOAL_THEN `&0 < &2 zpow (--k)` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `&j <= &N - &1` ASSUME_TAC THENL + [SUBGOAL_THEN `j + 1 <= N` MP_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_ADD] THEN + REAL_ARITH_TAC; ALL_TAC] THEN + ABBREV_TAC `z = &2 zpow (--k)` THEN ABBREV_TAC `p = real_of_int nIt` THEN + CONJ_TAC THEN + ONCE_REWRITE_TAC[REAL_ARITH + `p * &N * z = (p * &N) * z /\ (&N * p + (&j + &1 / &2)) * z = (&N * p + (&j + + &1 / &2)) * z /\ + (p + &1) * &N * z = ((p + &1) * &N) * z`] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN + ASM_REAL_ARITH_TAC);; + +(* 2^{k-kt}=&N with kt<=k forces N>=1 (2^nonneg >= 1 = 2^0, ZPOW2_MONOE). *) +let ONE_LE_N_FROM_ZPOW = prove + (`!k kt N:num. &2 zpow (k - kt) = &N /\ kt <= k ==> 1 <= N`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`&0:int`; `k - kt:int`] ZPOW2_MONOE) THEN + ASM_SIMP_TAC[INT_ARITH `kt <= k ==> &0 <= k - kt:int`; REAL_ZPOW_0] THEN + ASM_REWRITE_TAC[REAL_OF_NUM_LE]);; + +(* the sub-cell offset num_of_int(nIs - N*nIt) lands in 0..N-1 when the *) +(* spatial index nIs is in the coarse block [N*nIt, N*nIt+N). *) +let TILE_SUBCELL_OFFSET_IN = prove + (`!nIs nIt N:num. + &N * nIt <= nIs /\ nIs < &N * nIt + &N /\ + &(num_of_int (nIs - &N * nIt)) = nIs - &N * nIt /\ 1 <= N + ==> num_of_int (nIs - &N * nIt) IN (0..N-1)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[IN_NUMSEG] THEN CONJ_TAC THENL + [ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[GSYM INT_OF_NUM_LE] THEN + MP_TAC(ISPECL [`1`;`N:num`] INT_OF_NUM_SUB) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC[] THEN ASM_INT_ARITH_TAC);; + +(* TILE_LE_SUBCELL_INDEX with the &N-factor on the LEFT of the *) +(* multiplication (matching CARLESON_PERSCALE_TAIL's sub-cell offset *) +(* arithmetic). *) +let TILE_LE_SUBCELL_INDEX_FLIP = prove + (`!k kt nIs nJs nIt nJt N:num. + tile_le (k,nIs,nJs) (kt,nIt,nJt) /\ kt <= k /\ &2 zpow (k - kt) = &N + ==> &N * nIt <= nIs /\ nIs < &N * nIt + &N`, + REPEAT STRIP_TAC THENL + [MP_TAC(ISPECL + [`k:int`;`kt:int`;`nIs:int`;`nJs:int`;`nIt:int`;`nJt:int`;`&N:int`] + TILE_LE_SUBCELL_INDEX) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[REAL_OF_INT_CLAUSES]; ALL_TAC] THEN + REWRITE_TAC[INT_RING `nIt * &N:int = &N * nIt`] THEN STRIP_TAC THEN + FIRST_ASSUM ACCEPT_TAC; + MP_TAC(ISPECL + [`k:int`;`kt:int`;`nIs:int`;`nJs:int`;`nIt:int`;`nJt:int`;`&N:int`] + TILE_LE_SUBCELL_INDEX) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[REAL_OF_INT_CLAUSES]; ALL_TAC] THEN + REWRITE_TAC[INT_RING `nIt * &N:int = &N * nIt`] THEN STRIP_TAC THEN + FIRST_ASSUM ACCEPT_TAC]);; + +(* 286K(b) H_j d-scale: for a finite a-iii-disjoint set S of scale-k tiles *) +(* all *) +(* tile_le-below tau, the sum over S of int_{R\I_tau} w_sig is <= 1. Reindex *) +(* each sig to its spatial sub-cell offset in I_tau (SUM_LE_INCLUDED), then *) +(* the per-scale sub-cell tail sum is <= 1 (CARLESON_SUBTILE_TAIL_SUM). *) +let CARLESON_PERSCALE_TAIL = prove + (`!S tau k N. FINITE S /\ &2 zpow (k - tile_k tau) = &N /\ tile_k tau <= k /\ + (!sig. sig IN S ==> tile_le sig tau /\ tile_k sig = k) /\ + (!s s'. s IN S /\ s' IN S /\ ~(s = s') ==> DISJOINT (tile_I s) (tile_I + s')) + ==> sum S (\sig. real_integral + ({x | x <= real_of_int (FST(SND tau)) * &2 zpow (--(tile_k + tau))} UNION + {x | (real_of_int (FST(SND tau)) + &1) * &2 zpow (--(tile_k + tau)) <= x}) + (cw_tile sig)) + <= &1`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `tau:int#int#int` PAIR_SURJECTIVE) THEN + DISCH_THEN(X_CHOOSE_THEN `kt:int` (X_CHOOSE_THEN + `rest:int#int` SUBST_ALL_TAC)) THEN + MP_TAC(ISPEC `rest:int#int` PAIR_SURJECTIVE) THEN + DISCH_THEN(X_CHOOSE_THEN `nIt:int` (X_CHOOSE_THEN + `nJt:int` SUBST_ALL_TAC)) THEN + RULE_ASSUM_TAC(REWRITE_RULE[tile_k]) THEN REWRITE_TAC[tile_k; FST; SND] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum (0..N-1) (\j. real_integral + ({x | x <= real_of_int nIt * &2 zpow (--kt)} UNION + {x | (real_of_int nIt + &1) * &2 zpow (--kt) <= x}) + (cw_tile (k, &N * nIt + &j, nJt)))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE_INCLUDED THEN + EXISTS_TAC `\j:num. @sig:int#int#int. sig IN S /\ FST(SND sig) = &N * nIt + + &j` THEN + ASM_REWRITE_TAC[FINITE_NUMSEG] THEN CONJ_TAC THENL + [X_GEN_TAC `j:num` THEN REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN + MATCH_MP_TAC REAL_INTEGRAL_POS THEN + CONJ_TAC THENL + [MATCH_MP_TAC CWTILE_COMPL_INTEGRABLE THEN + REWRITE_TAC[tile_xmid; tile_k] THEN + MP_TAC(ISPECL [`k:int`;`kt:int`;`N:num`;`nIt:int`;`j:num`] + TILE_SUBCELL_MID_IN) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`k:int`;`kt:int`;`N:num`] ONE_LE_N_FROM_ZPOW) THEN + ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; ALL_TAC] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `&0 < &2 zpow (--kt)` MP_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + REAL_ARITH_TAC; + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`(k, &N * nIt + &j, nJt):int#int#int`; + `x:real`] CW_TILE_POS) THEN + REAL_ARITH_TAC]; + X_GEN_TAC `sig:int#int#int` THEN DISCH_TAC THEN + SUBGOAL_THEN `&N * nIt <= FST(SND(sig:int#int#int)) /\ + FST(SND sig) < &N * nIt + &N` STRIP_ASSUME_TAC THENL + [MP_TAC(ISPEC `sig:int#int#int` PAIR_SURJECTIVE) THEN + DISCH_THEN(X_CHOOSE_THEN `ks:int` (X_CHOOSE_THEN + `rs:int#int` SUBST_ALL_TAC)) THEN + MP_TAC(ISPEC `rs:int#int` PAIR_SURJECTIVE) THEN + DISCH_THEN(X_CHOOSE_THEN `nIs:int` (X_CHOOSE_THEN + `nJs:int` SUBST_ALL_TAC)) THEN + REWRITE_TAC[FST; SND] THEN + SUBGOAL_THEN + `tile_le (ks,nIs,nJs) (kt,nIt,nJt) /\ tile_k (ks,nIs,nJs) = k` + MP_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[tile_k] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC) THEN + MP_TAC(ISPECL + [`k:int`;`kt:int`;`nIs:int`;`nJs:int`;`nIt:int`;`nJt:int`;`N:num`] + TILE_LE_SUBCELL_INDEX_FLIP) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN ACCEPT_TAC; + ALL_TAC] THEN + EXISTS_TAC `num_of_int (FST(SND(sig:int#int#int)) - &N * nIt)` THEN + SUBGOAL_THEN `&(num_of_int (FST(SND(sig:int#int#int)) - &N * nIt)) = + FST(SND sig) - &N * nIt` ASSUME_TAC THENL + [MATCH_MP_TAC INT_OF_NUM_OF_INT THEN ASM_INT_ARITH_TAC; ALL_TAC] THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC TILE_SUBCELL_OFFSET_IN THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`k:int`;`kt:int`;`N:num`] ONE_LE_N_FROM_ZPOW) THEN + ASM_REWRITE_TAC[]; + SUBGOAL_THEN + `&N * nIt + FST(SND(sig:int#int#int)) - &N * nIt = FST(SND sig)` + ASSUME_TAC THENL [INT_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_OF_INT_CLAUSES] THEN + ASM_REWRITE_TAC[INT_ARITH `&N * nIt + (x - &N * nIt):int = x`] THEN + MATCH_MP_TAC SELECT_UNIQUE THEN X_GEN_TAC `w:int#int#int` THEN + REWRITE_TAC[] THEN EQ_TAC THENL + [STRIP_TAC THEN + MP_TAC(ISPECL [`S:(int#int#int)->bool`; `k:int`] + TILE_NI_UNIQUE) THEN + ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPECL [`w:int#int#int`; `sig:int#int#int`]) THEN + ASM_REWRITE_TAC[]; + DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[]]; + ASM_REWRITE_TAC[INT_ARITH `&N * nIt + (x - &N * nIt):int = x`] THEN + MP_TAC(ISPEC `sig:int#int#int` PAIR_SURJECTIVE) THEN + DISCH_THEN(X_CHOOSE_THEN `ks:int` (X_CHOOSE_THEN + `rs:int#int` SUBST_ALL_TAC)) THEN + MP_TAC(ISPEC `rs:int#int` PAIR_SURJECTIVE) THEN + DISCH_THEN(X_CHOOSE_THEN `nIs:int` (X_CHOOSE_THEN + `nJs:int` SUBST_ALL_TAC)) THEN + REWRITE_TAC[FST; SND] THEN + SUBGOAL_THEN + `tile_le (ks,nIs,nJs) (kt,nIt,nJt) /\ tile_k (ks,nIs,nJs) = k` + MP_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[tile_k] THEN + DISCH_THEN(CONJUNCTS_THEN2 (K ALL_TAC) SUBST_ALL_TAC) THEN + SUBST1_TAC(ISPECL [`k:int`;`nIs:int`;`nJs:int`;`nJt:int`] + CW_TILE_NJ_INDEP) THEN + REWRITE_TAC[REAL_LE_REFL]]]; + MATCH_MP_TAC CARLESON_SUBTILE_TAIL_SUM THEN ASM_REWRITE_TAC[]]);; + +(* Per-summand: the weight integral over the closed-ray complement pair *) +(* equals the integral over (:real) DIFF tile_I tau (they differ by the *) +(* single left endpoint {nIt*2^-kt}, negligible; REAL_INTEGRAL_SPIKE_SET). *) +let CW_TILE_INTEGRAL_RAYS_EQ_DIFF = prove + (`!sigma kt nIt nJt:int. + real_integral + ({x | x <= real_of_int nIt * &2 zpow (--kt)} UNION + {x | (real_of_int nIt + &1) * &2 zpow (--kt) <= x}) (cw_tile sigma) = + real_integral ((:real) DIFF tile_I (kt,nIt,nJt)) (cw_tile sigma)`, + REPEAT GEN_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_SPIKE_SET THEN + MATCH_MP_TAC REAL_NEGLIGIBLE_SUBSET THEN + EXISTS_TAC `{real_of_int nIt * &2 zpow (--kt)}` THEN + REWRITE_TAC[REAL_NEGLIGIBLE_SING] THEN + REWRITE_TAC[tile_I; dyho; SUBSET; IN_UNION; IN_DIFF; IN_UNIV; IN_ELIM_THM; + IN_SING] THEN REAL_ARITH_TAC);; + +(* CARLESON_PERSCALE_TAIL in the set-difference region form (:real) DIFF *) +(* tile_I tau, matching the region used by HJ_INNER_TILE / *) +(* CARLESON_INR2_BOUND (286Gh). *) +let CARLESON_PERSCALE_TAIL_DIFF = prove + (`!S tau k N. FINITE S /\ &2 zpow (k - tile_k tau) = &N /\ tile_k tau <= k /\ + (!sig. sig IN S ==> tile_le sig tau /\ tile_k sig = k) /\ + (!s s'. s IN S /\ s' IN S /\ ~(s = s') ==> DISJOINT (tile_I s) (tile_I + s')) + ==> sum S (\sig. real_integral ((:real) DIFF tile_I tau) (cw_tile sig)) <= + &1`, + REPEAT GEN_TAC THEN + MP_TAC(ISPEC `tau:int#int#int` PAIR_SURJECTIVE) THEN + DISCH_THEN(X_CHOOSE_THEN `kt:int` (X_CHOOSE_THEN + `rest:int#int` SUBST1_TAC)) THEN + MP_TAC(ISPEC `rest:int#int` PAIR_SURJECTIVE) THEN + DISCH_THEN(X_CHOOSE_THEN `nIt:int` (X_CHOOSE_THEN `nJt:int` SUBST1_TAC)) THEN + REWRITE_TAC[GSYM CW_TILE_INTEGRAL_RAYS_EQ_DIFF] THEN + REWRITE_TAC[tile_k] THEN STRIP_TAC THEN + MP_TAC(ISPECL [`S:(int#int#int)->bool`; `(kt,nIt,nJt):int#int#int`; `k:int`; + `N:num`] + CARLESON_PERSCALE_TAIL) THEN + ASM_REWRITE_TAC[tile_k; FST; SND]);; + +(* A nonneg-exponent power of 2 is a natural number: 2^{k-kt} = &N (kt <= *) +(* k). *) +let ZPOW2_SCALE_IS_NUM = prove + (`!k kt:int. kt <= k ==> ?N:num. &2 zpow (k - kt) = &N`, + REPEAT STRIP_TAC THEN EXISTS_TAC `2 EXP (num_of_int(k - kt))` THEN + SUBGOAL_THEN `&0:int <= k - kt` ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_POW] THEN + SUBGOAL_THEN `k - kt = &(num_of_int(k - kt)):int` SUBST1_TAC THENL + [ASM_SIMP_TAC[INT_OF_NUM_OF_INT]; ALL_TAC] THEN + REWRITE_TAC[REAL_ZPOW_NUM; NUM_OF_INT_OF_NUM; REAL_OF_NUM_POW]);; + +(* 286Gh with C4:=1, in tree form: for a finite set Pk of tiles all *) +(* tile_le-below *) +(* a common root u (tile_k u <= k) and all of scale k, the weight-tail sum *) +(* sum_{Pk} int_{R\I_u} w_sigma <= 1. The a-iii-style spatial disjointness *) +(* that *) +(* CARLESON_PERSCALE_TAIL_DIFF needs is FREE from tree geometry: same-scale *) +(* tree *) +(* tiles below u are nI-injective (TILE_TREE_FST_SND_INJ), so distinct tiles *) +(* have *) +(* distinct nI, hence disjoint scale-(-k) cells (DYHO_DISJOINT_SAMESCALE). *) +(* This *) +(* is the per-scale budget hypothesis of HJ_TILE_BOUND (with C4 = 1). *) +let TILE_TREE_PERSCALE_LE1 = prove + (`!Pk u k. + FINITE Pk /\ tile_k u <= k /\ + (!s. s IN Pk ==> tile_le s u /\ tile_k s = k) + ==> sum Pk (\sigma. real_integral ((:real) DIFF tile_I u) (cw_tile sigma)) + <= &1`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`k:int`; `tile_k(u:int#int#int)`] ZPOW2_SCALE_IS_NUM) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN + MP_TAC(ISPECL [`Pk:(int#int#int)->bool`; `u:int#int#int`; `k:int`; `N:num`] + CARLESON_PERSCALE_TAIL_DIFF) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + MAP_EVERY X_GEN_TAC [`s:int#int#int`; `s':int#int#int`] THEN STRIP_TAC THEN + MP_TAC(ISPEC `s:int#int#int` PAIR_SURJECTIVE) THEN + DISCH_THEN(X_CHOOSE_THEN `ks:int` (X_CHOOSE_THEN + `rs:int#int` SUBST_ALL_TAC)) THEN + MP_TAC(ISPEC `rs:int#int` PAIR_SURJECTIVE) THEN + DISCH_THEN(X_CHOOSE_THEN `nIs:int` (X_CHOOSE_THEN + `nJs:int` SUBST_ALL_TAC)) THEN + MP_TAC(ISPEC `s':int#int#int` PAIR_SURJECTIVE) THEN + DISCH_THEN(X_CHOOSE_THEN `ks':int` (X_CHOOSE_THEN + `rs':int#int` SUBST_ALL_TAC)) THEN + MP_TAC(ISPEC `rs':int#int` PAIR_SURJECTIVE) THEN + DISCH_THEN(X_CHOOSE_THEN `nIs':int` (X_CHOOSE_THEN + `nJs':int` SUBST_ALL_TAC)) THEN + SUBGOAL_THEN `ks:int = k /\ ks':int = k` STRIP_ASSUME_TAC THENL + [FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `(ks',nIs',nJs'):int#int#int` th) THEN + MP_TAC(SPEC `(ks,nIs,nJs):int#int#int` th)) THEN + ASM_REWRITE_TAC[tile_k] THEN MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `~(nIs:int = nIs')` ASSUME_TAC THENL + [DISCH_TAC THEN + UNDISCH_TAC `~((ks,nIs,nJs):int#int#int = (ks',nIs',nJs'))` THEN + REWRITE_TAC[] THEN + MP_TAC(ISPECL [`Pk:(int#int#int)->bool`; `k:int`; `u:int#int#int`; + `(ks,nIs,nJs):int#int#int`; `(ks',nIs',nJs'):int#int#int`] + TILE_TREE_FST_SND_INJ) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[FST; SND] THEN + GEN_TAC THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `r:int#int#int`) THEN + ASM_REWRITE_TAC[] THEN MESON_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[tile_I] THEN + MATCH_MP_TAC DYHO_DISJOINT_SAMESCALE THEN ASM_REWRITE_TAC[]);; + +(* ========================================================================= *) +(* 286K H_j square-sum for ONE piece P'_j (Fremlin's H_j <= 2 C3^2 gam^2 *) +(* muI_tauj, with C4 := 1). Instantiates the abstract HJ_TILE_BOUND at: *) +(* Sp = carleson_piece (the tree P'_j), *) +(* II sigma = (:real) DIFF tile_I root (root = carleson_rootseq = tau_j), *) +(* Tt sigma = {t in P' | J_sigma SUBSET J^l_t} (the H_j inner tau-set), *) +(* C4 = 1 (per-scale weight-tail budget, TILE_TREE_PERSCALE_LE1), *) +(* L = tile_k root, *) +(* inr sigma bound = CARLESON_INR2_BOUND (the deep per-sigma 286Gg *) +(* estimate). *) +(* The 5 per-sigma HJ hypotheses: inner-sum>=0 (SUM_POS_LE); R sigma>=0 *) +(* (REAL_INTEGRAL_POS + CARLESON_II_INTEGRABLE, x_sigma in I_root since *) +(* sigma tile_le root); R sigma<=1 (CW_TILE_SUBSET_LE_1); the INR2 bound; *) +(* L<=k_sigma (TILE_LE_SCALE). Per-scale: TILE_TREE_PERSCALE_LE1 (disjoint- *) +(* ness FREE from tree nI-injectivity), empty-slice sum=0 handled *) +(* separately. *) +(* C3 is threaded from CARLESON_INR2_BOUND's witness (same constant). *) +(* ========================================================================= *) +let CARLESON_HJ_PIECE = prove + (`?C3. &0 <= C3 /\ + !f gam0 P j gam. + &0 < gam0 /\ FINITE P /\ j < carleson_stopN f gam0 P /\ + &0 <= gam /\ energy_f f (carleson_Pextract f gam0 P) <= gam + ==> sum (carleson_piece f gam0 (carleson_Rtilde P) P j) + (\sigma. (sum {t | t IN carleson_Pextract f gam0 P /\ + tile_J sigma SUBSET tile_Jl t} + (\t. norm(integral (:real^1) + (\z. phi_sigma sigma carleson_phi (drop z) * + cnj(phi_sigma t carleson_phi (drop z)))) * + norm(carleson_ip f t))) pow 2) + <= (C3 * gam) pow 2 * + (&2 * &1 * inv(&2 zpow (tile_k (carleson_rootseq f gam0 + (carleson_Rtilde P) P j))))`, + X_CHOOSE_THEN `C3:real` STRIP_ASSUME_TAC CARLESON_INR2_BOUND THEN + EXISTS_TAC `C3:real` THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`f:real->complex`; + `carleson_piece f gam0 (carleson_Rtilde P) P j`; + `\sigma:int#int#int. {t | t IN carleson_Pextract f gam0 P /\ tile_J sigma + SUBSET tile_Jl t}`; + `\sigma:int#int#int. (:real) DIFF tile_I (carleson_rootseq f gam0 + (carleson_Rtilde P) P j)`; + `gam:real`; `&1:real`; + `tile_k (carleson_rootseq f gam0 (carleson_Rtilde P) P j)`; + `C3:real`] HJ_TILE_BOUND) THEN + REWRITE_TAC[] THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[REAL_POS]; + ASM_REWRITE_TAC[REAL_POS]; + REAL_ARITH_TAC; + MATCH_MP_TAC CARLESON_PIECE_FINITE THEN ASM_REWRITE_TAC[]; + GEN_TAC THEN DISCH_TAC THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC SUM_POS_LE THEN REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[NORM_POS_LE]; + SUBGOAL_THEN + `cw_tile sigma real_integrable_on + ((:real) DIFF tile_I (carleson_rootseq f gam0 (carleson_Rtilde P) P + j))` + ASSUME_TAC THENL + [MATCH_MP_TAC CARLESON_II_INTEGRABLE THEN + MP_TAC(ISPECL [`f:real->complex`;`gam0:real`;`carleson_Rtilde P`; + `P:(int#int#int)->bool`;`j:num`;`sigma:int#int#int`] + CARLESON_PIECE_LER_ROOT) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o MATCH_MP TILE_LER_IMP_LE) THEN + REWRITE_TAC[tile_le] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET]) THEN + REWRITE_TAC[TILE_XMID_IN_I]; ALL_TAC] THEN + MATCH_MP_TAC REAL_INTEGRAL_POS THEN ASM_REWRITE_TAC[] THEN + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`sigma:int#int#int`; `x:real`] CW_TILE_POS) THEN + REAL_ARITH_TAC; + MATCH_MP_TAC CW_TILE_SUBSET_LE_1 THEN + MATCH_MP_TAC CARLESON_II_INTEGRABLE THEN + MP_TAC(ISPECL [`f:real->complex`;`gam0:real`;`carleson_Rtilde P`; + `P:(int#int#int)->bool`;`j:num`;`sigma:int#int#int`] + CARLESON_PIECE_LER_ROOT) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o MATCH_MP TILE_LER_IMP_LE) THEN + REWRITE_TAC[tile_le] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET]) THEN + REWRITE_TAC[TILE_XMID_IN_I]; + FIRST_X_ASSUM(fun th -> + if is_forall(concl th) && + (let b = snd(strip_forall(concl th)) in is_imp b) + then MP_TAC(SPECL + [`f:real->complex`;`gam0:real`;`P:(int#int#int)->bool`; + `j:num`;`gam:real`;`sigma:int#int#int`] th) else NO_TAC) THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC TILE_LE_SCALE THEN + MP_TAC(ISPECL [`f:real->complex`;`gam0:real`;`carleson_Rtilde P`; + `P:(int#int#int)->bool`;`j:num`;`sigma:int#int#int`] + CARLESON_PIECE_LER_ROOT) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(ACCEPT_TAC o MATCH_MP TILE_LER_IMP_LE)]; + X_GEN_TAC `kk:int` THEN + ASM_CASES_TAC `{sigma | sigma IN carleson_piece f gam0 (carleson_Rtilde + P) P j /\ + tile_k sigma = kk} = {}` THENL + [ASM_REWRITE_TAC[SUM_CLAUSES] THEN REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPECL + [`{sigma | sigma IN carleson_piece f gam0 (carleson_Rtilde P) P j /\ + tile_k sigma = kk}`; + `carleson_rootseq f gam0 (carleson_Rtilde P) P j`; `kk:int`] + TILE_TREE_PERSCALE_LE1) THEN + DISCH_THEN MATCH_MP_TAC THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC FINITE_RESTRICT THEN + MATCH_MP_TAC CARLESON_PIECE_FINITE THEN + ASM_REWRITE_TAC[]; + FIRST_X_ASSUM(MP_TAC o REWRITE_RULE[GSYM MEMBER_NOT_EMPTY]) THEN + REWRITE_TAC[IN_ELIM_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `s0:int#int#int` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN MATCH_MP_TAC TILE_LE_SCALE THEN + MP_TAC(ISPECL [`f:real->complex`;`gam0:real`;`carleson_Rtilde P`; + `P:(int#int#int)->bool`;`j:num`;`s0:int#int#int`] + CARLESON_PIECE_LER_ROOT) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(ACCEPT_TAC o MATCH_MP TILE_LER_IMP_LE); + X_GEN_TAC `s:int#int#int` THEN REWRITE_TAC[IN_ELIM_THM] THEN + STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`f:real->complex`;`gam0:real`;`carleson_Rtilde P`; + `P:(int#int#int)->bool`;`j:num`;`s:int#int#int`] + CARLESON_PIECE_LER_ROOT) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(ACCEPT_TAC o MATCH_MP TILE_LER_IMP_LE)]]; + REWRITE_TAC[]]);; + +(* ========================================================================= *) +(* 286K(b) (d1)+(d3): the H_j accumulation sum_{s in P'} inr2_s^2 <= 8 C3^2 *) +(* d, *) +(* d = delta_f f P'. Partition P' over pieces (SUM_UNIONS_IMAGE_DISJOINT), *) +(* bound each piece-sum by CARLESON_HJ_PIECE, collapse the constant and use *) +(* the *) +(* root measure budget gam^2 sum 2^{-k_root} <= 4 delta. *) +(* ========================================================================= *) + +(* Generic: sum over a disjoint IMAGE family = sum of the per-index sums. *) +let SUM_UNIONS_IMAGE_DISJOINT = prove + (`!(h:A->real) (g:num->A->bool) II. + FINITE II /\ (!i. i IN II ==> FINITE (g i)) /\ (!i. i IN II ==> ~(g i = + {})) /\ + (!i j. i IN II /\ j IN II /\ ~(i = j) ==> DISJOINT (g i) (g j)) + ==> sum (UNIONS (IMAGE g II)) h = sum II (\i. sum (g i) h)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`h:A->real`; + `IMAGE (g:num->A->bool) II`] SUM_UNIONS_NONZERO) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[FINITE_IMAGE; FORALL_IN_IMAGE] THEN + MAP_EVERY X_GEN_TAC [`t1:A->bool`;`t2:A->bool`;`x:A`] THEN + REWRITE_TAC[IN_IMAGE] THEN STRIP_TAC THEN + SUBGOAL_THEN `~(x':num = x'')` ASSUME_TAC THENL + [DISCH_TAC THEN UNDISCH_TAC `~(t1:A->bool = t2)` THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`x':num`;`x'':num`]) THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[DISJOINT; EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN + DISCH_THEN(MP_TAC o SPEC `x:A`) THEN + UNDISCH_TAC `x:A IN t1` THEN UNDISCH_TAC `x:A IN t2` THEN + ASM_REWRITE_TAC[] THEN MESON_TAC[]; ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN + MP_TAC(ISPECL [`g:num->A->bool`; `\A:A->bool. sum A (h:A->real)`; + `II:num->bool`] + SUM_IMAGE) THEN + ANTS_TAC THENL + [MAP_EVERY X_GEN_TAC [`a:num`; `b:num`] THEN STRIP_TAC THEN + GEN_REWRITE_TAC I [TAUT `p <=> ~ ~p`] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`a:num`;`b:num`]) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[DISJOINT; INTER_IDEMPOT] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `b:num`) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[o_DEF] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[]);; + +(* Root measure budget in index-sum form: gam^2 sum_{j gam pow 2 * sum {j | j < carleson_stopN f gam P} + (\j. &2 zpow (--(tile_k (carleson_rootseq f gam (carleson_Rtilde + P) P j)))) + <= &4 * delta_f f (carleson_Pextract f gam P)`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[CARLESON_DELTA_PEXTRACT] THEN + REWRITE_TAC[GSYM SUM_LMUL] THEN MATCH_MP_TAC SUM_LE THEN + REWRITE_TAC[FINITE_NUMSEG_LT; IN_ELIM_THM] THEN + X_GEN_TAC `j:num` THEN DISCH_TAC THEN + MP_TAC(ISPECL [`f:real->complex`;`gam:real`;`P:(int#int#int)->bool`;`j:num`] + CARLESON_ROOT_ENERGY_LB) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; + +(* Arithmetic core: (2 (C3 gam)^2) S <= 8 C3^2 d given gam^2 S <= 4d, *) +(* S,d>=0. *) +let INR2_TAIL_ARITH = prove + (`!C3 gam S d:real. &0 <= C3 /\ &0 <= gam /\ + gam pow 2 * S <= &4 * d /\ &0 <= S /\ &0 <= d + ==> (&2 * (C3 * gam) pow 2) * S <= &8 * C3 pow 2 * d`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(&2 * (C3 * gam) pow 2) * S = (&2 * C3 pow 2) * (gam pow 2 * S)` + SUBST1_TAC THENL [CONV_TAC REAL_RING; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(&2 * C3 pow 2) * (&4 * d)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_LE_POW_2] THEN + REAL_ARITH_TAC; + REWRITE_TAC[REAL_ARITH `(&2*C3sq)*(&4*d) = &8*C3sq*d`] THEN + REAL_ARITH_TAC]);; + +(* Leg-2 collapse: sum_{jint) N d. + &0 <= C3 /\ &0 <= gam /\ &0 <= d /\ + gam pow 2 * sum {j | j < N} (\j. &2 zpow (--(kf j))) <= &4 * d + ==> sum {j | j < N} (\j. (C3 * gam) pow 2 * (&2 * &1 * inv(&2 zpow (kf + j)))) + <= &8 * C3 pow 2 * d`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[REAL_MUL_RID; GSYM REAL_ZPOW_NEG] THEN + REWRITE_TAC[REAL_ARITH `(C3 * gam) pow 2 * &2 * z = (&2 * (C3*gam) pow 2) * + z`] THEN + REWRITE_TAC[SUM_LMUL] THEN + REWRITE_TAC[REAL_ARITH `(&2 * (C3 * gam) pow 2) * &1 * S = (&2 * (C3 * gam) + pow 2) * S`] THEN + MP_TAC(ISPECL [`C3:real`;`gam:real`; + `sum {j | j < N} (\j. &2 zpow (--((kf:num->int) j)))`; + `d:real`] INR2_TAIL_ARITH) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + MATCH_MP_TAC SUM_POS_LE THEN REWRITE_TAC[FINITE_NUMSEG_LT; IN_ELIM_THM] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_ZPOW_LE THEN REAL_ARITH_TAC);; + +(* THE MISSING LINK: sum over P' of the block-2 row-sum^2 <= 8 C3^2 delta_f *) +(* P'. *) +let CARLESON_INR2_SUMSQ = prove + (`?C3. &0 <= C3 /\ + !f gam P. + &0 < gam /\ FINITE P /\ energy_f f P <= gam + ==> sum (carleson_Pextract f gam P) + (\sigma. (sum {t | t IN carleson_Pextract f gam P /\ + tile_J sigma SUBSET tile_Jl t} + (\t. norm(integral (:real^1) + (\z. phi_sigma sigma carleson_phi (drop z) * + cnj(phi_sigma t carleson_phi (drop z)))) * + norm(carleson_ip f t))) pow 2) + <= &8 * C3 pow 2 * delta_f f (carleson_Pextract f gam P)`, + X_CHOOSE_THEN `C3:real` STRIP_ASSUME_TAC CARLESON_HJ_PIECE THEN + EXISTS_TAC `C3:real` THEN CONJ_TAC THENL + [FIRST_ASSUM ACCEPT_TAC; ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`f:real->complex`;`gam:real`;`P:(int#int#int)->bool`] + THEN + STRIP_TAC THEN + SUBGOAL_THEN `energy_f f (carleson_Pextract f gam P) <= gam` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `energy_f f (P:(int#int#int)->bool)` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC ENERGY_MONO THEN + ASM_REWRITE_TAC[CARLESON_PEXTRACT_SUBSET]; ALL_TAC] THEN + MP_TAC(ISPECL + [`\sigma. (sum {t | t IN carleson_Pextract f gam P /\ tile_J sigma SUBSET + tile_Jl t} + (\t. norm(integral (:real^1) + (\z. phi_sigma sigma carleson_phi (drop z) * + cnj(phi_sigma t carleson_phi (drop z)))) * + norm(carleson_ip f t))) pow 2`; + `carleson_piece f gam (carleson_Rtilde P) P`; + `{j | j < carleson_stopN f gam P}`] SUM_UNIONS_IMAGE_DISJOINT) THEN + REWRITE_TAC[GSYM carleson_Pextract] THEN + ANTS_TAC THENL + [REWRITE_TAC[FINITE_NUMSEG_LT; IN_ELIM_THM] THEN REPEAT CONJ_TAC THENL + [X_GEN_TAC `i:num` THEN DISCH_TAC THEN + MATCH_MP_TAC CARLESON_PIECE_FINITE THEN ASM_REWRITE_TAC[]; + X_GEN_TAC `i:num` THEN DISCH_TAC THEN + MATCH_MP_TAC CARLESON_PIECE_NONEMPTY THEN ASM_REWRITE_TAC[]; + MAP_EVERY X_GEN_TAC [`a:num`;`b:num`] THEN STRIP_TAC THEN + SUBGOAL_THEN `a:num < b \/ b < a` STRIP_ASSUME_TAC THENL + [ASM_ARITH_TAC; + MATCH_MP_TAC CARLESON_PIECE_DISJOINT THEN + ASM_SIMP_TAC[CARLESON_ACTIVE_RSEQ]; + ONCE_REWRITE_TAC[DISJOINT_SYM] THEN + MATCH_MP_TAC CARLESON_PIECE_DISJOINT THEN + ASM_SIMP_TAC[CARLESON_ACTIVE_RSEQ]]]; + ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum {j | j < carleson_stopN f gam P} + (\j. (C3 * gam) pow 2 * &2 * &1 * + inv(&2 zpow (tile_k (carleson_rootseq f gam (carleson_Rtilde P) P + j))))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE THEN REWRITE_TAC[FINITE_NUMSEG_LT; IN_ELIM_THM] THEN + X_GEN_TAC `j:num` THEN DISCH_TAC THEN + FIRST_ASSUM(fun th -> + if is_forall(concl th) && (length(fst(strip_forall(concl th))) = 5) + then MP_TAC(SPECL [`f:real->complex`;`gam:real`;`P:(int#int#int)->bool`; + `j:num`;`gam:real`] th) else NO_TAC) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[REAL_LT_IMP_LE]; DISCH_THEN ACCEPT_TAC]; ALL_TAC] THEN + MP_TAC(BETA_RULE(ISPECL [`C3:real`; `gam:real`; + `\j. tile_k (carleson_rootseq f gam (carleson_Rtilde P) P j)`; + `carleson_stopN f gam P`; + `delta_f f (carleson_Pextract f gam P)`] CARLESON_HJ_SUM_ARITH)) THEN + REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[DELTA_POS] THEN CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; + MP_TAC(ISPECL [`f:real->complex`;`gam:real`;`P:(int#int#int)->bool`] + CARLESON_ROOT_MEASURE_BUDGET) THEN ASM_REWRITE_TAC[]]);; + +(* ========================================================================= *) +(* 286K(b) FINAL GRAM BOUND: delta_f f Pextract <= C6/4. Chains *) +(* OFFDIAG_2BLOCK *) +(* (offdiag <= 2 sum|ip|inr2) + OFFBLOCK_CS (<= 2 sqrt(d) sqrt(sum inr2^2)) *) +(* + *) +(* CARLESON_INR2_SUMSQ (sum inr2^2 <= 8 Cb^2 d) -> offdiag <= sqrt(d) *) +(* sqrt(32 *) +(* Cb^2 d), then CARLESON_GRAM_BUDGET2 (K=32 Cb^2) -> d <= Ca + sqrt(32 *) +(* Cb^2). *) +(* ========================================================================= *) + +(* sqrt arithmetic: 2 sqrt(d) sqrt(X) <= sqrt(d) sqrt(32 C^2 d) when X<=8C^2 *) +(* d. *) +let GRAM_SQRT_COLLAPSE = prove + (`!d C X. &0 <= d /\ &0 <= C /\ &0 <= X /\ X <= &8 * C pow 2 * d + ==> &2 * sqrt d * sqrt X <= sqrt d * sqrt((&32 * C pow 2) * d)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&2 * sqrt d * sqrt X = sqrt d * sqrt(&4 * X)` SUBST1_TAC THENL + [REWRITE_TAC[SQRT_MUL] THEN + SUBGOAL_THEN `sqrt(&4) = &2` SUBST1_TAC THENL + [SUBGOAL_THEN `&4 = &2 pow 2` SUBST1_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[POW_2_SQRT_ABS] THEN REAL_ARITH_TAC; ALL_TAC] THEN + REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC SQRT_POS_LE THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[SQRT_MONO_LE_EQ] THEN ASM_REAL_ARITH_TAC]);; + +(* THE GRAM BOUND for Pextract. C6 = 4(Ca + sqrt(32 Cb^2)) is a valid budget *) +(* constant (286M needs SOME C6). *) +let CARLESON_GRAM_DELTA = prove + (`?C6. &0 <= C6 /\ + !f gam P. + (\z. f(drop z)) IN lspace (:real^1) (&2) /\ + lnorm (:real^1) (&2) (\z. f(drop z)) <= &1 /\ + &0 < gam /\ FINITE P /\ energy_f f P <= gam + ==> delta_f f (carleson_Pextract f gam P) <= C6 / &4`, + X_CHOOSE_THEN `Ca:real` STRIP_ASSUME_TAC CARLESON_GRAM_BUDGET2 THEN + X_CHOOSE_THEN `Cb:real` STRIP_ASSUME_TAC CARLESON_INR2_SUMSQ THEN + EXISTS_TAC `&4 * (Ca + sqrt(&32 * Cb pow 2))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_ADD THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC SQRT_POS_LE THEN MATCH_MP_TAC REAL_LE_MUL THEN + REWRITE_TAC[REAL_LE_POW_2] THEN REAL_ARITH_TAC; ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`f:real->complex`;`gam:real`;`P:(int#int#int)->bool`] + THEN + STRIP_TAC THEN + SUBGOAL_THEN + `(&4 * (Ca + sqrt(&32 * Cb pow 2))) / &4 = Ca + sqrt(&32 * Cb pow 2)` + SUBST1_TAC THENL [CONV_TAC REAL_FIELD; ALL_TAC] THEN + (* apply GRAM_BUDGET2 at P' = Pextract, K = 32 Cb^2 *) + FIRST_X_ASSUM(fun th -> + if is_forall(concl th) && + (let b = snd(strip_forall(concl th)) in + is_imp b && free_in `sqrt` (snd(dest_imp b))) + then MP_TAC(SPECL [`f:real->complex`; `carleson_Pextract f gam P`; + `&32 * Cb pow 2`] th) else NO_TAC) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CARLESON_PEXTRACT_FINITE THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_LE_POW_2] THEN + REAL_ARITH_TAC; + (* the offdiag <= sqrt(d) sqrt(32 Cb^2 d) bound *) + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&2 * sum (carleson_Pextract f gam P) + (\s. norm(carleson_ip f s) * + sum {t | t IN carleson_Pextract f gam P /\ tile_J s SUBSET tile_Jl + t} + (\t. norm(integral (:real^1) + (\z. phi_sigma s carleson_phi (drop z) * + cnj(phi_sigma t carleson_phi (drop z)))) * + norm(carleson_ip f t)))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC CARLESON_OFFDIAG_2BLOCK THEN + MATCH_MP_TAC CARLESON_PEXTRACT_FINITE THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&2 * sqrt(delta_f f (carleson_Pextract f gam P)) * + sqrt(sum (carleson_Pextract f gam P) + (\s. (sum {t | t IN carleson_Pextract f gam P /\ tile_J s SUBSET + tile_Jl t} + (\t. norm(integral (:real^1) + (\z. phi_sigma s carleson_phi (drop z) * + cnj(phi_sigma t carleson_phi (drop z)))) * + norm(carleson_ip f t))) pow 2))` THEN + CONJ_TAC THENL + [REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_LMUL THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPECL [`f:real->complex`; `carleson_Pextract f gam P`; + `\s. sum {t | t IN carleson_Pextract f gam P /\ tile_J s SUBSET + tile_Jl t} + (\t. norm(integral (:real^1) + (\z. phi_sigma s carleson_phi (drop z) * + cnj(phi_sigma t carleson_phi (drop z)))) * + norm(carleson_ip f t))` ] OFFBLOCK_CS) THEN + REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + CONJ_TAC THENL + [MATCH_MP_TAC CARLESON_PEXTRACT_FINITE THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + X_GEN_TAC `s:int#int#int` THEN DISCH_TAC THEN + MATCH_MP_TAC SUM_POS_LE THEN REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[NORM_POS_LE]; ALL_TAC] THEN + MATCH_MP_TAC GRAM_SQRT_COLLAPSE THEN + ASM_REWRITE_TAC[DELTA_POS] THEN CONJ_TAC THENL + [MATCH_MP_TAC SUM_POS_LE THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[REAL_LE_POW_2]; + FIRST_X_ASSUM(fun th -> + if is_forall(concl th) && (length(fst(strip_forall(concl th))) = 3) + then MP_TAC(SPECL + [`f:real->complex`;`gam:real`;`P:(int#int#int)->bool`] th) + else NO_TAC) THEN + ASM_REWRITE_TAC[]]]; + DISCH_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `Ca + sqrt(&32 * Cb pow 2)` THEN + ASM_REWRITE_TAC[REAL_LE_REFL]]);; + +(* ========================================================================= *) +(* 286K (energy stopping-time budget), FULLY PROVED. For f in L^2 with *) +(* ||f||_2 <= 1, the energy budget predicate holds with C6 = 4(Ca + sqrt(32 *) +(* Cb^2)) (Ca from the Gram roof GRAM_BUDGET2, Cb from the H_j square-sum *) +(* INR2_SUMSQ). R1 = carleson_Rextract (the greedy-extracted roots): the *) +(* measure leg gam^2 sum_R1 2^{-k} <= 4 delta_f Pextract <= 4(C6/4) = C6 *) +(* [CARLESON_MEASURE_BUDGET + CARLESON_GRAM_DELTA]; the residual-energy leg *) +(* energy(P DIFF R1^+) <= gam/2 [CARLESON_RESIDUAL_ENERGY]. This closes the *) +(* energy budget that 286M (CARLESON_286M_STEP) consumes as a hypothesis. *) +(* ========================================================================= *) +let CARLESON_286K = prove + (`?C6. &0 <= C6 /\ + !f. (\z. f(drop z)) IN lspace (:real^1) (&2) /\ + lnorm (:real^1) (&2) (\z. f(drop z)) <= &1 + ==> carleson_energy_budget f C6`, + X_CHOOSE_THEN `C6:real` STRIP_ASSUME_TAC CARLESON_GRAM_DELTA THEN + EXISTS_TAC `C6:real` THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `f:real->complex` THEN STRIP_TAC THEN + REWRITE_TAC[carleson_energy_budget] THEN + MAP_EVERY X_GEN_TAC [`P:(int#int#int)->bool`;`gam:real`] THEN STRIP_TAC THEN + EXISTS_TAC `carleson_Rextract f gam P` THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[carleson_Rextract] THEN MATCH_MP_TAC FINITE_IMAGE THEN + REWRITE_TAC[FINITE_NUMSEG_LT]; + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&4 * delta_f f (carleson_Pextract f gam P)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC CARLESON_MEASURE_BUDGET THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&4 * C6 / &4` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + FIRST_X_ASSUM(fun th -> + if is_forall(concl th) && (length(fst(strip_forall(concl th))) = 3) + then MP_TAC(SPECL + [`f:real->complex`;`gam:real`;`P:(int#int#int)->bool`] th) + else NO_TAC) THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC CARLESON_RESIDUAL_ENERGY THEN ASM_REWRITE_TAC[]]);; + + +(* ========================================================================= *) +(* 286M with both budget hypotheses DISCHARGED (via CARLESON_286J mass + *) +(* CARLESON_286K energy). For f in L^2 with ||f||_2 <= 1, E measurable with *) +(* muE <= 1, and any measurable g:R->R, the linearized tile-operator sum is *) +(* bounded by an ABSOLUTE constant C = C8 (C5 + C6). This is the *) +(* unconditional *) +(* form 286N applies to the normalized "tilde" functions. (h is free, *) +(* matching *) +(* CARLESON_286M / carleson_mass_budget.) *) +(* ========================================================================= *) +let CARLESON_286M_CONCRETE = prove + (`?C. &0 <= C /\ + !(f:real->complex) E h P. + (\z. f(drop z)) IN lspace (:real^1) (&2) /\ + lnorm (:real^1) (&2) (\z. f(drop z)) <= &1 /\ + real_lebesgue_measurable E /\ real_measurable E /\ + real_measure E <= &1 /\ + h real_measurable_on (:real) /\ FINITE P /\ + (!t. cw_tile t real_integrable_on {x | x IN E /\ h x IN tile_J t}) + ==> sum P (\s. norm(carleson_ip f s * + integral (IMAGE lift {x | x IN E /\ h x IN tile_Jr s}) + (\z. phi_sigma s carleson_phi (drop z)))) + <= C`, + X_CHOOSE_THEN `C8:real` STRIP_ASSUME_TAC CARLESON_286M THEN + X_CHOOSE_THEN `C5:real` STRIP_ASSUME_TAC CARLESON_286J THEN + X_CHOOSE_THEN `C6:real` STRIP_ASSUME_TAC CARLESON_286K THEN + EXISTS_TAC `C8 * (C5 + C6):real` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o check(fun th -> + can (find_term (fun t -> t = `C8:real`)) (concl th))) THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o check(fun th -> + can (find_term (fun t -> t = `carleson_mass_budget`)) (concl th))) THEN + ASM_REWRITE_TAC[]; + FIRST_X_ASSUM(MATCH_MP_TAC o check(fun th -> + can (find_term (fun t -> t = `carleson_energy_budget`)) (concl th))) THEN + ASM_REWRITE_TAC[]]);; + + +(* ========================================================================= *) +(* 286N (Fremlin mt286.tex 1871-1937), finite-P form. For each measurable g *) +(* and measurable FF, and each f in L^2 with ||f||_2 <= 1 and 0 < muFF, the *) +(* linearized tile-operator sum is <= C9 sqrt(muFF), C9 = C sqrt2 (C the *) +(* 286M *) +(* constant at the dilated frequency map). [C9 quantified after g,FF -- the *) +(* 286M constant carries a free h, so its h-uniformity is not exposed; this *) +(* form is sufficient for 286O, which fixes g,FF per application.] *) +(* Method: pick k with muFF <= 2^k <= 2 muFF (POW2_BRACKET); *) +(* CARLESON_SUM_DILATE *) +(* + TILE_STAR_SUM_REINDEX give the sum = sqrt(2^k) sum_{star P}(tilde *) +(* summand); *) +(* CARLESON_286M_CONCRETE at h := gtilde(x)=2^k g(2^k x), FFtilde the 2^-k *) +(* dilate *) +(* (muFFtilde <= 1 via DILATE_PREIMAGE_MEASURE, ||ftilde||=||f|| via *) +(* LNORM_DILATE_ *) +(* EQ) bounds it by C; sqrt(2^k) <= sqrt(2 muFF). *) +(* ========================================================================= *) +let CARLESON_286N = prove + (`?C9. &0 <= C9 /\ + !(g:real->real) FF (f:real->complex) P. + (\z. f(drop z)) IN lspace (:real^1) (&2) /\ + lnorm (:real^1) (&2) (\z. f(drop z)) <= &1 /\ + g real_measurable_on (:real) /\ real_measurable FF /\ + &0 < real_measure FF /\ FINITE P /\ + (!t. cw_tile t real_integrable_on {x | x IN FF /\ g x IN tile_J t}) + ==> sum P (\s. norm(carleson_ip f s * + integral (IMAGE lift {x | x IN FF /\ g x IN tile_Jr s}) + (\z. phi_sigma s carleson_phi (drop z)))) + <= C9 * sqrt(real_measure FF)`, + X_CHOOSE_THEN `C:real` STRIP_ASSUME_TAC CARLESON_286M_CONCRETE THEN + EXISTS_TAC `C * sqrt(&2)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC SQRT_POS_LE THEN REAL_ARITH_TAC; ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`g:real->real`; `FF:real->bool`] THEN + MP_TAC(ISPEC `real_measure FF` POW2_BRACKET) THEN + ASM_CASES_TAC `&0 < real_measure FF` THENL + [ALL_TAC; + REPEAT STRIP_TAC THEN ASM_MESON_TAC[]] THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `k:int` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `&0 < &2 zpow k` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + REPEAT STRIP_TAC THEN + (* per-term dilation + side-condition *) + MP_TAC(ISPECL [`f:real->complex`; `FF:real->bool`; `g:real->real`; `k:int`; + `P:(int#int#int)->bool`] CARLESON_SUM_DILATE) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN + X_GEN_TAC `s:int#int#int` THEN DISCH_TAC THEN + SUBGOAL_THEN + `{x | &2 zpow k * x IN FF /\ + &2 zpow k * g (&2 zpow k * x) IN tile_Jr (FST s + k,SND s)} = + {x | &2 zpow k * x IN FF} INTER + {x | (\y. &2 zpow k * g(&2 zpow k * y)) x IN tile_Jr (FST s + k,SND s)}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LEBESGUE_MEASURABLE_INTER THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_MEASURABLE_IMP_REAL_LEBESGUE_MEASURABLE THEN + MP_TAC(ISPECL [`FF:real->bool`; + `&2 zpow k`] DILATE_PREIMAGE_MEASURE) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; SIMP_TAC[]]; + SUBGOAL_THEN `(FST s + k, SND s):int#int#int = + (FST s + k, FST(SND s), SND(SND s))` SUBST1_TAC THENL + [REWRITE_TAC[PAIR]; ALL_TAC] THEN + REWRITE_TAC[tile_Jr] THEN BETA_TAC THEN + MATCH_MP_TAC H_PREIMAGE_DYHO_LEBESGUE THEN + MATCH_MP_TAC REAL_MEASURABLE_ON_DILATE_MUL THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN + (* reindex the star-sum *) + SUBGOAL_THEN + `sum P (\s. norm(carleson_ip (\x. Cx (sqrt (&2 zpow k)) * f (&2 zpow k * x)) + (FST s + k,FST (SND s),SND (SND s)) * + integral (IMAGE lift + {x | &2 zpow k * x IN FF /\ &2 zpow k * g (&2 zpow k * x) IN tile_Jr + (FST s + k,FST (SND s),SND (SND s))}) + (\z. phi_sigma (FST s + k,FST (SND s),SND (SND s)) carleson_phi (drop + z)))) = + sum (IMAGE (\u:int#int#int. FST u + k,FST (SND u),SND (SND u)) P) + (\u. norm(carleson_ip (\x. Cx (sqrt (&2 zpow k)) * f (&2 zpow k * x)) u * + integral (IMAGE lift + {x | &2 zpow k * x IN FF /\ &2 zpow k * g (&2 zpow k * x) IN tile_Jr + u}) + (\z. phi_sigma u carleson_phi (drop z))))` + SUBST1_TAC THENL + [REWRITE_TAC[TILE_STAR_SUM_REINDEX]; ALL_TAC] THEN + (* bound sqrt(2^k) sum <= sqrt(2^k) C <= (C sqrt2) sqrt(muFF) *) + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sqrt(&2 zpow k) * C` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC SQRT_POS_LE THEN MATCH_MP_TAC REAL_ZPOW_LE THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + (* sum_{star P}(tilde summand) <= C via CARLESON_286M_CONCRETE (h = *) + (* gtilde) *) + SUBGOAL_THEN + `!u:int#int#int. {x | &2 zpow k * x IN FF /\ &2 zpow k * g (&2 zpow k * x) + IN tile_Jr u} = + {x | x IN {y | &2 zpow k * y IN FF} /\ &2 zpow k * g (&2 zpow k * x) + IN tile_Jr u}` + (LABEL_TAC "RE") THENL + [GEN_TAC THEN REWRITE_TAC[EXTENSION] THEN X_GEN_TAC `x:real` THEN + REWRITE_TAC[IN_ELIM_THM]; ALL_TAC] THEN + USE_THEN "RE" (fun th -> ONCE_REWRITE_TAC[th]) THEN + FIRST_ASSUM(fun th -> if is_forall(concl th) && + can (find_term (fun t->t=`carleson_ip`))(concl th) + then MATCH_MP_TAC (BETA_RULE th) else NO_TAC) THEN + REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [(* ftilde in L^2 *) + SUBGOAL_THEN `(\z. Cx (sqrt (&2 zpow k)) * f (&2 zpow k * drop z)) = + (\z. Cx(sqrt(&2 zpow k)) * (\w. f(drop w))(&2 zpow k % z))` + SUBST1_TAC THENL + [MP_TAC(ISPECL [`f:real->complex`; `&2 zpow k`] FTILDE_DROP_EQ) THEN + ASM_REWRITE_TAC[] THEN SIMP_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC L2_DILATE_LSPACE THEN ASM_REWRITE_TAC[]; + (* ||ftilde|| <= 1 *) + SUBGOAL_THEN `(\z. Cx (sqrt (&2 zpow k)) * f (&2 zpow k * drop z)) = + (\z. Cx(sqrt(&2 zpow k)) * (\w. f(drop w))(&2 zpow k % z))` + SUBST1_TAC THENL + [MP_TAC(ISPECL [`f:real->complex`; `&2 zpow k`] FTILDE_DROP_EQ) THEN + ASM_REWRITE_TAC[] THEN SIMP_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL [`\w. (f:real->complex)(drop w)`; + `&2 zpow k`] LNORM_DILATE_EQ) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[]; + (* FFtilde lebesgue-measurable *) + MATCH_MP_TAC REAL_MEASURABLE_IMP_REAL_LEBESGUE_MEASURABLE THEN + MP_TAC(ISPECL [`FF:real->bool`; + `&2 zpow k`] DILATE_PREIMAGE_MEASURE) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; DISCH_THEN(ACCEPT_TAC o CONJUNCT1)]; + (* FFtilde measurable *) + MP_TAC(ISPECL [`FF:real->bool`; + `&2 zpow k`] DILATE_PREIMAGE_MEASURE) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; DISCH_THEN(ACCEPT_TAC o CONJUNCT1)]; + (* muFFtilde <= 1 *) + MP_TAC(ISPECL [`FF:real->bool`; + `&2 zpow k`] DILATE_PREIMAGE_MEASURE) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + DISCH_THEN(fun th -> REWRITE_TAC[CONJUNCT2 th]) THEN + MATCH_MP_TAC REAL_LE_LCANCEL_IMP THEN EXISTS_TAC `&2 zpow k` THEN + ASM_REWRITE_TAC[REAL_MUL_ASSOC] THEN + SUBGOAL_THEN `&2 zpow k * inv(&2 zpow k) = &1` SUBST1_TAC THENL + [MATCH_MP_TAC REAL_MUL_RINV THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[REAL_MUL_LID; REAL_MUL_RID]; + (* gtilde measurable *) + MATCH_MP_TAC REAL_MEASURABLE_ON_DILATE_MUL THEN ASM_REWRITE_TAC[]; + (* FINITE (star P) *) + MATCH_MP_TAC FINITE_IMAGE THEN ASM_REWRITE_TAC[]; + (* integrability of cw_tile on tilde-regions *) + X_GEN_TAC `t:int#int#int` THEN + MATCH_MP_TAC CWTILE_INTEGRABLE_MEASURABLE THEN + MATCH_MP_TAC REAL_MEASURABLE_LEBMEAS_SUBSET THEN + EXISTS_TAC `{y | &2 zpow k * y IN FF}` THEN REPEAT CONJ_TAC THENL + [SUBGOAL_THEN + `{x | x IN {y | &2 zpow k * y IN FF} /\ &2 zpow k * g (&2 zpow k * x) + IN tile_J t} = + {y | &2 zpow k * y IN FF} INTER + {x | (\w. &2 zpow k * g(&2 zpow k * w)) x IN tile_J t}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LEBESGUE_MEASURABLE_INTER THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_MEASURABLE_IMP_REAL_LEBESGUE_MEASURABLE THEN + MP_TAC(ISPECL [`FF:real->bool`; + `&2 zpow k`] DILATE_PREIMAGE_MEASURE) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[]; DISCH_THEN(ACCEPT_TAC o CONJUNCT1)]; + SUBGOAL_THEN + `t:int#int#int = (FST t, FST(SND t), SND(SND t))` SUBST1_TAC THENL + [REWRITE_TAC[PAIR]; ALL_TAC] THEN + REWRITE_TAC[tile_J] THEN BETA_TAC THEN + MATCH_MP_TAC H_PREIMAGE_DYHO_LEBESGUE THEN + MATCH_MP_TAC REAL_MEASURABLE_ON_DILATE_MUL THEN ASM_REWRITE_TAC[]]; + MP_TAC(ISPECL [`FF:real->bool`; + `&2 zpow k`] DILATE_PREIMAGE_MEASURE) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; DISCH_THEN(ACCEPT_TAC o CONJUNCT1)]; + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN MESON_TAC[]]]; + (* final arithmetic sqrt(2^k) C <= (C sqrt2) sqrt(muFF) *) + SUBGOAL_THEN `(C * sqrt(&2)) * sqrt(real_measure FF) = + (sqrt(&2) * sqrt(real_measure FF)) * C` SUBST1_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[GSYM SQRT_MUL] THEN + MP_TAC(ISPECL [`&2 zpow k`; `&2 * real_measure FF`] SQRT_MONO_LE) THEN + ASM_REWRITE_TAC[]]);; + + +(* ========================================================================= *) +(* Fremlin 246K (factor-4 sign trick) -- toward the deep 286P tile bound. *) +(* ========================================================================= *) + +(* ========================================================================= *) +(* Fremlin 246K (factor-4 sign trick), toward 286P. For w abs-integrable on *) +(* measurable E, there is measurable F' SUBSET E with int_E|w| <= 4|int_F' *) +(* w|. *) +(* ========================================================================= *) + +(* Subregion {x IN E | c <= (w x)$k} is measurable (w abs-int on meas E, *) +(* 1<=k<=2). *) + + +(* ========================================================================= *) +(* Fremlin 246K (factor-4 sign trick) -- toward the deep 286P tile bound. *) +(* ========================================================================= *) + +(* ========================================================================= *) +(* Fremlin 246K (factor-4 sign trick), toward 286P. For w abs-integrable on *) +(* measurable E, there is measurable F' SUBSET E with int_E|w| <= 4|int_F' *) +(* w|. *) +(* ========================================================================= *) + +(* Subregion {x IN E | c <= (w x)$k} is measurable (w abs-int on meas E, *) +(* 1<=k<=2). *) +let K246_SUBREGION_GE = prove + (`!(w:real^1->complex) E c k. + w absolutely_integrable_on E /\ measurable E /\ 1 <= k /\ k <= 2 + ==> measurable {x:real^1 | x IN E /\ c <= (w x)$k}`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_LEBESGUE_MEASURABLE_SUBSET THEN + EXISTS_TAC `E:real^1->bool` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [ALL_TAC; SET_TAC[]] THEN + SUBGOAL_THEN `{x:real^1 | x IN E /\ c <= (w x)$k} = + {x | (\y. if y IN E then (w:real^1->complex) y else vec 0) x $ k >= c} + INTER E` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM; real_ge] THEN + GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + CONV_TAC TAUT; ALL_TAC] THEN + MATCH_MP_TAC LEBESGUE_MEASURABLE_INTER THEN CONJ_TAC THENL + [SUBGOAL_THEN + `(\x:real^1. if x IN E then (w:real^1->complex) x else vec 0) + measurable_on (:real^1)` MP_TAC THENL + [ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN + REWRITE_TAC[MEASURABLE_ON_UNIV] THEN + MATCH_MP_TAC INTEGRABLE_IMP_MEASURABLE THEN + REWRITE_TAC[INTEGRABLE_RESTRICT] THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GE] THEN + DISCH_THEN(MP_TAC o SPECL [`c:real`; `k:num`]) THEN + ASM_REWRITE_TAC[DIMINDEX_2]; + MATCH_MP_TAC MEASURABLE_IMP_LEBESGUE_MEASURABLE THEN ASM_REWRITE_TAC[]]);; + +(* Companion: subregion {x IN E | (w x)$k <= c} is measurable. *) +let K246_SUBREGION_LE = prove + (`!(w:real^1->complex) E c k. + w absolutely_integrable_on E /\ measurable E /\ 1 <= k /\ k <= 2 + ==> measurable {x:real^1 | x IN E /\ (w x)$k <= c}`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_LEBESGUE_MEASURABLE_SUBSET THEN + EXISTS_TAC `E:real^1->bool` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [ALL_TAC; SET_TAC[]] THEN + SUBGOAL_THEN `{x:real^1 | x IN E /\ (w x)$k <= c} = + {x | (\y. if y IN E then (w:real^1->complex) y else vec 0) x $ k <= c} + INTER E` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM] THEN + GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + CONV_TAC TAUT; ALL_TAC] THEN + MATCH_MP_TAC LEBESGUE_MEASURABLE_INTER THEN CONJ_TAC THENL + [SUBGOAL_THEN + `(\x:real^1. if x IN E then (w:real^1->complex) x else vec 0) + measurable_on (:real^1)` MP_TAC THENL + [ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN + REWRITE_TAC[MEASURABLE_ON_UNIV] THEN + MATCH_MP_TAC INTEGRABLE_IMP_MEASURABLE THEN + REWRITE_TAC[INTEGRABLE_RESTRICT] THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_LE] THEN + DISCH_THEN(MP_TAC o SPECL [`c:real`; `k:num`]) THEN + ASM_REWRITE_TAC[DIMINDEX_2]; + MATCH_MP_TAC MEASURABLE_IMP_LEBESGUE_MEASURABLE THEN ASM_REWRITE_TAC[]]);; + +(* Positive-part component identity: (int_{SP} w)$k = int_E max((w x)$k, 0), *) +(* SP={(w x)$k>=0}. *) +let K246_SP_COMPONENT = prove + (`!(w:real^1->complex) E k. + w absolutely_integrable_on E /\ measurable E /\ 1 <= k /\ k <= 2 + ==> (integral {x | x IN E /\ &0 <= (w x)$k} w)$k = + drop(integral E (\x. lift(max ((w x)$k) (&0))))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(w:real^1->complex) absolutely_integrable_on {x | x IN E /\ &0 <= (w + x)$k}` ASSUME_TAC THENL + [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN + EXISTS_TAC `E:real^1->bool` THEN REPEAT CONJ_TAC THENL + [FIRST_ASSUM ACCEPT_TAC; + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN GEN_TAC THEN STRIP_TAC THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC MEASURABLE_IMP_LEBESGUE_MEASURABLE THEN + MP_TAC(ISPECL [`w:real^1->complex`; `E:real^1->bool`; `&0:real`; + `k:num`] K246_SUBREGION_GE) THEN + ASM_REWRITE_TAC[]]; ALL_TAC] THEN + ASM_SIMP_TAC[INTEGRAL_COMPONENT; ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN + AP_TERM_TAC THEN + SUBGOAL_THEN + `integral E (\x:real^1. lift(max ((w x)$k) (&0))) = + integral E (\x. if x IN {x | x IN E /\ &0 <= (w x)$k} then + lift((w:real^1->complex) x$k) else vec 0)` + SUBST1_TAC THENL + [MATCH_MP_TAC INTEGRAL_EQ THEN X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN + REWRITE_TAC[IN_ELIM_THM] THEN ASM_REWRITE_TAC[] THEN COND_CASES_TAC THENL + [AP_TERM_TAC THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; + REWRITE_TAC[GSYM LIFT_NUM] THEN AP_TERM_TAC THEN POP_ASSUM MP_TAC THEN + REAL_ARITH_TAC]; ALL_TAC] THEN + REWRITE_TAC[INTEGRAL_RESTRICT_INTER] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM] THEN GEN_TAC THEN + CONV_TAC TAUT);; + +(* Negative-part companion: -(int_{SN} w)$k = int_E max(-(w x)$k, 0), SN={(w *) +(* x)$k<=0}. *) +let K246_SN_COMPONENT = prove + (`!(w:real^1->complex) E k. + w absolutely_integrable_on E /\ measurable E /\ 1 <= k /\ k <= 2 + ==> --((integral {x | x IN E /\ (w x)$k <= &0} w)$k) = + drop(integral E (\x. lift(max (--((w x)$k)) (&0))))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\x. --((w:real^1->complex) x)`; `E:real^1->bool`; + `k:num`] K246_SP_COMPONENT) THEN + ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_NEG; VECTOR_NEG_COMPONENT] THEN + REWRITE_TAC[REAL_ARITH `&0 <= --u <=> u <= &0`] THEN + SUBGOAL_THEN + `integral {x | x IN E /\ (w x)$k <= &0} (\x. --((w:real^1->complex) x)) = + --(integral {x | x IN E /\ (w x)$k <= &0} w)` + SUBST1_TAC THENL + [MATCH_MP_TAC INTEGRAL_NEG THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN + EXISTS_TAC `E:real^1->bool` THEN REPEAT CONJ_TAC THENL + [FIRST_ASSUM ACCEPT_TAC; + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN GEN_TAC THEN STRIP_TAC THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC MEASURABLE_IMP_LEBESGUE_MEASURABLE THEN + MP_TAC(ISPECL [`w:real^1->complex`; `E:real^1->bool`; `&0:real`; + `k:num`] K246_SUBREGION_LE) THEN + ASM_REWRITE_TAC[]]; ALL_TAC] THEN + REWRITE_TAC[VECTOR_NEG_COMPONENT]);; + +(* lift of a component of an abs-integrable complex fn is abs-integrable *) +(* (clean, no free :N). *) +let K246_LIFT_COMPONENT_ABSINT = prove + (`!(w:real^1->complex) E k. + w absolutely_integrable_on E /\ 1 <= k /\ k <= 2 + ==> (\x:real^1. lift((w x)$k)) absolutely_integrable_on E`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(INST_TYPE [`:2`,`:N`] ABSOLUTELY_INTEGRABLE_LIFT_COMPONENT) THEN + ASM_REWRITE_TAC[DIMINDEX_2]);; + +(* abs = pos-part + neg-part, as an integral identity. *) +let K246_ABS_SPLIT = prove + (`!(w:real^1->complex) E k. + w absolutely_integrable_on E /\ measurable E /\ 1 <= k /\ k <= 2 + ==> integral E (\x. lift(abs((w x)$k))) = + integral E (\x. lift(max ((w x)$k) (&0))) + integral E (\x. lift(max + (--((w x)$k)) (&0)))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\x:real^1. lift(((w:real^1->complex) x)$k)) absolutely_integrable_on E` + ASSUME_TAC THENL + [MATCH_MP_TAC K246_LIFT_COMPONENT_ABSINT THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `(\x:real^1. lift(&0)) absolutely_integrable_on E` ASSUME_TAC THENL + [REWRITE_TAC[LIFT_NUM; ABSOLUTELY_INTEGRABLE_0]; ALL_TAC] THEN + SUBGOAL_THEN + `(\x:real^1. lift(--(((w:real^1->complex) x)$k))) absolutely_integrable_on + E` ASSUME_TAC THENL + [REWRITE_TAC[LIFT_NEG] THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NEG THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `(\x:real^1. lift(max (((w:real^1->complex) x)$k) (&0))) + absolutely_integrable_on E` ASSUME_TAC THENL + [MP_TAC(ISPECL [`\x:real^1. ((w:real^1->complex) x)$k`; `\x:real^1. &0`; + `E:real^1->bool`] + ABSOLUTELY_INTEGRABLE_MAX_1) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `(\x:real^1. lift(max (--(((w:real^1->complex) x)$k)) (&0))) + absolutely_integrable_on E` ASSUME_TAC THENL + [MP_TAC(ISPECL [`\x:real^1. --(((w:real^1->complex) x)$k)`; `\x:real^1. &0`; + `E:real^1->bool`] + ABSOLUTELY_INTEGRABLE_MAX_1) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL [`\x:real^1. lift(max (((w:real^1->complex) x)$k) (&0))`; + `\x:real^1. lift(max (--(((w:real^1->complex) x)$k)) (&0))`; + `E:real^1->bool`] + INTEGRAL_ADD) THEN + ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[] THEN + MATCH_MP_TAC INTEGRAL_EQ THEN X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN + REWRITE_TAC[GSYM LIFT_ADD] THEN AP_TERM_TAC THEN REAL_ARITH_TAC);; + +(* per-component bound: int_E |w$k| <= norm(int_{SP} w) + norm(int_{SN} w). *) +let K246_COMPONENT_BOUND = prove + (`!(w:real^1->complex) E k. + w absolutely_integrable_on E /\ measurable E /\ 1 <= k /\ k <= 2 + ==> drop(integral E (\x. lift(abs((w x)$k)))) + <= norm(integral {x | x IN E /\ &0 <= (w x)$k} w) + + norm(integral {x | x IN E /\ (w x)$k <= &0} w)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`w:real^1->complex`; `E:real^1->bool`; + `k:num`] K246_ABS_SPLIT) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[DROP_ADD] THEN + MP_TAC(ISPECL [`w:real^1->complex`; `E:real^1->bool`; + `k:num`] K246_SP_COMPONENT) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + MP_TAC(ISPECL [`w:real^1->complex`; `E:real^1->bool`; + `k:num`] K246_SN_COMPONENT) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THENL + [MATCH_MP_TAC(REAL_ARITH `abs a <= b ==> a <= b`) THEN + MATCH_ACCEPT_TAC COMPONENT_LE_NORM; + MATCH_MP_TAC(REAL_ARITH `abs a <= b ==> --a <= b`) THEN + MATCH_ACCEPT_TAC COMPONENT_LE_NORM]);; + +(* norm bounded by sum of |components|, integrated. *) +let K246_NORM_COMPONENTS = prove + (`!(w:real^1->complex) E. + w absolutely_integrable_on E /\ measurable E + ==> drop(integral E (\x. lift(norm(w x)))) + <= drop(integral E (\x. lift(abs((w x)$1)))) + drop(integral E (\x. + lift(abs((w x)$2))))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\x:real^1. lift(norm((w:real^1->complex) x))) absolutely_integrable_on E` + ASSUME_TAC THENL + [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `(\x:real^1. lift(abs(((w:real^1->complex) x)$1))) absolutely_integrable_on + E` ASSUME_TAC THENL + [SUBGOAL_THEN `(\x:real^1. lift(abs(((w:real^1->complex) x)$1))) = + (\x. lift(norm(lift(((w:real^1->complex) x)$1))))` SUBST1_TAC + THENL + [REWRITE_TAC[FUN_EQ_THM; NORM_LIFT]; ALL_TAC] THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN + MATCH_MP_TAC K246_LIFT_COMPONENT_ABSINT THEN + ASM_REWRITE_TAC[ARITH]; ALL_TAC] THEN + SUBGOAL_THEN + `(\x:real^1. lift(abs(((w:real^1->complex) x)$2))) absolutely_integrable_on + E` ASSUME_TAC THENL + [SUBGOAL_THEN `(\x:real^1. lift(abs(((w:real^1->complex) x)$2))) = + (\x. lift(norm(lift(((w:real^1->complex) x)$2))))` SUBST1_TAC + THENL + [REWRITE_TAC[FUN_EQ_THM; NORM_LIFT]; ALL_TAC] THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN + MATCH_MP_TAC K246_LIFT_COMPONENT_ABSINT THEN + ASM_REWRITE_TAC[ARITH]; ALL_TAC] THEN + REWRITE_TAC[GSYM DROP_ADD] THEN + MP_TAC(ISPECL [`\x:real^1. lift(abs(((w:real^1->complex) x)$1))`; + `\x:real^1. lift(abs(((w:real^1->complex) x)$2))`; + `E:real^1->bool`] INTEGRAL_ADD) THEN + ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC INTEGRAL_DROP_LE THEN + ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE] THEN CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_ADD THEN + ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE]; ALL_TAC] THEN + X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN + REWRITE_TAC[LIFT_DROP; DROP_ADD] THEN + MP_TAC(ISPEC `(w:real^1->complex) x` COMPLEX_NORM_LE_RE_IM) THEN + REWRITE_TAC[RE_DEF; IM_DEF] THEN REAL_ARITH_TAC);; + +(* 246K (factor-4 sign trick): for w abs-int on measurable E, there is a *) +(* measurable *) +(* F' SUBSET E with int_E |w| <= 4 |int_F' w|. Pick F' = argmax over the 4 *) +(* subregions *) +(* {Re>=0},{Re<=0},{Im>=0},{Im<=0} of |int_subregion w|. *) +let K246_SIGN_TRICK = prove + (`!(w:real^1->complex) E. + w absolutely_integrable_on E /\ measurable E + ==> ?F'. measurable F' /\ F' SUBSET E /\ + drop(integral E (\x. lift(norm(w x)))) <= &4 * norm(integral F' + w)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `drop(integral E (\x. lift(norm((w:real^1->complex) x)))) <= + (norm(integral {x | x IN E /\ &0 <= (w x)$1} w) + norm(integral {x | x IN E + /\ (w x)$1 <= &0} w)) + + (norm(integral {x | x IN E /\ &0 <= (w x)$2} w) + norm(integral {x | x IN E + /\ (w x)$2 <= &0} w))` + ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `drop(integral E (\x. lift(abs(((w:real^1->complex) x)$1)))) + + drop(integral E (\x. lift(abs(((w:real^1->complex) x)$2))))` + THEN + CONJ_TAC THENL + [MATCH_MP_TAC K246_NORM_COMPONENTS THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THEN + MATCH_MP_TAC K246_COMPONENT_BOUND THEN + ASM_REWRITE_TAC[ARITH]]; ALL_TAC] THEN + SUBGOAL_THEN + `measurable {x:real^1 | x IN E /\ &0 <= ((w:real^1->complex) x)$1} /\ + measurable {x:real^1 | x IN E /\ ((w:real^1->complex) x)$1 <= &0} /\ + measurable {x:real^1 | x IN E /\ &0 <= ((w:real^1->complex) x)$2} /\ + measurable {x:real^1 | x IN E /\ ((w:real^1->complex) x)$2 <= &0}` + STRIP_ASSUME_TAC THENL + [REPEAT CONJ_TAC THENL + [MP_TAC(ISPECL [`w:real^1->complex`; `E:real^1->bool`; `&0:real`; + `1`] K246_SUBREGION_GE); + MP_TAC(ISPECL [`w:real^1->complex`; `E:real^1->bool`; `&0:real`; + `1`] K246_SUBREGION_LE); + MP_TAC(ISPECL [`w:real^1->complex`; `E:real^1->bool`; `&0:real`; + `2`] K246_SUBREGION_GE); + MP_TAC(ISPECL [`w:real^1->complex`; `E:real^1->bool`; `&0:real`; + `2`] K246_SUBREGION_LE)] THEN + ASM_REWRITE_TAC[ARITH]; ALL_TAC] THEN + MP_TAC(REAL_ARITH + `!n1 n2 n3 n4 s:real. + s <= (n1 + n2) + (n3 + n4) + ==> s <= &4 * n1 \/ s <= &4 * n2 \/ s <= &4 * n3 \/ s <= &4 * n4`) THEN + DISCH_THEN(MP_TAC o ISPECL + [`norm(integral {x | x IN E /\ &0 <= ((w:real^1->complex) x)$1} w)`; + `norm(integral {x | x IN E /\ ((w:real^1->complex) x)$1 <= &0} w)`; + `norm(integral {x | x IN E /\ &0 <= ((w:real^1->complex) x)$2} w)`; + `norm(integral {x | x IN E /\ ((w:real^1->complex) x)$2 <= &0} w)`; + `drop(integral E (\x. lift(norm((w:real^1->complex) x))))`]) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THENL + [EXISTS_TAC `{x:real^1 | x IN E /\ &0 <= ((w:real^1->complex) x)$1}`; + EXISTS_TAC `{x:real^1 | x IN E /\ ((w:real^1->complex) x)$1 <= &0}`; + EXISTS_TAC `{x:real^1 | x IN E /\ &0 <= ((w:real^1->complex) x)$2}`; + EXISTS_TAC `{x:real^1 | x IN E /\ ((w:real^1->complex) x)$2 <= &0}`] THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN + GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[]);; + + +(* ========================================================================= *) +(* 286O(a) (Fremlin mt286.tex 1939-2005): the frequency bump theta_z. For a *) +(* tile s with z in the right half J^r_s and y in the left half J^l_s, the *) +(* value is phi-hat(2^{-k_s}(y - y^l_s))^2 (y^l_s = tile_ymid s, the lower *) +(* quartile); zero if no such tile. The qualifying tiles at distinct scales *) +(* have disjoint left-halves so at most one term is nonzero, and the sup *) +(* below *) +(* equals Fremlin's sum. Elementary properties: 0 <= theta_z(y) <= 1, and *) +(* theta_z(y) = 0 for y >= z. *) +(* ========================================================================= *) +let carleson_theta = new_definition + `carleson_theta z y = + sup ({ Re(fourier carleson_phi (&2 zpow (--(tile_k s)) * (y - tile_ymid + s))) pow 2 + | s | z IN tile_Jr s /\ y IN tile_Jl s } UNION {&0})`;; + +(* Re(fourier carleson_phi) takes values in [0,1] (the 286Eb bump). *) +let CARLESON_PHI_RE_BOUNDS = prove + (`!t. &0 <= Re(fourier carleson_phi t) /\ Re(fourier carleson_phi t) <= &1`, + GEN_TAC THEN MP_TAC carleson_phi THEN STRIP_TAC THEN CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `t:real` o + check(fun th -> can (find_term (fun tm -> tm = `&1 / &6`)) (concl th))) + THEN + COND_CASES_TAC THEN REAL_ARITH_TAC; + FIRST_X_ASSUM(MP_TAC o SPEC `t:real` o + check(fun th -> can (find_term (fun tm -> tm = `&1 / &5`)) (concl th))) + THEN + COND_CASES_TAC THEN REAL_ARITH_TAC]);; + +let CARLESON_THETA_TERM_BOUNDS = prove + (`!t. &0 <= Re(fourier carleson_phi t) pow 2 /\ + Re(fourier carleson_phi t) pow 2 <= &1`, + GEN_TAC THEN REWRITE_TAC[REAL_LE_POW_2] THEN MATCH_MP_TAC REAL_POW_1_LE THEN + REWRITE_TAC[CARLESON_PHI_RE_BOUNDS]);; + +(* 286Oa: 0 <= theta_z(y) <= 1. *) +let CARLESON_THETA_BOUNDS = prove + (`!z y. &0 <= carleson_theta z y /\ carleson_theta z y <= &1`, + REPEAT GEN_TAC THEN REWRITE_TAC[carleson_theta] THEN + SUBGOAL_THEN + `!x. x IN ({ Re(fourier carleson_phi (&2 zpow (--(tile_k s)) * (y - + tile_ymid s))) pow 2 + | s | z IN tile_Jr s /\ y IN tile_Jl s } UNION {&0}) + ==> &0 <= x /\ x <= &1` + ASSUME_TAC THENL + [REWRITE_TAC[IN_UNION; IN_SING; IN_ELIM_THM] THEN + X_GEN_TAC `w:real` THEN STRIP_TAC THENL + [ASM_MESON_TAC[CARLESON_THETA_TERM_BOUNDS]; ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_SUP THEN MAP_EVERY EXISTS_TAC [`&1`; `&0`] THEN + REWRITE_TAC[IN_UNION; IN_SING; REAL_LE_REFL] THEN + X_GEN_TAC `w:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `w:real`) THEN + ASM_REWRITE_TAC[IN_UNION; IN_SING] THEN REAL_ARITH_TAC; + MATCH_MP_TAC REAL_SUP_LE THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `&0` THEN + REWRITE_TAC[IN_UNION; IN_SING]; + X_GEN_TAC `w:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `w:real`) THEN ASM_REWRITE_TAC[] THEN + REAL_ARITH_TAC]]);; + +(* 286Oa: theta_z(y) = 0 for y >= z (left half is strictly below the right *) +(* half). *) +let CARLESON_THETA_SUPPORT = prove + (`!z y. z <= y ==> carleson_theta z y = &0`, + REPEAT STRIP_TAC THEN REWRITE_TAC[carleson_theta] THEN + SUBGOAL_THEN + `{ Re(fourier carleson_phi (&2 zpow (--(tile_k s)) * (y - tile_ymid s))) pow + 2 + | s | z IN tile_Jr s /\ y IN tile_Jl s } = {}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN + X_GEN_TAC `w:real` THEN REWRITE_TAC[NOT_EXISTS_THM] THEN + X_GEN_TAC `s:int#int#int` THEN STRIP_TAC THEN + SUBGOAL_THEN `y:real < z` MP_TAC THENL + [MATCH_MP_TAC TILE_JL_LT_JR THEN ASM_MESON_TAC[]; ASM_REAL_ARITH_TAC]; + REWRITE_TAC[UNION_EMPTY; SUP_SING]]);; + +(* ------------------------------------------------------------------------- *) +(* R2 foundation (Fremlin 286O-a-i): the theta_z sup is achieved by a SINGLE *) +(* scale. Any two tiles s,t both witnessing (z in Jr, y in Jl) must share *) +(* the scale k (TILE_JL_DISJOINT: different scales with overlapping right- *) +(* halves have disjoint left-halves, but z is in both Jr and y in both Jl) *) +(* and, at a fixed scale, share nJ (DYHO_DISJOINT_SAMESCALE on the *) +(* right-half *) +(* dyadic cells). Hence all contributing tiles have the same tile_k and *) +(* tile_ymid, so the same psi-value, and the sup collapses to that value. *) +(* This is the HOL form of "theta_z = sum_{k in M} psi_k" (the psi_k being *) +(* disjoint-supported, only one contributes at each y). *) +(* ------------------------------------------------------------------------- *) + +(* Two witnessing tiles share the scale k. *) +let CARLESON_THETA_SINGLE_SCALE = prove + (`!(s:int#int#int) (t:int#int#int) z y. + z IN tile_Jr s /\ y IN tile_Jl s /\ z IN tile_Jr t /\ y IN tile_Jl t + ==> tile_k s = tile_k t`, + REWRITE_TAC[FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC + [`ks:int`;`nIs:int`;`nJs:int`;`kt:int`;`nIt:int`;`nJt:int`;`z:real`; + `y:real`] THEN + REWRITE_TAC[tile_Jr; tile_Jl; tile_k] THEN STRIP_TAC THEN + ASM_CASES_TAC `ks:int = kt` THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`ks:int`;`kt:int`;`nJs:int`;`nJt:int`] TILE_JL_DISJOINT) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + EXISTS_TAC `z:real` THEN ASM_REWRITE_TAC[IN_INTER]; ALL_TAC] THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + EXISTS_TAC `y:real` THEN ASM_REWRITE_TAC[IN_INTER]);; + +(* Two right-halves at the same scale containing z share nJ. *) +let CARLESON_THETA_SINGLE_NJ = prove + (`!(k:int) (nIs:int) (nJs:int) (nIt:int) (nJt:int) z. + z IN tile_Jr (k,nIs,nJs) /\ z IN tile_Jr (k,nIt,nJt) ==> nJs = nJt`, + REPEAT GEN_TAC THEN REWRITE_TAC[tile_Jr] THEN STRIP_TAC THEN + MP_TAC(SPECL [`k - &1:int`; `&2 * nJs + &1:int`; `&2 * nJt + &1:int`] + DYHO_DISJOINT_SAMESCALE) THEN + ASM_CASES_TAC `&2 * nJs + &1:int = &2 * nJt + &1` THENL + [POP_ASSUM MP_TAC THEN INT_ARITH_TAC; + ASM_REWRITE_TAC[] THEN REWRITE_TAC[DISJOINT] THEN ASM SET_TAC[]]);; + +(* Two witnessing tiles share tile_k AND tile_ymid (hence the same *) +(* psi-value). *) +let CARLESON_THETA_TILE_EQ = prove + (`!(s:int#int#int) (t:int#int#int) z y. + z IN tile_Jr s /\ y IN tile_Jl s /\ z IN tile_Jr t /\ y IN tile_Jl t + ==> tile_k s = tile_k t /\ tile_ymid s = tile_ymid t`, + REWRITE_TAC[FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC + [`ks:int`;`nIs:int`;`nJs:int`;`kt:int`;`nIt:int`;`nJt:int`;`z:real`; + `y:real`] THEN + STRIP_TAC THEN + SUBGOAL_THEN `ks:int = kt` ASSUME_TAC THENL + [MP_TAC(ISPECL [`(ks,nIs,nJs):int#int#int`; `(kt,nIt,nJt):int#int#int`; + `z:real`; `y:real`] + CARLESON_THETA_SINGLE_SCALE) THEN ASM_REWRITE_TAC[tile_k]; ALL_TAC] THEN + SUBGOAL_THEN `nJs:int = nJt` ASSUME_TAC THENL + [MP_TAC(ISPECL [`kt:int`; `nIs:int`; `nJs:int`; `nIt:int`; `nJt:int`; + `z:real`] + CARLESON_THETA_SINGLE_NJ) THEN + ASM_REWRITE_TAC[tile_Jr] THEN DISCH_THEN MATCH_MP_TAC THEN + UNDISCH_TAC `z IN tile_Jr (ks,nIs,nJs)` THEN + ASM_REWRITE_TAC[tile_Jr]; ALL_TAC] THEN + ASM_REWRITE_TAC[tile_k; tile_ymid]);; + +(* theta_z(y) = the psi-value of ANY witnessing tile s0 (the sup collapses *) +(* to a *) +(* single term). psi-value = Re(phihat(2^{-k}(y - ymid)))^2. *) +let CARLESON_THETA_VALUE = prove + (`!(s0:int#int#int) z y. + z IN tile_Jr s0 /\ y IN tile_Jl s0 + ==> carleson_theta z y = + Re(fourier carleson_phi (&2 zpow (--(tile_k s0)) * (y - tile_ymid + s0))) pow 2`, + REPEAT STRIP_TAC THEN REWRITE_TAC[carleson_theta] THEN + MATCH_MP_TAC SUP_UNIQUE THEN X_GEN_TAC `c:real` THEN + REWRITE_TAC[IN_UNION; IN_SING; IN_ELIM_THM] THEN EQ_TAC THENL + [DISCH_THEN MATCH_MP_TAC THEN DISJ1_TAC THEN + EXISTS_TAC `s0:int#int#int` THEN ASM_REWRITE_TAC[]; + DISCH_TAC THEN X_GEN_TAC `x:real` THEN + DISCH_THEN(DISJ_CASES_THEN2 (X_CHOOSE_THEN + `s1:int#int#int` STRIP_ASSUME_TAC) ASSUME_TAC) THENL + [SUBGOAL_THEN `tile_k s1 = tile_k s0 /\ tile_ymid s1 = tile_ymid s0` + (fun th -> ASM_REWRITE_TAC[th]) THEN + MATCH_MP_TAC CARLESON_THETA_TILE_EQ THEN + MAP_EVERY EXISTS_TAC [`z:real`; `y:real`] THEN ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `Re(fourier carleson_phi (&2 zpow (--(tile_k s0)) * (y - + tile_ymid s0))) pow 2` THEN + ASM_REWRITE_TAC[REAL_LE_POW_2]]]);; + +(* Complement of CARLESON_THETA_VALUE: theta_z(y) = 0 when NO tile witnesses *) +(* (z in Jr_s, y in Jl_s). Together with CARLESON_THETA_VALUE this is the *) +(* full *) +(* dichotomy: theta_z(y) is either the (unique-scale) witnessing psi-value *) +(* or 0 -- *) +(* the pointwise "theta_z = sum_k psi_k with <=1 nonzero term" of Fremlin *) +(* 286O-a-i. *) +let carleson_psi = new_definition + `carleson_psi (z:real) (k:int) (y:real) = + if (?nJ:int. z IN tile_Jr(k,&0,nJ) /\ y IN tile_Jl(k,&0,nJ)) + then Re(fourier carleson_phi + (&2 zpow (--k) * + (y - tile_ymid(k, &0, (@nJ. z IN tile_Jr(k,&0,nJ) /\ y IN + tile_Jl(k,&0,nJ)))))) pow 2 + else &0`;; + +(* When a scale-k tile (k,nI,nJ) witnesses (z in Jr, y in Jl), carleson_psi *) +(* z k y equals theta_z y (both = that tile's psi-value; *) +(* CARLESON_THETA_VALUE + SINGLE_NJ pin the SELECT'd nJ, tile_ymid *) +(* nI-independent). *) +let CARLESON_PSI_THETA = prove + (`!(k:int) nI nJ z y. + z IN tile_Jr(k,nI,nJ) /\ y IN tile_Jl(k,nI,nJ) + ==> carleson_psi z k y = carleson_theta z y`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`(k,nI,nJ):int#int#int`; `z:real`; + `y:real`] CARLESON_THETA_VALUE) THEN + ASM_REWRITE_TAC[tile_k] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[carleson_psi] THEN + RULE_ASSUM_TAC(REWRITE_RULE[tile_Jr; tile_Jl]) THEN + SUBGOAL_THEN + `?nJ':int. z IN dyho(k - &1)(&2 * nJ' + &1) /\ y IN dyho(k - &1)(&2 * nJ')` + ASSUME_TAC THENL + [EXISTS_TAC `nJ:int` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[tile_Jr; tile_Jl] THEN + ABBREV_TAC `nJ0 = @nJ':int. z IN dyho(k - &1)(&2 * nJ' + &1) /\ y IN dyho(k - + &1)(&2 * nJ')` THEN + SUBGOAL_THEN + `z IN dyho(k - &1)(&2 * nJ0 + &1) /\ y IN dyho(k - &1)(&2 * nJ0)` + STRIP_ASSUME_TAC THENL + [EXPAND_TAC "nJ0" THEN CONV_TAC SELECT_CONV THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `nJ0:int = nJ` SUBST1_TAC THENL + [MP_TAC(ISPECL [`k:int`; `&0:int`; `nJ0:int`; `nI:int`; `nJ:int`; `z:real`] + CARLESON_THETA_SINGLE_NJ) THEN + REWRITE_TAC[tile_Jr] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[tile_ymid]);; + +(* carleson_psi z k y = 0 when scale k has no witnessing tile. *) +let CARLESON_PSI_ZERO = prove + (`!(k:int) z y. + (!nJ:int. ~(z IN tile_Jr(k,&0,nJ) /\ y IN tile_Jl(k,&0,nJ))) + ==> carleson_psi z k y = &0`, + REPEAT STRIP_TAC THEN REWRITE_TAC[carleson_psi] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + POP_ASSUM(X_CHOOSE_TAC `nJ:int`) THEN ASM_MESON_TAC[]);; + +(* R2c linchpin: the per-scale bumps carleson_psi z (.) y have DISJOINT *) +(* support *) +(* across scales -- at each y at most one scale k gives a nonzero value. If *) +(* two *) +(* scales k, k' both give nonzero psi, both have a witnessing tile (z in Jr, *) +(* y in *) +(* Jl), so CARLESON_THETA_SINGLE_SCALE forces k = k'. This makes the *) +(* scale-sum *) +(* sum_k carleson_psi z k y a "sum with <=1 nonzero term" (= theta_z y). *) +let CARLESON_PSI_DISJOINT = prove + (`!z y k k'. + ~(carleson_psi z k y = &0) /\ ~(carleson_psi z k' y = &0) ==> k = k'`, + REPEAT GEN_TAC THEN REWRITE_TAC[carleson_psi] THEN + REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN STRIP_TAC THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `nJ':int` STRIP_ASSUME_TAC o + check (fun th -> is_exists(concl th) && can (find_term (fun t -> t = + `k':int`)) (concl th))) THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `nJ:int` STRIP_ASSUME_TAC o + check (fun th -> is_exists(concl th))) THEN + MP_TAC(ISPECL [`(k,&0,nJ):int#int#int`; `(k',&0,nJ'):int#int#int`; `z:real`; + `y:real`] + CARLESON_THETA_SINGLE_SCALE) THEN + ASM_REWRITE_TAC[tile_k]);; + +(* R2c per-term dichotomy: each carleson_psi z k y is EITHER 0 OR the full *) +(* theta_z y. *) +(* (Nonzero => the if-guard's witnessing tile exists => CARLESON_PSI_THETA.) *) +(* With *) +(* CARLESON_PSI_DISJOINT (<=1 nonzero) this shows every finite partial sum *) +(* of the *) +(* carleson_psi z (.) y is either 0 or theta_z y, hence bounded by theta_z y *) +(* <= 1. *) +let CARLESON_PSI_CASES = prove + (`!z k y. carleson_psi z k y = &0 \/ carleson_psi z k y = carleson_theta z y`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `carleson_psi z k y = &0` THENL + [ASM_REWRITE_TAC[]; ALL_TAC] THEN + DISJ2_TAC THEN + FIRST_X_ASSUM MP_TAC THEN REWRITE_TAC[carleson_psi] THEN + COND_CASES_TAC THEN REWRITE_TAC[] THEN + POP_ASSUM(X_CHOOSE_THEN `nJ:int` STRIP_ASSUME_TAC) THEN DISCH_TAC THEN + MP_TAC(ISPECL [`k:int`; `&0:int`; `nJ:int`; `z:real`; + `y:real`] CARLESON_PSI_THETA) THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[carleson_psi] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[]);; + +(* Abstract: the sum of a finite family whose values lie in {0, v} and which *) +(* has *) +(* AT MOST ONE nonzero term is either 0 or v. (Restrict to the support -- a *) +(* set of *) +(* cardinality <= 1 -- via SUM_SUPPORT; empty support => 0, singleton {a} => *) +(* f a=v.) *) +let SUM_ATMOST_ONE_VALUE = prove + (`!(f:A->real) v s. FINITE s /\ + (!i. i IN s ==> f i = &0 \/ f i = v) /\ + (!i j. i IN s /\ j IN s /\ ~(f i = &0) /\ ~(f j = &0) ==> i = j) + ==> sum s f = &0 \/ sum s f = v`, + REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[GSYM SUM_SUPPORT] THEN + REWRITE_TAC[support; NEUTRAL_REAL_ADD] THEN + ASM_CASES_TAC `{x:A | x IN s /\ ~(f x = &0)} = {}` THENL + [ASM_REWRITE_TAC[SUM_CLAUSES]; ALL_TAC] THEN + DISJ2_TAC THEN + SUBGOAL_THEN + `?a:A. {x:A | x IN s /\ ~(f x = &0)} = {a}` STRIP_ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC o REWRITE_RULE[GSYM MEMBER_NOT_EMPTY]) THEN + REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN EXISTS_TAC `x:A` THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_SING] THEN + X_GEN_TAC `w:A` THEN EQ_TAC THENL + [STRIP_TAC THEN FIRST_X_ASSUM(MATCH_MP_TAC o + check(fun th -> is_forall(concl th))) THEN ASM_MESON_TAC[]; + DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN + ASM_REWRITE_TAC[SUM_SING] THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP + (SET_RULE `{x | x IN s /\ ~(f x = &0)} = {a} ==> a IN s /\ ~(f a = &0)`)) + THEN + ASM_MESON_TAC[]);; + +(* Every finite partial sum of the per-scale bumps carleson_psi z (.) y is 0 *) +(* or *) +(* theta_z y (SUM_ATMOST_ONE_VALUE with CARLESON_PSI_CASES [each 0 or *) +(* theta_z] + *) +(* CARLESON_PSI_DISJOINT [<=1 nonzero]). Hence bounded by theta_z y <= 1 -- *) +(* the *) +(* pointwise value + DCT domination for the R2c/d scale-sum. *) +let CARLESON_PSI_PARTIAL = prove + (`!z y (s:int->bool). FINITE s + ==> sum s (\k. carleson_psi z k y) = &0 \/ + sum s (\k. carleson_psi z k y) = carleson_theta z y`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\k:int. carleson_psi z k y`; `carleson_theta z y`; + `s:int->bool`] + SUM_ATMOST_ONE_VALUE) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL + [X_GEN_TAC `k:int` THEN DISCH_TAC THEN REWRITE_TAC[CARLESON_PSI_CASES]; + MAP_EVERY X_GEN_TAC [`k:int`; `k':int`] THEN STRIP_TAC THEN + MATCH_MP_TAC CARLESON_PSI_DISJOINT THEN + MAP_EVERY EXISTS_TAC [`z:real`; `y:real`] THEN ASM_REWRITE_TAC[]]);; + +(* When theta_z y <> 0 the sup-set is nonempty, so some tile witnesses (z in *) +(* Jr, y in Jl); its scale k gives carleson_psi z k y = theta_z y (nonzero). *) +let CARLESON_THETA_WITNESS = prove + (`!z y. ~(carleson_theta z y = &0) + ==> ?k. carleson_psi z k y = carleson_theta z y /\ ~(carleson_psi z k + y = &0)`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o CONV_RULE(RAND_CONV(REWRITE_CONV[carleson_theta]))) THEN + ASM_CASES_TAC `{ Re(fourier carleson_phi (&2 zpow (--(tile_k s)) * (y - + tile_ymid s))) pow 2 + | s | z IN tile_Jr s /\ y IN tile_Jl s } = {}` THENL + [ASM_REWRITE_TAC[UNION_EMPTY; SUP_SING]; ALL_TAC] THEN + POP_ASSUM(MP_TAC o REWRITE_RULE[GSYM MEMBER_NOT_EMPTY]) THEN + REWRITE_TAC[IN_ELIM_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `w:real` (X_CHOOSE_THEN + `s0:int#int#int` STRIP_ASSUME_TAC)) THEN + DISCH_TAC THEN + MP_TAC(ISPEC `s0:int#int#int` PAIR_SURJECTIVE) THEN + DISCH_THEN(X_CHOOSE_THEN `k0:int` (X_CHOOSE_THEN + `p0:int#int` SUBST_ALL_TAC)) THEN + MP_TAC(ISPEC `p0:int#int` PAIR_SURJECTIVE) THEN + DISCH_THEN(X_CHOOSE_THEN `nI0:int` (X_CHOOSE_THEN + `nJ0:int` SUBST_ALL_TAC)) THEN + EXISTS_TAC `k0:int` THEN + SUBGOAL_THEN + `carleson_psi z k0 y = + carleson_theta z y` (fun th -> ASM_REWRITE_TAC[th]) THEN + MP_TAC(ISPECL [`k0:int`; `nI0:int`; `nJ0:int`; `z:real`; + `y:real`] CARLESON_PSI_THETA) THEN + ASM_REWRITE_TAC[tile_k]);; + +(* A finite partial sum with a single distinguished nonzero term k0 equals *) +(* that term (all others vanish by CARLESON_PSI_DISJOINT; SUM_SUPERSET onto *) +(* {k0}). *) +let CARLESON_PSI_SUM_SINGLE = prove + (`!z y (s:int->bool) k0. FINITE s /\ k0 IN s /\ ~(carleson_psi z k0 y = &0) + ==> sum s (\k. carleson_psi z k y) = carleson_psi z k0 y`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\k:int. carleson_psi z k y`; `{k0:int}`; + `s:int->bool`] SUM_SUPERSET) THEN + REWRITE_TAC[SUM_SING] THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[SING_SUBSET; IN_SING] THEN + X_GEN_TAC `k:int` THEN STRIP_TAC THEN REWRITE_TAC[] THEN + ASM_CASES_TAC `carleson_psi z k y = &0` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `k:int = k0` (fun th -> ASM_MESON_TAC[th]) THEN + MATCH_MP_TAC CARLESON_PSI_DISJOINT THEN + MAP_EVERY EXISTS_TAC [`z:real`; `y:real`] THEN ASM_REWRITE_TAC[]; + DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[]]);; + +(* R2c POINTWISE CONVERGENCE (Fremlin 286O-a-i "theta_z = sum_k psi_k"): the *) +(* finite *) +(* scale-partial-sums converge to theta_z y. Eventually constant: if theta_z *) +(* y = 0 *) +(* all sums are 0 (PSI_PARTIAL); else the unique witnessing scale k0 *) +(* (CARLESON_THETA_ *) +(* WITNESS) satisfies abs k0 <= K for K large, and the sum picks up exactly *) +(* that term *) +(* (CARLESON_PSI_SUM_SINGLE) = theta_z y. REALLIM_EVENTUALLY. *) +let CARLESON_PSI_SUM_LIMIT = prove + (`!z y. ((\K. sum {k:int | abs k <= &K} (\k. carleson_psi z k y)) + ---> carleson_theta z y) sequentially`, + REPEAT GEN_TAC THEN MATCH_MP_TAC REALLIM_EVENTUALLY THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN + ASM_CASES_TAC `carleson_theta z y = &0` THENL + [EXISTS_TAC `0` THEN X_GEN_TAC `K:num` THEN DISCH_TAC THEN + MP_TAC(ISPECL [`z:real`; `y:real`; + `{k:int | abs k <= &K}`] CARLESON_PSI_PARTIAL) THEN + ASM_REWRITE_TAC[CFOURIER_INDEX_FINITE] THEN ASM_MESON_TAC[]; ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP CARLESON_THETA_WITNESS) THEN + DISCH_THEN(X_CHOOSE_THEN `k0:int` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `num_of_int(abs k0)` THEN X_GEN_TAC `K:num` THEN DISCH_TAC THEN + MP_TAC(ISPECL [`z:real`; `y:real`; `{k:int | abs k <= &K}`; + `k0:int`] CARLESON_PSI_SUM_SINGLE) THEN + ASM_REWRITE_TAC[CFOURIER_INDEX_FINITE; IN_ELIM_THM] THEN + ANTS_TAC THENL + [SUBGOAL_THEN `abs k0 = &(num_of_int(abs k0))` SUBST1_TAC THENL + [MATCH_MP_TAC(GSYM INT_OF_NUM_OF_INT) THEN INT_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[INT_OF_NUM_LE] THEN ASM_ARITH_TAC; + DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[]]);; + +(* ========================================================================= *) +(* 286Q(a,b) (Fremlin mt286.tex 2361-2417): the affine-reparametrised bump *) +(* theta'_{z alpha beta}(y) = theta_{alpha z + beta}(alpha y + beta). Its *) +(* elementary properties (values in [0,1]; zero for y >= z when alpha>0) *) +(* follow *) +(* directly from those of carleson_theta. [The 286Q(c) kernel bound *) +(* 2pi|(h-hat x theta')^v| <= D_{1/alpha} A M_beta D_alpha h and the Borel *) +(* measurability (286Qa) are deferred with the tile operator A / 286O(b).] *) +(* ========================================================================= *) +let carleson_theta' = new_definition + `carleson_theta' z alpha beta y = + carleson_theta (alpha * z + beta) (alpha * y + beta)`;; + +let CARLESON_THETA'_BOUNDS = prove + (`!z alpha beta y. &0 <= carleson_theta' z alpha beta y /\ + carleson_theta' z alpha beta y <= &1`, + REPEAT GEN_TAC THEN REWRITE_TAC[carleson_theta'; CARLESON_THETA_BOUNDS]);; + +let CARLESON_THETA'_SUPPORT = prove + (`!z alpha beta y. &0 < alpha /\ z <= y ==> carleson_theta' z alpha beta y = + &0`, + REPEAT STRIP_TAC THEN REWRITE_TAC[carleson_theta'] THEN + MATCH_MP_TAC CARLESON_THETA_SUPPORT THEN + MATCH_MP_TAC REAL_LE_ADD2 THEN REWRITE_TAC[REAL_LE_REFL] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC);; + +(* ========================================================================= *) +(* 286R-e: dyadic scale-invariance theta_{2z}(2y) = theta_z(y) (Fremlin *) +(* mt286.tex 2567-2607). Doubling z, y AND the dyadic scale k together *) +(* leaves *) +(* both tile membership (Jr/Jl) and the phihat window value 2^{-k}(y-ymid) *) +(* invariant, so the sup-of-windows theta is unchanged. This is the building *) +(* block for 286R-f (g(2a,.)=g(a,.)) toward the averaged bump thetatilde. *) +(* ========================================================================= *) + +(* &2 zpow k = &2 * &2 zpow (k-1). *) +let ZPOW2_PRED = prove + (`!k:int. &2 zpow k = &2 * &2 zpow (k - &1)`, + GEN_TAC THEN + SUBGOAL_THEN + `k:int = (k - &1) + &1` (fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) + [th]) THENL + [INT_ARITH_TAC; ALL_TAC] THEN + SIMP_TAC[REAL_ZPOW_ADD; REAL_ARITH `~(&2 = &0)`] THEN + REWRITE_TAC[REAL_ZPOW_1] THEN REAL_ARITH_TAC);; + +(* 2x in dyho(k+1)n <=> x in dyho k n. *) +let CARLESON_DYHO_SCALE2 = prove + (`!k n x. (&2 * x) IN dyho (k + &1) n <=> x IN dyho k n`, + REPEAT GEN_TAC THEN REWRITE_TAC[dyho; IN_ELIM_THM] THEN + SUBGOAL_THEN + `&0 < &2 zpow k /\ &2 zpow (k + &1) = + &2 * &2 zpow k` STRIP_ASSUME_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; + SIMP_TAC[REAL_ZPOW_ADD; REAL_ARITH `~(&2 = &0)`] THEN + REWRITE_TAC[REAL_ZPOW_1] THEN REAL_ARITH_TAC]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC);; + +(* tile Jr/Jl membership scaling (k+1 form), via DYHO_SCALE2 with scale-args *) +(* normalized. *) +let CARLESON_TILE_JR_SCALE2 = prove + (`!k nI nJ z. (&2 * z) IN tile_Jr(k + &1,nI,nJ) <=> z IN tile_Jr(k,nI,nJ)`, + REPEAT GEN_TAC THEN REWRITE_TAC[tile_Jr] THEN + SUBGOAL_THEN + `dyho ((k + &1) - &1) (&2 * nJ + &1) = dyho ((k - &1) + &1) (&2 * nJ + &1)` + SUBST1_TAC THENL + [AP_THM_TAC THEN AP_TERM_TAC THEN INT_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[CARLESON_DYHO_SCALE2]);; + +let CARLESON_TILE_JL_SCALE2 = prove + (`!k nI nJ y. (&2 * y) IN tile_Jl(k + &1,nI,nJ) <=> y IN tile_Jl(k,nI,nJ)`, + REPEAT GEN_TAC THEN REWRITE_TAC[tile_Jl] THEN + SUBGOAL_THEN + `dyho ((k + &1) - &1) (&2 * nJ) = dyho ((k - &1) + &1) (&2 * nJ)` + SUBST1_TAC THENL + [AP_THM_TAC THEN AP_TERM_TAC THEN INT_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[CARLESON_DYHO_SCALE2]);; + +(* PRED-indexed forms (2z in Jr(k,..) <=> z in Jr(k-1,..)) for the bijection *) +(* forward leg. *) +let CARLESON_TILE_JR_SCALE2P = prove + (`!k nI nJ z. (&2 * z) IN tile_Jr(k,nI,nJ) <=> z IN tile_Jr(k - &1,nI,nJ)`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN + `tile_Jr(k,nI,nJ) = tile_Jr((k - &1) + &1,nI,nJ)` SUBST1_TAC THENL + [AP_TERM_TAC THEN REWRITE_TAC[PAIR_EQ] THEN INT_ARITH_TAC; + REWRITE_TAC[CARLESON_TILE_JR_SCALE2]]);; + +let CARLESON_TILE_JL_SCALE2P = prove + (`!k nI nJ y. (&2 * y) IN tile_Jl(k,nI,nJ) <=> y IN tile_Jl(k - &1,nI,nJ)`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN + `tile_Jl(k,nI,nJ) = tile_Jl((k - &1) + &1,nI,nJ)` SUBST1_TAC THENL + [AP_TERM_TAC THEN REWRITE_TAC[PAIR_EQ] THEN INT_ARITH_TAC; + REWRITE_TAC[CARLESON_TILE_JL_SCALE2]]);; + +(* dyho_mid k n = 2 * dyho_mid (k-1) n. *) +let DYHO_MID_PRED = prove + (`!k n. dyho_mid k n = &2 * dyho_mid (k - &1) n`, + REPEAT GEN_TAC THEN REWRITE_TAC[dyho_mid] THEN + SUBGOAL_THEN `&2 zpow k = &2 * &2 zpow (k - &1)` SUBST1_TAC THENL + [SUBGOAL_THEN + `k:int = (k - &1) + &1` (fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) + [th]) THENL + [INT_ARITH_TAC; ALL_TAC] THEN + SIMP_TAC[REAL_ZPOW_ADD; REAL_ARITH `~(&2 = &0)`] THEN + REWRITE_TAC[REAL_ZPOW_1] THEN REAL_ARITH_TAC; ALL_TAC] THEN + REAL_ARITH_TAC);; + +(* &2 zpow(--k) = inv 2 * &2 zpow(--(k-1)). *) +let ZPOW_NEG_PRED = prove + (`!k:int. &2 zpow (--k) = inv(&2) * &2 zpow (--(k - &1))`, + GEN_TAC THEN + SUBGOAL_THEN `--k:int = --(k - &1) + (-- &1)` SUBST1_TAC THENL + [INT_ARITH_TAC; ALL_TAC] THEN + SIMP_TAC[REAL_ZPOW_ADD; REAL_ARITH `~(&2 = &0)`] THEN + REWRITE_TAC[REAL_ZPOW_NEG; REAL_ZPOW_1] THEN REAL_ARITH_TAC);; + +let ZPOW_NEG_SUCC = prove + (`!k:int. &2 zpow (--(k + &1)) = inv(&2) * &2 zpow (--k)`, + GEN_TAC THEN SUBGOAL_THEN `--(k + &1):int = --k + (-- &1)` SUBST1_TAC THENL + [INT_ARITH_TAC; ALL_TAC] THEN + SIMP_TAC[REAL_ZPOW_ADD; REAL_ARITH `~(&2 = &0)`] THEN + REWRITE_TAC[REAL_ZPOW_NEG; REAL_ZPOW_1] THEN REAL_ARITH_TAC);; + +(* phihat-argument scale-invariance (PRED form): value@(2y,scale k) = *) +(* value@(y,scale k-1). *) +let CARLESON_TILE_ARG_SCALE2P = prove + (`!k nI nJ y. + &2 zpow (--(tile_k(k,nI,nJ))) * (&2 * y - tile_ymid(k,nI,nJ)) + = &2 zpow (--(tile_k(k - &1,nI,nJ))) * (y - tile_ymid(k - &1,nI,nJ))`, + REPEAT GEN_TAC THEN REWRITE_TAC[tile_k; tile_ymid] THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o RAND_CONV) [DYHO_MID_PRED] THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [ZPOW_NEG_PRED] THEN + CONV_TAC REAL_FIELD);; + +(* +1 form of ARG (backward leg): value@(2y,scale k+1) = value@(y,scale k). *) +let CARLESON_TILE_ARG_SCALE2 = prove + (`!k nI nJ y. + &2 zpow (--(tile_k(k + &1,nI,nJ))) * (&2 * y - tile_ymid(k + &1,nI,nJ)) + = &2 zpow (--(tile_k(k,nI,nJ))) * (y - tile_ymid(k,nI,nJ))`, + REPEAT GEN_TAC THEN REWRITE_TAC[tile_k; tile_ymid] THEN + SUBGOAL_THEN + `dyho_mid ((k + &1) - &1) (&2 * nJ) = + dyho_mid k (&2 * nJ)` SUBST1_TAC THENL + [AP_THM_TAC THEN AP_TERM_TAC THEN INT_ARITH_TAC; ALL_TAC] THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o RAND_CONV) [DYHO_MID_PRED] THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [ZPOW_NEG_SUCC] THEN + CONV_TAC REAL_FIELD);; + +(* 286R-e MAIN: theta_{2z}(2y) = theta_z(y). Sup-sets coincide via *) +(* (k,nI,nJ)<->(k+1,nI,nJ). *) +let CARLESON_THETA_SCALE2 = prove + (`!z y. carleson_theta (&2 * z) (&2 * y) = carleson_theta z y`, + REPEAT GEN_TAC THEN REWRITE_TAC[carleson_theta] THEN + AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `c:real` THEN EQ_TAC THENL + [DISCH_THEN(X_CHOOSE_THEN `s:int#int#int` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPEC `s:int#int#int` PAIR_SURJECTIVE) THEN + DISCH_THEN(X_CHOOSE_THEN `k:int` (X_CHOOSE_THEN + `r:int#int` SUBST_ALL_TAC)) THEN + MP_TAC(ISPEC `r:int#int` PAIR_SURJECTIVE) THEN + DISCH_THEN(X_CHOOSE_THEN `nI:int` (X_CHOOSE_THEN + `nJ:int` SUBST_ALL_TAC)) THEN + EXISTS_TAC `(k - &1, nI, nJ):int#int#int` THEN + RULE_ASSUM_TAC(REWRITE_RULE[CARLESON_TILE_JR_SCALE2P; + CARLESON_TILE_JL_SCALE2P]) THEN + ASM_REWRITE_TAC[GSYM CARLESON_TILE_ARG_SCALE2P]; + DISCH_THEN(X_CHOOSE_THEN `s:int#int#int` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPEC `s:int#int#int` PAIR_SURJECTIVE) THEN + DISCH_THEN(X_CHOOSE_THEN `k:int` (X_CHOOSE_THEN + `r:int#int` SUBST_ALL_TAC)) THEN + MP_TAC(ISPEC `r:int#int` PAIR_SURJECTIVE) THEN + DISCH_THEN(X_CHOOSE_THEN `nI:int` (X_CHOOSE_THEN + `nJ:int` SUBST_ALL_TAC)) THEN + EXISTS_TAC `(k + &1, nI, nJ):int#int#int` THEN + ASM_REWRITE_TAC[CARLESON_TILE_JR_SCALE2; CARLESON_TILE_JL_SCALE2] THEN + REWRITE_TAC[CARLESON_TILE_ARG_SCALE2] THEN ASM_REWRITE_TAC[]]);; + +(* 286R-e COROLLARY: theta'_{z,2a,2b}(y) = theta'_{z,a,b}(y). *) +let CARLESON_THETA'_SCALE2 = prove + (`!z a b y. carleson_theta' z (&2 * a) (&2 * b) y = carleson_theta' z a b y`, + REPEAT GEN_TAC THEN REWRITE_TAC[carleson_theta'] THEN + SUBGOAL_THEN `(&2 * a) * z + &2 * b = &2 * (a * z + b) /\ + (&2 * a) * y + &2 * b = &2 * (a * y + b)` + (fun th -> REWRITE_TAC[th]) THENL + [CONJ_TAC THEN REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[CARLESON_THETA_SCALE2]);; + +(* ========================================================================= *) +(* 286R-b-i FOUNDATIONS (Fremlin mt286.tex 2437-2488): the beta-periodicity *) +(* theta'_{z,a,beta+2^l}(y) = theta'_{z,a,beta}(y). Adding 2^l to beta *) +(* shifts *) +(* the witnessing tile's nJ-index by q = 2^{l-k} (an integer since k <= l), *) +(* leaving both membership (Jr/Jl) and the phihat window value invariant. *) +(* These are the dyadic-shift + window-support bricks; the k<=l gate (from *) +(* the *) +(* phihat support) and the theta-shift assembly build on them. *) +(* ========================================================================= *) + +(* H1: dyho cell translation by c widths. x + c*2^k in dyho k (n+c) <=> x in *) +(* dyho k n. *) +let DYHO_SHIFT = prove + (`!k n c x. (x + real_of_int c * &2 zpow k) IN dyho k (n + c) <=> x IN dyho k + n`, + REPEAT GEN_TAC THEN REWRITE_TAC[dyho; IN_ELIM_THM] THEN + REWRITE_TAC[GSYM REAL_OF_INT_CLAUSES] THEN + MP_TAC(ISPECL [`&2`; `k:int`] REAL_ZPOW_LT) THEN + REWRITE_TAC[REAL_ARITH `&0 < &2`] THEN + DISCH_TAC THEN REAL_ARITH_TAC);; + +(* H2: dyho_mid translation. *) +let DYHO_MID_SHIFT = prove + (`!k n c. dyho_mid k (n + c) = dyho_mid k n + real_of_int c * &2 zpow k`, + REPEAT GEN_TAC THEN REWRITE_TAC[dyho_mid] THEN + REWRITE_TAC[GSYM REAL_OF_INT_CLAUSES] THEN REAL_ARITH_TAC);; + +(* H3: tile_Jr under nJ-shift by q. Z + 2q*2^(k-1) in Jr(k,nI,nJ+q) <=> Z in *) +(* Jr(k,nI,nJ). *) +let TILE_JR_NJSHIFT = prove + (`!k nI nJ q Z. (Z + real_of_int(&2 * q) * &2 zpow (k - &1)) IN + tile_Jr(k,nI,nJ + q) + <=> Z IN tile_Jr(k,nI,nJ)`, + REPEAT GEN_TAC THEN REWRITE_TAC[tile_Jr] THEN + SUBGOAL_THEN + `dyho (k - &1) (&2 * (nJ + q) + &1) = + dyho (k - &1) ((&2 * nJ + &1) + &2 * q)` + SUBST1_TAC THENL + [AP_TERM_TAC THEN INT_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[DYHO_SHIFT]);; + +let TILE_JL_NJSHIFT = prove + (`!k nI nJ q Y. (Y + real_of_int(&2 * q) * &2 zpow (k - &1)) IN + tile_Jl(k,nI,nJ + q) + <=> Y IN tile_Jl(k,nI,nJ)`, + REPEAT GEN_TAC THEN REWRITE_TAC[tile_Jl] THEN + SUBGOAL_THEN + `dyho (k - &1) (&2 * (nJ + q)) = dyho (k - &1) ((&2 * nJ) + &2 * q)` + SUBST1_TAC THENL + [AP_TERM_TAC THEN INT_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[DYHO_SHIFT]);; + +(* H4: tile_ymid under nJ-shift. *) +let TILE_YMID_NJSHIFT = prove + (`!k nI nJ q. tile_ymid(k,nI,nJ + q) + = tile_ymid(k,nI,nJ) + real_of_int(&2 * q) * &2 zpow (k - &1)`, + REPEAT GEN_TAC THEN REWRITE_TAC[tile_ymid] THEN + SUBGOAL_THEN + `dyho_mid (k - &1) (&2 * (nJ + q)) = + dyho_mid (k - &1) ((&2 * nJ) + &2 * q)` + SUBST1_TAC THENL + [AP_TERM_TAC THEN INT_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[DYHO_MID_SHIFT]);; + +(* H5: for k <= L, the nJ-shift q = 2^(L-k) gives point-shift 2q*2^(k-1) = *) +(* 2^L. *) +let REAL_OF_INT_2POW = prove + (`!n:num. real_of_int((&2:int) pow n) = &2 pow n`, + GEN_TAC THEN REWRITE_TAC[GSYM REAL_OF_INT_CLAUSES] THEN + REWRITE_TAC[REAL_OF_INT_CLAUSES]);; + +let REAL_ZPOW_ADD_2 = prove + (`!m n:int. &2 zpow (m + n) = &2 zpow m * &2 zpow n`, + REPEAT GEN_TAC THEN MATCH_MP_TAC REAL_ZPOW_ADD THEN REAL_ARITH_TAC);; + +let ZPOW_SHIFT_EXISTS = prove + (`!k L:int. k <= L + ==> ?q:int. real_of_int(&2 * q) * &2 zpow (k - &1) = &2 zpow L`, + REPEAT STRIP_TAC THEN + ABBREV_TAC `n = num_of_int(L - k)` THEN + SUBGOAL_THEN `(&n:int) = L - k` ASSUME_TAC THENL + [EXPAND_TAC "n" THEN MATCH_MP_TAC INT_OF_NUM_OF_INT THEN + ASM_INT_ARITH_TAC; ALL_TAC] THEN + EXISTS_TAC `(&2:int) pow n` THEN + REWRITE_TAC[GSYM REAL_OF_INT_CLAUSES; REAL_OF_INT_2POW] THEN + SUBGOAL_THEN `&2 * &2 pow n = &2 pow (n + 1)` SUBST1_TAC THENL + [REWRITE_TAC[REAL_POW_ADD; REAL_POW_1] THEN REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[GSYM REAL_ZPOW_NUM] THEN + REWRITE_TAC[GSYM REAL_ZPOW_ADD_2] THEN + AP_TERM_TAC THEN + REWRITE_TAC[GSYM INT_OF_NUM_ADD] THEN ASM_INT_ARITH_TAC);; + +(* the phihat window value is shift-invariant under the (nJ+q, *) +(* point+2q*2^(k-1)) move. *) +let TILE_ARG_NJSHIFT = prove + (`!k nI nJ q Y. + &2 zpow (--(tile_k(k,nI,nJ + q))) * ((Y + real_of_int(&2 * q) * &2 zpow (k + - &1)) - tile_ymid(k,nI,nJ + q)) + = &2 zpow (--(tile_k(k,nI,nJ))) * (Y - tile_ymid(k,nI,nJ))`, + REPEAT GEN_TAC THEN REWRITE_TAC[tile_k] THEN + REWRITE_TAC[TILE_YMID_NJSHIFT] THEN + AP_TERM_TAC THEN REAL_ARITH_TAC);; + +(* H8a: window nonzero => phihat argument in [-1/5,1/5] (contrapositive of *) +(* PHI support). *) +let CARLESON_WINDOW_SUPP = prove + (`!t. ~(Re(fourier carleson_phi t) pow 2 = &0) ==> abs t <= &1 / &5`, + GEN_TAC THEN GEN_REWRITE_TAC I [GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[REAL_NOT_LE] THEN DISCH_TAC THEN + SUBGOAL_THEN + `fourier carleson_phi t = Cx(&0)` (fun th -> REWRITE_TAC[th; RE_CX]) THENL + [MATCH_MP_TAC CARLESON_PHI_FHAT_SUPPORT THEN ASM_REAL_ARITH_TAC; + CONV_TAC REAL_RING]);; + +(* ========================================================================= *) +(* 286R-b-i: the k<=l gate (Fremlin mt286.tex 2451-2457). A nonzero window *) +(* at *) +(* (Z,Y) with witness tile (k,nI,nJ) forces 2^k <= 20(Z-Y): Z in Jr gives *) +(* Z >= (2nJ+1)2^(k-1); window!=0 gives |2^{-k}(Y-ymid)|<=1/5 so Y <= *) +(* 2^k(nJ+9/20); hence Z-Y >= 2^k/20. Then l = floor(log2(20 a(z-y))) bounds *) +(* every such k (CARLESON_GATE_L_EXISTS), so q = 2^{l-k} in *) +(* ZPOW_SHIFT_EXISTS *) +(* is a genuine integer. *) +(* ========================================================================= *) + +(* the pure real-arithmetic 1/20-gap core. *) +let CARLESON_GATE_ARITH = prove + (`!w m Z Y:real. &0 < w /\ (&2 * m + &1) * w <= Z /\ + abs(Y - (&2 * m + &1 / &2) * w) <= (&2 * w) / &5 + ==> &2 * w <= &20 * (Z - Y)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `Y <= (&2 * m + &1 / &2) * w + (&2 * w) / &5` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_REAL_ARITH_TAC);; + +(* 2^(-k) = inv(2*2^(k-1)). *) +let ZPOW_NEG_HALF = prove + (`!k:int. &2 zpow (--k) = inv(&2 * &2 zpow (k - &1))`, + GEN_TAC THEN REWRITE_TAC[REAL_ZPOW_NEG] THEN AP_TERM_TAC THEN + GEN_REWRITE_TAC (LAND_CONV) [ZPOW2_PRED] THEN REFL_TAC);; + +(* inv(2w)*p <= 1/5 /\ 0 p <= 2w/5. *) +let WSUPP_DIV = prove + (`!w p:real. &0 < w /\ inv(&2 * w) * p <= &1 / &5 ==> p <= (&2 * w) / &5`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&0 < &2 * w` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPECL [`p:real`; `&1 / &5`; `&2 * w`] REAL_LE_LDIV_EQ) THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `p / (&2 * w) = inv(&2 * w) * p` SUBST1_TAC THENL + [REWRITE_TAC[real_div] THEN REAL_ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; + +(* window nonzero => |Y - ymid| <= 2*2^(k-1)/5 (= 2^k/5). *) +let CARLESON_WSUPP_ABS = prove + (`!k nI nJ Y. + ~(Re(fourier carleson_phi (&2 zpow (--(tile_k(k,nI,nJ))) * (Y - + tile_ymid(k,nI,nJ)))) pow 2 = &0) /\ + &0 < &2 zpow (k - &1) + ==> abs(Y - (&2 * real_of_int nJ + &1 / &2) * &2 zpow (k - &1)) <= (&2 * + &2 zpow (k - &1)) / &5`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP CARLESON_WINDOW_SUPP) THEN + REWRITE_TAC[tile_k; tile_ymid; dyho_mid; int_add_th; int_mul_th; + int_of_num_th] THEN + REWRITE_TAC[ZPOW_NEG_HALF; REAL_ABS_MUL; REAL_ABS_INV] THEN + SUBGOAL_THEN `abs(&2) = &2 /\ abs(&2 zpow (k - &1)) = &2 zpow (k - &1)` + (fun th -> REWRITE_TAC[th]) THENL + [REWRITE_TAC[REAL_ABS_NUM] THEN REWRITE_TAC[REAL_ABS_REFL] THEN + ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_TAC THEN MATCH_MP_TAC WSUPP_DIV THEN ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[REAL_ABS_SUB] THEN ASM_REWRITE_TAC[]);; + +(* H8-tile: nonzero window at (Z,Y) with witness (k,nI,nJ) => 2^k <= *) +(* 20(Z-Y). *) +let CARLESON_TILE_GATE = prove + (`!k nI nJ Z Y. + Z IN tile_Jr(k,nI,nJ) /\ + ~(Re(fourier carleson_phi (&2 zpow (--(tile_k(k,nI,nJ))) * (Y - + tile_ymid(k,nI,nJ)))) pow 2 = &0) + ==> &2 zpow k <= &20 * (Z - Y)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&0 < &2 zpow (k - &1)` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV) [ZPOW2_PRED] THEN + MATCH_MP_TAC CARLESON_GATE_ARITH THEN EXISTS_TAC `real_of_int nJ` THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [UNDISCH_TAC `Z IN tile_Jr(k,nI,nJ)` THEN + REWRITE_TAC[tile_Jr; dyho; IN_ELIM_THM; int_add_th; int_mul_th; + int_of_num_th] THEN + STRIP_TAC THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC CARLESON_WSUPP_ABS THEN EXISTS_TAC `nI:int` THEN + ASM_REWRITE_TAC[]]);; + +(* zpow strict monotonicity contrapositive: 2^k < 2^m ==> k < m. *) +let ZPOW2_LT_MONO = prove + (`!k m:int. &2 zpow k < &2 zpow m ==> k < m`, + REPEAT GEN_TAC THEN GEN_REWRITE_TAC I [GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[INT_NOT_LT; REAL_NOT_LT] THEN DISCH_TAC THEN + MATCH_MP_TAC ZPOW2_MONOE THEN ASM_REWRITE_TAC[]);; + +(* H8-L: the l-construction. For X>0 there is an integer L bounding every k *) +(* with *) +(* 2^k <= X. (l = floor(log2 X); any L with X < 2^(L+1) works, via *) +(* REAL_ARCH_SIMPLE *) +(* + N < 2^N.) *) +let CARLESON_GATE_L_EXISTS = prove + (`!X:real. &0 < X ==> ?L:int. !k:int. &2 zpow k <= X ==> k <= L`, + REPEAT STRIP_TAC THEN + MP_TAC(SPEC `X:real` REAL_ARCH_SIMPLE) THEN + DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN + EXISTS_TAC `&N:int` THEN X_GEN_TAC `k:int` THEN DISCH_TAC THEN + REWRITE_TAC[INT_LE_LT] THEN DISJ1_TAC THEN + MATCH_MP_TAC ZPOW2_LT_MONO THEN + REWRITE_TAC[REAL_ZPOW_NUM] THEN + MP_TAC(SPEC `N:num` LT_POW2_REFL) THEN + REWRITE_TAC[GSYM REAL_OF_NUM_LT; REAL_OF_NUM_POW] THEN + ASM_REAL_ARITH_TAC);; + +(* ========================================================================= *) +(* 286R-b-i H7 core: the gated theta-shift value-transfer. If theta(Z)(Y)<>0 *) +(* and every nonzero-window witness of (Z,Y) has scale k <= L, then adding *) +(* 2^L *) +(* to both points preserves theta: theta(Z+2^L)(Y+2^L) = theta(Z)(Y). The *) +(* witness tile (k,nI,nJ) [k<=L via the gate] shifts to (k,nI,nJ+q), *) +(* q=2^{l-k}, *) +(* which witnesses (Z+2^L,Y+2^L) with the SAME phihat window value. *) +(* ========================================================================= *) + +(* theta Z Y <> 0 yields an actual witnessing tile with nonzero window *) +(* value. (Any witness's value = theta Z Y by CARLESON_THETA_VALUE, hence <> *) +(* 0.) *) +let THETA_TILE_WITNESS = prove + (`!Z Y. ~(carleson_theta Z Y = &0) + ==> ?k nI nJ. Z IN tile_Jr(k,nI,nJ) /\ Y IN tile_Jl(k,nI,nJ) /\ + ~(Re(fourier carleson_phi (&2 zpow (--(tile_k(k,nI,nJ))) * (Y + - tile_ymid(k,nI,nJ)))) pow 2 = &0)`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o CONV_RULE(RAND_CONV(REWRITE_CONV[carleson_theta]))) THEN + ASM_CASES_TAC `{ Re(fourier carleson_phi (&2 zpow (--(tile_k s)) * (Y - + tile_ymid s))) pow 2 + | s | Z IN tile_Jr s /\ Y IN tile_Jl s } = {}` THENL + [ASM_REWRITE_TAC[UNION_EMPTY; SUP_SING]; ALL_TAC] THEN + POP_ASSUM(MP_TAC o REWRITE_RULE[GSYM MEMBER_NOT_EMPTY]) THEN + REWRITE_TAC[IN_ELIM_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `w:real` (X_CHOOSE_THEN + `s0:int#int#int` STRIP_ASSUME_TAC)) THEN DISCH_TAC THEN + MP_TAC(ISPEC `s0:int#int#int` PAIR_SURJECTIVE) THEN + DISCH_THEN(X_CHOOSE_THEN `k0:int` (X_CHOOSE_THEN + `p0:int#int` SUBST_ALL_TAC)) THEN + MP_TAC(ISPEC `p0:int#int` PAIR_SURJECTIVE) THEN + DISCH_THEN(X_CHOOSE_THEN `nI0:int` (X_CHOOSE_THEN + `nJ0:int` SUBST_ALL_TAC)) THEN + MAP_EVERY EXISTS_TAC [`k0:int`;`nI0:int`;`nJ0:int`] THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`(k0,nI0,nJ0):int#int#int`; `Z:real`; + `Y:real`] CARLESON_THETA_VALUE) THEN + ASM_REWRITE_TAC[tile_k] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + ASM_REWRITE_TAC[]);; + +(* forward value-transfer: theta(Z)(Y)<>0 + (nonzero witness scale <= L) ==> *) +(* theta(Z+2^L)(Y+2^L) = theta(Z)(Y). *) +let THETA_SHIFT_TRANSFER = prove + (`!Z Y L. + ~(carleson_theta Z Y = &0) /\ + (!k nI nJ. Z IN tile_Jr(k,nI,nJ) /\ Y IN tile_Jl(k,nI,nJ) /\ + ~(Re(fourier carleson_phi (&2 zpow (--(tile_k(k,nI,nJ))) * (Y - + tile_ymid(k,nI,nJ)))) pow 2 = &0) + ==> k <= L) + ==> carleson_theta (Z + &2 zpow L) (Y + &2 zpow L) = carleson_theta Z Y`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP THETA_TILE_WITNESS) THEN + DISCH_THEN(X_CHOOSE_THEN `k:int` (X_CHOOSE_THEN `nI:int` (X_CHOOSE_THEN + `nJ:int` STRIP_ASSUME_TAC))) THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`k:int`;`nI:int`;`nJ:int`]) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MP_TAC(SPECL [`k:int`;`L:int`] ZPOW_SHIFT_EXISTS) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_TAC `q:int`) THEN + SUBGOAL_THEN + `carleson_theta Z Y = + Re(fourier carleson_phi (&2 zpow (--k) * (Y - tile_ymid(k,nI,nJ)))) pow 2` + SUBST1_TAC THENL + [MP_TAC(ISPECL [`(k,nI,nJ):int#int#int`; `Z:real`; + `Y:real`] CARLESON_THETA_VALUE) THEN + ASM_REWRITE_TAC[tile_k]; ALL_TAC] THEN + SUBGOAL_THEN + `carleson_theta (Z + &2 zpow L) (Y + &2 zpow L) = + Re(fourier carleson_phi (&2 zpow (--k) * ((Y + &2 zpow L) - + tile_ymid(k,nI,nJ + q)))) pow 2` + SUBST1_TAC THENL + [MP_TAC(ISPECL [`(k,nI,nJ + q):int#int#int`; `Z + &2 zpow L`; + `Y + &2 zpow L`] CARLESON_THETA_VALUE) THEN + REWRITE_TAC[tile_k] THEN DISCH_THEN MATCH_MP_TAC THEN + MP_TAC(SPECL [`k:int`;`nI:int`;`nJ:int`;`q:int`;`Z:real`] TILE_JR_NJSHIFT) + THEN + MP_TAC(SPECL [`k:int`;`nI:int`;`nJ:int`;`q:int`;`Y:real`] TILE_JL_NJSHIFT) + THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN DISCH_TAC THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + MP_TAC(SPECL [`k:int`;`nI:int`;`nJ:int`;`q:int`;`Y:real`] TILE_ARG_NJSHIFT) + THEN + REWRITE_TAC[tile_k] THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN REFL_TAC);; + +(* down-transfer (mirror of THETA_SHIFT_TRANSFER): theta(Z+2^L)(Y+2^L)<>0 + *) +(* (nonzero witness of the shifted point has scale k<=L) ==> theta(Z)(Y) = *) +(* theta(Z+2^L)(Y+2^L). Witness (k,nI,nJ) of the shifted point maps DOWN to *) +(* (k,nI,nJ-q) witnessing (Z,Y) with the same window value. *) +let THETA_SHIFT_TRANSFER_DOWN = prove + (`!Z Y L. + ~(carleson_theta (Z + &2 zpow L) (Y + &2 zpow L) = &0) /\ + (!k nI nJ. (Z + &2 zpow L) IN tile_Jr(k,nI,nJ) /\ (Y + &2 zpow L) IN + tile_Jl(k,nI,nJ) /\ + ~(Re(fourier carleson_phi (&2 zpow (--(tile_k(k,nI,nJ))) * ((Y + + &2 zpow L) - tile_ymid(k,nI,nJ)))) pow 2 = &0) + ==> k <= L) + ==> carleson_theta Z Y = carleson_theta (Z + &2 zpow L) (Y + &2 zpow L)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP THETA_TILE_WITNESS) THEN + DISCH_THEN(X_CHOOSE_THEN `k:int` (X_CHOOSE_THEN `nI:int` (X_CHOOSE_THEN + `nJ:int` STRIP_ASSUME_TAC))) THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`k:int`;`nI:int`;`nJ:int`]) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MP_TAC(SPECL [`k:int`;`L:int`] ZPOW_SHIFT_EXISTS) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_TAC `q:int`) THEN + SUBGOAL_THEN + `carleson_theta (Z + &2 zpow L) (Y + &2 zpow L) = + Re(fourier carleson_phi (&2 zpow (--k) * ((Y + &2 zpow L) - + tile_ymid(k,nI,nJ)))) pow 2` + SUBST1_TAC THENL + [MP_TAC(ISPECL [`(k,nI,nJ):int#int#int`; `Z + &2 zpow L`; + `Y + &2 zpow L`] CARLESON_THETA_VALUE) THEN + ASM_REWRITE_TAC[tile_k]; ALL_TAC] THEN + SUBGOAL_THEN + `carleson_theta Z Y = + Re(fourier carleson_phi (&2 zpow (--k) * (Y - tile_ymid(k,nI,nJ - q)))) pow + 2` + SUBST1_TAC THENL + [MP_TAC(ISPECL [`(k,nI,nJ - q):int#int#int`; `Z:real`; + `Y:real`] CARLESON_THETA_VALUE) THEN + REWRITE_TAC[tile_k] THEN DISCH_THEN MATCH_MP_TAC THEN + MP_TAC(SPECL [`k:int`;`nI:int`;`nJ - q:int`;`q:int`;`Z:real`] + TILE_JR_NJSHIFT) THEN + MP_TAC(SPECL [`k:int`;`nI:int`;`nJ - q:int`;`q:int`;`Y:real`] + TILE_JL_NJSHIFT) THEN + SUBGOAL_THEN `(nJ:int) - q + q = nJ` (fun th -> REWRITE_TAC[th]) THENL + [INT_ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN DISCH_TAC THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + MP_TAC(SPECL [`k:int`;`nI:int`;`nJ - q:int`;`q:int`;`Y:real`] + TILE_ARG_NJSHIFT) THEN + SUBGOAL_THEN `(nJ:int) - q + q = nJ` (fun th -> REWRITE_TAC[th]) THENL + [INT_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[tile_k] THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN REFL_TAC);; + +(* full shift-equality: theta(Z+2^L)(Y+2^L) = theta(Z)(Y), given L bounds *) +(* every nonzero-window witnessing scale of BOTH points (4-way case-split on *) +(* the two thetas being zero; nonzero side handled by the up/down transfer). *) +let CARLESON_THETA_SHIFT_2L = prove + (`!Z Y L. + (!k nI nJ. Z IN tile_Jr(k,nI,nJ) /\ Y IN tile_Jl(k,nI,nJ) /\ + ~(Re(fourier carleson_phi (&2 zpow (--(tile_k(k,nI,nJ))) * (Y - + tile_ymid(k,nI,nJ)))) pow 2 = &0) + ==> k <= L) /\ + (!k nI nJ. (Z + &2 zpow L) IN tile_Jr(k,nI,nJ) /\ (Y + &2 zpow L) IN + tile_Jl(k,nI,nJ) /\ + ~(Re(fourier carleson_phi (&2 zpow (--(tile_k(k,nI,nJ))) * ((Y + + &2 zpow L) - tile_ymid(k,nI,nJ)))) pow 2 = &0) + ==> k <= L) + ==> carleson_theta (Z + &2 zpow L) (Y + &2 zpow L) = carleson_theta Z Y`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + ASM_CASES_TAC `carleson_theta Z Y = &0` THENL + [ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `carleson_theta (Z + &2 zpow L) (Y + &2 zpow L) = &0` THENL + [ASM_REWRITE_TAC[]; ALL_TAC] THEN + MP_TAC(SPECL [`Z:real`; `Y:real`; `L:int`] THETA_SHIFT_TRANSFER_DOWN) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SYM) THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC THETA_SHIFT_TRANSFER THEN ASM_REWRITE_TAC[]]);; + +(* 286R-b-i (Fremlin mt286.tex 2437-2488): the beta-periodicity of theta'. *) +(* For y0, there is an integer L (= floor log2(20 a(z-y))) such that *) +(* shifting *) +(* beta by 2^L leaves theta' unchanged, for every beta. The gate L is beta- *) +(* independent because (a z+b)-(a y+b) = a(z-y) does not involve b. *) +let CARLESON_THETA'_PERIOD = prove + (`!z a y. &0 < a /\ y < z + ==> ?L:int. !b. carleson_theta' z a (b + &2 zpow L) y = carleson_theta' z a + b y`, + REPEAT STRIP_TAC THEN + MP_TAC(SPEC `&20 * a * (z - y)` CARLESON_GATE_L_EXISTS) THEN + ANTS_TAC THENL + [MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_TAC `L:int`) THEN EXISTS_TAC `L:int` THEN GEN_TAC THEN + REWRITE_TAC[carleson_theta'] THEN + SUBGOAL_THEN `a * z + (b + &2 zpow L) = (a * z + b) + &2 zpow L /\ + a * y + (b + &2 zpow L) = (a * y + b) + &2 zpow L` + (fun th -> REWRITE_TAC[th]) THENL [CONJ_TAC THEN + REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC CARLESON_THETA_SHIFT_2L THEN CONJ_TAC THEN + MAP_EVERY X_GEN_TAC [`k:int`;`nI:int`;`nJ:int`] THEN STRIP_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THENL + [MP_TAC(SPECL [`k:int`;`nI:int`;`nJ:int`;`(a * z + b):real`;`(a * y + + b):real`] + CARLESON_TILE_GATE) THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + MP_TAC(SPECL [`k:int`;`nI:int`;`nJ:int`;`(a * z + b) + &2 zpow L`;`(a * y + + b) + &2 zpow L`] + CARLESON_TILE_GATE) THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC]);; + +(* ========================================================================= *) +(* 286R-(b-ii): the B.Levi / Cesaro-average limit *) +(* g(alpha,y,z) = lim_{b->inf} (1/b) int_0^b theta'_{z,alpha,beta}(y) dbeta *) +(* is defined (Fremlin mt286.tex 2490-2518). We prove the general fact: for *) +(* a nonnegative p-periodic locally-integrable f, the Cesaro average *) +(* (1/b) int_0^b f converges to the mean (1/p) int_0^p f as b -> +inf. *) +(* Fremlin's squeeze: with gamma = (1/p) int_0^p f = (1/(p m)) int_0^{p m} f *) +(* (by periodicity), for p m <= b <= p(m+1) one has *) +(* (m/(m+1)) gamma <= (1/b) int_0^b f <= ((m+1)/m) gamma, *) +(* both approaching gamma. Instantiated at p = 2^l (the beta-period from *) +(* CARLESON_THETA'_PERIOD) this gives 286R-(b-ii). *) +(* ========================================================================= *) + +(* n/(n+1) -> 1 and (n+1)/n -> 1 *) +let SEQ_N_OVER_SUC = prove + (`((\n. &n / (&n + &1)) ---> &1) sequentially`, + MP_TAC(ISPECL [`sequentially`; `\n. &1 - inv(&n + &1)`; `\n. &n / (&n + &1)`; + `&1`] + REALLIM_TRANSFORM_EVENTUALLY) THEN + ANTS_TAC THENL [ALL_TAC; DISCH_THEN ACCEPT_TAC] THEN CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `0` THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC(REAL_FIELD `&0 <= y ==> y / (y + &1) = &1 - inv(y + &1)`) THEN + REWRITE_TAC[REAL_POS]; + MP_TAC(ISPECL [`sequentially`; `\n:num. &1`; `\n. inv(&n + &1)`; `&1`; + `&0`] + REALLIM_SUB) THEN + REWRITE_TAC[REALLIM_CONST; REALLIM_1_OVER_N_OFFSET; REAL_SUB_RZERO; + ETA_AX]]);; + +let SEQ_SUC_OVER_N = prove + (`((\n. (&n + &1) / &n) ---> &1) sequentially`, + MP_TAC(ISPECL [`sequentially`; `\n. &1 + inv(&n)`; `\n. (&n + &1) / &n`; + `&1`] + REALLIM_TRANSFORM_EVENTUALLY) THEN + ANTS_TAC THENL [ALL_TAC; DISCH_THEN ACCEPT_TAC] THEN CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC(REAL_FIELD `&0 < y ==> (y + &1) / y = &1 + inv(y)`) THEN + REWRITE_TAC[REAL_OF_NUM_LT] THEN ASM_ARITH_TAC; + MP_TAC(ISPECL [`sequentially`; `\n:num. &1`; `\n. inv(&n)`; `&1`; `&0`] + REALLIM_ADD) THEN + REWRITE_TAC[REALLIM_CONST; REALLIM_1_OVER_N; REAL_ADD_RID; ETA_AX]]);; + +(* monotonicity of the integral over [0,.] for a nonnegative integrand *) +let INT_0_MONO = prove + (`!f u v. &0 <= u /\ u <= v /\ (!x. &0 <= f x) /\ + (!a b. f real_integrable_on real_interval[a,b]) + ==> real_integral (real_interval[&0,u]) f <= real_integral + (real_interval[&0,v]) f`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_SUBSET_LE THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET; IN_REAL_INTERVAL] THEN + ASM_REAL_ARITH_TAC);; + +(* the shift int_c^{c+p} f = int_0^p f(.+c) via HAS_REAL_INTEGRAL_AFFINITY *) +let REAL_INTEGRAL_SHIFT = prove + (`!f c p. f real_integrable_on real_interval[c,c + p] + ==> real_integral (real_interval[c,c + p]) f = real_integral + (real_interval[&0,p]) (\b. f(b + c))`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP REAL_INTEGRABLE_INTEGRAL) THEN + DISCH_THEN(MP_TAC o SPECL [`&1`; `c:real`] o MATCH_MP + (REWRITE_RULE[TAUT `a /\ b ==> c <=> a ==> b ==> c`] + HAS_REAL_INTEGRAL_AFFINITY)) THEN + REWRITE_TAC[REAL_ARITH `~(&1 = &0)`; REAL_MUL_LID; REAL_INV_1; + REAL_ABS_NUM] THEN + SUBGOAL_THEN + `IMAGE (\x. x - c) (real_interval[c,c + p]) = real_interval[&0,p]` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_REAL_INTERVAL] THEN + X_GEN_TAC `t:real` THEN EQ_TAC THENL + [STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + STRIP_TAC THEN EXISTS_TAC `t + c:real` THEN + ASM_REAL_ARITH_TAC]; ALL_TAC] THEN + DISCH_THEN(SUBST1_TAC o SYM o MATCH_MP REAL_INTEGRAL_UNIQUE) THEN REFL_TAC);; + +(* period iteration f(b + n p) = f b *) +let PERIOD_ITERATE = prove + (`!f p. (!b. f(b + p) = f b) ==> !n b. f(b + &n * p) = f b`, + REPEAT GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THEN + REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_RID; GSYM REAL_OF_NUM_SUC] THEN + X_GEN_TAC `b:real` THEN + SUBGOAL_THEN `b + (&n + &1) * p = (b + &n * p) + p` SUBST1_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[]);; + +(* int_0^{n p} f = n int_0^p f for p-periodic integrable f *) +let PERIOD_INTEGRAL_MULTIPLE = prove + (`!f p. &0 < p /\ (!b. f(b + p) = f b) /\ (!u v. f real_integrable_on + real_interval[u,v]) + ==> !n. real_integral (real_interval[&0,&n * p]) f = &n * real_integral + (real_interval[&0,p]) f`, + REPEAT GEN_TAC THEN STRIP_TAC THEN INDUCT_TAC THEN + REWRITE_TAC[REAL_MUL_LZERO; GSYM REAL_OF_NUM_SUC] THENL + [SIMP_TAC[REAL_INTEGRAL_NULL; REAL_LE_REFL]; ALL_TAC] THEN + SUBGOAL_THEN + `real_integral (real_interval[&0,(&n + &1) * p]) f = + real_integral (real_interval[&0,&n * p]) f + + real_integral (real_interval[&n * p,(&n + &1) * p]) f` + SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_INTEGRAL_COMBINE THEN + ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_MUL THEN ASM_REAL_ARITH_TAC; + ASM_REAL_ARITH_TAC]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `(&n + &1) * p = (&n * p) + p` (fun th -> ONCE_REWRITE_TAC[th]) THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(SPECL [`f:real->real`; `&n * p`; `p:real`] REAL_INTEGRAL_SHIFT) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + SUBGOAL_THEN `(\b. (f:real->real)(b + &n * p)) = f` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:real` THEN + MP_TAC(ISPECL [`f:real->real`; `p:real`] PERIOD_ITERATE) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> REWRITE_TAC[th]); ALL_TAC] THEN + REAL_ARITH_TAC);; + +(* gamma = (1/(p m)) int_0^{p m} f = (1/p) int_0^p f for m >= 1 *) +let PERIOD_AVG_MULTIPLE = prove + (`!f p. &0 < p /\ (!b. f(b + p) = f b) /\ (!u v. f real_integrable_on + real_interval[u,v]) + ==> !m. 1 <= m + ==> inv(p * &m) * real_integral (real_interval[&0,&m * p]) f = + inv p * real_integral (real_interval[&0,p]) f`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`f:real->real`; `p:real`] PERIOD_INTEGRAL_MULTIPLE) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(fun th -> REWRITE_TAC[SPEC `m:num` th]) THEN + SUBGOAL_THEN `~(p = &0) /\ ~(&m = &0)` MP_TAC THENL + [CONJ_TAC THENL [ASM_REAL_ARITH_TAC; + REWRITE_TAC[REAL_OF_NUM_EQ] THEN ASM_ARITH_TAC]; ALL_TAC] THEN + CONV_TAC REAL_FIELD);; + +(* auxiliary division bounds for the sandwich *) +let INV_SUC_LE_DIV = prove + (`&0 < b /\ &0 < &m + &1 /\ &0 < p /\ b <= (&m + &1) * p ==> inv (&m + &1) <= + p / b`, + STRIP_TAC THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `inv(&m + &1) * ((&m + &1) * p)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN + ASM_SIMP_TAC[REAL_LE_INV_EQ; REAL_LT_IMP_LE]; + ASM_SIMP_TAC[REAL_MUL_ASSOC; REAL_MUL_LINV; REAL_LT_IMP_NZ; REAL_MUL_LID; + REAL_LE_REFL]]);; + +let DIV_LE_INV_M = prove + (`&0 < b /\ &0 < &m /\ &0 < p /\ &m * p <= b ==> p / b <= inv (&m)`, + STRIP_TAC THEN ASM_SIMP_TAC[REAL_LE_LDIV_EQ] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(&m) * (&m * p)` THEN + CONJ_TAC THENL + [ASM_SIMP_TAC[REAL_MUL_ASSOC; REAL_MUL_LINV; REAL_LT_IMP_NZ; REAL_MUL_LID; + REAL_LE_REFL]; + MATCH_MP_TAC REAL_LE_LMUL THEN + ASM_SIMP_TAC[REAL_LE_INV_EQ; REAL_LT_IMP_LE]]);; + +(* the two-sided sandwich for p m <= b <= p(m+1), m >= 1 *) +let PERIOD_AVG_SANDWICH = prove + (`!f p m b. &0 < p /\ 1 <= m /\ (!x. &0 <= f x) /\ + (!u v. f real_integrable_on real_interval[u,v]) /\ + (!b. f(b + p) = f b) /\ + &m * p <= b /\ b <= (&m + &1) * p + ==> (&m / (&m + &1)) * (inv p * real_integral (real_interval[&0,p]) f) + <= inv b * real_integral (real_interval[&0,b]) f /\ + inv b * real_integral (real_interval[&0,b]) f + <= ((&m + &1) / &m) * (inv p * real_integral (real_interval[&0,p]) + f)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + ABBREV_TAC `G = inv p * real_integral (real_interval[&0,p]) f` THEN + SUBGOAL_THEN `&0 < b` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&m * p` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_MUL THEN + ASM_REWRITE_TAC[REAL_OF_NUM_LT] THEN ASM_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `&0 < &m /\ &0 < &m + &1 /\ ~(&m = &0) /\ ~(&m + &1 = &0)` STRIP_ASSUME_TAC + THENL + [REWRITE_TAC[REAL_OF_NUM_LT; REAL_OF_NUM_EQ] THEN + ASM_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `real_integral (real_interval[&0,&m * p]) f = + (p * &m) * G` ASSUME_TAC THENL + [MP_TAC(SPECL [`f:real->real`; `p:real`] PERIOD_AVG_MULTIPLE) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `m:num`) THEN + ASM_REWRITE_TAC[] THEN EXPAND_TAC "G" THEN + SUBGOAL_THEN `~(p * &m = &0)` MP_TAC THENL + [REWRITE_TAC[REAL_ENTIRE; DE_MORGAN_THM] THEN CONJ_TAC THEN + ASM_REAL_ARITH_TAC; ALL_TAC] THEN CONV_TAC REAL_FIELD; ALL_TAC] THEN + SUBGOAL_THEN + `real_integral (real_interval[&0,(&m + &1) * p]) f = (p * (&m + &1)) * G` + ASSUME_TAC THENL + [MP_TAC(SPECL [`f:real->real`; `p:real`] PERIOD_AVG_MULTIPLE) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `m + 1`) THEN + ANTS_TAC THENL [ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN EXPAND_TAC "G" THEN + SUBGOAL_THEN `~(p * (&m + &1) = &0)` MP_TAC THENL + [REWRITE_TAC[REAL_ENTIRE; DE_MORGAN_THM] THEN CONJ_TAC THEN + ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `(&m + &1) * p = p * (&m + &1)` SUBST1_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN CONV_TAC REAL_FIELD; ALL_TAC] THEN + SUBGOAL_THEN `&0 <= G` ASSUME_TAC THENL + [EXPAND_TAC "G" THEN MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INV THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_INTEGRAL_POS THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `inv b * real_integral (real_interval[&0,&m * p]) f` THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[] THEN + REWRITE_TAC[REAL_ARITH `inv b * (p * &m) * G = (&m * G) * (p / b)`; + REAL_ARITH `&m / (&m + &1) * G = (&m * G) * inv(&m + &1)`] + THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC; + MATCH_MP_TAC INV_SUC_LE_DIV THEN ASM_REWRITE_TAC[]]; + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INV THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC INT_0_MONO THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_MUL THEN ASM_REAL_ARITH_TAC]]; + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `inv b * real_integral (real_interval[&0,(&m + &1) * p]) f` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INV THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC INT_0_MONO THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC]; + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[REAL_ARITH `inv b * (p * (&m + &1)) * G = ((&m + &1) * G) * + (p / b)`; + REAL_ARITH `(&m + &1) / &m * G = ((&m + &1) * G) * inv(&m)`] + THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC; + MATCH_MP_TAC DIV_LE_INV_M THEN ASM_REWRITE_TAC[]]]]);; + +(* the floor block: for b > 0 there is m with p m <= b < p (m+1) *) +let CESARO_BLOCK_EXISTS = prove + (`!p b:real. &0 < p /\ &0 < b ==> ?m. &m * p <= b /\ b < (&m + &1) * p`, + REPEAT STRIP_TAC THEN MP_TAC(SPEC `(b:real) / p` FLOOR_POS) THEN + ANTS_TAC THENL [ASM_SIMP_TAC[REAL_LE_DIV; REAL_LT_IMP_LE]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_TAC `m:num`) THEN EXISTS_TAC `m:num` THEN + MP_TAC(SPEC `(b:real) / p` FLOOR) THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; GSYM REAL_LT_LDIV_EQ]);; + +(* the squeeze glue *) +let CESARO_SQUEEZE = prove + (`!A G e r1 r2. + r1 <= A /\ A <= r2 /\ abs(r1 - G) < e /\ abs(r2 - G) < e ==> abs(A - G) < + e`, + REAL_ARITH_TAC);; + +(* THE Cesaro-mean limit: nonnegative p-periodic locally-integrable f => *) +(* (1/b) int_0^b f -> (1/p) int_0^p f as b -> +inf. [Fremlin 286R-b-ii] *) +let PERIODIC_CESARO_LIMIT = prove + (`!f p. &0 < p /\ (!x. &0 <= f x) /\ + (!u v. f real_integrable_on real_interval[u,v]) /\ + (!b. f(b + p) = f b) + ==> ((\b. inv b * real_integral (real_interval[&0,b]) f) + ---> inv p * real_integral (real_interval[&0,p]) f) at_posinfinity`, + REPEAT STRIP_TAC THEN + ABBREV_TAC `G = inv p * real_integral (real_interval[&0,p]) f` THEN + SUBGOAL_THEN `&0 <= G` ASSUME_TAC THENL + [EXPAND_TAC "G" THEN MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INV THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_INTEGRAL_POS THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN + SUBGOAL_THEN `((\m. (&m / (&m + &1)) * G) ---> G) sequentially /\ + ((\m. ((&m + &1) / &m) * G) ---> G) sequentially` + STRIP_ASSUME_TAC THENL + [CONJ_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [GSYM REAL_MUL_LID] THEN + MATCH_MP_TAC REALLIM_RMUL THENL + [ACCEPT_TAC SEQ_N_OVER_SUC; ACCEPT_TAC SEQ_SUC_OVER_N]; ALL_TAC] THEN + REWRITE_TAC[REALLIM_AT_POSINFINITY] THEN X_GEN_TAC `e:real` THEN + DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REALLIM_SEQUENTIALLY]) THEN + DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `M2:num`) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REALLIM_SEQUENTIALLY]) THEN + DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `M1:num`) THEN + EXISTS_TAC `(&(M1 + M2) + &1) * p + &1` THEN + X_GEN_TAC `b:real` THEN REWRITE_TAC[real_ge] THEN DISCH_TAC THEN + SUBGOAL_THEN `&0 < b` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LTE_TRANS THEN + EXISTS_TAC `(&(M1 + M2) + &1) * p + &1` THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> &0 < x + &1`) THEN + MATCH_MP_TAC REAL_LE_MUL THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(SPECL [`p:real`; `b:real`] CESARO_BLOCK_EXISTS) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `m:num` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `1 <= m /\ M1 <= m /\ M2 <= m` STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC(ARITH_RULE `!M1 M2 m:num. M1 + M2 < m ==> 1 <= m /\ M1 <= m /\ + M2 <= m`) THEN + SUBGOAL_THEN `(&(M1 + M2) + &1) * p < (&m + &1) * p` MP_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LT_RMUL_EQ] THEN + REWRITE_TAC[REAL_ARITH `&(M1 + M2) + &1 < &m + &1 <=> &(M1 + M2) < &m`] + THEN + REWRITE_TAC[REAL_OF_NUM_LT]; ALL_TAC] THEN + MP_TAC(SPECL [`f:real->real`; `p:real`; `m:num`; + `b:real`] PERIOD_AVG_SANDWICH) THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + MATCH_MP_TAC CESARO_SQUEEZE THEN + EXISTS_TAC `&m / (&m + &1) * G` THEN + EXISTS_TAC `(&m + &1) / &m * G` THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THEN FIRST_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[]);; + +(* --- Cesaro change-of-variable engine (feeds 286R-(d)/(f)/(g)) *) +(* ------------- *) +(* The (1/b)-average kills boundary terms: shifting/rescaling the window of *) +(* a *) +(* bounded nonnegative integrand leaves the Cesaro limit unchanged. *) + +(* int_c^{b+c} f = int_0^b f + (int_b^{b+c} f - int_0^c f) for c>=0, b>0. *) +let CESARO_SPLIT_ID = prove + (`!f b c. &0 <= c /\ &0 < b /\ (!u v. f real_integrable_on real_interval[u,v]) + ==> real_integral (real_interval[c,b + c]) f = + real_integral (real_interval[&0,b]) f + + (real_integral (real_interval[b,b + c]) f - real_integral + (real_interval[&0,c]) f)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `real_integral (real_interval[&0,c]) f + real_integral (real_interval[c,b + + c]) f = + real_integral (real_interval[&0,b + c]) f` + (fun th -> MP_TAC th) THENL + [MATCH_MP_TAC REAL_INTEGRAL_COMBINE THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `real_integral (real_interval[&0,b]) f + real_integral (real_interval[b,b + + c]) f = + real_integral (real_interval[&0,b + c]) f` + (fun th -> MP_TAC th) THENL + [MATCH_MP_TAC REAL_INTEGRAL_COMBINE THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REAL_ARITH_TAC);; + +(* 0 <= int_a^{a+c} f <= c for 0<=f<=1, c>=0. *) +let CESARO_BOUNDARY_BOUND = prove + (`!f a c. &0 <= c /\ (!x. &0 <= f x) /\ (!x. f x <= &1) /\ + (!u v. f real_integrable_on real_interval[u,v]) + ==> &0 <= real_integral (real_interval[a,a + c]) f /\ + real_integral (real_interval[a,a + c]) f <= c`, + REPEAT GEN_TAC THEN STRIP_TAC THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_POS THEN ASM_REWRITE_TAC[] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `real_integral (real_interval[a,a + c]) (\x. &1)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_LE THEN + ASM_REWRITE_TAC[REAL_INTEGRABLE_CONST] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + ASM_SIMP_TAC[REAL_INTEGRAL_CONST; + REAL_ARITH `&0 <= c ==> a <= a + c`] THEN + REAL_ARITH_TAC]]);; + +(* inv b ---> 0 as b ---> +inf. *) +let REALLIM_INV_POSINF = prove + (`((\b. inv b) ---> &0) at_posinfinity`, + REWRITE_TAC[REALLIM_AT_POSINFINITY] THEN X_GEN_TAC `e:real` THEN + DISCH_TAC THEN + EXISTS_TAC `&1 / e + &1` THEN X_GEN_TAC `x:real` THEN + REWRITE_TAC[real_ge] THEN DISCH_TAC THEN + SUBGOAL_THEN `&0 < &1 / e` ASSUME_TAC THENL + [ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_01]; ALL_TAC] THEN + ABBREV_TAC `d = &1 / e` THEN + SUBGOAL_THEN `d < x` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `&0 < x` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_SUB_RZERO] THEN + ASM_SIMP_TAC[REAL_ABS_INV; REAL_ARITH `&0 < y ==> abs y = y`] THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `inv(d:real)` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LT_INV2 THEN ASM_REWRITE_TAC[]; + EXPAND_TAC "d" THEN ASM_SIMP_TAC[REAL_INV_DIV] THEN ASM_REAL_ARITH_TAC]);; + +(* the boundary contribution inv b * (int_b^{b+c} - int_0^c) ---> 0. *) +let CESARO_BOUNDARY_NULL = prove + (`!f c. &0 <= c /\ (!x. &0 <= f x) /\ (!x. f x <= &1) /\ + (!u v. f real_integrable_on real_interval[u,v]) + ==> ((\b. inv b * (real_integral (real_interval[b,b + c]) f - + real_integral (real_interval[&0,c]) f)) ---> &0) + at_posinfinity`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`at_posinfinity`; + `\b. inv b * (real_integral (real_interval[b,b + c]) f - + real_integral (real_interval[&0,c]) f)`; + `\b:real. c * inv b`] REALLIM_NULL_COMPARISON) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_AT_POSINFINITY] THEN EXISTS_TAC `&1` THEN + X_GEN_TAC `b:real` THEN REWRITE_TAC[real_ge] THEN DISCH_TAC THEN + BETA_TAC THEN + REWRITE_TAC[REAL_ABS_MUL] THEN + SUBGOAL_THEN `abs(inv b) = inv b` SUBST1_TAC THENL + [REWRITE_TAC[REAL_ABS_INV; REAL_ABS_REFL] THEN + MATCH_MP_TAC REAL_LE_INV THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INV THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(SPECL [`f:real->real`;`b:real`;`c:real`] CESARO_BOUNDARY_BOUND) + THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(SPECL [`f:real->real`;`&0`;`c:real`] CESARO_BOUNDARY_BOUND) THEN + ASM_REWRITE_TAC[REAL_ADD_LID] THEN REAL_ARITH_TAC; + SUBGOAL_THEN `&0 = c * &0` SUBST1_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REALLIM_LMUL THEN MP_TAC REALLIM_INV_POSINF THEN + REWRITE_TAC[ETA_AX]]; + DISCH_THEN ACCEPT_TAC]);; + +(* 286R-(d) engine: the c-shifted Cesaro average has the same limit (c>=0). *) +let CESARO_SHIFT_INVARIANT = prove + (`!f c L. &0 <= c /\ + (!x. &0 <= f x) /\ (!x. f x <= &1) /\ (!u v. f real_integrable_on + real_interval[u,v]) /\ + ((\b. inv b * real_integral (real_interval[&0,b]) f) ---> L) + at_posinfinity + ==> ((\b. inv b * real_integral (real_interval[c,b + c]) f) ---> L) + at_posinfinity`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REALLIM_TRANSFORM_EVENTUALLY THEN + EXISTS_TAC `\b. inv b * real_integral (real_interval[&0,b]) f + + inv b * (real_integral (real_interval[b,b + c]) f - + real_integral (real_interval[&0,c]) f)` THEN + CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_AT_POSINFINITY] THEN EXISTS_TAC `&1` THEN + X_GEN_TAC `b:real` THEN REWRITE_TAC[real_ge] THEN DISCH_TAC THEN + BETA_TAC THEN + MP_TAC(SPECL [`f:real->real`;`b:real`;`c:real`] CESARO_SPLIT_ID) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN REAL_ARITH_TAC; + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_ADD_RID] THEN + MATCH_MP_TAC REALLIM_ADD THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC CESARO_BOUNDARY_NULL THEN ASM_REWRITE_TAC[]]);; + +(* ========================================================================= *) +(* Sine-kernel Riemann-Lebesgue reduction (DINI's TEST, general form). For a *) +(* fixed x, if the localized kernel H(u) = ((f(x+u)+f(x-u)) - 2 f x)/u is *) +(* (absolutely) integrable on [0,pi], then the discrete sine-kernel integral *) +(* int_0^pi sin((n+1/2)u) H(u) du -> 0 as n -> inf *) +(* by Riemann-Lebesgue. Proof: extend H by zero to R (RESTRICT_UNIV), apply *) +(* RIEMANN_LEBESGUE_RLINE (continuous a -> +inf), then specialise *) +(* a := &n + 1/2 via the shifted-sequential limit helper. *) +(* *) +(* CAUTION (route note): the Dini hypothesis "H_x integrable a.e." is a *) +(* SUFFICIENT-but-not-necessary convergence test; it FAILS on positive- *) +(* measure sets for general L^2 f, so it is NOT the route to Carleson (were *) +(* it, a.e. convergence would be elementary). The honest Carleson-level *) +(* target is the OSCILLATORY sine-kernel limit itself (no integrability of *) +(* H_x assumed -- the sin((n+1/2)u) cancels the 1/u singularity), which by *) +(* FOURIER_SUM_LIMIT_SINE_PART is EQUIVALENT to s_n(x) -> f(x). So the true *) +(* remaining input is CARLESON_286V_FROM_SINEKERNEL's hypothesis; the Dini *) +(* form below is retained only as a general-purpose lemma / sanity check. *) +(* ========================================================================= *) + +let REALLIM_POSINFINITY_SEQ_SHIFT = prove + (`!g l. (g ---> l) at_posinfinity + ==> ((\n. g(&n + &1 / &2)) ---> l) sequentially`, + REPEAT GEN_TAC THEN + REWRITE_TAC[REALLIM_AT_POSINFINITY; REALLIM_SEQUENTIALLY] THEN + DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `b:real` STRIP_ASSUME_TAC) THEN + MP_TAC(SPEC `b:real` REAL_ARCH_SIMPLE) THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `N:num` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `&n + &1 / &2`) THEN + REWRITE_TAC[real_ge] THEN ANTS_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&N:real` THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&n:real` THEN + ASM_SIMP_TAC[REAL_OF_NUM_LE] THEN REAL_ARITH_TAC; + REWRITE_TAC[]]);; + +let CARLESON_286V_FROM_SINEKERNEL = prove + (`!f. f square_integrable_on real_interval[--pi,pi] /\ + (!x. f(x + &2 * pi) = f x) /\ + (?s. real_negligible s /\ + !x. ~(x IN s) + ==> ((\n. real_integral (real_interval[&0,pi]) + (\u. sin((&n + &1 / &2) * u) * + ((f(x + u) + f(x - u)) - &2 * f x) / u)) + ---> &0) sequentially) + ==> ?s. real_negligible s /\ + !x. ~(x IN s) + ==> ((\n. sum(0..n) (\k. fourier_coefficient f k * + trigonometric_set k x)) + ---> f x) sequentially`, + GEN_TAC THEN STRIP_TAC THEN + EXISTS_TAC `s:real->bool` THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `x:real` THEN DISCH_TAC THEN + MP_TAC(ISPECL [`f:real->real`; `x:real`; `(f:real->real) x`; `pi`] + FOURIER_SUM_LIMIT_SINE_PART) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC SQUARE_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE THEN + ASM_REWRITE_TAC[REAL_MEASURABLE_REAL_INTERVAL]; + MP_TAC PI_POS THEN REAL_ARITH_TAC; + REAL_ARITH_TAC]; + DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real`) THEN ASM_REWRITE_TAC[]]);; + +(* ========================================================================= *) +(* 286V descent, LOCAL-INTEGRABILITY (Dini) form: combining the RL reduction *) +(* with the periodic descent, Fourier-series a.e. convergence follows from *) +(* the a.e. absolute integrability on [0,pi] of H_x(u) = ((f(x+u)+f(x-u)) *) +(* - 2 f x)/u. NOTE: this is a corollary via DINI's test, NOT the Carleson *) +(* route -- the Dini hypothesis is too strong (fails a.e. for general L^2). *) +(* The actual remaining CARLESON_THEOREM input is the weaker OSCILLATORY *) +(* sine-kernel hypothesis of CARLESON_286V_FROM_SINEKERNEL (the honest *) +(* target of the 286O-286U maximal-operator tower). Kept as a general *) +(* convergence-test corollary. *) +(* ========================================================================= *) + +let SUP_SEQ_SUPERLEVEL = prove + (`!(Ff:num->real->real) x a. + (?B. !n. Ff n x <= B) + ==> (a < sup {Ff n x | n IN (:num)} <=> ?n. a < Ff n x)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `sup {Ff n x | n IN (:num)} <= a <=> (!n. (Ff:num->real->real) n x <= a)` + ASSUME_TAC THENL + [MP_TAC(ISPECL [`{(Ff:num->real->real) n x | n IN (:num)}`; `a:real`] + REAL_SUP_LE_EQ) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + MESON_TAC[IN_UNIV]; + EXISTS_TAC `B:real` THEN REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN + ASM_REWRITE_TAC[]]; + REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN DISCH_THEN SUBST1_TAC THEN + REFL_TAC]; + EQ_TAC THENL + [DISCH_TAC THEN REWRITE_TAC[GSYM NOT_FORALL_THM; GSYM REAL_NOT_LT] THEN + ASM_MESON_TAC[REAL_NOT_LT]; + STRIP_TAC THEN ASM_MESON_TAC[REAL_NOT_LT; REAL_LTE_TRANS]]]);; + +(* Superlevel set of the sup = point in the countable union of superlevel *) +(* sets. *) +let SUP_MEM_UNIONS = prove + (`!(Ff:num->real->real) a x. + (?B. !n. Ff n x <= B) + ==> (sup {Ff n x | n IN (:num)} > a <=> + x IN UNIONS {{x | Ff n x > a} | n IN (:num)})`, + REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[real_gt] THEN + MP_TAC(ISPECL [`Ff:num->real->real`; `x:real`; + `a:real`] SUP_SEQ_SUPERLEVEL) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[IN_UNIONS; EXISTS_IN_GSPEC; IN_UNIV; IN_ELIM_THM; real_gt]);; + +(* A pointwise-bounded-above countable sup of measurable functions is *) +(* measurable. *) +let REAL_MEASURABLE_ON_SUP = prove + (`!(Ff:num->real->real). + (!n. Ff n real_measurable_on (:real)) /\ + (!x. ?B. !n. Ff n x <= B) + ==> (\x. sup {Ff n x | n IN (:num)}) real_measurable_on (:real)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[REAL_MEASURABLE_ON_PREIMAGE_HALFSPACE_GT] THEN + X_GEN_TAC `a:real` THEN + SUBGOAL_THEN + `{x | sup {(Ff:num->real->real) n x | n IN (:num)} > a} = + UNIONS {{x | Ff n x > a} | n IN (:num)}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `x:real` THEN + MP_TAC(ISPECL [`Ff:num->real->real`; `a:real`; + `x:real`] SUP_MEM_UNIONS) THEN + ASM_REWRITE_TAC[IN_ELIM_THM]; + MATCH_MP_TAC REAL_LEBESGUE_MEASURABLE_COUNTABLE_UNIONS THEN CONJ_TAC THENL + [REWRITE_TAC[SIMPLE_IMAGE] THEN MATCH_MP_TAC COUNTABLE_IMAGE THEN + REWRITE_TAC[NUM_COUNTABLE]; + REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN X_GEN_TAC `n:num` THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN + REWRITE_TAC[REAL_MEASURABLE_ON_PREIMAGE_HALFSPACE_GT] THEN + DISCH_THEN(ACCEPT_TAC o SPEC `a:real`)]]);; + +(* pure sequence-level superlevel fact (domain-free cousin of SUP_SEQ_ *) +(* SUPERLEVEL, whose x:real is incidental): for a bounded-above real *) +(* sequence, a < sup <=> some member exceeds a. *) +let SUP_SEQ_SUPERLEVEL_PURE = prove + (`!(s:num->real) a. (?B. !n. s n <= B) + ==> (a < sup {s n | n IN (:num)} <=> ?n. a < s n)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `sup {(s:num->real) n | n IN (:num)} <= a <=> (!n. s n <= a)` + ASSUME_TAC THENL + [MP_TAC(ISPECL [`{(s:num->real) n | n IN (:num)}`; + `a:real`] REAL_SUP_LE_EQ) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + MESON_TAC[IN_UNIV]; + EXISTS_TAC `B:real` THEN REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN + ASM_REWRITE_TAC[]]; + REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN DISCH_THEN SUBST1_TAC THEN + REFL_TAC]; + EQ_TAC THENL + [DISCH_TAC THEN REWRITE_TAC[GSYM NOT_FORALL_THM; GSYM REAL_NOT_LT] THEN + ASM_MESON_TAC[REAL_NOT_LT]; + STRIP_TAC THEN ASM_MESON_TAC[REAL_NOT_LT; REAL_LTE_TRANS]]]);; + +(* The R^M analog of REAL_MEASURABLE_ON_SUP (which is R^1-only): a *) +(* pointwise- *) +(* bounded-above countable sup of measurable real-valued functions on R^M is *) +(* measurable. Superlevel of the sup = countable union of the members' *) +(* superlevels (SUP_SEQ_SUPERLEVEL_PURE), each lebesgue_measurable. Feeds *) +(* the *) +(* joint (a,b,w)-measurability of the tile-sup theta' kernel (S6 keystone). *) +let MEASURABLE_ON_SUP_MULTI = prove + (`!(Ff:num->real^M->real). + (!n. (\x. lift(Ff n x)) measurable_on (:real^M)) /\ + (!x. ?B. !n. Ff n x <= B) + ==> (\x. lift(sup {Ff n x | n IN (:num)})) measurable_on (:real^M)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GT] THEN + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `k = 1` SUBST_ALL_TAC THENL + [UNDISCH_TAC `k <= dimindex(:1)` THEN UNDISCH_TAC `1 <= k` THEN + REWRITE_TAC[DIMINDEX_1] THEN ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[GSYM drop; LIFT_DROP] THEN + SUBGOAL_THEN + `{x:real^M | sup {(Ff:num->real^M->real) n x | n IN (:num)} > a} = + UNIONS {{x | Ff n x > a} | n IN (:num)}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_UNIONS; EXISTS_IN_GSPEC; IN_UNIV; IN_ELIM_THM; + real_gt] THEN + X_GEN_TAC `x:real^M` THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real^M`) THEN + DISCH_THEN(MP_TAC o SPEC `a:real` o MATCH_MP SUP_SEQ_SUPERLEVEL_PURE) THEN + REWRITE_TAC[IN_UNIV]; + MATCH_MP_TAC LEBESGUE_MEASURABLE_COUNTABLE_UNIONS THEN CONJ_TAC THENL + [REWRITE_TAC[SIMPLE_IMAGE] THEN MATCH_MP_TAC COUNTABLE_IMAGE THEN + REWRITE_TAC[NUM_COUNTABLE]; + REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN X_GEN_TAC `n:num` THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN + REWRITE_TAC[MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GT] THEN + DISCH_THEN(MP_TAC o SPECL [`a:real`; `1`]) THEN + REWRITE_TAC[DIMINDEX_1; LE_REFL; LIFT_DROP; GSYM drop; real_gt]]]);; + +(* --- LSC (lower-semicontinuity) route to measurability of a sup over an *) +(* arbitrary (possibly uncountable) index set of continuous functions. This *) +(* is what 286T(a) actually needs for Ahat_n (sup over the uncountable *) +(* window *) +(* set {-n<=a<=b<=n}); the countable-sup lemma above is the sequential *) +(* cousin. *) +(* Chain: open superlevels ==> measurable; continuous ==> open superlevel; *) +(* sup *) +(* superlevel = union of superlevels (bounded above) ==> open (union of *) +(* opens). --- *) + +(* Open superlevels of a function make it measurable (LSC => Borel). *) +let REAL_MEASURABLE_ON_LSC = prove + (`!f:real->real. (!a. real_open {x | f x > a}) ==> f real_measurable_on + (:real)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[REAL_MEASURABLE_ON_PREIMAGE_HALFSPACE_GT] THEN + ASM_SIMP_TAC[REAL_LEBESGUE_MEASURABLE_OPEN]);; + +(* The superlevel set of a continuous function is open. *) +let REAL_OPEN_SUPERLEVEL_CONTINUOUS = prove + (`!g:real->real a. (!x. g real_continuous atreal x) ==> real_open {y | g y > + a}`, + REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_OPEN; OPEN_CONTAINS_BALL] THEN + REWRITE_TAC[FORALL_IN_IMAGE; IN_ELIM_THM] THEN X_GEN_TAC `y:real` THEN + DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `y:real`) THEN + REWRITE_TAC[real_continuous_atreal] THEN + DISCH_THEN(fun th -> MP_TAC(SPEC `(g:real->real) y - a` th)) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[SUBSET; IN_BALL] THEN + REWRITE_TAC[IN_IMAGE; IN_ELIM_THM] THEN + X_GEN_TAC `z:real^1` THEN DISCH_TAC THEN EXISTS_TAC `drop z` THEN + REWRITE_TAC[LIFT_DROP] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `drop z`) THEN + SUBGOAL_THEN `abs(drop z - y) < d` (fun th -> SIMP_TAC[th]) THENL + [FIRST_X_ASSUM MP_TAC THEN REWRITE_TAC[DIST_1; LIFT_DROP] THEN + REAL_ARITH_TAC; + REWRITE_TAC[real_gt] THEN ASM_REAL_ARITH_TAC]);; + +(* a < sup over a nonempty bounded-above index set <=> some member exceeds *) +(* a. *) +let SUP_SET_SUPERLEVEL = prove + (`!(g:A->real->real) t x a. + ~(t = {}) /\ (?B. !i. i IN t ==> g i x <= B) + ==> (a < sup {g i x | i IN t} <=> ?i. i IN t /\ a < g i x)`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(X_CHOOSE_TAC `i0:A` o REWRITE_RULE[GSYM MEMBER_NOT_EMPTY]) THEN + SUBGOAL_THEN + `sup {(g:A->real->real) i x | i IN t} <= a <=> (!i. i IN t ==> g i x <= a)` + ASSUME_TAC THENL + [MP_TAC(ISPECL [`{(g:A->real->real) i x | i IN t}`; + `a:real`] REAL_SUP_LE_EQ) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + MAP_EVERY EXISTS_TAC [`(g:A->real->real) i0 x`; `i0:A`] THEN + ASM_REWRITE_TAC[]; + EXISTS_TAC `B:real` THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN + ASM_REWRITE_TAC[]]; + REWRITE_TAC[FORALL_IN_GSPEC] THEN DISCH_THEN SUBST1_TAC THEN REFL_TAC]; + ALL_TAC] THEN + EQ_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LE] THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; REAL_NOT_LE] THEN MESON_TAC[]);; + +(* Two-bar (two-argument) version: c < sup over a nonempty bounded-above *) +(* two-bar *) +(* family {g a b | a,b | P a b} iff some member exceeds c. Needed for the *) +(* carleson_gamma sup (indexed by the window pair (a,b)). --- *) +let SUP_2BAR_SUPERLEVEL = prove + (`!(g:A->B->real) P c. + (?a b. P a b) /\ (?M. !a b. P a b ==> g a b <= M) + ==> (c < sup {g a b | a,b | P a b} <=> ?a b. P a b /\ c < g a b)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `sup {(g:A->B->real) a b | a,b | P a b} <= c <=> (!a b. P a b ==> g a b <= + c)` + ASSUME_TAC THENL + [MP_TAC(ISPECL [`{(g:A->B->real) a b | a,b | P a b}`; + `c:real`] REAL_SUP_LE_EQ) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN ASM_MESON_TAC[]; + EXISTS_TAC `M:real` THEN REWRITE_TAC[IN_ELIM_THM] THEN + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[]]; + REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[] THEN MESON_TAC[]]; + EQ_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LE] THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; REAL_NOT_LE] THEN MESON_TAC[]]);; + +(* Sup over a nonempty index set of continuous functions, pointwise bounded *) +(* above, is measurable. *) +let REAL_MEASURABLE_ON_SUP_CONTINUOUS = prove + (`!(g:A->real->real) t. + (!i. i IN t ==> (!x. (g i) real_continuous atreal x)) /\ + (!x. ?B. !i. i IN t ==> g i x <= B) /\ ~(t = {}) + ==> (\x. sup {g i x | i IN t}) real_measurable_on (:real)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_MEASURABLE_ON_LSC THEN + X_GEN_TAC `a:real` THEN REWRITE_TAC[] THEN + SUBGOAL_THEN + `{x | sup {(g:A->real->real) i x | i IN t} > a} = + UNIONS {{y | g i y > a} | i IN t}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `x:real` THEN + REWRITE_TAC[IN_UNIONS; EXISTS_IN_GSPEC; IN_ELIM_THM] THEN + MP_TAC(ISPECL [`g:A->real->real`; `t:A->bool`; `x:real`; `a:real`] + SUP_SET_SUPERLEVEL) THEN + ASM_REWRITE_TAC[real_gt]; + MATCH_MP_TAC REAL_OPEN_UNIONS THEN + REWRITE_TAC[FORALL_IN_GSPEC] THEN X_GEN_TAC `i:A` THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_OPEN_SUPERLEVEL_CONTINUOUS THEN + GEN_TAC THEN REWRITE_TAC[ETA_AX] THEN ASM_SIMP_TAC[]]);; + +(* --- The 286T maximal operator (Fremlin 286T): sup over a<=b of the *) +(* normalised truncated Fourier-integral modulus. --- *) +let carleson_Ahat = new_definition + `carleson_Ahat (f:real->complex) (y:real) = + sup { inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[a,b])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * f(drop x))) + | a <= b }`;; + +(* --- carleson_Ahat >= 0 (guarded form): where the truncated-integral *) +(* family *) +(* is bounded above (Af(y) finite), the sup is nonneg -- the a=b term is >= *) +(* 0 *) +(* and witnesses the sup. NB Fremlin's Af maps to [0,+inf]; the HOL real sup *) +(* is junk on the null set where the family is unbounded, so nonnegativity *) +(* is *) +(* stated under the boundedness hypothesis (always available where it *) +(* matters: *) +(* 286T gives int_F Af finite, hence Af finite a.e.). --- *) +let CARLESON_AHAT_POS = prove + (`!(f:real->complex) y. + (?B. !a b. a <= b ==> inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[a,b])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * f(drop x))) <= B) + ==> &0 <= carleson_Ahat f y`, + REPEAT STRIP_TAC THEN REWRITE_TAC[carleson_Ahat] THEN + MP_TAC(ISPECL + [`{ inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[a,b])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * (f:real->complex)(drop + x))) + | a <= b }`; + `&0:real`; + `B:real`; + `inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[y,y])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * (f:real->complex)(drop + x)))`] + REAL_LE_SUP) THEN + REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN MATCH_MP_TAC THEN + REPEAT CONJ_TAC THENL + [MAP_EVERY EXISTS_TAC [`y:real`; `y:real`] THEN REWRITE_TAC[REAL_LE_REFL]; + MATCH_MP_TAC REAL_LE_MUL THEN + SIMP_TAC[REAL_LE_INV_EQ; NORM_POS_LE; SQRT_POS_LE; REAL_LE_MUL; REAL_POS; + PI_POS_LE; REAL_LT_IMP_LE]; + X_GEN_TAC `w:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[]]);; + +(* --- 286U(a) existence criterion (Fremlin mt286.tex 2960-2975): the *) +(* abstract *) +(* Cauchy test for the improper truncated-integral limit. If the truncated *) +(* integrals II a b (= (1/sqrt2pi) int_[a,b] e^{-ixy}f, but stated *) +(* abstractly) *) +(* are "tail-Cauchy" -- for each e>0 some symmetric window [-N,N] captures *) +(* all *) +(* wider windows within e -- then the symmetric sequence II(-n)(n) *) +(* converges. *) +(* This is exactly Fremlin's "inf_n gamma_n(y)=0 ==> g(y) defined"; pure *) +(* completeness of C (CONVERGENT_EQ_CAUCHY), no dependence on the 286T *) +(* bound. --- *) +let CARLESON_286U_CAUCHY = prove + (`!(II:real->real->complex). + (!e. &0 < e ==> ?N. &0 <= N /\ + !a b. a <= --N /\ N <= b ==> norm(II a b - II (--N) N) <= e) + ==> ?z. ((\n. II (--(&n)) (&n)) --> z) sequentially`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[ISPEC `\n. (II:real->real->complex) (--(&n)) (&n)` + CONVERGENT_EQ_CAUCHY] THEN + REWRITE_TAC[cauchy] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / &3`) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN + `N:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "H"))) THEN + MP_TAC(ISPEC `N:real` REAL_ARCH_SIMPLE) THEN + DISCH_THEN(X_CHOOSE_TAC `M:num`) THEN + EXISTS_TAC `M:num` THEN + MAP_EVERY X_GEN_TAC [`p:num`; `q:num`] THEN REWRITE_TAC[GE] THEN + STRIP_TAC THEN + REWRITE_TAC[] THEN + MP_TAC(ISPECL + [`(II:real->real->complex) (--(&p)) (&p)`; + `(II:real->real->complex) (--(&q)) (&q)`; + `(II:real->real->complex) (--N) N`; `e:real`] + (NORM_ARITH + `!sp sq c e. + &0 < e /\ norm(sp - c) <= e / &3 /\ norm(sq - c) <= e / &3 + ==> dist(sp:complex,sq) < e`)) THEN + ANTS_TAC THENL [ALL_TAC; REWRITE_TAC[]] THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THEN USE_THEN "H" MATCH_MP_TAC THEN + REWRITE_TAC[REAL_LE_NEG2] THEN REPEAT CONJ_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&M:real` THEN + ASM_REWRITE_TAC[REAL_OF_NUM_LE] THEN ASM_ARITH_TAC);; + +(* --- 286U(a) symmetric real limit: the same tail-Cauchy hypothesis gives *) +(* the *) +(* symmetric REAL-parameter net (\a. II(-a) a) -> z at_posinfinity (not just *) +(* the integer sequence). This is the exact shape Fremlin 286V consumes: *) +(* g(y) = lim_{a->inf} (1/sqrt2pi) int_{-a}^a e^{-ixy}. Proof: z from *) +(* CARLESON_ *) +(* 286U_CAUCHY, then for x>=N a 3-eps triangle (window [-x,x] vs [-N,N] vs a *) +(* sequence point n0=K+Mn beyond both K and N) closes dist(II(-x)x,z)real->complex). + (!e. &0 < e ==> ?N. &0 <= N /\ + !a b. a <= --N /\ N <= b ==> norm(II a b - II (--N) N) <= e) + ==> ?z. ((\a. II (--a) a) --> z) at_posinfinity`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(X_CHOOSE_TAC `z:complex` o MATCH_MP CARLESON_286U_CAUCHY) THEN + EXISTS_TAC `z:complex` THEN + REWRITE_TAC[LIM_AT_POSINFINITY] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `e / &3` o check(fun th -> is_forall(concl th))) + THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN + `N:real` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "H"))) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_SEQUENTIALLY]) THEN + DISCH_THEN(MP_TAC o SPEC `e / &3`) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `K:num` (LABEL_TAC "Kseq")) THEN + MP_TAC(ISPEC `N:real` REAL_ARCH_SIMPLE) THEN + DISCH_THEN(X_CHOOSE_TAC `Mn:num`) THEN + EXISTS_TAC `N:real` THEN X_GEN_TAC `x:real` THEN REWRITE_TAC[real_ge] THEN + DISCH_TAC THEN + SUBGOAL_THEN `N <= &(K + Mn)` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&Mn:real` THEN + ASM_REWRITE_TAC[REAL_OF_NUM_LE] THEN ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `dist((II:real->real->complex) (-- &(K+Mn)) (&(K+Mn)),z) < e / &3` + ASSUME_TAC THENL + [USE_THEN "Kseq" (MP_TAC o SPEC `K + Mn:num`) THEN + REWRITE_TAC[LE_ADD] THEN BETA_TAC THEN REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `norm((II:real->real->complex) (--(&(K+Mn))) (&(K+Mn)) - II (--N) N) <= e / + &3` + ASSUME_TAC THENL + [USE_THEN "H" MATCH_MP_TAC THEN ASM_REWRITE_TAC[REAL_LE_NEG2]; ALL_TAC] THEN + SUBGOAL_THEN `norm((II:real->real->complex) (--x) x - II (--N) N) <= e / &3` + ASSUME_TAC THENL + [USE_THEN "H" MATCH_MP_TAC THEN ASM_REWRITE_TAC[REAL_LE_NEG2]; ALL_TAC] THEN + MP_TAC(ISPECL + [`(II:real->real->complex) (--x) x`; + `(II:real->real->complex) (--(&(K+Mn))) (&(K+Mn))`; + `(II:real->real->complex) (--N) N`; `z:complex`; `e:real`] + (NORM_ARITH + `!sx sk c z e. + norm(sx - c) <= e / &3 /\ norm(sk - c) <= e / &3 /\ dist(sk:complex,z) < + e / &3 + ==> dist(sx:complex,z) < e`)) THEN + ASM_REWRITE_TAC[]);; + +(* --- 286V sinc bridge (Fremlin mt286.tex 3078): the Fourier transform of *) +(* the *) +(* truncated exponential h_ax(y) = e^{ixy} chi_[-a,a](y) is the sinc kernel *) +(* hat-h_ax(t) = (1/sqrt2pi) 2 sin((x-t)a)/(x-t). This is the exact factor *) +(* converting = into (2/sqrt2pi) int *) +(* sin((x-t)a)/(x-t)f. *) +(* Reduces the fourier integral over (:real^1) to CEXP_INTERVAL_INTEGRAL via *) +(* INTEGRAL_RESTRICT_UNIV (indicator = interval) after fusing the two *) +(* cexp's. --- *) +let CARLESON_TRUNC_AS_FOURIER = prove + (`!(f:real->complex) a b z. + integral (IMAGE lift (real_interval[a,b])) + (\x. cexp(--(ii * Cx(drop z) * Cx(drop x))) * f(drop x)) = + Cx(sqrt(&2 * pi)) * + fourier (\x. if x IN real_interval[a,b] then (f:real->complex) x else + Cx(&0)) (drop z)`, + REPEAT GEN_TAC THEN REWRITE_TAC[fourier] THEN + SUBGOAL_THEN + `integral (:real^1) + (\x. cexp(--(ii * Cx(drop z) * Cx(drop x))) * + (if drop x IN real_interval[a,b] then (f:real->complex)(drop x) else + Cx(&0))) = + integral (IMAGE lift (real_interval[a,b])) + (\x. cexp(--(ii * Cx(drop z) * Cx(drop x))) * f(drop x))` + ASSUME_TAC THENL + [GEN_REWRITE_TAC (RAND_CONV) [GSYM INTEGRAL_RESTRICT_UNIV] THEN + REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL] THEN MATCH_MP_TAC INTEGRAL_EQ THEN + X_GEN_TAC `w:real^1` THEN DISCH_TAC THEN + REWRITE_TAC[IN_INTERVAL_1; IN_REAL_INTERVAL; LIFT_DROP] THEN + COND_CASES_TAC THEN REWRITE_TAC[COMPLEX_MUL_RZERO; COMPLEX_VEC_0]; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `~(Cx(sqrt(&2 * pi)) = Cx(&0))` MP_TAC THENL + [REWRITE_TAC[CX_INJ] THEN MATCH_MP_TAC REAL_LT_IMP_NZ THEN + MATCH_MP_TAC SQRT_POS_LT THEN MP_TAC PI_POS THEN REAL_ARITH_TAC; + CONV_TAC COMPLEX_FIELD]);; + +let CARLESON_TRUNC_FOURIER_CONTINUOUS = prove + (`!(f:real->complex) a b. + (\z. f(drop z)) absolutely_integrable_on (:real^1) + ==> (\z:real^1. integral (IMAGE lift (real_interval[a,b])) + (\x. cexp(--(ii * Cx(drop z) * Cx(drop x))) * f(drop x))) + continuous_on (:real^1)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[CARLESON_TRUNC_AS_FOURIER] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_LMUL THEN + MATCH_MP_TAC FOURIER_CONTINUOUS_ON THEN + BETA_TAC THEN + SUBGOAL_THEN + `(\z:real^1. if drop z IN real_interval[a,b] then (f:real->complex)(drop z) + else Cx(&0)) = + (\z:real^1. if z IN interval[lift a, lift b] then f(drop z) else vec 0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `w:real^1` THEN + REWRITE_TAC[IN_INTERVAL_1; IN_REAL_INTERVAL; LIFT_DROP; COMPLEX_VEC_0]; + ALL_TAC] THEN + REWRITE_TAC[ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV] THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `(:real^1)` THEN ASM_REWRITE_TAC[SUBSET_UNIV]);; + +(* --- 286T(a) window continuity: each truncated-window modulus *) +(* y |-> inv(sqrt2pi) norm(int_[a,b] e^{-ixy}f) is real-continuous in the *) +(* frequency y (for f absolutely integrable). This is the per-window *) +(* hypothesis *) +(* that REAL_MEASURABLE_ON_SUP_CONTINUOUS needs for Ahat = sup over windows. *) +(* Chain: CARLESON_TRUNC_FOURIER_CONTINUOUS (complex integral continuous in *) +(* y) *) +(* -> lift-norm compose -> real_continuous_atreal; scalar via *) +(* REAL_CONTINUOUS_ *) +(* LMUL. *) +let CARLESON_AHAT_WINDOW_CONTINUOUS = prove + (`!(f:real->complex) a b y. + (\z. f(drop z)) absolutely_integrable_on (:real^1) + ==> (\y. inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[a,b])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * f(drop x)))) + real_continuous atreal y`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_LMUL THEN + REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS_ATREAL; o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_LIFT_NORM_COMPOSE THEN + MP_TAC(ISPECL [`f:real->complex`; `a:real`; `b:real`] + CARLESON_TRUNC_FOURIER_CONTINUOUS) THEN + ASM_REWRITE_TAC[] THEN + SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT; OPEN_UNIV; IN_UNIV]);; + +(* --- 286U(b) gamma_n window-difference continuity: y |-> inv(sqrt2pi) norm *) +(* (int_[a,b] e^{-ixy}f - int_[-n,n] e^{-ixy}f) is real-continuous in y. *) +(* This *) +(* is the per-window hypothesis for gamma_n measurability (gamma_n = sup *) +(* over the *) +(* window-difference family, each continuous). Same chain as CARLESON_AHAT_ *) +(* WINDOW_CONTINUOUS but with CONTINUOUS_SUB on the two truncated integrals. *) +(* --- *) +let CARLESON_AHAT_REINDEX = prove + (`!(f:real->complex) y. + carleson_Ahat f y = + sup { (\p. inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[FST p,SND p])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * f(drop x)))) p + | p IN {p:real#real | FST p <= SND p} }`, + REPEAT GEN_TAC THEN REWRITE_TAC[carleson_Ahat] THEN + AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `w:real` THEN + REWRITE_TAC[EXISTS_IN_GSPEC; IN_ELIM_THM] THEN + EQ_TAC THEN STRIP_TAC THENL + [EXISTS_TAC `(a:real,b:real)` THEN ASM_REWRITE_TAC[FST; SND]; + MAP_EVERY EXISTS_TAC [`FST(p:real#real)`; `SND(p:real#real)`] THEN + ASM_REWRITE_TAC[]]);; + +(* --- 286T(a): the Carleson maximal operator Ahat f is real-measurable, *) +(* given *) +(* it is pointwise bounded above (a.e.-finiteness -- honest per the [0,inf] *) +(* framing: off the null set where Af=+inf, and there the 286T integral *) +(* bound *) +(* supplies finiteness). Assembles CARLESON_AHAT_REINDEX + per-window *) +(* continuity (CARLESON_AHAT_WINDOW_CONTINUOUS) + REAL_MEASURABLE_ON_SUP_ *) +(* CONTINUOUS. --- *) +let CARLESON_AHAT_MEASURABLE = prove + (`!(f:real->complex). + (\z. f(drop z)) absolutely_integrable_on (:real^1) /\ + (!y. ?B. !a b. a <= b + ==> inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[a,b])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * f(drop x))) <= + B) + ==> (carleson_Ahat f) real_measurable_on (:real)`, + GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN + `carleson_Ahat f = + (\y. sup { (\p. inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[FST p,SND p])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * + (f:real->complex)(drop x)))) p + | p IN {p:real#real | FST p <= SND p} })` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + REWRITE_TAC[CARLESON_AHAT_REINDEX]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_MEASURABLE_ON_SUP_CONTINUOUS THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[FORALL_IN_GSPEC] THEN X_GEN_TAC `p:real#real` THEN + DISCH_TAC THEN + X_GEN_TAC `y:real` THEN BETA_TAC THEN + MP_TAC(ISPECL [`f:real->complex`; `FST(p:real#real)`; `SND(p:real#real)`; + `y:real`] + CARLESON_AHAT_WINDOW_CONTINUOUS) THEN + ASM_REWRITE_TAC[]; + X_GEN_TAC `y:real` THEN + FIRST_X_ASSUM(X_CHOOSE_TAC `B:real` o SPEC `y:real`) THEN + EXISTS_TAC `B:real` THEN + REWRITE_TAC[FORALL_IN_GSPEC] THEN X_GEN_TAC `p:real#real` THEN + DISCH_TAC THEN + BETA_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`FST(p:real#real)`; `SND(p:real#real)`] o + check(fun th -> is_forall(concl th) && + can (find_term (fun t -> t = `B:real`)) (concl th))) THEN + ASM_REWRITE_TAC[]; + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + EXISTS_TAC `(&0,&0):real#real` THEN REWRITE_TAC[FST; SND; REAL_LE_REFL]]);; + +(* --- 286U(b) domination atom: each truncated-window modulus is <= Ahat f y *) +(* (given the family bounded above). This is the "each tail is an f_1-window *) +(* <= Ahat f_1" step of Fremlin's gamma_n <= 2 Ahat f_1 (mt286.tex *) +(* 3006-3010). *) +(* Member-<=-sup via REAL_LE_SUP (explicit ISPECL with fresh comprehension *) +(* vars *) +(* a'',b'' to avoid clashing with the goal's a,b). --- *) +let CARLESON_AHAT_WINDOW_LE = prove + (`!(f:real->complex) y a b. + a <= b /\ + (?B. !a' b'. a' <= b' ==> inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[a',b'])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * f(drop x))) <= B) + ==> inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[a,b])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * f(drop x))) + <= carleson_Ahat f y`, + REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[carleson_Ahat] THEN + MP_TAC(ISPECL + [`{ inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[a'',b''])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * (f:real->complex)(drop + x))) + | a'' <= b'' }`; + `inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[a,b])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * (f:real->complex)(drop + x)))`; + `B:real`; + `inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[a,b])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * (f:real->complex)(drop + x)))`] + REAL_LE_SUP) THEN + REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN MATCH_MP_TAC THEN + REPEAT CONJ_TAC THENL + [MAP_EVERY EXISTS_TAC [`a:real`; `b:real`] THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_LE_REFL]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[]]);; + +(* --- 286U(b) difference-of-windows identity: for [-n,n] SUBSET [a,b], the *) +(* gamma_n difference int_[a,b] e^{-ixy}f - int_[-n,n] e^{-ixy}f collapses *) +(* to a *) +(* SINGLE f_1-window integral int_[a,b] e^{-ixy}f_1, where f_1 = f off *) +(* [-n,n], *) +(* 0 on it (Fremlin's f_1 = f - f.chi[-n,n]). Integrand rewrite e*f_1 = e*f *) +(* - *) +(* (chi[-n,n]-restricted e*f) + INTEGRAL_SUB + INTEGRAL_RESTRICT; *) +(* integrability *) +(* via FOURIER_MODULATION_ABSINT (@fourier_inversion.ml) on subintervals. *) +(* --- *) +let carleson_gamma = new_definition + `carleson_gamma (f:real->complex) n y = + sup { inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[a,b])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * f(drop x)) - + integral (IMAGE lift (real_interval[--n,n])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * f(drop x))) + | a,b | a <= --n /\ n <= b }`;; + +(* --- 286U(b) gamma_n measurability: y |-> carleson_gamma f n y is real- *) +(* measurable, given &0<=n and the window-difference family bounded above at *) +(* each y (a.e.-finiteness of gamma_n). LSC route (REAL_MEASURABLE_ON_LSC): *) +(* the *) +(* superlevel set [gamma_n y > c] = UNIONS over window pairs (a,b) of the *) +(* sets *) +(* diff(a,b,y)>c} (SUP_2BAR_SUPERLEVEL), each open (REAL_OPEN_SUPERLEVEL_ *) +(* CONTINUOUS + CARLESON_GAMMA_WINDOW_CONTINUOUS), union open *) +(* (REAL_OPEN_UNIONS). --- *) +let CARLESON_LSPACE2_LOCAL_ABSINT = prove + (`!(f:real->complex) a b. + (\z. f(drop z)) IN lspace (:real^1) (&2) + ==> (\z. f(drop z)) absolutely_integrable_on (IMAGE lift + (real_interval[a,b]))`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[GSYM LSPACE_1] THEN + MATCH_MP_TAC LSPACE_MONO THEN EXISTS_TAC `&2:real` THEN + REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL; MEASURABLE_INTERVAL] THEN + CONJ_TAC THENL + [MATCH_MP_TAC LSPACE_SUBSET THEN EXISTS_TAC `(:real^1)` THEN + ASM_REWRITE_TAC[SUBSET_UNIV; IMAGE_LIFT_REAL_INTERVAL; + LEBESGUE_MEASURABLE_INTERVAL]; + REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL] THEN REAL_ARITH_TAC]);; + +(* L^2 truncated-integral continuity in the frequency y (compact window) *) +let CARLESON_TRUNC_FOURIER_CONTINUOUS_L2 = prove + (`!(f:real->complex) a b. + (\z. f(drop z)) IN lspace (:real^1) (&2) + ==> (\z:real^1. integral (IMAGE lift (real_interval[a,b])) + (\x. cexp(--(ii * Cx(drop z) * Cx(drop x))) * f(drop x))) + continuous_on (:real^1)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[CARLESON_TRUNC_AS_FOURIER] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_LMUL THEN + MATCH_MP_TAC FOURIER_CONTINUOUS_ON THEN + BETA_TAC THEN + SUBGOAL_THEN + `(\z:real^1. if drop z IN real_interval[a,b] then (f:real->complex)(drop z) + else Cx(&0)) = + (\z:real^1. if z IN interval[lift a, lift b] then f(drop z) else vec 0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `w:real^1` THEN + REWRITE_TAC[IN_INTERVAL_1; IN_REAL_INTERVAL; LIFT_DROP; COMPLEX_VEC_0]; + ALL_TAC] THEN + REWRITE_TAC[ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV] THEN + REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL] THEN + MATCH_MP_TAC CARLESON_LSPACE2_LOCAL_ABSINT THEN ASM_REWRITE_TAC[]);; + +(* L^2 gamma_n window-difference continuity *) +let FOURIER_MODULATION_ABSINT_ON = prove + (`!(f:real->complex) d s. + measurable s /\ (\z. f(drop z)) absolutely_integrable_on s + ==> (\y. cexp(--(ii * Cx d * Cx(drop y))) * f(drop y)) + absolutely_integrable_on s`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`( * ):complex->complex->complex`; + `\y:real^1. cexp(--(ii * Cx d * Cx(drop y)))`; + `\y:real^1. (f:real->complex)(drop y)`; `s:real^1->bool`] + ABSOLUTELY_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT) THEN + ASM_REWRITE_TAC[BILINEAR_COMPLEX_MUL] THEN DISCH_THEN MATCH_MP_TAC THEN + CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_ON_MEASURABLE_SUBSET THEN + EXISTS_TAC `(:real^1)` THEN + ASM_REWRITE_TAC[SUBSET_UNIV] THEN + MATCH_MP_TAC CONTINUOUS_IMP_MEASURABLE_ON THEN + SUBGOAL_THEN `(\y:real^1. cexp(--(ii * Cx d * Cx(drop y)))) = + cexp o (\y. --((ii * Cx d) * Cx(drop y)))` + SUBST1_TAC THENL [REWRITE_TAC[o_DEF; COMPLEX_MUL_ASSOC]; ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + REWRITE_TAC[CONTINUOUS_ON_CEXP] THEN + MATCH_MP_TAC CONTINUOUS_ON_NEG THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN + REWRITE_TAC[CONTINUOUS_ON_CONST] THEN + MATCH_MP_TAC CONTINUOUS_ON_CX_DROP THEN + REWRITE_TAC[CONTINUOUS_ON_ID]; + REWRITE_TAC[bounded; FORALL_IN_IMAGE] THEN EXISTS_TAC `&1` THEN + X_GEN_TAC `y:real^1` THEN DISCH_TAC THEN + SUBGOAL_THEN + `--(ii * Cx d * Cx(drop y)) = ii * Cx(--(d * drop y))` SUBST1_TAC THENL + [REWRITE_TAC[CX_NEG; CX_MUL] THEN SIMPLE_COMPLEX_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[NORM_CEXP_II] THEN REAL_ARITH_TAC]);; + +(* L^2 window-difference collapse. *) +let CARLESON_WINDOW_DIFF_L2 = prove + (`!(f:real->complex) y n a b. + a <= --n /\ n <= b /\ + (\z. f(drop z)) IN lspace (:real^1) (&2) + ==> integral (IMAGE lift (real_interval[a,b])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * + (if abs(drop x) <= n then Cx(&0) else f(drop x))) = + integral (IMAGE lift (real_interval[a,b])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * f(drop x)) - + integral (IMAGE lift (real_interval[--n,n])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * f(drop x))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL] THEN + SUBGOAL_THEN + `(\x:real^1. cexp(--(ii * Cx y * Cx(drop x))) * + (if abs(drop x) <= n then Cx(&0) else (f:real->complex)(drop x))) = + (\x:real^1. (\x. cexp(--(ii * Cx y * Cx(drop x))) * f(drop x)) x - + (if x IN interval[lift(--n),lift n] + then (\x. cexp(--(ii * Cx y * Cx(drop x))) * f(drop x)) x else vec + 0))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `w:real^1` THEN + REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP] THEN + REWRITE_TAC[REAL_ARITH `--n <= drop w /\ drop w <= n <=> abs(drop w) <= n`] + THEN + COND_CASES_TAC THEN + REWRITE_TAC[COMPLEX_MUL_RZERO; COMPLEX_SUB_RZERO; COMPLEX_VEC_0] THEN + SIMPLE_COMPLEX_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `(\x:real^1. cexp(--(ii * Cx y * Cx(drop x))) * (f:real->complex)(drop x)) + integrable_on interval[lift a, lift b]` + ASSUME_TAC THENL + [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL] THEN + MATCH_MP_TAC FOURIER_MODULATION_ABSINT_ON THEN + REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL; MEASURABLE_INTERVAL] THEN + REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL] THEN + MATCH_MP_TAC CARLESON_LSPACE2_LOCAL_ABSINT THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `interval[lift(--n),lift n] SUBSET interval[lift a, lift b]` + ASSUME_TAC THENL + [REWRITE_TAC[SUBSET_INTERVAL_1; LIFT_DROP] THEN + ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `(\x:real^1. if x IN interval[lift(--n),lift n] + then cexp(--(ii * Cx y * Cx(drop x))) * (f:real->complex)(drop x) else + vec 0) + integrable_on interval[lift a, lift b]` + ASSUME_TAC THENL + [ASM_SIMP_TAC[INTEGRABLE_RESTRICT] THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL] THEN + MATCH_MP_TAC FOURIER_MODULATION_ABSINT_ON THEN + REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL; MEASURABLE_INTERVAL] THEN + REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL] THEN + MATCH_MP_TAC CARLESON_LSPACE2_LOCAL_ABSINT THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + W(MP_TAC o PART_MATCH (lhs o rand) INTEGRAL_SUB o lhand o snd) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + AP_TERM_TAC THEN MATCH_MP_TAC INTEGRAL_RESTRICT THEN ASM_REWRITE_TAC[]);; + +(* f_1 = f off [-n,n] stays in L^2 (LSPACE_SUB + TRUNC_IN_LSPACE). *) +let CARLESON_TRUNC_LSPACE2 = prove + (`!(f:real->complex) n. + (\z. f(drop z)) IN lspace (:real^1) (&2) + ==> (\z. if abs(drop z) <= n then Cx(&0) else f(drop z)) + IN lspace (:real^1) (&2)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\z:real^1. if abs(drop z) <= n then Cx(&0) else (f:real->complex)(drop z)) + = + (\z:real^1. f(drop z) - + (if z IN interval[lift(--n),lift n] then f(drop z) else vec 0))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `w:real^1` THEN + REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; + REAL_ARITH `--n <= drop w /\ drop w <= n <=> abs(drop w) <= n`] THEN + COND_CASES_TAC THEN + REWRITE_TAC[COMPLEX_SUB_RZERO; COMPLEX_VEC_0] THEN CONV_TAC COMPLEX_RING; + ALL_TAC] THEN + MATCH_MP_TAC LSPACE_SUB THEN ASM_REWRITE_TAC[REAL_POS] THEN + MATCH_MP_TAC TRUNC_IN_LSPACE THEN + ASM_REWRITE_TAC[REAL_ARITH `&0 < &2`; LEBESGUE_MEASURABLE_INTERVAL]);; + +(* L^2 gamma_n <= Ahat f_1 (sup over the window differences). *) +let GAMMA_N_LE_AHAT_L2 = prove + (`!(f:real->complex) y n. + (\z. f(drop z)) IN lspace (:real^1) (&2) /\ &0 <= n /\ + (?B. !a b. a <= b ==> inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[a,b])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * + (if abs(drop x) <= n then Cx(&0) else f(drop x)))) <= + B) + ==> sup { inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[a,b])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * f(drop x)) - + integral (IMAGE lift (real_interval[--n,n])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * f(drop x))) + | a,b | a <= --n /\ n <= b } + <= carleson_Ahat (\t. if abs t <= n then Cx(&0) else f t) y`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_TAC `B:real`))) THEN + MATCH_MP_TAC REAL_SUP_LE THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + EXISTS_TAC + `inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[--n,n])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * (f:real->complex)(drop x)) + - + integral (IMAGE lift (real_interval[--n,n])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * f(drop x)))` THEN + REWRITE_TAC[IN_ELIM_THM] THEN + MAP_EVERY EXISTS_TAC [`--n:real`; `n:real`] THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[IN_ELIM_THM] THEN + X_GEN_TAC `w:real` THEN + DISCH_THEN(X_CHOOSE_THEN `a:real` (X_CHOOSE_THEN + `b:real` STRIP_ASSUME_TAC)) THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`f:real->complex`; `y:real`; `n:real`; `a:real`; `b:real`] + CARLESON_WINDOW_DIFF_L2) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + MP_TAC(ISPECL + [`\t. if abs t <= n then Cx(&0) else (f:real->complex) t`; + `y:real`; `a:real`; `b:real`] CARLESON_AHAT_WINDOW_LE) THEN + REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; + EXISTS_TAC `B:real` THEN ASM_REWRITE_TAC[]]]);; + +(* L^2 carleson_gamma <= Ahat f_1 (named form). *) +let CARLESON_GAMMA_LE_AHAT_L2 = prove + (`!(f:real->complex) y n. + (\z. f(drop z)) IN lspace (:real^1) (&2) /\ &0 <= n /\ + (?B. !a b. a <= b ==> inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[a,b])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * + (if abs(drop x) <= n then Cx(&0) else f(drop x)))) <= + B) + ==> carleson_gamma f n y + <= carleson_Ahat (\t. if abs t <= n then Cx(&0) else f t) y`, + REPEAT GEN_TAC THEN REWRITE_TAC[carleson_gamma] THEN + MATCH_ACCEPT_TAC GAMMA_N_LE_AHAT_L2);; + +(* L^2 lower bound e*muF <= int_F Ahat f_1 (Chebyshev via the pointwise *) +(* bound). *) +let carleson_Ahat_trunc = new_definition + `carleson_Ahat_trunc (f:real->complex) (n:real) (y:real) = + sup { inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[a,b])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * f(drop x))) + | a,b | --n <= a /\ a <= b /\ b <= n }`;; + +(* Each compact window integral (|y|-modulated) is bounded in norm by the *) +(* full-interval integral of |f| (cexp unimodular + monotonicity of int|.|). *) +let CARLESON_TRUNC_WINDOW_LE_INT = prove + (`!(f:real->complex) n y a b. + --n <= a /\ a <= b /\ b <= n /\ + (\z. f(drop z)) absolutely_integrable_on (IMAGE lift + (real_interval[--n,n])) + ==> norm(integral (IMAGE lift (real_interval[a,b])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * f(drop x))) + <= drop(integral (IMAGE lift (real_interval[--n,n])) (\x. + lift(norm(f(drop x)))))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\z. (f:real->complex)(drop z)) absolutely_integrable_on + (IMAGE lift (real_interval[a,b]))` + ASSUME_TAC THENL + [REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL] THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `IMAGE lift (real_interval[--n,n])` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL; SUBSET_INTERVAL_1; LIFT_DROP] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `drop(integral (IMAGE lift (real_interval[a,b])) (\x. + lift(norm((f:real->complex)(drop x)))))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC FOURIER_MODULATION_ABSINT_ON THEN + ASM_REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL; MEASURABLE_INTERVAL]; + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN ASM_REWRITE_TAC[]; + X_GEN_TAC `w:real^1` THEN DISCH_TAC THEN + REWRITE_TAC[LIFT_DROP; COMPLEX_NORM_MUL] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&1 * norm((f:real->complex)(drop w))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN + SUBGOAL_THEN + `--(ii * Cx y * Cx(drop w)) = + ii * Cx(--(y * drop w))` SUBST1_TAC THENL + [REWRITE_TAC[CX_NEG; CX_MUL] THEN + SIMPLE_COMPLEX_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[NORM_CEXP_II] THEN REAL_ARITH_TAC; + REWRITE_TAC[REAL_MUL_LID; REAL_LE_REFL]]]; + MATCH_MP_TAC INTEGRAL_SUBSET_DROP_LE THEN + REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL] THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[SUBSET_INTERVAL_1; LIFT_DROP] THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN + ASM_REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL]; + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN + ASM_REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL]; + X_GEN_TAC `w:real^1` THEN DISCH_TAC THEN + REWRITE_TAC[LIFT_DROP; NORM_POS_LE]]]);; + +(* Ahat_n f is a genuine finite sup: bounded above by (1/sqrt2pi) *) +(* int_[-n,n]|f|, *) +(* UNCONDITIONALLY (only f loc-L^1 on [-n,n]). No ?B / a.e.-finiteness *) +(* needed. *) +let CARLESON_AHAT_TRUNC_FINITE = prove + (`!(f:real->complex) n y. + &0 <= n /\ + (\z. f(drop z)) absolutely_integrable_on (IMAGE lift + (real_interval[--n,n])) + ==> carleson_Ahat_trunc f n y + <= inv(sqrt(&2 * pi)) * + drop(integral (IMAGE lift (real_interval[--n,n])) (\x. + lift(norm(f(drop x)))))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[carleson_Ahat_trunc] THEN + MATCH_MP_TAC REAL_SUP_LE THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + MAP_EVERY EXISTS_TAC + [`inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[--n,n])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * (f:real->complex)(drop + x)))`; + `--n:real`; `n:real`] THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[IN_ELIM_THM] THEN X_GEN_TAC `w:real` THEN + DISCH_THEN(X_CHOOSE_THEN `a:real` (X_CHOOSE_THEN + `b:real` STRIP_ASSUME_TAC)) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INV THEN MATCH_MP_TAC SQRT_POS_LE THEN + MP_TAC PI_POS THEN REAL_ARITH_TAC; + MATCH_MP_TAC CARLESON_TRUNC_WINDOW_LE_INT THEN ASM_REWRITE_TAC[]]]);; + +(* Per-window L^2 continuity in y (single compact window [a,b]): the norm of *) +(* the *) +(* truncated modulated integral is real-continuous. = CARLESON_AHAT_WINDOW_ *) +(* CONTINUOUS but under the L^2 hypothesis (via _CONTINUOUS_L2). *) +let CARLESON_AHAT_WINDOW_CONTINUOUS_L2 = prove + (`!(f:real->complex) a b y. + (\z. f(drop z)) IN lspace (:real^1) (&2) + ==> (\y. inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[a,b])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * f(drop x)))) + real_continuous atreal y`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_LMUL THEN + REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS_ATREAL; o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_LIFT_NORM_COMPOSE THEN + MP_TAC(ISPECL [`f:real->complex`; `a:real`; `b:real`] + CARLESON_TRUNC_FOURIER_CONTINUOUS_L2) THEN + ASM_REWRITE_TAC[] THEN + SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT; OPEN_UNIV; IN_UNIV]);; + +(* Ahat_n f is real-measurable in y, UNCONDITIONALLY (LSC route: the *) +(* compact-range sup of continuous window-moduli; bounded above by *) +(* TRUNC_WINDOW_LE_INT so the sup is genuine, no ?B hypothesis). *) +let CARLESON_AHAT_TRUNC_MEASURABLE = prove + (`!(f:real->complex) n. + &0 <= n /\ + (\z. f(drop z)) IN lspace (:real^1) (&2) + ==> (\y. carleson_Ahat_trunc f n y) real_measurable_on (:real)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN + `(\z. (f:real->complex)(drop z)) absolutely_integrable_on + (IMAGE lift (real_interval[--n,n]))` + ASSUME_TAC THENL + [MATCH_MP_TAC CARLESON_LSPACE2_LOCAL_ABSINT THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC REAL_MEASURABLE_ON_LSC THEN + X_GEN_TAC `c:real` THEN REWRITE_TAC[carleson_Ahat_trunc] THEN + SUBGOAL_THEN + `{y | sup { inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[a,b])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * + (f:real->complex)(drop x))) + | a,b | --n <= a /\ a <= b /\ b <= n } > c} = + UNIONS { {y | inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[a,b])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * + (f:real->complex)(drop x))) > c} + | a,b | --n <= a /\ a <= b /\ b <= n }` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_UNIONS; IN_ELIM_THM] THEN X_GEN_TAC `y:real` THEN + REWRITE_TAC[real_gt] THEN + MP_TAC(ISPECL + [`\a b. inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[a,b])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * + (f:real->complex)(drop x)))`; + `\a b. --n <= a /\ a <= b /\ b <= n`; `c:real`] SUP_2BAR_SUPERLEVEL) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [CONJ_TAC THENL + [MAP_EVERY EXISTS_TAC [`--n:real`; `n:real`] THEN ASM_REAL_ARITH_TAC; + EXISTS_TAC + `inv(sqrt(&2 * pi)) * + drop(integral (IMAGE lift (real_interval[--n,n])) (\x. + lift(norm((f:real->complex)(drop x)))))` THEN + MAP_EVERY X_GEN_TAC [`a:real`; `b:real`] THEN STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INV THEN MATCH_MP_TAC SQRT_POS_LE THEN + MP_TAC PI_POS THEN REAL_ARITH_TAC; + MATCH_MP_TAC CARLESON_TRUNC_WINDOW_LE_INT THEN ASM_REWRITE_TAC[]]]; + DISCH_THEN SUBST1_TAC] THEN + EQ_TAC THENL + [DISCH_THEN(X_CHOOSE_THEN `a:real` (X_CHOOSE_THEN + `b:real` STRIP_ASSUME_TAC)) THEN + EXISTS_TAC + `{u | c < inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[a,b])) + (\x. cexp(--(ii * Cx u * Cx(drop x))) * + (f:real->complex)(drop x)))}` THEN + CONJ_TAC THENL + [MAP_EVERY EXISTS_TAC [`a:real`; `b:real`] THEN + ASM_REWRITE_TAC[IN_ELIM_THM]; + ASM_REWRITE_TAC[IN_ELIM_THM]]; + DISCH_THEN(X_CHOOSE_THEN `t:real->bool` STRIP_ASSUME_TAC) THEN + MAP_EVERY EXISTS_TAC [`a:real`; `b:real`] THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[]]; + MATCH_MP_TAC REAL_OPEN_UNIONS THEN + REWRITE_TAC[IN_ELIM_THM] THEN X_GEN_TAC `s:real->bool` THEN + DISCH_THEN(X_CHOOSE_THEN `a:real` (X_CHOOSE_THEN `b:real` (CONJUNCTS_THEN2 + ASSUME_TAC SUBST1_TAC))) THEN + MATCH_MP_TAC REAL_OPEN_SUPERLEVEL_CONTINUOUS THEN + GEN_TAC THEN MATCH_MP_TAC CARLESON_AHAT_WINDOW_CONTINUOUS_L2 THEN + ASM_REWRITE_TAC[]]);; + +(* Ahat_n f y >= 0 (the [-n,n] window member is >= 0 and witnesses the sup). *) +let CARLESON_AHAT_TRUNC_POS = prove + (`!(f:real->complex) n y. + &0 <= n /\ (\z. f(drop z)) IN lspace (:real^1) (&2) + ==> &0 <= carleson_Ahat_trunc f n y`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\z. (f:real->complex)(drop z)) absolutely_integrable_on + (IMAGE lift (real_interval[--n,n]))` + ASSUME_TAC THENL + [MATCH_MP_TAC CARLESON_LSPACE2_LOCAL_ABSINT THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[carleson_Ahat_trunc] THEN + MP_TAC(ISPECL + [`{ inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[a,b])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * (f:real->complex)(drop + x))) + | a,b | --n <= a /\ a <= b /\ b <= n }`; + `&0:real`; + `inv(sqrt(&2 * pi)) * + drop(integral (IMAGE lift (real_interval[--n,n])) (\x. + lift(norm((f:real->complex)(drop x)))))`; + `inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[--n,n])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * (f:real->complex)(drop + x)))`] + REAL_LE_SUP) THEN + REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN MATCH_MP_TAC THEN + REPEAT CONJ_TAC THENL + [MAP_EVERY EXISTS_TAC [`--n:real`; `n:real`] THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LE_MUL THEN + SIMP_TAC[REAL_LE_INV_EQ; NORM_POS_LE; SQRT_POS_LE; REAL_LE_MUL; REAL_POS; + PI_POS_LE; REAL_LT_IMP_LE]; + X_GEN_TAC `w:real` THEN + DISCH_THEN(X_CHOOSE_THEN `a:real` (X_CHOOSE_THEN + `b:real` STRIP_ASSUME_TAC)) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INV THEN MATCH_MP_TAC SQRT_POS_LE THEN + MP_TAC PI_POS THEN REAL_ARITH_TAC; + MATCH_MP_TAC CARLESON_TRUNC_WINDOW_LE_INT THEN ASM_REWRITE_TAC[]]]);; + +(* Ahat_n f is increasing in n: the window range [-m,m] sits inside [-n,n] *) +(* (m<=n), so the Ahat_m sup-set is a subset of the Ahat_n sup-set. *) +let CARLESON_AHAT_TRUNC_MONO = prove + (`!(f:real->complex) m n y. + &0 <= m /\ m <= n /\ (\z. f(drop z)) IN lspace (:real^1) (&2) + ==> carleson_Ahat_trunc f m y <= carleson_Ahat_trunc f n y`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\z. (f:real->complex)(drop z)) absolutely_integrable_on + (IMAGE lift (real_interval[--n,n]))` + ASSUME_TAC THENL + [MATCH_MP_TAC CARLESON_LSPACE2_LOCAL_ABSINT THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[carleson_Ahat_trunc] THEN + MATCH_MP_TAC REAL_SUP_LE THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + MAP_EVERY EXISTS_TAC + [`inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[--m,m])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * (f:real->complex)(drop + x)))`; + `--m:real`; `m:real`] THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[IN_ELIM_THM] THEN X_GEN_TAC `w:real` THEN + DISCH_THEN(X_CHOOSE_THEN `a:real` (X_CHOOSE_THEN + `b:real` STRIP_ASSUME_TAC)) THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL + [`{ inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[a',b'])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * (f:real->complex)(drop + x))) + | a',b' | --n <= a' /\ a' <= b' /\ b' <= n }`; + `inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[a,b])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * (f:real->complex)(drop + x)))`; + `inv(sqrt(&2 * pi)) * + drop(integral (IMAGE lift (real_interval[--n,n])) (\x. + lift(norm((f:real->complex)(drop x)))))`; + `inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[a,b])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * (f:real->complex)(drop + x)))`] + REAL_LE_SUP) THEN + REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN MATCH_MP_TAC THEN + REPEAT CONJ_TAC THENL + [MAP_EVERY EXISTS_TAC [`a:real`; `b:real`] THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[REAL_LE_REFL]; + X_GEN_TAC `w':real` THEN + DISCH_THEN(X_CHOOSE_THEN `a2:real` (X_CHOOSE_THEN + `b2:real` STRIP_ASSUME_TAC)) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INV THEN MATCH_MP_TAC SQRT_POS_LE THEN + MP_TAC PI_POS THEN REAL_ARITH_TAC; + MATCH_MP_TAC CARLESON_TRUNC_WINDOW_LE_INT THEN ASM_REWRITE_TAC[]]]]);; + +(* L^2 norm of the constant function 1 on a compact interval = sqrt(length). *) +let LNORM2_CONST1 = prove + (`!a b. a <= b + ==> lnorm (IMAGE lift (real_interval[a,b])) (&2) (\z:real^1. Cx(&1)) = + sqrt(b - a)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[lnorm] THEN + REWRITE_TAC[COMPLEX_NORM_CX; REAL_ABS_NUM] THEN + REWRITE_TAC[RPOW_ONE; LIFT_NUM] THEN + SUBGOAL_THEN + `integral (IMAGE lift (real_interval[a,b])) (\x:real^1. vec 1:real^1) = + lift(b - a)` + SUBST1_TAC THENL + [REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL; INTEGRAL_CONST] THEN + ASM_SIMP_TAC[CONTENT_1; LIFT_DROP] THEN + REWRITE_TAC[GSYM LIFT_NUM; GSYM LIFT_CMUL; REAL_MUL_RID]; + REWRITE_TAC[LIFT_DROP] THEN + SUBGOAL_THEN `inv(&2) = &1 / &2` SUBST1_TAC THENL + [REAL_ARITH_TAC; + MATCH_MP_TAC RPOW_SQRT THEN ASM_REAL_ARITH_TAC]]);; + +(* --- 286T(c) Cauchy-Schwarz window bound (Fremlin 2933): the modulated *) +(* window *) +(* integral over a compact [a,b] is <= sqrt(b-a) * ||g||_{L^2[a,b]}. Route: *) +(* norm(int_[a,b] e^{-ixy}g) <= int_[a,b]|g| (cexp unimodular; *) +(* INTEGRAL_NORM_BOUND) *) +(* = int_[a,b] |1|*|g| <= ||1||_{L^2} ||g||_{L^2} (HOELDER p=q=2), *) +(* ||1||=sqrt(b-a). *) +let CARLESON_WINDOW_CAUCHY_SCHWARZ = prove + (`!(g:real->complex) a b y. + a <= b /\ (\z. g(drop z)) IN lspace (:real^1) (&2) + ==> norm(integral (IMAGE lift (real_interval[a,b])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * g(drop x))) + <= sqrt(b - a) * + lnorm (IMAGE lift (real_interval[a,b])) (&2) (\z. g(drop z))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\z. (g:real->complex)(drop z)) IN lspace (IMAGE lift (real_interval[a,b])) + (&2)` + ASSUME_TAC THENL + [MATCH_MP_TAC LSPACE_SUBSET THEN EXISTS_TAC `(:real^1)` THEN + ASM_REWRITE_TAC[SUBSET_UNIV; IMAGE_LIFT_REAL_INTERVAL; + LEBESGUE_MEASURABLE_INTERVAL]; + ALL_TAC] THEN + SUBGOAL_THEN + `(\z. (g:real->complex)(drop z)) absolutely_integrable_on (IMAGE lift + (real_interval[a,b]))` + ASSUME_TAC THENL + [MATCH_MP_TAC CARLESON_LSPACE2_LOCAL_ABSINT THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `drop(integral (IMAGE lift (real_interval[a,b])) + (\x. lift(norm((g:real->complex)(drop x)))))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `drop(integral (IMAGE lift (real_interval[a,b])) + (\x. lift(norm(cexp(--(ii * Cx y * Cx(drop x))) * + (g:real->complex)(drop x)))))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC FOURIER_MODULATION_ABSINT_ON THEN + ASM_REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL; MEASURABLE_INTERVAL]; + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN + MATCH_MP_TAC FOURIER_MODULATION_ABSINT_ON THEN + ASM_REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL; MEASURABLE_INTERVAL]; + REWRITE_TAC[LIFT_DROP; REAL_LE_REFL]]; + MATCH_MP_TAC REAL_EQ_IMP_LE THEN AP_TERM_TAC THEN + MATCH_MP_TAC INTEGRAL_EQ THEN X_GEN_TAC `w:real^1` THEN DISCH_TAC THEN + REWRITE_TAC[COMPLEX_NORM_MUL] THEN + SUBGOAL_THEN + `--(ii * Cx y * Cx(drop w)) = ii * Cx(--(y * drop w))` SUBST1_TAC THENL + [REWRITE_TAC[CX_NEG; CX_MUL] THEN + SIMPLE_COMPLEX_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[NORM_CEXP_II; REAL_MUL_LID]]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`IMAGE lift (real_interval[a,b])`; `&2:real`; `&2:real`; + `\z:real^1. Cx(&1)`; `\z:real^1. (g:real->complex)(drop z)`] + HOELDER_INEQUALITY) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[REAL_ARITH `&0 < &2`] THEN + CONJ_TAC THENL [CONV_TAC REAL_FIELD; ALL_TAC] THEN + MATCH_MP_TAC LSPACE_CONST THEN + REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL; MEASURABLE_INTERVAL]; + ALL_TAC] THEN + REWRITE_TAC[COMPLEX_NORM_CX; REAL_ABS_NUM; REAL_MUL_LID] THEN + ASM_SIMP_TAC[LNORM2_CONST1]);; + +(* L^2 norm on a compact subinterval is <= the L^2 norm on all of R *) +(* (int_[a,b]|g|^2 <= int_R|g|^2, INTEGRAL_SUBSET_DROP_LE, then rpow *) +(* monotone). *) +let LNORM2_SUBSET_UNIV = prove + (`!(g:real->complex) a b. + a <= b /\ (\z. g(drop z)) IN lspace (:real^1) (&2) + ==> lnorm (IMAGE lift (real_interval[a,b])) (&2) (\z. g(drop z)) + <= lnorm (:real^1) (&2) (\z. g(drop z))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\z. (g:real->complex)(drop z)) IN lspace (IMAGE lift (real_interval[a,b])) + (&2)` + ASSUME_TAC THENL + [MATCH_MP_TAC LSPACE_SUBSET THEN EXISTS_TAC `(:real^1)` THEN + ASM_REWRITE_TAC[SUBSET_UNIV; IMAGE_LIFT_REAL_INTERVAL; + LEBESGUE_MEASURABLE_INTERVAL]; + ALL_TAC] THEN + SUBGOAL_THEN + `(\x:real^1. lift(norm((g:real->complex)(drop x)) rpow (&2))) integrable_on + (IMAGE lift (real_interval[a,b]))` + ASSUME_TAC THENL + [MP_TAC(SPEC_ALL(MATCH_MP LSPACE_IMP_INTEGRABLE + (ASSUME `(\z. (g:real->complex)(drop z)) IN lspace (IMAGE lift + (real_interval[a,b])) (&2)`))) THEN + REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `(\x:real^1. lift(norm((g:real->complex)(drop x)) rpow (&2))) integrable_on + (:real^1)` + ASSUME_TAC THENL + [MP_TAC(SPEC_ALL(MATCH_MP LSPACE_IMP_INTEGRABLE + (ASSUME `(\z. (g:real->complex)(drop z)) IN lspace (:real^1) (&2)`))) + THEN + REWRITE_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[lnorm] THEN + MATCH_MP_TAC RPOW_LE2 THEN + REWRITE_TAC[REAL_LE_INV_EQ; REAL_POS] THEN CONJ_TAC THENL + [MATCH_MP_TAC INTEGRAL_DROP_POS THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[LIFT_DROP] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC RPOW_POS_LE THEN REWRITE_TAC[NORM_POS_LE]; + MATCH_MP_TAC INTEGRAL_SUBSET_DROP_LE THEN + ASM_REWRITE_TAC[SUBSET_UNIV] THEN + REWRITE_TAC[LIFT_DROP] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC RPOW_POS_LE THEN REWRITE_TAC[NORM_POS_LE]]);; + +(* --- 286T(c) test-function comparison (Fremlin 2933-2934): Ahat_n f <= *) +(* Ahat_n h *) +(* + (sqrt(2n)/sqrt2pi) ||f-h||_2. Split each window integral f = h + (f-h) *) +(* (INTEGRAL_ADD), NORM_TRIANGLE; the h-part <= Ahat_n h (member <= sup), *) +(* the *) +(* (f-h)-part <= sqrt(b-a) ||f-h||_{L^2[a,b]} <= sqrt(2n) ||f-h||_{L^2(R)} *) +(* [CARLESON_WINDOW_CAUCHY_SCHWARZ + sqrt(b-a)<=sqrt(2n) + *) +(* LNORM2_SUBSET_UNIV]. --- *) +let CARLESON_AHAT_TRUNC_SUB_BOUND = prove + (`!(f:real->complex) h n y. + &0 <= n /\ (\z. f(drop z)) IN lspace (:real^1) (&2) /\ + (\z. h(drop z)) IN lspace (:real^1) (&2) + ==> carleson_Ahat_trunc f n y + <= carleson_Ahat_trunc h n y + + inv(sqrt(&2 * pi)) * sqrt(&2 * n) * lnorm (:real^1) (&2) (\z. + f(drop z) - h(drop z))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\z. (f:real->complex)(drop z) - h(drop z)) IN lspace (:real^1) (&2)` + ASSUME_TAC THENL + [MATCH_MP_TAC LSPACE_SUB THEN ASM_REWRITE_TAC[REAL_POS]; ALL_TAC] THEN + REWRITE_TAC[carleson_Ahat_trunc] THEN + MATCH_MP_TAC REAL_SUP_LE THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + MAP_EVERY EXISTS_TAC + [`inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[--n,n])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * (f:real->complex)(drop + x)))`; + `--n:real`; `n:real`] THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[IN_ELIM_THM] THEN X_GEN_TAC `w:real` THEN + DISCH_THEN(X_CHOOSE_THEN `a:real` (X_CHOOSE_THEN + `b:real` STRIP_ASSUME_TAC)) THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `integral (IMAGE lift (real_interval[a,b])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * (f:real->complex)(drop x)) = + integral (IMAGE lift (real_interval[a,b])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * h(drop x)) + + integral (IMAGE lift (real_interval[a,b])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * (f(drop x) - h(drop x)))` + SUBST1_TAC THENL + [SUBGOAL_THEN + `(\x. cexp(--(ii * Cx y * Cx(drop x))) * (f:real->complex)(drop x)) = + (\x. cexp(--(ii * Cx y * Cx(drop x))) * h(drop x) + + cexp(--(ii * Cx y * Cx(drop x))) * (f(drop x) - h(drop x)))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + CONV_TAC COMPLEX_RING; ALL_TAC] THEN + MATCH_MP_TAC INTEGRAL_ADD THEN CONJ_TAC THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC FOURIER_MODULATION_ABSINT_ON THEN + REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL; MEASURABLE_INTERVAL] THEN + REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL] THEN + MATCH_MP_TAC CARLESON_LSPACE2_LOCAL_ABSINT THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `inv(sqrt(&2 * pi)) * + (norm(integral (IMAGE lift (real_interval[a,b])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * (h:real->complex)(drop + x))) + + norm(integral (IMAGE lift (real_interval[a,b])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * (f(drop x) - h(drop + x)))))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INV THEN MATCH_MP_TAC SQRT_POS_LE THEN + MP_TAC PI_POS THEN REAL_ARITH_TAC; + REWRITE_TAC[NORM_TRIANGLE]]; + ALL_TAC] THEN + REWRITE_TAC[REAL_ADD_LDISTRIB] THEN MATCH_MP_TAC REAL_LE_ADD2 THEN + CONJ_TAC THENL + [REWRITE_TAC[carleson_Ahat_trunc] THEN + MP_TAC(ISPECL + [`{ inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[a',b'])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * + (h:real->complex)(drop x))) + | a',b' | --n <= a' /\ a' <= b' /\ b' <= n }`; + `inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[a,b])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * (h:real->complex)(drop + x)))`; + `inv(sqrt(&2 * pi)) * + drop(integral (IMAGE lift (real_interval[--n,n])) (\x. + lift(norm((h:real->complex)(drop x)))))`; + `inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[a,b])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * (h:real->complex)(drop + x)))`] + REAL_LE_SUP) THEN + REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN MATCH_MP_TAC THEN + REPEAT CONJ_TAC THENL + [MAP_EVERY EXISTS_TAC [`a:real`; `b:real`] THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_LE_REFL]; + X_GEN_TAC `v:real` THEN + DISCH_THEN(X_CHOOSE_THEN `a2:real` (X_CHOOSE_THEN + `b2:real` STRIP_ASSUME_TAC)) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INV THEN MATCH_MP_TAC SQRT_POS_LE THEN + MP_TAC PI_POS THEN REAL_ARITH_TAC; + MATCH_MP_TAC CARLESON_TRUNC_WINDOW_LE_INT THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC CARLESON_LSPACE2_LOCAL_ABSINT THEN ASM_REWRITE_TAC[]]]; + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INV THEN MATCH_MP_TAC SQRT_POS_LE THEN + MP_TAC PI_POS THEN REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sqrt(b - a) * + lnorm (IMAGE lift (real_interval[a,b])) (&2) (\z. + (f:real->complex)(drop z) - h(drop z))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC CARLESON_WINDOW_CAUCHY_SCHWARZ THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LE_MUL2 THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC SQRT_POS_LE THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC SQRT_MONO_LE THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC LNORM_POS_LE THEN MATCH_MP_TAC LSPACE_SUBSET THEN + EXISTS_TAC `(:real^1)` THEN + ASM_REWRITE_TAC[SUBSET_UNIV; IMAGE_LIFT_REAL_INTERVAL; + LEBESGUE_MEASURABLE_INTERVAL]; + MATCH_MP_TAC LNORM2_SUBSET_UNIV THEN ASM_REWRITE_TAC[]]]]]);; + +(* --- 286T(c) n->infinity link: Ahat_n f <= Ahat f (compact window range is *) +(* a *) +(* subset of all windows), UNDER the untruncated-family-bounded hyp (so Ahat *) +(* f is *) +(* a genuine sup). Member<=sup twice. --- *) +let CARLESON_AHAT_TRUNC_LE = prove + (`!(f:real->complex) n y. + &0 <= n /\ + (?B. !a b. a <= b ==> inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[a,b])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * f(drop x))) <= B) + ==> carleson_Ahat_trunc f n y <= carleson_Ahat f y`, + REPEAT STRIP_TAC THEN REWRITE_TAC[carleson_Ahat_trunc] THEN + MATCH_MP_TAC REAL_SUP_LE THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + MAP_EVERY EXISTS_TAC + [`inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[--n,n])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * (f:real->complex)(drop + x)))`; + `--n:real`; `n:real`] THEN + REWRITE_TAC[REAL_LE_REFL] THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[IN_ELIM_THM] THEN X_GEN_TAC `w:real` THEN + DISCH_THEN(X_CHOOSE_THEN `a:real` (X_CHOOSE_THEN + `b:real` STRIP_ASSUME_TAC)) THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[carleson_Ahat] THEN + MP_TAC(ISPECL + [`{ inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[a',b'])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * (f:real->complex)(drop + x))) + | a',b' | a' <= b' }`; + `inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[a,b])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * (f:real->complex)(drop + x)))`; + `B:real`; + `inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[a,b])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * (f:real->complex)(drop + x)))`] + REAL_LE_SUP) THEN + REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN MATCH_MP_TAC THEN + REPEAT CONJ_TAC THENL + [MAP_EVERY EXISTS_TAC [`a:real`; `b:real`] THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[REAL_LE_REFL]; + X_GEN_TAC `v:real` THEN + DISCH_THEN(X_CHOOSE_THEN `a2:real` (X_CHOOSE_THEN + `b2:real` STRIP_ASSUME_TAC)) THEN + ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[]]]);; + +(* --- 286T(c) monotone-convergence bridge: Ahat_m f y -> Ahat f y as m->inf *) +(* (m in N). Given the untruncated family bounded (Ahat f genuine sup): for *) +(* e>0 *) +(* SUP_APPROACH gives a window [a,b] with term > Ahat f - e/2; that window *) +(* sits in *) +(* [-m,m] for m >= max(|a|,|b|) (REAL_ARCH_SIMPLE), so Ahat_m f >= term > *) +(* Ahat f - *) +(* e/2, and Ahat_m f <= Ahat f (CARLESON_AHAT_TRUNC_LE); hence |Ahat_m f - *) +(* Ahat f| *) +(* <= e/2 < e. --- *) +let CARLESON_AHAT_TRUNC_SUP = prove + (`!(f:real->complex) y. + (?B. !a b. a <= b ==> inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[a,b])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * f(drop x))) <= B) + ==> ((\m. carleson_Ahat_trunc f (&m) y) ---> carleson_Ahat f y) + sequentially`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(ISPECL + [`{ inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[a,b])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * (f:real->complex)(drop + x))) + | a,b | a <= b }`; `carleson_Ahat f y - e / &2`] SUP_APPROACH) THEN + REWRITE_TAC[GSYM carleson_Ahat] THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + MAP_EVERY EXISTS_TAC + [`inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[y,y])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * (f:real->complex)(drop + x)))`; + `y:real`; `y:real`] THEN REWRITE_TAC[REAL_LE_REFL]; + EXISTS_TAC `B:real` THEN + REWRITE_TAC[IN_ELIM_THM; LEFT_IMP_EXISTS_THM] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[]; + ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + REWRITE_TAC[IN_ELIM_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `w0:real` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM SUBST_ALL_TAC THEN + MP_TAC(SPEC `max (abs a) (abs b)` REAL_ARCH_SIMPLE) THEN + DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `N:num` THEN + X_GEN_TAC `m:num` THEN DISCH_TAC THEN + SUBGOAL_THEN `&N:real <= &m` ASSUME_TAC THENL + [ASM_REWRITE_TAC[REAL_OF_NUM_LE]; ALL_TAC] THEN + SUBGOAL_THEN + `&0 <= &m /\ --(&m) <= a /\ a <= b /\ b <= &m` STRIP_ASSUME_TAC THENL + [REPEAT CONJ_TAC THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[a,b])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * (f:real->complex)(drop x))) + <= carleson_Ahat_trunc f (&m) y` + ASSUME_TAC THENL + [REWRITE_TAC[carleson_Ahat_trunc] THEN + MP_TAC(ISPECL + [`{ inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[a',b'])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * (f:real->complex)(drop + x))) + | a',b' | --(&m) <= a' /\ a' <= b' /\ b' <= &m }`; + `inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[a,b])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * (f:real->complex)(drop + x)))`; + `B:real`; + `inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[a,b])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * (f:real->complex)(drop + x)))`] + REAL_LE_SUP) THEN + REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN MATCH_MP_TAC THEN + REPEAT CONJ_TAC THENL + [MAP_EVERY EXISTS_TAC [`a:real`; `b:real`] THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_LE_REFL]; + X_GEN_TAC `v:real` THEN + DISCH_THEN(X_CHOOSE_THEN `a2:real` (X_CHOOSE_THEN + `b2:real` STRIP_ASSUME_TAC)) THEN + ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN + `carleson_Ahat_trunc f (&m) y <= carleson_Ahat f y` ASSUME_TAC THENL + [MATCH_MP_TAC CARLESON_AHAT_TRUNC_LE THEN ASM_REWRITE_TAC[REAL_POS] THEN + EXISTS_TAC `B:real` THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + ASM_REAL_ARITH_TAC);; + +(* --- 286T(c) assembly (n->infinity, Fremlin 2946-2948): the UNtruncated *) +(* bound *) +(* int_F Ahat f <= C ||f||_2 sqrt muF follows from the TRUNCATED bounds *) +(* int_F *) +(* Ahat_m f <= C ||f||_2 sqrt muF (uniform in m, = 286P output for the *) +(* compact- *) +(* window operator) by MONOTONE CONVERGENCE. f_m = Ahat_m f is integrable on *) +(* F *) +(* (threaded), increasing in m (CARLESON_AHAT_TRUNC_MONO), -> Ahat f a.e. *) +(* (CARLESON *) +(* _AHAT_TRUNC_SUP, needs Ahat f finite a.e. = the threaded *) +(* window-bound-a.e. hyp, *) +(* Fremlin 286D from the bound), with uniformly bounded integrals; so Ahat f *) +(* is *) +(* integrable and int_F Ahat_m f -> int_F Ahat f, whose limit is <= the *) +(* bound *) +(* (REALLIM_UBOUND). This reduces CARLESON_286T_BOUND to the truncated bound *) +(* (whose engine is the DEEP 286O(b)/286P tile operator). --- *) +let CARLESON_286T_FROM_TRUNC = prove + (`!(f:real->complex) FF C. + &0 <= C /\ real_measurable FF /\ (\z. f(drop z)) IN lspace (:real^1) (&2) + /\ + (?t. real_negligible t /\ + (!y. ~(y IN t) ==> ?B. !a b. a <= b ==> inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[a,b])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * f(drop x))) <= B)) + /\ + (!m. (\y. carleson_Ahat_trunc f (&m) y) real_integrable_on FF /\ + real_integral FF (\y. carleson_Ahat_trunc f (&m) y) + <= C * lnorm (:real^1) (&2) (\z. f(drop z)) * sqrt(real_measure + FF)) + ==> carleson_Ahat f real_integrable_on FF /\ + real_integral FF (carleson_Ahat f) + <= C * lnorm (:real^1) (&2) (\z. f(drop z)) * sqrt(real_measure + FF)`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 (X_CHOOSE_THEN + `t:real->bool` STRIP_ASSUME_TAC) ASSUME_TAC)))) THEN + MP_TAC(ISPECL + [`\m:num. (\y. carleson_Ahat_trunc f (&m) y)`; + `carleson_Ahat f`; `FF:real->bool`] + REAL_MONOTONE_CONVERGENCE_INCREASING_AE) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [GEN_TAC THEN ASM_REWRITE_TAC[]; + MAP_EVERY X_GEN_TAC [`k:num`; `y:real`] THEN DISCH_TAC THEN + MATCH_MP_TAC CARLESON_AHAT_TRUNC_MONO THEN + ASM_REWRITE_TAC[REAL_POS; REAL_OF_NUM_LE] THEN ARITH_TAC; + EXISTS_TAC `t:real->bool` THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `y:real` THEN REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN + MATCH_MP_TAC CARLESON_AHAT_TRUNC_SUP THEN + FIRST_X_ASSUM(MP_TAC o SPEC `y:real`) THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[real_bounded; FORALL_IN_GSPEC; IN_UNIV] THEN + EXISTS_TAC `abs(C * lnorm (:real^1) (&2) (\z. (f:real->complex)(drop z)) + * sqrt(real_measure FF))` THEN + X_GEN_TAC `k:num` THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= b ==> abs x <= abs b`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `real_integral FF (\y. &0)` THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_INTEGRAL_0; REAL_LE_REFL]; + MATCH_MP_TAC REAL_INTEGRAL_LE THEN + ASM_REWRITE_TAC[REAL_INTEGRABLE_0] THEN + X_GEN_TAC `y:real` THEN DISCH_TAC THEN + MATCH_MP_TAC CARLESON_AHAT_TRUNC_POS THEN ASM_REWRITE_TAC[REAL_POS]]; + ASM_REWRITE_TAC[]]]; + ALL_TAC] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(ISPEC `sequentially` REALLIM_UBOUND) THEN + EXISTS_TAC `\m:num. real_integral FF (\y. carleson_Ahat_trunc f (&m) y)` THEN + ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; EVENTUALLY_SEQUENTIALLY] THEN + EXISTS_TAC `0` THEN ASM_REWRITE_TAC[]);; + +(* ========================================================================= *) +(* 286T(b): the Schwartz estimate and density transfer. *) +(* *) +(* The deep analytic content of 286T is the Schwartz maximal bound *) +(* int_F carleson_Ahat h <= C10 ||h||_2 sqrt(muF) (h a test function) *) +(* [= Fremlin 286T(b), whose engine is 286P -> 286Q/R/S dilation-averaging]. *) +(* CARLESON_286T_SCHWARTZ is transferred to the general truncated bound *) +(* int_{[-M,M]} carleson_Ahat_trunc f n <= C10 ||f||_2 sqrt(2M) *) +(* via 286T(c): Ahat_n f <= Ahat_n h + Cauchy-error (SUB_BOUND) + Schwartz *) +(* density (284N). This is exactly the H1 hypothesis of both CARLESON_286T_ *) +(* FROM_TRUNC and CARLESON_286U_EXISTS_FROM_BOUNDS. --- *) + +(* Schwartz h: the window-integral family is uniformly bounded (h in L^1). *) +let CARLESON_SCHWARTZ_WINDOW_BOUND = prove + (`!(h:real->complex) y. + schwartz h + ==> ?B. !a b. a <= b ==> inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[a,b])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * h(drop x))) <= B`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP SCHWARTZ_ABSINT) THEN + EXISTS_TAC `inv(sqrt(&2 * pi)) * + drop(integral (:real^1) (\x. lift(norm((h:real->complex)(drop x)))))` THEN + MAP_EVERY X_GEN_TAC [`a:real`; `b:real`] THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INV THEN MATCH_MP_TAC SQRT_POS_LE THEN + MP_TAC PI_POS THEN REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `drop(integral (IMAGE lift (real_interval[a,b])) (\x. + lift(norm((h:real->complex)(drop x)))))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC FOURIER_MODULATION_ABSINT_ON THEN + REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL; MEASURABLE_INTERVAL] THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `(:real^1)` THEN + ASM_REWRITE_TAC[SUBSET_UNIV; GSYM IMAGE_LIFT_REAL_INTERVAL]; + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN + REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL] THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `(:real^1)` THEN + ASM_REWRITE_TAC[SUBSET_UNIV; GSYM IMAGE_LIFT_REAL_INTERVAL]; + X_GEN_TAC `w:real^1` THEN DISCH_TAC THEN + REWRITE_TAC[LIFT_DROP; COMPLEX_NORM_MUL] THEN + SUBGOAL_THEN + `--(ii * Cx y * Cx(drop w)) = ii * Cx(--(y * drop w))` SUBST1_TAC THENL + [REWRITE_TAC[CX_NEG; CX_MUL] THEN + SIMPLE_COMPLEX_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[NORM_CEXP_II; REAL_MUL_LID; REAL_LE_REFL]]; + MATCH_MP_TAC INTEGRAL_SUBSET_DROP_LE THEN + REWRITE_TAC[SUBSET_UNIV] THEN CONJ_TAC THENL + [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN + REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL] THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `(:real^1)` THEN + ASM_REWRITE_TAC[SUBSET_UNIV; GSYM IMAGE_LIFT_REAL_INTERVAL]; + CONJ_TAC THENL + [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN ASM_REWRITE_TAC[]; + X_GEN_TAC `w:real^1` THEN DISCH_TAC THEN + REWRITE_TAC[LIFT_DROP; NORM_POS_LE]]]]);; + +(* Ahat_n h <= Ahat h for Schwartz h (compact windows subset all windows). *) +let CARLESON_AHAT_TRUNC_SCHWARTZ_LE = prove + (`!(h:real->complex) n y. + &0 <= n /\ schwartz h + ==> carleson_Ahat_trunc h n y <= carleson_Ahat h y`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC CARLESON_AHAT_TRUNC_LE THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`h:real->complex`; + `y:real`] CARLESON_SCHWARTZ_WINDOW_BOUND) THEN + ASM_REWRITE_TAC[]);; + +(* Ahat h is pointwise bounded by the loc-L^1 constant (Schwartz h). *) +let CARLESON_AHAT_SCHWARTZ_BOUND = prove + (`!(h:real->complex) y. + schwartz h + ==> carleson_Ahat h y <= + inv(sqrt(&2 * pi)) * drop(integral (:real^1) (\x. + lift(norm((h:real->complex)(drop x)))))`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP SCHWARTZ_ABSINT) THEN + REWRITE_TAC[carleson_Ahat] THEN MATCH_MP_TAC REAL_SUP_LE THEN + CONJ_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + MAP_EVERY EXISTS_TAC + [`inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[y,y])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * (h:real->complex)(drop + x)))`; + `y:real`; `y:real`] THEN REWRITE_TAC[REAL_LE_REFL]; + REWRITE_TAC[IN_ELIM_THM] THEN X_GEN_TAC `w:real` THEN + DISCH_THEN(X_CHOOSE_THEN `a:real` (X_CHOOSE_THEN + `b:real` STRIP_ASSUME_TAC)) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INV THEN MATCH_MP_TAC SQRT_POS_LE THEN + MP_TAC PI_POS THEN REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `drop(integral (IMAGE lift (real_interval[a,b])) (\x. + lift(norm((h:real->complex)(drop x)))))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC FOURIER_MODULATION_ABSINT_ON THEN + REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL; MEASURABLE_INTERVAL] THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `(:real^1)` THEN + ASM_REWRITE_TAC[SUBSET_UNIV; GSYM IMAGE_LIFT_REAL_INTERVAL]; + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN + REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL] THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `(:real^1)` THEN + ASM_REWRITE_TAC[SUBSET_UNIV; GSYM IMAGE_LIFT_REAL_INTERVAL]; + X_GEN_TAC `w2:real^1` THEN DISCH_TAC THEN + REWRITE_TAC[LIFT_DROP; COMPLEX_NORM_MUL] THEN + SUBGOAL_THEN + `--(ii * Cx y * Cx(drop w2)) = + ii * Cx(--(y * drop w2))` SUBST1_TAC THENL + [REWRITE_TAC[CX_NEG; CX_MUL] THEN + SIMPLE_COMPLEX_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[NORM_CEXP_II; REAL_MUL_LID; REAL_LE_REFL]]; + MATCH_MP_TAC INTEGRAL_SUBSET_DROP_LE THEN + REWRITE_TAC[SUBSET_UNIV] THEN CONJ_TAC THENL + [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN + REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL] THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `(:real^1)` THEN + ASM_REWRITE_TAC[SUBSET_UNIV; GSYM IMAGE_LIFT_REAL_INTERVAL]; + CONJ_TAC THENL + [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN ASM_REWRITE_TAC[]; + X_GEN_TAC `w2:real^1` THEN DISCH_TAC THEN + REWRITE_TAC[LIFT_DROP; NORM_POS_LE]]]]]);; + +(* Ahat h is integrable on any measurable set (measurable + bounded by *) +(* const). *) +let CARLESON_AHAT_SCHWARTZ_INTEGRABLE = prove + (`!(h:real->complex) FF. + schwartz h /\ real_measurable FF + ==> (carleson_Ahat h) real_integrable_on FF`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN + EXISTS_TAC `\y:real. inv(sqrt(&2 * pi)) * + drop(integral (:real^1) (\x. lift(norm((h:real->complex)(drop x)))))` THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC REAL_MEASURABLE_ON_MEASURABLE_SUBSET THEN + EXISTS_TAC `(:real)` THEN ASM_REWRITE_TAC[SUBSET_UNIV] THEN + MATCH_MP_TAC CARLESON_AHAT_MEASURABLE THEN CONJ_TAC THENL + [MATCH_MP_TAC SCHWARTZ_ABSINT THEN ASM_REWRITE_TAC[]; + GEN_TAC THEN MATCH_MP_TAC CARLESON_SCHWARTZ_WINDOW_BOUND THEN + ASM_REWRITE_TAC[]]; + ONCE_REWRITE_TAC[GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_INTEGRABLE_LMUL THEN + ASM_REWRITE_TAC[GSYM REAL_MEASURABLE]; + X_GEN_TAC `y:real` THEN DISCH_TAC THEN + SUBGOAL_THEN `&0 <= carleson_Ahat h y` ASSUME_TAC THENL + [MATCH_MP_TAC CARLESON_AHAT_POS THEN + MATCH_MP_TAC CARLESON_SCHWARTZ_WINDOW_BOUND THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `carleson_Ahat h y <= inv(sqrt(&2 * pi)) * + drop(integral (:real^1) (\x. lift(norm((h:real->complex)(drop x)))))` + ASSUME_TAC THENL + [MATCH_MP_TAC CARLESON_AHAT_SCHWARTZ_BOUND THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_REAL_ARITH_TAC]);; + +(* ========================================================================= *) +(* Deep 286P tile-bound ladder (Fremlin mt286.tex 1939-2948): the tile *) +(* operator A (286P) + the 286Q/R/S/T dilation-averaging reduction, one rung *) +(* at a time. 246K (the factor-4 sign trick, above) is the first sub-piece *) +(* of 286P. *) +(* ========================================================================= *) + +(* Fremlin 286C: shift / modulation / dilation operators. *) +let carleson_modulate = new_definition + `carleson_modulate a (f:real->complex) = \x. cexp(ii * Cx a * Cx x) * f x`;; +let carleson_dilate = new_definition + `carleson_dilate a (f:real->complex) = \x. f(a * x)`;; + +(* ========================================================================= *) +(* 286Q(c) FOURIER-ALGEBRA bricks (Fremlin mt286 2380-2416), toward the *) +(* kernel *) +(* bound 2pi|(hhat.theta')check| <= D_{1/a} A M_b D_a h. *) +(* ========================================================================= *) + +(* (M_b D_a h)hat w = (1/a) hhat((w-b)/a). M_b D_a h = D_a(M_{b/a} h) (the *) +(* modulation frequency scales under dilation), then FOURIER_DILATION + *) +(* FOURIER_MODULATION. *) +let CARLESON_MODDIL_FOURIER = prove + (`!(h:real->complex) a b w. &0 < a /\ + (\x. cexp(--(ii * Cx (w/a) * Cx(drop x))) * (\u. cexp(ii * Cx(b/a) * Cx u) + * h u)(drop x)) integrable_on (:real^1) + ==> fourier (carleson_modulate b (carleson_dilate a h)) w + = Cx(&1/a) * fourier h ((w - b)/a)`, + REWRITE_TAC[carleson_modulate; carleson_dilate] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(\x. cexp(ii * Cx b * Cx x) * (h:real->complex)(a * x)) + = (\x. (\u. cexp(ii * Cx(b/a) * Cx u) * h u)(a * x))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN REWRITE_TAC[] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[CX_MUL] THEN + SUBGOAL_THEN `Cx(b/a) * Cx a = Cx b` (fun th -> MP_TAC th) THENL + [REWRITE_TAC[GSYM CX_MUL] THEN AP_TERM_TAC THEN + ASM_SIMP_TAC[REAL_DIV_RMUL; REAL_LT_IMP_NZ]; + CONV_TAC SIMPLE_COMPLEX_ARITH]; ALL_TAC] THEN + MP_TAC(SPECL [`\u. cexp(ii * Cx(b/a) * Cx u) * (h:real->complex) u`; + `a:real`; `w:real`] FOURIER_DILATION) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[FOURIER_MODULATION] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + REAL_ARITH_TAC);; + +(* The check-integrand identity: fourier h w * Cx(theta' z a b w) = Cx a * *) +(* ((M_b *) +(* D_a h)hat . Cx(theta_v)) at (a w+b), v = a z+b. Lets the check-integral *) +(* become *) +(* a dilation+shift of the (M_b D_a h) window (the y/a-evaluation of *) +(* 286Q(c)). *) +let CARLESON_Q286C_INTEGRAND = prove + (`!(h:real->complex) z a b w. &0 < a /\ + (!w. (\x. cexp(--(ii * Cx (w/a) * Cx(drop x))) * (\u. cexp(ii * Cx(b/a) * + Cx u) * h u)(drop x)) integrable_on (:real^1)) + ==> fourier h w * Cx(carleson_theta' z a b w) + = Cx a * (fourier (carleson_modulate b (carleson_dilate a h)) (a*w+b) * + Cx(carleson_theta (a*z+b) (a*w+b)))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[carleson_theta'] THEN + SUBGOAL_THEN + `fourier (carleson_modulate b (carleson_dilate a (h:real->complex))) (a*w+b) + = Cx(&1/a) * fourier h w` + ASSUME_TAC THENL + [MP_TAC(SPECL [`h:real->complex`; `a:real`; `b:real`; + `a*w+b:real`] CARLESON_MODDIL_FOURIER) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_FIELD `&0 < a ==> ((a*w+b) - b)/a = w`]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `Cx a * Cx(&1/a) = Cx(&1)` MP_TAC THENL + [REWRITE_TAC[GSYM CX_MUL] THEN AP_TERM_TAC THEN + UNDISCH_TAC `&0 < a` THEN CONV_TAC REAL_FIELD; ALL_TAC] THEN + CONV_TAC COMPLEX_RING);; + +(* 286Q(c) brick 3 (the specific check-integral change-of-variables): the *) +(* transform *) +(* of a dilated+shifted g. \w. g(a w+b) = \w. (S_b g)(a w), S_b g = \u. *) +(* g(u+b); so *) +(* FOURIER_DILATION on S_b g + FOURIER_SHIFT on g give the 1/a Jacobian + *) +(* e^{ibz/a} *) +(* phase. (This is the affine COV specialised to the check-integral, *) +(* expressed via *) +(* the operator laws rather than raw HAS_INTEGRAL_AFFINITY.) *) +let CARLESON_FOURIER_DILSHIFT = prove + (`!(g:real->complex) a b z. &0 < a /\ + (\x. cexp(--(ii * Cx (z/a) * Cx(drop x))) * (\u. g(u + b))(drop x)) + integrable_on (:real^1) /\ + (\x. cexp(--(ii * Cx (z/a) * Cx(drop x))) * g(drop x)) integrable_on + (:real^1) + ==> fourier (\w. g(a * w + b)) z + = Cx(&1/a) * cexp(ii * Cx b * Cx(z/a)) * fourier g (z/a)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\w. (g:real->complex)(a * w + b)) = (\w. (\u. g(u + b))(a * w))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM]; ALL_TAC] THEN + MP_TAC(SPECL [`\u. (g:real->complex)(u + b)`; `a:real`; + `z:real`] FOURIER_DILATION) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + MP_TAC(SPECL [`g:real->complex`; `b:real`; `z/a:real`] FOURIER_SHIFT) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[COMPLEX_MUL_ASSOC]);; + +(* ========================================================================= *) +(* 286O(a): the window function theta_z is Borel/Lebesgue measurable. Since *) +(* theta_z(y) is a sup over the (countable) tile family of a continuous term *) +(* Re(phi-hat(2^{-k}(y-ymid)))^2 restricted to the dyadic left-half J^l, it *) +(* is a countable sup of measurable functions, hence measurable. This is the *) +(* isolated gate on which the tile-operator sub-bricks below are *) +(* conditioned. *) +(* ========================================================================= *) + +(* The per-tile term y |-> Re(phi-hat(A(y-m)))^2 is real-continuous, hence *) +(* real-measurable (phi-hat is continuous by CARLESON_PHI_SCHWARTZ; the *) +(* affine reparametrisation and Re/square preserve continuity). *) +let CARLESON_THETA_TERM_MEASURABLE = prove + (`!(A:real) (m:real). + (\y. Re(fourier carleson_phi (A * (y - m))) pow 2) real_measurable_on + (:real)`, + REPEAT GEN_TAC THEN MATCH_MP_TAC CONTINUOUS_IMP_REAL_MEASURABLE_ON THEN + REWRITE_TAC[REAL_CONTINUOUS_ON; IMAGE_LIFT_UNIV; o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_LIFT_POW THEN + REWRITE_TAC[RE_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_LIFT_COMPONENT_COMPOSE THEN + SUBGOAL_THEN + `(\z:real^1. fourier carleson_phi (A * (drop z - m))) = + (\w:real^1. fourier carleson_phi (drop w)) o (\z:real^1. lift(A * (drop z - + m)))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; o_THM; LIFT_DROP]; ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL + [REWRITE_TAC[LIFT_CMUL; LIFT_SUB] THEN + MATCH_MP_TAC CONTINUOUS_ON_CMUL THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN + REWRITE_TAC[CONTINUOUS_ON_CONST] THEN + SUBGOAL_THEN `(\z:real^1. lift(drop z)) = (\z:real^1. z)` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; LIFT_DROP]; REWRITE_TAC[CONTINUOUS_ON_ID]]; + MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `(:real^1)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC FOURIER_CONTINUOUS_ON THEN + MATCH_MP_TAC SCHWARTZ_ABSINT THEN REWRITE_TAC[CARLESON_PHI_SCHWARTZ]; + REWRITE_TAC[SUBSET_UNIV]]]);; + +(* The dyadic left-half tile_Jl s is real-measurable for any tile s. *) +let TILE_JL_MEASURABLE = prove + (`!s:int#int#int. real_measurable (tile_Jl s)`, + GEN_TAC THEN + MP_TAC(ISPEC `s:int#int#int` PAIR_SURJECTIVE) THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(ISPEC `y:int#int` PAIR_SURJECTIVE) THEN STRIP_TAC THEN + ASM_REWRITE_TAC[tile_Jl; DYHO_MEASURABLE]);; + +(* Each member g_n of the enumerated tile family (with a sentinel n=0 slot *) +(* forcing 0 into the family) is real-measurable: either the constant 0, or *) +(* the per-tile term restricted to the measurable J^l (REAL_MEASURABLE_ON_ *) +(* RESTRICT). The zt IN J^r condition is a y-independent proposition. *) +let CARLESON_THETA_FAMILY_MEASURABLE = prove + (`!(e:num->(int#int#int)) (zt:real) (n:num). + (\y. if n = 0 then &0 + else if zt IN tile_Jr (e(n-1)) /\ y IN tile_Jl (e(n-1)) + then Re(fourier carleson_phi (&2 zpow (--(tile_k (e(n-1)))) * (y + - tile_ymid (e(n-1))))) pow 2 + else &0) + real_measurable_on (:real)`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[REAL_MEASURABLE_ON_CONST] THEN + ASM_CASES_TAC `zt IN tile_Jr ((e:num->int#int#int)(n-1))` THENL + [ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_MEASURABLE_ON_RESTRICT THEN + CONJ_TAC THENL + [REWRITE_TAC[CARLESON_THETA_TERM_MEASURABLE]; + MATCH_MP_TAC REAL_MEASURABLE_IMP_REAL_LEBESGUE_MEASURABLE THEN + REWRITE_TAC[TILE_JL_MEASURABLE]]; + ASM_REWRITE_TAC[REAL_MEASURABLE_ON_CONST]]);; + +(* Reconcile theta_z's set-sup (over qualifying tiles, UNION {0}) with a *) +(* num- *) +(* indexed sup over the enumerated family g_n. The n=0 sentinel supplies 0; *) +(* n>=1 runs the enumeration e of the countable tile index set int#int#int. *) +let CARLESON_THETA_SUP_RECONCILE = prove + (`!(e:num->(int#int#int)) zt y. + (:int#int#int) = IMAGE e (:num) + ==> carleson_theta zt y = + sup { (if n = 0 then &0 + else if zt IN tile_Jr (e(n-1)) /\ y IN tile_Jl (e(n-1)) + then Re(fourier carleson_phi (&2 zpow (--(tile_k + (e(n-1)))) * (y - tile_ymid (e(n-1))))) pow 2 + else &0) + | n IN (:num) }`, + REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[carleson_theta] THEN + AP_TERM_TAC THEN + CONV_TAC SYM_CONV THEN + REWRITE_TAC[EXTENSION; IN_UNION; IN_SING; IN_ELIM_THM; IN_UNIV] THEN + X_GEN_TAC `w:real` THEN EQ_TAC THENL + [DISCH_THEN(X_CHOOSE_THEN `n:num` SUBST1_TAC) THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + DISJ1_TAC THEN EXISTS_TAC `(e:num->int#int#int)(n-1)` THEN + ASM_REWRITE_TAC[]; + STRIP_TAC THENL + [SUBGOAL_THEN `?m. (e:num->int#int#int) m = s` STRIP_ASSUME_TAC THENL + [FIRST_ASSUM(MP_TAC o AP_TERM `\u. (s:int#int#int) IN u`) THEN + REWRITE_TAC[IN_UNIV; IN_IMAGE] THEN MESON_TAC[]; ALL_TAC] THEN + EXISTS_TAC `m + 1` THEN REWRITE_TAC[ADD_EQ_0; ARITH_EQ; ADD_SUB] THEN + ASM_REWRITE_TAC[]; + EXISTS_TAC `0` THEN ASM_REWRITE_TAC[]]]);; + +(* 286O(a): theta_z is real-measurable. Enumerate the countable tile set, *) +(* express theta_z as the num-sup of the family (bounded by 1 via CARLESON_ *) +(* THETA_TERM_BOUNDS), apply REAL_MEASURABLE_ON_SUP. *) +let CARLESON_THETA_MEASURABLE = prove + (`!(zt:real). (\y. carleson_theta zt y) real_measurable_on (:real)`, + GEN_TAC THEN + SUBGOAL_THEN + `?e:num->(int#int#int). (:int#int#int) = + IMAGE e (:num)` STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC COUNTABLE_AS_IMAGE THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM CROSS_UNIV] THEN MATCH_MP_TAC COUNTABLE_CROSS THEN + REWRITE_TAC[INT_COUNTABLE; GSYM CROSS_UNIV] THEN + MATCH_MP_TAC COUNTABLE_CROSS THEN + REWRITE_TAC[INT_COUNTABLE]; + REWRITE_TAC[UNIV_NOT_EMPTY]]; ALL_TAC] THEN + ASM_SIMP_TAC[CARLESON_THETA_SUP_RECONCILE] THEN + MATCH_MP_TAC REAL_MEASURABLE_ON_SUP THEN CONJ_TAC THENL + [GEN_TAC THEN REWRITE_TAC[CARLESON_THETA_FAMILY_MEASURABLE]; + GEN_TAC THEN EXISTS_TAC `&1` THEN GEN_TAC THEN + COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_01] THEN + COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_01] THEN + REWRITE_TAC[CARLESON_THETA_TERM_BOUNDS]]);; + +(* Lift 286O(a) to the complex-window form the tile operator needs: *) +(* y |-> Cx(theta_z(drop y)) is measurable on R^1 (real-measurable composed *) +(* with the continuous Cx o drop). *) +let CARLESON_THETA_CX_MEASURABLE = prove + (`!(zt:real). (\y:real^1. Cx(carleson_theta zt (drop y))) measurable_on + (:real^1)`, + GEN_TAC THEN + SUBGOAL_THEN + `(\y:real^1. Cx(carleson_theta zt (drop y))) = + (\w. Cx(drop w)) o (\z. lift(carleson_theta zt (drop z)))` + SUBST1_TAC THENL [REWRITE_TAC[o_DEF; LIFT_DROP]; ALL_TAC] THEN + MATCH_MP_TAC MEASURABLE_ON_COMPOSE_CONTINUOUS THEN CONJ_TAC THENL + [SUBGOAL_THEN + `(\z:real^1. lift(carleson_theta zt (drop z))) = lift o (\u. + carleson_theta zt u) o drop` + SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN + REWRITE_TAC[GSYM IMAGE_LIFT_UNIV; GSYM real_measurable_on] THEN + REWRITE_TAC[ETA_AX; CARLESON_THETA_MEASURABLE]; + MATCH_MP_TAC CONTINUOUS_ON_CX_DROP THEN REWRITE_TAC[CONTINUOUS_ON_ID]]);; + +(* ========================================================================= *) +(* 286R-(b-ii)/(c): the averaged bump g(alpha,y,z) and its bounds. *) +(* g(alpha,y,z) = lim_{b->inf} (1/b) int_0^b theta'_{z,alpha,beta}(y) dbeta *) +(* (Fremlin mt286.tex 2490-2531). Existence is PERIODIC_CESARO_LIMIT applied *) +(* to beta |-> theta'_{z,alpha,beta}(y): nonnegative (THETA'_BOUNDS), <=1, *) +(* locally integrable (THETA'_BETA_INTEGRABLE = bounded + measurable), and *) +(* 2^l-periodic (CARLESON_THETA'_PERIOD) when y0. For y>=z the *) +(* integrand is identically 0 (THETA'_SUPPORT) so g=0. *) +(* ========================================================================= *) + +(* {beta | c + beta IN dyho k n} is real-measurable (translate of a dyadic *) +(* cell). *) +let THETA_BETA_PREIMAGE = prove + (`!c:real k n. real_measurable {beta | (c + beta) IN dyho k n}`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN + `{beta | (c + beta) IN dyho k n} = IMAGE (\x. (--c) + x) (dyho k n)` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM] THEN X_GEN_TAC `b:real` THEN + EQ_TAC THENL + [DISCH_TAC THEN EXISTS_TAC `c + b:real` THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ASM_REWRITE_TAC[]]; + DISCH_THEN(X_CHOOSE_THEN `x:real` STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `c + --c + x:real = x` (fun th -> ASM_REWRITE_TAC[th]) THEN + REAL_ARITH_TAC]; ALL_TAC] THEN + REWRITE_TAC[REAL_MEASURABLE_TRANSLATION; DYHO_MEASURABLE]);; + +(* each per-tile term of theta', as a function of beta, is real-measurable. *) +let THETA_BETA_FAMILY_MEASURABLE = prove + (`!(e:num->(int#int#int)) (alpha:real) (y:real) (z:real) (n:num). + (\beta. if n = 0 then &0 + else if (alpha * z + beta) IN tile_Jr (e(n-1)) /\ (alpha * y + beta) + IN tile_Jl (e(n-1)) + then Re(fourier carleson_phi (&2 zpow (--(tile_k (e(n-1)))) * + ((alpha * y + beta) - tile_ymid (e(n-1))))) pow 2 + else &0) + real_measurable_on (:real)`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[REAL_MEASURABLE_ON_CONST] THEN + SUBGOAL_THEN + `(\beta. if (alpha * z + beta) IN tile_Jr (e(n-1)) /\ (alpha * y + beta) IN + tile_Jl (e(n-1)) + then Re(fourier carleson_phi (&2 zpow (--(tile_k (e(n-1)))) * + ((alpha * y + beta) - tile_ymid (e(n-1))))) pow 2 + else &0) = + (\beta. if beta IN {b | (alpha * z + b) IN tile_Jr (e(n-1)) /\ (alpha * y + + b) IN tile_Jl (e(n-1))} + then (\beta. Re(fourier carleson_phi (&2 zpow (--(tile_k (e(n-1)))) + * ((alpha * y + beta) - tile_ymid (e(n-1))))) pow 2) beta + else &0)` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; IN_ELIM_THM]; ALL_TAC] THEN + MATCH_MP_TAC REAL_MEASURABLE_ON_RESTRICT THEN CONJ_TAC THENL + [SUBGOAL_THEN + `(\beta. Re(fourier carleson_phi (&2 zpow (--(tile_k (e(n-1)))) * ((alpha + * y + beta) - tile_ymid (e(n-1))))) pow 2) = + (\beta. Re(fourier carleson_phi (&2 zpow (--(tile_k (e(n-1)))) * (beta - + (tile_ymid (e(n-1)) - alpha * y)))) pow 2)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN AP_THM_TAC THEN + AP_TERM_TAC THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[CARLESON_THETA_TERM_MEASURABLE]; + MATCH_MP_TAC REAL_MEASURABLE_IMP_REAL_LEBESGUE_MEASURABLE THEN + SUBGOAL_THEN + `{b | (alpha * z + b) IN tile_Jr (e(n-1)) /\ (alpha * y + b) IN tile_Jl + (e(n-1))} = + {b | (alpha * z + b) IN tile_Jr (e(n-1))} INTER {b | (alpha * y + b) IN + tile_Jl (e(n-1))}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM]; ALL_TAC] THEN + MATCH_MP_TAC REAL_MEASURABLE_INTER THEN + MP_TAC(ISPEC `(e:num->int#int#int)(n-1)` PAIR_SURJECTIVE) THEN + STRIP_TAC THEN + MP_TAC(ISPEC `y':int#int` PAIR_SURJECTIVE) THEN STRIP_TAC THEN + ASM_REWRITE_TAC[tile_Jr; tile_Jl; THETA_BETA_PREIMAGE]]);; + +(* reconcile theta(alpha z+beta)(alpha y+beta) with the num-sup of the *) +(* family *) +let THETA_BETA_SUP_RECONCILE = prove + (`!(e:num->(int#int#int)) alpha y z beta. + (:int#int#int) = IMAGE e (:num) + ==> carleson_theta (alpha * z + beta) (alpha * y + beta) = + sup { (if n = 0 then &0 + else if (alpha * z + beta) IN tile_Jr (e(n-1)) /\ (alpha * y + + beta) IN tile_Jl (e(n-1)) + then Re(fourier carleson_phi (&2 zpow (--(tile_k + (e(n-1)))) * ((alpha * y + beta) - tile_ymid (e(n-1))))) + pow 2 + else &0) + | n IN (:num) }`, + REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[carleson_theta] THEN + AP_TERM_TAC THEN + CONV_TAC SYM_CONV THEN + REWRITE_TAC[EXTENSION; IN_UNION; IN_SING; IN_ELIM_THM; IN_UNIV] THEN + X_GEN_TAC `w:real` THEN EQ_TAC THENL + [DISCH_THEN(X_CHOOSE_THEN `n:num` SUBST1_TAC) THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + DISJ1_TAC THEN EXISTS_TAC `(e:num->int#int#int)(n-1)` THEN + ASM_REWRITE_TAC[]; + STRIP_TAC THENL + [SUBGOAL_THEN `?m. (e:num->int#int#int) m = s` STRIP_ASSUME_TAC THENL + [FIRST_ASSUM(MP_TAC o AP_TERM `\u. (s:int#int#int) IN u`) THEN + REWRITE_TAC[IN_UNIV; IN_IMAGE] THEN MESON_TAC[]; ALL_TAC] THEN + EXISTS_TAC `m + 1` THEN REWRITE_TAC[ADD_EQ_0; ARITH_EQ; ADD_SUB] THEN + ASM_REWRITE_TAC[]; + EXISTS_TAC `0` THEN ASM_REWRITE_TAC[]]]);; + +(* theta'_{z,alpha,.}(y) is real-measurable in beta. *) +let THETA'_BETA_MEASURABLE = prove + (`!alpha y z. (\beta. carleson_theta' z alpha beta y) real_measurable_on + (:real)`, + REPEAT GEN_TAC THEN REWRITE_TAC[carleson_theta'] THEN + SUBGOAL_THEN + `?e:num->(int#int#int). (:int#int#int) = + IMAGE e (:num)` STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC COUNTABLE_AS_IMAGE THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM CROSS_UNIV] THEN MATCH_MP_TAC COUNTABLE_CROSS THEN + REWRITE_TAC[INT_COUNTABLE; GSYM CROSS_UNIV] THEN + MATCH_MP_TAC COUNTABLE_CROSS THEN + REWRITE_TAC[INT_COUNTABLE]; + REWRITE_TAC[UNIV_NOT_EMPTY]]; ALL_TAC] THEN + ASM_SIMP_TAC[THETA_BETA_SUP_RECONCILE] THEN + MATCH_MP_TAC REAL_MEASURABLE_ON_SUP THEN CONJ_TAC THENL + [GEN_TAC THEN REWRITE_TAC[THETA_BETA_FAMILY_MEASURABLE]; + GEN_TAC THEN EXISTS_TAC `&1` THEN GEN_TAC THEN + COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_01] THEN + COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_01] THEN + REWRITE_TAC[CARLESON_THETA_TERM_BOUNDS]]);; + +(* theta'_{z,alpha,.}(y) is integrable on every bounded interval. *) +let THETA'_BETA_INTEGRABLE = prove + (`!alpha y z u v. (\beta. carleson_theta' z alpha beta y) real_integrable_on + real_interval[u,v]`, + REPEAT GEN_TAC THEN + MATCH_MP_TAC REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN + EXISTS_TAC `(\beta. &1):real->real` THEN REPEAT CONJ_TAC THENL + [ONCE_REWRITE_TAC[GSYM REAL_MEASURABLE_ON_UNIV] THEN + MATCH_MP_TAC REAL_MEASURABLE_ON_RESTRICT THEN + REWRITE_TAC[THETA'_BETA_MEASURABLE] THEN + MATCH_MP_TAC REAL_MEASURABLE_IMP_REAL_LEBESGUE_MEASURABLE THEN + REWRITE_TAC[REAL_MEASURABLE_REAL_INTERVAL]; + REWRITE_TAC[REAL_INTEGRABLE_CONST]; + X_GEN_TAC `x:real` THEN DISCH_TAC THEN BETA_TAC THEN + MP_TAC(SPECL [`z:real`;`alpha:real`;`x:real`;`y:real`] + CARLESON_THETA'_BOUNDS) THEN + REAL_ARITH_TAC]);; + +(* helper: reallim net f = l whenever the limit exists (nontrivial net). *) +let REALLIM_REALLIM_EQ = prove + (`!net:(A)net f l. ~(trivial_limit net) /\ (f ---> l) net ==> reallim net f = + l`, + REPEAT STRIP_TAC THEN REWRITE_TAC[reallim] THEN + MATCH_MP_TAC SELECT_UNIQUE THEN + X_GEN_TAC `m:real` THEN REWRITE_TAC[] THEN EQ_TAC THEN DISCH_TAC THENL + [MATCH_MP_TAC(ISPEC `net:(A)net` REALLIM_UNIQUE) THEN + EXISTS_TAC `f:A->real` THEN ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]]);; + +(* the averaged bump. *) +let carleson_g = new_definition + `carleson_g alpha y z = + reallim at_posinfinity + (\b. inv b * real_integral (real_interval[&0,b]) (\beta. carleson_theta' + z alpha beta y))`;; + +(* 286R-(b-ii): the Cesaro average of theta' converges (y0). *) +let CARLESON_G_CESARO = prove + (`!alpha y z. &0 < alpha /\ y < z + ==> ?L. ((\b. inv b * real_integral (real_interval[&0,b]) (\beta. + carleson_theta' z alpha beta y)) + ---> L) at_posinfinity`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`z:real`;`alpha:real`;`y:real`] CARLESON_THETA'_PERIOD) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `L:int`) THEN + EXISTS_TAC `inv(&2 zpow L) * + real_integral (real_interval[&0,&2 zpow L]) (\beta. carleson_theta' z alpha + beta y)` THEN + MATCH_MP_TAC PERIODIC_CESARO_LIMIT THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; + GEN_TAC THEN REWRITE_TAC[CARLESON_THETA'_BOUNDS]; + REWRITE_TAC[THETA'_BETA_INTEGRABLE]; + GEN_TAC THEN ASM_REWRITE_TAC[]]);; + +(* periodic Cesaro lower bound (feeds 286R-h): f>=0 period-p with int_0^p f *) +(* >= c*p forces the Cesaro average limit reallim (1/b) int_0^b f >= c. *) +let PERIODIC_CESARO_LBOUND = prove + (`!f p c. &0 < p /\ (!x. &0 <= f x) /\ + (!u v. f real_integrable_on real_interval[u,v]) /\ + (!b. f(b + p) = f b) /\ + c * p <= real_integral (real_interval[&0,p]) f + ==> c <= reallim at_posinfinity + (\b. inv b * real_integral (real_interval[&0,b]) f)`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`f:real->real`; `p:real`] PERIODIC_CESARO_LIMIT) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + SUBGOAL_THEN + `reallim at_posinfinity (\b. inv b * real_integral (real_interval[&0,b]) f) + = + inv p * real_integral (real_interval[&0,p]) f` + SUBST1_TAC THENL + [MATCH_MP_TAC REALLIM_REALLIM_EQ THEN + ASM_REWRITE_TAC[TRIVIAL_LIMIT_AT_POSINFINITY]; + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv p * (c * p):real` THEN + CONJ_TAC THENL + [SUBGOAL_THEN + `inv p * (c * p) = + c:real` (fun th -> REWRITE_TAC[th; REAL_LE_REFL]) THEN + UNDISCH_TAC `&0 < p` THEN CONV_TAC REAL_FIELD; + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INV THEN + ASM_REAL_ARITH_TAC; ASM_REWRITE_TAC[]]]]);; + +(* the averaged family converges TO carleson_g (y0). *) +let CARLESON_G_AVG_LIMIT = prove + (`!alpha y z. &0 < alpha /\ y < z + ==> ((\b. inv b * real_integral (real_interval[&0,b]) (\beta. + carleson_theta' z alpha beta y)) + ---> carleson_g alpha y z) at_posinfinity`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`alpha:real`;`y:real`;`z:real`] CARLESON_G_CESARO) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `L:real`) THEN + SUBGOAL_THEN `carleson_g alpha y z = L` SUBST1_TAC THENL + [REWRITE_TAC[carleson_g] THEN MATCH_MP_TAC REALLIM_REALLIM_EQ THEN + ASM_REWRITE_TAC[TRIVIAL_LIMIT_AT_POSINFINITY]; + ASM_REWRITE_TAC[]]);; + +(* g = 0 for y >= z (the bump support is empty). *) +let CARLESON_G_TRIVIAL = prove + (`!alpha y z. &0 < alpha /\ z <= y ==> carleson_g alpha y z = &0`, + REPEAT STRIP_TAC THEN REWRITE_TAC[carleson_g] THEN + MATCH_MP_TAC REALLIM_REALLIM_EQ THEN + REWRITE_TAC[TRIVIAL_LIMIT_AT_POSINFINITY] THEN + SUBGOAL_THEN + `(\b. inv b * real_integral (real_interval[&0,b]) (\beta. carleson_theta' z + alpha beta y)) = + (\b. &0)` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + SUBGOAL_THEN + `(\beta. carleson_theta' z alpha beta y) = (\beta. &0)` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + MATCH_MP_TAC CARLESON_THETA'_SUPPORT THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_INTEGRAL_0; REAL_MUL_RZERO]]; + REWRITE_TAC[REALLIM_CONST]]);; + +(* the averaged family lies in [0,1] for every b>0. *) +let CARLESON_G_AVG_BOUNDS = prove + (`!alpha y z b. &0 < b + ==> &0 <= inv b * real_integral (real_interval[&0,b]) (\beta. + carleson_theta' z alpha beta y) /\ + inv b * real_integral (real_interval[&0,b]) (\beta. carleson_theta' z + alpha beta y) <= &1`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN + `&0 <= real_integral (real_interval[&0,b]) (\beta. carleson_theta' z alpha + beta y) /\ + real_integral (real_interval[&0,b]) (\beta. carleson_theta' z alpha beta y) + <= b` + STRIP_ASSUME_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_POS THEN + REWRITE_TAC[THETA'_BETA_INTEGRABLE] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[CARLESON_THETA'_BOUNDS]; + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `real_integral (real_interval[&0,b]) (\beta. &1)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_LE THEN + REWRITE_TAC[THETA'_BETA_INTEGRABLE; REAL_INTEGRABLE_CONST] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[CARLESON_THETA'_BOUNDS]; + ASM_SIMP_TAC[REAL_INTEGRAL_CONST; REAL_LT_IMP_LE] THEN + ASM_REAL_ARITH_TAC]]; ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC[REAL_LE_INV_EQ; REAL_LT_IMP_LE]; + SUBGOAL_THEN + `inv b * real_integral (real_interval[&0,b]) (\beta. carleson_theta' z + alpha beta y) <= inv b * b` + MP_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN + ASM_SIMP_TAC[REAL_LE_INV_EQ; REAL_LT_IMP_LE]; + ASM_SIMP_TAC[REAL_MUL_LINV; REAL_LT_IMP_NZ]]]);; + +(* 286R-(c): 0 <= g <= 1. *) +let CARLESON_G_BOUNDS = prove + (`!alpha y z. &0 < alpha ==> &0 <= carleson_g alpha y z /\ carleson_g alpha y + z <= &1`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + ASM_CASES_TAC `(z:real) <= y` THENL + [ASM_SIMP_TAC[CARLESON_G_TRIVIAL] THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `(y:real) < z` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(SPECL [`alpha:real`;`y:real`;`z:real`] CARLESON_G_AVG_LIMIT) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN CONJ_TAC THENL + [MATCH_MP_TAC(ISPEC `at_posinfinity` REALLIM_LBOUND) THEN + EXISTS_TAC `\b. inv b * real_integral (real_interval[&0,b]) (\beta. + carleson_theta' z alpha beta y)` THEN + ASM_REWRITE_TAC[TRIVIAL_LIMIT_AT_POSINFINITY; + EVENTUALLY_AT_POSINFINITY] THEN + EXISTS_TAC `&1` THEN X_GEN_TAC `b:real` THEN REWRITE_TAC[real_ge] THEN + DISCH_TAC THEN + MP_TAC(SPECL [`alpha:real`;`y:real`;`z:real`;`b:real`] + CARLESON_G_AVG_BOUNDS) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[]]; + MATCH_MP_TAC(ISPEC `at_posinfinity` REALLIM_UBOUND) THEN + EXISTS_TAC `\b. inv b * real_integral (real_interval[&0,b]) (\beta. + carleson_theta' z alpha beta y)` THEN + ASM_REWRITE_TAC[TRIVIAL_LIMIT_AT_POSINFINITY; + EVENTUALLY_AT_POSINFINITY] THEN + EXISTS_TAC `&1` THEN X_GEN_TAC `b:real` THEN REWRITE_TAC[real_ge] THEN + DISCH_TAC THEN + MP_TAC(SPECL [`alpha:real`;`y:real`;`z:real`;`b:real`] + CARLESON_G_AVG_BOUNDS) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; REWRITE_TAC[] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[]]]);; + +(* ========================================================================= *) +(* 286R-(d) translation-invariance and (g) scale-invariance of g. *) +(* ========================================================================= *) + +(* theta'_{z+gam,alpha,beta}(y+gam) = theta'_{z,alpha,beta+alpha*gam}(y). *) +let THETA'_TRANSLATE = prove + (`!z alpha beta y gam. + carleson_theta' (z + gam) alpha beta (y + gam) = + carleson_theta' z alpha (beta + alpha * gam) y`, + REPEAT GEN_TAC THEN REWRITE_TAC[carleson_theta'] THEN + SUBGOAL_THEN + `alpha * (z + gam) + beta = alpha * z + beta + alpha * gam:real` SUBST1_TAC + THENL + [CONV_TAC REAL_RING; ALL_TAC] THEN + SUBGOAL_THEN + `alpha * (y + gam) + beta = alpha * y + beta + alpha * gam:real` SUBST1_TAC + THENL + [CONV_TAC REAL_RING; REFL_TAC]);; + +(* the shifted-args average = the window-shifted average (c = alpha*gam). *) +let CARLESON_G_SHIFT_AVG = prove + (`!alpha y z gam b. + inv b * real_integral (real_interval[&0,b]) (\beta. carleson_theta' (z + + gam) alpha beta (y + gam)) = + inv b * real_integral (real_interval[alpha * gam, alpha * gam + b]) + (\beta. carleson_theta' z alpha beta y)`, + REPEAT GEN_TAC THEN AP_TERM_TAC THEN + SUBGOAL_THEN + `(\beta. carleson_theta' (z + gam) alpha beta (y + gam)) = + (\beta. (\b. carleson_theta' z alpha b y) (beta + alpha * gam))` SUBST1_TAC + THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + REWRITE_TAC[THETA'_TRANSLATE]; ALL_TAC] THEN + CONV_TAC SYM_CONV THEN + MP_TAC(SPECL [`\b. carleson_theta' z alpha b y`; `alpha * gam:real`; + `b:real`] REAL_INTEGRAL_SHIFT) THEN + REWRITE_TAC[THETA'_BETA_INTEGRABLE] THEN DISCH_THEN ACCEPT_TAC);; + +(* 286R-(d), gamma >= 0: g(alpha,y+gam,z+gam) = g(alpha,y,z). *) +let CARLESON_G_TRANSLATE_NONNEG = prove + (`!alpha y z gam. &0 < alpha /\ y < z /\ &0 <= gam + ==> carleson_g alpha (y + gam) (z + gam) = carleson_g alpha y z`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`at_posinfinity`; + `\b. inv b * real_integral (real_interval[&0,b]) (\beta. carleson_theta' (z + + gam) alpha beta (y + gam))`; + `carleson_g alpha (y + gam) (z + gam)`; + `carleson_g alpha y z`] REALLIM_UNIQUE) THEN + REWRITE_TAC[TRIVIAL_LIMIT_AT_POSINFINITY] THEN DISCH_THEN MATCH_MP_TAC THEN + CONJ_TAC THENL + [MP_TAC(SPECL [`alpha:real`;`y + gam:real`;`z + gam:real`] + CARLESON_G_AVG_LIMIT) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[]]; + ONCE_REWRITE_TAC[CARLESON_G_SHIFT_AVG] THEN + GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) [REAL_ADD_SYM] THEN + MATCH_MP_TAC CESARO_SHIFT_INVARIANT THEN + ASM_SIMP_TAC[REAL_LE_MUL; REAL_LT_IMP_LE] THEN + REPEAT CONJ_TAC THENL + [GEN_TAC THEN REWRITE_TAC[CARLESON_THETA'_BOUNDS]; + GEN_TAC THEN REWRITE_TAC[CARLESON_THETA'_BOUNDS]; + REWRITE_TAC[THETA'_BETA_INTEGRABLE]; + MP_TAC(SPECL [`alpha:real`;`y:real`;`z:real`] CARLESON_G_AVG_LIMIT) THEN + ASM_REWRITE_TAC[]]]);; + +(* 286R-(d), any gamma. *) +let CARLESON_G_TRANSLATE = prove + (`!alpha y z gam. &0 < alpha /\ y < z + ==> carleson_g alpha (y + gam) (z + gam) = carleson_g alpha y z`, + REPEAT STRIP_TAC THEN + DISJ_CASES_TAC(REAL_ARITH `&0 <= gam \/ &0 <= --gam`) THENL + [MATCH_MP_TAC CARLESON_G_TRANSLATE_NONNEG THEN ASM_REWRITE_TAC[]; + MP_TAC(SPECL [`alpha:real`;`y + gam:real`;`z + gam:real`;`--gam:real`] + CARLESON_G_TRANSLATE_NONNEG) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `(y + gam) + --gam:real = y /\ (z + gam) + --gam:real = z` (fun th -> + REWRITE_TAC[th]) THENL + [CONJ_TAC THEN REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(fun th -> REWRITE_TAC[SYM th])]);; + +(* theta'_{gam*z,alpha,beta}(gam*y) = theta'_{z,alpha*gam,beta}(y). *) +let THETA'_SCALE_ARG = prove + (`!z alpha beta y gam. + carleson_theta' (gam * z) alpha beta (gam * y) = carleson_theta' z (alpha + * gam) beta y`, + REPEAT GEN_TAC THEN REWRITE_TAC[carleson_theta'; REAL_MUL_ASSOC]);; + +(* 286R-(g): g(alpha, gam*y, gam*z) = g(alpha*gam, y, z). *) +let CARLESON_G_SCALE_ARG = prove + (`!alpha y z gam. carleson_g alpha (gam * y) (gam * z) = carleson_g (alpha * + gam) y z`, + REPEAT GEN_TAC THEN REWRITE_TAC[carleson_g] THEN + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN AP_TERM_TAC THEN + AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN REWRITE_TAC[THETA'_SCALE_ARG]);; + +(* ========================================================================= *) +(* 286R-(f) scale-doubling invariance g(2a,.)=g(a,.), and the *) +(* carleson_thetatilde *) +(* definition (Fremlin mt286.tex 2611-2620, 2530). *) +(* ========================================================================= *) + +(* int_0^{2c} f = 2 int_0^c (\x. f(2x)) for c>=0 *) +(* (HAS_REAL_INTEGRAL_AFFINITY). *) +let REAL_INTEGRAL_SCALE2 = prove + (`!f c. &0 <= c /\ (!u v. f real_integrable_on real_interval[u,v]) + ==> real_integral (real_interval[&0,&2 * c]) f = + &2 * real_integral (real_interval[&0,c]) (\x. f(&2 * x))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:real->real`; + `real_interval[&0,&2 * c]`] REAL_INTEGRABLE_INTEGRAL) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPECL [`&2`; `&0`] o MATCH_MP + (REWRITE_RULE[TAUT `a /\ b ==> c <=> a ==> b ==> c`] + HAS_REAL_INTEGRAL_AFFINITY)) THEN + REWRITE_TAC[REAL_ARITH `~(&2 = &0)`; REAL_ADD_RID; REAL_ABS_NUM] THEN + SUBGOAL_THEN + `IMAGE (\x. inv(&2) * (x - &0)) (real_interval[&0,&2 * c]) = + real_interval[&0,c]` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_REAL_INTERVAL; REAL_SUB_RZERO] THEN + X_GEN_TAC `t:real` THEN + EQ_TAC THENL + [STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + STRIP_TAC THEN EXISTS_TAC `&2 * t` THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_ARITH `inv(&2) * &2 * t = t`]; ASM_REAL_ARITH_TAC]]; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o MATCH_MP REAL_INTEGRAL_UNIQUE) THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN REAL_ARITH_TAC);; + +(* F ---> L at +inf ==> (\b. F(b/2)) ---> L at +inf. *) +let REALLIM_HALF_ARG = prove + (`!F L. (F ---> L) at_posinfinity ==> ((\b. F(b / &2)) ---> L) + at_posinfinity`, + REPEAT GEN_TAC THEN REWRITE_TAC[REALLIM_AT_POSINFINITY] THEN + DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `B:real`) THEN EXISTS_TAC `&2 * B` THEN + X_GEN_TAC `b:real` THEN REWRITE_TAC[real_ge] THEN DISCH_TAC THEN + BETA_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[real_ge] THEN + ASM_REAL_ARITH_TAC);; + +(* (1/b) int_0^b theta'_{z,2a,.}(y) = inv(b/2) int_0^{b/2} *) +(* theta'_{z,a,.}(y). *) +let CARLESON_G_SCALE2_AVG = prove + (`!alpha y z b. &0 < b + ==> inv b * real_integral (real_interval[&0,b]) (\beta. carleson_theta' z + (&2 * alpha) beta y) = + inv(b / &2) * real_integral (real_interval[&0,b / &2]) (\gm. + carleson_theta' z alpha gm y)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[real_div] THEN + MP_TAC(SPECL [`\beta. carleson_theta' z (&2 * alpha) beta y`; + `b * inv(&2)`] REAL_INTEGRAL_SCALE2) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[THETA'_BETA_INTEGRABLE] THEN + ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `&2 * (b * inv(&2)) = b` SUBST1_TAC THENL + [CONV_TAC REAL_FIELD; ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN CONV_TAC(DEPTH_CONV BETA_CONV) THEN + SUBGOAL_THEN `(\x. carleson_theta' z (&2 * alpha) (&2 * x) y) = + (\gm. carleson_theta' z alpha gm y)` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + REWRITE_TAC[CARLESON_THETA'_SCALE2]; ALL_TAC] THEN + ABBREV_TAC `I2 = real_integral (real_interval[&0,b * inv(&2)]) (\gm. + carleson_theta' z alpha gm y)` THEN + SUBGOAL_THEN `~(b = &0)` MP_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + CONV_TAC REAL_FIELD);; + +(* 286R-(f): g(2*alpha, y, z) = g(alpha, y, z) for alpha>0. *) +let CARLESON_G_SCALE2 = prove + (`!alpha y z. &0 < alpha ==> carleson_g (&2 * alpha) y z = carleson_g alpha y + z`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `(z:real) <= y` THENL + [ASM_SIMP_TAC[CARLESON_G_TRIVIAL; REAL_ARITH `&0 < a ==> &0 < &2 * a`]; + ALL_TAC] THEN + SUBGOAL_THEN `(y:real) < z` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPECL [`at_posinfinity`; + `\b. inv b * real_integral (real_interval[&0,b]) (\beta. carleson_theta' z + (&2 * alpha) beta y)`; + `carleson_g (&2 * alpha) y z`; `carleson_g alpha y z`] REALLIM_UNIQUE) THEN + REWRITE_TAC[TRIVIAL_LIMIT_AT_POSINFINITY] THEN DISCH_THEN MATCH_MP_TAC THEN + CONJ_TAC THENL + [MP_TAC(SPECL [`&2 * alpha`;`y:real`;`z:real`] CARLESON_G_AVG_LIMIT) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[]]; + MATCH_MP_TAC REALLIM_TRANSFORM_EVENTUALLY THEN + EXISTS_TAC `\b. (\c. inv c * real_integral (real_interval[&0,c]) (\gm. + carleson_theta' z alpha gm y)) (b / &2)` THEN + CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_AT_POSINFINITY] THEN EXISTS_TAC `&1` THEN + X_GEN_TAC `b:real` THEN REWRITE_TAC[real_ge] THEN DISCH_TAC THEN + BETA_TAC THEN + MP_TAC(SPECL [`alpha:real`;`y:real`;`z:real`;`b:real`] + CARLESON_G_SCALE2_AVG) THEN + ANTS_TAC THENL + [ASM_REAL_ARITH_TAC; DISCH_THEN(fun th -> REWRITE_TAC[th])]; + MATCH_MP_TAC REALLIM_HALF_ARG THEN + MP_TAC(SPECL [`alpha:real`;`y:real`;`z:real`] CARLESON_G_AVG_LIMIT) THEN + ASM_REWRITE_TAC[]]]);; + +(* carleson_thetatilde z y = int_1^2 (1/alpha) g(alpha,y,z) dalpha. *) +let carleson_thetatilde = new_definition + `carleson_thetatilde z y = + real_integral (real_interval[&1,&2]) (\alpha. inv alpha * carleson_g alpha + y z)`;; + +(* ========================================================================= *) +(* Octave (log-)shift-invariance of int_gam^{2gam} (1/a) G(a) da for a *) +(* function G with the doubling symmetry G(2a)=G(a) (a>0): the integral over *) +(* ANY octave [gam,2gam] equals the one over [1,2] (Fremlin 286R (e)-(g)). *) +(* Elementary a=2x-affinity + split, measurable-friendly (no log *) +(* substitution). *) +(* Integrability is required only on positive intervals (00). *) +(* ========================================================================= *) + +(* int_[2p,2q] inv a G da = int_[p,q] inv a G da (0 G(&2 * a) = G a) /\ + (!u v. &0 < u ==> (\a. inv a * G a) real_integrable_on + real_interval[u,v]) + ==> real_integral (real_interval[&2 * p,&2 * q]) (\a. inv a * G a) = + real_integral (real_interval[p,q]) (\a. inv a * G a)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `real_integral (real_interval[p,q]) (\x. inv(&2 * x) * G(&2 * x)) = + inv(&2) * real_integral (real_interval[&2 * p,&2 * q]) (\a. inv a * G a)` + (LABEL_TAC "str") THENL + [MP_TAC(ISPECL [`\a. inv a * (G:real->real) a`; + `real_integral (real_interval[&2 * p,&2 * q]) (\a. inv a * + (G:real->real) a)`; + `&2 * p`; `&2 * q`; `&2`] HAS_REAL_INTEGRAL_STRETCH) THEN + REWRITE_TAC[GSYM HAS_REAL_INTEGRAL_INTEGRAL] THEN + SUBGOAL_THEN + `(\a. inv a * G a) real_integrable_on real_interval[&2 * p,&2 * q]` + (fun th -> REWRITE_TAC[th; REAL_ARITH `~(&2 = &0)`]) THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `IMAGE (\x. inv(&2) * x) (real_interval[&2 * p,&2 * q]) = + real_interval[p,q]` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_REAL_INTERVAL] THEN + X_GEN_TAC `t:real` THEN + EQ_TAC THENL + [STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + STRIP_TAC THEN EXISTS_TAC `&2 * t` THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ASM_REAL_ARITH_TAC]]; + DISCH_THEN(MP_TAC o MATCH_MP REAL_INTEGRAL_UNIQUE) THEN BETA_TAC THEN + REWRITE_TAC[REAL_ABS_NUM]]; + SUBGOAL_THEN + `real_integral (real_interval[p,q]) (\x. inv(&2) * inv x * G x) = + inv(&2) * real_integral (real_interval[p,q]) (\a. inv a * G a)` + (LABEL_TAC "lmul") THENL + [MP_TAC(ISPECL [`\a. inv a * (G:real->real) a`; `inv(&2)`; + `real_interval[p,q]`] + REAL_INTEGRAL_LMUL) THEN + ANTS_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC; + DISCH_THEN(fun th -> REWRITE_TAC[GSYM th]) THEN + MATCH_MP_TAC REAL_INTEGRAL_EQ THEN REWRITE_TAC[] THEN REAL_ARITH_TAC]; + SUBGOAL_THEN + `real_integral (real_interval[p,q]) (\x. inv(&2 * x) * G(&2 * x)) = + real_integral (real_interval[p,q]) (\x. inv(&2) * inv x * G x)` + (LABEL_TAC "eq") THENL + [MATCH_MP_TAC REAL_INTEGRAL_EQ THEN X_GEN_TAC `x:real` THEN + REWRITE_TAC[IN_REAL_INTERVAL] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real` o + check (fun t -> can (find_term (fun s -> s = `&2 * a`)) (concl t))) + THEN + ANTS_TAC THENL + [ASM_REAL_ARITH_TAC; + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[REAL_INV_MUL] THEN + REAL_ARITH_TAC]; + MATCH_MP_TAC(REAL_ARITH `inv(&2) * a = inv(&2) * b ==> a = b`) THEN + USE_THEN "eq" (fun e -> USE_THEN "str" (fun s -> USE_THEN + "lmul" (fun l -> + REWRITE_TAC[GSYM s; GSYM l; e])))]]]);; + +(* [1,2]-split case: for gam in [1,2], int_[gam,2gam] inv a G = int_[1,2] *) +(* inv a G. *) +let OCTAVE_INV_UNIT = prove + (`!G gam. &1 <= gam /\ gam <= &2 /\ + (!a. &0 < a ==> G(&2 * a) = G a) /\ + (!u v. &0 < u ==> (\a. inv a * G a) real_integrable_on + real_interval[u,v]) + ==> real_integral (real_interval[gam,&2 * gam]) (\a. inv a * G a) = + real_integral (real_interval[&1,&2]) (\a. inv a * G a)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`G:real->real`; `&1:real`; `gam:real`] PARTIAL_DOUBLE) THEN + ASM_REWRITE_TAC[REAL_MUL_RID; REAL_LT_01] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`\a. inv a * (G:real->real) a`; `gam:real`; `&2 * gam`; `&2`] + REAL_INTEGRAL_COMBINE) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; ASM_REAL_ARITH_TAC; + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC]; ALL_TAC] THEN + MP_TAC(ISPECL [`\a. inv a * (G:real->real) a`; `&1:real`; `&2:real`; + `gam:real`] + REAL_INTEGRAL_COMBINE) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; ASM_REAL_ARITH_TAC; + FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[REAL_LT_01]]; ALL_TAC] THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o check (fun t -> is_eq (concl t)))) THEN + CONV_TAC REAL_ARITH);; + +(* octave doubling equivalence PHI(2gam)=PHI(gam) (from PARTIAL_DOUBLE, *) +(* p=gam,q=2gam). *) +let OCTAVE_DOUBLE_EQ = prove + (`!G gam. &0 < gam /\ + (!a. &0 < a ==> G(&2 * a) = G a) /\ + (!u v. &0 < u ==> (\a. inv a * G a) real_integrable_on + real_interval[u,v]) + ==> real_integral (real_interval[&2 * gam,&2 * (&2 * gam)]) (\a. inv a * G + a) = + real_integral (real_interval[gam,&2 * gam]) (\a. inv a * G a)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`G:real->real`; `gam:real`; `&2 * gam`] PARTIAL_DOUBLE) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC);; + +(* num-power ladder: PHI(2^n * gam) = PHI(gam). *) +let OCTAVE_POW2_LADDER = prove + (`!G gam. &0 < gam /\ + (!a. &0 < a ==> G(&2 * a) = G a) /\ + (!u v. &0 < u ==> (\a. inv a * G a) real_integrable_on + real_interval[u,v]) + ==> !n. real_integral (real_interval[&2 pow n * gam,&2 * (&2 pow n * + gam)]) (\a. inv a * G a) = + real_integral (real_interval[gam,&2 * gam]) (\a. inv a * G a)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN INDUCT_TAC THENL + [REWRITE_TAC[real_pow; REAL_MUL_LID]; + REWRITE_TAC[real_pow] THEN + MP_TAC(ISPECL [`G:real->real`; `&2 pow n * gam`] OCTAVE_DOUBLE_EQ) THEN + ASM_SIMP_TAC[REAL_LT_MUL; REAL_POW_LT; REAL_ARITH `&0 < &2`] THEN + SUBGOAL_THEN `&2 * &2 pow n * gam = (&2 * &2 pow n) * gam` SUBST1_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN ASM_REWRITE_TAC[]]);; + +(* every gam>=1 is 2^n * delta with delta in [1,2). *) +let DYADIC_NORM_GE1 = prove + (`!gam. &1 <= gam ==> ?n:num delta. &1 <= delta /\ delta < &2 /\ gam = &2 pow + n * delta`, + GEN_TAC THEN DISCH_TAC THEN + MP_TAC(ISPEC `gam:real` REAL_ARCH_POW2) THEN + DISCH_THEN(X_CHOOSE_TAC `m:num`) THEN + SUBGOAL_THEN `?n. gam < &2 pow n` (MP_TAC o ONCE_REWRITE_RULE[num_WOP]) THENL + [EXISTS_TAC `m:num` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `1 <= n` ASSUME_TAC THENL + [REWRITE_TAC[ARITH_RULE `1 <= n <=> ~(n = 0)`] THEN DISCH_TAC THEN + UNDISCH_TAC `gam < &2 pow n` THEN ASM_REWRITE_TAC[real_pow] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n - 1`) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; REWRITE_TAC[REAL_NOT_LT] THEN DISCH_TAC] THEN + MAP_EVERY EXISTS_TAC [`n - 1`; `gam / &2 pow (n - 1)`] THEN + SUBGOAL_THEN `&0 < &2 pow (n - 1)` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_POW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + REPEAT CONJ_TAC THENL + [ASM_SIMP_TAC[REAL_LE_RDIV_EQ] THEN ASM_REWRITE_TAC[REAL_MUL_LID]; + ASM_SIMP_TAC[REAL_LT_LDIV_EQ] THEN + SUBGOAL_THEN `&2 * &2 pow (n - 1) = &2 pow n` SUBST1_TAC THENL + [REWRITE_TAC[GSYM(CONJUNCT2 real_pow)] THEN AP_TERM_TAC THEN + ASM_ARITH_TAC; + ASM_REWRITE_TAC[]]; + ASM_SIMP_TAC[REAL_DIV_LMUL; REAL_LT_IMP_NZ]]);; + +(* every gam in (0,1) has 2^n * gam in [1,2). *) +let DYADIC_NORM_LT1 = prove + (`!gam. &0 < gam /\ gam < &1 ==> ?n:num delta. &1 <= delta /\ delta < &2 /\ &2 + pow n * gam = delta`, + GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN + `?n:num. &1 <= &2 pow n * gam` (MP_TAC o ONCE_REWRITE_RULE[num_WOP]) THENL + [MP_TAC(SPEC `inv(gam:real)` REAL_ARCH_POW2) THEN + DISCH_THEN(X_CHOOSE_TAC `m:num`) THEN + EXISTS_TAC `m:num` THEN + SUBGOAL_THEN `&1 = gam * inv gam` SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_MUL_RINV THEN + ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `gam * &2 pow m` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; ASM_REAL_ARITH_TAC]; + REWRITE_TAC[REAL_MUL_SYM] THEN REAL_ARITH_TAC]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `1 <= n` ASSUME_TAC THENL + [REWRITE_TAC[ARITH_RULE `1 <= n <=> ~(n = 0)`] THEN DISCH_TAC THEN + UNDISCH_TAC `&1 <= &2 pow n * gam` THEN + ASM_REWRITE_TAC[real_pow; REAL_MUL_LID] THEN + ASM_REAL_ARITH_TAC; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n - 1`) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; REWRITE_TAC[REAL_NOT_LE] THEN DISCH_TAC] THEN + MAP_EVERY EXISTS_TAC [`n:num`; `&2 pow n * gam`] THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `&2 pow n * gam = &2 * (&2 pow (n - 1) * gam)` SUBST1_TAC THENL + [REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[GSYM(CONJUNCT2 real_pow)] THEN AP_TERM_TAC THEN ASM_ARITH_TAC; + ASM_REAL_ARITH_TAC]);; + +(* unified: every gam>0 is 2^n*delta OR 2^n*gam=delta, delta in [1,2). *) +let DYADIC_NORM = prove + (`!gam. &0 < gam + ==> ?n:num delta. &1 <= delta /\ delta < &2 /\ + (gam = &2 pow n * delta \/ &2 pow n * gam = delta)`, + GEN_TAC THEN DISCH_TAC THEN ASM_CASES_TAC `gam < &1` THENL + [MP_TAC(SPEC `gam:real` DYADIC_NORM_LT1) THEN ASM_REWRITE_TAC[] THEN + STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`n:num`; `delta:real`] THEN + ASM_REWRITE_TAC[]; + MP_TAC(SPEC `gam:real` DYADIC_NORM_GE1) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`n:num`; `delta:real`] THEN + ASM_REWRITE_TAC[]]);; + +(* general-gam octave shift-invariance, generic G: int_[gam,2gam] = *) +(* int_[1,2], gam>0. *) +let CARLESON_G_OCTAVE_ABSTRACT = prove + (`!G gam. &0 < gam /\ + (!a. &0 < a ==> G(&2 * a) = G a) /\ + (!u v. &0 < u ==> (\a. inv a * G a) real_integrable_on + real_interval[u,v]) + ==> real_integral (real_interval[gam,&2 * gam]) (\a. inv a * G a) = + real_integral (real_interval[&1,&2]) (\a. inv a * G a)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(SPEC `gam:real` DYADIC_NORM) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` (X_CHOOSE_THEN + `delta:real` STRIP_ASSUME_TAC)) THEN + SUBGOAL_THEN + `real_integral (real_interval[delta,&2 * delta]) (\a. inv a * G a) = + real_integral (real_interval[&1,&2]) (\a. inv a * G a)` + ASSUME_TAC THENL + [MATCH_MP_TAC OCTAVE_INV_UNIT THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC; + ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`G:real->real`; `delta:real`] OCTAVE_POW2_LADDER) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `n:num`) THEN DISCH_THEN SUBST1_TAC THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC OCTAVE_INV_UNIT THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC; + MP_TAC(ISPECL [`G:real->real`; `gam:real`] OCTAVE_POW2_LADDER) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `n:num`) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + ASM_REWRITE_TAC[]]);; + +(* the log-average integrand is nonnegative on [1,2]. *) +let COUNTABLE_SHIFT_PREIMAGE = prove + (`!c:real D. COUNTABLE D ==> COUNTABLE {beta | (c + beta) IN D}`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC COUNTABLE_SUBSET THEN + EXISTS_TAC `IMAGE (\d:real. d - c) D` THEN ASM_SIMP_TAC[COUNTABLE_IMAGE] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_IMAGE] THEN + X_GEN_TAC `b:real` THEN DISCH_TAC THEN EXISTS_TAC `c + b:real` THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ASM_REWRITE_TAC[]]);; + +(* the dyadic points {real_of_int n * 2^k} are countable. *) +let DYADIC_COUNTABLE = prove + (`COUNTABLE (IMAGE (\(n,k). real_of_int n * &2 zpow k) (:int#int))`, + MATCH_MP_TAC COUNTABLE_IMAGE THEN REWRITE_TAC[GSYM CROSS_UNIV] THEN + MATCH_MP_TAC COUNTABLE_CROSS THEN REWRITE_TAC[INT_COUNTABLE]);; + +(* ... hence negligible as a subset of R^1. *) +let THETA_BAD_BETA_NEGLIGIBLE = prove + (`!alpha y z. negligible + (IMAGE lift {beta | (alpha * z + beta) IN (IMAGE (\(n,k). real_of_int n * + &2 zpow k) (:int#int)) \/ + (alpha * y + beta) IN (IMAGE (\(n,k). real_of_int n * + &2 zpow k) (:int#int))})`, + REPEAT GEN_TAC THEN MATCH_MP_TAC NEGLIGIBLE_COUNTABLE THEN + MATCH_MP_TAC COUNTABLE_IMAGE THEN + REWRITE_TAC[SET_RULE `{beta | P beta \/ Q beta} = {beta | P beta} UNION {beta + | Q beta}`] THEN + REWRITE_TAC[COUNTABLE_UNION] THEN CONJ_TAC THEN + MATCH_MP_TAC COUNTABLE_SHIFT_PREIMAGE THEN REWRITE_TAC[DYADIC_COUNTABLE]);; + + +(* carleson_theta sups over (k,nJ) only -- nI is inert in tile_k/Jr/Jl/ymid. *) +(* This reindexing is the first structural brick toward theta's local *) +(* continuity at non-dyadic points (the DCT-continuity route to *) +(* alpha-measurability of g). *) +let THETA_NODEP_NI = prove + (`!z y. carleson_theta z y = + sup ({ Re(fourier carleson_phi (&2 zpow (--k) * (y - dyho_mid (k - &1) (&2 + * nJ)))) pow 2 + | (k,nJ) | z IN dyho (k - &1) (&2 * nJ + &1) /\ y IN dyho (k - &1) (&2 + * nJ) } UNION {&0})`, + REPEAT GEN_TAC THEN REWRITE_TAC[carleson_theta] THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_UNION; IN_SING; IN_ELIM_THM] THEN + X_GEN_TAC `w:real` THEN AP_THM_TAC THEN AP_TERM_TAC THEN + EQ_TAC THEN STRIP_TAC THENL + [MAP_EVERY EXISTS_TAC [`tile_k (s:int#int#int)`; + `SND(SND(s:int#int#int))`] THEN + SUBGOAL_THEN + `tile_Jr (s:int#int#int) = dyho (tile_k s - &1) (&2 * SND(SND s) + &1) /\ + tile_Jl (s:int#int#int) = dyho (tile_k s - &1) (&2 * SND(SND + s)) /\ + tile_ymid (s:int#int#int) = dyho_mid (tile_k s - &1) (&2 * + SND(SND s))` + (fun th -> RULE_ASSUM_TAC(REWRITE_RULE[th]) THEN + ASM_REWRITE_TAC[th]) THEN + MP_TAC(ISPEC `s:int#int#int` PAIR_SURJECTIVE) THEN + DISCH_THEN(X_CHOOSE_THEN `k:int` (X_CHOOSE_THEN + `q:int#int` SUBST1_TAC)) THEN + MP_TAC(ISPEC `q:int#int` PAIR_SURJECTIVE) THEN + DISCH_THEN(X_CHOOSE_THEN `nI:int` (X_CHOOSE_THEN `nJ:int` SUBST1_TAC)) THEN + REWRITE_TAC[tile_k; tile_ymid; tile_Jr; tile_Jl; SND]; + EXISTS_TAC `(k:int,(&0):int,nJ:int)` THEN + ASM_REWRITE_TAC[tile_k; tile_ymid; tile_Jr; tile_Jl]]);; + +(* each qualifying (k,nJ)-term is <= carleson_theta z y (a sup upper bound). *) +let THETA_TERM_LE = prove + (`!z y k nJ. z IN dyho (k - &1) (&2 * nJ + &1) /\ y IN dyho (k - &1) (&2 * nJ) + ==> Re(fourier carleson_phi (&2 zpow (--k) * (y - dyho_mid (k - &1) (&2 * + nJ)))) pow 2 + <= carleson_theta z y`, + REPEAT STRIP_TAC THEN GEN_REWRITE_TAC RAND_CONV [THETA_NODEP_NI] THEN + MATCH_MP_TAC REAL_LE_SUP THEN + MAP_EVERY EXISTS_TAC [`&1`; + `Re(fourier carleson_phi (&2 zpow (--k) * (y - dyho_mid (k - &1) (&2 * + nJ)))) pow 2`] THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[IN_UNION; IN_ELIM_THM] THEN DISJ1_TAC THEN + MAP_EVERY EXISTS_TAC [`k:int`; `nJ:int`] THEN ASM_REWRITE_TAC[]; + REAL_ARITH_TAC; + X_GEN_TAC `w:real` THEN REWRITE_TAC[IN_UNION; IN_ELIM_THM; IN_SING] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[CARLESON_THETA_TERM_BOUNDS; REAL_LE_01]]);; + +(* k-band lower bound: a qualifying tile forces Z - Y < 2^k (Z,Y in adjacent *) +(* (k-1)-cells). With CARLESON_TILE_GATE (2^k <= 20(Z-Y), window nonzero) *) +(* this *) +(* pins k to a finite band Z-Y < 2^k <= 20(Z-Y): the finiteness making *) +(* carleson_theta a max of finitely many continuous windows near a *) +(* non-dyadic pt. *) +let THETA_JR_JL_KBAND_LO = prove + (`!k nJ Z Y. Z IN dyho (k - &1) (&2 * nJ + &1) /\ Y IN dyho (k - &1) (&2 * nJ) + ==> Z - Y < &2 zpow k`, + REPEAT GEN_TAC THEN REWRITE_TAC[dyho; IN_ELIM_THM] THEN STRIP_TAC THEN + GEN_REWRITE_TAC (RAND_CONV) [ZPOW2_PRED] THEN + RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_INT_CLAUSES]) THEN + ASM_REAL_ARITH_TAC);; + +(* out-of-band qualifying tile has zero window (CARLESON_TILE_GATE *) +(* contrapositive). *) +let THETA_OUTBAND_ZERO = prove + (`!z y k nJ. z IN dyho (k - &1) (&2 * nJ + &1) /\ ~(&2 zpow k <= &20 * (z - + y)) + ==> Re(fourier carleson_phi (&2 zpow (--k) * (y - dyho_mid (k - &1) (&2 * + nJ)))) pow 2 = &0`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`k:int`;`(&0):int`;`nJ:int`;`z:real`;`y:real`] + CARLESON_TILE_GATE) THEN + REWRITE_TAC[tile_Jr; tile_k; tile_ymid] THEN + ASM_CASES_TAC `Re(fourier carleson_phi (&2 zpow (--k) * (y - dyho_mid (k - + &1) (&2 * nJ)))) pow 2 = &0` THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC);; + +(* carleson_theta as a sup RESTRICTED to the finite k-band *) +(* (Z-Y<2^k<=20(Z-Y)): out-of-band terms have zero window, so dropping them *) +(* leaves the sup unchanged. This finite-band representation is the base for *) +(* theta's local continuity at non-dyadic points (B1, the DCT route to *) +(* alpha-measurability of g). *) +let THETA_BAND_SUP = prove + (`!z y. carleson_theta z y = + sup ({ Re(fourier carleson_phi (&2 zpow (--k) * (y - dyho_mid (k - &1) (&2 + * nJ)))) pow 2 + | (k,nJ) | z IN dyho (k - &1) (&2 * nJ + &1) /\ y IN dyho (k - &1) (&2 + * nJ) /\ + &2 zpow k <= &20 * (z - y) } UNION {&0})`, + REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [THETA_NODEP_NI] THEN + AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_UNION; IN_SING; IN_ELIM_THM] THEN + X_GEN_TAC `w:real` THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THENL + [ASM_CASES_TAC `&2 zpow k <= &20 * (z - y)` THENL + [DISJ1_TAC THEN MAP_EVERY EXISTS_TAC [`k:int`; `nJ:int`] THEN + ASM_REWRITE_TAC[]; + DISJ2_TAC THEN + MP_TAC(SPECL [`z:real`;`y:real`;`k:int`; + `nJ:int`] THETA_OUTBAND_ZERO) THEN + ASM_REWRITE_TAC[]]; + DISJ1_TAC THEN MAP_EVERY EXISTS_TAC [`k:int`; `nJ:int`] THEN + ASM_REWRITE_TAC[]]);; + +(* dyadic-cell interior stability: if x0 is STRICTLY interior to dyho k n, *) +(* then any *) +(* sequence converging to x0 eventually lands in dyho k n. This makes the *) +(* tile *) +(* memberships stable under the alpha-perturbation at a non-dyadic point -- *) +(* the *) +(* mechanism behind theta's local continuity (B1). *) +let DYHO_INTERIOR_STABLE = prove + (`!k n x0 (xseq:num->real). + real_of_int n * &2 zpow k < x0 /\ x0 < (real_of_int n + &1) * &2 zpow k /\ + (xseq ---> x0) sequentially + ==> eventually (\m. xseq m IN dyho k n) sequentially`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REALLIM_SEQUENTIALLY]) THEN + DISCH_THEN(MP_TAC o SPEC `min (x0 - real_of_int n * &2 zpow k) + ((real_of_int n + &1) * &2 zpow k - x0)`) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN + DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `N:num` THEN + X_GEN_TAC `m:num` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[dyho; IN_ELIM_THM] THEN ASM_REAL_ARITH_TAC);; + +(* window continuity: y |-> Re(fourier carleson_phi (A*(y-m)))^2 is *) +(* continuous on R *) +(* (carleson_phi Schwartz => fourier continuous; compose), hence *) +(* real_continuous *) +(* atreal every point, hence preserves sequential limits. The second B1 *) +(* continuity *) +(* ingredient (with DYHO_INTERIOR_STABLE) for theta's local continuity. *) +let WINDOW_CONTINUOUS_ON = prove + (`!A m. (\y. Re(fourier carleson_phi (A * (y - m))) pow 2) real_continuous_on + (:real)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[REAL_CONTINUOUS_ON; IMAGE_LIFT_UNIV; o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_LIFT_POW THEN + REWRITE_TAC[RE_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_LIFT_COMPONENT_COMPOSE THEN + SUBGOAL_THEN + `(\z:real^1. fourier carleson_phi (A * (drop z - m))) = + (\w:real^1. fourier carleson_phi (drop w)) o (\z:real^1. lift(A * (drop z - + m)))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; o_THM; LIFT_DROP]; ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL + [REWRITE_TAC[LIFT_CMUL; LIFT_SUB] THEN + MATCH_MP_TAC CONTINUOUS_ON_CMUL THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN + REWRITE_TAC[CONTINUOUS_ON_CONST] THEN + SUBGOAL_THEN `(\z:real^1. lift(drop z)) = (\z:real^1. z)` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; LIFT_DROP]; REWRITE_TAC[CONTINUOUS_ON_ID]]; + MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `(:real^1)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC FOURIER_CONTINUOUS_ON THEN + MATCH_MP_TAC SCHWARTZ_ABSINT THEN REWRITE_TAC[CARLESON_PHI_SCHWARTZ]; + REWRITE_TAC[SUBSET_UNIV]]]);; + +let WINDOW_ATREAL = prove + (`!A m y. (\y. Re(fourier carleson_phi (A * (y - m))) pow 2) real_continuous + atreal y`, + REPEAT GEN_TAC THEN + MP_TAC(SPECL [`A:real`;`m:real`] WINDOW_CONTINUOUS_ON) THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + DISCH_THEN(MP_TAC o SPEC `y:real`) THEN + REWRITE_TAC[IN_UNIV; WITHINREAL_UNIV]);; + +let WINDOW_REALLIM = prove + (`!A m (yseq:num->real) y0. (yseq ---> y0) sequentially + ==> ((\n. Re(fourier carleson_phi (A * (yseq n - m))) pow 2) + ---> Re(fourier carleson_phi (A * (y0 - m))) pow 2) sequentially`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\y. Re(fourier carleson_phi (A * (y - m))) pow 2`; + `sequentially`; `yseq:num->real`; + `y0:real`] REALLIM_REAL_CONTINUOUS_FUNCTION) THEN + ASM_REWRITE_TAC[WINDOW_ATREAL] THEN REWRITE_TAC[]);; + +(* At a non-dyadic point, dyho membership is STRICT interior (open cell). *) +let DYHO_NONDYADIC_INTERIOR = prove + (`!k n Z. Z IN dyho k n /\ + ~(Z IN IMAGE (\(m,j). real_of_int m * &2 zpow j) (:int#int)) + ==> real_of_int n * &2 zpow k < Z /\ Z < (real_of_int n + &1) * &2 zpow k`, + REPEAT GEN_TAC THEN REWRITE_TAC[dyho; IN_ELIM_THM] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `~(Z = real_of_int n * &2 zpow k)` MP_TAC THENL + [DISCH_TAC THEN + UNDISCH_TAC `~(Z IN IMAGE (\(m,j). real_of_int m * &2 zpow j) (:int#int))` + THEN + REWRITE_TAC[] THEN REWRITE_TAC[IN_IMAGE; IN_UNIV] THEN + EXISTS_TAC `(n:int,k:int)` THEN ASM_REWRITE_TAC[]; + ASM_REAL_ARITH_TAC]);; + +(* The affine curve b |-> aseq n * z + beta converges when aseq -> alpha. *) +let CURVE_LIM = prove + (`!aseq alpha z beta. (aseq ---> alpha) sequentially + ==> ((\n. aseq n * z + beta) ---> alpha * z + beta) sequentially`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REALLIM_ADD THEN REWRITE_TAC[REALLIM_CONST] THEN + MATCH_MP_TAC REALLIM_RMUL THEN ASM_REWRITE_TAC[]);; + +(* Lower-semicontinuity of carleson_theta along the affine curve at a *) +(* non-dyadic base point: eventually theta on the aseq-curve exceeds the *) +(* base *) +(* value minus eps. The single active tile (k0,nI0,nJ0) stays a witness *) +(* (memberships stable at an interior point) and its window value is *) +(* continuous. *) +let ZPOW2_POSITIVE = prove + (`!k:int. &0 < &2 zpow k`, + GEN_TAC THEN MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC);; + +let ZPOW_NEG_GATE = prove + (`!c1 k:int. &0 < c1 /\ c1 < &2 zpow k ==> &2 zpow (--k) < inv c1`, + REPEAT STRIP_TAC THEN SUBGOAL_THEN + `&2 zpow (--k) = inv(&2 zpow k)` SUBST1_TAC THENL + [REWRITE_TAC[REAL_ZPOW_NEG]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LT_INV2 THEN ASM_REWRITE_TAC[]);; + +let ZPOW_BAND_FINITE = prove + (`!c1 c2. &0 < c1 ==> FINITE {k:int | c1 < &2 zpow k /\ &2 zpow k <= c2}`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `&0 < c2` THENL + [ALL_TAC; + SUBGOAL_THEN + `{k:int | c1 < &2 zpow k /\ &2 zpow k <= c2} = {}` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN + X_GEN_TAC `k:int` THEN + MP_TAC(SPEC `k:int` ZPOW2_POSITIVE) THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[FINITE_EMPTY]]] THEN + MP_TAC(SPEC `c2:real` CARLESON_GATE_L_EXISTS) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `U:int` (LABEL_TAC "UB")) THEN + MP_TAC(ISPEC `inv(c1:real)` CARLESON_GATE_L_EXISTS) THEN + ASM_SIMP_TAC[REAL_LT_INV] THEN + DISCH_THEN(X_CHOOSE_THEN `V:int` (LABEL_TAC "VB")) THEN + MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `{k:int | --V <= k /\ k <= U}` THEN + REWRITE_TAC[FINITE_INT_SEG] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `k:int` THEN STRIP_TAC THEN + SUBGOAL_THEN `&2 zpow (--k) <= inv c1` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LT_IMP_LE THEN MATCH_MP_TAC ZPOW_NEG_GATE THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `k:int <= U` ASSUME_TAC THENL + [USE_THEN "UB" MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `--k:int <= V` ASSUME_TAC THENL + [USE_THEN "VB" MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_INT_ARITH_TAC);; + +(* At an interior point x0 of dyho k n, a sequence converging to x0 *) +(* eventually avoids every OTHER same-scale cell dyho k m (m<>n), by cell *) +(* disjointness. *) +let SUP_FINITE_REALLIM = prove + (`!(s:A->bool) f L. + FINITE s /\ (!i. i IN s ==> ((\n. f (i:A) n) ---> L i) sequentially) + ==> ((\n. sup ({f i n | i IN s} UNION {&0})) + ---> sup ({L i | i IN s} UNION {&0})) sequentially`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `!(g:A->real) t:A->bool. {g i | i IN t} UNION {&0} = (&0) INSERT IMAGE g t` + (fun th -> REWRITE_TAC[th]) THENL + [REWRITE_TAC[SIMPLE_IMAGE; EXTENSION; IN_UNION; IN_INSERT; IN_SING; + IN_IMAGE] THEN + MESON_TAC[]; ALL_TAC] THEN + REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN X_GEN_TAC `eps:real` THEN + DISCH_TAC THEN + ASM_CASES_TAC `s:A->bool = {}` THENL + [ASM_REWRITE_TAC[IMAGE_CLAUSES; SUP_SING; REAL_SUB_REFL; REAL_ABS_NUM] THEN + ASM_MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `eventually (\x:num. !a:A. a IN s ==> abs(f a x - L a) < eps / &2) + sequentially` + MP_TAC THENL + [ASM_SIMP_TAC[EVENTUALLY_FORALL] THEN X_GEN_TAC `i:A` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `i:A`) THEN + ASM_REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + DISCH_THEN(MP_TAC o SPEC `eps / &2`) THEN + ASM_SIMP_TAC[REAL_HALF; EVENTUALLY_SEQUENTIALLY]; ALL_TAC] THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN + DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `N:num` THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN + SUBGOAL_THEN + `!(g:A->real). &0 <= sup ((&0) INSERT IMAGE g s)` (LABEL_TAC "NN") THENL + [GEN_TAC THEN + ASM_SIMP_TAC[REAL_LE_SUP_FINITE; FINITE_INSERT; FINITE_IMAGE; + NOT_INSERT_EMPTY] THEN + EXISTS_TAC `&0` THEN REWRITE_TAC[IN_INSERT; REAL_LE_REFL]; ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH + `a <= b + e / &2 /\ b <= a + e / &2 /\ &0 < e ==> abs(a - b) < e`) THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [ASM_SIMP_TAC[REAL_SUP_LE_FINITE; FINITE_INSERT; FINITE_IMAGE; + NOT_INSERT_EMPTY] THEN + REWRITE_TAC[FORALL_IN_INSERT; FORALL_IN_IMAGE] THEN CONJ_TAC THENL + [USE_THEN "NN" (MP_TAC o SPEC `L:A->real`) THEN ASM_REAL_ARITH_TAC; + X_GEN_TAC `i:A` THEN DISCH_TAC THEN + SUBGOAL_THEN + `(L:A->real) i <= sup ((&0) INSERT IMAGE L s)` ASSUME_TAC THENL + [ASM_SIMP_TAC[REAL_LE_SUP_FINITE; FINITE_INSERT; FINITE_IMAGE; + NOT_INSERT_EMPTY] THEN + EXISTS_TAC `(L:A->real) i` THEN CONJ_TAC THENL + [REWRITE_TAC[IN_INSERT; IN_IMAGE] THEN DISJ2_TAC THEN + EXISTS_TAC `i:A` THEN ASM_REWRITE_TAC[]; REWRITE_TAC[REAL_LE_REFL]]; + ALL_TAC] THEN + SUBGOAL_THEN + `abs((f:A->num->real) i n - L i) < eps / &2` ASSUME_TAC THENL + [FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `i:A` th)) THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_REAL_ARITH_TAC]; + ASM_SIMP_TAC[REAL_SUP_LE_FINITE; FINITE_INSERT; FINITE_IMAGE; + NOT_INSERT_EMPTY] THEN + REWRITE_TAC[FORALL_IN_INSERT; FORALL_IN_IMAGE] THEN CONJ_TAC THENL + [USE_THEN "NN" (MP_TAC o ISPEC `(\i. (f:A->num->real) i n):A->real`) THEN + ASM_REAL_ARITH_TAC; + X_GEN_TAC `j:A` THEN DISCH_TAC THEN + SUBGOAL_THEN + `(f:A->num->real) j n <= sup ((&0) INSERT IMAGE (\i. f (i:A) n) s)` + ASSUME_TAC THENL + [ASM_SIMP_TAC[REAL_LE_SUP_FINITE; FINITE_INSERT; FINITE_IMAGE; + NOT_INSERT_EMPTY] THEN + EXISTS_TAC `(f:A->num->real) j n` THEN CONJ_TAC THENL + [REWRITE_TAC[IN_INSERT; IN_IMAGE] THEN DISJ2_TAC THEN + EXISTS_TAC `j:A` THEN ASM_REWRITE_TAC[]; REWRITE_TAC[REAL_LE_REFL]]; + ALL_TAC] THEN + SUBGOAL_THEN + `abs((f:A->num->real) j n - L j) < eps / &2` ASSUME_TAC THENL + [FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `j:A` th)) THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_REAL_ARITH_TAC]]);; + +(* (i) the base qualifying set F of the k-band sup at (Z0,Y0), Y0 FINITE {(k,nJ) | Z0 IN dyho (k - &1) (&2 * nJ + &1) /\ + Y0 IN dyho (k - &1) (&2 * nJ) /\ + &2 zpow k <= &20 * (Z0 - Y0)}`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC + `IMAGE (\k. (k, @nJ. Y0 IN dyho (k - &1) (&2 * nJ))) + {k:int | Z0 - Y0 < &2 zpow k /\ &2 zpow k <= &20 * (Z0 - Y0)}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC FINITE_IMAGE THEN MATCH_MP_TAC ZPOW_BAND_FINITE THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[SUBSET; FORALL_PAIR_THM; IN_ELIM_PAIR_THM; IN_IMAGE; + IN_ELIM_THM] THEN + MAP_EVERY X_GEN_TAC [`k:int`; `nJ:int`] THEN STRIP_TAC THEN + EXISTS_TAC `k:int` THEN REWRITE_TAC[PAIR_EQ] THEN + REPEAT CONJ_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC SELECT_UNIQUE THEN + X_GEN_TAC `m:int` THEN + REWRITE_TAC[] THEN EQ_TAC THENL + [DISCH_TAC THEN GEN_REWRITE_TAC I [TAUT `p <=> ~ ~p`] THEN + DISCH_TAC THEN + MP_TAC(ISPECL [`k - &1:int`;`&2 * m:int`;`&2 * nJ:int`] + DYHO_DISJOINT_SAMESCALE) THEN + ANTS_TAC THENL [ASM_INT_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[DISJOINT; EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN + DISCH_THEN(MP_TAC o SPEC `Y0:real`) THEN ASM_REWRITE_TAC[]; + DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN ASM_REWRITE_TAC[]]; + MP_TAC(ISPECL [`k:int`;`nJ:int`;`Z0:real`;`Y0:real`] + THETA_JR_JL_KBAND_LO) THEN + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]]]);; + +(* At a non-dyadic base, each qualifying tile has Z0,Y0 STRICTLY interior to *) +(* its two cells (open-cell membership at a non-dyadic point). *) +let THETA_F_STRICT = prove + (`!Z0 Y0 k nJ. + Z0 IN dyho (k - &1) (&2 * nJ + &1) /\ Y0 IN dyho (k - &1) (&2 * nJ) /\ + ~(Z0 IN IMAGE (\(m,j). real_of_int m * &2 zpow j) (:int#int)) /\ + ~(Y0 IN IMAGE (\(m,j). real_of_int m * &2 zpow j) (:int#int)) + ==> real_of_int (&2 * nJ + &1) * &2 zpow (k - &1) < Z0 /\ + Z0 < (real_of_int (&2 * nJ + &1) + &1) * &2 zpow (k - &1) /\ + real_of_int (&2 * nJ) * &2 zpow (k - &1) < Y0 /\ + Y0 < (real_of_int (&2 * nJ) + &1) * &2 zpow (k - &1)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(ISPECL [`k - &1:int`; `&2 * nJ:int`; + `Y0:real`] DYHO_NONDYADIC_INTERIOR) THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`k - &1:int`; `&2 * nJ + &1:int`; + `Z0:real`] DYHO_NONDYADIC_INTERIOR) THEN + ASM_REWRITE_TAC[] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]);; + +(* A tile whose base cells contain Z0,Y0 in their interior stays a witness *) +(* along the Zseq/Yseq curves: eventually its window <= theta(Zseq n)(Yseq *) +(* n). *) +let THETA_TERM_EVENTUAL_LE = prove + (`!Zseq Yseq Z0 Y0 k nJ. + (Zseq ---> Z0) sequentially /\ (Yseq ---> Y0) sequentially /\ + real_of_int (&2 * nJ + &1) * &2 zpow (k - &1) < Z0 /\ + Z0 < (real_of_int (&2 * nJ + &1) + &1) * &2 zpow (k - &1) /\ + real_of_int (&2 * nJ) * &2 zpow (k - &1) < Y0 /\ + Y0 < (real_of_int (&2 * nJ) + &1) * &2 zpow (k - &1) + ==> eventually + (\n. Re(fourier carleson_phi + (&2 zpow (--k) * (Yseq n - dyho_mid (k - &1) (&2 * nJ)))) + pow 2 + <= carleson_theta (Zseq n) (Yseq n)) sequentially`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`k - &1:int`; `&2 * nJ + &1:int`; `Z0:real`; `Zseq:num->real`] + DYHO_INTERIOR_STABLE) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`k - &1:int`; `&2 * nJ:int`; `Y0:real`; `Yseq:num->real`] + DYHO_INTERIOR_STABLE) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`sequentially`; + `\n:num. Zseq n IN dyho (k - &1) (&2 * nJ + &1) /\ Yseq n IN dyho (k - &1) + (&2 * nJ)`; + `\n:num. Re(fourier carleson_phi + (&2 zpow (--k) * (Yseq n - dyho_mid (k - &1) (&2 * nJ)))) pow + 2 + <= carleson_theta (Zseq n) (Yseq n)`] EVENTUALLY_MONO) THEN + REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL + [X_GEN_TAC `n:num` THEN STRIP_TAC THEN + MP_TAC(ISPECL [`Zseq (n:num):real`; `Yseq (n:num):real`; `k:int`; `nJ:int`] + THETA_TERM_LE) THEN + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[EVENTUALLY_AND]]);; + +(* LOWER (LSC) half of the theta-continuity sandwich: eventually the sup *) +(* over the FIXED base gated set F0 of the window at Yseq n is <= theta(Zseq *) +(* n)(Yseq n). Each F0-term qualifies eventually (THETA_TERM_EVENTUAL_LE via *) +(* THETA_F_STRICT); F0 finite (THETA_F_FINITE) so EVENTUALLY_FORALL; then *) +(* REAL_SUP_LE (0<=theta for the {0} floor, CARLESON_THETA_BOUNDS). *) +let DYHO_SAME_POINT_INDEX = prove + (`!k a b x:real. x IN dyho k a /\ x IN dyho k b ==> a = b`, + REPEAT STRIP_TAC THEN GEN_REWRITE_TAC I [TAUT `p <=> ~ ~p`] THEN + DISCH_TAC THEN + MP_TAC(ISPECL [`k:int`;`a:int`;`b:int`] DYHO_DISJOINT_SAMESCALE) THEN + ASM_REWRITE_TAC[DISJOINT; EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN + DISCH_THEN(MP_TAC o SPEC `x:real`) THEN ASM_REWRITE_TAC[]);; + +(* k-localization: eventually any gated-qualifying tile at step n has 2^k in *) +(* (d0/2, 40 d0), d0=Z0-Y0>0. qual gives Zseq n-Yseq n < 2^k <= 20(Zseq *) +(* n-Yseq n) *) +(* (THETA_JR_JL_KBAND_LO); eventually Zseq n-Yseq n in (d0/2,2 d0) *) +(* (REALLIM_SUB). *) +let THETA_QUAL_KLOCAL = prove + (`!Zseq Yseq Z0 Y0. + (Zseq ---> Z0) sequentially /\ (Yseq ---> Y0) sequentially /\ Y0 < Z0 + ==> eventually + (\n. !k nJ. Zseq n IN dyho (k - &1) (&2 * nJ + &1) /\ + Yseq n IN dyho (k - &1) (&2 * nJ) /\ + &2 zpow k <= &20 * (Zseq n - Yseq n) + ==> (Z0 - Y0) / &2 < &2 zpow k /\ &2 zpow k <= &40 * (Z0 + - Y0)) + sequentially`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`sequentially`; `Zseq:num->real`; `Yseq:num->real`; `Z0:real`; + `Y0:real`] + REALLIM_SUB) THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + DISCH_THEN(MP_TAC o SPEC `(Z0 - Y0) / &2`) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN + DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `N:num` THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN + MAP_EVERY X_GEN_TAC [`k:int`; `nJ:int`] THEN STRIP_TAC THEN + MP_TAC(ISPECL [`k:int`; `nJ:int`; `Zseq (n:num):real`; `Yseq (n:num):real`] + THETA_JR_JL_KBAND_LO) THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC);; + +(* per-FIXED-k: eventually any qualifying tile at scale k lands its base *) +(* cells in F0. Y0 in a unique cell m0 (DYHO_COVERS_POINT), Z0 in mZ; *) +(* eventually Yseq,Zseq are in them, so a qual tile forces 2nJ=m0, 2nJ+1=mZ *) +(* (DYHO_SAME_POINT_INDEX) hence Z0,Y0 in the (2nJ+1),(2nJ) cells; gate *) +(* 2^k<=20 d0 by the no-boundary hyp + margin. *) +let THETA_QUAL_PERK_IN_F0 = prove + (`!Zseq Yseq Z0 Y0 k. + (Zseq ---> Z0) sequentially /\ (Yseq ---> Y0) sequentially /\ Y0 < Z0 /\ + ~(Z0 IN IMAGE (\(m,j). real_of_int m * &2 zpow j) (:int#int)) /\ + ~(Y0 IN IMAGE (\(m,j). real_of_int m * &2 zpow j) (:int#int)) /\ + ~(&2 zpow k = &20 * (Z0 - Y0)) + ==> eventually + (\n. !nJ. Zseq n IN dyho (k - &1) (&2 * nJ + &1) /\ + Yseq n IN dyho (k - &1) (&2 * nJ) /\ + &2 zpow k <= &20 * (Zseq n - Yseq n) + ==> Z0 IN dyho (k - &1) (&2 * nJ + &1) /\ + Y0 IN dyho (k - &1) (&2 * nJ) /\ + &2 zpow k <= &20 * (Z0 - Y0)) sequentially`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`k - &1:int`; `Y0:real`] DYHO_COVERS_POINT) THEN + DISCH_THEN(X_CHOOSE_TAC `m0:int`) THEN + MP_TAC(ISPECL [`k - &1:int`; `Z0:real`] DYHO_COVERS_POINT) THEN + DISCH_THEN(X_CHOOSE_TAC `mZ:int`) THEN + MP_TAC(ISPECL [`k - &1:int`; `m0:int`; `Y0:real`; + `Yseq:num->real`] DYHO_INTERIOR_STABLE) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`k - &1:int`;`m0:int`;`Y0:real`] DYHO_NONDYADIC_INTERIOR) + THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + DISCH_TAC THEN + MP_TAC(ISPECL [`k - &1:int`; `mZ:int`; `Z0:real`; + `Zseq:num->real`] DYHO_INTERIOR_STABLE) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`k - &1:int`;`mZ:int`;`Z0:real`] DYHO_NONDYADIC_INTERIOR) + THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + DISCH_TAC THEN + SUBGOAL_THEN + `eventually (\n:num. &2 zpow k <= &20 * (Zseq n - Yseq n) + ==> &2 zpow k <= &20 * (Z0 - Y0)) sequentially` + MP_TAC THENL + [SUBGOAL_THEN `&2 zpow k < &20 * (Z0 - Y0) \/ &20 * (Z0 - Y0) < &2 zpow k` + STRIP_ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; + MATCH_MP_TAC ALWAYS_EVENTUALLY THEN REWRITE_TAC[] THEN + REPEAT STRIP_TAC THEN ASM_REAL_ARITH_TAC; + MP_TAC(ISPECL [`sequentially`; `Zseq:num->real`; `Yseq:num->real`; + `Z0:real`; `Y0:real`] + REALLIM_SUB) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + DISCH_THEN(MP_TAC o SPEC `(&2 zpow k - &20 * (Z0 - Y0)) / &20`) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN + DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `N:num` THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC]; ALL_TAC] THEN + DISCH_TAC THEN + MP_TAC(ISPECL [`sequentially`; + `\n:num. (Yseq n IN dyho (k - &1) m0) /\ (Zseq n IN dyho (k - &1) mZ) /\ + (&2 zpow k <= &20 * (Zseq n - Yseq n) + ==> &2 zpow k <= &20 * (Z0 - Y0))`; + `\n:num. !nJ. Zseq n IN dyho (k - &1) (&2 * nJ + &1) /\ + Yseq n IN dyho (k - &1) (&2 * nJ) /\ + &2 zpow k <= &20 * (Zseq n - Yseq n) + ==> Z0 IN dyho (k - &1) (&2 * nJ + &1) /\ + Y0 IN dyho (k - &1) (&2 * nJ) /\ + &2 zpow k <= &20 * (Z0 - Y0)`] + EVENTUALLY_MONO) THEN + REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[EVENTUALLY_AND] THEN ASM_REWRITE_TAC[]] THEN + X_GEN_TAC `n:num` THEN STRIP_TAC THEN + X_GEN_TAC `nJ:int` THEN STRIP_TAC THEN + SUBGOAL_THEN `&2 * nJ:int = m0` ASSUME_TAC THENL + [MATCH_MP_TAC DYHO_SAME_POINT_INDEX THEN + MAP_EVERY EXISTS_TAC [`k - &1:int`; `Yseq (n:num):real`] THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `&2 * nJ + &1:int = mZ` ASSUME_TAC THENL + [MATCH_MP_TAC DYHO_SAME_POINT_INDEX THEN + MAP_EVERY EXISTS_TAC [`k - &1:int`; `Zseq (n:num):real`] THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + REPEAT CONJ_TAC THENL + [ASM_MESON_TAC[]; ASM_MESON_TAC[]; ASM_MESON_TAC[]]);; + +(* the full USC containment: eventually every gated-qualifying tile at step *) +(* n is in *) +(* the base set F0. P1 (KLOCAL) localizes k to the finite band Kb; P2 *) +(* (PERK_IN_F0) *) +(* per k in Kb forces F0-membership; EVENTUALLY_FORALL over Kb + P1 combine. *) +let THETA_QUAL_IN_F0_EVENTUAL = prove + (`!Zseq Yseq Z0 Y0. + (Zseq ---> Z0) sequentially /\ (Yseq ---> Y0) sequentially /\ Y0 < Z0 /\ + ~(Z0 IN IMAGE (\(m,j). real_of_int m * &2 zpow j) (:int#int)) /\ + ~(Y0 IN IMAGE (\(m,j). real_of_int m * &2 zpow j) (:int#int)) /\ + (!k. ~(&2 zpow k = &20 * (Z0 - Y0))) + ==> eventually + (\n. !k nJ. Zseq n IN dyho (k - &1) (&2 * nJ + &1) /\ + Yseq n IN dyho (k - &1) (&2 * nJ) /\ + &2 zpow k <= &20 * (Zseq n - Yseq n) + ==> Z0 IN dyho (k - &1) (&2 * nJ + &1) /\ + Y0 IN dyho (k - &1) (&2 * nJ) /\ + &2 zpow k <= &20 * (Z0 - Y0)) sequentially`, + REPEAT STRIP_TAC THEN + ABBREV_TAC `Kb = {k:int | (Z0 - Y0) / &2 < &2 zpow k /\ &2 zpow k <= &40 * + (Z0 - Y0)}` THEN + SUBGOAL_THEN `FINITE (Kb:int->bool)` ASSUME_TAC THENL + [EXPAND_TAC "Kb" THEN MATCH_MP_TAC ZPOW_BAND_FINITE THEN + ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPECL [`Zseq:num->real`; `Yseq:num->real`; `Z0:real`; + `Y0:real`] THETA_QUAL_KLOCAL) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(LABEL_TAC "P1") THEN + SUBGOAL_THEN + `!k:int. k IN Kb ==> eventually + (\n. !nJ. Zseq n IN dyho (k - &1) (&2 * nJ + &1) /\ + Yseq n IN dyho (k - &1) (&2 * nJ) /\ + &2 zpow k <= &20 * (Zseq n - Yseq n) + ==> Z0 IN dyho (k - &1) (&2 * nJ + &1) /\ + Y0 IN dyho (k - &1) (&2 * nJ) /\ + &2 zpow k <= &20 * (Z0 - Y0)) sequentially` + (LABEL_TAC "P2fam") THENL + [REPEAT STRIP_TAC THEN MATCH_MP_TAC THETA_QUAL_PERK_IN_F0 THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `eventually (\n:num. !k:int. k IN Kb ==> !nJ:int. + Zseq n IN dyho (k - &1) (&2 * nJ + &1) /\ + Yseq n IN dyho (k - &1) (&2 * nJ) /\ &2 zpow k <= &20 * (Zseq n - Yseq + n) + ==> Z0 IN dyho (k - &1) (&2 * nJ + &1) /\ Y0 IN dyho (k - &1) (&2 * nJ) + /\ + &2 zpow k <= &20 * (Z0 - Y0)) sequentially` + (LABEL_TAC "P2") THENL + [ASM_CASES_TAC `Kb:int->bool = {}` THEN + ASM_REWRITE_TAC[NOT_IN_EMPTY; EVENTUALLY_TRUE] THEN + MP_TAC(ISPECL [`sequentially`; + `\k:int n:num. !nJ:int. Zseq n IN dyho (k - &1) (&2 * nJ + &1) /\ + Yseq n IN dyho (k - &1) (&2 * nJ) /\ &2 zpow k <= &20 * (Zseq n - + Yseq n) + ==> Z0 IN dyho (k - &1) (&2 * nJ + &1) /\ Y0 IN dyho (k - &1) (&2 + * nJ) /\ + &2 zpow k <= &20 * (Z0 - Y0)`; + `Kb:int->bool`] EVENTUALLY_FORALL) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN + USE_THEN "P2fam" ACCEPT_TAC; ALL_TAC] THEN + MP_TAC(ISPECL [`sequentially`; + `\n:num. (!k nJ:int. Zseq n IN dyho (k - &1) (&2 * nJ + &1) /\ + Yseq n IN dyho (k - &1) (&2 * nJ) /\ &2 zpow k <= &20 * (Zseq n + - Yseq n) + ==> (Z0 - Y0) / &2 < &2 zpow k /\ &2 zpow k <= &40 * (Z0 - Y0)) + /\ + (!k:int. k IN Kb ==> !nJ:int. Zseq n IN dyho (k - &1) (&2 * nJ + + &1) /\ + Yseq n IN dyho (k - &1) (&2 * nJ) /\ &2 zpow k <= &20 * (Zseq n + - Yseq n) + ==> Z0 IN dyho (k - &1) (&2 * nJ + &1) /\ Y0 IN dyho (k - &1) + (&2 * nJ) /\ + &2 zpow k <= &20 * (Z0 - Y0))`; + `\n:num. !k nJ:int. Zseq n IN dyho (k - &1) (&2 * nJ + &1) /\ + Yseq n IN dyho (k - &1) (&2 * nJ) /\ &2 zpow k <= &20 * (Zseq n + - Yseq n) + ==> Z0 IN dyho (k - &1) (&2 * nJ + &1) /\ Y0 IN dyho (k - &1) + (&2 * nJ) /\ + &2 zpow k <= &20 * (Z0 - Y0)`] + EVENTUALLY_MONO) THEN + REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL + [X_GEN_TAC `n:num` THEN STRIP_TAC THEN + MAP_EVERY X_GEN_TAC [`k:int`; `nJ:int`] THEN STRIP_TAC THEN + SUBGOAL_THEN `(k:int) IN Kb` ASSUME_TAC THENL + [EXPAND_TAC "Kb" THEN REWRITE_TAC[IN_ELIM_THM] THEN + FIRST_X_ASSUM(fun th -> MP_TAC(SPECL [`k:int`; `nJ:int`] th)) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `k:int` th)) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(fun th -> MP_TAC(SPEC `nJ:int` th)) THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[EVENTUALLY_AND] THEN CONJ_TAC THENL + [USE_THEN "P1" ACCEPT_TAC; USE_THEN "P2" ACCEPT_TAC]]);; + +(* UPPER (USC) half of the theta-continuity sandwich: eventually theta(Zseq *) +(* n)(Yseq n) *) +(* <= sup over F0 of the window at Yseq n. theta = sup(bandset_n U {0}) *) +(* (THETA_BAND_SUP); bandset_n index SUBSET F0 eventually *) +(* (THETA_QUAL_IN_F0_EVENTUAL) *) +(* so bandset_n's window-image SUBSET F0's window-image; REAL_SUP_LE_SUBSET. *) +let PAIR_SETBUILDER_EQ = prove + (`!(f:int#int->real) P. + { f kJ | kJ IN {(k,nJ) | P k nJ} } = { f (k,nJ) | (k,nJ) | P k nJ }`, + REPEAT GEN_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN + X_GEN_TAC `w:real` THEN + REWRITE_TAC[EXISTS_PAIR_THM; IN_ELIM_PAIR_THM; PAIR_EQ] THEN + EQ_TAC THEN STRIP_TAC THENL + [ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; + MAP_EVERY EXISTS_TAC [`k:int`; `nJ:int`] THEN ASM_REWRITE_TAC[] THEN + MAP_EVERY EXISTS_TAC [`k:int`; `nJ:int`] THEN ASM_REWRITE_TAC[]]);; + +(* LOWER (LSC) half in the TWO-BAR form (matching THETA_BAND_SUP exactly): *) +(* eventually sup_F0 win(Yseq n) <= carleson_theta(Zseq n)(Yseq n). *) +let THETA_SUPF_LOWER2 = prove + (`!Zseq Yseq Z0 Y0. + (Zseq ---> Z0) sequentially /\ (Yseq ---> Y0) sequentially /\ Y0 < Z0 /\ + ~(Z0 IN IMAGE (\(m,j). real_of_int m * &2 zpow j) (:int#int)) /\ + ~(Y0 IN IMAGE (\(m,j). real_of_int m * &2 zpow j) (:int#int)) + ==> eventually + (\n. sup ({ Re(fourier carleson_phi + (&2 zpow (--k) * (Yseq n - dyho_mid (k - &1) (&2 * + nJ)))) pow 2 + | (k,nJ) | Z0 IN dyho (k - &1) (&2 * nJ + &1) /\ + Y0 IN dyho (k - &1) (&2 * nJ) /\ + &2 zpow k <= &20 * (Z0 - Y0) } UNION {&0}) + <= carleson_theta (Zseq n) (Yseq n)) sequentially`, + REPEAT STRIP_TAC THEN + ABBREV_TAC + `F0 = {(k,nJ) | Z0 IN dyho (k - &1) (&2 * nJ + &1) /\ + Y0 IN dyho (k - &1) (&2 * nJ) /\ + &2 zpow k <= &20 * (Z0 - Y0)}` THEN + SUBGOAL_THEN `FINITE (F0:int#int->bool)` ASSUME_TAC THENL + [EXPAND_TAC "F0" THEN MATCH_MP_TAC THETA_F_FINITE THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `eventually + (\n. !kJ:int#int. kJ IN F0 + ==> Re(fourier carleson_phi + (&2 zpow (--(FST kJ)) * + (Yseq n - dyho_mid (FST kJ - &1) (&2 * SND kJ)))) pow 2 + <= carleson_theta (Zseq n) (Yseq n)) sequentially` + MP_TAC THENL + [ASM_CASES_TAC `F0:int#int->bool = {}` THEN + ASM_REWRITE_TAC[NOT_IN_EMPTY; EVENTUALLY_TRUE] THEN + ASM_SIMP_TAC[EVENTUALLY_FORALL] THEN + X_GEN_TAC `kJ:int#int` THEN EXPAND_TAC "F0" THEN + SPEC_TAC(`kJ:int#int`,`kJ:int#int`) THEN REWRITE_TAC[FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC [`k:int`; `nJ:int`] THEN + REWRITE_TAC[IN_ELIM_PAIR_THM; FST; SND] THEN STRIP_TAC THEN + MATCH_MP_TAC THETA_TERM_EVENTUAL_LE THEN + MAP_EVERY EXISTS_TAC [`Z0:real`; `Y0:real`] THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`Z0:real`;`Y0:real`;`k:int`;`nJ:int`] THETA_F_STRICT) THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN + X_GEN_TAC `n:num` THEN REWRITE_TAC[] THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_SUP_LE THEN + CONJ_TAC THENL + [SET_TAC[]; + REWRITE_TAC[FORALL_IN_UNION; IN_SING] THEN CONJ_TAC THENL + [REWRITE_TAC[FORALL_IN_GSPEC; FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC [`k:int`;`nJ:int`] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(k:int,nJ:int)`) THEN + EXPAND_TAC "F0" THEN REWRITE_TAC[IN_ELIM_PAIR_THM; FST; SND] THEN + ASM_REWRITE_TAC[]; + GEN_TAC THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[CARLESON_THETA_BOUNDS]]]);; + +(* UPPER (USC) half in the TWO-BAR form: eventually theta(Zseq n)(Yseq n) <= *) +(* sup_F0. *) +let THETA_SUPF_UPPER2 = prove + (`!Zseq Yseq Z0 Y0. + (Zseq ---> Z0) sequentially /\ (Yseq ---> Y0) sequentially /\ Y0 < Z0 /\ + ~(Z0 IN IMAGE (\(m,j). real_of_int m * &2 zpow j) (:int#int)) /\ + ~(Y0 IN IMAGE (\(m,j). real_of_int m * &2 zpow j) (:int#int)) /\ + (!k. ~(&2 zpow k = &20 * (Z0 - Y0))) + ==> eventually + (\n. carleson_theta (Zseq n) (Yseq n) + <= sup ({ Re(fourier carleson_phi + (&2 zpow (--k) * (Yseq n - dyho_mid (k - &1) (&2 * + nJ)))) pow 2 + | (k,nJ) | Z0 IN dyho (k - &1) (&2 * nJ + &1) /\ + Y0 IN dyho (k - &1) (&2 * nJ) /\ + &2 zpow k <= &20 * (Z0 - Y0) } UNION {&0})) + sequentially`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`Zseq:num->real`; `Yseq:num->real`; `Z0:real`; `Y0:real`] + THETA_QUAL_IN_F0_EVENTUAL) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN + X_GEN_TAC `n:num` THEN REWRITE_TAC[] THEN DISCH_TAC THEN + GEN_REWRITE_TAC LAND_CONV [THETA_BAND_SUP] THEN + MATCH_MP_TAC REAL_SUP_LE_SUBSET THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `&0` THEN + REWRITE_TAC[IN_UNION; IN_SING]; + REWRITE_TAC[SUBSET; FORALL_IN_UNION; IN_SING; FORALL_IN_GSPEC; + FORALL_PAIR_THM] THEN + CONJ_TAC THENL + [MAP_EVERY X_GEN_TAC [`k:int`; `nJ:int`] THEN STRIP_TAC THEN + REWRITE_TAC[IN_UNION; IN_ELIM_THM] THEN DISJ1_TAC THEN + REWRITE_TAC[EXISTS_PAIR_THM; PAIR_EQ] THEN + MAP_EVERY EXISTS_TAC [`k:int`; `nJ:int`] THEN + FIRST_X_ASSUM(fun th -> MP_TAC(SPECL [`k:int`; `nJ:int`] th)) THEN + ASM_REWRITE_TAC[]; + GEN_TAC THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[IN_UNION; IN_SING]]; + EXISTS_TAC `&1` THEN + REWRITE_TAC[FORALL_IN_UNION; IN_SING; FORALL_IN_GSPEC; + FORALL_PAIR_THM] THEN + CONJ_TAC THENL + [MAP_EVERY X_GEN_TAC [`a:int`; `b:int`] THEN STRIP_TAC THEN + REWRITE_TAC[CARLESON_THETA_TERM_BOUNDS]; + GEN_TAC THEN DISCH_THEN SUBST1_TAC THEN REAL_ARITH_TAC]]);; + +(* sandwich collapse (two-bar): eventually sup_F0 win(Yseq n) = theta(Zseq *) +(* n)(Yseq n). *) +let THETA_EVENTUAL_SUPF_EQ2 = prove + (`!Zseq Yseq Z0 Y0. + (Zseq ---> Z0) sequentially /\ (Yseq ---> Y0) sequentially /\ Y0 < Z0 /\ + ~(Z0 IN IMAGE (\(m,j). real_of_int m * &2 zpow j) (:int#int)) /\ + ~(Y0 IN IMAGE (\(m,j). real_of_int m * &2 zpow j) (:int#int)) /\ + (!k. ~(&2 zpow k = &20 * (Z0 - Y0))) + ==> eventually + (\n. sup ({ Re(fourier carleson_phi + (&2 zpow (--k) * (Yseq n - dyho_mid (k - &1) (&2 * + nJ)))) pow 2 + | (k,nJ) | Z0 IN dyho (k - &1) (&2 * nJ + &1) /\ + Y0 IN dyho (k - &1) (&2 * nJ) /\ + &2 zpow k <= &20 * (Z0 - Y0) } UNION {&0}) + = carleson_theta (Zseq n) (Yseq n)) sequentially`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`Zseq:num->real`; `Yseq:num->real`; `Z0:real`; + `Y0:real`] THETA_SUPF_UPPER2) THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`Zseq:num->real`; `Yseq:num->real`; `Z0:real`; + `Y0:real`] THETA_SUPF_LOWER2) THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[IMP_IMP; GSYM EVENTUALLY_AND] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] EVENTUALLY_MONO) THEN + X_GEN_TAC `n:num` THEN REWRITE_TAC[] THEN STRIP_TAC THEN + MATCH_MP_TAC(REAL_ARITH `a <= b /\ b <= a ==> a = b`) THEN + ASM_REWRITE_TAC[]);; + +(* 286R-c B1 MAIN: carleson_theta is continuous along any Zseq/Yseq -> a *) +(* non-dyadic, *) +(* non-gate-boundary base (Y0 sup_F0 win(Y0) = theta(Z0,Y0) (SUP_FINITE_REALLIM + *) +(* BAND_SUP, *) +(* PAIR_SETBUILDER_EQ bridging the one-bar SUP_FINITE output to the two-bar *) +(* form). *) +let THETA_REALLIM_NONDYADIC = prove + (`!Zseq Yseq Z0 Y0. + (Zseq ---> Z0) sequentially /\ (Yseq ---> Y0) sequentially /\ Y0 < Z0 /\ + ~(Z0 IN IMAGE (\(m,j). real_of_int m * &2 zpow j) (:int#int)) /\ + ~(Y0 IN IMAGE (\(m,j). real_of_int m * &2 zpow j) (:int#int)) /\ + (!k. ~(&2 zpow k = &20 * (Z0 - Y0))) + ==> ((\n. carleson_theta (Zseq n) (Yseq n)) ---> carleson_theta Z0 Y0) + sequentially`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REALLIM_TRANSFORM_EVENTUALLY THEN + EXISTS_TAC + `\n:num. sup ({ Re(fourier carleson_phi + (&2 zpow (--k) * (Yseq n - dyho_mid (k - &1) (&2 * nJ)))) + pow 2 + | (k,nJ) | Z0 IN dyho (k - &1) (&2 * nJ + &1) /\ + Y0 IN dyho (k - &1) (&2 * nJ) /\ + &2 zpow k <= &20 * (Z0 - Y0) } UNION {&0})` THEN + REWRITE_TAC[] THEN CONJ_TAC THENL + [MP_TAC(ISPECL [`Zseq:num->real`; `Yseq:num->real`; `Z0:real`; `Y0:real`] + THETA_EVENTUAL_SUPF_EQ2) THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + GEN_REWRITE_TAC (RATOR_CONV o ONCE_DEPTH_CONV) [THETA_BAND_SUP] THEN + SUBGOAL_THEN + `!Y:real. { Re(fourier carleson_phi + (&2 zpow (--k) * (Y - dyho_mid (k - &1) (&2 * nJ)))) pow 2 + | (k,nJ) | Z0 IN dyho (k - &1) (&2 * nJ + &1) /\ + Y0 IN dyho (k - &1) (&2 * nJ) /\ &2 zpow k <= &20 * (Z0 + - Y0) } + = { Re(fourier carleson_phi + (&2 zpow (--(FST kJ)) * (Y - dyho_mid (FST kJ - &1) (&2 * + SND kJ)))) pow 2 + | kJ IN {(k,nJ) | Z0 IN dyho (k - &1) (&2 * nJ + &1) /\ + Y0 IN dyho (k - &1) (&2 * nJ) /\ &2 zpow k <= + &20 * (Z0 - Y0)} }` + (fun th -> REWRITE_TAC[th]) THENL + [GEN_TAC THEN + MP_TAC(BETA_RULE(REWRITE_RULE[FST;SND](ISPECL + [`\kJ:int#int. Re(fourier carleson_phi + (&2 zpow (--(FST kJ)) * (Y - dyho_mid (FST kJ - &1) (&2 * SND kJ)))) + pow 2`; + `\k nJ. Z0 IN dyho (k - &1) (&2 * nJ + &1) /\ Y0 IN dyho (k - &1) (&2 * + nJ) /\ + &2 zpow k <= &20 * (Z0 - Y0)`] PAIR_SETBUILDER_EQ))) THEN + DISCH_THEN(fun th -> REWRITE_TAC[GSYM th]); ALL_TAC] THEN + MATCH_MP_TAC SUP_FINITE_REALLIM THEN CONJ_TAC THENL + [MATCH_MP_TAC THETA_F_FINITE THEN ASM_REWRITE_TAC[]; + X_GEN_TAC `kJ:int#int` THEN DISCH_TAC THEN + MATCH_MP_TAC WINDOW_REALLIM THEN ASM_REWRITE_TAC[]]);; + +(* 286R-c DCT step 1: at a fixed beta with (alpha0 z+beta),(alpha0 y+beta) *) +(* non-dyadic and alpha0 off the (countable) gate boundary, alpha |-> *) +(* carleson_theta' z alpha beta y is continuous along aseq -> alpha0 *) +(* (instantiate THETA_REALLIM_NONDYADIC at the affine curves via CURVE_LIM). *) +let THETA'_ALPHA_CONTINUOUS = prove + (`!aseq alpha0 z y beta. + (aseq ---> alpha0) sequentially /\ &0 < alpha0 /\ y < z /\ + ~((alpha0 * z + beta) IN IMAGE (\(n,k). real_of_int n * &2 zpow k) + (:int#int)) /\ + ~((alpha0 * y + beta) IN IMAGE (\(n,k). real_of_int n * &2 zpow k) + (:int#int)) /\ + (!k. ~(&2 zpow k = &20 * (alpha0 * (z - y)))) + ==> ((\m. carleson_theta' z (aseq m) beta y) ---> carleson_theta' z alpha0 + beta y) + sequentially`, + REPEAT STRIP_TAC THEN REWRITE_TAC[carleson_theta'] THEN + MP_TAC(ISPECL + [`(\m. aseq m * z + beta):num->real`; `(\m. aseq m * y + beta):num->real`; + `alpha0 * z + beta:real`; + `alpha0 * y + beta:real`] THETA_REALLIM_NONDYADIC) THEN + REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CURVE_LIM THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC CURVE_LIM THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC(REAL_ARITH `a < b ==> a + c < b + c`) THEN + MATCH_MP_TAC REAL_LT_LMUL THEN ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + GEN_TAC THEN + SUBGOAL_THEN + `&20 * ((alpha0 * z + beta) - (alpha0 * y + beta)) = &20 * (alpha0 * (z - + y))` + SUBST1_TAC THENL + [REWRITE_TAC[REAL_SUB_LDISTRIB] THEN REAL_ARITH_TAC; + ASM_REWRITE_TAC[]]]);; + +(* ========================================================================= *) +(* Real-valued a.e. dominated convergence. Mirrors the library *) +(* REAL_DOMINATED_CONVERGENCE (realanalysis.ml) bridge but carries an *) +(* explicit negligible exception set t (from the vector *) +(* DOMINATED_CONVERGENCE_AE, *) +(* integration.ml). Powers the DCT-continuity route to alpha-measurability *) +(* of carleson_g: A_n(alpha)=(1/n)int_0^n theta' dbeta is continuous in *) +(* alpha *) +(* off the countable gate set, the bad-beta null set being the exception t. *) +(* ========================================================================= *) +let REAL_DOMINATED_CONVERGENCE_AE = prove + (`!f:num->real->real g h s t. + (!k. (f k) real_integrable_on s) /\ h real_integrable_on s /\ + real_negligible t /\ + (!k x. x IN s DIFF t ==> abs(f k x) <= h x) /\ + (!x. x IN s DIFF t ==> ((\k. f k x) ---> g x) sequentially) + ==> g real_integrable_on s /\ + ((\k. real_integral s (f k)) ---> real_integral s g) sequentially`, + REPEAT GEN_TAC THEN + REWRITE_TAC[REAL_INTEGRABLE_ON; TENDSTO_REAL; real_negligible] THEN + REWRITE_TAC[o_DEF] THEN STRIP_TAC THEN + MP_TAC(ISPECL [`\n x. lift(f (n:num) (drop x))`; + `lift o g o drop`; `lift o h o drop`; `IMAGE lift s`; + `IMAGE lift t`] DOMINATED_CONVERGENCE_AE) THEN + SUBGOAL_THEN `IMAGE lift s DIFF IMAGE lift t = IMAGE lift (s DIFF t)` + SUBST1_TAC THENL [SET_TAC[LIFT_EQ]; ALL_TAC] THEN + ASM_REWRITE_TAC[FORALL_IN_IMAGE; LIFT_DROP; o_DEF; NORM_LIFT] THEN + SUBGOAL_THEN + `!k:num. real_integral s (f k) = + drop(integral (IMAGE lift s) (lift o f k o drop))` + (fun th -> RULE_ASSUM_TAC(REWRITE_RULE[th]) THEN REWRITE_TAC[th]) + THENL + [GEN_TAC THEN MATCH_MP_TAC REAL_INTEGRAL THEN + ASM_REWRITE_TAC[REAL_INTEGRABLE_ON; o_DEF]; + ALL_TAC] THEN + REWRITE_TAC[o_DEF; LIFT_DROP] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + ONCE_REWRITE_TAC[GSYM DROP_EQ] THEN REWRITE_TAC[LIFT_DROP] THEN + CONV_TAC SYM_CONV THEN REWRITE_TAC[GSYM o_DEF] THEN + MATCH_MP_TAC REAL_INTEGRAL THEN ASM_REWRITE_TAC[REAL_INTEGRABLE_ON; o_DEF]);; + +(* ========================================================================= *) +(* 286R-c: alpha-measurability of carleson_g via the DCT-continuity route. *) +(* The bump indicators theta'_{z,alpha,beta}(y) are jointly measurable and *) +(* locally continuous in alpha at non-gate-boundary points (THETA'_ALPHA_ *) +(* CONTINUOUS); by dominated convergence the Cesaro-average A_n(alpha) = *) +(* (1/n) int_0^n theta' dbeta is continuous in alpha off the countable gate *) +(* set G = {alpha | ?k. 2^k = 20 alpha(z-y)}, hence measurable; and g = lim *) +(* A_n *) +(* everywhere, so g is measurable (Fremlin 286R-c, cites 251M+252P+261...). *) +(* ========================================================================= *) + +(* the gate set G = {alpha | ?k. 2^k = 20 alpha(z-y)} is negligible (y real_negligible {alpha | ?k:int. &2 zpow k = &20 * (alpha * (z - y))}`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_NEGLIGIBLE_COUNTABLE THEN + MATCH_MP_TAC COUNTABLE_SUBSET THEN + EXISTS_TAC `IMAGE (\k:int. &2 zpow k / (&20 * (z - y))) (:int)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC COUNTABLE_IMAGE THEN REWRITE_TAC[INT_COUNTABLE]; + REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_IMAGE; IN_UNIV] THEN + X_GEN_TAC `alpha:real` THEN DISCH_THEN(X_CHOOSE_TAC `k:int`) THEN + EXISTS_TAC `k:int` THEN + SUBGOAL_THEN `&0 < &20 * (z - y)` MP_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + POP_ASSUM MP_TAC THEN CONV_TAC REAL_FIELD]);; + +(* real-valued sequential characterization of continuity on a set. *) +let REAL_CONTINUOUS_ON_SEQUENTIALLY = prove + (`!f s. f real_continuous_on s <=> + !x a. a IN s /\ (!n. x n IN s) /\ (x ---> a) sequentially + ==> ((\n. f(x n)) ---> f a) sequentially`, + REPEAT GEN_TAC THEN + REWRITE_TAC[REAL_CONTINUOUS_ON; CONTINUOUS_ON_SEQUENTIALLY] THEN + EQ_TAC THEN DISCH_TAC THENL + [MAP_EVERY X_GEN_TAC [`x:num->real`; `a:real`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`lift o (x:num->real)`; `lift a`]) THEN + ASM_REWRITE_TAC[o_DEF; IN_IMAGE_LIFT_DROP; LIFT_DROP; TENDSTO_REAL] THEN + ANTS_TAC THENL + [UNDISCH_TAC `((x:num->real) ---> a) sequentially` THEN + REWRITE_TAC[TENDSTO_REAL; o_DEF]; + REWRITE_TAC[]]; + MAP_EVERY X_GEN_TAC [`x:num->real^1`; `a:real^1`] THEN + REWRITE_TAC[IN_IMAGE_LIFT_DROP] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`drop o (x:num->real^1)`; `drop a`]) THEN + ASM_REWRITE_TAC[o_DEF; LIFT_DROP] THEN + ANTS_TAC THENL + [REWRITE_TAC[TENDSTO_REAL; o_DEF; LIFT_DROP] THEN + UNDISCH_TAC `((x:num->real^1) --> a) sequentially` THEN + REWRITE_TAC[ETA_AX]; + REWRITE_TAC[TENDSTO_REAL; o_DEF; LIFT_DROP]]]);; + +(* real measurability is invariant under on-set equality. *) +let REAL_MEASURABLE_ON_EQ = prove + (`!f g s. (!x. x IN s ==> f x = g x) /\ f real_measurable_on s + ==> g real_measurable_on s`, + REPEAT GEN_TAC THEN REWRITE_TAC[real_measurable_on] THEN STRIP_TAC THEN + MATCH_MP_TAC MEASURABLE_ON_EQ THEN + EXISTS_TAC `lift o f o drop` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[FORALL_IN_IMAGE; o_DEF; LIFT_DROP] THEN ASM_SIMP_TAC[]);; + +(* STEP 2a: the bare-integral limit (no inv(&n) factor). DCT with dominator *) +(* 1. *) +let CARLESON_AN_INTEGRAL_LIMIT = prove + (`!n z y alpha0 aseq. + &0 < alpha0 /\ y < z /\ (aseq ---> alpha0) sequentially /\ + (!k:int. ~(&2 zpow k = &20 * (alpha0 * (z - y)))) + ==> ((\m. real_integral (real_interval[&0,&n]) (\beta. carleson_theta' z + (aseq m) beta y)) + ---> real_integral (real_interval[&0,&n]) (\beta. carleson_theta' z + alpha0 beta y)) + sequentially`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`\(m:num) beta. carleson_theta' z (aseq m) beta y`; + `\beta. carleson_theta' z alpha0 beta y`; + `\beta:real. &1`; + `real_interval[&0,&n]`; + `{beta | (alpha0 * z + beta) IN (IMAGE (\(n,k). real_of_int n * &2 zpow k) + (:int#int)) \/ + (alpha0 * y + beta) IN (IMAGE (\(n,k). real_of_int n * &2 zpow k) + (:int#int))}`] + REAL_DOMINATED_CONVERGENCE_AE) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [GEN_TAC THEN REWRITE_TAC[THETA'_BETA_INTEGRABLE]; + REWRITE_TAC[REAL_INTEGRABLE_CONST]; + MP_TAC(SPECL [`alpha0:real`;`y:real`;`z:real`] THETA_BAD_BETA_NEGLIGIBLE) + THEN + REWRITE_TAC[real_negligible]; + MAP_EVERY X_GEN_TAC [`m:num`;`beta:real`] THEN DISCH_TAC THEN + MP_TAC(SPECL [`z:real`;`aseq(m:num):real`;`beta:real`;`y:real`] + CARLESON_THETA'_BOUNDS) THEN + REAL_ARITH_TAC; + X_GEN_TAC `beta:real` THEN + REWRITE_TAC[IN_DIFF; IN_ELIM_THM; DE_MORGAN_THM] THEN + STRIP_TAC THEN + MATCH_MP_TAC THETA'_ALPHA_CONTINUOUS THEN ASM_REWRITE_TAC[]]; + DISCH_THEN(fun th -> ACCEPT_TAC(CONJUNCT2 th))]);; + +(* STEP 2b: the inv(&n)-scaled form A_n(aseq m) ---> A_n(alpha0). *) +let CARLESON_AN_CONTINUOUS = prove + (`!n z y alpha0 aseq. + &0 < alpha0 /\ y < z /\ (aseq ---> alpha0) sequentially /\ + (!k:int. ~(&2 zpow k = &20 * (alpha0 * (z - y)))) + ==> ((\m. inv(&n) * + real_integral (real_interval[&0,&n]) (\beta. carleson_theta' z + (aseq m) beta y)) + ---> inv(&n) * + real_integral (real_interval[&0,&n]) (\beta. carleson_theta' z + alpha0 beta y)) + sequentially`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REALLIM_LMUL THEN + MATCH_MP_TAC CARLESON_AN_INTEGRAL_LIMIT THEN ASM_REWRITE_TAC[]);; + +(* STEP 3+4: alpha |-> A_n(alpha) is measurable on [1,2]. For y=1>0). *) +let CARLESON_AN_MEASURABLE = prove + (`!n z y. + (\alpha. inv(&n) * + real_integral (real_interval[&0,&n]) (\beta. carleson_theta' z + alpha beta y)) + real_measurable_on real_interval[&1,&2]`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `(z:real) <= y` THENL + [MATCH_MP_TAC REAL_MEASURABLE_ON_EQ THEN + EXISTS_TAC `(\alpha. &0):real->real` THEN + CONJ_TAC THENL + [X_GEN_TAC `alpha:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN + STRIP_TAC THEN + SUBGOAL_THEN + `(\beta. carleson_theta' z alpha beta y) = + (\beta. &0)` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + MATCH_MP_TAC CARLESON_THETA'_SUPPORT THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[REAL_INTEGRAL_0; REAL_MUL_RZERO]]; + REWRITE_TAC[REAL_MEASURABLE_ON_0]]; + ALL_TAC] THEN + SUBGOAL_THEN `(y:real) < z` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_CONTINUOUS_AE_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET + THEN + EXISTS_TAC `{alpha | ?k:int. &2 zpow k = &20 * (alpha * (z - y))}` THEN + REWRITE_TAC[REAL_LEBESGUE_MEASURABLE_INTERVAL] THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_CONTINUOUS_ON_SEQUENTIALLY] THEN + MAP_EVERY X_GEN_TAC [`aseq:num->real`; `alpha0:real`] THEN + REWRITE_TAC[IN_DIFF; IN_REAL_INTERVAL; IN_ELIM_THM] THEN STRIP_TAC THEN + MATCH_MP_TAC CARLESON_AN_CONTINUOUS THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; + REWRITE_TAC[NOT_EXISTS_THM] THEN ASM_MESON_TAC[]]; + MATCH_MP_TAC CARLESON_GATE_SET_NEGLIGIBLE THEN ASM_REWRITE_TAC[]]);; + +(* STEP 5: alpha |-> carleson_g alpha y z is measurable on [1,2] (286R-c). g *) +(* = lim_n A_n everywhere (CARLESON_G_AVG_LIMIT + integer subsequence for *) +(* yreal` THEN + REWRITE_TAC[REAL_MEASURABLE_ON_0] THEN + X_GEN_TAC `alpha:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN + STRIP_TAC THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC CARLESON_G_TRIVIAL THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `(y:real) < z` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_MEASURABLE_ON_LIMIT THEN + MAP_EVERY EXISTS_TAC + [`\n alpha. inv(&n) * + real_integral (real_interval[&0,&n]) (\beta. carleson_theta' z + alpha beta y)`; + `{}:real->bool`] THEN + REWRITE_TAC[REAL_NEGLIGIBLE_EMPTY; DIFF_EMPTY] THEN CONJ_TAC THENL + [GEN_TAC THEN REWRITE_TAC[CARLESON_AN_MEASURABLE]; + X_GEN_TAC `alpha:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN + STRIP_TAC THEN + MP_TAC(ISPECL + [`\b. inv b * real_integral (real_interval[&0,b]) (\beta. carleson_theta' + z alpha beta y)`; + `carleson_g alpha y z`] REALLIM_POSINFINITY_SEQUENTIALLY) THEN + REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + MATCH_MP_TAC CARLESON_G_AVG_LIMIT THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC]);; + +(* ========================================================================= *) +(* 286R-c tail + (d): carleson_thetatilde is well-defined in [0,1] and *) +(* translation-invariant (Fremlin 286R). The log-average integrand *) +(* (1/alpha) g(alpha,y,z) is measurable (CARLESON_G_ALPHA_MEASURABLE x *) +(* continuous 1/alpha) and bounded by 1 (1<=alpha, 0<=g<=1), hence *) +(* integrable *) +(* on [1,2]; the value is in [0,1]. *) +(* ========================================================================= *) + +(* the log-average integrand (1/alpha) g(alpha,y,z) is integrable on [1,2]. *) +let THETATILDE_INTEGRAND_INTEGRABLE = prove + (`!y z. (\alpha. inv alpha * carleson_g alpha y z) real_integrable_on + real_interval[&1,&2]`, + REPEAT GEN_TAC THEN + MATCH_MP_TAC REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN + EXISTS_TAC `(\alpha. &1):real->real` THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC REAL_MEASURABLE_ON_MUL THEN + REWRITE_TAC[CARLESON_G_ALPHA_MEASURABLE] THEN + SUBGOAL_THEN `inv = (\x:real. inv x)` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM]; + MATCH_MP_TAC REAL_CONTINUOUS_IMP_REAL_MEASURABLE_ON_CLOSED_SUBSET THEN + REWRITE_TAC[REAL_CLOSED_REAL_INTERVAL] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_INV THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_ID; IN_REAL_INTERVAL] THEN + REPEAT STRIP_TAC THEN ASM_REAL_ARITH_TAC]; + REWRITE_TAC[REAL_INTEGRABLE_CONST]; + X_GEN_TAC `alpha:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN + STRIP_TAC THEN + MP_TAC(SPECL [`alpha:real`;`y:real`;`z:real`] CARLESON_G_BOUNDS) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; STRIP_TAC] THEN + REWRITE_TAC[REAL_ABS_MUL] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&1 * &1` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN + CONJ_TAC THENL + [SUBGOAL_THEN `abs(inv alpha) = inv alpha` SUBST1_TAC THENL + [REWRITE_TAC[REAL_ABS_REFL] THEN MATCH_MP_TAC REAL_LE_INV THEN + ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_INV_LE_1 THEN ASM_REAL_ARITH_TAC]; + ASM_REAL_ARITH_TAC]; + REAL_ARITH_TAC]]);; + +(* thetatilde in [0,1]. *) +let THETATILDE_TRANSLATE = prove + (`!y z gam. y < z + ==> carleson_thetatilde (z + gam) (y + gam) = carleson_thetatilde z y`, + REPEAT STRIP_TAC THEN REWRITE_TAC[carleson_thetatilde] THEN + MATCH_MP_TAC REAL_INTEGRAL_EQ THEN + X_GEN_TAC `alpha:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN STRIP_TAC THEN + AP_TERM_TAC THEN MATCH_MP_TAC CARLESON_G_TRANSLATE THEN + ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC);; + +(* ========================================================================= *) +(* 286R-c/g generalization: A_n, carleson_g measurable and (1/a)g integrable *) +(* on any positive interval [u,v] (00. *) +(* ========================================================================= *) + +let CARLESON_AN_MEASURABLE_GEN = prove + (`!n z y u v. &0 < u + ==> (\alpha. inv(&n) * + real_integral (real_interval[&0,&n]) (\beta. carleson_theta' + z alpha beta y)) + real_measurable_on real_interval[u,v]`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `(z:real) <= y` THENL + [MATCH_MP_TAC REAL_MEASURABLE_ON_EQ THEN + EXISTS_TAC `(\alpha. &0):real->real` THEN + CONJ_TAC THENL + [X_GEN_TAC `alpha:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN + STRIP_TAC THEN + SUBGOAL_THEN + `(\beta. carleson_theta' z alpha beta y) = + (\beta. &0)` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + MATCH_MP_TAC CARLESON_THETA'_SUPPORT THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[REAL_INTEGRAL_0; REAL_MUL_RZERO]]; + REWRITE_TAC[REAL_MEASURABLE_ON_0]]; + ALL_TAC] THEN + SUBGOAL_THEN `(y:real) < z` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_CONTINUOUS_AE_IMP_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET + THEN + EXISTS_TAC `{alpha | ?k:int. &2 zpow k = &20 * (alpha * (z - y))}` THEN + REWRITE_TAC[REAL_LEBESGUE_MEASURABLE_INTERVAL] THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_CONTINUOUS_ON_SEQUENTIALLY] THEN + MAP_EVERY X_GEN_TAC [`aseq:num->real`; `alpha0:real`] THEN + REWRITE_TAC[IN_DIFF; IN_REAL_INTERVAL; IN_ELIM_THM] THEN STRIP_TAC THEN + MATCH_MP_TAC CARLESON_AN_CONTINUOUS THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; + REWRITE_TAC[NOT_EXISTS_THM] THEN ASM_MESON_TAC[]]; + MATCH_MP_TAC CARLESON_GATE_SET_NEGLIGIBLE THEN ASM_REWRITE_TAC[]]);; + +let CARLESON_G_ALPHA_MEASURABLE_GEN = prove + (`!y z u v. &0 < u + ==> (\alpha. carleson_g alpha y z) real_measurable_on real_interval[u,v]`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `(z:real) <= y` THENL + [MATCH_MP_TAC REAL_MEASURABLE_ON_EQ THEN + EXISTS_TAC `(\alpha. &0):real->real` THEN + REWRITE_TAC[REAL_MEASURABLE_ON_0] THEN + X_GEN_TAC `alpha:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN + STRIP_TAC THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC CARLESON_G_TRIVIAL THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `(y:real) < z` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_MEASURABLE_ON_LIMIT THEN + MAP_EVERY EXISTS_TAC + [`\n alpha. inv(&n) * + real_integral (real_interval[&0,&n]) (\beta. carleson_theta' z + alpha beta y)`; + `{}:real->bool`] THEN + REWRITE_TAC[REAL_NEGLIGIBLE_EMPTY; DIFF_EMPTY] THEN CONJ_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC CARLESON_AN_MEASURABLE_GEN THEN + ASM_REWRITE_TAC[]; + X_GEN_TAC `alpha:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN + STRIP_TAC THEN + MP_TAC(ISPECL + [`\b. inv b * real_integral (real_interval[&0,b]) (\beta. carleson_theta' + z alpha beta y)`; + `carleson_g alpha y z`] REALLIM_POSINFINITY_SEQUENTIALLY) THEN + REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + MATCH_MP_TAC CARLESON_G_AVG_LIMIT THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC]);; + +(* the a-iterate (\a. inv a * int_[0,n] theta') is real_integrable on [1,2]. *) +(* Analog of A_ITERATE_INTEGRABLE for the theta' kernel (feeds the w-outer *) +(* side of *) +(* MNF_FOURIER_BOX -- the inner (a,b)-box integral = Cx(n*Mn w)). Measurable *) +(* arm: *) +(* int_[0,n] theta' measurable in a (CARLESON_AN_MEASURABLE * &n; n=0 *) +(* REAL_INTEGRAL_ *) +(* NULL) times cont inv a; bound |inv a * int| <= n (inv a<=1 on [1,2], *) +(* 0<=int<=n). *) +let THETA'_A_ITERATE_INTEGRABLE = prove + (`!z0:real w:real n:num. + (\a. inv a * real_integral (real_interval[&0,&n]) (\b. carleson_theta' z0 + a b w)) + real_integrable_on real_interval[&1,&2]`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN + `(\a. real_integral (real_interval[&0,&n]) (\b. carleson_theta' z0 a b w)) + real_measurable_on real_interval[&1,&2]` + ASSUME_TAC THENL + [ASM_CASES_TAC `n = 0` THENL + [ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `(\a:real. real_integral (real_interval[&0,&0]) (\b. carleson_theta' z0 + a b w)) = (\a:real. &0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + MATCH_MP_TAC REAL_INTEGRAL_NULL THEN REWRITE_TAC[REAL_LE_REFL]; + REWRITE_TAC[REAL_MEASURABLE_ON_0]]; + MP_TAC(ISPECL [`n:num`; `z0:real`; `w:real`] CARLESON_AN_MEASURABLE) THEN + DISCH_THEN(MP_TAC o SPEC `&n:real` o MATCH_MP REAL_MEASURABLE_ON_LMUL) + THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN + ASM_SIMP_TAC[REAL_MUL_RINV; REAL_OF_NUM_EQ; REAL_MUL_LID]]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN + EXISTS_TAC `(\a:real. &n)` THEN REPEAT CONJ_TAC THENL + [MP_TAC(ISPECL [`\a:real. inv a`; + `\a:real. real_integral (real_interval[&0,&n]) (\b. + carleson_theta' z0 a b w)`; + `real_interval[&1,&2]`] REAL_MEASURABLE_ON_MUL) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + MATCH_MP_TAC REAL_CONTINUOUS_IMP_REAL_MEASURABLE_ON_CLOSED_SUBSET THEN + REWRITE_TAC[REAL_CLOSED_REAL_INTERVAL] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_INV THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_ID; IN_REAL_INTERVAL] THEN + REPEAT STRIP_TAC THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[REAL_INTEGRABLE_CONST]; + X_GEN_TAC `a:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN STRIP_TAC THEN + SUBGOAL_THEN + `&0 <= real_integral (real_interval[&0,&n]) (\b. carleson_theta' z0 a b w) + /\ + real_integral (real_interval[&0,&n]) (\b. carleson_theta' z0 a b w) <= + &n` + STRIP_ASSUME_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_POS THEN + REWRITE_TAC[THETA'_BETA_INTEGRABLE] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[CARLESON_THETA'_BOUNDS]; + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `real_integral (real_interval[&0,&n]) (\b:real. &1)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_LE THEN + REWRITE_TAC[THETA'_BETA_INTEGRABLE; REAL_INTEGRABLE_CONST] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[CARLESON_THETA'_BOUNDS]; + SIMP_TAC[REAL_INTEGRAL_CONST; REAL_ARITH `&0 <= &n`] THEN + REAL_ARITH_TAC]]; + ALL_TAC] THEN + REWRITE_TAC[REAL_ABS_MUL] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&1 * &n` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[REAL_ABS_INV] THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `abs(inv(&1))` THEN + REWRITE_TAC[REAL_ABS_INV] THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INV2 THEN + ASM_REAL_ARITH_TAC; CONV_TAC REAL_RAT_REDUCE_CONV]; + ASM_REAL_ARITH_TAC]; + REWRITE_TAC[REAL_MUL_LID; REAL_LE_REFL]]]);; + +(* (1/a) g integrable on [u,v], 0 (\alpha. inv alpha * carleson_g alpha y z) real_integrable_on + real_interval[u,v]`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN + EXISTS_TAC `(\alpha. inv u):real->real` THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC REAL_MEASURABLE_ON_MUL THEN + ASM_SIMP_TAC[CARLESON_G_ALPHA_MEASURABLE_GEN] THEN + SUBGOAL_THEN `inv = (\x:real. inv x)` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM]; + MATCH_MP_TAC REAL_CONTINUOUS_IMP_REAL_MEASURABLE_ON_CLOSED_SUBSET THEN + REWRITE_TAC[REAL_CLOSED_REAL_INTERVAL] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_INV THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_ID; IN_REAL_INTERVAL] THEN + REPEAT STRIP_TAC THEN ASM_REAL_ARITH_TAC]; + REWRITE_TAC[REAL_INTEGRABLE_CONST]; + X_GEN_TAC `alpha:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN + STRIP_TAC THEN + MP_TAC(SPECL [`alpha:real`;`y:real`;`z:real`] CARLESON_G_BOUNDS) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; STRIP_TAC] THEN + REWRITE_TAC[REAL_ABS_MUL] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs(inv alpha) * &1` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[REAL_MUL_RID] THEN + SUBGOAL_THEN + `abs(inv alpha) = inv alpha /\ abs(inv u) = inv u` (fun th -> + REWRITE_TAC[th]) THENL + [CONJ_TAC THEN REWRITE_TAC[REAL_ABS_REFL] THEN + MATCH_MP_TAC REAL_LE_INV THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REAL_ARITH_TAC]]]);; + +(* ========================================================================= *) +(* 286R-g scale-invariance of thetatilde and the value thetatilde_z(y) = *) +(* thetatilde_1(0) * indicator(y0). HAS_REAL_INTEGRAL_STRETCH + *) +(* G-scale-arg. *) +let THETATILDE_STRETCH = prove + (`!y z gam. &0 < gam + ==> real_integral (real_interval[&1,&2]) (\alpha. inv alpha * carleson_g + alpha (gam * y) (gam * z)) = + real_integral (real_interval[gam,&2 * gam]) (\alpha. inv alpha * + carleson_g alpha y z)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `~(gam = &0)` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `real_integral (real_interval[&1,&2]) (\x. inv(gam * x) * carleson_g (gam * + x) y z) = + inv(gam) * real_integral (real_interval[gam,&2 * gam]) (\a. inv a * + carleson_g a y z)` + (LABEL_TAC "str") THENL + [MP_TAC(ISPECL [`\a. inv a * carleson_g a y z`; + `real_integral (real_interval[gam,&2 * gam]) (\a. inv a * + carleson_g a y z)`; + `gam:real`; `&2 * gam`; + `gam:real`] HAS_REAL_INTEGRAL_STRETCH) THEN + REWRITE_TAC[GSYM HAS_REAL_INTEGRAL_INTEGRAL] THEN + SUBGOAL_THEN + `(\a. inv a * carleson_g a y z) + real_integrable_on real_interval[gam,&2 * gam]` + (fun th -> REWRITE_TAC[th]) THENL + [MATCH_MP_TAC THETATILDE_INTEGRAND_INTEGRABLE_GEN THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `IMAGE (\x. inv gam * x) (real_interval[gam,&2 * gam]) = + real_interval[&1,&2]` + SUBST1_TAC THENL + [SUBGOAL_THEN `~(real_interval[gam,&2 * gam] = {})` ASSUME_TAC THENL + [REWRITE_TAC[REAL_INTERVAL_EQ_EMPTY; REAL_NOT_LT] THEN + ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `&0 <= inv gam` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_INV THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `inv gam * gam = + &1 /\ inv gam * (&2 * gam) = &2` STRIP_ASSUME_TAC THENL + [UNDISCH_TAC `~(gam = &0)` THEN CONV_TAC REAL_FIELD; ALL_TAC] THEN + ASM_REWRITE_TAC[IMAGE_STRETCH_REAL_INTERVAL]; ALL_TAC] THEN + SUBGOAL_THEN `abs gam = gam` SUBST1_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(SUBST1_TAC o SYM o MATCH_MP REAL_INTEGRAL_UNIQUE) THEN + BETA_TAC THEN + REFL_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `real_integral (real_interval[&1,&2]) (\x. inv(gam * x) * carleson_g (gam * + x) y z) = + inv(gam) * real_integral (real_interval[&1,&2]) (\alpha. inv alpha * + carleson_g alpha (gam * y) (gam * z))` + (LABEL_TAC "lmul") THENL + [MP_TAC(ISPECL [`\alpha. inv alpha * carleson_g alpha (gam * y) (gam * + z):real`; `inv(gam:real)`; `real_interval[&1,&2]`] + REAL_INTEGRAL_LMUL) THEN + ANTS_TAC THENL + [MATCH_MP_TAC THETATILDE_INTEGRAND_INTEGRABLE_GEN THEN + REWRITE_TAC[REAL_LT_01]; + DISCH_THEN(fun th -> REWRITE_TAC[GSYM th]) THEN + MATCH_MP_TAC REAL_INTEGRAL_EQ THEN X_GEN_TAC `x:real` THEN DISCH_TAC THEN + REWRITE_TAC[] THEN + SUBGOAL_THEN + `carleson_g (gam * x) y z = carleson_g (x * gam) y z` SUBST1_TAC THENL + [AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[CARLESON_G_SCALE_ARG; REAL_INV_MUL] THEN + REAL_ARITH_TAC]; ALL_TAC] THEN + SUBGOAL_THEN + `inv gam * real_integral (real_interval[&1,&2]) (\alpha. inv alpha * + carleson_g alpha (gam * y) (gam * z)) = + inv gam * real_integral (real_interval[gam,&2 * gam]) (\a. inv a * + carleson_g a y z)` + MP_TAC THENL + [USE_THEN "str" (fun s -> USE_THEN "lmul" (fun l -> + MP_TAC s THEN MP_TAC l THEN REAL_ARITH_TAC)); + REWRITE_TAC[REAL_EQ_MUL_LCANCEL; REAL_INV_EQ_0] THEN + ASM_CASES_TAC `gam = &0` THENL [ASM_REAL_ARITH_TAC; ASM_REWRITE_TAC[]]]);; + +(* PIECE 3 (286R-g value): thetatilde(gam*z)(gam*y) = thetatilde z y for *) +(* gam>0. *) +let THETATILDE_SCALE = prove + (`!y z gam. &0 < gam + ==> carleson_thetatilde (gam * z) (gam * y) = carleson_thetatilde z y`, + REPEAT STRIP_TAC THEN REWRITE_TAC[carleson_thetatilde] THEN + ASM_SIMP_TAC[THETATILDE_STRETCH] THEN + MATCH_MP_TAC CARLESON_G_OCTAVE_ABSTRACT THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [REPEAT STRIP_TAC THEN MATCH_MP_TAC CARLESON_G_SCALE2 THEN + ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC THEN MATCH_MP_TAC THETATILDE_INTEGRAND_INTEGRABLE_GEN THEN + ASM_REWRITE_TAC[]]);; + +(* 286R value: thetatilde_z(y) = thetatilde_1(0) for y=z. y=z: g=0 on [1,2] (alpha>=1>0) so the log-average *) +(* vanishes. *) +let CARLESON_THETATILDE_VALUE = prove + (`!y z. carleson_thetatilde z y = + if y < z then carleson_thetatilde (&1) (&0) else &0`, + REPEAT GEN_TAC THEN COND_CASES_TAC THENL + [SUBGOAL_THEN + `carleson_thetatilde z y = + carleson_thetatilde (z - y) (&0)` SUBST1_TAC THENL + [MP_TAC(SPECL [`y:real`; `z:real`; `--y:real`] THETATILDE_TRANSLATE) THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `z + --y = z - y /\ y + --y = &0` (fun th -> REWRITE_TAC[th]) THENL + [CONJ_TAC THEN REAL_ARITH_TAC; DISCH_THEN(ACCEPT_TAC o SYM)]; + ALL_TAC] THEN + MP_TAC(SPECL [`&0:real`; `&1:real`; `z - y:real`] THETATILDE_SCALE) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_MUL_RZERO; REAL_MUL_RID] THEN + DISCH_THEN(ACCEPT_TAC o SYM); + REWRITE_TAC[carleson_thetatilde] THEN + SUBGOAL_THEN + `real_integral (real_interval[&1,&2]) (\alpha. inv alpha * carleson_g + alpha y z) = + real_integral (real_interval[&1,&2]) (\alpha. &0)` + SUBST1_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_EQ THEN + X_GEN_TAC `alpha:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN + STRIP_TAC THEN + SUBGOAL_THEN `carleson_g alpha y z = &0` SUBST1_TAC THENL + [MATCH_MP_TAC CARLESON_G_TRIVIAL THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ASM_REAL_ARITH_TAC]; + REWRITE_TAC[REAL_MUL_RZERO]]; + REWRITE_TAC[REAL_INTEGRAL_0]]]);; + +(* ========================================================================= *) +(* 286R-(h): thetatilde_1(0) > 0. For 1<=alpha<7/6 and beta in the good band *) +(* [2m+1/6, 2m+5/6] (m in Z), the k=1 tile makes carleson_theta(alpha+beta) *) +(* (beta) = phihat((beta-(2m+1/2))/2)^2 = 1 (window on |arg|<=1/6). So *) +(* g(alpha,0,1) >= 1/3 (good band = 2/3 of each period-2 cell), and *) +(* thetatilde_1(0) >= (1/3) int_1^{7/6} 1/alpha > 0. *) +(* ========================================================================= *) + +(* the (h) window: carleson_theta(alpha+beta)(beta) = 1 on the good band. *) +let THETA_LOWER_WINDOW = prove + (`!alpha m beta. + &1 <= alpha /\ alpha < &7 / &6 /\ + &2 * real_of_int m + &1 / &6 <= beta /\ beta <= &2 * real_of_int m + &5 / + &6 + ==> carleson_theta (alpha + beta) beta = &1`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(REAL_ARITH `&1 <= t /\ t <= &1 ==> t = &1`) THEN + REWRITE_TAC[CARLESON_THETA_BOUNDS] THEN + MP_TAC(SPECL [`alpha + beta:real`; `beta:real`; `&1:int`; + `m:int`] THETA_TERM_LE) THEN + REWRITE_TAC[INT_ARITH `(&1:int) - &1 = &0`] THEN + ANTS_TAC THENL + [CONJ_TAC THEN + REWRITE_TAC[dyho; IN_ELIM_THM; REAL_ZPOW_0; REAL_MUL_RID] THEN + REWRITE_TAC[GSYM REAL_OF_INT_CLAUSES] THEN + ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[dyho_mid; REAL_ZPOW_0; REAL_MUL_RID; REAL_ZPOW_NEG; + REAL_ZPOW_1] THEN + SUBGOAL_THEN + `fourier carleson_phi (inv(&2) * (beta - (real_of_int (&2 * m) + &1 / &2))) + = Cx(&1)` + SUBST1_TAC THENL + [MATCH_MP_TAC CARLESON_PHI_FHAT_ONE THEN + REWRITE_TAC[GSYM REAL_OF_INT_CLAUSES] THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[RE_CX] THEN REAL_ARITH_TAC]);; + +(* the same window at a nat cell index (theta' = carleson_theta on the *) +(* diagonal). *) +let THETA'_LOWER_WINDOW_NUM = prove + (`!alpha (N:num) beta. &1 <= alpha /\ alpha < &7 / &6 /\ + &2 * &N + &1 / &6 <= beta /\ beta <= &2 * &N + &5 / &6 + ==> carleson_theta' (&1) alpha beta (&0) = &1`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[carleson_theta'; REAL_MUL_RID; REAL_MUL_RZERO; REAL_ADD_LID] THEN + MP_TAC(SPECL [`alpha:real`; `&N:int`; `beta:real`] THETA_LOWER_WINDOW) THEN + REWRITE_TAC[int_of_num_th] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[]);; + +(* single cell: int_[2N,2N+2] theta'(1)(alpha)(.)(0) >= 2/3 (good band *) +(* [2N+1/6,2N+5/6]). *) +let THETA'_CELL_LB = prove + (`!alpha N. &1 <= alpha /\ alpha < &7 / &6 + ==> &2 / &3 <= real_integral (real_interval[&2 * &N, &2 * &N + &2]) + (\beta. carleson_theta' (&1) alpha beta (&0))`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `real_integral (real_interval[&2 * &N + &1 / &6, &2 * &N + &5 / + &6]) + (\beta. carleson_theta' (&1) alpha beta (&0))` THEN + CONJ_TAC THENL + [SUBGOAL_THEN + `real_integral (real_interval[&2 * &N + &1 / &6, &2 * &N + &5 / &6]) + (\beta. carleson_theta' (&1) alpha beta (&0)) = + real_integral (real_interval[&2 * &N + &1 / &6, &2 * &N + &5 / &6]) + (\beta. &1)` + SUBST1_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_EQ THEN X_GEN_TAC `beta:real` THEN + REWRITE_TAC[IN_REAL_INTERVAL] THEN STRIP_TAC THEN + MP_TAC(SPECL [`alpha:real`; `N:num`; + `beta:real`] THETA'_LOWER_WINDOW_NUM) THEN + ASM_REWRITE_TAC[]; + SIMP_TAC[REAL_INTEGRAL_CONST; + REAL_ARITH `&2 * &N + &1 / &6 <= &2 * &N + &5 / &6`] THEN + REAL_ARITH_TAC]; + MATCH_MP_TAC REAL_INTEGRAL_SUBSET_LE THEN + REWRITE_TAC[THETA'_BETA_INTEGRABLE] THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET; IN_REAL_INTERVAL] THEN REAL_ARITH_TAC; + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[CARLESON_THETA'_BOUNDS]]]);; + +(* band-counting: int_[0,2N] theta'(1)(alpha)(.)(0) >= N*(2/3) (each cell >= *) +(* 2/3). *) +let GOOD_BAND_INTEGRAL_LB = prove + (`!alpha. &1 <= alpha /\ alpha < &7 / &6 + ==> !N. &N * (&2 / &3) <= + real_integral (real_interval[&0,&2 * &N]) + (\beta. carleson_theta' (&1) alpha beta (&0))`, + GEN_TAC THEN STRIP_TAC THEN INDUCT_TAC THENL + [REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_INTEGRAL_REFL; + REAL_LE_REFL]; + ALL_TAC] THEN + SUBGOAL_THEN + `real_integral (real_interval[&0,&2 * &(SUC N)]) (\beta. carleson_theta' + (&1) alpha beta (&0)) = + real_integral (real_interval[&0,&2 * &N]) (\beta. carleson_theta' (&1) + alpha beta (&0)) + + real_integral (real_interval[&2 * &N,&2 * &N + &2]) (\beta. carleson_theta' + (&1) alpha beta (&0))` + SUBST1_TAC THENL + [SUBGOAL_THEN `&2 * &(SUC N) = &2 * &N + &2` SUBST1_TAC THENL + [REWRITE_TAC[GSYM REAL_OF_NUM_SUC] THEN REAL_ARITH_TAC; ALL_TAC] THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_INTEGRAL_COMBINE THEN + REWRITE_TAC[THETA'_BETA_INTEGRABLE] THEN REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_SUC; + REAL_ARITH `(&N + &1) * (&2 / &3) = &N * (&2 / &3) + &2 / &3`] + THEN + MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + MATCH_MP_TAC THETA'_CELL_LB THEN ASM_REWRITE_TAC[]]);; + +(* ========================================================================= *) +(* 286R-(h): the Cesaro mean thetatilde_1(0) is STRICTLY POSITIVE. *) +(* g(alpha,0,1) >= 1/3 for alpha in [1,7/6) by the good-band count, whence *) +(* thetatilde_1(0) = int_[1,2] (1/a) g >= (2/7)(1/8) > 0. This positivity *) +(* is what makes the 286T constant C10 = 3 C9 / (pi thetatilde_1(0)) finite. *) +(* ========================================================================= *) + +(* Every int L is <= some num &n (so the beta-period 2 zpow L can be taken *) +(* as a nonnegative power 2^n). *) +let LE_INT_NUM = prove + (`!L:int. ?n:num. L <= &n`, + GEN_TAC THEN EXISTS_TAC `num_of_int(abs L)` THEN + SUBGOAL_THEN `&(num_of_int(abs L)):int = abs L` SUBST1_TAC THENL + [MATCH_MP_TAC INT_OF_NUM_OF_INT THEN INT_ARITH_TAC; INT_ARITH_TAC]);; + +(* a single period P is also a period after any num multiple &j * P. *) +let PERIODIC_MULTIPLE = prove + (`!(f:real->real) P. (!b. f(b + P) = f b) ==> !j b. f(b + &j * P) = f b`, + GEN_TAC THEN GEN_TAC THEN DISCH_TAC THEN INDUCT_TAC THEN + ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_RID] THEN GEN_TAC THEN + REWRITE_TAC[GSYM REAL_OF_NUM_SUC] THEN + SUBGOAL_THEN `b + (&j + &1) * P = (b + &j * P) + P` SUBST1_TAC THENL + [REAL_ARITH_TAC; ASM_REWRITE_TAC[]]);; + +(* num-valued restatement of CARLESON_THETA'_PERIOD: theta'(z)(a)(.)(y) has *) +(* a period of the shape 2^n (n:num), obtained from the int period 2 zpow L *) +(* by 2 zpow L = 2^{n-L} * 2 zpow L with L <= &n = 2^n via *) +(* PERIODIC_MULTIPLE. *) +let CARLESON_THETA'_PERIOD_NUM = prove + (`!z a y. &0 < a /\ y < z + ==> ?n:num. !b. carleson_theta' z a (b + &2 pow n) y = carleson_theta' z a b + y`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`z:real`; `a:real`; `y:real`] CARLESON_THETA'_PERIOD) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `L:int`) THEN + MP_TAC(SPEC `L:int` LE_INT_NUM) THEN DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN + EXISTS_TAC `n:num` THEN GEN_TAC THEN + SUBGOAL_THEN + `&2 pow n = &(2 EXP (num_of_int(&n - L))) * &2 zpow L` SUBST1_TAC THENL + [REWRITE_TAC[GSYM REAL_OF_NUM_POW; GSYM REAL_ZPOW_POW] THEN + SUBGOAL_THEN `&(num_of_int(&n - L)):int = &n - L` SUBST1_TAC THENL + [MATCH_MP_TAC INT_OF_NUM_OF_INT THEN ASM_INT_ARITH_TAC; ALL_TAC] THEN + SIMP_TAC[GSYM REAL_ZPOW_ADD; REAL_ARITH `~(&2 = &0)`] THEN + AP_TERM_TAC THEN ASM_INT_ARITH_TAC; ALL_TAC] THEN + MP_TAC(BETA_RULE(ISPECL [`\b. carleson_theta' z a b y`; + `&2 zpow L`] PERIODIC_MULTIPLE)) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPECL [`(2 EXP num_of_int (&n - L)):num`; `b:real`]) THEN + REWRITE_TAC[]);; + +(* 286R-(h) core: g(alpha,0,1) >= 1/3 for alpha in [1,7/6). Cesaro lower *) +(* bound at the even period p = 2 * 2^n (2^n = beta-period): int_0^p theta' *) +(* >= (1/3) p is exactly GOOD_BAND_INTEGRAL_LB at N = 2^n (2*&N = p). *) +let CARLESON_G_0_1_LOWER = prove + (`!alpha. &1 <= alpha /\ alpha < &7 / &6 ==> &1 / &3 <= carleson_g alpha (&0) + (&1)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[carleson_g] THEN + MP_TAC(SPECL [`&1:real`; `alpha:real`; + `&0:real`] CARLESON_THETA'_PERIOD_NUM) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN + MP_TAC(SPECL [`\beta. carleson_theta' (&1) alpha beta (&0)`; + `&2 * &2 pow n`; `&1 / &3`] PERIODIC_CESARO_LBOUND) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [MATCH_MP_TAC REAL_LT_MUL THEN REWRITE_TAC[REAL_LT_POW2] THEN + REAL_ARITH_TAC; + GEN_TAC THEN REWRITE_TAC[CARLESON_THETA'_BOUNDS]; + REWRITE_TAC[THETA'_BETA_INTEGRABLE]; + GEN_TAC THEN + SUBGOAL_THEN + `b + &2 * &2 pow n = (b + &2 pow n) + &2 pow n` SUBST1_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[]; + MP_TAC(SPECL [`alpha:real`] GOOD_BAND_INTEGRAL_LB) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `2 EXP n`) THEN + REWRITE_TAC[REAL_OF_NUM_POW] THEN REAL_ARITH_TAC]; + DISCH_THEN ACCEPT_TAC]);; + +(* 286R-(h): thetatilde_1(0) > 0. int_[1,2] (1/a) g >= int_[1,9/8] (1/a) g *) +(* >= int_[1,9/8] (2/7) = (2/7)(1/8) > 0, using (1/a) >= 8/9 and g >= 1/3 on *) +(* [1,9/8] (subset of [1,7/6) so CARLESON_G_0_1_LOWER applies). *) +let CARLESON_THETATILDE_1_0_POS = prove + (`&0 < carleson_thetatilde (&1) (&0)`, + REWRITE_TAC[carleson_thetatilde] THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN + EXISTS_TAC `real_integral (real_interval[&1,&9 / &8]) (\alpha. inv alpha * + carleson_g alpha (&0) (&1))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LTE_TRANS THEN + EXISTS_TAC `real_integral (real_interval[&1,&9 / &8]) (\alpha. &2 / &7)` + THEN + CONJ_TAC THENL + [SIMP_TAC[REAL_INTEGRAL_CONST; REAL_ARITH `&1 <= &9 / &8`] THEN + REAL_ARITH_TAC; + MATCH_MP_TAC REAL_INTEGRAL_LE THEN + REWRITE_TAC[REAL_INTEGRABLE_CONST] THEN CONJ_TAC THENL + [MATCH_MP_TAC THETATILDE_INTEGRAND_INTEGRABLE_GEN THEN + REWRITE_TAC[REAL_LT_01]; + X_GEN_TAC `alpha:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN + STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(&8 / &9) * (&1 / &3)` THEN + CONJ_TAC THENL + [REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LE_MUL2 THEN REPEAT CONJ_TAC THENL + [REAL_ARITH_TAC; + REWRITE_TAC[REAL_LE_INV_EQ] THEN + MATCH_MP_TAC(REAL_ARITH `&8 / &9 <= inv alpha ==> &8 / &9 <= inv + alpha`) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(&9 / &8)` THEN + CONJ_TAC THENL + [REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REAL_ARITH_TAC]; + REAL_ARITH_TAC; + MATCH_MP_TAC CARLESON_G_0_1_LOWER THEN ASM_REAL_ARITH_TAC]]]]; + MATCH_MP_TAC REAL_INTEGRAL_SUBSET_LE THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[SUBSET; IN_REAL_INTERVAL] THEN REAL_ARITH_TAC; + MATCH_MP_TAC THETATILDE_INTEGRAND_INTEGRABLE_GEN THEN + REWRITE_TAC[REAL_LT_01]; + REWRITE_TAC[THETATILDE_INTEGRAND_INTEGRABLE]; + X_GEN_TAC `alpha:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN + STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_LE_INV_EQ] THEN ASM_REAL_ARITH_TAC; + MP_TAC(SPECL [`alpha:real`;`&0:real`;`&1:real`] CARLESON_G_BOUNDS) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; SIMP_TAC[]]]]]);; + +(* The tile operator A (Fremlin 286P): Ah(x) = sup_z |2pi (hhat x theta_z) *) +(* check(x)|. The inverse transform g check(x) = fourier g (--x) *) +(* (FOURIER_REFLECT). *) +let carleson_A = new_definition + `carleson_A (h:real->complex) (x:real) = + sup { norm(Cx(&2 * pi) * + fourier (\y. fourier h y * Cx(carleson_theta z y)) (--x)) + | z IN (:real) }`;; + +(* Two auxiliary results for the CARLESON_286P tile operator. *) +(* (286O(a) theta_z-measurability = CARLESON_THETA_CX_MEASURABLE discharges *) +(* the measurability hypothesis). hhat * theta_z is L^1 *) +(* (Schwartz transform x bounded *) +(* measurable), and each tile-window is continuous. *) +let CARLESON_FHAT_THETA_ABSINT = prove + (`!(h:real->complex) z. + schwartz h + ==> (\y. fourier h (drop y) * Cx(carleson_theta z (drop y))) + absolutely_integrable_on (:real^1)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `z:real` CARLESON_THETA_CX_MEASURABLE) THEN DISCH_TAC THEN + MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE THEN + EXISTS_TAC `\y:real^1. lift(norm(fourier (h:real->complex) (drop y)))` THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_ON_COMPLEX_MUL THEN CONJ_TAC THENL + [MP_TAC(ISPEC `h:real->complex` SCHWARTZ_FHAT_ABSINT) THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[ABSOLUTELY_INTEGRABLE_MEASURABLE] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]]; + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN + MP_TAC(ISPEC `h:real->complex` SCHWARTZ_FHAT_ABSINT) THEN + ASM_REWRITE_TAC[]; + X_GEN_TAC `x:real^1` THEN + REWRITE_TAC[IN_UNIV; LIFT_DROP; COMPLEX_NORM_MUL; COMPLEX_NORM_CX] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[NORM_POS_LE] THEN + MP_TAC(ISPECL [`z:real`; `drop(x:real^1)`] CARLESON_THETA_BOUNDS) THEN + REAL_ARITH_TAC]);; + +(* --------------------------------------------------------------------- *) +(* 286Q(c) support: the modulated-dilated Schwartz function M_b D_a h is *) +(* Schwartz (a<>0), and its theta-window (M_b D_a h)hat . Cx(theta v) is *) +(* absolutely integrable -- the input to the 286Q kernel bound. *) +(* --------------------------------------------------------------------- *) + +let CARLESON_SCHWARTZ_MODDIL = prove + (`!(h:real->complex) a b. schwartz h /\ ~(a = &0) + ==> schwartz (carleson_modulate b (carleson_dilate a h))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[carleson_modulate; carleson_dilate] THEN + MATCH_MP_TAC SCHWARTZ_MODULATE THEN + SUBGOAL_THEN + `(\x. (h:real->complex)(a * x)) = (\x. h(&0 + a * x))` SUBST1_TAC THENL + [REWRITE_TAC[REAL_ADD_LID]; ALL_TAC] THEN + MATCH_MP_TAC SCHWARTZ_AFFINE THEN ASM_REWRITE_TAC[]);; + +let CARLESON_MODDIL_WINDOW_ABSINT = prove + (`!(h:real->complex) a b v. schwartz h /\ ~(a = &0) + ==> (\w. fourier (carleson_modulate b (carleson_dilate a h)) (drop w) * + Cx(carleson_theta v (drop w))) absolutely_integrable_on (:real^1)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CARLESON_FHAT_THETA_ABSINT THEN + MATCH_MP_TAC CARLESON_SCHWARTZ_MODDIL THEN ASM_REWRITE_TAC[]);; + +let CARLESON_A_WINDOW_CONTINUOUS = prove + (`!(h:real->complex) zt x. + schwartz h + ==> (\x. norm(Cx(&2 * pi) * + fourier (\y. fourier h y * Cx(carleson_theta zt y)) (--x))) + real_continuous atreal x`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS_ATREAL; o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_LIFT_NORM_COMPOSE THEN + MATCH_MP_TAC CONTINUOUS_COMPLEX_LMUL THEN + SUBGOAL_THEN + `(\w:real^1. fourier (\y. fourier (h:real->complex) y * Cx(carleson_theta zt + y)) (--drop w)) = + (\w:real^1. fourier (\y. fourier (h:real->complex) y * Cx(carleson_theta zt + y)) (drop w)) o (\w. --w)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; o_THM; DROP_NEG]; ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_AT_COMPOSE THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_NEG THEN + REWRITE_TAC[CONTINUOUS_AT_ID]; ALL_TAC] THEN + CONV_TAC(DEPTH_CONV BETA_CONV) THEN + MP_TAC(ISPEC `\y. fourier (h:real->complex) y * Cx(carleson_theta zt y)` + FOURIER_CONTINUOUS_ON) THEN + ANTS_TAC THENL + [REWRITE_TAC[] THEN MATCH_MP_TAC CARLESON_FHAT_THETA_ABSINT THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT; OPEN_UNIV; IN_UNIV]);; + +(* 286P(a) uniform (in z,x) modulus bound: |2pi (hhat x theta_z)check(x)| is *) +(* <= sqrt(2pi) int|hhat|, independent of z (because 0<=theta_z<=1). *) +(* Supplies the *) +(* pointwise-bounded hypothesis for the sup-over-z measurability of Ah. *) +let CARLESON_A_WINDOW_UNIFORM_BOUND = prove + (`!(h:real->complex) z x. + schwartz h + ==> norm(Cx(&2 * pi) * + fourier (\y. fourier h y * Cx(carleson_theta z y)) (--x)) + <= sqrt(&2 * pi) * + drop(integral (:real^1) (\y. lift(norm(fourier (h:real->complex) + (drop y)))))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`h:real->complex`; `z:real`] CARLESON_FHAT_THETA_ABSINT) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX] THEN + SUBGOAL_THEN `abs(&2 * pi) = &2 * pi` SUBST1_TAC THENL + [REWRITE_TAC[REAL_ABS_REFL] THEN MP_TAC PI_POS THEN + REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPECL [`\y. fourier (h:real->complex) y * Cx(carleson_theta z y)`; + `--x:real`] + FOURIER_BOUND) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MP_TAC(ISPECL [`( * ):complex->complex->complex`; + `\u:real^1. cexp(--(ii * Cx(--x) * Cx(drop u)))`; + `\u:real^1. fourier (h:real->complex) (drop u) * + Cx(carleson_theta z (drop u))`; + `(:real^1)`] + ABSOLUTELY_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT) THEN + REWRITE_TAC[BILINEAR_COMPLEX_MUL] THEN BETA_TAC THEN DISCH_THEN + MATCH_MP_TAC THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_IMP_MEASURABLE_ON THEN + SUBGOAL_THEN + `(\u:real^1. cexp(--(ii * Cx(--x) * Cx(drop u)))) = + cexp o (\u. --((ii * Cx(--x)) * Cx(drop u)))` + SUBST1_TAC THENL [REWRITE_TAC[o_DEF; COMPLEX_MUL_ASSOC]; ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + REWRITE_TAC[CONTINUOUS_ON_CEXP] THEN + MATCH_MP_TAC CONTINUOUS_ON_NEG THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN + REWRITE_TAC[CONTINUOUS_ON_CONST] THEN + MATCH_MP_TAC CONTINUOUS_ON_CX_DROP THEN + REWRITE_TAC[CONTINUOUS_ON_ID]; + REWRITE_TAC[bounded; FORALL_IN_IMAGE] THEN EXISTS_TAC `&1` THEN + X_GEN_TAC `u:real^1` THEN REWRITE_TAC[IN_UNIV] THEN + SUBGOAL_THEN + `--(ii * Cx(--x) * Cx(drop u)) = + ii * Cx(--(--x * drop u))` SUBST1_TAC THENL + [REWRITE_TAC[CX_NEG; CX_MUL] THEN + SIMPLE_COMPLEX_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[NORM_CEXP_II; REAL_LE_REFL]; + ASM_REWRITE_TAC[]]; + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + DISCH_TAC THEN + SUBGOAL_THEN `&0 < sqrt(&2 * pi)` ASSUME_TAC THENL + [MATCH_MP_TAC SQRT_POS_LT THEN MP_TAC PI_POS THEN + REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `(&2 * pi) * (&1 / sqrt(&2 * pi)) = sqrt(&2 * pi)` ASSUME_TAC THENL + [MP_TAC(SPEC `&2 * pi` SQRT_POW_2) THEN + ANTS_TAC THENL [MP_TAC PI_POS THEN REAL_ARITH_TAC; ALL_TAC] THEN + POP_ASSUM MP_TAC THEN CONV_TAC REAL_FIELD; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sqrt(&2 * pi) * + drop(integral (:real^1) + (\y. lift(norm(fourier (h:real->complex) (drop y) * + Cx(carleson_theta z (drop y))))))` THEN + CONJ_TAC THENL + [FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [SYM th]) + THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_LMUL THEN + CONJ_TAC THENL + [MP_TAC PI_POS THEN REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MP_TAC PI_POS THEN REAL_ARITH_TAC; + ASM_REWRITE_TAC[REAL_MUL_ASSOC]]]; + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC INTEGRAL_DROP_LE THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN + MP_TAC(ISPEC `h:real->complex` SCHWARTZ_FHAT_ABSINT) THEN + ASM_REWRITE_TAC[]; + X_GEN_TAC `y:real^1` THEN REWRITE_TAC[IN_UNIV; LIFT_DROP] THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[NORM_POS_LE] THEN + MP_TAC(ISPECL [`z:real`; `drop(y:real^1)`] CARLESON_THETA_BOUNDS) THEN + REAL_ARITH_TAC]]);; + +(* ===================================================================== *) +(* 286Q(c): the kernel bound. For Schwartz h and a > 0, *) +(* 2pi |(hhat . theta'_{z,a,b})check(-y)| <= A(M_b D_a h)(y/a), *) +(* where A = carleson_A is the (uncountable) sup-of-windows maximal *) +(* operator. This is Fremlin 286Q(c): the dilation-modulation of the *) +(* theta'-kernel check-integral reduces (change of variables) to a single *) +(* window of the maximal operator for the reparametrised M_b D_a h. *) +(* Proof spine: rewrite the check-integrand (CARLESON_Q286C_INTEGRAND) as *) +(* Cx a * (M_b D_a h)hat-window at (a w + b); pull Cx a (FOURIER_LMUL); *) +(* apply the affine change of variables (CARLESON_FOURIER_DILSHIFT) to get *) +(* Cx(1/a) cexp(..) fourier(window)(-(y/a)); the Jacobian x phase has unit *) +(* modulus (CARLESON_JACOBIAN_UNIT), so 2pi|LHS| = 2pi|window(-(y/a))|, *) +(* a single element of the A-sup-set (REAL_LE_SUP, bounded by 286P(a) *) +(* CARLESON_A_WINDOW_UNIFORM_BOUND). *) +(* ===================================================================== *) + +(* The G-window and its b-shift are absolutely integrable, hence the cexp- *) +(* twisted forms (the CARLESON_FOURIER_DILSHIFT hypotheses) are integrable. *) +let CARLESON_MODDIL_WINDOW_SHIFT_ABSINT = prove + (`!(h:real->complex) a b v c. schwartz h /\ ~(a = &0) + ==> (\z:real^1. fourier (carleson_modulate b (carleson_dilate a h)) (drop z + + c) * + Cx(carleson_theta v (drop z + c))) absolutely_integrable_on + (:real^1)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\z:real^1. fourier (carleson_modulate b (carleson_dilate a + (h:real->complex))) (drop z + c) * + Cx(carleson_theta v (drop z + c))) + = (\z:real^1. (\w:real^1. fourier (carleson_modulate b (carleson_dilate a + h)) (drop w) * + Cx(carleson_theta v (drop w))) (lift c + z))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + REWRITE_TAC[DROP_ADD; LIFT_DROP] THEN + REWRITE_TAC[REAL_ADD_SYM]; ALL_TAC] THEN + REWRITE_TAC[ABSOLUTELY_INTEGRABLE_TRANSLATION; TRANSLATION_UNIV] THEN + MATCH_MP_TAC CARLESON_MODDIL_WINDOW_ABSINT THEN ASM_REWRITE_TAC[]);; + +let CARLESON_KERNEL_INTEG = prove + (`!(h:real->complex) a b v d c. schwartz h /\ ~(a = &0) + ==> (\x:real^1. cexp(--(ii * Cx d * Cx(drop x))) * + (fourier(carleson_modulate b (carleson_dilate a h))(drop x + + c) * + Cx(carleson_theta v (drop x + c)))) integrable_on + (:real^1)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MP_TAC(ISPECL [`\u. fourier(carleson_modulate b (carleson_dilate (a:real) + (h:real->complex)))(u+c)*Cx(carleson_theta v (u+c))`; + `d:real`] FOURIER_MODULATION_ABSINT) THEN + ANTS_TAC THENL + [BETA_TAC THEN MATCH_MP_TAC CARLESON_MODDIL_WINDOW_SHIFT_ABSINT THEN + ASM_REWRITE_TAC[]; + DISCH_THEN(MP_TAC o BETA_RULE) THEN REWRITE_TAC[]]);; + +(* M_{b/a} h transform-integrand integrable (all w): the hypothesis of *) +(* CARLESON_Q286C_INTEGRAND. *) +let CARLESON_MOD_TRANSFORM_INTEG = prove + (`!(h:real->complex) a b w. schwartz h + ==> (\x:real^1. cexp(--(ii * Cx (w/a) * Cx(drop x))) * + (\u. cexp(ii * Cx(b/a) * Cx u) * h u)(drop x)) integrable_on + (:real^1)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MP_TAC(ISPECL [`\u. cexp(ii * Cx(b/a) * Cx u) * (h:real->complex) u`; + `w/a:real`] FOURIER_MODULATION_ABSINT) THEN + ANTS_TAC THENL + [BETA_TAC THEN + MP_TAC(ISPEC `\x. cexp(ii * Cx(b/a) * Cx x) * (h:real->complex) x` + SCHWARTZ_ABSINT) THEN + ANTS_TAC THENL + [MATCH_MP_TAC SCHWARTZ_MODULATE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[]; + REWRITE_TAC[]]);; + +(* Affine image of the whole line is the whole line (nonzero scale). *) +let CARLESON_AFFINITY_IMAGE_UNIV = prove + (`!m c:real^1. ~(m = &0) ==> IMAGE (\x:real^1. m % x + c) (:real^1) = + (:real^1)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[EXTENSION; IN_IMAGE; IN_UNIV] THEN + X_GEN_TAC `y:real^1` THEN EXISTS_TAC `inv m % (y - c):real^1` THEN + REWRITE_TAC[VECTOR_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_MUL_RINV] THEN + VECTOR_ARITH_TAC);; + +(* The dilated+shifted G-window \z. G(a z + b) is absolutely integrable. *) +let CARLESON_MODDIL_WINDOW_DIL_ABSINT = prove + (`!(h:real->complex) a b v. schwartz h /\ &0 < a + ==> (\z:real^1. fourier(carleson_modulate b (carleson_dilate a h))(a * drop z + + b) * + Cx(carleson_theta v (a * drop z + b))) + absolutely_integrable_on (:real^1)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`\z:real^1. fourier(carleson_modulate b (carleson_dilate a + (h:real->complex)))(drop z) * + Cx(carleson_theta v (drop z))`; + `(:real^1)`; `a:real`; `lift b`] ABSOLUTELY_INTEGRABLE_AFFINITY) THEN + ASM_SIMP_TAC[REAL_LT_IMP_NZ] THEN ANTS_TAC THENL + [MATCH_MP_TAC CARLESON_MODDIL_WINDOW_ABSINT THEN + ASM_SIMP_TAC[REAL_LT_IMP_NZ]; ALL_TAC] THEN + ASM_SIMP_TAC[CARLESON_AFFINITY_IMAGE_UNIV; REAL_INV_EQ_0; + REAL_LT_IMP_NZ] THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + REWRITE_TAC[DROP_ADD; DROP_CMUL; LIFT_DROP]);; + +(* Its cexp-twist is integrable: the FOURIER_LMUL side-condition. *) +let CARLESON_DILWIN_LMUL_INTEG = prove + (`!(h:real->complex) a b v y. schwartz h /\ &0 < a + ==> (\x:real^1. cexp(--(ii * Cx(--y) * Cx(drop x))) * + (\w. fourier(carleson_modulate b (carleson_dilate a h))(a * w + b) * + Cx(carleson_theta v (a * w + b)))(drop x)) + integrable_on (:real^1)`, + REPEAT STRIP_TAC THEN BETA_TAC THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MP_TAC(ISPECL [`\w. fourier(carleson_modulate b (carleson_dilate (a:real) + (h:real->complex)))(a * w + b) * Cx(carleson_theta v (a * w + b))`; + `--y:real`] FOURIER_MODULATION_ABSINT) THEN + ANTS_TAC THENL + [BETA_TAC THEN MATCH_MP_TAC CARLESON_MODDIL_WINDOW_DIL_ABSINT THEN + ASM_REWRITE_TAC[]; + DISCH_THEN(MP_TAC o BETA_RULE) THEN REWRITE_TAC[]]);; + +(* The unit modulus of the Jacobian (Cx a . Cx(1/a)) times the shift phase. *) +let CARLESON_JACOBIAN_UNIT = prove + (`!a b c. &0 < a ==> norm(Cx a) * norm(Cx(&1/a)) * norm(cexp(ii * Cx b * Cx + c)) = &1`, + REPEAT STRIP_TAC THEN REWRITE_TAC[COMPLEX_NORM_CX] THEN + SUBGOAL_THEN `cexp(ii * Cx b * Cx c) = cexp(ii * Cx(b * c))` SUBST1_TAC THENL + [AP_TERM_TAC THEN REWRITE_TAC[CX_MUL] THEN + SIMPLE_COMPLEX_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[NORM_CEXP_II; REAL_MUL_RID] THEN + SUBGOAL_THEN + `abs a = a /\ abs(&1/a) = &1/a` (fun th -> REWRITE_TAC[th]) THENL + [ASM_SIMP_TAC[REAL_ABS_REFL; REAL_LT_IMP_LE; REAL_LE_DIV; REAL_POS]; + ALL_TAC] THEN + UNDISCH_TAC `&0 < a` THEN CONV_TAC REAL_FIELD);; + +let CARLESON_NEG_DIV = prove + (`!y a:real. (--y)/a = --(y/a)`, + REWRITE_TAC[real_div] THEN REAL_ARITH_TAC);; + +(* STEP 1: rewrite the theta'-check-integrand and pull the Cx a scalar out. *) +let CARLESON_KERNEL_STEP1 = prove + (`!(h:real->complex) z a b y. schwartz h /\ &0 < a + ==> fourier(\w. fourier h w * Cx(carleson_theta' z a b w))(--y) + = Cx a * fourier(\w. fourier(carleson_modulate b (carleson_dilate a + h))(a*w+b) * + Cx(carleson_theta (a*z+b)(a*w+b)))(--y)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\w. fourier (h:real->complex) w * Cx(carleson_theta' z a b w)) + = (\w. Cx a * (fourier(carleson_modulate b (carleson_dilate a h))(a*w+b) * + Cx(carleson_theta (a*z+b)(a*w+b))))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `w:real` THEN + MATCH_MP_TAC CARLESON_Q286C_INTEGRAND THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + GEN_TAC THEN MATCH_MP_TAC CARLESON_MOD_TRANSFORM_INTEG THEN + ASM_REWRITE_TAC[]]; ALL_TAC] THEN + MP_TAC(ISPECL [`\w. fourier(carleson_modulate b (carleson_dilate (a:real) + (h:real->complex)))(a*w+b) * + Cx(carleson_theta (a*z+b)(a*w+b))`; `Cx a`; + `--y:real`] FOURIER_LMUL) THEN + ANTS_TAC THENL + [MP_TAC(ISPECL [`h:real->complex`;`a:real`;`b:real`;`(a:real)*z+b`;`y:real`] + CARLESON_DILWIN_LMUL_INTEG) THEN + ASM_REWRITE_TAC[] THEN BETA_TAC THEN REWRITE_TAC[]; + DISCH_THEN(fun th -> REWRITE_TAC[BETA_RULE th])]);; + +(* STEP 2: the affine change of variables on the inner Fourier transform. *) +let CARLESON_KERNEL_STEP2 = prove + (`!(h:real->complex) z a b y. schwartz h /\ &0 < a + ==> fourier(\w. fourier(carleson_modulate b (carleson_dilate a h))(a*w+b) * + Cx(carleson_theta (a*z+b)(a*w+b)))(--y) + = Cx(&1/a) * cexp(ii * Cx b * Cx((--y)/a)) * + fourier(\w'. fourier(carleson_modulate b (carleson_dilate a h)) w' * + Cx(carleson_theta (a*z+b) w'))((--y)/a)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `~(a = &0)` ASSUME_TAC THENL + [ASM_SIMP_TAC[REAL_LT_IMP_NZ]; ALL_TAC] THEN + MP_TAC(SPECL + [`\w'. fourier(carleson_modulate b (carleson_dilate (a:real) + (h:real->complex))) w' * + Cx(carleson_theta (a*z+b) w')`; + `a:real`; `b:real`; `--y:real`] CARLESON_FOURIER_DILSHIFT) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL + [MP_TAC(SPECL + [`h:real->complex`;`a:real`;`b:real`;`(a:real)*z+b`;`((--y)/a):real`; + `b:real`] CARLESON_KERNEL_INTEG) THEN + ASM_REWRITE_TAC[] THEN BETA_TAC THEN REWRITE_TAC[]; + MP_TAC(SPECL + [`h:real->complex`;`a:real`;`b:real`;`(a:real)*z+b`;`((--y)/a):real`; + `&0`] CARLESON_KERNEL_INTEG) THEN + ASM_REWRITE_TAC[REAL_ADD_RID] THEN BETA_TAC THEN + REWRITE_TAC[REAL_ADD_RID]]);; + +(* The combined norm identity: the Jacobian x phase drops out (unit *) +(* modulus). *) +let CARLESON_KERNEL_NORM_ID = prove + (`!(h:real->complex) z a b y. schwartz h /\ &0 < a + ==> &2 * pi * norm(fourier(\w. fourier h w * Cx(carleson_theta' z a b + w))(--y)) + = &2 * pi * norm(fourier(\w'. fourier(carleson_modulate b + (carleson_dilate a h)) w' * + Cx(carleson_theta (a*z+b) w'))((--y)/a))`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[CARLESON_KERNEL_STEP1; CARLESON_KERNEL_STEP2] THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[COMPLEX_NORM_MUL] THEN + MP_TAC(SPECL [`a:real`; `b:real`; + `((--y)/a):real`] CARLESON_JACOBIAN_UNIT) THEN + ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[REAL_ARITH `A * B * C * D = (A * B * C) * D:real`] THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[REAL_MUL_LID]);; + +(* Single-window sup-membership: 2pi|window(-(y/a))| <= A(M_b D_a h)(y/a). *) +let CARLESON_KERNEL_SUP = prove + (`!(h:real->complex) z a b y. schwartz h /\ &0 < a + ==> &2 * pi * norm(fourier(\w'. fourier(carleson_modulate b (carleson_dilate + a h)) w' * + Cx(carleson_theta (a*z+b) w'))((--y)/a)) + <= carleson_A (carleson_modulate b (carleson_dilate a h)) (y/a)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[carleson_A] THEN + MATCH_MP_TAC REAL_LE_SUP THEN + EXISTS_TAC + `sqrt(&2 * pi) * + drop(integral(:real^1) + (\y'. lift(norm(fourier + (carleson_modulate b (carleson_dilate a (h:real->complex))) + (drop y')))))` THEN + EXISTS_TAC `norm(Cx(&2 * pi) * + fourier (\y'. fourier (carleson_modulate b (carleson_dilate a + (h:real->complex))) y' * Cx(carleson_theta (a*z+b) y')) + (--(y/a)))` THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `(a:real)*z+b` THEN + REWRITE_TAC[IN_UNIV]; + REWRITE_TAC[CARLESON_NEG_DIV; COMPLEX_NORM_MUL; COMPLEX_NORM_CX] THEN + SUBGOAL_THEN `abs(&2 * pi) = &2 * pi` SUBST1_TAC THENL + [REWRITE_TAC[REAL_ABS_REFL] THEN MP_TAC PI_POS THEN + REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_MUL_ASSOC; REAL_LE_REFL]; + REWRITE_TAC[FORALL_IN_GSPEC] THEN X_GEN_TAC `zz:real` THEN + MP_TAC(SPECL [`carleson_modulate b (carleson_dilate a (h:real->complex))`; + `zz:real`; `y/a:real`] CARLESON_A_WINDOW_UNIFORM_BOUND) THEN + ASM_SIMP_TAC[CARLESON_SCHWARTZ_MODDIL; REAL_LT_IMP_NZ]]);; + +(* 286Q(c): the kernel bound, assembled from NORM_ID + SUP. *) +let CARLESON_286Q_KERNEL = prove + (`!(h:real->complex) z a b y. schwartz h /\ &0 < a + ==> &2 * pi * norm(fourier(\w. fourier h w * Cx(carleson_theta' z a b + w))(--y)) + <= carleson_A (carleson_modulate b (carleson_dilate a h)) (y/a)`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[CARLESON_KERNEL_NORM_ID] THEN + ASM_SIMP_TAC[CARLESON_KERNEL_SUP]);; + +(* 286P(a) measurability: Ah = sup_z |v_z| is lower semi-continuous *) +(* (each v_z continuous in x = CARLESON_A_WINDOW_CONTINUOUS) and pointwise *) +(* bounded *) +(* (CARLESON_A_WINDOW_UNIFORM_BOUND), so real-measurable by *) +(* REAL_MEASURABLE_ON_SUP_ *) +(* CONTINUOUS. This is Fremlin 286P's "Ah is Borel measurable, by 256Ma". *) +let CARLESON_A_MEASURABLE = prove + (`!(h:real->complex). schwartz h ==> (carleson_A h) real_measurable_on + (:real)`, + GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN + `carleson_A (h:real->complex) = + (\x. sup { (\z. norm(Cx(&2 * pi) * + fourier (\y. fourier h y * Cx(carleson_theta z y)) + (--x))) z + | z IN (:real) })` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; carleson_A]; ALL_TAC] THEN + MATCH_MP_TAC REAL_MEASURABLE_ON_SUP_CONTINUOUS THEN + REWRITE_TAC[UNIV_NOT_EMPTY; IN_UNIV] THEN CONJ_TAC THENL + [X_GEN_TAC `z:real` THEN X_GEN_TAC `x:real` THEN REWRITE_TAC[] THEN + MP_TAC(ISPECL [`h:real->complex`; `z:real`; + `x:real`] CARLESON_A_WINDOW_CONTINUOUS) THEN + ASM_REWRITE_TAC[]; + X_GEN_TAC `x:real` THEN + EXISTS_TAC `sqrt(&2 * pi) * + drop(integral (:real^1) (\y. lift(norm(fourier + (h:real->complex) (drop y)))))` THEN + X_GEN_TAC `z:real` THEN REWRITE_TAC[] THEN + MP_TAC(ISPECL [`h:real->complex`; `z:real`; + `x:real`] CARLESON_A_WINDOW_UNIFORM_BOUND) THEN + ASM_REWRITE_TAC[]]);; + +(* ========================================================================= *) +(* 286S infrastructure (Fremlin mt286.tex 2700-2823): the iterated dilation- *) +(* average operator Atilde h. 286S(b) rests on 286P applied to the *) +(* modulated-dilated M_beta D_alpha h, with the scaling relations *) +(* ||M_b D_a h||_2 = (1/sqrt a) ||h||_2, mu(a^-1 F) = (1/a) mu F, *) +(* which make the per-(alpha,beta) slice integral 4C9||h||sqrt(muF) *) +(* INDEPENDENT *) +(* of (alpha,beta) -- the a cancels exactly. These are the S0-S3 bricks. *) +(* ========================================================================= *) + +(* S0: carleson_A h >= 0 (sup of norms over the nonempty bounded z-family). *) +let CARLESON_A_POS = prove + (`!(h:real->complex) x. schwartz h ==> &0 <= carleson_A h x`, + REPEAT STRIP_TAC THEN REWRITE_TAC[carleson_A] THEN + MATCH_MP_TAC REAL_LE_SUP THEN + EXISTS_TAC `sqrt(&2 * pi) * + drop(integral (:real^1) (\y. lift(norm(fourier (h:real->complex) + (drop y)))))` THEN + EXISTS_TAC `norm(Cx(&2 * pi) * + fourier (\y. fourier h y * Cx(carleson_theta (&0) y)) (--x))` + THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `&0:real` THEN + REWRITE_TAC[IN_UNIV]; + REWRITE_TAC[NORM_POS_LE]; + REWRITE_TAC[FORALL_IN_GSPEC] THEN X_GEN_TAC `z:real` THEN + MP_TAC(ISPECL [`h:real->complex`; `z:real`; + `x:real`] CARLESON_A_WINDOW_UNIFORM_BOUND) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> REWRITE_TAC[th])]);; + +(* S0': carleson_A h is bounded by the uniform-bound constant (sup <= *) +(* const). *) +let CARLESON_A_UNIFORM_BOUND = prove + (`!(h:real->complex) x. schwartz h + ==> carleson_A h x <= sqrt(&2 * pi) * drop(integral (:real^1) (\y. + lift(norm(fourier (h:real->complex) (drop y)))))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[carleson_A] THEN + MATCH_MP_TAC REAL_SUP_LE THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + EXISTS_TAC `norm(Cx(&2 * pi) * fourier (\y. fourier h y * Cx(carleson_theta + (&0) y)) (--x))` THEN + REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `&0:real` THEN + REWRITE_TAC[IN_UNIV]; + REWRITE_TAC[FORALL_IN_GSPEC] THEN X_GEN_TAC `z:real` THEN + MP_TAC(ISPECL [`h:real->complex`; `z:real`; + `x:real`] CARLESON_A_WINDOW_UNIFORM_BOUND) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> REWRITE_TAC[th])]);; + +(* S0'': carleson_A h integrable on any finite-measure set (bounded *) +(* measurable). *) +let CARLESON_A_INTEGRABLE = prove + (`!(h:real->complex) FF. schwartz h /\ real_measurable FF + ==> (carleson_A h) real_integrable_on FF`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN + EXISTS_TAC `(\x:real. sqrt(&2 * pi) * drop(integral (:real^1) (\y. + lift(norm(fourier (h:real->complex) (drop y)))))):real->real` THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC REAL_MEASURABLE_ON_MEASURABLE_SUBSET THEN + EXISTS_TAC `(:real)` THEN ASM_SIMP_TAC[SUBSET_UNIV; CARLESON_A_MEASURABLE]; + REWRITE_TAC[REAL_INTEGRABLE_ON] THEN REWRITE_TAC[o_DEF; LIFT_CMUL] THEN + REWRITE_TAC[INTEGRABLE_ON_CONST] THEN DISJ2_TAC THEN + ASM_REWRITE_TAC[GSYM REAL_MEASURABLE_MEASURABLE]; + X_GEN_TAC `x:real` THEN DISCH_TAC THEN + MP_TAC(ISPECL [`h:real->complex`; `x:real`] CARLESON_A_POS) THEN + MP_TAC(ISPECL [`h:real->complex`; `x:real`] CARLESON_A_UNIFORM_BOUND) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC]);; + +(* S1: lnorm depends only on the pointwise norm of the integrand. *) +let LNORM_NORM_EQ = prove + (`!s p (f:real^1->complex) g. (!x. norm(f x) = norm(g x)) ==> lnorm s p f = + lnorm s p g`, + REPEAT STRIP_TAC THEN REWRITE_TAC[lnorm] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN ASM_REWRITE_TAC[]);; + +(* S1: L^2 dilation scaling of the argument: ||h(a.)||_2 = (1/sqrt a) *) +(* ||h||_2. *) +let DILATE_ARG_LNORM = prove + (`!(h:real->complex) a. &0 < a /\ (\z. h(drop z)) IN lspace (:real^1) (&2) + ==> lnorm (:real^1) (&2) (\z. h(a * drop z)) = + inv(sqrt a) * lnorm (:real^1) (&2) (\z. h(drop z))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\z. (h:real->complex)(a * drop z)) = + (\z. inv(sqrt a) % (Cx(sqrt a) * (\w. h(drop w))(a % z)))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `z:real^1` THEN + REWRITE_TAC[DROP_CMUL; COMPLEX_CMUL; GSYM CX_MUL; COMPLEX_MUL_ASSOC; + GSYM CX_MUL] THEN + SUBGOAL_THEN `inv(sqrt a) * sqrt a = &1` SUBST1_TAC THENL + [MATCH_MP_TAC REAL_MUL_LINV THEN MATCH_MP_TAC REAL_LT_IMP_NZ THEN + MATCH_MP_TAC SQRT_POS_LT THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[CX_MUL; COMPLEX_MUL_LID]]; + ALL_TAC] THEN + MP_TAC(ISPECL [`(:real^1)`; `&2`; + `\z. Cx(sqrt a) * (\w. (h:real->complex)(drop w))(a % z)`; + `inv(sqrt a)`] LNORM_MUL) THEN + ANTS_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_EQ; ARITH_EQ] THEN + MATCH_MP_TAC L2_DILATE_LSPACE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + MP_TAC(ISPECL [`\w. (h:real->complex)(drop w)`; + `a:real`] LNORM_DILATE_EQ) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + SUBGOAL_THEN `abs(inv(sqrt a)) = inv(sqrt a)` SUBST1_TAC THENL + [REWRITE_TAC[REAL_ABS_INV] THEN AP_TERM_TAC THEN + REWRITE_TAC[REAL_ABS_REFL] THEN + MATCH_MP_TAC SQRT_POS_LE THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[]]);; + +(* S1: modulation is a unit-modulus multiplier, so |M_b D_a h| = |D_a h|. *) +let MODDIL_NORM = prove + (`!(h:real->complex) a b z. norm(carleson_modulate b (carleson_dilate a h) + (drop z)) = norm(h(a * drop z))`, + REWRITE_TAC[carleson_modulate; carleson_dilate; COMPLEX_NORM_MUL] THEN + REWRITE_TAC[GSYM CX_MUL; GSYM COMPLEX_MUL_ASSOC; NORM_CEXP_II; + REAL_MUL_LID]);; + +(* S1: ||M_b D_a h||_2 = (1/sqrt a) ||h||_2. *) +let MODDIL_LNORM = prove + (`!(h:real->complex) a b. &0 < a /\ (\z. h(drop z)) IN lspace (:real^1) (&2) + ==> lnorm (:real^1) (&2) (\z. carleson_modulate b (carleson_dilate a h) + (drop z)) = + inv(sqrt a) * lnorm (:real^1) (&2) (\z. h(drop z))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `lnorm (:real^1) (&2) (\z. carleson_modulate b (carleson_dilate a h) (drop + z)) = + lnorm (:real^1) (&2) (\z. (h:real->complex)(a * drop z))` SUBST1_TAC THENL + [MATCH_MP_TAC LNORM_NORM_EQ THEN GEN_TAC THEN + REWRITE_TAC[MODDIL_NORM]; ALL_TAC] THEN + MATCH_MP_TAC DILATE_ARG_LNORM THEN ASM_REWRITE_TAC[]);; + +(* S2: the D_{1/alpha} A M_beta D_alpha h kernel, a real >= 0. *) +let carleson_amd = new_definition + `carleson_amd (h:real->complex) alpha beta x = + carleson_A (carleson_modulate beta (carleson_dilate alpha h)) (x / + alpha)`;; + +let AMD_NONNEG = prove + (`!(h:real->complex) alpha beta x. schwartz h /\ &0 < alpha ==> &0 <= + carleson_amd h alpha beta x`, + REPEAT STRIP_TAC THEN REWRITE_TAC[carleson_amd] THEN + MATCH_MP_TAC CARLESON_A_POS THEN + MATCH_MP_TAC CARLESON_SCHWARTZ_MODDIL THEN + ASM_SIMP_TAC[REAL_LT_IMP_NZ]);; + +(* S3: change-of-variables on a general measurable set (from *) +(* HAS_INTEGRAL_AFFINITY *) +(* on IMAGE lift): int_{IMAGE(a.)T} f-preimage form. *) +let HAS_REAL_INTEGRAL_DILATE_SET = prove + (`!(f:real->real) a Tset i. &0 < a /\ (f has_real_integral i) (IMAGE (\x. a * + x) Tset) + ==> ((\x. f(a * x)) has_real_integral (inv a * i)) Tset`, + REPEAT STRIP_TAC THEN REWRITE_TAC[has_real_integral] THEN + FIRST_X_ASSUM(MP_TAC o REWRITE_RULE[has_real_integral]) THEN + DISCH_THEN(MP_TAC o SPECL [`a:real`; `vec 0:real^1`] o MATCH_MP + (ONCE_REWRITE_RULE[IMP_CONJ] HAS_INTEGRAL_AFFINITY)) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[DIMINDEX_1; REAL_POW_1; VECTOR_MUL_RZERO; VECTOR_ADD_RID; + VECTOR_NEG_0] THEN + SUBGOAL_THEN + `IMAGE (\x:real^1. inv a % x) (IMAGE lift (IMAGE (\x. a * x) Tset)) = IMAGE + lift Tset` + SUBST1_TAC THENL + [REWRITE_TAC[GSYM IMAGE_o; o_DEF] THEN + SUBGOAL_THEN + `(\x. inv a % lift (a * x)) = (\x:real. lift x)` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `u:real` THEN + REWRITE_TAC[LIFT_CMUL; VECTOR_MUL_ASSOC] THEN + SUBGOAL_THEN `inv a * a = &1` SUBST1_TAC THENL + [MATCH_MP_TAC REAL_MUL_LINV THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[VECTOR_MUL_LID]]; + REWRITE_TAC[ETA_AX]]; ALL_TAC] THEN + SUBGOAL_THEN + `(\x. (lift o f o drop) (a % x)) = lift o (\x. f (a * x)) o drop` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; o_THM] THEN GEN_TAC THEN + REWRITE_TAC[DROP_CMUL; LIFT_DROP]; + ALL_TAC] THEN + SUBGOAL_THEN `inv(abs a) % lift i = lift(inv a * i)` SUBST1_TAC THENL + [ASM_SIMP_TAC[REAL_ARITH `&0 < a ==> abs a = a`; LIFT_CMUL]; ALL_TAC] THEN + REWRITE_TAC[]);; + +let REAL_DIV_INV_MUL = prove + (`!x a:real. x / a = inv a * x`, + REPEAT GEN_TAC THEN REWRITE_TAC[real_div] THEN REAL_ARITH_TAC);; + +(* S3: int_F (D_{1/a}AM_bD_a h) = a * int_{a^-1 F} A(M_b D_a h). *) +let AMD_INT_F_SUBST = prove + (`!(h:real->complex) a b FF. schwartz h /\ &0 < a /\ real_measurable FF + ==> real_integral FF (\x. carleson_amd h a b x) = + a * real_integral (IMAGE (\x. inv a * x) FF) + (carleson_A (carleson_modulate b (carleson_dilate a h)))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[carleson_amd] THEN + MP_TAC(ISPECL [`carleson_A (carleson_modulate b (carleson_dilate a + (h:real->complex)))`; + `inv a:real`; `FF:real->bool`; + `real_integral (IMAGE (\x. inv a * x) FF) (carleson_A + (carleson_modulate b (carleson_dilate a + (h:real->complex))))`] + HAS_REAL_INTEGRAL_DILATE_SET) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC REAL_LT_INV THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_INTEGRABLE_INTEGRAL THEN + MATCH_MP_TAC CARLESON_A_INTEGRABLE THEN CONJ_TAC THENL + [MATCH_MP_TAC CARLESON_SCHWARTZ_MODDIL THEN + ASM_SIMP_TAC[REAL_LT_IMP_NZ]; + MATCH_MP_TAC REAL_MEASURABLE_SCALING THEN ASM_REWRITE_TAC[]]]; + ALL_TAC] THEN + REWRITE_TAC[REAL_INV_INV; REAL_DIV_INV_MUL] THEN + DISCH_THEN(SUBST1_TAC o MATCH_MP REAL_INTEGRAL_UNIQUE) THEN REFL_TAC);; + +let INV_SQRT_SQ = prove + (`!a. &0 < a ==> inv(sqrt a) * inv(sqrt a) = inv a`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_INV_MUL] THEN AP_TERM_TAC THEN + MP_TAC(SPEC `a:real` SQRT_POW_2) THEN ANTS_TAC THENL + [ASM_REAL_ARITH_TAC; REWRITE_TAC[REAL_POW_2] THEN + DISCH_THEN(fun th -> REWRITE_TAC[th])]);; + +(* S3 [286S(b) core]: the per-(alpha,beta) slice integral, INDEPENDENT of *) +(* (a,b): *) +(* int_F (D_{1/a}AM_bD_a h) <= 4C9 ||h||_2 sqrt(muF) -- the a cancels via *) +(* the *) +(* scaling a * (1/sqrt a) * sqrt(1/a) = 1. Takes 286P's bound as a *) +(* hypothesis. *) +let AMD_INT_F_BOUND = prove + (`!(h:real->complex) a b FF C9. + schwartz h /\ &0 < a /\ real_measurable FF /\ &0 <= C9 /\ + (!(g:real->complex) GG. schwartz g /\ real_measurable GG + ==> real_integral GG (carleson_A g) + <= &4 * C9 * lnorm (:real^1) (&2) (\z. g(drop z)) * + sqrt(real_measure GG)) + ==> real_integral FF (\x. carleson_amd h a b x) + <= &4 * C9 * lnorm (:real^1) (&2) (\z. h(drop z)) * sqrt(real_measure + FF)`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[AMD_INT_F_SUBST] THEN + SUBGOAL_THEN + `real_integral (IMAGE (\x. inv a * x) FF) + (carleson_A (carleson_modulate b (carleson_dilate a (h:real->complex)))) + <= &4 * C9 * + lnorm (:real^1) (&2) (\z. carleson_modulate b (carleson_dilate a h) + (drop z)) * + sqrt(real_measure (IMAGE (\x. inv a * x) FF))` + ASSUME_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN CONJ_TAC THENL + [MATCH_MP_TAC CARLESON_SCHWARTZ_MODDIL THEN ASM_SIMP_TAC[REAL_LT_IMP_NZ]; + MATCH_MP_TAC REAL_MEASURABLE_SCALING THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `a * (&4 * C9 * + lnorm (:real^1) (&2) (\z. carleson_modulate b (carleson_dilate a h) (drop + z)) * + sqrt(real_measure (IMAGE (\x. inv a * x) FF)))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE]; ALL_TAC] THEN + MP_TAC(ISPECL [`h:real->complex`; `a:real`; `b:real`] MODDIL_LNORM) THEN + ANTS_TAC THENL [ASM_SIMP_TAC[SCHWARTZ_L2]; ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN + SUBGOAL_THEN + `real_measure (IMAGE (\x. inv a * x) FF) = inv a * real_measure FF` + SUBST1_TAC THENL + [ASM_SIMP_TAC[REAL_MEASURE_SCALING] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[REAL_ABS_INV] THEN + AP_TERM_TAC THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `&0 <= real_measure FF` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_MEASURE_POS_LE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_SIMP_TAC[SQRT_MUL; REAL_LE_INV_EQ; REAL_LT_IMP_LE] THEN + MATCH_MP_TAC(REAL_ARITH `x = y ==> x <= y`) THEN + SUBGOAL_THEN `sqrt(inv a) = inv(sqrt a)` SUBST1_TAC THENL + [REWRITE_TAC[SQRT_INV]; ALL_TAC] THEN + SUBGOAL_THEN `a * inv(sqrt a) * inv(sqrt a) = &1` MP_TAC THENL + [MP_TAC(SPEC `a:real` INV_SQRT_SQ) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC REAL_MUL_RINV THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + CONV_TAC REAL_RING);; + +(* ========================================================================= *) +(* S5: the real-valued liminf-Fatou lemma (Fremlin's 286S(b) Fatou step). *) +(* No pre-built real liminf-Fatou exists (library FATOU needs a supplied *) +(* pointwise limit). Built here from the running infimum w_m = inf_{n>=m} *) +(* f_n *) +(* (increasing to liminf) via *) +(* REAL_BEPPO_LEVI_MONOTONE_CONVERGENCE_INCREASING. *) +(* ========================================================================= *) + +(* finite-tail inf is absolutely integrable (finite index set). *) +let FINTAIL_INF_INTEGRABLE = prove + (`!(f:num->real->real) s m k. + (!n. (f n) absolutely_real_integrable_on s) + ==> (\x. inf {f n x | n IN m..(m+k)}) absolutely_real_integrable_on s`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `!x. {f n x | n IN m..(m+k)} = + IMAGE (\n. (f:num->real->real) n x) (m..(m+k))` + (fun th -> REWRITE_TAC[th]) THENL + [REWRITE_TAC[SIMPLE_IMAGE]; ALL_TAC] THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_INF THEN + REWRITE_TAC[FINITE_NUMSEG; NUMSEG_EMPTY; NOT_LT; LE_ADD] THEN + REWRITE_TAC[ETA_AX] THEN ASM_REWRITE_TAC[]);; + +let FINTAIL_INF_NONNEG = prove + (`!(f:num->real->real) m k x. (!n. &0 <= f n x) + ==> &0 <= inf {f n x | n IN m..(m+k)}`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_INF THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM; FORALL_IN_GSPEC] THEN + CONJ_TAC THENL + [EXISTS_TAC `(f:num->real->real) m x` THEN EXISTS_TAC `m:num` THEN + REWRITE_TAC[IN_NUMSEG; LE_REFL; LE_ADD]; + REWRITE_TAC[IN_NUMSEG] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[]]);; +let FINTAIL_INF_LE_HEAD = prove + (`!(f:num->real->real) m k x. (!n. &0 <= f n x) + ==> inf {f n x | n IN m..(m+k)} <= f m x`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC INF_LE_ELEMENT THEN CONJ_TAC THENL + [EXISTS_TAC `&0:real` THEN REWRITE_TAC[FORALL_IN_GSPEC; IN_NUMSEG] THEN + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[]; + REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `m:num` THEN + REWRITE_TAC[IN_NUMSEG; LE_REFL; LE_ADD]]);; + +(* the finite-tail inf decreases to the infinite-tail inf as k -> inf. *) +let RUNNING_INF_CONVERGES = prove + (`!(f:num->real->real) m x. + (!n. &0 <= f n x) + ==> ((\k. inf {f n x | n IN m..(m+k)}) ---> inf {f n x | n >= m}) + sequentially`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `~({(f:num->real->real) n x | n >= m} = {}) /\ + (?b. !w. w IN {(f:num->real->real) n x | n >= m} ==> b <= w)` + STRIP_ASSUME_TAC THENL + [CONJ_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + EXISTS_TAC `(f:num->real->real) m x` THEN EXISTS_TAC `m:num` THEN + REWRITE_TAC[GE; LE_REFL]; + EXISTS_TAC `&0:real` THEN REWRITE_TAC[IN_ELIM_THM] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + MP_TAC(ISPEC `{(f:num->real->real) n x | n >= m}` INF) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; ALL_TAC] THEN + ABBREV_TAC `i = inf {(f:num->real->real) n x | n >= m}` THEN + DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "ilb") (LABEL_TAC "igt")) THEN + SUBGOAL_THEN + `!k. i <= inf {(f:num->real->real) n x | n IN m..(m+k)}` ASSUME_TAC THENL + [X_GEN_TAC `k:num` THEN + SUBGOAL_THEN `i = inf {(f:num->real->real) n x | n >= m}` SUBST1_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_INF_SUBSET THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + EXISTS_TAC `(f:num->real->real) m x` THEN EXISTS_TAC `m:num` THEN + REWRITE_TAC[IN_NUMSEG; LE_REFL; LE_ADD]; + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `w:real` THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `n:num` THEN + ASM_REWRITE_TAC[GE] THEN + FIRST_X_ASSUM(MP_TAC o check (fun th -> can (find_term (fun t -> t = + `(m:num)..(m+k)`)) (concl th))) THEN + REWRITE_TAC[IN_NUMSEG] THEN ARITH_TAC; + EXISTS_TAC `&0:real` THEN REWRITE_TAC[IN_ELIM_THM] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + SUBGOAL_THEN + `?n0:num. n0 >= m /\ + (f:num->real->real) n0 x < i + e` STRIP_ASSUME_TAC THENL + [REWRITE_TAC[GSYM REAL_NOT_LE] THEN + ONCE_REWRITE_TAC[MESON[] `(?n0. P n0 /\ ~Q n0) <=> ~(!n0. P n0 ==> Q n0)`] + THEN + DISCH_TAC THEN + SUBGOAL_THEN `i + e <= i` MP_TAC THENL + [REMOVE_THEN "igt" MATCH_MP_TAC THEN + REWRITE_TAC[IN_ELIM_THM] THEN X_GEN_TAC `w:real` THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN + ASM_REWRITE_TAC[]; + ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + EXISTS_TAC `n0 - m:num` THEN X_GEN_TAC `k:num` THEN DISCH_TAC THEN + REWRITE_TAC[] THEN + SUBGOAL_THEN + `inf {(f:num->real->real) n x | n IN m..(m+k)} <= f n0 x` ASSUME_TAC THENL + [MATCH_MP_TAC INF_LE_ELEMENT THEN CONJ_TAC THENL + [EXISTS_TAC `&0:real` THEN REWRITE_TAC[IN_ELIM_THM] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `n0:num` THEN + REWRITE_TAC[IN_NUMSEG] THEN + RULE_ASSUM_TAC(REWRITE_RULE[GE]) THEN ASM_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN + `i <= inf {(f:num->real->real) n x | n IN m..(m+k)}` ASSUME_TAC THENL + [FIRST_X_ASSUM(fun th -> if is_forall(concl th) && + can (find_term (fun t -> t = `(m:num)..(m+k)`)) (concl th) + then MATCH_ACCEPT_TAC(SPEC `k:num` th) else NO_TAC); + ALL_TAC] THEN + MP_TAC(SPECL [`inf {(f:num->real->real) n x | n IN m..(m+k)}`; + `i:real`; `e:real`; `(f:num->real->real) n0 x`] + (REAL_ARITH `!w i e f0. i <= w /\ w <= f0 /\ f0 < i + e ==> abs(w - i) < + e`)) THEN + ASM_REWRITE_TAC[]);; + +(* the infinite-tail inf w_m = inf_{n>=m} f_n is integrable (decreasing *) +(* MCT). *) +let RUNNING_INF_TAIL_INTEGRABLE = prove + (`!(f:num->real->real) s m. + (!n. (f n) absolutely_real_integrable_on s) /\ + (!n x. x IN s ==> &0 <= f n x) + ==> (\x. inf {f n x | n >= m}) real_integrable_on s`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\k. (\x. inf {(f:num->real->real) n x | n IN m..(m+k)})`; + `\x. inf {(f:num->real->real) n x | n >= m}`; `s:real->bool`] + REAL_MONOTONE_CONVERGENCE_DECREASING) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [X_GEN_TAC `k:num` THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC FINTAIL_INF_INTEGRABLE THEN ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_INF_SUBSET THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + EXISTS_TAC `(f:num->real->real) m x` THEN EXISTS_TAC `m:num` THEN + REWRITE_TAC[IN_NUMSEG; LE_REFL; LE_ADD]; + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `w:real` THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `n:num` THEN + ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o check(fun th -> can(find_term(fun + t->t=`(m:num)..(m+k)`))(concl th))) THEN + REWRITE_TAC[IN_NUMSEG] THEN ARITH_TAC; + EXISTS_TAC `&0:real` THEN REWRITE_TAC[IN_ELIM_THM] THEN + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[]]; + REPEAT STRIP_TAC THEN MATCH_MP_TAC RUNNING_INF_CONVERGES THEN + ASM_SIMP_TAC[]; + REWRITE_TAC[real_bounded; FORALL_IN_GSPEC; IN_UNIV] THEN + EXISTS_TAC `real_integral s ((f:num->real->real) m)` THEN + X_GEN_TAC `k:num` THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= b ==> abs x <= b`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_POS THEN CONJ_TAC THENL + [MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC FINTAIL_INF_INTEGRABLE THEN ASM_REWRITE_TAC[]; + X_GEN_TAC `x:real` THEN DISCH_TAC THEN BETA_TAC THEN + MATCH_MP_TAC FINTAIL_INF_NONNEG THEN ASM_SIMP_TAC[]]; + MATCH_MP_TAC REAL_INTEGRAL_LE THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC FINTAIL_INF_INTEGRABLE THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE THEN + ASM_REWRITE_TAC[ETA_AX]; + X_GEN_TAC `x:real` THEN DISCH_TAC THEN BETA_TAC THEN + MATCH_MP_TAC FINTAIL_INF_LE_HEAD THEN ASM_SIMP_TAC[]]]]; + STRIP_TAC THEN ASM_REWRITE_TAC[]]);; + +(* REAL_FATOU_LIMINF: f_n >= 0 integrable with int f_n <= B ==> the *) +(* pointwise liminf (= lim of running infima) is integrable with integral <= *) +(* B. *) +let REAL_FATOU_LIMINF = prove + (`!(f:num->real->real) s B. + (!n. (f n) absolutely_real_integrable_on s) /\ + (!n x. x IN s ==> &0 <= f n x) /\ + (!n. real_integral s (f n) <= B) + ==> ?g k. real_negligible k /\ + (!x. x IN s DIFF k ==> ((\m. inf {f n x | n >= m}) ---> g x) + sequentially) /\ + g real_integrable_on s /\ real_integral s g <= B`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\m. (\x. inf {(f:num->real->real) n x | n >= m})`; + `s:real->bool`] + REAL_BEPPO_LEVI_MONOTONE_CONVERGENCE_INCREASING) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC RUNNING_INF_TAIL_INTEGRABLE THEN + ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_INF_SUBSET THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + EXISTS_TAC `(f:num->real->real) (SUC k) x` THEN EXISTS_TAC `SUC k` THEN + REWRITE_TAC[GE; LE_REFL]; + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `w:real` THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `n:num` THEN + ASM_REWRITE_TAC[] THEN UNDISCH_TAC `n >= SUC k` THEN ARITH_TAC; + EXISTS_TAC `&0:real` THEN REWRITE_TAC[IN_ELIM_THM] THEN + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[]]; + REWRITE_TAC[real_bounded; FORALL_IN_GSPEC; IN_UNIV] THEN + EXISTS_TAC `B:real` THEN X_GEN_TAC `k:num` THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= B ==> abs x <= B`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_POS THEN CONJ_TAC THENL + [MATCH_MP_TAC RUNNING_INF_TAIL_INTEGRABLE THEN ASM_REWRITE_TAC[]; + X_GEN_TAC `x:real` THEN DISCH_TAC THEN BETA_TAC THEN + MATCH_MP_TAC REAL_LE_INF THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM; FORALL_IN_GSPEC] THEN + CONJ_TAC THENL + [EXISTS_TAC `(f:num->real->real) k x` THEN EXISTS_TAC `k:num` THEN + REWRITE_TAC[GE; LE_REFL]; + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[]]]; + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `real_integral s ((f:num->real->real) k)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_LE THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC RUNNING_INF_TAIL_INTEGRABLE THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE THEN + ASM_REWRITE_TAC[ETA_AX]; + X_GEN_TAC `x:real` THEN DISCH_TAC THEN BETA_TAC THEN + MATCH_MP_TAC INF_LE_ELEMENT THEN CONJ_TAC THENL + [EXISTS_TAC `&0:real` THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[]; + REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `k:num` THEN + REWRITE_TAC[GE; LE_REFL]]]; + ASM_REWRITE_TAC[]]]]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `g:real->real` (X_CHOOSE_THEN + `kk:real->bool` STRIP_ASSUME_TAC)) THEN + MAP_EVERY EXISTS_TAC [`g:real->real`; `kk:real->bool`] THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(ISPEC `sequentially` REALLIM_UBOUND) THEN + EXISTS_TAC `\m. real_integral s (\x. inf {(f:num->real->real) n x | n >= m})` + THEN + ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; EVENTUALLY_SEQUENTIALLY] THEN + EXISTS_TAC `0` THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `real_integral s ((f:num->real->real) m)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_LE THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC RUNNING_INF_TAIL_INTEGRABLE THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE THEN + ASM_REWRITE_TAC[ETA_AX]; + X_GEN_TAC `x:real` THEN DISCH_TAC THEN BETA_TAC THEN + MATCH_MP_TAC INF_LE_ELEMENT THEN CONJ_TAC THENL + [EXISTS_TAC `&0:real` THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[]; + REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `m:num` THEN + REWRITE_TAC[GE; LE_REFL]]]; + ASM_REWRITE_TAC[]]);; + +(* ========================================================================= *) +(* S4: the iterated dilation-average operator (Fremlin 286S) and the log 2 *) +(* factor int_[1,2] (1/alpha) dalpha = log 2 used in the per-n integral *) +(* bound. *) +(* ========================================================================= *) + +(* int_[1,2] (1/alpha) dalpha = log 2 (FTC with (log)' = inv). *) +let INV_INTEGRAL_1_2_LOG2 = prove + (`real_integral (real_interval[&1,&2]) (\a. inv a) = log(&2)`, + MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + SUBGOAL_THEN `log(&2) = log(&2) - log(&1)` SUBST1_TAC THENL + [REWRITE_TAC[LOG_1] THEN REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS THEN + REWRITE_TAC[REAL_ARITH `&1 <= &2`] THEN + X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN STRIP_TAC THEN + MATCH_MP_TAC HAS_REAL_DERIVATIVE_ATREAL_WITHIN THEN + MATCH_MP_TAC HAS_REAL_DERIVATIVE_LOG THEN ASM_REAL_ARITH_TAC);; + +(* the inner (alpha,beta) double integral of the D_{1/a}AM_bD_a h kernel (no *) +(* 1/n). *) +let carleson_Sinner = new_definition + `carleson_Sinner (h:real->complex) n x = + real_integral (real_interval[&1,&2]) + (\alpha. inv alpha * real_integral (real_interval[&0,&n]) + (\beta. carleson_amd h alpha beta x))`;; + +(* the n-th dilation-average (1/n) int_1^2 (1/a) int_0^n (D_{1/a}AM_bD_a *) +(* h)(x). *) +let carleson_Aavg = new_definition + `carleson_Aavg (h:real->complex) n x = inv(&n) * carleson_Sinner h n x`;; + +(* carleson_Atilde h x = liminf_n Aavg h n x (Fremlin 286S: the iterated *) +(* dilation- *) +(* average operator). Encoded as the reallim of the running infima (matches *) +(* the g of *) +(* REAL_FATOU_LIMINF, which is how ATILDE_INT_F_BOUND = 286S(b) will be *) +(* derived). *) +let carleson_Atilde = new_definition + `carleson_Atilde (h:real->complex) x = + reallim sequentially (\m. inf {carleson_Aavg h n x | n >= m})`;; + +(* multivariate LSC: a real^1-valued function with OPEN superlevels {x | *) +(* drop(f x) > a} *) +(* is measurable_on the whole space. The R^M analogue of *) +(* REAL_MEASURABLE_ON_LSC, used to *) +(* get 286S(a) joint measurability of (alpha,beta,x) |-> amd = sup_z *) +(* (jointly-continuous). *) +let MEASURABLE_ON_LSC_MULTI = prove + (`!(f:real^M->real^1). (!a. open {x | drop(f x) > a}) ==> f measurable_on + (:real^M)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GT] THEN + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `k = 1` SUBST_ALL_TAC THENL + [UNDISCH_TAC `k <= dimindex(:1)` THEN UNDISCH_TAC `1 <= k` THEN + REWRITE_TAC[DIMINDEX_1] THEN ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[GSYM drop] THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_OPEN THEN + ASM_REWRITE_TAC[]);; + +(* joint curve limit: aseq->a0, bseq->b0 ==> aseq*z+bseq -> a0*z+b0. *) +let CX_SEQ_LIM = prove + (`!(g:num->real) l. (g ---> l) sequentially ==> ((\m. Cx(g m)) --> Cx l) + sequentially`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o ONCE_REWRITE_RULE[REALLIM_COMPLEX]) THEN + REWRITE_TAC[o_DEF]);; + +(* modulation-phase continuity: xseq ---> x0 ==> cexp(ii xseq_m w) --> *) +(* cexp(ii x0 w). *) +let CEXP_SEQ_LIM = prove + (`!(xseq:num->real) x0 w. (xseq ---> x0) sequentially + ==> ((\m. cexp(ii * Cx(xseq m) * Cx w)) --> cexp(ii * Cx x0 * Cx w)) + sequentially`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`cexp`; `sequentially`; `\m:num. ii * Cx(xseq m) * Cx w`; + `ii * Cx x0 * Cx w`] LIM_CONTINUOUS_FUNCTION) THEN + REWRITE_TAC[CONTINUOUS_AT_CEXP] THEN DISCH_THEN MATCH_MP_TAC THEN + ONCE_REWRITE_TAC[COMPLEX_RING `ii * a * Cx w = (ii * Cx w) * a`] THEN + MATCH_MP_TAC LIM_COMPLEX_LMUL THEN + MATCH_MP_TAC CX_SEQ_LIM THEN ASM_REWRITE_TAC[]);; + +(* a.e. joint (a,b,x)-convergence of the tile-window Fourier INTEGRAND *) +(* (fixed w). For a.e. *) +(* w -- both (alpha0 z+beta0) [fixed] and (alpha0 w+beta0) non-dyadic + off *) +(* gate -- the *) +(* integrand cexp(ii x w) hhat(w) theta'_{z a b}(w) converges jointly. For *) +(* w=z both sides vanish *) +(* (CARLESON_THETA'_SUPPORT). *) +(* This is the DCT input for the joint continuity of the window (286S(a)). *) +let MEASURABLE_ON_AFFINE_INNER = prove + (`!(ff:real^1->complex) c d. ~(c = &0) /\ ff measurable_on (:real^1) + ==> (\w:real^1. ff(c % w + d)) measurable_on (:real^1)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(\w:real^1. (ff:real^1->complex)(c % w + d)) = + ((\u. ff(u + d)) o (\w:real^1. c % w))` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; o_DEF]; ALL_TAC] THEN + MP_TAC(ISPECL [`\w:real^1. c % w`; `\u:real^1. (ff:real^1->complex)(u+d)`; + `(:real^1)`] + MEASURABLE_ON_LINEAR_IMAGE_EQ) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [REWRITE_TAC[linear] THEN CONJ_TAC THEN VECTOR_ARITH_TAC; + REWRITE_TAC[VECTOR_MUL_LCANCEL] THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN + SUBGOAL_THEN + `IMAGE (\w:real^1. c % w) (:real^1) = (:real^1)` SUBST1_TAC THENL + [MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[IN_UNIV] THEN + X_GEN_TAC `y:real^1` THEN EXISTS_TAC `inv c % y:real^1` THEN + REWRITE_TAC[VECTOR_MUL_ASSOC] THEN + ASM_SIMP_TAC[REAL_MUL_RINV; VECTOR_MUL_LID]; + ALL_TAC] THEN + ONCE_REWRITE_TAC[MEASURABLE_ON_TRANSLATION_EQ] THEN + SUBGOAL_THEN + `(\u:real^1. (ff:real^1->complex)(u + d)) = + (\u. ff(d + u))` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN AP_TERM_TAC THEN + VECTOR_ARITH_TAC; + ALL_TAC] THEN + ONCE_REWRITE_TAC[MEASURABLE_ON_TRANSLATION_EQ] THEN + SUBGOAL_THEN + `IMAGE (\x:real^1. d + x) (:real^1) = (:real^1)` SUBST1_TAC THENL + [MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[IN_UNIV] THEN + X_GEN_TAC `y:real^1` THEN EXISTS_TAC `y - d:real^1` THEN VECTOR_ARITH_TAC; + ASM_REWRITE_TAC[ETA_AX]]);; + +(* hence theta'_{z a b}(.) is measurable in its last argument w (theta *) +(* measurable in Y [CARLESON_THETA_CX_MEASURABLE] composed with the affine w *) +(* |-> a w+b). *) +let CARLESON_THETA'_W_CX_MEASURABLE = prove + (`!z a b. ~(a = &0) + ==> (\w:real^1. Cx(carleson_theta' z a b (drop w))) measurable_on + (:real^1)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[carleson_theta'] THEN + SUBGOAL_THEN + `(\w:real^1. Cx(carleson_theta (a*z+b) (a * drop w + b))) = + (\w:real^1. (\u:real^1. Cx(carleson_theta (a*z+b) (drop u))) (a % w + lift + b))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + REWRITE_TAC[DROP_ADD; DROP_CMUL; LIFT_DROP]; + ALL_TAC] THEN + MATCH_MP_TAC MEASURABLE_ON_AFFINE_INNER THEN + ASM_REWRITE_TAC[CARLESON_THETA_CX_MEASURABLE]);; + +(* the tile-window Fourier integrand hhat * Cx(theta'_{z a b}) is absolutely *) +(* integrable (measurable * bounded, dominated by |hhat|; the DCT L1/L2/L4 *) +(* input for WINDOW_JOINT_CONT). *) +let CARLESON_FHAT_THETA'_ABSINT = prove + (`!(h:real->complex) z a b. schwartz h /\ ~(a = &0) + ==> (\y. fourier h (drop y) * Cx(carleson_theta' z a b (drop y))) + absolutely_integrable_on (:real^1)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`z:real`;`a:real`;`b:real`] CARLESON_THETA'_W_CX_MEASURABLE) + THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE THEN + EXISTS_TAC `\y:real^1. lift(norm(fourier (h:real->complex) (drop y)))` THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_ON_COMPLEX_MUL THEN CONJ_TAC THENL + [MP_TAC(ISPEC `h:real->complex` SCHWARTZ_FHAT_ABSINT) THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[ABSOLUTELY_INTEGRABLE_MEASURABLE] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]]; + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN + MP_TAC(ISPEC `h:real->complex` SCHWARTZ_FHAT_ABSINT) THEN + ASM_REWRITE_TAC[]; + X_GEN_TAC `x:real^1` THEN + REWRITE_TAC[IN_UNIV; LIFT_DROP; COMPLEX_NORM_MUL; COMPLEX_NORM_CX] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[NORM_POS_LE] THEN + MP_TAC(ISPECL [`z:real`; `a:real`; `b:real`; + `drop(x:real^1)`] CARLESON_THETA'_BOUNDS) THEN + REAL_ARITH_TAC]);; + +(* ================================================================= *) +(* S6 keystone foundation: joint 3D measurability of the tile-sup *) +(* theta' kernel. Mirrors CARLESON_THETA_MEASURABLE (1D) but on *) +(* real^3 (a=p$1,b=p$2,w=p$3), using MEASURABLE_ON_SUP_MULTI for the *) +(* countable tile sup. This is what the box-Fubini step MNF_FOURIER_ *) +(* BOX needs to apply FUBINI_INTEGRAL_SWAP over the (a,b)-box x w-line. *) +(* ================================================================= *) + +(* single tile term Re(fhat(A(Y-m)))^2 with Y = a*w+b = p$1*p$3+p$2 is *) +(* CONTINUOUS in (a,b,w), hence measurable on R^3. *) +let CARLESON_THETA_TERM3_MEASURABLE = prove + (`!(A:real) (m:real). + (\p:real^3. lift(Re(fourier carleson_phi (A * ((p$1 * p$3 + p$2) - m))) + pow 2)) measurable_on (:real^3)`, + REPEAT GEN_TAC THEN MATCH_MP_TAC CONTINUOUS_IMP_MEASURABLE_ON THEN + REWRITE_TAC[o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_LIFT_POW THEN + REWRITE_TAC[RE_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_LIFT_COMPONENT_COMPOSE THEN + SUBGOAL_THEN + `(\p:real^3. fourier carleson_phi (A * ((p$1 * p$3 + p$2) - m))) = + (\w:real^1. fourier carleson_phi (drop w)) o (\p:real^3. lift(A * ((p$1 * + p$3 + p$2) - m)))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; o_THM; LIFT_DROP]; ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL + [REWRITE_TAC[LIFT_CMUL] THEN MATCH_MP_TAC CONTINUOUS_ON_CMUL THEN + REWRITE_TAC[LIFT_SUB] THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN + REWRITE_TAC[CONTINUOUS_ON_CONST] THEN + REWRITE_TAC[LIFT_ADD] THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN + CONJ_TAC THENL + [SUBGOAL_THEN + `(\p:real^3. lift(p$1 * p$3)) = (\p:real^3. (p$1) % lift(p$3))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; LIFT_CMUL]; ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_MUL THEN CONJ_TAC THENL + [REWRITE_TAC[o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_LIFT_COMPONENT_COMPOSE THEN + REWRITE_TAC[CONTINUOUS_ON_ID]; + MATCH_MP_TAC CONTINUOUS_ON_LIFT_COMPONENT_COMPOSE THEN + REWRITE_TAC[CONTINUOUS_ON_ID]]; + MATCH_MP_TAC CONTINUOUS_ON_LIFT_COMPONENT_COMPOSE THEN + REWRITE_TAC[CONTINUOUS_ON_ID]]; + MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `(:real^1)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC FOURIER_CONTINUOUS_ON THEN + MATCH_MP_TAC SCHWARTZ_ABSINT THEN REWRITE_TAC[CARLESON_PHI_SCHWARTZ]; + REWRITE_TAC[SUBSET_UNIV]]]);; + +(* preimage of a dyadic half-open interval under a measurable map g:R^3->R *) +(* is lebesgue_measurable (= closed-halfline preimage INTER open-halfline *) +(* preimage, LEBESGUE_MEASURABLE_PREIMAGE_CLOSED/OPEN). *) +let DYHO_PREIMAGE_MEASURABLE = prove + (`!(g:real^3->real) k n. (\p. lift(g p)) measurable_on (:real^3) + ==> lebesgue_measurable {p:real^3 | g p IN dyho k n}`, + REPEAT STRIP_TAC THEN REWRITE_TAC[dyho] THEN + SUBGOAL_THEN + `{p:real^3 | (g:real^3->real) p IN {x | real_of_int n * &2 zpow k <= x /\ x + < (real_of_int n + &1) * &2 zpow k}} = + {p | g p IN {x | real_of_int n * &2 zpow k <= x}} INTER + {p | g p IN {x | x < (real_of_int n + &1) * &2 zpow k}}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM] THEN + MESON_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC LEBESGUE_MEASURABLE_INTER THEN CONJ_TAC THENL + [MP_TAC(ISPECL [`\p:real^3. lift((g:real^3->real) p)`; + `{x:real^1 | real_of_int n * &2 zpow k <= drop x}`] + LEBESGUE_MEASURABLE_PREIMAGE_CLOSED) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `{x:real^1 | real_of_int n * &2 zpow k <= drop x} = {x | x$1 >= + real_of_int n * &2 zpow k}` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; real_ge; drop]; ALL_TAC] THEN + REWRITE_TAC[CLOSED_HALFSPACE_COMPONENT_GE]; + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; LIFT_DROP]]; + MP_TAC(ISPECL [`\p:real^3. lift((g:real^3->real) p)`; + `{x:real^1 | drop x < (real_of_int n + &1) * &2 zpow k}`] + LEBESGUE_MEASURABLE_PREIMAGE_OPEN) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `{x:real^1 | drop x < (real_of_int n + &1) * &2 zpow k} = {x | x$1 < + (real_of_int n + &1) * &2 zpow k}` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; drop]; ALL_TAC] THEN + REWRITE_TAC[OPEN_HALFSPACE_COMPONENT_LT]; + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; LIFT_DROP]]]);; + +(* the two tile-condition coordinate maps on R^3 (a=p$1,b=p$2,w=p$3) are *) +(* measurable: Y = a*w+b = p$1*p$3+p$2 (bilinear), Z = a*z+b = p$1*z+p$2 *) +(* (affine, z a fixed real). *) +let YMAP3_MEASURABLE = prove + (`(\p:real^3. lift(p$1 * p$3 + p$2)) measurable_on (:real^3)`, + MATCH_MP_TAC CONTINUOUS_IMP_MEASURABLE_ON THEN + REWRITE_TAC[LIFT_ADD] THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN CONJ_TAC THENL + [SUBGOAL_THEN + `(\p:real^3. lift(p$1 * p$3)) = (\p:real^3. (p$1) % lift(p$3))` SUBST1_TAC + THENL + [REWRITE_TAC[FUN_EQ_THM; LIFT_CMUL]; ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_MUL THEN CONJ_TAC THENL + [REWRITE_TAC[o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_LIFT_COMPONENT_COMPOSE THEN + REWRITE_TAC[CONTINUOUS_ON_ID]; + MATCH_MP_TAC CONTINUOUS_ON_LIFT_COMPONENT_COMPOSE THEN + REWRITE_TAC[CONTINUOUS_ON_ID]]; + MATCH_MP_TAC CONTINUOUS_ON_LIFT_COMPONENT_COMPOSE THEN + REWRITE_TAC[CONTINUOUS_ON_ID]]);; + +let ZMAP3_MEASURABLE = prove + (`!z:real. (\p:real^3. lift(p$1 * z + p$2)) measurable_on (:real^3)`, + GEN_TAC THEN MATCH_MP_TAC CONTINUOUS_IMP_MEASURABLE_ON THEN + REWRITE_TAC[LIFT_ADD] THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN CONJ_TAC THENL + [SUBGOAL_THEN + `(\p:real^3. lift(p$1 * z)) = (\p:real^3. z % lift(p$1))` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + REWRITE_TAC[GSYM LIFT_CMUL] THEN + AP_TERM_TAC THEN REWRITE_TAC[REAL_MUL_SYM]; + MATCH_MP_TAC CONTINUOUS_ON_CMUL THEN + MATCH_MP_TAC CONTINUOUS_ON_LIFT_COMPONENT_COMPOSE THEN + REWRITE_TAC[CONTINUOUS_ON_ID]]; + MATCH_MP_TAC CONTINUOUS_ON_LIFT_COMPONENT_COMPOSE THEN + REWRITE_TAC[CONTINUOUS_ON_ID]]);; + +(* each enumerated tile-family member (a=p$1,b=p$2,w=p$3) is measurable on *) +(* R^3: the n=0 sentinel is 0; n>0 is the continuous term restricted to the *) +(* tile region {Z in Jr} INTER {Y in Jl} (both lebesgue_measurable *) +(* preimages). *) +let CARLESON_THETA_FAMILY3_MEASURABLE = prove + (`!(e:num->int#int#int) (z:real) (n:num). + (\p:real^3. lift(if n = 0 then &0 + else if (p$1 * z + p$2) IN tile_Jr(e(n-1)) /\ (p$1 * p$3 + p$2) IN + tile_Jl(e(n-1)) + then Re(fourier carleson_phi (&2 zpow(--tile_k(e(n-1))) * ((p$1 + * p$3 + p$2) - tile_ymid(e(n-1))))) pow 2 + else &0)) measurable_on (:real^3)`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `n = 0` THEN + ASM_REWRITE_TAC[LIFT_NUM; MEASURABLE_ON_0] THEN + ABBREV_TAC `s = (e:num->int#int#int)(n-1)` THEN + SUBGOAL_THEN + `(\p:real^3. lift(if (p$1 * z + p$2) IN tile_Jr s /\ (p$1 * p$3 + p$2) IN + tile_Jl s + then Re(fourier carleson_phi (&2 zpow(--tile_k s) * ((p$1 * p$3 + + p$2) - tile_ymid s))) pow 2 + else &0)) = + (\p:real^3. if p IN ({p | (p$1 * z + p$2) IN tile_Jr s} INTER {p | (p$1 * + p$3 + p$2) IN tile_Jl s}) + then lift(Re(fourier carleson_phi (&2 zpow(--tile_k s) * ((p$1 + * p$3 + p$2) - tile_ymid s))) pow 2) + else vec 0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN + COND_CASES_TAC THEN REWRITE_TAC[LIFT_NUM]; + ALL_TAC] THEN + MATCH_MP_TAC MEASURABLE_ON_RESTRICT THEN CONJ_TAC THENL + [REWRITE_TAC[CARLESON_THETA_TERM3_MEASURABLE]; + MP_TAC(ISPEC `s:int#int#int` PAIR_SURJECTIVE) THEN + DISCH_THEN(X_CHOOSE_THEN `k0:int` (X_CHOOSE_THEN + `rest:int#int` ASSUME_TAC)) THEN + MP_TAC(ISPEC `rest:int#int` PAIR_SURJECTIVE) THEN + DISCH_THEN(X_CHOOSE_THEN `nI0:int` (X_CHOOSE_THEN + `nJ0:int` ASSUME_TAC)) THEN + SUBGOAL_THEN `s = (k0:int,nI0:int,nJ0:int)` SUBST_ALL_TAC THENL + [ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[tile_Jr; tile_Jl] THEN + MATCH_MP_TAC LEBESGUE_MEASURABLE_INTER THEN CONJ_TAC THENL + [MATCH_MP_TAC DYHO_PREIMAGE_MEASURABLE THEN REWRITE_TAC[ZMAP3_MEASURABLE]; + MATCH_MP_TAC DYHO_PREIMAGE_MEASURABLE THEN + REWRITE_TAC[YMAP3_MEASURABLE]]]);; + +(* CAPSTONE: the tile-sup kernel theta'_z(a,b,w) (a=p$1,b=p$2,w=p$3) is *) +(* JOINTLY measurable on R^3. theta'_z a b w = theta(a*z+b, a*w+b) is the *) +(* countable tile-sup (CARLESON_THETA_SUP_RECONCILE) of the family members *) +(* (CARLESON_THETA_FAMILY3_MEASURABLE), each in [0,1] (CARLESON_THETA_TERM_ *) +(* BOUNDS), so MEASURABLE_ON_SUP_MULTI applies. This is the joint *) +(* measurability the S6 box-Fubini keystone MNF_FOURIER_BOX needs. *) +let CARLESON_THETA'_3D_MEASURABLE = prove + (`!z:real. (\p:real^3. lift(carleson_theta' z (p$1) (p$2) (p$3))) + measurable_on (:real^3)`, + GEN_TAC THEN REWRITE_TAC[carleson_theta'] THEN + SUBGOAL_THEN + `?e:num->(int#int#int). (:int#int#int) = + IMAGE e (:num)` STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC COUNTABLE_AS_IMAGE THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM CROSS_UNIV] THEN MATCH_MP_TAC COUNTABLE_CROSS THEN + REWRITE_TAC[INT_COUNTABLE; GSYM CROSS_UNIV] THEN + MATCH_MP_TAC COUNTABLE_CROSS THEN + REWRITE_TAC[INT_COUNTABLE]; + REWRITE_TAC[UNIV_NOT_EMPTY]]; ALL_TAC] THEN + SUBGOAL_THEN + `(\p:real^3. lift(carleson_theta (p$1 * z + p$2) (p$1 * p$3 + p$2))) = + (\p:real^3. lift(sup {(if nn = 0 then &0 + else if (p$1 * z + p$2) IN tile_Jr (e(nn-1)) /\ (p$1 * p$3 + + p$2) IN tile_Jl (e(nn-1)) + then Re(fourier carleson_phi (&2 zpow(--tile_k(e(nn-1))) * + ((p$1 * p$3 + p$2) - tile_ymid(e(nn-1))))) pow 2 + else &0) | nn IN (:num)}))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN AP_TERM_TAC THEN + MATCH_MP_TAC CARLESON_THETA_SUP_RECONCILE THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MP_TAC(ISPEC + `\nn p:real^3. (if nn = 0 then &0 + else if (p$1 * z + p$2) IN tile_Jr (e(nn-1)) /\ (p$1 * p$3 + + p$2) IN tile_Jl (e(nn-1)) + then Re(fourier carleson_phi (&2 zpow(--tile_k(e(nn-1))) * + ((p$1 * p$3 + p$2) - tile_ymid(e(nn-1))))) pow 2 + else &0)` MEASURABLE_ON_SUP_MULTI) THEN + REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL + [GEN_TAC THEN REWRITE_TAC[CARLESON_THETA_FAMILY3_MEASURABLE]; + GEN_TAC THEN EXISTS_TAC `&1` THEN GEN_TAC THEN + COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_01] THEN + COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_01] THEN + REWRITE_TAC[CARLESON_THETA_TERM_BOUNDS]]);; + +(* ------------------------------------------------------------------------- *) +(* 2D (a,b)-measurability of the tile-sup theta' kernel at fixed w (inner *) +(* affine Y=a*w+b). Mirrors the 3D tower; feeds the 2D-box abs-int for the *) +(* w-outer side of MNF_FOURIER_BOX. *) +(* ------------------------------------------------------------------------- *) +let CARLESON_THETA_TERM2_MEASURABLE = prove + (`!(A:real) (m:real) (w:real). + (\p:real^2. lift(Re(fourier carleson_phi (A * ((p$1 * w + p$2) - m))) pow + 2)) measurable_on (:real^2)`, + REPEAT GEN_TAC THEN MATCH_MP_TAC CONTINUOUS_IMP_MEASURABLE_ON THEN + REWRITE_TAC[o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_LIFT_POW THEN + REWRITE_TAC[RE_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_LIFT_COMPONENT_COMPOSE THEN + SUBGOAL_THEN + `(\p:real^2. fourier carleson_phi (A * ((p$1 * w + p$2) - m))) = + (\u:real^1. fourier carleson_phi (drop u)) o (\p:real^2. lift(A * ((p$1 * w + + p$2) - m)))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; o_THM; LIFT_DROP]; ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL + [REWRITE_TAC[LIFT_CMUL] THEN MATCH_MP_TAC CONTINUOUS_ON_CMUL THEN + REWRITE_TAC[LIFT_SUB] THEN MATCH_MP_TAC CONTINUOUS_ON_SUB THEN + REWRITE_TAC[CONTINUOUS_ON_CONST] THEN + REWRITE_TAC[LIFT_ADD] THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN + CONJ_TAC THENL + [SUBGOAL_THEN + `(\p:real^2. lift(p$1 * w)) = + (\p:real^2. w % lift(p$1))` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + REWRITE_TAC[GSYM LIFT_CMUL] THEN + AP_TERM_TAC THEN REWRITE_TAC[REAL_MUL_SYM]; ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_CMUL THEN + MATCH_MP_TAC CONTINUOUS_ON_LIFT_COMPONENT_COMPOSE THEN + REWRITE_TAC[CONTINUOUS_ON_ID]; + MATCH_MP_TAC CONTINUOUS_ON_LIFT_COMPONENT_COMPOSE THEN + REWRITE_TAC[CONTINUOUS_ON_ID]]; + MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `(:real^1)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC FOURIER_CONTINUOUS_ON THEN + MATCH_MP_TAC SCHWARTZ_ABSINT THEN REWRITE_TAC[CARLESON_PHI_SCHWARTZ]; + REWRITE_TAC[SUBSET_UNIV]]]);; + +(* preimage of dyho under a measurable g:R^2->R is lebesgue_measurable. *) +let DYHO_PREIMAGE2_MEASURABLE = prove + (`!(g:real^2->real) k n. (\p. lift(g p)) measurable_on (:real^2) + ==> lebesgue_measurable {p:real^2 | g p IN dyho k n}`, + REPEAT STRIP_TAC THEN REWRITE_TAC[dyho] THEN + SUBGOAL_THEN + `{p:real^2 | (g:real^2->real) p IN {x | real_of_int n * &2 zpow k <= x /\ x + < (real_of_int n + &1) * &2 zpow k}} = + {p | g p IN {x | real_of_int n * &2 zpow k <= x}} INTER + {p | g p IN {x | x < (real_of_int n + &1) * &2 zpow k}}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM] THEN + MESON_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC LEBESGUE_MEASURABLE_INTER THEN CONJ_TAC THENL + [MP_TAC(ISPECL [`\p:real^2. lift((g:real^2->real) p)`; + `{x:real^1 | real_of_int n * &2 zpow k <= drop x}`] + LEBESGUE_MEASURABLE_PREIMAGE_CLOSED) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `{x:real^1 | real_of_int n * &2 zpow k <= drop x} = {x | x$1 >= + real_of_int n * &2 zpow k}` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; real_ge; drop]; ALL_TAC] THEN + REWRITE_TAC[CLOSED_HALFSPACE_COMPONENT_GE]; + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; LIFT_DROP]]; + MP_TAC(ISPECL [`\p:real^2. lift((g:real^2->real) p)`; + `{x:real^1 | drop x < (real_of_int n + &1) * &2 zpow k}`] + LEBESGUE_MEASURABLE_PREIMAGE_OPEN) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `{x:real^1 | drop x < (real_of_int n + &1) * &2 zpow k} = {x | x$1 < + (real_of_int n + &1) * &2 zpow k}` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; drop]; ALL_TAC] THEN + REWRITE_TAC[OPEN_HALFSPACE_COMPONENT_LT]; + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; LIFT_DROP]]]);; + +(* 2D coordinate maps: Y = a*w+b = p$1*w+p$2 (w fixed), Z = a*z+b = *) +(* p$1*z+p$2. *) +let YMAP2_MEASURABLE = prove + (`!w:real. (\p:real^2. lift(p$1 * w + p$2)) measurable_on (:real^2)`, + GEN_TAC THEN MATCH_MP_TAC CONTINUOUS_IMP_MEASURABLE_ON THEN + REWRITE_TAC[LIFT_ADD] THEN MATCH_MP_TAC CONTINUOUS_ON_ADD THEN CONJ_TAC THENL + [SUBGOAL_THEN + `(\p:real^2. lift(p$1 * w)) = (\p:real^2. w % lift(p$1))` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + REWRITE_TAC[GSYM LIFT_CMUL] THEN + AP_TERM_TAC THEN REWRITE_TAC[REAL_MUL_SYM]; + MATCH_MP_TAC CONTINUOUS_ON_CMUL THEN + MATCH_MP_TAC CONTINUOUS_ON_LIFT_COMPONENT_COMPOSE THEN + REWRITE_TAC[CONTINUOUS_ON_ID]]; + MATCH_MP_TAC CONTINUOUS_ON_LIFT_COMPONENT_COMPOSE THEN + REWRITE_TAC[CONTINUOUS_ON_ID]]);; + +let ZMAP2_MEASURABLE = prove + (`!z:real. (\p:real^2. lift(p$1 * z + p$2)) measurable_on (:real^2)`, + REWRITE_TAC[YMAP2_MEASURABLE]);; + +(* each 2D tile-family member is measurable (n=0 sentinel 0; n>0 term *) +(* restricted to the tile region {Z in Jr} INTER {Y in Jl}). *) +let CARLESON_THETA_FAMILY2_MEASURABLE = prove + (`!(e:num->int#int#int) (z:real) (w:real) (n:num). + (\p:real^2. lift(if n = 0 then &0 + else if (p$1 * z + p$2) IN tile_Jr(e(n-1)) /\ (p$1 * w + p$2) IN + tile_Jl(e(n-1)) + then Re(fourier carleson_phi (&2 zpow(--tile_k(e(n-1))) * ((p$1 + * w + p$2) - tile_ymid(e(n-1))))) pow 2 + else &0)) measurable_on (:real^2)`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `n = 0` THEN + ASM_REWRITE_TAC[LIFT_NUM; MEASURABLE_ON_0] THEN + ABBREV_TAC `s = (e:num->int#int#int)(n-1)` THEN + SUBGOAL_THEN + `(\p:real^2. lift(if (p$1 * z + p$2) IN tile_Jr s /\ (p$1 * w + p$2) IN + tile_Jl s + then Re(fourier carleson_phi (&2 zpow(--tile_k s) * ((p$1 * w + + p$2) - tile_ymid s))) pow 2 + else &0)) = + (\p:real^2. if p IN ({p | (p$1 * z + p$2) IN tile_Jr s} INTER {p | (p$1 * w + + p$2) IN tile_Jl s}) + then lift(Re(fourier carleson_phi (&2 zpow(--tile_k s) * ((p$1 + * w + p$2) - tile_ymid s))) pow 2) + else vec 0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN + COND_CASES_TAC THEN REWRITE_TAC[LIFT_NUM]; + ALL_TAC] THEN + MATCH_MP_TAC MEASURABLE_ON_RESTRICT THEN CONJ_TAC THENL + [REWRITE_TAC[CARLESON_THETA_TERM2_MEASURABLE]; + MP_TAC(ISPEC `s:int#int#int` PAIR_SURJECTIVE) THEN + DISCH_THEN(X_CHOOSE_THEN `k0:int` (X_CHOOSE_THEN + `rest:int#int` ASSUME_TAC)) THEN + MP_TAC(ISPEC `rest:int#int` PAIR_SURJECTIVE) THEN + DISCH_THEN(X_CHOOSE_THEN `nI0:int` (X_CHOOSE_THEN + `nJ0:int` ASSUME_TAC)) THEN + SUBGOAL_THEN `s = (k0:int,nI0:int,nJ0:int)` SUBST_ALL_TAC THENL + [ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[tile_Jr; tile_Jl] THEN + MATCH_MP_TAC LEBESGUE_MEASURABLE_INTER THEN CONJ_TAC THENL + [MATCH_MP_TAC DYHO_PREIMAGE2_MEASURABLE THEN + REWRITE_TAC[ZMAP2_MEASURABLE]; + MATCH_MP_TAC DYHO_PREIMAGE2_MEASURABLE THEN + REWRITE_TAC[YMAP2_MEASURABLE]]]);; + +(* CAPSTONE: theta'_z(a,b,w0) is measurable in (a,b) on R^2 (w0 fixed). *) +let CARLESON_THETA'_2D_MEASURABLE = prove + (`!z0:real w:real. (\p:real^2. lift(carleson_theta' z0 (p$1) (p$2) w)) + measurable_on (:real^2)`, + REPEAT GEN_TAC THEN REWRITE_TAC[carleson_theta'] THEN + SUBGOAL_THEN + `?e:num->(int#int#int). (:int#int#int) = + IMAGE e (:num)` STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC COUNTABLE_AS_IMAGE THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM CROSS_UNIV] THEN MATCH_MP_TAC COUNTABLE_CROSS THEN + REWRITE_TAC[INT_COUNTABLE; GSYM CROSS_UNIV] THEN + MATCH_MP_TAC COUNTABLE_CROSS THEN + REWRITE_TAC[INT_COUNTABLE]; + REWRITE_TAC[UNIV_NOT_EMPTY]]; ALL_TAC] THEN + SUBGOAL_THEN + `(\p:real^2. lift(carleson_theta (p$1 * z0 + p$2) (p$1 * w + p$2))) = + (\p:real^2. lift(sup {(if nn = 0 then &0 + else if (p$1 * z0 + p$2) IN tile_Jr (e(nn-1)) /\ (p$1 * w + + p$2) IN tile_Jl (e(nn-1)) + then Re(fourier carleson_phi (&2 zpow(--tile_k(e(nn-1))) * + ((p$1 * w + p$2) - tile_ymid(e(nn-1))))) pow 2 + else &0) | nn IN (:num)}))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN AP_TERM_TAC THEN + MATCH_MP_TAC CARLESON_THETA_SUP_RECONCILE THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MP_TAC(ISPEC + `\nn p:real^2. (if nn = 0 then &0 + else if (p$1 * z0 + p$2) IN tile_Jr (e(nn-1)) /\ (p$1 * w + + p$2) IN tile_Jl (e(nn-1)) + then Re(fourier carleson_phi (&2 zpow(--tile_k(e(nn-1))) * + ((p$1 * w + p$2) - tile_ymid(e(nn-1))))) pow 2 + else &0)` MEASURABLE_ON_SUP_MULTI) THEN + REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL + [GEN_TAC THEN REWRITE_TAC[CARLESON_THETA_FAMILY2_MEASURABLE]; + GEN_TAC THEN EXISTS_TAC `&1` THEN GEN_TAC THEN + COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_01] THEN + COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_01] THEN + REWRITE_TAC[CARLESON_THETA_TERM_BOUNDS]]);; + +(* 2D Cx(inv a) measurable (a=p$1; a=0 hyperplane negligible). *) +let CX_INVA2_MEASURABLE = prove + (`(\p:real^2. Cx(inv(p$1))) measurable_on (:real^2)`, + SUBGOAL_THEN + `(\p:real^2. Cx(inv(p$1))) = (\v:real^1. Cx(drop v)) o (\p:real^2. + lift(inv(p$1)))` + SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM; o_THM; LIFT_DROP]; ALL_TAC] THEN + MATCH_MP_TAC MEASURABLE_ON_COMPOSE_CONTINUOUS THEN + REWRITE_TAC[CONTINUOUS_ON_CX_LIFT; LIFT_DROP; CONTINUOUS_ON_ID] THEN + MATCH_MP_TAC MEASURABLE_ON_LIFT_INV THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_IMP_MEASURABLE_ON THEN + MATCH_MP_TAC CONTINUOUS_ON_LIFT_COMPONENT_COMPOSE THEN + REWRITE_TAC[CONTINUOUS_ON_ID]; + REWRITE_TAC[IN_UNIV; NEGLIGIBLE_STANDARD_HYPERPLANE]]);; + +(* Cx(theta'_zab w) measurable in (a,b) [compose lift-2D capstone with Cx o *) +(* drop]. *) +let CX_THETA2_MEASURABLE = prove + (`!z0:real w:real. (\p:real^2. Cx(carleson_theta' z0 (p$1) (p$2) w)) + measurable_on (:real^2)`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN + `(\p:real^2. Cx(carleson_theta' z0 (p$1) (p$2) w)) = + (\v:real^1. Cx(drop v)) o (\p:real^2. lift(carleson_theta' z0 (p$1) (p$2) + w))` + SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM; o_THM; LIFT_DROP]; ALL_TAC] THEN + MATCH_MP_TAC MEASURABLE_ON_COMPOSE_CONTINUOUS THEN + REWRITE_TAC[CARLESON_THETA'_2D_MEASURABLE; CONTINUOUS_ON_CX_LIFT; LIFT_DROP; + CONTINUOUS_ON_ID]);; + +(* box2d region on R^2 is lebesgue_measurable (= *) +(* interval[vector[1;0],vector[2;n]]). *) +let TBOX_SHUFFLE_LINEAR = prove + (`linear (\z:real^((1,1)finite_sum,1)finite_sum. + vector[drop(fstcart(fstcart z)); drop(sndcart(fstcart z)); + drop(sndcart z)]:real^3) /\ + (!u v:real^((1,1)finite_sum,1)finite_sum. + (\z. vector[drop(fstcart(fstcart z)); drop(sndcart(fstcart z)); + drop(sndcart z)]:real^3) u = + (\z. vector[drop(fstcart(fstcart z)); drop(sndcart(fstcart z)); + drop(sndcart z)]:real^3) v ==> u = v)`, + CONJ_TAC THENL + [REWRITE_TAC[linear] THEN CONJ_TAC THEN REPEAT GEN_TAC THEN + REWRITE_TAC[CART_EQ; DIMINDEX_3; FORALL_3; VECTOR_3] THEN + SIMP_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; VECTOR_3; DIMINDEX_3; + ARITH] THEN + REWRITE_TAC[FSTCART_ADD; SNDCART_ADD; FSTCART_CMUL; SNDCART_CMUL; + DROP_ADD; DROP_CMUL] THEN REWRITE_TAC[VECTOR_3] THEN + REAL_ARITH_TAC; + REPEAT GEN_TAC THEN REWRITE_TAC[] THEN DISCH_TAC THEN + SUBGOAL_THEN + `drop(fstcart(fstcart(u:real^((1,1)finite_sum,1)finite_sum))) = + drop(fstcart(fstcart v)) /\ + drop(sndcart(fstcart u)) = drop(sndcart(fstcart v)) /\ + drop(sndcart u) = drop(sndcart v)` + STRIP_ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC) THEN + REWRITE_TAC[CART_EQ; DIMINDEX_3; FORALL_3; VECTOR_3] THEN + SIMP_TAC[]; ALL_TAC] THEN + ONCE_REWRITE_TAC[PASTECART_EQ] THEN CONJ_TAC THENL + [ONCE_REWRITE_TAC[PASTECART_EQ] THEN CONJ_TAC THEN + ONCE_REWRITE_TAC[GSYM DROP_EQ] THEN ASM_REWRITE_TAC[]; + ONCE_REWRITE_TAC[GSYM DROP_EQ] THEN ASM_REWRITE_TAC[]]]);; + +let TBOX_SHUFFLE_IMAGE = prove + (`IMAGE (\z:real^((1,1)finite_sum,1)finite_sum. + vector[drop(fstcart(fstcart z)); drop(sndcart(fstcart z)); + drop(sndcart z)]:real^3) (:real^((1,1)finite_sum,1)finite_sum) = + (:real^3)`, + MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[IN_UNIV] THEN + X_GEN_TAC `p:real^3` THEN + EXISTS_TAC `pastecart (pastecart (lift((p:real^3)$1)) (lift(p$2))) + (lift(p$3)):real^((1,1)finite_sum,1)finite_sum` THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; LIFT_DROP] THEN + REWRITE_TAC[CART_EQ; DIMINDEX_3; FORALL_3; VECTOR_3] THEN + CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[]);; + +let TBOX_SHUFFLE = prove + (`!hh:real^3->real^1. + (hh o (\z:real^((1,1)finite_sum,1)finite_sum. + vector[drop(fstcart(fstcart z)); drop(sndcart(fstcart z)); + drop(sndcart z)]:real^3)) + measurable_on (:real^((1,1)finite_sum,1)finite_sum) + <=> hh measurable_on (:real^3)`, + GEN_TAC THEN + MP_TAC(ISPECL + [`\z:real^((1,1)finite_sum,1)finite_sum. + vector[drop(fstcart(fstcart z)); drop(sndcart(fstcart z)); + drop(sndcart z)]:real^3`; + `hh:real^3->real^1`; + `(:real^((1,1)finite_sum,1)finite_sum)`] + MEASURABLE_ON_LINEAR_IMAGE_EQ_GEN) THEN + REWRITE_TAC[TBOX_SHUFFLE_LINEAR; DIMINDEX_FINITE_SUM; DIMINDEX_1; DIMINDEX_3; + ARITH] THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[TBOX_SHUFFLE_IMAGE]);; + +(* theta' kernel measurable on the iterated box type (via the capstone + *) +(* the shuffle transfer). a=fstcart(fstcart z), b=sndcart(fstcart z), *) +(* w=sndcart z. *) +let CARLESON_THETA'_TBOX_MEASURABLE = prove + (`!z0:real. (\z:real^((1,1)finite_sum,1)finite_sum. + lift(carleson_theta' z0 (drop(fstcart(fstcart z))) (drop(sndcart(fstcart + z))) (drop(sndcart z)))) + measurable_on (:real^((1,1)finite_sum,1)finite_sum)`, + GEN_TAC THEN + MP_TAC(ISPEC `\p:real^3. lift(carleson_theta' z0 (p$1) (p$2) (p$3))` + TBOX_SHUFFLE) THEN + REWRITE_TAC[CARLESON_THETA'_3D_MEASURABLE] THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM; o_THM] THEN GEN_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[VECTOR_3]);; + +(* Cx(theta') measurable on the iterated box type (compose lift-theta' *) +(* kernel with the continuous Cx o drop). *) +let CARLESON_THETA'_TBOX_CX = prove + (`!z0:real. (\z:real^((1,1)finite_sum,1)finite_sum. + Cx(carleson_theta' z0 (drop(fstcart(fstcart z))) (drop(sndcart(fstcart + z))) (drop(sndcart z)))) + measurable_on (:real^((1,1)finite_sum,1)finite_sum)`, + GEN_TAC THEN + SUBGOAL_THEN + `(\z:real^((1,1)finite_sum,1)finite_sum. + Cx(carleson_theta' z0 (drop(fstcart(fstcart z))) (drop(sndcart(fstcart + z))) (drop(sndcart z)))) = + (\v:real^1. Cx(drop v)) o (\z:real^((1,1)finite_sum,1)finite_sum. + lift(carleson_theta' z0 (drop(fstcart(fstcart z))) (drop(sndcart(fstcart + z))) (drop(sndcart z))))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; o_THM; LIFT_DROP]; ALL_TAC] THEN + MATCH_MP_TAC MEASURABLE_ON_COMPOSE_CONTINUOUS THEN + REWRITE_TAC[CARLESON_THETA'_TBOX_MEASURABLE] THEN + REWRITE_TAC[CONTINUOUS_ON_CX_LIFT; LIFT_DROP; CONTINUOUS_ON_ID]);; + +(* w-projection Cx(drop(sndcart z)) continuous on the iterated box type. *) +let WPROJ_CX_CONT = prove + (`(\z:real^((1,1)finite_sum,1)finite_sum. Cx(drop(sndcart z))) continuous_on + (:real^((1,1)finite_sum,1)finite_sum)`, + REWRITE_TAC[CONTINUOUS_ON_CX_LIFT; LIFT_DROP] THEN + MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN REWRITE_TAC[ETA_AX; LINEAR_SNDCART]);; + +(* the modulated transform factor cexp(-i(-x)w)*fhat(w), w=drop(sndcart z), *) +(* measurable on the iterated box type (continuous: cexp o linear, fhat o *) +(* proj). *) +let CEXPFHAT_W_MEASURABLE = prove + (`!(h:real->complex) x. schwartz h + ==> (\z:real^((1,1)finite_sum,1)finite_sum. + cexp(--(ii * Cx(--x) * Cx(drop(sndcart z)))) * fourier h + (drop(sndcart z))) + measurable_on (:real^((1,1)finite_sum,1)finite_sum)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC CONTINUOUS_IMP_MEASURABLE_ON THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN CONJ_TAC THENL + [SUBGOAL_THEN + `(\z:real^((1,1)finite_sum,1)finite_sum. cexp(--(ii * Cx(--x) * + Cx(drop(sndcart z))))) = + cexp o (\z:real^((1,1)finite_sum,1)finite_sum. --(ii * Cx(--x) * + Cx(drop(sndcart z))))` + SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM; o_THM]; ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + REWRITE_TAC[CONTINUOUS_ON_CEXP] THEN + MATCH_MP_TAC CONTINUOUS_ON_NEG THEN + ONCE_REWRITE_TAC[COMPLEX_RING `ii * Cx(--x) * w = (ii * Cx(--x)) * w`] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_LMUL THEN REWRITE_TAC[WPROJ_CX_CONT]; + SUBGOAL_THEN + `(\z:real^((1,1)finite_sum,1)finite_sum. fourier h (drop(sndcart z))) = + (\v:real^1. fourier h (drop v)) o (\z:real^((1,1)finite_sum,1)finite_sum. + sndcart z)` + SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM; o_THM]; ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL + [REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN + REWRITE_TAC[LINEAR_SNDCART]; + MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `(:real^1)` THEN + REWRITE_TAC[SUBSET_UNIV] THEN + MATCH_MP_TAC FOURIER_CONTINUOUS_ON THEN MATCH_MP_TAC SCHWARTZ_ABSINT THEN + ASM_REWRITE_TAC[]]]);; + +(* the (a,b)-box region {1<=a<=2, 0<=b<=n} on the iterated box type is *) +(* lebesgue_measurable (= (box2d) PCROSS (:real^1) for the w-factor). *) +let TBOX_REGION_LMEAS = prove + (`!n. lebesgue_measurable + {z:real^((1,1)finite_sum,1)finite_sum | + &1 <= drop(fstcart(fstcart z)) /\ drop(fstcart(fstcart z)) <= &2 /\ + &0 <= drop(sndcart(fstcart z)) /\ drop(sndcart(fstcart z)) <= &n}`, + GEN_TAC THEN + SUBGOAL_THEN + `{z:real^((1,1)finite_sum,1)finite_sum | + &1 <= drop(fstcart(fstcart z)) /\ drop(fstcart(fstcart z)) <= &2 /\ + &0 <= drop(sndcart(fstcart z)) /\ drop(sndcart(fstcart z)) <= &n} = + ((interval[lift(&1),lift(&2)]) PCROSS (interval[lift(&0),lift(&n)])) PCROSS + (:real^1)` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; FORALL_PASTECART; PASTECART_IN_PCROSS; IN_ELIM_THM; + FSTCART_PASTECART; SNDCART_PASTECART; IN_INTERVAL_1; IN_UNIV; + LIFT_DROP] THEN + REWRITE_TAC[CONJ_ACI]; + ALL_TAC] THEN + REWRITE_TAC[LEBESGUE_MEASURABLE_PCROSS; LEBESGUE_MEASURABLE_UNIV; + LEBESGUE_MEASURABLE_INTERVAL]);; + +(* a = drop(fstcart(fstcart z)) is the z$1 coordinate (for the a=0 *) +(* hyperplane). *) +let TBOX_A_EQ_C1 = prove + (`!z:real^((1,1)finite_sum,1)finite_sum. drop(fstcart(fstcart z)) = z$1`, + GEN_TAC THEN REWRITE_TAC[drop] THEN + SUBGOAL_THEN + `fstcart(fstcart(z:real^((1,1)finite_sum,1)finite_sum))$1 = fstcart z$1` + SUBST1_TAC THENL + [MATCH_MP_TAC FSTCART_COMPONENT THEN + REWRITE_TAC[DIMINDEX_1; LE_REFL]; ALL_TAC] THEN + MATCH_MP_TAC FSTCART_COMPONENT THEN + REWRITE_TAC[DIMINDEX_FINITE_SUM; DIMINDEX_1; ARITH]);; + +(* Cx(inv a), a=drop(fstcart(fstcart z)), measurable on the iterated box *) +(* type (a=0 hyperplane negligible via TBOX_A_EQ_C1 + *) +(* NEGLIGIBLE_STANDARD_HYPERPLANE). *) +let TBOX_INVA_CX_MEASURABLE = prove + (`(\z:real^((1,1)finite_sum,1)finite_sum. Cx(inv(drop(fstcart(fstcart z))))) + measurable_on (:real^((1,1)finite_sum,1)finite_sum)`, + SUBGOAL_THEN + `(\z:real^((1,1)finite_sum,1)finite_sum. Cx(inv(drop(fstcart(fstcart z))))) + = + (\v:real^1. Cx(drop v)) o (\z:real^((1,1)finite_sum,1)finite_sum. + lift(inv(drop(fstcart(fstcart z)))))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; o_THM; LIFT_DROP]; ALL_TAC] THEN + MATCH_MP_TAC MEASURABLE_ON_COMPOSE_CONTINUOUS THEN CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_ON_LIFT_INV THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_IMP_MEASURABLE_ON THEN + SUBGOAL_THEN + `(\z:real^((1,1)finite_sum,1)finite_sum. lift(drop(fstcart(fstcart z)))) + = + (fstcart:real^(1,1)finite_sum->real^1) o + (fstcart:real^((1,1)finite_sum,1)finite_sum->real^(1,1)finite_sum)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; o_THM; LIFT_DROP]; ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THEN + MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN + REWRITE_TAC[ETA_AX; LINEAR_FSTCART]; + REWRITE_TAC[IN_UNIV; TBOX_A_EQ_C1; NEGLIGIBLE_STANDARD_HYPERPLANE]]; + REWRITE_TAC[CONTINUOUS_ON_CX_LIFT; LIFT_DROP; CONTINUOUS_ON_ID]]);; + +(* FULL box-restricted transform kernel measurable on the iterated Fubini *) +(* type: Cx(inv a)*(cexp(-i(-x)w)*fhat(w))*Cx(theta'_zab w) restricted to *) +(* the (a,b)-box. MEASURABLE_ON_RESTRICT (TBOX_REGION_LMEAS) + *) +(* MEASURABLE_ON_COMPLEX_MUL x2 over the 3 factors (TBOX_INVA_CX / *) +(* CEXPFHAT_W / CARLESON_THETA'_TBOX_CX). *) +let MNF_KERNEL_BOX_MEAS = prove + (`!(h:real->complex) z0 x n. schwartz h + ==> (\z:real^((1,1)finite_sum,1)finite_sum. + if &1 <= drop(fstcart(fstcart z)) /\ drop(fstcart(fstcart z)) <= &2 + /\ + &0 <= drop(sndcart(fstcart z)) /\ drop(sndcart(fstcart z)) <= &n + then Cx(inv(drop(fstcart(fstcart z)))) * + (cexp(--(ii * Cx(--x) * Cx(drop(sndcart z)))) * fourier h + (drop(sndcart z))) * + Cx(carleson_theta' z0 (drop(fstcart(fstcart z))) + (drop(sndcart(fstcart z))) (drop(sndcart z))) + else vec 0) + measurable_on (:real^((1,1)finite_sum,1)finite_sum)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\z:real^((1,1)finite_sum,1)finite_sum. + if &1 <= drop(fstcart(fstcart z)) /\ drop(fstcart(fstcart z)) <= &2 /\ + &0 <= drop(sndcart(fstcart z)) /\ drop(sndcart(fstcart z)) <= &n + then Cx(inv(drop(fstcart(fstcart z)))) * + (cexp(--(ii * Cx(--x) * Cx(drop(sndcart z)))) * fourier h + (drop(sndcart z))) * + Cx(carleson_theta' z0 (drop(fstcart(fstcart z))) + (drop(sndcart(fstcart z))) (drop(sndcart z))) + else vec 0) = + (\z:real^((1,1)finite_sum,1)finite_sum. + if z IN {z | &1 <= drop(fstcart(fstcart z)) /\ drop(fstcart(fstcart z)) + <= &2 /\ + &0 <= drop(sndcart(fstcart z)) /\ drop(sndcart(fstcart z)) + <= &n} + then Cx(inv(drop(fstcart(fstcart z)))) * + (cexp(--(ii * Cx(--x) * Cx(drop(sndcart z)))) * fourier h + (drop(sndcart z))) * + Cx(carleson_theta' z0 (drop(fstcart(fstcart z))) + (drop(sndcart(fstcart z))) (drop(sndcart z))) + else vec 0)` + SUBST1_TAC THENL [REWRITE_TAC[IN_ELIM_THM]; ALL_TAC] THEN + MATCH_MP_TAC MEASURABLE_ON_RESTRICT THEN CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_ON_COMPLEX_MUL THEN + REWRITE_TAC[TBOX_INVA_CX_MEASURABLE] THEN + MATCH_MP_TAC MEASURABLE_ON_COMPLEX_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC CEXPFHAT_W_MEASURABLE THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[CARLESON_THETA'_TBOX_CX]]; + REWRITE_TAC[TBOX_REGION_LMEAS]]);; + +(* abstract: |cexp(-i a b)| = 1 (purely imaginary exponent; Re = 0 by *) +(* REAL_ARITH on the complex_mul expansion -- robust, no fragile literal *) +(* arithmetic form). *) +let CEXP_IMAG_NORM1 = prove + (`!a b:real. norm(cexp(--(ii * Cx a * Cx b))) = &1`, + REPEAT GEN_TAC THEN REWRITE_TAC[NORM_CEXP; RE_NEG] THEN + SUBGOAL_THEN `Re(ii * Cx a * Cx b) = &0` SUBST1_TAC THENL + [REWRITE_TAC[COMPLEX_MUL_ASSOC; GSYM CX_MUL] THEN + REWRITE_TAC[ii; complex_mul; RE; IM; RE_CX; IM_CX] THEN REAL_ARITH_TAC; + REWRITE_TAC[REAL_NEG_0; REAL_EXP_0]]);; + +(* pointwise: norm of the box-restricted kernel <= norm(fhat(w))*1[box]. *) +(* |Cx(inv a)|<=1 (a in [1,2]), |cexp|=1, |Cx theta'|<=1 *) +(* (CARLESON_THETA'_BOUNDS). *) +let MNF_KERNEL_NORM_BOUND = prove + (`!(h:real->complex) z0 x n z:real^((1,1)finite_sum,1)finite_sum. + norm((if &1 <= drop(fstcart(fstcart z)) /\ drop(fstcart(fstcart z)) <= &2 + /\ + &0 <= drop(sndcart(fstcart z)) /\ drop(sndcart(fstcart z)) <= &n + then Cx(inv(drop(fstcart(fstcart z)))) * + (cexp(--(ii * Cx(--x) * Cx(drop(sndcart z)))) * fourier h + (drop(sndcart z))) * + Cx(carleson_theta' z0 (drop(fstcart(fstcart z))) + (drop(sndcart(fstcart z))) (drop(sndcart z))) + else vec 0)) + <= norm(if &1 <= drop(fstcart(fstcart z)) /\ drop(fstcart(fstcart z)) <= + &2 /\ + &0 <= drop(sndcart(fstcart z)) /\ drop(sndcart(fstcart z)) <= + &n + then fourier h (drop(sndcart z)) else vec 0)`, + REPEAT GEN_TAC THEN COND_CASES_TAC THEN + REWRITE_TAC[NORM_0; REAL_LE_REFL] THEN + POP_ASSUM STRIP_ASSUME_TAC THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX; CEXP_IMAG_NORM1] THEN + REWRITE_TAC[REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&1 * norm(fourier (h:real->complex) + (drop(sndcart(z:real^((1,1)finite_sum,1)finite_sum)))) * &1` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL2 THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[REAL_ABS_POS]; + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs(inv(&1))` THEN + CONJ_TAC THENL + [ALL_TAC; CONV_TAC REAL_RAT_REDUCE_CONV] THEN + REWRITE_TAC[REAL_ABS_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN + ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[NORM_POS_LE; REAL_ABS_POS]; + MATCH_MP_TAC REAL_LE_MUL2 THEN + REWRITE_TAC[NORM_POS_LE; REAL_LE_REFL; REAL_ABS_POS] THEN + MP_TAC(ISPECL + [`z0:real`; + `drop(fstcart(fstcart(z:real^((1,1)finite_sum,1)finite_sum)))`; + `drop(sndcart(fstcart(z:real^((1,1)finite_sum,1)finite_sum)))`; + `drop(sndcart(z:real^((1,1)finite_sum,1)finite_sum))`] + CARLESON_THETA'_BOUNDS) THEN + REAL_ARITH_TAC]; + REWRITE_TAC[REAL_MUL_LID; REAL_MUL_RID; REAL_LE_REFL]]);; + +(* ------------------------------------------------------------------------- *) +(* S6 keystone step (b): box ABSOLUTE INTEGRABILITY of the transform kernel. *) +(* Reusable tensor lemma + box2d-measurability + the dominated abs-int. *) +(* ------------------------------------------------------------------------- *) + +(* general: g absint on the R^N (=w) factor, times the indicator of a *) +(* measurable s in the R^M (=(a,b)) factor, is absint on the product. Via *) +(* FUBINI_TONELLI: measurable (RESTRICT of g o sndcart to s PCROSS UNIV); *) +(* every *) +(* slice absint (g or 0); slice-norm-integral = int|g| * indicator s, *) +(* integrable. *) +let TENSOR_INDICATOR_L1_ABSINT = prove + (`!(g:real^1->real^1) (s:real^(1,1)finite_sum->bool). + g absolutely_integrable_on (:real^1) /\ measurable s + ==> (\z:real^((1,1)finite_sum,1)finite_sum. + if fstcart z IN s then g(sndcart z) else vec 0) + absolutely_integrable_on (:real^((1,1)finite_sum,1)finite_sum)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC + `\z:real^((1,1)finite_sum,1)finite_sum. if fstcart z IN s then + (g:real^1->real^1)(sndcart z) else vec 0` + FUBINI_TONELLI) THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN + ANTS_TAC THENL + [SUBGOAL_THEN + `(\z:real^((1,1)finite_sum,1)finite_sum. if fstcart z IN s then + (g:real^1->real^1)(sndcart z) else vec 0) = + (\z:real^((1,1)finite_sum,1)finite_sum. if z IN (s PCROSS (:real^1)) then + (g(sndcart z)) else vec 0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + ONCE_REWRITE_TAC[GSYM PASTECART_FST_SND] THEN + REWRITE_TAC[PASTECART_IN_PCROSS; FSTCART_PASTECART; SNDCART_PASTECART; + IN_UNIV] THEN + REWRITE_TAC[PASTECART_FST_SND]; + ALL_TAC] THEN + MATCH_MP_TAC MEASURABLE_ON_RESTRICT THEN CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_ON_COMPOSE_SNDCART THEN + ASM_MESON_TAC[ABSOLUTELY_INTEGRABLE_MEASURABLE]; + REWRITE_TAC[LEBESGUE_MEASURABLE_PCROSS; LEBESGUE_MEASURABLE_UNIV] THEN + ASM_SIMP_TAC[MEASURABLE_IMP_LEBESGUE_MEASURABLE]]; + ALL_TAC] THEN + DISCH_THEN(fun th -> GEN_REWRITE_TAC I [th]) THEN CONJ_TAC THENL + [SUBGOAL_THEN + `{x:real^(1,1)finite_sum | ~((\y. if x IN s then (g:real^1->real^1) y else + vec 0) absolutely_integrable_on (:real^1))} = {}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN + X_GEN_TAC `x:real^(1,1)finite_sum` THEN + ASM_CASES_TAC `x IN (s:real^(1,1)finite_sum->bool)` THEN + ASM_REWRITE_TAC[ABSOLUTELY_INTEGRABLE_0; ETA_AX]; + REWRITE_TAC[NEGLIGIBLE_EMPTY]]; + SUBGOAL_THEN + `(\x. integral (:real^1) (\y. lift(norm(if x IN s then (g:real^1->real^1) + y else vec 0)))) = + (\x:real^(1,1)finite_sum. drop(integral (:real^1) (\y. lift(norm(g y)))) + % indicator s x)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; indicator] THEN GEN_TAC THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[NORM_0; LIFT_NUM; INTEGRAL_0; VECTOR_MUL_RZERO] THEN + REWRITE_TAC[GSYM DROP_EQ; DROP_CMUL; DROP_VEC; REAL_MUL_RID]; + ALL_TAC] THEN + MATCH_MP_TAC INTEGRABLE_CMUL THEN + REWRITE_TAC[ETA_AX; INTEGRABLE_ON_INDICATOR; INTER_UNIV] THEN + ASM_REWRITE_TAC[]]);; + +(* the box2d region {1<=a<=2, 0<=b<=n} in R^(1,1)fs is MEASURABLE (an *) +(* interval). *) +let TBOX2D_MEASURABLE = prove + (`!n. measurable {ab:real^(1,1)finite_sum | + &1 <= drop(fstcart ab) /\ drop(fstcart ab) <= &2 /\ + &0 <= drop(sndcart ab) /\ drop(sndcart ab) <= &n}`, + GEN_TAC THEN + SUBGOAL_THEN + `{ab:real^(1,1)finite_sum | + &1 <= drop(fstcart ab) /\ drop(fstcart ab) <= &2 /\ + &0 <= drop(sndcart ab) /\ drop(sndcart ab) <= &n} = + (interval[lift(&1),lift(&2)]) PCROSS (interval[lift(&0),lift(&n)])` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; FORALL_PASTECART; PASTECART_IN_PCROSS; IN_ELIM_THM; + FSTCART_PASTECART; SNDCART_PASTECART; IN_INTERVAL_1; + LIFT_DROP] THEN + CONV_TAC TAUT; + REWRITE_TAC[MEASURABLE_PCROSS] THEN REPEAT DISJ2_TAC THEN + REWRITE_TAC[MEASURABLE_INTERVAL]]);; + +(* the box-restricted transform kernel is ABSOLUTELY INTEGRABLE on the *) +(* iterated *) +(* type: dominated by norm(fhat(w))*1[box] (MNF_KERNEL_NORM_BOUND), the *) +(* dominator *) +(* integrable via TENSOR_INDICATOR_L1_ABSINT (SCHWARTZ_FHAT_ABSINT on w-line *) +(* x *) +(* the finite box2d). Feeds FUBINI_INTEGRAL_SWAP for MNF_FOURIER_BOX. *) +let MNF_KERNEL_BOX_ABSINT = prove + (`!(h:real->complex) z0 x n. schwartz h + ==> (\z:real^((1,1)finite_sum,1)finite_sum. + if &1 <= drop(fstcart(fstcart z)) /\ drop(fstcart(fstcart z)) <= &2 + /\ + &0 <= drop(sndcart(fstcart z)) /\ drop(sndcart(fstcart z)) <= &n + then Cx(inv(drop(fstcart(fstcart z)))) * + (cexp(--(ii * Cx(--x) * Cx(drop(sndcart z)))) * fourier h + (drop(sndcart z))) * + Cx(carleson_theta' z0 (drop(fstcart(fstcart z))) + (drop(sndcart(fstcart z))) (drop(sndcart z))) + else vec 0) + absolutely_integrable_on (:real^((1,1)finite_sum,1)finite_sum)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE THEN + EXISTS_TAC + `\z:real^((1,1)finite_sum,1)finite_sum. + if fstcart z IN {ab:real^(1,1)finite_sum | + &1 <= drop(fstcart ab) /\ drop(fstcart ab) <= &2 /\ + &0 <= drop(sndcart ab) /\ drop(sndcart ab) <= &n} + then lift(norm(fourier h (drop(sndcart z)))) else vec 0` THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC MNF_KERNEL_BOX_MEAS THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC TENSOR_INDICATOR_L1_ABSINT THEN CONJ_TAC THENL + [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN + MP_TAC(ISPEC `h:real->complex` SCHWARTZ_FHAT_ABSINT) THEN + ASM_REWRITE_TAC[]; + REWRITE_TAC[TBOX2D_MEASURABLE]]; + X_GEN_TAC `z:real^((1,1)finite_sum,1)finite_sum` THEN + REWRITE_TAC[IN_UNIV] THEN + MP_TAC(ISPECL [`h:real->complex`; `z0:real`; `x:real`; `n:num`; + `z:real^((1,1)finite_sum,1)finite_sum`] + MNF_KERNEL_NORM_BOUND) THEN + REWRITE_TAC[IN_ELIM_THM; FSTCART_PASTECART; SNDCART_PASTECART] THEN + MATCH_MP_TAC(REAL_ARITH `b = c ==> a <= b ==> a <= c`) THEN + COND_CASES_TAC THEN + REWRITE_TAC[NORM_0; LIFT_DROP; NORM_LIFT; DROP_VEC] THEN + REWRITE_TAC[REAL_ABS_NORM]]);; + +(* modulation by a plane wave cexp(ii t w) preserves absolute integrability *) +(* (bounded *) +(* measurable multiplier). The L1-integrability input for the window DCT. *) +let CEXP_MODULATE_ABSINT_GEN = prove + (`!(g:real^1->complex) t. g absolutely_integrable_on (:real^1) + ==> (\w:real^1. cexp(ii * Cx t * Cx(drop w)) * g w) + absolutely_integrable_on (:real^1)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`( * ):complex->complex->complex`; + `\w:real^1. cexp(ii * Cx t * Cx(drop w))`; + `g:real^1->complex`; `(:real^1)`] + ABSOLUTELY_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT) THEN + ASM_REWRITE_TAC[BILINEAR_COMPLEX_MUL] THEN DISCH_THEN MATCH_MP_TAC THEN + CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_IMP_MEASURABLE_ON THEN + SUBGOAL_THEN `(\w:real^1. cexp(ii * Cx t * Cx(drop w))) = + cexp o (\w:real^1. (ii * Cx t) * Cx(drop w))` SUBST1_TAC + THENL + [REWRITE_TAC[o_DEF; COMPLEX_MUL_ASSOC]; ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + REWRITE_TAC[CONTINUOUS_ON_CEXP] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_LMUL THEN + MP_TAC(ISPECL [`\w:real^1. w`; `(:real^1)`] CONTINUOUS_ON_CX_DROP) THEN + REWRITE_TAC[CONTINUOUS_ON_ID] THEN REWRITE_TAC[ETA_AX]; + REWRITE_TAC[bounded; FORALL_IN_IMAGE] THEN EXISTS_TAC `&1` THEN + REWRITE_TAC[IN_UNIV; GSYM CX_MUL; NORM_CEXP_II; REAL_LE_REFL]]);; + + +(* WINDOW_INTEGRAL_LIM: the DCT integral-limit core. As (a,b,x) -> *) +(* (a0,b0,x0), the *) +(* Fourier integral int cexp(ii x w) hhat(w) theta'_{z a b}(w) dw converges, *) +(* jointly. *) +(* DOMINATED_CONVERGENCE_AE with envelope norm(fourier h), null set the *) +(* dyadic+gate bad-w. *) +let NORM_SEQ_REALLIM = prove + (`!(f:num->complex) l. (f --> l) sequentially ==> ((\m. norm(f m)) ---> norm + l) sequentially`, + REPEAT STRIP_TAC THEN REWRITE_TAC[TENDSTO_REAL; o_DEF] THEN + MATCH_MP_TAC LIM_NORM THEN ASM_REWRITE_TAC[]);; + +(* fourier ff at frequency -x, exposing the +ii sign, keeping ff abstract *) +(* (FOURIER_INV_NEG from fourier_transform.ml, with the constant folded). *) +let FOURIER_AT_NEG = prove + (`!(ff:real->complex) x. fourier ff (--x) = + Cx(&1 / sqrt(&2 * pi)) * integral (:real^1) (\w. cexp(ii * Cx x * Cx(drop + w)) * ff(drop w))`, + REWRITE_TAC[CX_DIV; FOURIER_INV_NEG]);; + +(* WINDOW_JOINT_CONT: the amd z-window *) +(* 2pi*norm(fourier(hhat*theta_{zab})check(x)) is jointly *) +(* continuous in (a,b,x) (sequential form). From WINDOW_INTEGRAL_LIM via *) +(* FOURIER_AT_NEG + *) +(* norm-continuity (NORM_SEQ_REALLIM) + the constant factor (REALLIM_LMUL). *) +let FHAT_QUAD_ENVELOPE = prove + (`!(h:real->complex). schwartz h + ==> ?gamma. &0 <= gamma /\ !t. norm(fourier h t) <= gamma * inv(&1 + t pow + 2)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `h:real->complex` SCHWARTZ_FOURIER) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[schwartz] THEN + DISCH_THEN(X_CHOOSE_THEN `d:num->real->complex` STRIP_ASSUME_TAC) THEN + FIRST_ASSUM(X_CHOOSE_TAC `B0:real` o SPECL [`0`; `0`]) THEN + FIRST_ASSUM(X_CHOOSE_TAC `B2:real` o SPECL [`2`; `0`]) THEN + EXISTS_TAC `abs B0 + abs B2` THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + X_GEN_TAC `t:real` THEN + SUBGOAL_THEN `fourier h t = (d:num->real->complex) 0 t` SUBST1_TAC THENL + [ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(abs B0 + abs B2) * inv(&1 + t pow 2)` THEN CONJ_TAC THENL + [MATCH_MP_TAC SCHWARTZ_DECAY_DOMINATION THEN CONJ_TAC THEN + X_GEN_TAC `x:real` THENL + [MP_TAC(SPEC `x:real` (ASSUME `!x. abs(x) pow 0 * + norm((d:num->real->complex) 0 x) <= B0`)) THEN + REAL_ARITH_TAC; + MP_TAC(SPEC `x:real` (ASSUME `!x. abs(x) pow 2 * + norm((d:num->real->complex) 0 x) <= B2`)) THEN + REAL_ARITH_TAC]; + REWRITE_TAC[REAL_LE_REFL]]);; + +(* Schwartz-specialized MODDIL closed form: (M_b D_a h)hat(w) = (1/a) *) +(* hhat((w-b)/a). *) +let CARLESON_MODDIL_FHAT = prove + (`!(h:real->complex) a b w. schwartz h /\ &0 < a + ==> fourier (carleson_modulate b (carleson_dilate a h)) w = Cx(&1/a) * + fourier h ((w - b)/a)`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`h:real->complex`; `a:real`; `b:real`; + `w:real`] CARLESON_MODDIL_FOURIER) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + MP_TAC(SPECL [`h:real->complex`; `a:real`; `b:real`; + `w:real`] CARLESON_MOD_TRANSFORM_INTEG) THEN + ASM_REWRITE_TAC[]]; + DISCH_THEN(fun th -> REWRITE_TAC[th])]);; + +(* fourier h continuous in its argument along a sequence (schwartz h). *) +let FOURIER_ARG_SEQ_LIM = prove + (`!(h:real->complex) tseq t0. schwartz h /\ (tseq ---> t0) sequentially + ==> ((\m. fourier h (tseq m)) --> fourier h t0) sequentially`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`h:real->complex`; `t0:real`] FOURIER_CONTINUOUS_SEQ) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MP_TAC(ISPECL [`h:real->complex`; + `y':real`] FOURIER_MODULATION_ABSINT) THEN + DISCH_THEN MATCH_MP_TAC THEN + MATCH_MP_TAC SCHWARTZ_ABSINT THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN + MATCH_MP_TAC SCHWARTZ_ABSINT THEN ASM_REWRITE_TAC[]]; + DISCH_THEN(MP_TAC o SPEC `tseq:num->real`) THEN ASM_REWRITE_TAC[]]);; + +(* (a,b) |-> fourier(M_b D_a h)(y) continuous (pointwise y): via closed form *) +(* + FT arg-cont. *) +let MODDIL_FHAT_SEQ_LIM = prove + (`!(h:real->complex) aseq bseq a0 b0 y. + schwartz h /\ &0 < a0 /\ (!m. &0 < aseq m) /\ + (aseq ---> a0) sequentially /\ (bseq ---> b0) sequentially + ==> ((\m. fourier (carleson_modulate (bseq m) (carleson_dilate (aseq m) + h)) y) + --> fourier (carleson_modulate b0 (carleson_dilate a0 h)) y) + sequentially`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\m:num. fourier (carleson_modulate (bseq m) (carleson_dilate (aseq m) h)) + y) = + (\m:num. Cx(&1/aseq m) * fourier h ((y - bseq m)/aseq m))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `m:num` THEN + MATCH_MP_TAC CARLESON_MODDIL_FHAT THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `fourier (carleson_modulate b0 (carleson_dilate a0 h)) y = Cx(&1/a0) * + fourier h ((y - b0)/a0)` + SUBST1_TAC THENL + [MATCH_MP_TAC CARLESON_MODDIL_FHAT THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC LIM_COMPLEX_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC CX_SEQ_LIM THEN + REWRITE_TAC[real_div; REAL_MUL_LID] THEN + MATCH_MP_TAC REALLIM_INV THEN ASM_SIMP_TAC[REAL_LT_IMP_NZ]; + MATCH_MP_TAC FOURIER_ARG_SEQ_LIM THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REALLIM_DIV THEN ASM_SIMP_TAC[REAL_LT_IMP_NZ] THEN + MATCH_MP_TAC REALLIM_SUB THEN ASM_REWRITE_TAC[REALLIM_CONST]]);; + +(* FREMLIN integrand-limit (M_bD_a form, theta_zeta FIXED weight): pointwise *) +(* EVERY y. *) +let FREMLIN_INTEGRAND_LIM = prove + (`!(h:real->complex) zeta aseq bseq xseq a0 b0 x0 y. + schwartz h /\ &0 < a0 /\ (!m. &0 < aseq m) /\ + (aseq ---> a0) sequentially /\ (bseq ---> b0) sequentially /\ (xseq ---> + x0) sequentially + ==> ((\m. cexp(ii * Cx(xseq m / aseq m) * Cx y) * + fourier (carleson_modulate (bseq m) (carleson_dilate (aseq m) + h)) y * + Cx(carleson_theta zeta y)) + --> cexp(ii * Cx(x0 / a0) * Cx y) * + fourier (carleson_modulate b0 (carleson_dilate a0 h)) y * + Cx(carleson_theta zeta y)) sequentially`, + REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[COMPLEX_RING `a * b * c = (a * b) * c:complex`] THEN + MATCH_MP_TAC LIM_COMPLEX_MUL THEN REWRITE_TAC[LIM_CONST] THEN + MATCH_MP_TAC LIM_COMPLEX_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC CEXP_SEQ_LIM THEN + MATCH_MP_TAC REALLIM_DIV THEN ASM_SIMP_TAC[REAL_LT_IMP_NZ]; + MATCH_MP_TAC MODDIL_FHAT_SEQ_LIM THEN ASM_REWRITE_TAC[]]);; + +(* ========================================================================= *) +(* 286S(a) DCT DOMINATOR pieces. The integrand modulus <= *) +(* (1/a)|hhat((y-b)/a)| *) +(* (MODULUS_LE_INVA_FHAT), and along a convergent sequence *) +(* (a_m,b_m)->(a0,b0) the *) +(* a_m/b_m are GLOBALLY bounded (AMD_SEQ_GLOBAL_BOUNDS: alo<=a_m<=ahi, *) +(* alo>0, *) +(* |b_m|<=bhi), so the modulus is dominated for ALL m by an integrable *) +(* envelope *) +(* built from the shifted-scaled inverse square *) +(* (INV_SHIFT_SCALE_INTEGRABLE). *) +(* ========================================================================= *) + +(* integrand modulus <= (1/a) |hhat((y-b)/a)| (theta<=1, |cexp|=1). *) +let MODULUS_LE_INVA_FHAT = prove + (`!(h:real->complex) zeta a b x y. schwartz h /\ &0 < a + ==> norm(cexp(ii * Cx(x/a) * Cx y) * + fourier (carleson_modulate b (carleson_dilate a h)) y * + Cx(carleson_theta zeta y)) + <= inv a * norm(fourier h ((y - b)/a))`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[CARLESON_MODDIL_FHAT] THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX] THEN + REWRITE_TAC[GSYM COMPLEX_MUL_ASSOC; GSYM CX_MUL; NORM_CEXP_II; + REAL_MUL_LID] THEN + SUBGOAL_THEN `abs(&1/a) = inv a` SUBST1_TAC THENL + [REWRITE_TAC[REAL_ABS_DIV; REAL_ABS_NUM; REAL_DIV_1] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < a ==> abs a = a`; real_div; REAL_MUL_LID]; + ALL_TAC] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + ONCE_REWRITE_TAC[REAL_ARITH `(i * n) * t = (i * n) * t:real`] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN + ASM_SIMP_TAC[REAL_LE_INV_EQ; NORM_POS_LE; REAL_LT_IMP_LE]; + MP_TAC(SPECL [`zeta:real`; `y:real`] CARLESON_THETA_BOUNDS) THEN + REAL_ARITH_TAC]);; + +(* inverse-order swap helper (avoids an in-context EXISTS_TAC type snag). *) +let INV_LE_INV_SWAP = prove + (`!a K. &0 < a /\ &0 < K /\ inv a <= K ==> inv K <= a`, + REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_INV] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN ASM_SIMP_TAC[REAL_LT_INV]);; + +(* a convergent positive sequence is bounded below by a positive constant. *) +let ASEQ_POS_LOWER = prove + (`!aseq a0. &0 < a0 /\ (!m. &0 < aseq m) /\ (aseq ---> a0) sequentially + ==> ?alo. &0 < alo /\ !m. alo <= aseq m`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `((\m. inv(aseq m)) ---> inv a0) sequentially` ASSUME_TAC THENL + [MATCH_MP_TAC REALLIM_INV THEN ASM_SIMP_TAC[REAL_LT_IMP_NZ]; ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP REAL_CONVERGENT_IMP_BOUNDED) THEN + REWRITE_TAC[REAL_BOUNDED_POS; FORALL_IN_IMAGE; IN_UNIV] THEN + DISCH_THEN(X_CHOOSE_THEN `K:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `inv(K:real)` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LT_INV THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + X_GEN_TAC `m:num` THEN MATCH_MP_TAC INV_LE_INV_SWAP THEN + ASM_SIMP_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN + ASM_SIMP_TAC[REAL_ABS_INV; REAL_ARITH `&0 < a ==> abs a = a`]);; + +(* global bounds for the (a_m,b_m) sequences: alo<=a_m<=ahi (alo>0), *) +(* |b_m|<=bhi. *) +let AMD_SEQ_GLOBAL_BOUNDS = prove + (`!aseq bseq a0 b0. &0 < a0 /\ (!m. &0 < aseq m) /\ + (aseq ---> a0) sequentially /\ (bseq ---> b0) sequentially + ==> ?alo ahi bhi. &0 < alo /\ + (!m. alo <= aseq m /\ aseq m <= ahi /\ abs(bseq m) <= bhi)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`aseq:num->real`; `a0:real`] ASEQ_POS_LOWER) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN + `alo:real` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `?ahi. !m. (aseq:num->real) m <= ahi` (X_CHOOSE_TAC `ahi:real`) THENL + [FIRST_X_ASSUM(MP_TAC o MATCH_MP REAL_CONVERGENT_IMP_BOUNDED o + check(fun th -> can (find_term (fun t -> t = `a0:real`)) (concl th))) + THEN + REWRITE_TAC[REAL_BOUNDED_POS; FORALL_IN_IMAGE; IN_UNIV] THEN + DISCH_THEN(X_CHOOSE_THEN `Ma:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `Ma:real` THEN X_GEN_TAC `m:num` THEN + FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `?bhi. !m. abs((bseq:num->real) m) <= bhi` (X_CHOOSE_TAC `bhi:real`) THENL + [FIRST_X_ASSUM(MP_TAC o MATCH_MP REAL_CONVERGENT_IMP_BOUNDED o + check(fun th -> can (find_term (fun t -> t = `b0:real`)) (concl th))) + THEN + REWRITE_TAC[REAL_BOUNDED_POS; FORALL_IN_IMAGE; IN_UNIV] THEN + DISCH_THEN(X_CHOOSE_THEN `Mb:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `Mb:real` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MAP_EVERY EXISTS_TAC [`alo:real`; `ahi:real`; `bhi:real`] THEN + ASM_REWRITE_TAC[]);; + +(* translate of INV_SQ integrable on the whole line (via vector *) +(* INTEGRABLE_TRANSLATION). *) +let INV_SQ_TRANSLATE_INTEGRABLE = prove + (`!d. (\y. inv(&1 + (y - d) pow 2)) real_integrable_on (:real)`, + GEN_TAC THEN REWRITE_TAC[REAL_INTEGRABLE_ON; IMAGE_LIFT_UNIV; o_DEF] THEN + MP_TAC(ISPECL [`\x:real^1. lift(inv(&1 + drop x pow 2))`; `(:real^1)`; + `--(lift d)`] + INTEGRABLE_TRANSLATION) THEN + SUBGOAL_THEN + `IMAGE (\x:real^1. --(lift d) + x) (:real^1) = (:real^1)` SUBST1_TAC THENL + [MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[IN_UNIV] THEN + X_GEN_TAC `z:real^1` THEN EXISTS_TAC `z + lift d:real^1` THEN + VECTOR_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[DROP_ADD; DROP_NEG; LIFT_DROP] THEN + SUBGOAL_THEN `(\x:real^1. lift(inv(&1 + (drop x - d) pow 2))) = + (\x:real^1. lift(inv(&1 + (--d + drop x) pow 2)))` SUBST1_TAC + THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN + MP_TAC INV_SQ_REAL_INTEGRABLE THEN + REWRITE_TAC[REAL_INTEGRABLE_ON; IMAGE_LIFT_UNIV; o_DEF]);; + +(* comparison: inv(c+s^2) <= max(1,inv c) * inv(1+s^2), c>0. *) +let INV_C_LE_MAX_INV_SQ = prove + (`!c s. &0 < c ==> inv(c + s pow 2) <= max (&1) (inv c) * inv(&1 + s pow 2)`, + REPEAT STRIP_TAC THEN MP_TAC(SPEC `s:real` REAL_LE_POW_2) THEN DISCH_TAC THEN + SUBGOAL_THEN `&0 < &1 + s pow 2 /\ &0 < c + s pow 2` STRIP_ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_CASES_TAC `&1 <= c` THENL + [SUBGOAL_THEN `inv c <= &1` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_INV_LE_1 THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `max (&1) (inv c) = &1` SUBST1_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LE_INV2 THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + SUBGOAL_THEN `&1 <= inv c` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_INV_1_LE THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `max (&1) (inv c) = inv c` SUBST1_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[GSYM REAL_INV_MUL] THEN MATCH_MP_TAC REAL_LE_INV2 THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[REAL_ADD_LDISTRIB; REAL_MUL_RID] THEN + SUBGOAL_THEN `c * s pow 2 <= s pow 2` MP_TAC THENL + [GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_REAL_ARITH_TAC]]);; + +(* the shifted-scaled inverse square is integrable on the whole line (c>0). *) +let INV_SHIFT_SCALE_INTEGRABLE = prove + (`!c d. &0 < c ==> (\y. inv(c + (y - d) pow 2)) real_integrable_on (:real)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN + EXISTS_TAC `\y. max (&1) (inv c) * inv(&1 + (y - d) pow 2)` THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_IMP_REAL_MEASURABLE_ON THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_INV THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_ON_ADD THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_CONST] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_POW THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_SUB THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_ID; REAL_CONTINUOUS_ON_CONST]; + X_GEN_TAC `y:real` THEN REWRITE_TAC[IN_UNIV] THEN + MP_TAC(SPEC `y - d:real` REAL_LE_POW_2) THEN ASM_REAL_ARITH_TAC]; + MATCH_MP_TAC REAL_INTEGRABLE_LMUL THEN + REWRITE_TAC[INV_SQ_TRANSLATE_INTEGRABLE]; + X_GEN_TAC `y:real` THEN REWRITE_TAC[IN_UNIV] THEN + SUBGOAL_THEN `&0 < c + (y - d) pow 2` ASSUME_TAC THENL + [MP_TAC(SPEC `y - d:real` REAL_LE_POW_2) THEN + ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[real_abs; REAL_LT_IMP_LE; REAL_LE_INV_EQ] THEN + MP_TAC(ISPECL [`c:real`; `y - d:real`] INV_C_LE_MAX_INV_SQ) THEN + ASM_REWRITE_TAC[]]);; + +(* ========================================================================= *) +(* 286S(a) DCT: the uniform (all-m) Poisson dominator bound + arithmetic *) +(* helpers. POISSON_UNIF_BOUND says the M_bD_a-window integrand modulus is *) +(* dominated, for all a in [alo,ahi] and |b|<=bhi, by the b-free integrable *) +(* envelope gamma*ahi*C*inv(alo^2+y^2) (C=2+(alo^2+2bhi^2)/alo^2), which *) +(* feeds *) +(* the core DOMINATED_CONVERGENCE for FREMLIN_WINDOW_INTEGRAL_LIM. *) +(* ========================================================================= *) + +(* uniform-in-b denominator comparison: alo^2+y^2 <= C*(alo^2+(y-b)^2), *) +(* |b|<=bhi. *) +let DENOM_UNIF_COMPARE = prove + (`!alo bhi y b. &0 < alo /\ abs b <= bhi + ==> alo pow 2 + y pow 2 + <= (&2 + (alo pow 2 + &2 * bhi pow 2) / alo pow 2) * (alo pow 2 + (y - + b) pow 2)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&0 < alo pow 2` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_POW_LT THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `y pow 2 <= &2 * (y - b) pow 2 + &2 * b pow 2` ASSUME_TAC THENL + [MP_TAC(SPEC `(y - b) - b:real` REAL_LE_POW_2) THEN + MATCH_MP_TAC(REAL_ARITH + `((y - b) - b) pow 2 = &2 * (y - b) pow 2 + &2 * b pow 2 - y pow 2 + ==> &0 <= ((y - b) - b) pow 2 ==> y pow 2 <= &2 * (y - b) pow 2 + &2 * b + pow 2`) THEN + CONV_TAC REAL_RING; ALL_TAC] THEN + SUBGOAL_THEN `b pow 2 <= bhi pow 2` ASSUME_TAC THENL + [REWRITE_TAC[GSYM REAL_LE_SQUARE_ABS] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `(&2 + (alo pow 2 + &2 * bhi pow 2) / alo pow 2) * (alo pow 2 + (y - b) pow + 2) + = &2 * (alo pow 2 + (y - b) pow 2) + + ((alo pow 2 + &2 * bhi pow 2) + + (alo pow 2 + &2 * bhi pow 2) / alo pow 2 * (y - b) pow + 2)` + SUBST1_TAC THENL + [REWRITE_TAC[REAL_ADD_RDISTRIB] THEN + ASM_SIMP_TAC[REAL_FIELD `&0 < a ==> x / a * (a + w) = x + x / a * w`]; + ALL_TAC] THEN + SUBGOAL_THEN + `&0 <= (alo pow 2 + &2 * bhi pow 2)/alo pow 2 * (y - b) pow 2` + ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_LE_POW_2] THEN + MATCH_MP_TAC REAL_LE_DIV THEN + MP_TAC(SPEC `bhi:real` REAL_LE_POW_2) THEN + ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(SPEC `bhi:real` REAL_LE_POW_2) THEN + MP_TAC(SPEC `y - b:real` REAL_LE_POW_2) THEN + ASM_REAL_ARITH_TAC);; + +(* Poisson form of the envelope: inv *) +(* a*(gamma*inv(1+((y-b)/a)^2))=gamma*a*inv(a^2+(y-b)^2). *) +let INVA_ENVELOPE_POISSON = prove + (`!a b y gam. &0 < a + ==> inv a * (gam * inv(&1 + ((y - b)/a) pow 2)) = gam * a * inv(a pow 2 + (y + - b) pow 2)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&0 < a pow 2` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_POW_LT THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `&1 + ((y - b)/a) pow 2 = + (a pow 2 + (y - b) pow 2) / a pow 2` SUBST1_TAC THENL + [REWRITE_TAC[REAL_POW_DIV] THEN + MP_TAC(ASSUME `&0 < a pow 2`) THEN CONV_TAC REAL_FIELD; ALL_TAC] THEN + REWRITE_TAC[REAL_INV_DIV] THEN + MP_TAC(ASSUME `&0 < a`) THEN MP_TAC(ASSUME `&0 < a pow 2`) THEN + CONV_TAC REAL_FIELD);; + +(* inverse-order swap: 0 inv d1<=c*inv d2. *) +let INV_LE_MUL_INV = prove + (`!d1 d2 c. &0 < d1 /\ &0 < d2 /\ &0 < c /\ d2 <= c * d1 ==> inv d1 <= c * inv + d2`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `~(d1 = &0) /\ ~(d2 = &0)` STRIP_ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `inv d1 <= c * inv d2 <=> inv d1 * (d1 * d2) <= (c * inv d2) * (d1 * d2)` + SUBST1_TAC THENL + [MATCH_MP_TAC(GSYM REAL_LE_RMUL_EQ) THEN MATCH_MP_TAC REAL_LT_MUL THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + MP_TAC(REAL_FIELD `~(d1 = &0) /\ ~(d2 = &0) + ==> inv d1 * d1 * d2 = d2 /\ (c * inv d2) * d1 * d2 = c * d1`) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(CONJUNCTS_THEN SUBST1_TAC) THEN + ASM_REWRITE_TAC[]);; + +(* monotone denominator: 0

inv(q+r)<=inv(p+r). *) +let INV_ADD_MONO = prove + (`!p q r. &0 < p /\ p <= q /\ &0 <= r ==> inv(q + r) <= inv(p + r)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REAL_ARITH_TAC);; + +(* POISSON_UNIF_BOUND: uniform (all-m via global bounds) modulus dominator. *) +let POISSON_UNIF_BOUND = prove + (`!(h:real->complex) zeta a b x y alo ahi bhi gam. + schwartz h /\ &0 < alo /\ alo <= a /\ a <= ahi /\ abs b <= bhi /\ + &0 <= gam /\ (!t. norm(fourier h t) <= gam * inv(&1 + t pow 2)) + ==> norm(cexp(ii * Cx(x/a) * Cx y) * + fourier (carleson_modulate b (carleson_dilate a h)) y * + Cx(carleson_theta zeta y)) + <= gam * ahi * (&2 + (alo pow 2 + &2 * bhi pow 2) / alo pow 2) * + inv(alo pow 2 + y pow 2)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&0 < a` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `inv a * norm(fourier h ((y - b)/a))` THEN CONJ_TAC THENL + [MATCH_MP_TAC MODULUS_LE_INVA_FHAT THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `inv a * (gam * inv(&1 + ((y - b)/a) pow 2)):real` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN + ASM_SIMP_TAC[REAL_LE_INV_EQ; REAL_LT_IMP_LE]; ALL_TAC] THEN + ASM_SIMP_TAC[INVA_ENVELOPE_POISSON] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `gam * ahi * inv(alo pow 2 + (y - b) pow 2):real` THEN + CONJ_TAC THENL + [SUBGOAL_THEN + `&0 < alo pow 2 + (y - b) pow 2 /\ &0 < a pow 2 + (y - b) pow 2` + STRIP_ASSUME_TAC THENL + [MP_TAC(SPEC `y - b:real` REAL_LE_POW_2) THEN + MP_TAC(SPECL [`alo:real`; `2`] REAL_POW_LT) THEN + MP_TAC(SPECL [`a:real`; `2`] REAL_POW_LT) THEN + ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `a * inv(alo pow 2 + (y - b) pow 2):real` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC INV_ADD_MONO THEN REPEAT CONJ_TAC THENL + [MP_TAC(SPECL [`alo:real`; `2`] REAL_POW_LT) THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_POW_LE2 THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[REAL_LE_POW_2]]; + MATCH_MP_TAC REAL_LE_RMUL THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_LE_INV_EQ] THEN ASM_REAL_ARITH_TAC]]; ALL_TAC] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `alo:real` THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC INV_LE_MUL_INV THEN REPEAT CONJ_TAC THENL + [MP_TAC(SPEC `y - b:real` REAL_LE_POW_2) THEN + MP_TAC(SPECL [`alo:real`; `2`] REAL_POW_LT) THEN + ASM_REAL_ARITH_TAC; + MP_TAC(SPEC `y:real` REAL_LE_POW_2) THEN + MP_TAC(SPECL [`alo:real`; `2`] REAL_POW_LT) THEN + ASM_REAL_ARITH_TAC; + MP_TAC(SPEC `bhi:real` REAL_LE_POW_2) THEN + MP_TAC(SPECL [`alo:real`; `2`] REAL_POW_LT) THEN + SUBGOAL_THEN `&0 <= (alo pow 2 + &2 * bhi pow 2) / alo pow 2` MP_TAC THENL + [MATCH_MP_TAC REAL_LE_DIV THEN MP_TAC(SPEC `bhi:real` REAL_LE_POW_2) THEN + MP_TAC(SPEC `alo:real` REAL_LE_POW_2) THEN + ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REAL_ARITH_TAC; + MP_TAC(ISPECL [`alo:real`; `bhi:real`; `y:real`; + `b:real`] DENOM_UNIF_COMPARE) THEN + ASM_REWRITE_TAC[]]);; + +(* the b-free dominator K*inv(alo^2+y^2) is integrable on the whole line *) +(* (alo>0). *) +let DOMINATOR_VEC_INTEGRABLE = prove + (`!K alo. &0 < alo + ==> (\w:real^1. lift(K * inv(alo pow 2 + drop w pow 2))) integrable_on + (:real^1)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[LIFT_CMUL] THEN MATCH_MP_TAC INTEGRABLE_CMUL THEN + SUBGOAL_THEN `&0 < alo pow 2` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_POW_LT THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL [`(alo:real) pow 2`; + `&0:real`] INV_SHIFT_SCALE_INTEGRABLE) THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[REAL_INTEGRABLE_ON; IMAGE_LIFT_UNIV; o_DEF; REAL_SUB_RZERO; + LIFT_DROP]);; + +(* FREMLIN_WINDOW_INTEGRAL_LIM: the DCT integral-limit for Fremlin's window *) +(* (theta_zeta a FIXED weight, hhat dilated). As (a_m,b_m,x_m)->(a0,b0,x0) *) +(* [a0>0], *) +(* int cexp(ii(x_m/a_m)y)(M_{b_m}D_{a_m}h)hat(y)theta_zeta(y) -> the *) +(* a0/b0/x0 one. *) +(* Core DOMINATED_CONVERGENCE, EMPTY exceptional set (theta_zeta fixed => *) +(* pointwise *) +(* everywhere via FREMLIN_INTEGRAND_LIM), uniform all-m dominator via *) +(* AMD_SEQ_ *) +(* GLOBAL_BOUNDS + FHAT_QUAD_ENVELOPE + POISSON_UNIF_BOUND. The hardest *) +(* 286S(a) *) +(* brick. *) +let FREMLIN_WINDOW_INTEGRAL_LIM = prove + (`!(h:real->complex) (aseq:num->real) bseq xseq alpha0 beta0 x0 zeta. + schwartz h /\ &0 < alpha0 /\ + (aseq ---> alpha0) sequentially /\ (bseq ---> beta0) sequentially /\ + (xseq ---> x0) sequentially /\ (!m. &0 < aseq m) + ==> ((\m. integral (:real^1) (\w. cexp(ii * Cx(xseq m / aseq m) * Cx(drop + w)) * + fourier (carleson_modulate (bseq m) (carleson_dilate (aseq + m) h)) (drop w) * + Cx(carleson_theta zeta (drop w)))) + --> integral (:real^1) (\w. cexp(ii * Cx(x0 / alpha0) * Cx(drop w)) * + fourier (carleson_modulate beta0 (carleson_dilate alpha0 + h)) (drop w) * + Cx(carleson_theta zeta (drop w)))) sequentially`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`aseq:num->real`; `bseq:num->real`; `alpha0:real`; + `beta0:real`] + AMD_SEQ_GLOBAL_BOUNDS) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `alo:real` (X_CHOOSE_THEN `ahi:real` + (X_CHOOSE_THEN `bhi:real` STRIP_ASSUME_TAC))) THEN + MP_TAC(ISPEC `h:real->complex` FHAT_QUAD_ENVELOPE) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `gam:real` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL + [`\(m:num) (w:real^1). cexp(ii * Cx(xseq m / aseq m) * Cx(drop w)) * + fourier (carleson_modulate (bseq m) (carleson_dilate (aseq m) + h)) (drop w) * + Cx(carleson_theta zeta (drop w))`; + `\w:real^1. cexp(ii * Cx(x0 / alpha0) * Cx(drop w)) * + fourier (carleson_modulate beta0 (carleson_dilate alpha0 h)) + (drop w) * + Cx(carleson_theta zeta (drop w))`; + `\w:real^1. lift(gam * ahi * (&2 + (alo pow 2 + &2 * bhi pow 2) / alo pow + 2) * + inv(alo pow 2 + drop w pow 2))`; + `(:real^1)`] + DOMINATED_CONVERGENCE) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + SUBGOAL_THEN + `(\w:real^1. cexp(ii * Cx(xseq (k:num) / aseq k) * Cx(drop w)) * + fourier (carleson_modulate (bseq k) (carleson_dilate (aseq k) h)) + (drop w) * + Cx(carleson_theta zeta (drop w))) = + (\w:real^1. cexp(ii * Cx(xseq k / aseq k) * Cx(drop w)) * + (\u:real^1. fourier (carleson_modulate (bseq k) (carleson_dilate + (aseq k) h)) (drop u) * + Cx(carleson_theta zeta (drop u))) w)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; COMPLEX_MUL_ASSOC]; ALL_TAC] THEN + MATCH_MP_TAC CEXP_MODULATE_ABSINT_GEN THEN + MATCH_MP_TAC CARLESON_MODDIL_WINDOW_ABSINT THEN + ASM_SIMP_TAC[REAL_LT_IMP_NZ]; + SUBGOAL_THEN + `(\w:real^1. lift(gam * ahi * (&2 + (alo pow 2 + &2 * bhi pow 2) / alo + pow 2) * + inv(alo pow 2 + drop w pow 2))) = + (\w:real^1. lift((gam * ahi * (&2 + (alo pow 2 + &2 * bhi pow 2) / alo + pow 2)) * + inv(alo pow 2 + drop w pow 2)))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; REAL_MUL_ASSOC]; ALL_TAC] THEN + MATCH_MP_TAC DOMINATOR_VEC_INTEGRABLE THEN ASM_REWRITE_TAC[]; + MAP_EVERY X_GEN_TAC [`m:num`; `w:real^1`] THEN DISCH_TAC THEN + BETA_TAC THEN + REWRITE_TAC[LIFT_DROP] THEN + MP_TAC(ISPECL [`h:real->complex`; `zeta:real`; `aseq(m:num):real`; + `bseq(m:num):real`; + `xseq(m:num):real`; `drop(w:real^1)`; `alo:real`; + `ahi:real`; + `bhi:real`; `gam:real`] POISSON_UNIF_BOUND) THEN + ASM_SIMP_TAC[]; + X_GEN_TAC `w:real^1` THEN DISCH_TAC THEN BETA_TAC THEN + MATCH_MP_TAC FREMLIN_INTEGRAND_LIM THEN ASM_REWRITE_TAC[]]; + DISCH_THEN(MP_TAC o CONJUNCT2) THEN REWRITE_TAC[]]);; + +(* FREMLIN_WINDOW_JOINT_CONT: the amd z-window *) +(* V_zeta(a,b,x)=2pi*norm(fourier *) +(* ((M_bD_a h)hat . theta_zeta)(-x/a)) is jointly sequentially continuous in *) +(* (a,b,x). *) +(* Wraps FREMLIN_WINDOW_INTEGRAL_LIM via FOURIER_AT_NEG + NORM_SEQ_REALLIM + *) +(* REALLIM_LMUL (the 2pi/sqrt(2pi) constant). Fremlin's window: theta_zeta a *) +(* FIXED *) +(* weight => NO dyadic gate; the correct object for the amd *) +(* sup-LSC/measurability. *) +let FREMLIN_WINDOW_JOINT_CONT = prove + (`!(h:real->complex) (aseq:num->real) bseq xseq alpha0 beta0 x0 zeta. + schwartz h /\ &0 < alpha0 /\ + (aseq ---> alpha0) sequentially /\ (bseq ---> beta0) sequentially /\ + (xseq ---> x0) sequentially /\ (!m. &0 < aseq m) + ==> ((\m. &2 * pi * norm(fourier(\w. fourier (carleson_modulate (bseq m) + (carleson_dilate (aseq m) h)) w * + Cx(carleson_theta zeta w))(--(xseq m / aseq m)))) + ---> &2 * pi * norm(fourier(\w. fourier (carleson_modulate beta0 + (carleson_dilate alpha0 h)) w * + Cx(carleson_theta zeta w))(--(x0 / alpha0)))) + sequentially`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[FOURIER_AT_NEG] THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX] THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN + ONCE_REWRITE_TAC[REAL_ARITH `(&2 * pi) * c * n = ((&2 * pi) * c) * n:real`] + THEN + MATCH_MP_TAC REALLIM_LMUL THEN + MATCH_MP_TAC NORM_SEQ_REALLIM THEN + MATCH_MP_TAC FREMLIN_WINDOW_INTEGRAL_LIM THEN ASM_REWRITE_TAC[]);; + +(* unfolded amd sup-rep matching FREMLIN_WINDOW_JOINT_CONT's window *) +(* (theta_zeta a *) +(* FIXED weight): amd h a b x = sup_zeta [2pi*norm(fourier((M_bD_a h)hat *) +(* theta_zeta) *) +(* (-x/a))]. Directly carleson_A(M_bD_a h)(x/a) unfolded, *) +(* norm(Cx2pi*W)=2pi*norm W. *) +let CARLESON_AMD_SUP_WINDOW_UNFOLD = prove + (`!(h:real->complex) a b x. + carleson_amd h a b x = + sup { &2 * pi * norm(fourier(\w. fourier (carleson_modulate b + (carleson_dilate a h)) w * + Cx(carleson_theta zeta w))(--(x/a))) + | zeta IN (:real) }`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN + `!zeta. norm(Cx(&2 * pi) * + fourier(\y. fourier (carleson_modulate b (carleson_dilate a h)) + y * + Cx(carleson_theta zeta y))(--(x/a))) + = &2 * pi * norm(fourier(\w. fourier (carleson_modulate b + (carleson_dilate a h)) w * + Cx(carleson_theta zeta w))(--(x/a)))` + ASSUME_TAC THENL + [GEN_TAC THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX; REAL_ABS_MUL; REAL_ABS_NUM; + REAL_ABS_PI] THEN + MP_TAC PI_POS THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN + REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[carleson_amd; carleson_A] THEN AP_TERM_TAC THEN + ASM_REWRITE_TAC[]);; + +(* V_zeta as a real^3->real^1 function is continuous_on the open half-space *) +(* {a>0}. *) +(* Bridges FREMLIN_WINDOW_JOINT_CONT (sequential) to continuous_on via *) +(* CONTINUOUS_ON_SEQUENTIALLY + componentwise limits *) +(* (LIM_COMPONENTWISE_REAL). *) +(* The (a,b,x) point is encoded as p:real^3 with p$1=a, p$2=b, p$3=x. This *) +(* feeds *) +(* the LSC/measurability of amd = sup_zeta V_zeta. *) +let VZETA_CONTINUOUS_ON = prove + (`!(h:real->complex) zeta. schwartz h + ==> (\p:real^3. lift(&2 * pi * norm(fourier(\w. fourier (carleson_modulate + (p$2) (carleson_dilate (p$1) h)) w * + Cx(carleson_theta zeta w))(--(p$3 / p$1))))) + continuous_on {p:real^3 | p$1 > &0}`, + REPEAT STRIP_TAC THEN REWRITE_TAC[CONTINUOUS_ON_SEQUENTIALLY] THEN + MAP_EVERY X_GEN_TAC [`xs:num->real^3`; `p:real^3`] THEN + REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN + REWRITE_TAC[o_DEF] THEN REWRITE_TAC[GSYM LIFT_CMUL] THEN + SUBGOAL_THEN + `(\x. lift(&2 * pi * norm(fourier(\w. fourier (carleson_modulate + ((xs:num->real^3) x$2) (carleson_dilate (xs x$1) h)) w * + Cx(carleson_theta zeta w))(--(xs x$3 / xs x$1))))) + = (lift o (\x. &2 * pi * norm(fourier(\w. fourier (carleson_modulate + ((xs:num->real^3) x$2) (carleson_dilate (xs x$1) h)) w * + Cx(carleson_theta zeta w))(--(xs x$3 / xs x$1)))))` + SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN + REWRITE_TAC[GSYM TENDSTO_REAL] THEN + MP_TAC(ISPECL [`h:real->complex`; `\n. (xs:num->real^3) n$1`; + `\n. (xs:num->real^3) n$2`; + `\n. (xs:num->real^3) n$3`; `(p:real^3)$1`; `(p:real^3)$2`; + `(p:real^3)$3`; `zeta:real`] + FREMLIN_WINDOW_JOINT_CONT) THEN + REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_COMPONENTWISE_REAL]) THEN + REWRITE_TAC[DIMINDEX_3; GSYM tendsto_real_def] THEN + DISCH_THEN(fun th -> MP_TAC(SPEC `1` th) THEN MP_TAC(SPEC `2` th) THEN + MP_TAC(SPEC `3` th)) THEN + REWRITE_TAC[ARITH] THEN REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[GSYM real_gt]);; + +(* single-V_zeta superlevel {p$1>0 /\ V_zeta p > c} is open in real^3 *) +(* (continuous on the open half-space {a>0} => open superlevel, *) +(* CONTINUOUS_OPEN_PREIMAGE). *) +let VZETA_SUPERLEVEL_OPEN = prove + (`!(h:real->complex) zeta c. schwartz h + ==> open {p:real^3 | p$1 > &0 /\ + &2 * pi * norm(fourier(\w. fourier (carleson_modulate (p$2) + (carleson_dilate (p$1) h)) w * + Cx(carleson_theta zeta w))(--(p$3 / p$1))) > c}`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`\p:real^3. lift(&2 * pi * norm(fourier(\w. fourier (carleson_modulate + (p$2) (carleson_dilate (p$1) h)) w * + Cx(carleson_theta zeta w))(--(p$3 / p$1))))`; + `{p:real^3 | p$1 > &0}`; + `{t:real^1 | t$1 > c}`] CONTINUOUS_OPEN_PREIMAGE) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[VZETA_CONTINUOUS_ON; OPEN_HALFSPACE_COMPONENT_GT]; + ALL_TAC] THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; GSYM drop; LIFT_DROP] THEN + X_GEN_TAC `p:real^3` THEN REWRITE_TAC[CONJ_ACI]);; + +(* amd sup-characterization: amd h a b x > c <=> some window value > c *) +(* (a>0). From *) +(* CARLESON_AMD_SUP_WINDOW_UNFOLD + REAL_SUP_LE_EQ (nonempty + bounded by *) +(* carleson_A's *) +(* uniform bound), negated. *) +let AMD_SUP_GT = prove + (`!(h:real->complex) a b x c. schwartz h /\ &0 < a + ==> (carleson_amd h a b x > c <=> + ?zeta. &2 * pi * norm(fourier(\w. fourier (carleson_modulate b + (carleson_dilate a h)) w * + Cx(carleson_theta zeta w))(--(x/a))) > c)`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[CARLESON_AMD_SUP_WINDOW_UNFOLD] THEN + REWRITE_TAC[real_gt] THEN + MP_TAC(ISPECL + [`{ &2 * pi * norm(fourier(\w. fourier (carleson_modulate b (carleson_dilate + a h)) w * + Cx(carleson_theta zeta w))(--(x/a))) | zeta IN (:real)}`; + `c:real`] + REAL_SUP_LE_EQ) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + EXISTS_TAC `&2 * pi * norm(fourier(\w. fourier (carleson_modulate b + (carleson_dilate a h)) w * + Cx(carleson_theta (&0) w))(--(x/a)))` THEN + EXISTS_TAC `&0:real` THEN REWRITE_TAC[IN_UNIV]; + EXISTS_TAC `sqrt(&2 * pi) * + drop(integral (:real^1) (\y. lift(norm(fourier + (carleson_modulate b (carleson_dilate a (h:real->complex))) + (drop y)))))` THEN + REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN X_GEN_TAC `zeta:real` THEN + MP_TAC(ISPECL [`carleson_modulate b (carleson_dilate a + (h:real->complex))`; `zeta:real`; `(x/a):real`] + CARLESON_A_WINDOW_UNIFORM_BOUND) THEN + ANTS_TAC THENL + [MATCH_MP_TAC CARLESON_SCHWARTZ_MODDIL THEN + ASM_SIMP_TAC[REAL_LT_IMP_NZ]; ALL_TAC] THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX; REAL_ABS_MUL; + REAL_ABS_NUM; REAL_ABS_PI] THEN + REWRITE_TAC[real_div; REAL_NEG_LMUL; REAL_MUL_ASSOC]]; ALL_TAC] THEN + DISCH_TAC THEN + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_NOT_LE] THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; IN_ELIM_THM; IN_UNIV; REAL_NOT_LE] THEN + MESON_TAC[]);; + +(* AMD_JOINT_LSC: the amd kernel (real^3->real^1, junk 0 for a<=0) is *) +(* measurable_on *) +(* (:real^3). amd = sup_zeta V_zeta, each V_zeta continuous on {a>0}, so amd *) +(* is LSC: *) +(* c<0 => superlevel = everything (amd>=0); c>=0 => UNIONS_zeta of the open *) +(* V_zeta- *) +(* superlevels (AMD_SUP_GT + VZETA_SUPERLEVEL_OPEN). MEASURABLE_ON_LSC_MULTI *) +(* closes. *) +let AMD_JOINT_LSC = prove + (`!(h:real->complex). schwartz h + ==> (\p:real^3. lift(if p$1 > &0 then carleson_amd h (p$1) (p$2) (p$3) else + &0)) + measurable_on (:real^3)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_ON_LSC_MULTI THEN + X_GEN_TAC `c:real` THEN REWRITE_TAC[LIFT_DROP] THEN + ASM_CASES_TAC `c < &0` THENL + [SUBGOAL_THEN + `{x:real^3 | (if x$1 > &0 then carleson_amd h (x$1) (x$2) (x$3) else &0) > + c} = (:real^3)` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_UNIV] THEN + X_GEN_TAC `p:real^3` THEN COND_CASES_TAC THEN REWRITE_TAC[real_gt] THENL + [MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&0` THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC AMD_NONNEG THEN ASM_REWRITE_TAC[GSYM real_gt]; + ASM_REAL_ARITH_TAC]; + REWRITE_TAC[OPEN_UNIV]]; + SUBGOAL_THEN + `{x:real^3 | (if x$1 > &0 then carleson_amd h (x$1) (x$2) (x$3) else &0) > + c} = + UNIONS { {p:real^3 | p$1 > &0 /\ + &2 * pi * norm(fourier(\w. fourier (carleson_modulate (p$2) + (carleson_dilate (p$1) h)) w * + Cx(carleson_theta zeta w))(--(p$3 / p$1))) > c} + | zeta IN (:real) }` + SUBST1_TAC THENL + [REWRITE_TAC[UNIONS_GSPEC; EXTENSION; IN_ELIM_THM; IN_UNIV] THEN + X_GEN_TAC `p:real^3` THEN COND_CASES_TAC THENL + [MP_TAC(ISPECL [`h:real->complex`; `(p:real^3)$1`; `(p:real^3)$2`; + `(p:real^3)$3`; `c:real`] + AMD_SUP_GT) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[GSYM real_gt]; ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[real_gt] THEN ASM_REAL_ARITH_TAC]; + MATCH_MP_TAC OPEN_UNIONS THEN + REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN + X_GEN_TAC `zeta:real` THEN + MATCH_MP_TAC VZETA_SUPERLEVEL_OPEN THEN ASM_REWRITE_TAC[]]]);; + +(* ========================================================================= *) +(* 286S(b) box-Tonelli, step 1: transfer AMD_JOINT_LSC (measurable on *) +(* real^3) to the *) +(* product type real^(1,2)finite_sum via the linear coordinate SHUFFLE g: *) +(* g z = vector[sndcart z$1; sndcart z$2; fstcart z$1] (alpha=sndcart$1, *) +(* beta= *) +(* sndcart$2, x=fstcart$1). This is the joint measurability the Fubini swap *) +(* needs. *) +(* ========================================================================= *) + +(* the coordinate shuffle g is linear + injective. *) +let MODDIL_FHAT_L1 = prove + (`!(h:real->complex) a b. schwartz h /\ &0 < a + ==> integral (:real^1) (\w. lift(norm(fourier (carleson_modulate b + (carleson_dilate a h)) (drop w)))) = + integral (:real^1) (\w. lift(norm(fourier h (drop w))))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `~(a = &0)` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `(\w:real^1. lift(norm(fourier (carleson_modulate b (carleson_dilate a h)) + (drop w)))) = + (\w:real^1. inv a % (\u:real^1. lift(norm(fourier h (drop u)))) (inv a % w + + lift(--(b/a))))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `w:real^1` THEN + ASM_SIMP_TAC[CARLESON_MODDIL_FHAT] THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX] THEN + REWRITE_TAC[DROP_CMUL; DROP_ADD; LIFT_DROP; LIFT_CMUL] THEN + SUBGOAL_THEN `abs(&1 / a) = inv a` SUBST1_TAC THENL + [REWRITE_TAC[real_div; REAL_MUL_LID; REAL_ABS_INV] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < a ==> abs a = a`]; ALL_TAC] THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + UNDISCH_TAC `~(a = &0)` THEN CONV_TAC REAL_FIELD; ALL_TAC] THEN + SUBGOAL_THEN + `(\u:real^1. lift(norm(fourier (h:real->complex) (drop u)))) integrable_on + (:real^1)` + ASSUME_TAC THENL + [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN + MP_TAC(ISPEC `h:real->complex` SCHWARTZ_FHAT_ABSINT) THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `(\w:real^1. (\u:real^1. lift (norm (fourier (h:real->complex) (drop u)))) + (inv a % w + lift (--(b / a)))) integrable_on (:real^1)` + ASSUME_TAC THENL + [MP_TAC(ISPECL [`\u:real^1. lift(norm(fourier (h:real->complex) (drop u)))`; + `inv a:real`; `lift(--(b/a))`] INTEGRABLE_DILATE_UNIV) THEN + ASM_SIMP_TAC[REAL_INV_EQ_0; REAL_LT_IMP_NZ]; ALL_TAC] THEN + ASM_SIMP_TAC[INTEGRAL_CMUL] THEN + MP_TAC(BETA_RULE(ISPECL [`\u:real^1. lift(norm(fourier (h:real->complex) + (drop u)))`; + `inv a:real`; `lift(--(b/a))`] INTEGRAL_DILATE_UNIV)) THEN + ASM_SIMP_TAC[REAL_INV_EQ_0; REAL_LT_IMP_NZ] THEN + DISCH_THEN SUBST1_TAC THEN + SUBGOAL_THEN `inv(abs(inv a)) = a` SUBST1_TAC THENL + [REWRITE_TAC[REAL_ABS_INV; REAL_INV_INV] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < a ==> abs a = a`]; ALL_TAC] THEN + REWRITE_TAC[VECTOR_MUL_ASSOC] THEN + ASM_SIMP_TAC[REAL_MUL_LINV; REAL_LT_IMP_NZ; VECTOR_MUL_LID]);; + +(* Uniform constant bound on the amd kernel, independent of (a>0, b, x). *) +let AMD_UNIF_BOUND = prove + (`!(h:real->complex) a b x. schwartz h /\ &0 < a + ==> carleson_amd h a b x + <= sqrt(&2 * pi) * drop(integral (:real^1) (\y. lift(norm(fourier + (h:real->complex) (drop y)))))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[carleson_amd] THEN + MP_TAC(ISPECL [`carleson_modulate b (carleson_dilate a (h:real->complex))`; + `x / a:real`] + CARLESON_A_UNIFORM_BOUND) THEN + ANTS_TAC THENL + [MATCH_MP_TAC CARLESON_SCHWARTZ_MODDIL THEN + ASM_SIMP_TAC[REAL_LT_IMP_NZ]; ALL_TAC] THEN + ASM_SIMP_TAC[MODDIL_FHAT_L1]);; + +(* ========================================================================= *) +(* Iterated-product measurability of the amd kernel, for the box-Tonelli *) +(* swap. *) +(* The type real^(1,(1,1)finite_sum)finite_sum = R x (R x R) lets BOTH the *) +(* outer swap x <-> (alpha,beta) AND the inner alpha <-> beta split be *) +(* direct *) +(* finite_sum library Fubinis. We transfer AMD_JOINT_LSC (on real^3) along *) +(* the *) +(* linear+bijective coordinate shuffle *) +(* g z = vector[drop(fstcart(sndcart z)); drop(sndcart(sndcart z)); *) +(* drop(fstcart z)], *) +(* i.e. alpha=fstcart(sndcart z), beta=sndcart(sndcart z), x=fstcart z. *) +(* ------------------------------------------------------------------------- *) +(* the iterated shuffle is linear + injective. *) +let AMDT_SHUFFLE_LINEAR = prove + (`linear (\z:real^(1,(1,1)finite_sum)finite_sum. + vector[drop(fstcart(sndcart z)); drop(sndcart(sndcart z)); + drop(fstcart z)]:real^3) /\ + (!u v:real^(1,(1,1)finite_sum)finite_sum. + (\z. vector[drop(fstcart(sndcart z)); drop(sndcart(sndcart z)); + drop(fstcart z)]:real^3) u = + (\z. vector[drop(fstcart(sndcart z)); drop(sndcart(sndcart z)); + drop(fstcart z)]:real^3) v ==> u = v)`, + CONJ_TAC THENL + [REWRITE_TAC[linear] THEN CONJ_TAC THEN REPEAT GEN_TAC THEN + REWRITE_TAC[CART_EQ; DIMINDEX_3; FORALL_3; VECTOR_3] THEN + SIMP_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; VECTOR_3; DIMINDEX_3; + ARITH] THEN + REWRITE_TAC[FSTCART_ADD; SNDCART_ADD; FSTCART_CMUL; SNDCART_CMUL; + DROP_ADD; DROP_CMUL] THEN REWRITE_TAC[VECTOR_3] THEN + REAL_ARITH_TAC; + REPEAT GEN_TAC THEN REWRITE_TAC[] THEN DISCH_TAC THEN + SUBGOAL_THEN + `drop(fstcart(sndcart(u:real^(1,(1,1)finite_sum)finite_sum))) = + drop(fstcart(sndcart v)) /\ + drop(sndcart(sndcart u)) = drop(sndcart(sndcart v)) /\ + drop(fstcart u) = drop(fstcart v)` + STRIP_ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC) THEN + REWRITE_TAC[CART_EQ; DIMINDEX_3; FORALL_3; VECTOR_3] THEN + SIMP_TAC[]; ALL_TAC] THEN + ONCE_REWRITE_TAC[PASTECART_EQ] THEN CONJ_TAC THENL + [ONCE_REWRITE_TAC[GSYM DROP_EQ] THEN ASM_REWRITE_TAC[]; + ONCE_REWRITE_TAC[PASTECART_EQ] THEN CONJ_TAC THEN + ONCE_REWRITE_TAC[GSYM DROP_EQ] THEN ASM_REWRITE_TAC[]]]);; + +(* image of UNIV under the (bijective) iterated shuffle is UNIV. *) +let AMDT_SHUFFLE_IMAGE = prove + (`IMAGE (\z:real^(1,(1,1)finite_sum)finite_sum. + vector[drop(fstcart(sndcart z)); drop(sndcart(sndcart z)); + drop(fstcart z)]:real^3) + (:real^(1,(1,1)finite_sum)finite_sum) = (:real^3)`, + REWRITE_TAC[EXTENSION; IN_IMAGE; IN_UNIV] THEN X_GEN_TAC `p:real^3` THEN + EXISTS_TAC + `pastecart (lift((p:real^3)$3)) + (pastecart (lift((p:real^3)$1)) (lift((p:real^3)$2)) + :real^(1,1)finite_sum) + :real^(1,(1,1)finite_sum)finite_sum` THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; LIFT_DROP] THEN + REWRITE_TAC[CART_EQ; DIMINDEX_3; FORALL_3; VECTOR_3; LIFT_COMPONENT]);; + +(* pre-specialized measurability bridge for the iterated shuffle (hh *) +(* general). *) +let MEAS_SHUFFLE_T = prove + (`!hh:real^3->real^1. + (hh o (\z:real^(1,(1,1)finite_sum)finite_sum. + vector[drop(fstcart(sndcart z)); drop(sndcart(sndcart z)); + drop(fstcart z)]:real^3)) + measurable_on (:real^(1,(1,1)finite_sum)finite_sum) + <=> hh measurable_on (:real^3)`, + GEN_TAC THEN + MP_TAC(ISPECL + [`\z:real^(1,(1,1)finite_sum)finite_sum. + vector[drop(fstcart(sndcart z)); drop(sndcart(sndcart z)); + drop(fstcart z)]:real^3`; + `hh:real^3->real^1`; + `(:real^(1,(1,1)finite_sum)finite_sum)`] + MEASURABLE_ON_LINEAR_IMAGE_EQ_GEN) THEN + REWRITE_TAC[AMDT_SHUFFLE_LINEAR; DIMINDEX_FINITE_SUM; DIMINDEX_1; DIMINDEX_3; + ARITH] THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[AMDT_SHUFFLE_IMAGE]);; + +(* the amd kernel measurable on the ITERATED product type *) +(* real^(1,(1,1)fs)fs. *) +let AMDT_PROD_MEASURABLE = prove + (`!(h:real->complex). schwartz h + ==> (\z:real^(1,(1,1)finite_sum)finite_sum. + lift(if drop(fstcart(sndcart z)) > &0 + then carleson_amd h (drop(fstcart(sndcart z))) + (drop(sndcart(sndcart z))) (drop(fstcart z)) + else &0)) + measurable_on (:real^(1,(1,1)finite_sum)finite_sum)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\z:real^(1,(1,1)finite_sum)finite_sum. + lift(if drop(fstcart(sndcart z)) > &0 + then carleson_amd h (drop(fstcart(sndcart z))) + (drop(sndcart(sndcart z))) (drop(fstcart z)) + else &0)) + = (\p:real^3. lift(if p$1 > &0 then carleson_amd h (p$1)(p$2)(p$3) else + &0)) o + (\z:real^(1,(1,1)finite_sum)finite_sum. + vector[drop(fstcart(sndcart z)); drop(sndcart(sndcart z)); + drop(fstcart z)]:real^3)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; o_THM] THEN + X_GEN_TAC `z:real^(1,(1,1)finite_sum)finite_sum` THEN + REWRITE_TAC[VECTOR_3]; ALL_TAC] THEN + REWRITE_TAC[MEAS_SHUFFLE_T] THEN + MATCH_MP_TAC AMD_JOINT_LSC THEN ASM_REWRITE_TAC[]);; + +(* the alpha-coordinate scalar drop(fstcart(sndcart z)) on the iterated *) +(* type, and its inverse (with the negligible alpha=0 hyperplane), are *) +(* measurable. *) +let AMDT_ALPHA_MEASURABLE = prove + (`(\z:real^(1,(1,1)finite_sum)finite_sum. lift(drop(fstcart(sndcart z)))) + measurable_on (:real^(1,(1,1)finite_sum)finite_sum)`, + REWRITE_TAC[LIFT_DROP; ETA_AX] THEN + MATCH_MP_TAC CONTINUOUS_IMP_MEASURABLE_ON THEN + MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN + SUBGOAL_THEN + `(\z:real^(1,(1,1)finite_sum)finite_sum. fstcart(sndcart z)) = + (fstcart:real^(1,1)finite_sum->real^1) o + (sndcart:real^(1,(1,1)finite_sum)finite_sum->real^(1,1)finite_sum)` + SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN + MATCH_MP_TAC LINEAR_COMPOSE THEN + REWRITE_TAC[LINEAR_FSTCART; LINEAR_SNDCART]);; + +(* alpha = drop(fstcart(sndcart z)) is exactly the z$2 coordinate. *) +let AMDT_ALPHA_EQ_C2 = prove + (`!z:real^(1,(1,1)finite_sum)finite_sum. drop(fstcart(sndcart z)) = z$2`, + GEN_TAC THEN REWRITE_TAC[drop] THEN + SUBGOAL_THEN + `fstcart(sndcart(z:real^(1,(1,1)finite_sum)finite_sum))$1 = sndcart z$1` + SUBST1_TAC THENL + [MATCH_MP_TAC FSTCART_COMPONENT THEN + REWRITE_TAC[DIMINDEX_1; LE_REFL]; ALL_TAC] THEN + SUBGOAL_THEN + `sndcart(z:real^(1,(1,1)finite_sum)finite_sum)$1 = z$(1 + dimindex(:1))` + SUBST1_TAC THENL + [MATCH_MP_TAC SNDCART_COMPONENT THEN + REWRITE_TAC[DIMINDEX_FINITE_SUM; DIMINDEX_1; ARITH]; ALL_TAC] THEN + REWRITE_TAC[DIMINDEX_1] THEN CONV_TAC NUM_REDUCE_CONV);; + +(* the alpha-zero-set is the negligible standard hyperplane {z$2 = 0}. *) +let AMDT_ALPHA_HYP_NEG = prove + (`negligible {z:real^(1,(1,1)finite_sum)finite_sum | drop(fstcart(sndcart z)) + = &0}`, + REWRITE_TAC[AMDT_ALPHA_EQ_C2; NEGLIGIBLE_STANDARD_HYPERPLANE]);; + +(* inv(alpha) is measurable on the iterated type. *) +let AMDT_INV_ALPHA_MEASURABLE = prove + (`(\z:real^(1,(1,1)finite_sum)finite_sum. lift(inv(drop(fstcart(sndcart z))))) + measurable_on (:real^(1,(1,1)finite_sum)finite_sum)`, + MATCH_MP_TAC MEASURABLE_ON_LIFT_INV THEN + REWRITE_TAC[AMDT_ALPHA_MEASURABLE] THEN + MP_TAC AMDT_ALPHA_HYP_NEG THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_UNIV]);; + +(* the box F x [1,2] x [0,n] on the iterated type is lebesgue_measurable *) +(* (= lift-FF PCROSS interval-box, all factors measurable). *) +let CARLESON_BOX_MEASURABLE = prove + (`!FF n. real_measurable FF + ==> lebesgue_measurable + {z:real^(1,(1,1)finite_sum)finite_sum | + drop(fstcart z) IN FF /\ + &1 <= drop(fstcart(sndcart z)) /\ drop(fstcart(sndcart z)) <= &2 /\ + &0 <= drop(sndcart(sndcart z)) /\ drop(sndcart(sndcart z)) <= &n}`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `{z:real^(1,(1,1)finite_sum)finite_sum | + drop(fstcart z) IN FF /\ + &1 <= drop(fstcart(sndcart z)) /\ drop(fstcart(sndcart z)) <= &2 /\ + &0 <= drop(sndcart(sndcart z)) /\ drop(sndcart(sndcart z)) <= &n} = + (IMAGE lift FF) PCROSS + ((interval[lift(&1),lift(&2)]) PCROSS (interval[lift(&0),lift(&n)]))` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; FORALL_PASTECART; PASTECART_IN_PCROSS; IN_ELIM_THM; + FSTCART_PASTECART; SNDCART_PASTECART; IN_IMAGE_LIFT_DROP; + IN_INTERVAL_1] THEN + REWRITE_TAC[LIFT_DROP] THEN CONV_TAC TAUT; ALL_TAC] THEN + SUBGOAL_THEN `lebesgue_measurable(IMAGE lift FF)` ASSUME_TAC THENL + [REWRITE_TAC[GSYM REAL_LEBESGUE_MEASURABLE] THEN + MATCH_MP_TAC REAL_MEASURABLE_IMP_REAL_LEBESGUE_MEASURABLE THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_SIMP_TAC[LEBESGUE_MEASURABLE_PCROSS; LEBESGUE_MEASURABLE_INTERVAL]);; + +(* the box-restricted (1/alpha)-weighted amd kernel is MEASURABLE (RESTRICT *) +(* of the product inv(alpha)*amd to the lebesgue-measurable box). *) +let AMDT_BOX_KERNEL_MEAS = prove + (`!(h:real->complex) FF n. schwartz h /\ real_measurable FF + ==> (\z:real^(1,(1,1)finite_sum)finite_sum. + if drop(fstcart z) IN FF /\ + &1 <= drop(fstcart(sndcart z)) /\ drop(fstcart(sndcart z)) <= &2 + /\ + &0 <= drop(sndcart(sndcart z)) /\ drop(sndcart(sndcart z)) <= &n + then lift(inv(drop(fstcart(sndcart z))) * + (if drop(fstcart(sndcart z)) > &0 + then carleson_amd h (drop(fstcart(sndcart z))) + (drop(sndcart(sndcart z))) + (drop(fstcart z)) + else &0)) + else vec 0) + measurable_on (:real^(1,(1,1)finite_sum)finite_sum)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`\z:real^(1,(1,1)finite_sum)finite_sum. + lift(inv(drop(fstcart(sndcart z))) * + (if drop(fstcart(sndcart z)) > &0 + then carleson_amd h (drop(fstcart(sndcart z))) + (drop(sndcart(sndcart z))) (drop(fstcart z)) + else &0))`; + `{z:real^(1,(1,1)finite_sum)finite_sum | + drop(fstcart z) IN FF /\ + &1 <= drop(fstcart(sndcart z)) /\ drop(fstcart(sndcart z)) <= &2 /\ + &0 <= drop(sndcart(sndcart z)) /\ drop(sndcart(sndcart z)) <= &n}`] + MEASURABLE_ON_RESTRICT) THEN + REWRITE_TAC[IN_ELIM_THM] THEN + DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_ON_LIFT_MUL THEN + REWRITE_TAC[AMDT_INV_ALPHA_MEASURABLE] THEN + MP_TAC(ISPEC `h:real->complex` AMDT_PROD_MEASURABLE) THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC CARLESON_BOX_MEASURABLE THEN ASM_REWRITE_TAC[]]);; + +(* the box kernel is ABSOLUTELY INTEGRABLE: dominated by the constant *) +(* K = sqrt(2pi) int|hhat| on the finite-measure box (AMD_UNIF_BOUND, and *) +(* inv(alpha)<=1 for alpha>=1); the dominator K % 1_box is integrable. *) +let AMDT_BOX_ABSINT = prove + (`!(h:real->complex) FF n. schwartz h /\ real_measurable FF + ==> (\z:real^(1,(1,1)finite_sum)finite_sum. + if drop(fstcart z) IN FF /\ + &1 <= drop(fstcart(sndcart z)) /\ drop(fstcart(sndcart z)) <= &2 + /\ + &0 <= drop(sndcart(sndcart z)) /\ drop(sndcart(sndcart z)) <= &n + then lift(inv(drop(fstcart(sndcart z))) * + (if drop(fstcart(sndcart z)) > &0 + then carleson_amd h (drop(fstcart(sndcart z))) + (drop(sndcart(sndcart z))) + (drop(fstcart z)) + else &0)) + else vec 0) + absolutely_integrable_on (:real^(1,(1,1)finite_sum)finite_sum)`, + REPEAT STRIP_TAC THEN + ABBREV_TAC `K = sqrt(&2 * pi) * drop(integral (:real^1) (\y. + lift(norm(fourier (h:real->complex) (drop y)))))` THEN + MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE THEN + EXISTS_TAC + `\z:real^(1,(1,1)finite_sum)finite_sum. + K % indicator + {z:real^(1,(1,1)finite_sum)finite_sum | + drop(fstcart z) IN FF /\ + &1 <= drop(fstcart(sndcart z)) /\ drop(fstcart(sndcart z)) <= &2 /\ + &0 <= drop(sndcart(sndcart z)) /\ drop(sndcart(sndcart z)) <= &n} + z` THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC AMDT_BOX_KERNEL_MEAS THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC INTEGRABLE_CMUL THEN REWRITE_TAC[ETA_AX] THEN + REWRITE_TAC[INTEGRABLE_ON_INDICATOR; INTER_UNIV] THEN + SUBGOAL_THEN + `{z:real^(1,(1,1)finite_sum)finite_sum | + drop(fstcart z) IN FF /\ + &1 <= drop(fstcart(sndcart z)) /\ drop(fstcart(sndcart z)) <= &2 /\ + &0 <= drop(sndcart(sndcart z)) /\ drop(sndcart(sndcart z)) <= &n} = + (IMAGE lift FF) PCROSS + ((interval[lift(&1),lift(&2)]) PCROSS (interval[lift(&0),lift(&n)]))` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; FORALL_PASTECART; PASTECART_IN_PCROSS; + IN_ELIM_THM; + FSTCART_PASTECART; SNDCART_PASTECART; IN_IMAGE_LIFT_DROP; + IN_INTERVAL_1] THEN + REWRITE_TAC[LIFT_DROP] THEN CONV_TAC TAUT; ALL_TAC] THEN + SUBGOAL_THEN `measurable(IMAGE lift FF)` ASSUME_TAC THENL + [REWRITE_TAC[GSYM REAL_MEASURABLE_MEASURABLE] THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_SIMP_TAC[MEASURABLE_PCROSS; MEASURABLE_INTERVAL]; + X_GEN_TAC `z:real^(1,(1,1)finite_sum)finite_sum` THEN + REWRITE_TAC[IN_UNIV] THEN + REWRITE_TAC[indicator; IN_ELIM_THM; DROP_CMUL] THEN + SUBGOAL_THEN `&0 <= K` ASSUME_TAC THENL + [EXPAND_TAC "K" THEN MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC SQRT_POS_LE THEN MP_TAC PI_POS THEN REAL_ARITH_TAC; + MATCH_MP_TAC INTEGRAL_DROP_POS THEN + REWRITE_TAC[LIFT_DROP; NORM_POS_LE] THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN + MP_TAC(ISPEC `h:real->complex` SCHWARTZ_FHAT_ABSINT) THEN + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + COND_CASES_TAC THEN + ASM_REWRITE_TAC[NORM_0; DROP_VEC; REAL_MUL_RZERO; REAL_LE_REFL] THEN + REWRITE_TAC[REAL_MUL_RID; NORM_LIFT] THEN + SUBGOAL_THEN + `drop(fstcart(sndcart(z:real^(1,(1,1)finite_sum)finite_sum))) > &0` + ASSUME_TAC THENL [REWRITE_TAC[real_gt] THEN + ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&1 * carleson_amd h + (drop(fstcart(sndcart(z:real^(1,(1,1)finite_sum)finite_sum)))) + (drop(sndcart(sndcart z))) (drop(fstcart z))` THEN + CONJ_TAC THENL + [REWRITE_TAC[REAL_ABS_MUL] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN + REWRITE_TAC[REAL_ABS_POS] THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[REAL_ABS_INV] THEN MATCH_MP_TAC REAL_INV_LE_1 THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[real_abs] THEN COND_CASES_TAC THEN + REWRITE_TAC[REAL_LE_REFL] THEN + POP_ASSUM MP_TAC THEN + MP_TAC(ISPECL + [`h:real->complex`; + `drop(fstcart(sndcart(z:real^(1,(1,1)finite_sum)finite_sum)))`; + `drop(sndcart(sndcart(z:real^(1,(1,1)finite_sum)finite_sum)))`; + `drop(fstcart(z:real^(1,(1,1)finite_sum)finite_sum))`] + AMD_NONNEG) THEN + ASM_SIMP_TAC[GSYM real_gt] THEN REAL_ARITH_TAC]; + REWRITE_TAC[REAL_MUL_LID] THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC AMD_UNIF_BOUND THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC]]);; + +(* Vector<->real bridge for an outer x-integral restricted to FF: the *) +(* (:real^1) *) +(* integral of (if drop x IN FF then lift(g(drop x)) else 0) is lift of the *) +(* real_integral of g over FF. Reused when peeling the x-in-FF indicator in *) +(* the *) +(* box-Tonelli reassembly (SINNER_INT_F_SWAP). *) +let CARLESON_OUTER_REAL_BRIDGE = prove + (`!(g:real->real) FF. (g real_integrable_on FF) + ==> integral (:real^1) (\x. if drop x IN FF then lift(g(drop x)) else vec 0) + = + lift(real_integral FF g)`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(SUBST1_TAC o MATCH_MP REAL_INTEGRAL) THEN + REWRITE_TAC[LIFT_DROP] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM INTEGRAL_RESTRICT_UNIV] THEN + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:real^1` THEN + REWRITE_TAC[IN_IMAGE_LIFT_DROP; o_THM] THEN + COND_CASES_TAC THEN REWRITE_TAC[]);; + +(* Interval version of the vector<->real bridge (for peeling the a-in-[1,2] *) +(* and b-in-[0,n] interval gates in the box-Tonelli reassembly). *) +let CARLESON_INTERVAL_REAL_BRIDGE = prove + (`!(g:real->real) c d. (g real_integrable_on real_interval[c,d]) + ==> integral (:real^1) (\t. if c <= drop t /\ drop t <= d then lift(g(drop + t)) else vec 0) = + lift(real_integral (real_interval[c,d]) g)`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(SUBST1_TAC o MATCH_MP REAL_INTEGRAL) THEN + REWRITE_TAC[LIFT_DROP] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM INTEGRAL_RESTRICT_UNIV] THEN + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `t:real^1` THEN + REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL; IN_IMAGE_LIFT_DROP; + IN_REAL_INTERVAL; o_THM] THEN + COND_CASES_TAC THEN REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Per-slice integrability of the amd kernel (needed for the box-Tonelli *) +(* reassembly to connect to carleson_Sinner's nested-real-integral *) +(* definition). *) +(* The b-slice b|->amd h a b xf is LSC (sup of the b-continuous windows), *) +(* hence *) +(* Borel measurable, and bounded by K (AMD_UNIF_BOUND), hence integrable on *) +(* any *) +(* finite interval. Mirrors AMD_JOINT_LSC in 1D. *) +(* ------------------------------------------------------------------------- *) +(* each amd window is continuous in b (VZETA_CONTINUOUS_ON on the b-line). *) +let WINDOW_BSLICE_CONT = prove + (`!(h:real->complex) a x zeta. schwartz h /\ &0 < a + ==> (\b. &2 * pi * norm(fourier(\w. fourier (carleson_modulate b + (carleson_dilate a h)) w * + Cx(carleson_theta zeta w))(--(x/a)))) real_continuous_on + (:real)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[REAL_CONTINUOUS_ON; IMAGE_LIFT_UNIV] THEN + SUBGOAL_THEN + `(lift o (\b. &2 * pi * norm(fourier(\w. fourier (carleson_modulate b + (carleson_dilate a h)) w * + Cx(carleson_theta zeta w))(--(x/a)))) o drop) = + (\p:real^3. lift(&2 * pi * norm(fourier(\w. fourier (carleson_modulate + (p$2) (carleson_dilate (p$1) h)) w * + Cx(carleson_theta zeta w))(--(p$3 / p$1))))) o (\t:real^1. + vector[a; drop t; x]:real^3)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; o_THM] THEN X_GEN_TAC `t:real^1` THEN + REWRITE_TAC[VECTOR_3]; ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL + [ONCE_REWRITE_TAC[CONTINUOUS_ON_COMPONENTWISE_LIFT] THEN + SIMP_TAC[DIMINDEX_3; FORALL_3; VECTOR_3] THEN + REWRITE_TAC[CONTINUOUS_ON_CONST; LIFT_DROP; CONTINUOUS_ON_ID]; + MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `{p:real^3 | p$1 > &0}` THEN CONJ_TAC THENL + [MATCH_MP_TAC VZETA_CONTINUOUS_ON THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM; VECTOR_3; IN_UNIV] THEN + ASM_REWRITE_TAC[real_gt]]]);; + +(* b-slice b|->amd h a b xf is real_measurable_on R (LSC via *) +(* WINDOW_BSLICE_CONT). *) +let AMD_BSLICE_MEASURABLE = prove + (`!(h:real->complex) a xf. schwartz h /\ &0 < a + ==> (\b. carleson_amd h a b xf) real_measurable_on (:real)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[real_measurable_on; IMAGE_LIFT_UNIV] THEN + MATCH_MP_TAC MEASURABLE_ON_LSC_MULTI THEN + X_GEN_TAC `c:real` THEN REWRITE_TAC[o_THM; LIFT_DROP] THEN + ASM_CASES_TAC `c < &0` THENL + [SUBGOAL_THEN + `{x:real^1 | carleson_amd h a (drop x) xf > c} = + (:real^1)` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_UNIV] THEN + X_GEN_TAC `t:real^1` THEN REWRITE_TAC[real_gt] THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&0` THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC AMD_NONNEG THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[OPEN_UNIV]]; + SUBGOAL_THEN + `{x:real^1 | carleson_amd h a (drop x) xf > c} = + UNIONS { {t:real^1 | + &2 * pi * norm(fourier(\w. fourier (carleson_modulate (drop t) + (carleson_dilate a h)) w * + Cx(carleson_theta zeta w))(--(xf/a))) > c} + | zeta IN (:real) }` + SUBST1_TAC THENL + [REWRITE_TAC[UNIONS_GSPEC; EXTENSION; IN_ELIM_THM; IN_UNIV] THEN + X_GEN_TAC `t:real^1` THEN + MP_TAC(ISPECL [`h:real->complex`; `a:real`; `drop(t:real^1)`; `xf:real`; + `c:real`] AMD_SUP_GT) THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC OPEN_UNIONS THEN + REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN X_GEN_TAC `zeta:real` THEN + MP_TAC(ISPECL [`h:real->complex`; `a:real`; `xf:real`; + `zeta:real`] WINDOW_BSLICE_CONT) THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[REAL_CONTINUOUS_ON; IMAGE_LIFT_UNIV] THEN DISCH_TAC THEN + SUBGOAL_THEN + `{t:real^1 | + &2 * pi * norm(fourier(\w. fourier (carleson_modulate (drop t) + (carleson_dilate a h)) w * + Cx(carleson_theta zeta w))(--(xf/a))) > c} = + {t | t IN (:real^1) /\ + (lift o (\b. &2 * pi * norm(fourier(\w. fourier (carleson_modulate + b (carleson_dilate a h)) w * + Cx(carleson_theta zeta w))(--(xf/a)))) o drop) t IN {u | drop + u > c}}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_UNIV; o_THM; LIFT_DROP]; + ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_OPEN_PREIMAGE THEN + ASM_REWRITE_TAC[OPEN_UNIV; ETA_AX] THEN + REWRITE_TAC[drop; OPEN_HALFSPACE_COMPONENT_GT]]]);; + +(* b-slice integrable on any interval (measurable + bounded by K on finite *) +(* meas). *) +let AMD_BSLICE_INTEGRABLE = prove + (`!(h:real->complex) a xf u v. schwartz h /\ &0 < a + ==> (\b. carleson_amd h a b xf) real_integrable_on real_interval[u,v]`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN + EXISTS_TAC `(\b:real. sqrt(&2 * pi) * + drop(integral (:real^1) (\y. lift(norm(fourier (h:real->complex) (drop + y)))))):real->real` THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC REAL_MEASURABLE_ON_MEASURABLE_SUBSET THEN + EXISTS_TAC `(:real)` THEN + ASM_SIMP_TAC[SUBSET_UNIV; AMD_BSLICE_MEASURABLE; + REAL_MEASURABLE_REAL_INTERVAL]; + REWRITE_TAC[REAL_INTEGRABLE_ON; o_DEF; LIFT_CMUL] THEN + REWRITE_TAC[INTEGRABLE_ON_CONST] THEN DISJ2_TAC THEN + REWRITE_TAC[GSYM REAL_MEASURABLE_MEASURABLE; + REAL_MEASURABLE_REAL_INTERVAL]; + X_GEN_TAC `b:real` THEN DISCH_TAC THEN + MP_TAC(ISPECL [`h:real->complex`; `a:real`; `b:real`; + `xf:real`] AMD_UNIF_BOUND) THEN + MP_TAC(ISPECL [`h:real->complex`; `a:real`; `b:real`; + `xf:real`] AMD_NONNEG) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC]);; + +(* 2D joint (alpha,beta)-measurability of the amd kernel at fixed xf: for *) +(* the fixed-x Step-C of the box-Tonelli (the (1,1)fs box integral of *) +(* (1/a)amd). amd = sup_zeta of the (alpha,beta)-continuous windows *) +(* (WINDOW_ABSLICE_CONT via VZETA_CONTINUOUS_ON o embedding), so LSC -> *) +(* measurable (MEASURABLE_ON_LSC_MULTI). the (alpha,beta)-region {alpha>0} *) +(* is open in R^2. *) +let ABREGION_OPEN = prove + (`open {ab:real^(1,1)finite_sum | drop(fstcart ab) > &0}`, + SUBGOAL_THEN + `{ab:real^(1,1)finite_sum | drop(fstcart ab) > &0} = + {ab:real^(1,1)finite_sum | ab$1 > &0}` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN GEN_TAC THEN AP_THM_TAC THEN + AP_TERM_TAC THEN + REWRITE_TAC[drop] THEN MATCH_MP_TAC FSTCART_COMPONENT THEN + REWRITE_TAC[DIMINDEX_1; LE_REFL]; + REWRITE_TAC[OPEN_HALFSPACE_COMPONENT_GT]]);; + +(* each amd window is jointly continuous in (alpha,beta) on {alpha>0} (2D). *) +let WINDOW_ABSLICE_CONT = prove + (`!(h:real->complex) xf zeta. schwartz h + ==> (\ab:real^(1,1)finite_sum. + lift(&2 * pi * norm(fourier(\w. fourier (carleson_modulate + (drop(sndcart ab)) (carleson_dilate (drop(fstcart ab)) h)) w * + Cx(carleson_theta zeta w))(--(xf/(drop(fstcart ab))))))) + continuous_on {ab:real^(1,1)finite_sum | drop(fstcart ab) > &0}`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\ab:real^(1,1)finite_sum. + lift(&2 * pi * norm(fourier(\w. fourier (carleson_modulate + (drop(sndcart ab)) (carleson_dilate (drop(fstcart ab)) h)) w * + Cx(carleson_theta zeta w))(--(xf/(drop(fstcart ab))))))) = + (\p:real^3. lift(&2 * pi * norm(fourier(\w. fourier (carleson_modulate + (p$2) (carleson_dilate (p$1) h)) w * + Cx(carleson_theta zeta w))(--(p$3 / p$1))))) o + (\ab:real^(1,1)finite_sum. vector[drop(fstcart ab); drop(sndcart ab); + xf]:real^3)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; o_THM] THEN + X_GEN_TAC `ab:real^(1,1)finite_sum` THEN + REWRITE_TAC[VECTOR_3]; ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL + [ONCE_REWRITE_TAC[CONTINUOUS_ON_COMPONENTWISE_LIFT] THEN + SIMP_TAC[DIMINDEX_3; FORALL_3; VECTOR_3] THEN + REWRITE_TAC[CONTINUOUS_ON_CONST] THEN CONJ_TAC THENL + [SIMP_TAC[CONTINUOUS_ON_LIFT_COMPONENT_COMPOSE; LINEAR_CONTINUOUS_ON; + LINEAR_FSTCART; o_DEF; LIFT_DROP; ETA_AX]; + SIMP_TAC[CONTINUOUS_ON_LIFT_COMPONENT_COMPOSE; LINEAR_CONTINUOUS_ON; + LINEAR_SNDCART; o_DEF; LIFT_DROP; ETA_AX]]; + MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `{p:real^3 | p$1 > &0}` THEN CONJ_TAC THENL + [MATCH_MP_TAC VZETA_CONTINUOUS_ON THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM; VECTOR_3]]]);; + +(* hence each window's superlevel {alpha>0 /\ V_zeta > c} is open in R^2. *) +let WINDOW_ABSLICE_SUPERLEVEL_OPEN = prove + (`!(h:real->complex) xf zeta c. schwartz h + ==> open {ab:real^(1,1)finite_sum | drop(fstcart ab) > &0 /\ + &2 * pi * norm(fourier(\w. fourier (carleson_modulate + (drop(sndcart ab)) (carleson_dilate (drop(fstcart ab)) h)) w * + Cx(carleson_theta zeta w))(--(xf/(drop(fstcart ab))))) > + c}`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`(\ab:real^(1,1)finite_sum. + lift(&2 * pi * norm(fourier(\w. fourier (carleson_modulate + (drop(sndcart ab)) (carleson_dilate (drop(fstcart ab)) h)) w * + Cx(carleson_theta zeta w))(--(xf/(drop(fstcart ab)))))))`; + `{ab:real^(1,1)finite_sum | drop(fstcart ab) > &0}`; + `(:real^1)`; + `{u:real^1 | drop u > c}`] CONTINUOUS_OPEN_IN_PREIMAGE_GEN) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[WINDOW_ABSLICE_CONT; SUBSET_UNIV] THEN + REWRITE_TAC[SUBTOPOLOGY_UNIV; GSYM OPEN_IN; drop; + OPEN_HALFSPACE_COMPONENT_GT]; ALL_TAC] THEN + SUBGOAL_THEN + `{x:real^(1,1)finite_sum | x IN {ab | drop(fstcart ab) > &0} /\ + (\ab:real^(1,1)finite_sum. lift(&2 * pi * norm(fourier(\w. fourier + (carleson_modulate (drop(sndcart ab)) (carleson_dilate (drop(fstcart + ab)) h)) w * + Cx(carleson_theta zeta w))(--(xf/(drop(fstcart ab))))))) x + IN {u | drop u > c}} = + {ab:real^(1,1)finite_sum | drop(fstcart ab) > &0 /\ + &2 * pi * norm(fourier(\w. fourier (carleson_modulate (drop(sndcart ab)) + (carleson_dilate (drop(fstcart ab)) h)) w * + Cx(carleson_theta zeta w))(--(xf/(drop(fstcart ab))))) > + c}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; LIFT_DROP]; ALL_TAC] THEN + REWRITE_TAC[OPEN_IN_OPEN] THEN + DISCH_THEN(X_CHOOSE_THEN + `t:real^(1,1)finite_sum->bool` STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC OPEN_INTER THEN + ASM_REWRITE_TAC[ABREGION_OPEN]);; + +(* 2D joint measurability of the amd kernel (junk 0 for alpha<=0). *) +let AMD_ABSLICE_MEASURABLE = prove + (`!(h:real->complex) xf. schwartz h + ==> (\ab:real^(1,1)finite_sum. + lift(if drop(fstcart ab) > &0 + then carleson_amd h (drop(fstcart ab)) (drop(sndcart ab)) xf + else &0)) + measurable_on (:real^(1,1)finite_sum)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_ON_LSC_MULTI THEN + X_GEN_TAC `c:real` THEN REWRITE_TAC[LIFT_DROP] THEN + ASM_CASES_TAC `c < &0` THENL + [SUBGOAL_THEN + `{ab:real^(1,1)finite_sum | (if drop(fstcart ab) > &0 + then carleson_amd h (drop(fstcart ab)) (drop(sndcart ab)) xf else &0) + > c} = (:real^(1,1)finite_sum)` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_UNIV] THEN + X_GEN_TAC `ab:real^(1,1)finite_sum` THEN COND_CASES_TAC THEN + REWRITE_TAC[real_gt] THENL + [MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&0` THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC AMD_NONNEG THEN ASM_REWRITE_TAC[GSYM real_gt]; + ASM_REAL_ARITH_TAC]; + REWRITE_TAC[OPEN_UNIV]]; + SUBGOAL_THEN + `{ab:real^(1,1)finite_sum | (if drop(fstcart ab) > &0 + then carleson_amd h (drop(fstcart ab)) (drop(sndcart ab)) xf else &0) + > c} = + UNIONS { {ab:real^(1,1)finite_sum | drop(fstcart ab) > &0 /\ + &2 * pi * norm(fourier(\w. fourier (carleson_modulate + (drop(sndcart ab)) (carleson_dilate (drop(fstcart ab)) h)) w * + Cx(carleson_theta zeta w))(--(xf/(drop(fstcart ab))))) > + c} + | zeta IN (:real) }` + SUBST1_TAC THENL + [REWRITE_TAC[UNIONS_GSPEC; EXTENSION; IN_ELIM_THM; IN_UNIV] THEN + X_GEN_TAC `ab:real^(1,1)finite_sum` THEN COND_CASES_TAC THENL + [MP_TAC(ISPECL [`h:real->complex`; + `drop(fstcart(ab:real^(1,1)finite_sum))`; + `drop(sndcart(ab:real^(1,1)finite_sum))`; `xf:real`; + `c:real`] AMD_SUP_GT) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[GSYM real_gt]; ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[real_gt] THEN ASM_REAL_ARITH_TAC]; + MATCH_MP_TAC OPEN_UNIONS THEN REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN + X_GEN_TAC `zeta:real` THEN + MATCH_MP_TAC WINDOW_ABSLICE_SUPERLEVEL_OPEN THEN ASM_REWRITE_TAC[]]]);; + +(* ------------------------------------------------------------------------- *) +(* The fixed-x (1,1)fs box kernel (1/a)amd on [1,2]x[0,n]: measurable + abs- *) +(* integrable. Feeds the fixed-x Step-C of the box-Tonelli (the (a,b)-double *) +(* integral of (1/a)amd at fixed xf = carleson_Sinner h n xf). *) +(* ------------------------------------------------------------------------- *) +(* inv(alpha)=inv(drop(fstcart ab)) measurable on real^(1,1)fs. *) +let INVA_ABSLICE_MEASURABLE = prove + (`(\ab:real^(1,1)finite_sum. lift(inv(drop(fstcart ab)))) measurable_on + (:real^(1,1)finite_sum)`, + MATCH_MP_TAC MEASURABLE_ON_LIFT_INV THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_IMP_MEASURABLE_ON THEN + MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN + SUBGOAL_THEN + `(\ab:real^(1,1)finite_sum. lift(drop(fstcart ab))) = + (fstcart:real^(1,1)finite_sum->real^1)` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; LIFT_DROP]; ALL_TAC] THEN + REWRITE_TAC[LINEAR_FSTCART]; + SUBGOAL_THEN + `{ab:real^(1,1)finite_sum | ab IN (:real^(1,1)finite_sum) /\ drop + (fstcart ab) = &0} = + {ab:real^(1,1)finite_sum | ab$1 = &0}` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_UNIV] THEN GEN_TAC THEN + AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[drop] THEN + MATCH_MP_TAC FSTCART_COMPONENT THEN REWRITE_TAC[DIMINDEX_1; LE_REFL]; + REWRITE_TAC[NEGLIGIBLE_STANDARD_HYPERPLANE]]]);; + +(* the (1,1)fs box [1,2]x[0,n] is measurable (finite). *) +let ABBOX_MEASURABLE = prove + (`!n. measurable {ab:real^(1,1)finite_sum | + &1 <= drop(fstcart ab) /\ drop(fstcart ab) <= &2 /\ + &0 <= drop(sndcart ab) /\ drop(sndcart ab) <= &n}`, + GEN_TAC THEN + SUBGOAL_THEN + `{ab:real^(1,1)finite_sum | + &1 <= drop(fstcart ab) /\ drop(fstcart ab) <= &2 /\ + &0 <= drop(sndcart ab) /\ drop(sndcart ab) <= &n} = + (interval[lift(&1),lift(&2)]) PCROSS (interval[lift(&0),lift(&n)])` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; FORALL_PASTECART; PASTECART_IN_PCROSS; + IN_ELIM_THM; FSTCART_PASTECART; SNDCART_PASTECART; + IN_INTERVAL_1; LIFT_DROP] THEN + REWRITE_TAC[CONJ_ACI]; + SIMP_TAC[MEASURABLE_PCROSS; MEASURABLE_INTERVAL]]);; + +(* ================================================================= *) +(* real^(1,1)finite_sum <-> real^2 shuffle, to port the real^2 2D *) +(* theta' measurability to the FUBINI-usable fs type (fstcart=a, *) +(* sndcart=b), for the inner (a,b)-Fubini of the w-outer side. *) +(* ================================================================= *) +let SHUF2_LINEAR = prove + (`linear (\z:real^(1,1)finite_sum. vector[drop(fstcart z); + drop(sndcart z)]:real^2) /\ + (!u v:real^(1,1)finite_sum. (\z. vector[drop(fstcart z); + drop(sndcart z)]:real^2) u = + (\z. vector[drop(fstcart z); drop(sndcart z)]:real^2) v ==> u = v)`, + CONJ_TAC THENL + [REWRITE_TAC[linear] THEN CONJ_TAC THEN REPEAT GEN_TAC THEN + REWRITE_TAC[CART_EQ; DIMINDEX_2; FORALL_2; VECTOR_2] THEN + SIMP_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; VECTOR_2; DIMINDEX_2; + ARITH] THEN + REWRITE_TAC[FSTCART_ADD; SNDCART_ADD; FSTCART_CMUL; SNDCART_CMUL; DROP_ADD; + DROP_CMUL] THEN + REWRITE_TAC[VECTOR_2] THEN REAL_ARITH_TAC; + REPEAT GEN_TAC THEN REWRITE_TAC[] THEN DISCH_TAC THEN + SUBGOAL_THEN + `drop(fstcart(u:real^(1,1)finite_sum)) = drop(fstcart v) /\ drop(sndcart + u) = drop(sndcart v)` + STRIP_ASSUME_TAC THENL + [FIRST_X_ASSUM MP_TAC THEN + REWRITE_TAC[CART_EQ; DIMINDEX_2; FORALL_2; VECTOR_2] THEN + SIMP_TAC[]; ALL_TAC] THEN + ONCE_REWRITE_TAC[PASTECART_EQ] THEN CONJ_TAC THEN + ONCE_REWRITE_TAC[GSYM DROP_EQ] THEN ASM_REWRITE_TAC[]]);; + +let SHUF2_IMAGE = prove + (`IMAGE (\z:real^(1,1)finite_sum. vector[drop(fstcart z); + drop(sndcart z)]:real^2) (:real^(1,1)finite_sum) = (:real^2)`, + MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[IN_UNIV] THEN + X_GEN_TAC `p:real^2` THEN + EXISTS_TAC `pastecart (lift((p:real^2)$1)) (lift(p$2)):real^(1,1)finite_sum` + THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; LIFT_DROP] THEN + REWRITE_TAC[CART_EQ; DIMINDEX_2; FORALL_2; VECTOR_2] THEN + CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[]);; + +let SHUF2C = prove + (`!hh:real^2->complex. + (hh o (\z:real^(1,1)finite_sum. vector[drop(fstcart z); + drop(sndcart z)]:real^2)) + measurable_on (:real^(1,1)finite_sum) + <=> hh measurable_on (:real^2)`, + GEN_TAC THEN + MP_TAC(ISPECL + [`\z:real^(1,1)finite_sum. vector[drop(fstcart z); drop(sndcart z)]:real^2`; + `hh:real^2->complex`; + `(:real^(1,1)finite_sum)`] MEASURABLE_ON_LINEAR_IMAGE_EQ_GEN) THEN + REWRITE_TAC[SHUF2_LINEAR; DIMINDEX_FINITE_SUM; DIMINDEX_1; DIMINDEX_2; + ARITH] THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[SHUF2_IMAGE]);; + +let CX_THETA2FS_MEASURABLE = prove + (`!z0:real w:real. (\z:real^(1,1)finite_sum. Cx(carleson_theta' z0 + (drop(fstcart z)) (drop(sndcart z)) w)) + measurable_on (:real^(1,1)finite_sum)`, + REPEAT GEN_TAC THEN + MP_TAC(ISPEC `\p:real^2. Cx(carleson_theta' z0 (p$1) (p$2) w)` SHUF2C) THEN + REWRITE_TAC[CX_THETA2_MEASURABLE] THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM; o_THM] THEN GEN_TAC THEN REWRITE_TAC[VECTOR_2]);; + +let CX_INVAFS_MEASURABLE = prove + (`(\z:real^(1,1)finite_sum. Cx(inv(drop(fstcart z)))) measurable_on + (:real^(1,1)finite_sum)`, + MP_TAC(ISPEC `\p:real^2. Cx(inv(p$1))` SHUF2C) THEN + REWRITE_TAC[CX_INVA2_MEASURABLE] THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM; o_THM] THEN GEN_TAC THEN REWRITE_TAC[VECTOR_2]);; + +let MNF_ABKERNEL_FS_ABSINT = prove + (`!z0:real w:real n:num. + (\ab:real^(1,1)finite_sum. + if &1 <= drop(fstcart ab) /\ drop(fstcart ab) <= &2 /\ + &0 <= drop(sndcart ab) /\ drop(sndcart ab) <= &n + then Cx(inv(drop(fstcart ab))) * Cx(carleson_theta' z0 (drop(fstcart + ab)) (drop(sndcart ab)) w) else vec 0) + absolutely_integrable_on (:real^(1,1)finite_sum)`, + REPEAT GEN_TAC THEN + MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE THEN + EXISTS_TAC + `\ab:real^(1,1)finite_sum. + if &1 <= drop(fstcart ab) /\ drop(fstcart ab) <= &2 /\ + &0 <= drop(sndcart ab) /\ drop(sndcart ab) <= &n + then lift(&1) else vec 0` THEN + REPEAT CONJ_TAC THENL + [SUBGOAL_THEN + `(\ab:real^(1,1)finite_sum. + if &1 <= drop(fstcart ab) /\ drop(fstcart ab) <= &2 /\ + &0 <= drop(sndcart ab) /\ drop(sndcart ab) <= &n + then Cx(inv(drop(fstcart ab))) * Cx(carleson_theta' z0 (drop(fstcart + ab)) (drop(sndcart ab)) w) else vec 0) = + (\ab:real^(1,1)finite_sum. + if ab IN {ab:real^(1,1)finite_sum | &1 <= drop(fstcart ab) /\ + drop(fstcart ab) <= &2 /\ + &0 <= drop(sndcart ab) /\ drop(sndcart ab) <= &n} + then Cx(inv(drop(fstcart ab))) * Cx(carleson_theta' z0 (drop(fstcart + ab)) (drop(sndcart ab)) w) else vec 0)` + SUBST1_TAC THENL [REWRITE_TAC[IN_ELIM_THM]; ALL_TAC] THEN + MATCH_MP_TAC MEASURABLE_ON_RESTRICT THEN CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_ON_COMPLEX_MUL THEN + REWRITE_TAC[CX_INVAFS_MEASURABLE; CX_THETA2FS_MEASURABLE]; + MATCH_MP_TAC MEASURABLE_IMP_LEBESGUE_MEASURABLE THEN + REWRITE_TAC[ABBOX_MEASURABLE]]; + SUBGOAL_THEN + `(\ab:real^(1,1)finite_sum. if &1 <= drop(fstcart ab) /\ drop(fstcart ab) + <= &2 /\ + &0 <= drop(sndcart ab) /\ drop(sndcart ab) <= &n then lift(&1) else + vec 0) = + (\ab:real^(1,1)finite_sum. if ab IN {ab:real^(1,1)finite_sum | &1 <= + drop(fstcart ab) /\ drop(fstcart ab) <= &2 /\ + &0 <= drop(sndcart ab) /\ drop(sndcart ab) <= &n} then lift(&1) else + vec 0)` + SUBST1_TAC THENL [REWRITE_TAC[IN_ELIM_THM]; ALL_TAC] THEN + REWRITE_TAC[INTEGRABLE_RESTRICT_UNIV; INTEGRABLE_ON_CONST] THEN + DISJ2_TAC THEN + REWRITE_TAC[ABBOX_MEASURABLE]; + X_GEN_TAC `ab:real^(1,1)finite_sum` THEN REWRITE_TAC[IN_UNIV] THEN + COND_CASES_TAC THEN + REWRITE_TAC[NORM_0; NORM_LIFT; LIFT_DROP; DROP_VEC; REAL_ABS_NUM; + REAL_LE_REFL] THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `abs(inv(drop(fstcart(ab:real^(1,1)finite_sum)))) * &1` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN + MP_TAC(ISPECL [`z0:real`; `drop(fstcart(ab:real^(1,1)finite_sum))`; + `drop(sndcart(ab:real^(1,1)finite_sum))`; + `w:real`] CARLESON_THETA'_BOUNDS) THEN REAL_ARITH_TAC; + REWRITE_TAC[REAL_MUL_RID] THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `abs(inv(&1))` THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_ABS_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN + ASM_REAL_ARITH_TAC; + CONV_TAC REAL_RAT_REDUCE_CONV]]]);; + +(* the box-restricted (1/a)amd kernel at fixed xf is MEASURABLE on *) +(* real^(1,1)fs. NB the box-lebesgue-measurable leg via *) +(* MEASURABLE_IMP_LEBESGUE_MEASURABLE (the indicator/GSYM *) +(* INTEGRABLE_ON_INDICATOR route TIMES OUT >150s here). *) +let AMD_ABBOX_KERNEL_MEAS = prove + (`!(h:real->complex) n xf. schwartz h + ==> (\ab:real^(1,1)finite_sum. + if &1 <= drop(fstcart ab) /\ drop(fstcart ab) <= &2 /\ + &0 <= drop(sndcart ab) /\ drop(sndcart ab) <= &n + then lift(inv(drop(fstcart ab)) * + (if drop(fstcart ab) > &0 + then carleson_amd h (drop(fstcart ab)) (drop(sndcart ab)) + xf else &0)) + else vec 0) + measurable_on (:real^(1,1)finite_sum)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`\ab:real^(1,1)finite_sum. + lift(inv(drop(fstcart ab)) * + (if drop(fstcart ab) > &0 + then carleson_amd h (drop(fstcart ab)) (drop(sndcart ab)) xf else + &0))`; + `{ab:real^(1,1)finite_sum | + &1 <= drop(fstcart ab) /\ drop(fstcart ab) <= &2 /\ + &0 <= drop(sndcart ab) /\ drop(sndcart ab) <= &n}`] + MEASURABLE_ON_RESTRICT) THEN + REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_ON_LIFT_MUL THEN + REWRITE_TAC[INVA_ABSLICE_MEASURABLE] THEN + MP_TAC(ISPECL [`h:real->complex`; `xf:real`] AMD_ABSLICE_MEASURABLE) THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC MEASURABLE_IMP_LEBESGUE_MEASURABLE THEN + REWRITE_TAC[ABBOX_MEASURABLE]]);; + +(* 2D box kernel at fixed xf: (1/a)amd on [1,2]x[0,n], abs-integrable (const *) +(* domin). *) +let AMD_ABBOX_ABSINT = prove + (`!(h:real->complex) n xf. schwartz h + ==> (\ab:real^(1,1)finite_sum. + if &1 <= drop(fstcart ab) /\ drop(fstcart ab) <= &2 /\ + &0 <= drop(sndcart ab) /\ drop(sndcart ab) <= &n + then lift(inv(drop(fstcart ab)) * + (if drop(fstcart ab) > &0 + then carleson_amd h (drop(fstcart ab)) (drop(sndcart ab)) + xf else &0)) + else vec 0) + absolutely_integrable_on (:real^(1,1)finite_sum)`, + REPEAT STRIP_TAC THEN + ABBREV_TAC `K = sqrt(&2 * pi) * drop(integral (:real^1) (\y. + lift(norm(fourier (h:real->complex) (drop y)))))` THEN + MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE THEN + EXISTS_TAC + `\ab:real^(1,1)finite_sum. + K % indicator + {ab:real^(1,1)finite_sum | + &1 <= drop(fstcart ab) /\ drop(fstcart ab) <= &2 /\ + &0 <= drop(sndcart ab) /\ drop(sndcart ab) <= &n} ab` THEN + REPEAT CONJ_TAC THENL + [ASM_SIMP_TAC[AMD_ABBOX_KERNEL_MEAS]; + MATCH_MP_TAC INTEGRABLE_CMUL THEN REWRITE_TAC[ETA_AX] THEN + REWRITE_TAC[INTEGRABLE_ON_INDICATOR; INTER_UNIV] THEN + REWRITE_TAC[GSYM MEASURABLE_INTEGRABLE; ABBOX_MEASURABLE]; + X_GEN_TAC `ab:real^(1,1)finite_sum` THEN REWRITE_TAC[IN_UNIV] THEN + REWRITE_TAC[indicator; IN_ELIM_THM; DROP_CMUL] THEN + SUBGOAL_THEN `&0 <= K` ASSUME_TAC THENL + [EXPAND_TAC "K" THEN MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC SQRT_POS_LE THEN MP_TAC PI_POS THEN REAL_ARITH_TAC; + MATCH_MP_TAC INTEGRAL_DROP_POS THEN + REWRITE_TAC[LIFT_DROP; NORM_POS_LE] THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN + MP_TAC(ISPEC `h:real->complex` SCHWARTZ_FHAT_ABSINT) THEN + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + COND_CASES_TAC THEN + ASM_REWRITE_TAC[NORM_0; DROP_VEC; REAL_MUL_RZERO; REAL_LE_REFL] THEN + REWRITE_TAC[REAL_MUL_RID; NORM_LIFT] THEN + SUBGOAL_THEN `drop(fstcart(ab:real^(1,1)finite_sum)) > &0` ASSUME_TAC THENL + [REWRITE_TAC[real_gt] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&1 * carleson_amd h (drop(fstcart(ab:real^(1,1)finite_sum))) + (drop(sndcart ab)) xf` THEN + CONJ_TAC THENL + [REWRITE_TAC[REAL_ABS_MUL] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN + REWRITE_TAC[REAL_ABS_POS] THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[REAL_ABS_INV] THEN MATCH_MP_TAC REAL_INV_LE_1 THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[real_abs] THEN COND_CASES_TAC THEN + REWRITE_TAC[REAL_LE_REFL] THEN + POP_ASSUM MP_TAC THEN + MP_TAC(ISPECL [`h:real->complex`; + `drop(fstcart(ab:real^(1,1)finite_sum))`; + `drop(sndcart(ab:real^(1,1)finite_sum))`; + `xf:real`] AMD_NONNEG) THEN + ASM_SIMP_TAC[GSYM real_gt] THEN REAL_ARITH_TAC]; + REWRITE_TAC[REAL_MUL_LID] THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC AMD_UNIF_BOUND THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC]]);; + +(* ------------------------------------------------------------------------- *) +(* Fixed-x Step-C of the box-Tonelli: the (a,b)-box integral of (1/a)amd at *) +(* fixed xf equals carleson_Sinner h n xf. a-outer FUBINI_INTEGRAL on the *) +(* box *) +(* kernel (AMD_ABBOX_ABSINT) + inner b-gate pull + *) +(* CARLESON_INTERVAL_REAL_BRIDGE *) +(* twice. Feeds SIDE-A (int_FF Sinner) of SINNER_INT_F_SWAP. *) +(* ------------------------------------------------------------------------- *) +(* the inner b-integral at fixed x (STEPC_INNER). *) +let STEPC_INNER = prove + (`!(h:real->complex) n xf x. schwartz h + ==> integral (:real^1) + (\y. if &1 <= drop x /\ drop x <= &2 /\ &0 <= drop y /\ drop y <= &n + then lift(inv(drop x) * (if drop x > &0 then carleson_amd h (drop + x) (drop y) xf else &0)) + else vec 0) = + (if &1 <= drop x /\ drop x <= &2 + then lift(inv(drop x) * real_integral (real_interval[&0,&n]) (\beta. + carleson_amd h (drop x) beta xf)) + else vec 0)`, + REPEAT STRIP_TAC THEN COND_CASES_TAC THENL + [SUBGOAL_THEN `drop x > &0` ASSUME_TAC THENL [REWRITE_TAC[real_gt] THEN + ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`\b. inv(drop(x:real^1)) * carleson_amd h (drop x) b xf`; + `&0:real`; `&n:real`] CARLESON_INTERVAL_REAL_BRIDGE) THEN + ANTS_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_LMUL THEN + MATCH_MP_TAC AMD_BSLICE_INTEGRABLE THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + AP_TERM_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_LMUL THEN + MATCH_MP_TAC AMD_BSLICE_INTEGRABLE THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC; + SUBGOAL_THEN + `(\y:real^1. if &1 <= drop x /\ drop x <= &2 /\ &0 <= drop y /\ + drop y <= &n + then lift(inv(drop x) * (if drop x > &0 then carleson_amd h (drop + x) (drop y) xf else &0)) else vec 0) = (\y:real^1. vec 0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; REWRITE_TAC[INTEGRAL_0]]]);; + +(* the a-iterate (\a. inv a * int_[0,n] amd) real_integrable on [1,2]. *) +(* Derived from AMD_ABBOX_ABSINT via FUBINI_ABSOLUTELY_INTEGRABLE (x-outer): *) +(* the box kernel's a-iterate = if 1<=a<=2 then lift(inv a*int amd) else 0 *) +(* (STEPC_INNER) is integrable on UNIV, hence its [1,2]-restriction (=raw fn *) +(* there) integrable. *) +let A_ITERATE_INTEGRABLE = prove + (`!(h:real->complex) n xf. schwartz h /\ ~(n = 0) + ==> (\alpha. inv alpha * real_integral (real_interval[&0,&n]) (\beta. + carleson_amd h alpha beta xf)) + real_integrable_on real_interval[&1,&2]`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_INTEGRABLE_EQ THEN + EXISTS_TAC + `\alpha. if &1 <= alpha /\ alpha <= &2 + then inv alpha * real_integral (real_interval[&0,&n]) (\beta. + carleson_amd h alpha beta xf) + else &0` THEN + CONJ_TAC THENL + [X_GEN_TAC `a:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC REAL_INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `(:real)` THEN REWRITE_TAC[SUBSET_UNIV] THEN + REWRITE_TAC[REAL_INTEGRABLE_ON; IMAGE_LIFT_UNIV] THEN + MP_TAC(ISPECL [`h:real->complex`; `n:num`; `xf:real`] AMD_ABBOX_ABSINT) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o MATCH_MP FUBINI_ABSOLUTELY_INTEGRABLE) THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN + ASM_SIMP_TAC[STEPC_INNER] THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_INTEGRABLE o CONJUNCT2) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM; o_THM] THEN X_GEN_TAC `a:real^1` THEN + REWRITE_TAC[LIFT_DROP] THEN COND_CASES_TAC THEN REWRITE_TAC[LIFT_NUM]);; + +(* Fixed-x Step-C: the (a,b)-box integral of (1/a)amd at fixed xf = Sinner h *) +(* n xf. *) +let SINNER_FIXEDX = prove + (`!(h:real->complex) n xf. schwartz h /\ ~(n = 0) + ==> drop(integral (:real^(1,1)finite_sum) + (\ab. if &1 <= drop(fstcart ab) /\ drop(fstcart ab) <= &2 /\ + &0 <= drop(sndcart ab) /\ drop(sndcart ab) <= &n + then lift(inv(drop(fstcart ab)) * + (if drop(fstcart ab) > &0 + then carleson_amd h (drop(fstcart ab)) (drop(sndcart ab)) + xf else &0)) + else vec 0)) = + carleson_Sinner h n xf`, + REPEAT STRIP_TAC THEN REWRITE_TAC[carleson_Sinner] THEN + MP_TAC(ISPECL [`h:real->complex`; `n:num`; `xf:real`] AMD_ABBOX_ABSINT) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(fun th -> ONCE_REWRITE_TAC[MATCH_MP FUBINI_INTEGRAL th]) THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN + ASM_SIMP_TAC[STEPC_INNER] THEN + MP_TAC(ISPECL [`\alpha. inv alpha * real_integral (real_interval[&0,&n]) + (\beta. carleson_amd h alpha beta xf)`; + `&1:real`; `&2:real`] CARLESON_INTERVAL_REAL_BRIDGE) THEN + ANTS_TAC THENL [MATCH_MP_TAC A_ITERATE_INTEGRABLE THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[LIFT_DROP]);; + +(* ------------------------------------------------------------------------- *) +(* Box-Tonelli SIDE-A: drop(int over the 3D box kernel K3) = int_FF Sinner. *) +(* K3(z) = (1/a)amd restricted to FF x [1,2] x [0,n] (x=fstcart, *) +(* (a,b)=sndcart). *) +(* ------------------------------------------------------------------------- *) +(* the amd x-slice is real_integrable on FF (a>0): carleson_A(moddil)(./a), *) +(* HAS_REAL_INTEGRAL_DILATE_SET from CARLESON_A_INTEGRABLE on (1/a)FF. *) +let AMD_XSLICE_INTEGRABLE = prove + (`!(h:real->complex) a b FF. schwartz h /\ &0 < a /\ real_measurable FF + ==> (\x. carleson_amd h a b x) real_integrable_on FF`, + REPEAT STRIP_TAC THEN REWRITE_TAC[carleson_amd] THEN + SUBGOAL_THEN + `(\x. carleson_A (carleson_modulate b (carleson_dilate a h)) (x / a)) = + (\x. carleson_A (carleson_modulate b (carleson_dilate a (h:real->complex))) + (inv a * x))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[real_div] THEN REWRITE_TAC[REAL_MUL_SYM]; ALL_TAC] THEN + MP_TAC(ISPECL + [`carleson_A (carleson_modulate b (carleson_dilate a (h:real->complex)))`; + `inv a:real`; `FF:real->bool`; + `real_integral (IMAGE (\x. inv a * x) FF) + (carleson_A (carleson_modulate b (carleson_dilate a + (h:real->complex))))`] + HAS_REAL_INTEGRAL_DILATE_SET) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC REAL_LT_INV THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_INTEGRABLE_INTEGRAL THEN + MATCH_MP_TAC CARLESON_A_INTEGRABLE THEN CONJ_TAC THENL + [MATCH_MP_TAC CARLESON_SCHWARTZ_MODDIL THEN + ASM_SIMP_TAC[REAL_LT_IMP_NZ]; + MATCH_MP_TAC REAL_MEASURABLE_SCALING THEN ASM_REWRITE_TAC[]]]; + REWRITE_TAC[real_integrable_on] THEN MESON_TAC[]]);; + +(* the x-slice of K3 at fixed x = if x IN FF then lift Sinner else 0 *) +(* (SINNER_FIXEDX). *) +let K3_XSLICE = prove + (`!(h:real->complex) FF n x. schwartz h /\ ~(n = 0) + ==> integral (:real^(1,1)finite_sum) + (\ab. (\z:real^(1,(1,1)finite_sum)finite_sum. + if drop(fstcart z) IN FF /\ + &1 <= drop(fstcart(sndcart z)) /\ drop(fstcart(sndcart z)) + <= &2 /\ + &0 <= drop(sndcart(sndcart z)) /\ drop(sndcart(sndcart z)) + <= &n + then lift(inv(drop(fstcart(sndcart z))) * + (if drop(fstcart(sndcart z)) > &0 + then carleson_amd h (drop(fstcart(sndcart z))) + (drop(sndcart(sndcart z))) (drop(fstcart z)) + else &0)) + else vec 0) (pastecart x ab)) = + (if drop x IN FF then lift(carleson_Sinner h n (drop x)) else vec 0)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN + COND_CASES_TAC THENL + [MP_TAC(ISPECL [`h:real->complex`; `n:num`; + `drop(x:real^1)`] SINNER_FIXEDX) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[LIFT_DROP]; + SUBGOAL_THEN + `(\ab:real^(1,1)finite_sum. if drop x IN FF /\ &1 <= drop(fstcart ab) /\ + drop(fstcart ab) <= &2 /\ + &0 <= drop(sndcart ab) /\ drop(sndcart ab) <= &n + then lift(inv(drop(fstcart ab)) * (if drop(fstcart ab) > &0 + then carleson_amd h (drop(fstcart ab)) (drop(sndcart ab)) + (drop x) else &0)) else vec 0) = (\ab:real^(1,1)finite_sum. + vec 0)` + SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + ASM_REWRITE_TAC[]; REWRITE_TAC[INTEGRAL_0]]]);; + +(* Sinner is real_integrable on FF (via FUBINI x-outer of K3 + K3_XSLICE). *) +let SINNER_INTEGRABLE_F = prove + (`!(h:real->complex) FF n. schwartz h /\ real_measurable FF /\ ~(n = 0) + ==> (\x. carleson_Sinner h n x) real_integrable_on FF`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\x:real. if x IN FF then carleson_Sinner h n x else &0) real_integrable_on + (:real)` + MP_TAC THENL + [REWRITE_TAC[REAL_INTEGRABLE_ON; IMAGE_LIFT_UNIV] THEN + MP_TAC(ISPECL [`h:real->complex`; `FF:real->bool`; + `n:num`] AMDT_BOX_ABSINT) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o MATCH_MP FUBINI_ABSOLUTELY_INTEGRABLE) THEN + ASM_SIMP_TAC[K3_XSLICE] THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_INTEGRABLE o CONJUNCT2) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM; o_THM] THEN X_GEN_TAC `x:real^1` THEN + REWRITE_TAC[LIFT_DROP] THEN COND_CASES_TAC THEN REWRITE_TAC[LIFT_NUM]; + REWRITE_TAC[REAL_INTEGRABLE_RESTRICT_UNIV; ETA_AX]]);; + +(* SIDE-A: drop(int over 3D box of K3) = int_FF Sinner. *) +let SIDE_A = prove + (`!(h:real->complex) FF n. schwartz h /\ real_measurable FF /\ ~(n = 0) + ==> drop(integral (:real^(1,(1,1)finite_sum)finite_sum) + (\z. if drop(fstcart z) IN FF /\ + &1 <= drop(fstcart(sndcart z)) /\ drop(fstcart(sndcart z)) <= + &2 /\ + &0 <= drop(sndcart(sndcart z)) /\ drop(sndcart(sndcart z)) <= + &n + then lift(inv(drop(fstcart(sndcart z))) * + (if drop(fstcart(sndcart z)) > &0 + then carleson_amd h (drop(fstcart(sndcart z))) + (drop(sndcart(sndcart z))) (drop(fstcart z)) + else &0)) + else vec 0)) = + real_integral FF (\x. carleson_Sinner h n x)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`h:real->complex`; `FF:real->bool`; + `n:num`] AMDT_BOX_ABSINT) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(fun th -> ONCE_REWRITE_TAC[MATCH_MP FUBINI_INTEGRAL th]) THEN + ASM_SIMP_TAC[K3_XSLICE] THEN + MP_TAC(ISPECL [`\x. carleson_Sinner h n x`; + `FF:real->bool`] CARLESON_OUTER_REAL_BRIDGE) THEN + ASM_SIMP_TAC[SINNER_INTEGRABLE_F] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[LIFT_DROP]);; + +(* the K3 (a,b)-slice at fixed ab = if 1<=a<=2 /\ 0<=b<=n then lift(inv *) +(* a*int_FF amd) else 0. *) +let K3_ABSLICE = prove + (`!(h:real->complex) FF n ab. schwartz h /\ real_measurable FF + ==> integral (:real^1) + (\x. (\z:real^(1,(1,1)finite_sum)finite_sum. + if drop(fstcart z) IN FF /\ + &1 <= drop(fstcart(sndcart z)) /\ drop(fstcart(sndcart z)) + <= &2 /\ + &0 <= drop(sndcart(sndcart z)) /\ drop(sndcart(sndcart z)) + <= &n + then lift(inv(drop(fstcart(sndcart z))) * + (if drop(fstcart(sndcart z)) > &0 + then carleson_amd h (drop(fstcart(sndcart z))) + (drop(sndcart(sndcart z))) (drop(fstcart z)) + else &0)) + else vec 0) (pastecart x ab)) = + (if &1 <= drop(fstcart ab) /\ drop(fstcart ab) <= &2 /\ &0 <= + drop(sndcart ab) /\ drop(sndcart ab) <= &n + then lift(inv(drop(fstcart ab)) * real_integral FF (\x. carleson_amd h + (drop(fstcart ab)) (drop(sndcart ab)) x)) + else vec 0)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN + COND_CASES_TAC THENL + [SUBGOAL_THEN `drop(fstcart(ab:real^(1,1)finite_sum)) > &0` ASSUME_TAC THENL + [REWRITE_TAC[real_gt] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `(\x:real^1. if drop x IN FF then lift(inv(drop(fstcart ab)) * + carleson_amd h (drop(fstcart ab)) (drop(sndcart ab)) (drop x)) else vec + 0) = + (\x:real^1. if drop x IN FF then lift((\xx. inv(drop(fstcart ab)) * + carleson_amd h (drop(fstcart ab)) (drop(sndcart ab)) xx)(drop x)) else + vec 0)` + SUBST1_TAC THENL [REWRITE_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL [`\xx. inv(drop(fstcart(ab:real^(1,1)finite_sum))) * + carleson_amd h (drop(fstcart ab)) (drop(sndcart ab)) xx`; + `FF:real->bool`] CARLESON_OUTER_REAL_BRIDGE) THEN + ANTS_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_LMUL THEN + MATCH_MP_TAC AMD_XSLICE_INTEGRABLE THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN AP_TERM_TAC THEN + MATCH_MP_TAC REAL_INTEGRAL_LMUL THEN + MATCH_MP_TAC AMD_XSLICE_INTEGRABLE THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC; + SUBGOAL_THEN + `(\x:real^1. if drop x IN FF /\ &1 <= drop(fstcart ab) /\ drop(fstcart + ab) <= &2 /\ + &0 <= drop(sndcart ab) /\ drop(sndcart ab) <= &n + then lift(inv(drop(fstcart ab)) * (if drop(fstcart ab) > &0 + then carleson_amd h (drop(fstcart ab)) (drop(sndcart ab)) + (drop x) else &0)) else vec 0) = (\x:real^1. vec 0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; REWRITE_TAC[INTEGRAL_0]]]);; + +(* KFF = the (a,b)-partial-integral of K3, absolutely_integrable on *) +(* real^(1,1)fs. *) +(* = FUBINI_HAS_ABSOLUTE_INTEGRAL_ALT (2nd conjunct) on K3 + K3_ABSLICE. *) +(* Gives *) +(* int K3 = int KFF, and KFF is the (1/a)int_FF amd box kernel used to BOUND *) +(* drop(int K3) directly (no exact SIDE-B nesting needed for *) +(* AAVG_INT_F_BOUND). *) +let KFF_ABSINT = prove + (`!(h:real->complex) FF n. schwartz h /\ real_measurable FF /\ ~(n = 0) + ==> (\ab:real^(1,1)finite_sum. + if &1 <= drop(fstcart ab) /\ drop(fstcart ab) <= &2 /\ &0 <= + drop(sndcart ab) /\ drop(sndcart ab) <= &n + then lift(inv(drop(fstcart ab)) * real_integral FF (\x. carleson_amd + h (drop(fstcart ab)) (drop(sndcart ab)) x)) + else vec 0) absolutely_integrable_on (:real^(1,1)finite_sum)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`h:real->complex`; `FF:real->bool`; + `n:num`] AMDT_BOX_ABSINT) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o CONJUNCT1 o CONJUNCT2 o MATCH_MP + FUBINI_HAS_ABSOLUTE_INTEGRAL_ALT) THEN + ASM_SIMP_TAC[K3_ABSLICE]);; + +(* ------------------------------------------------------------------------- *) +(* The constant-dominator box kernel (1/a)*M on [1,2]x[0,n]: abs-integrable *) +(* + *) +(* its integral = M*log2*n. KFF <= this pointwise (int_FF amd <= *) +(* 4C9||h||sqrt *) +(* by AMD_INT_F_BOUND), so drop(int K3) = drop(int KFF) <= M*log2*n bounds *) +(* the *) +(* box integral for AAVG_INT_F_BOUND -- NO exact SIDE-B nesting needed. *) +(* ------------------------------------------------------------------------- *) +let DOM_BOX_ABSINT = prove + (`!M n. (\ab:real^(1,1)finite_sum. + if &1 <= drop(fstcart ab) /\ drop(fstcart ab) <= &2 /\ &0 <= + drop(sndcart ab) /\ drop(sndcart ab) <= &n + then lift(inv(drop(fstcart ab)) * M) else vec 0) + absolutely_integrable_on (:real^(1,1)finite_sum)`, + REPEAT GEN_TAC THEN + MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE THEN + EXISTS_TAC `\ab:real^(1,1)finite_sum. abs M % indicator + {ab:real^(1,1)finite_sum | &1 <= drop(fstcart ab) /\ drop(fstcart ab) + <= &2 /\ &0 <= drop(sndcart ab) /\ drop(sndcart ab) <= &n} ab` THEN + REPEAT CONJ_TAC THENL + [MP_TAC(ISPECL [`\ab:real^(1,1)finite_sum. lift(inv(drop(fstcart ab)) * M)`; + `{ab:real^(1,1)finite_sum | &1 <= drop(fstcart ab) /\ drop(fstcart ab) <= + &2 /\ &0 <= drop(sndcart ab) /\ drop(sndcart ab) <= &n}`] + MEASURABLE_ON_RESTRICT) THEN + REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_ON_LIFT_MUL THEN + REWRITE_TAC[INVA_ABSLICE_MEASURABLE] THEN + REWRITE_TAC[MEASURABLE_ON_CONST]; + MATCH_MP_TAC MEASURABLE_IMP_LEBESGUE_MEASURABLE THEN + REWRITE_TAC[ABBOX_MEASURABLE]]; + MATCH_MP_TAC INTEGRABLE_CMUL THEN REWRITE_TAC[ETA_AX] THEN + REWRITE_TAC[INTEGRABLE_ON_INDICATOR; INTER_UNIV] THEN + REWRITE_TAC[GSYM MEASURABLE_INTEGRABLE; ABBOX_MEASURABLE]; + X_GEN_TAC `ab:real^(1,1)finite_sum` THEN REWRITE_TAC[IN_UNIV] THEN + REWRITE_TAC[indicator; IN_ELIM_THM; DROP_CMUL] THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[NORM_0; DROP_VEC; REAL_MUL_RZERO; REAL_LE_REFL; NORM_LIFT; + REAL_MUL_RID] THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_INV] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&1 * abs M` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN + MATCH_MP_TAC REAL_INV_LE_1 THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[REAL_MUL_LID; REAL_LE_REFL]]]);; + +(* the inner b-integral of the const dominator at fixed a. *) +let DOM_INNER = prove + (`!M n a. integral (:real^1) + (\y. if &1 <= drop a /\ drop a <= &2 /\ &0 <= drop y /\ drop y <= &n + then lift(inv(drop a) * M) else vec 0) = + (if &1 <= drop a /\ drop a <= &2 then lift(inv(drop a) * M * &n) else + vec 0)`, + REPEAT GEN_TAC THEN COND_CASES_TAC THENL + [ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`\b:real. inv(drop(a:real^1)) * M`; `&0:real`; + `&n:real`] CARLESON_INTERVAL_REAL_BRIDGE) THEN + REWRITE_TAC[REAL_INTEGRABLE_CONST] THEN DISCH_THEN SUBST1_TAC THEN + AP_TERM_TAC THEN SIMP_TAC[REAL_INTEGRAL_CONST; REAL_POS] THEN + REAL_ARITH_TAC; + SUBGOAL_THEN + `(\y:real^1. if &1 <= drop a /\ drop a <= &2 /\ &0 <= drop y /\ drop y <= + &n then lift(inv(drop a) * M) else vec 0) = (\y:real^1. vec 0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; REWRITE_TAC[INTEGRAL_0]]]);; + +(* inv integrable + the (M,n)-weighted inv integral value on [1,2]. *) +let INV_INTEGRABLE_1_2 = prove + (`(\a. inv a) real_integrable_on real_interval[&1,&2]`, + MATCH_MP_TAC REAL_INTEGRABLE_CONTINUOUS THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_INV THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_ID; IN_REAL_INTERVAL] THEN + REPEAT STRIP_TAC THEN ASM_REAL_ARITH_TAC);; + +let INV_MN_INTEGRAL_1_2 = prove + (`!M n. real_integral (real_interval[&1,&2]) (\a. inv a * M * &n) = M * &n * + log(&2)`, + REPEAT GEN_TAC THEN + ONCE_REWRITE_TAC[REAL_ARITH `inv a * M * &n = (M * &n) * inv a`] THEN + MP_TAC(ISPECL [`\a:real. inv a`; `(M:real) * &n`; + `real_interval[&1,&2]`] REAL_INTEGRAL_LMUL) THEN + REWRITE_TAC[INV_INTEGRABLE_1_2] THEN BETA_TAC THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[INV_INTEGRAL_1_2_LOG2] THEN + REAL_ARITH_TAC);; + +(* the constant-dominator box integral value = M*log2*n. *) +let DOM_BOX_INTEGRAL = prove + (`!M n. drop(integral (:real^(1,1)finite_sum) + (\ab. if &1 <= drop(fstcart ab) /\ drop(fstcart ab) <= &2 /\ &0 <= + drop(sndcart ab) /\ drop(sndcart ab) <= &n + then lift(inv(drop(fstcart ab)) * M) else vec 0)) = + M * log(&2) * &n`, + REPEAT GEN_TAC THEN + MP_TAC(ISPECL [`M:real`; `n:num`] DOM_BOX_ABSINT) THEN + DISCH_THEN(fun th -> ONCE_REWRITE_TAC[MATCH_MP FUBINI_INTEGRAL th]) THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN + REWRITE_TAC[DOM_INNER] THEN + SUBGOAL_THEN + `(\a:real. inv a * M * &n) real_integrable_on real_interval[&1,&2]` + ASSUME_TAC THENL + [ONCE_REWRITE_TAC[REAL_ARITH `inv a * M * &n = (M * &n) * inv a`] THEN + MP_TAC(ISPECL [`\a:real. inv a`; `(M:real) * &n`; + `real_interval[&1,&2]`] REAL_INTEGRABLE_LMUL) THEN + REWRITE_TAC[INV_INTEGRABLE_1_2] THEN BETA_TAC THEN + REWRITE_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL [`\a:real. inv a * M * &n`; `&1:real`; + `&2:real`] CARLESON_INTERVAL_REAL_BRIDGE) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> REWRITE_TAC[BETA_RULE th]) THEN + REWRITE_TAC[LIFT_DROP; INV_MN_INTEGRAL_1_2] THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* AAVG_INT_F_BOUND (Fremlin 286S(b) core): the n-th dilation-average *) +(* integral *) +(* bound int_F Aavg h n <= 4C9 log2 ||h||_2 sqrt(muF), from 286P (the ?C9 *) +(* tile *) +(* bound hypothesis). Direct box domination -- NO exact SIDE-B nesting *) +(* needed: *) +(* int_F Aavg = (1/n)int_F Sinner = (1/n)drop(int K3) = (1/n)drop(int KFF) *) +(* <= (1/n)*drop(int of inv(a)*M box) = (1/n)*M*log2*n = M*log2, *) +(* M=4C9||h||sqrt. *) +(* ------------------------------------------------------------------------- *) +(* drop(int K3) = drop(int KFF) [FUBINI_INTEGRAL_ALT ab-outer + K3_ABSLICE]. *) +let SIDE_A_KFF = prove + (`!(h:real->complex) FF n. schwartz h /\ real_measurable FF + ==> integral (:real^(1,(1,1)finite_sum)finite_sum) + (\z. if drop(fstcart z) IN FF /\ + &1 <= drop(fstcart(sndcart z)) /\ drop(fstcart(sndcart z)) <= + &2 /\ + &0 <= drop(sndcart(sndcart z)) /\ drop(sndcart(sndcart z)) <= + &n + then lift(inv(drop(fstcart(sndcart z))) * + (if drop(fstcart(sndcart z)) > &0 + then carleson_amd h (drop(fstcart(sndcart z))) + (drop(sndcart(sndcart z))) (drop(fstcart z)) + else &0)) + else vec 0) = + integral (:real^(1,1)finite_sum) + (\ab. if &1 <= drop(fstcart ab) /\ drop(fstcart ab) <= &2 /\ &0 <= + drop(sndcart ab) /\ drop(sndcart ab) <= &n + then lift(inv(drop(fstcart ab)) * real_integral FF (\x. + carleson_amd h (drop(fstcart ab)) (drop(sndcart ab)) x)) + else vec 0)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`h:real->complex`; `FF:real->bool`; + `n:num`] AMDT_BOX_ABSINT) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(fun th -> ONCE_REWRITE_TAC[MATCH_MP FUBINI_INTEGRAL_ALT th]) THEN + ASM_SIMP_TAC[K3_ABSLICE]);; + +let AAVG_INT_F_BOUND = prove + (`!(h:real->complex) FF n C9. + schwartz h /\ real_measurable FF /\ ~(n = 0) /\ &0 <= C9 /\ + (!(g:real->complex) GG. + schwartz g /\ real_measurable GG + ==> real_integral GG (carleson_A g) <= + &4 * C9 * lnorm (:real^1) (&2) (\z. g (drop z)) * sqrt + (real_measure GG)) + ==> real_integral FF (\x. carleson_Aavg h n x) <= + &4 * C9 * log(&2) * lnorm (:real^1) (&2) (\z. h (drop z)) * + sqrt(real_measure FF)`, + REPEAT STRIP_TAC THEN + ABBREV_TAC `L = lnorm (:real^1) (&2) (\z. (h:real->complex) (drop z))` THEN + ABBREV_TAC `S = sqrt(real_measure FF)` THEN + ABBREV_TAC `M = &4 * C9 * L * S` THEN + REWRITE_TAC[carleson_Aavg] THEN + SUBGOAL_THEN + `real_integral FF (\x. inv(&n) * carleson_Sinner h n x) = + inv(&n) * real_integral FF (\x. carleson_Sinner h n x)` + SUBST1_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_LMUL THEN MATCH_MP_TAC SINNER_INTEGRABLE_F THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MP_TAC(ISPECL [`h:real->complex`; `FF:real->bool`; `n:num`] SIDE_A) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + ASM_SIMP_TAC[SIDE_A_KFF] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `inv(&n) * (M * log(&2) * &n)` THEN CONJ_TAC THENL + [ALL_TAC; + SUBGOAL_THEN `inv(&n) * (M * log(&2) * &n) = M * log(&2)` SUBST1_TAC THENL + [SUBGOAL_THEN `~(&n = &0)` MP_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_EQ] THEN + ASM_REWRITE_TAC[]; CONV_TAC REAL_FIELD]; ALL_TAC] THEN + MATCH_MP_TAC REAL_EQ_IMP_LE THEN EXPAND_TAC "M" THEN REAL_ARITH_TAC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INV THEN REWRITE_TAC[REAL_POS]; ALL_TAC] THEN + MP_TAC(ISPECL [`M:real`; `n:num`] DOM_BOX_INTEGRAL) THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC INTEGRAL_DROP_LE THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC KFF_ABSINT THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + REWRITE_TAC[DOM_BOX_ABSINT]; + X_GEN_TAC `ab:real^(1,1)finite_sum` THEN REWRITE_TAC[IN_UNIV] THEN + COND_CASES_TAC THEN REWRITE_TAC[DROP_VEC; REAL_LE_REFL; LIFT_DROP] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INV THEN ASM_REAL_ARITH_TAC; + EXPAND_TAC "M" THEN + MP_TAC(ISPECL [`h:real->complex`; + `drop(fstcart(ab:real^(1,1)finite_sum))`; + `drop(sndcart(ab:real^(1,1)finite_sum))`; `FF:real->bool`; + `C9:real`] AMD_INT_F_BOUND) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_REAL_ARITH_TAC]]);; + +(* ================================================================= *) +(* 286S(b) FINAL: Aavg nonneg/absint/all-n bound + Atilde liminf. *) +(* SINNER_NONNEG, AAVG_NONNEG, AAVG_ABSINT, AAVG_INT_F_ALLN, *) +(* REALLIM_OF_CONVERGENT, ATILDE_INT_F_BOUND. *) +(* ================================================================= *) + +(* Sinner h n x >= 0: it is int_[1,2] (1/a) int_[0,n] amd, all factors >=0. *) +let SINNER_NONNEG = prove + (`!(h:real->complex) n x. schwartz h /\ ~(n = 0) ==> &0 <= carleson_Sinner h n + x`, + REPEAT STRIP_TAC THEN REWRITE_TAC[carleson_Sinner] THEN + MATCH_MP_TAC REAL_INTEGRAL_POS THEN CONJ_TAC THENL + [MATCH_MP_TAC A_ITERATE_INTEGRABLE THEN ASM_REWRITE_TAC[]; + X_GEN_TAC `a:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INV THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_INTEGRAL_POS THEN CONJ_TAC THENL + [MATCH_MP_TAC AMD_BSLICE_INTEGRABLE THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC; + X_GEN_TAC `b:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN + STRIP_TAC THEN + MATCH_MP_TAC AMD_NONNEG THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC]]]);; + +(* Aavg h n x >= 0 (handles n=0 giving 0). *) +let AAVG_NONNEG = prove + (`!(h:real->complex) n x. schwartz h ==> &0 <= carleson_Aavg h n x`, + REPEAT STRIP_TAC THEN REWRITE_TAC[carleson_Aavg] THEN + ASM_CASES_TAC `n = 0` THENL + [ASM_REWRITE_TAC[REAL_INV_0; REAL_MUL_LZERO; REAL_LE_REFL]; + MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INV THEN REWRITE_TAC[REAL_POS]; + MATCH_MP_TAC SINNER_NONNEG THEN ASM_REWRITE_TAC[]]]);; + +(* Aavg h n absolutely_real_integrable on FF (n=0 -> const 0). *) +let AAVG_ABSINT = prove + (`!(h:real->complex) FF n. schwartz h /\ real_measurable FF + ==> (\x. carleson_Aavg h n x) absolutely_real_integrable_on FF`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `n = 0` THENL + [ASM_REWRITE_TAC[carleson_Aavg; REAL_INV_0; REAL_MUL_LZERO] THEN + REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_0]; + REWRITE_TAC[carleson_Aavg] THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_LMUL THEN + MATCH_MP_TAC NONNEGATIVE_ABSOLUTELY_REAL_INTEGRABLE THEN CONJ_TAC THENL + [X_GEN_TAC `x:real` THEN DISCH_TAC THEN BETA_TAC THEN + MATCH_MP_TAC SINNER_NONNEG THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC SINNER_INTEGRABLE_F THEN ASM_REWRITE_TAC[]]]);; + +(* per-n integral bound (n=0 -> RHS>=0 trivially). *) +let AAVG_INT_F_ALLN = prove + (`!(h:real->complex) FF n C9. + schwartz h /\ real_measurable FF /\ &0 <= C9 /\ + (!(g:real->complex) GG. + schwartz g /\ real_measurable GG + ==> real_integral GG (carleson_A g) <= + &4 * C9 * lnorm (:real^1) (&2) (\z. g (drop z)) * sqrt + (real_measure GG)) + ==> real_integral FF (\x. carleson_Aavg h n x) <= + &4 * C9 * log(&2) * lnorm (:real^1) (&2) (\z. h (drop z)) * + sqrt(real_measure FF)`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `n = 0` THENL + [ASM_REWRITE_TAC[carleson_Aavg; REAL_INV_0; REAL_MUL_LZERO] THEN + REWRITE_TAC[REAL_INTEGRAL_0] THEN + REPEAT(MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC) THENL + [REAL_ARITH_TAC; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC LOG_POS THEN REAL_ARITH_TAC; + MATCH_MP_TAC LNORM_POS_LE THEN MATCH_MP_TAC SCHWARTZ_L2 THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC SQRT_POS_LE THEN MATCH_MP_TAC REAL_MEASURE_POS_LE THEN + ASM_REWRITE_TAC[]]; + MATCH_MP_TAC AAVG_INT_F_BOUND THEN ASM_REWRITE_TAC[]]);; + +(* a convergent real sequence has reallim = its limit. *) +let REALLIM_OF_CONVERGENT = prove + (`!f l. (f ---> l) sequentially ==> reallim sequentially f = l`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`sequentially`; `f:num->real`; `reallim sequentially f`; + `l:real`] REALLIM_UNIQUE) THEN + DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN + REWRITE_TAC[reallim] THEN CONV_TAC SELECT_CONV THEN + EXISTS_TAC `l:real` THEN ASM_REWRITE_TAC[]);; + +(* 286S(b) conclusion: int_F Atilde h <= 4 C9 log2 ||h||_2 sqrt muF. Atilde *) +(* = liminf_m Aavg h n; REAL_FATOU_LIMINF gives an a.e.-limit g with int_F g *) +(* <= liminf of the (uniformly-bounded) int_F Aavg; each of the latter <= *) +(* the RHS by AAVG_INT_F_ALLN, and Atilde = g a.e. via *) +(* REALLIM_OF_CONVERGENT. *) +let ATILDE_INT_F_BOUND = prove + (`!(h:real->complex) FF C9. + schwartz h /\ real_measurable FF /\ &0 <= C9 /\ + (!(g:real->complex) GG. schwartz g /\ real_measurable GG + ==> real_integral GG (carleson_A g) <= &4 * C9 * lnorm (:real^1) (&2) + (\z. g (drop z)) * sqrt (real_measure GG)) + ==> real_integral FF (\x. carleson_Atilde h x) <= + &4 * C9 * log(&2) * lnorm (:real^1) (&2) (\z. h (drop z)) * + sqrt(real_measure FF)`, + REPEAT STRIP_TAC THEN + ABBREV_TAC `B = &4 * C9 * log(&2) * lnorm (:real^1) (&2) (\z. + (h:real->complex) (drop z)) * sqrt(real_measure FF)` THEN + MP_TAC(ISPECL [`carleson_Aavg (h:real->complex)`; `FF:real->bool`; + `B:real`] REAL_FATOU_LIMINF) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [GEN_TAC THEN GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV) [GSYM ETA_AX] THEN + MATCH_MP_TAC AAVG_ABSINT THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + CONJ_TAC THENL + [REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC AAVG_NONNEG THEN + ASM_REWRITE_TAC[]; + GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM ETA_AX] THEN + EXPAND_TAC "B" THEN MATCH_MP_TAC AAVG_INT_F_ALLN THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `g:real->real` (X_CHOOSE_THEN + `k:real->bool` STRIP_ASSUME_TAC)) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `real_integral FF g` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_EQ_IMP_LE THEN + MATCH_MP_TAC REAL_INTEGRAL_SPIKE THEN EXISTS_TAC `k:real->bool` THEN + ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_DIFF] THEN + STRIP_TAC THEN + BETA_TAC THEN REWRITE_TAC[carleson_Atilde] THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC REALLIM_OF_CONVERGENT THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_DIFF]; + ASM_REWRITE_TAC[]]);; + +(* ========================================================================= *) +(* 256Mb interface for carleson_A (Fremlin 256M). *) +(* carleson_A h = sup over the UNCOUNTABLE z in R of the x-continuous *) +(* windows *) +(* carleson_v h z. By CM_MEASURABLE_SUP_COUNTABLE_REDUCTION *) +(* (= Fremlin's "there is a countable Psi with g = sup Psi", via LINDELOF) *) +(* the *) +(* sup equals one over a COUNTABLE nonempty index set for every x; *) +(* enumerating *) +(* it as a sequence and invoking CMAXSEQ_SUP_INTEGRAL_LE (the running-max *) +(* B.Levi *) +(* monotone convergence) reduces int_F carleson_A h <= C to the finite-max *) +(* integral bounds that 286N/286O(b) supply -- WITHOUT any upper-integral *) +(* machinery. This is exactly Fremlin's 286P step "int_F Ah = sup over *) +(* finite *) +(* {z_0..z_n} of int_F max|v_{z_i}|". *) +(* ========================================================================= *) + +(* The tile-window modulus v_z(x) = |2pi (hhat x theta_z) check(x)|. *) +let carleson_v = new_definition + `carleson_v (h:real->complex) (z:real) (x:real) = + norm(Cx(&2 * pi) * + fourier (\y. fourier h y * Cx(carleson_theta z y)) (--x))`;; + +(* carleson_v as a lambda (for MATCH against the window lemmas). *) +let CARLESON_V_ALT = prove + (`!(h:real->complex) z. + carleson_v h z = + (\x. norm(Cx(&2 * pi) * fourier (\y. fourier h y * Cx(carleson_theta z y)) + (--x)))`, + REWRITE_TAC[FUN_EQ_THM; carleson_v]);; + +(* carleson_v is nonnegative (a norm). *) +let CARLESON_V_POS = prove + (`!(h:real->complex) z x. &0 <= carleson_v h z x`, + REWRITE_TAC[carleson_v; NORM_POS_LE]);; + +(* Countable reduction of carleson_A: the uncountable sup over z in R equals *) +(* a sup over a COUNTABLE nonempty index set, for every x (256M via *) +(* LINDELOF; uses only x-continuity of the windows, so theta_z's *) +(* z-discontinuity is irrelevant, and carleson_A keeps its uncountable *) +(* definition intact). *) +let CARLESON_A_COUNTABLE = prove + (`!(h:real->complex). + schwartz h + ==> ?j. COUNTABLE j /\ ~(j = {}) /\ + (!x. carleson_A h x = sup {carleson_v h z x | z IN j})`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\z. carleson_v (h:real->complex) z`; `(:real)`] + CM_MEASURABLE_SUP_COUNTABLE_REDUCTION) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [X_GEN_TAC `z:real` THEN DISCH_TAC THEN X_GEN_TAC `x:real` THEN + REWRITE_TAC[CARLESON_V_ALT] THEN + MATCH_MP_TAC CARLESON_A_WINDOW_CONTINUOUS THEN ASM_REWRITE_TAC[]; + X_GEN_TAC `x:real` THEN + EXISTS_TAC `sqrt(&2 * pi) * + drop(integral (:real^1) (\y. lift(norm(fourier + (h:real->complex) (drop y)))))` THEN + X_GEN_TAC `z:real` THEN DISCH_TAC THEN REWRITE_TAC[carleson_v] THEN + MATCH_MP_TAC CARLESON_A_WINDOW_UNIFORM_BOUND THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[UNIV_NOT_EMPTY]]; + DISCH_THEN(X_CHOOSE_THEN `j:real->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `j:real->bool` THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `x:real` THEN + REWRITE_TAC[carleson_A] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real`) THEN + REWRITE_TAC[carleson_v; IN_UNIV]]);; + +(* Reindexing: for j = IMAGE u (:num), the value-set {v z x | z in j} equals *) +(* {abs(v(u n) x) | n} (v >= 0), matching CMAXSEQ_SUP_INTEGRAL_LE's sup *) +(* form. *) +let CARLESON_V_SET_REINDEX = prove + (`!(h:real->complex) u x. + {carleson_v h z x | z IN IMAGE u (:num)} = + {abs(carleson_v h (u n) x) | n IN (:num)}`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN + `!n:num. abs(carleson_v (h:real->complex) (u n) x) = carleson_v h (u n) x` + (fun th -> REWRITE_TAC[th]) THENL + [GEN_TAC THEN REWRITE_TAC[REAL_ABS_REFL; CARLESON_V_POS]; ALL_TAC] THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE; IN_UNIV] THEN + MESON_TAC[]);; + +(* 256Mb interface [KEY]: to bound int_F carleson_A h <= C it suffices that *) +(* for *) +(* EVERY enumeration u:num->real the windows are absolutely integrable on *) +(* FF, *) +(* uniformly bounded, and every finite running-max integral is <= C. (The *) +(* uniform "for every u" hypothesis is what the dilation-free 286N tile *) +(* bound *) +(* supplies for an arbitrary finite z-selection.) *) +let CARLESON_256MB_A = prove + (`!(h:real->complex) FF C. + schwartz h /\ + (!u:num->real. (!i. (\x. carleson_v h (u i) x) + absolutely_real_integrable_on FF) /\ + (?B. !i x. x IN FF ==> abs(carleson_v h (u i) x) <= B) /\ + (!n. real_integral FF (cmaxseq (\i. carleson_v h (u i)) n) + <= C)) + ==> real_integral FF (carleson_A h) <= C`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `h:real->complex` CARLESON_A_COUNTABLE) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `j:real->bool` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPEC `j:real->bool` COUNTABLE_AS_IMAGE) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `u:num->real` SUBST_ALL_TAC) THEN + SUBGOAL_THEN + `real_integral FF (carleson_A (h:real->complex)) = + real_integral FF (\x. sup {abs(carleson_v h (u n) x) | n IN (:num)})` + SUBST1_TAC THENL + [AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:real` THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[GSYM CARLESON_V_SET_REINDEX]; + ALL_TAC] THEN + MATCH_MP_TAC CMAXSEQ_SUP_INTEGRAL_LE THEN + FIRST_X_ASSUM(MP_TAC o SPEC `u:num->real`) THEN + STRIP_TAC THEN + EXISTS_TAC `B:real` THEN ASM_REWRITE_TAC[] THEN + ASM_REWRITE_TAC[ETA_AX]);; + +(* ------------------------------------------------------------------------- *) +(* Easy legs of the CARLESON_256MB_A hypothesis: the tile windows are *) +(* absolutely integrable on any measurable FF (continuous + bounded) and *) +(* uniformly bounded (0<=theta_z<=1 so |v_z|<=sqrt(2pi) int|hhat|). *) +(* ------------------------------------------------------------------------- *) + +(* Each window is absolutely real-integrable on a measurable FF (it is *) +(* everywhere continuous, hence measurable, and bounded by a constant that *) +(* is integrable on the finite-measure FF). *) +let CARLESON_V_ABSINT = prove + (`!(h:real->complex) z FF. + schwartz h /\ real_measurable FF + ==> (carleson_v h z) absolutely_real_integrable_on FF`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE + THEN + EXISTS_TAC `(\x:real. sqrt(&2 * pi) * + drop(integral (:real^1) (\y. lift(norm(fourier + (h:real->complex) (drop y))))))` THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC REAL_MEASURABLE_ON_MEASURABLE_SUBSET THEN + EXISTS_TAC `(:real)` THEN + ASM_REWRITE_TAC[SUBSET_UNIV] THEN + MATCH_MP_TAC CONTINUOUS_IMP_REAL_MEASURABLE_ON THEN + SIMP_TAC[REAL_CONTINUOUS_ON_EQ_REAL_CONTINUOUS_AT; REAL_OPEN_UNIV; + IN_UNIV] THEN + X_GEN_TAC `x:real` THEN + ONCE_REWRITE_TAC[CARLESON_V_ALT] THEN + MATCH_MP_TAC CARLESON_A_WINDOW_CONTINUOUS THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_INTEGRABLE_ON_CONST_MEASURABLE THEN ASM_REWRITE_TAC[]; + X_GEN_TAC `x:real` THEN DISCH_TAC THEN + REWRITE_TAC[carleson_v; REAL_ABS_NORM] THEN + MATCH_MP_TAC CARLESON_A_WINDOW_UNIFORM_BOUND THEN ASM_REWRITE_TAC[]]);; + +(* Uniform (in z and x) bound on the window modulus. *) +let CARLESON_V_UNIF_BOUND = prove + (`!(h:real->complex). schwartz h + ==> ?B. !z x. abs(carleson_v h z x) <= B`, + REPEAT STRIP_TAC THEN + EXISTS_TAC `sqrt(&2 * pi) * + drop(integral (:real^1) (\y. lift(norm(fourier (h:real->complex) + (drop y)))))` THEN + REPEAT GEN_TAC THEN REWRITE_TAC[carleson_v; REAL_ABS_NORM] THEN + MATCH_MP_TAC CARLESON_A_WINDOW_UNIFORM_BOUND THEN ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* 286P(b-i): the argmax selector + 246K sign trick. The complex window *) +(* w_z(x) = 2pi (hhat x theta_z) check(x) (carleson_v = |w_z|); cargmax *) +(* picks *) +(* the least i<=n achieving the running max cmaxseq, so W(x) = *) +(* w_{u(cargmax)}(x) *) +(* is Fremlin's sum_i w_i chi E_i collapsed to a single selected term, with *) +(* norm(W(x)) = cmaxseq..n x = sup_{i<=n}|w_i(x)| = v(x). *) +(* ------------------------------------------------------------------------- *) + +(* The complex tile window w_z(x) = 2pi (hhat x theta_z) check(x). *) +let carleson_w = new_definition + `carleson_w (h:real->complex) (z:real) (x:real) = + Cx(&2 * pi) * fourier (\y. fourier h y * Cx(carleson_theta z y)) (--x)`;; + +(* carleson_v z x = norm(carleson_w z x). *) +let CARLESON_V_EQ_NORM_W = prove + (`!(h:real->complex) z x. carleson_v h z x = norm(carleson_w h z x)`, + REWRITE_TAC[carleson_v; carleson_w]);; + +(* Argmax selector: the least index i<=n achieving the running max cmaxseq w *) +(* n. *) +let cargmax = define + `(cargmax (w:num->real->real) 0 x = 0) /\ + (cargmax w (SUC n) x = + if cmaxseq w n x < abs(w (SUC n) x) then SUC n else cargmax w n x)`;; + +(* cargmax w n x <= n. *) +let CARGMAX_LE = prove + (`!(w:num->real->real) n x. cargmax w n x <= n`, + GEN_TAC THEN INDUCT_TAC THEN GEN_TAC THEN REWRITE_TAC[cargmax] THENL + [REWRITE_TAC[LE_REFL]; + COND_CASES_TAC THEN REWRITE_TAC[LE_REFL] THEN + MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `n:num` THEN + ASM_REWRITE_TAC[] THEN ARITH_TAC]);; + +(* The selected term realizes the running max: |w (cargmax w n x) x| = *) +(* cmaxseq. *) +let CARGMAX_REALIZES = prove + (`!(w:num->real->real) n x. abs(w (cargmax w n x) x) = cmaxseq w n x`, + GEN_TAC THEN INDUCT_TAC THEN GEN_TAC THEN + REWRITE_TAC[cargmax; cmaxseq] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real`) THEN ASM_REAL_ARITH_TAC);; + +(* The selected complex window W(x)=w_{u(cargmax)}(x) has norm = the running *) +(* max of the real family v_i = |w_i| = carleson_v h (u i). This is *) +(* Fremlin's *) +(* v = |sum_i w_i chi E_i| with the E_i-partition realized by cargmax. *) +let CARLESON_W_SELECT_NORM = prove + (`!(h:real->complex) u n x. + norm(carleson_w h (u (cargmax (\i:num. carleson_v h (u i)) n x)) x) = + cmaxseq (\i:num. carleson_v h (u i)) n x`, + REPEAT GEN_TAC THEN + REWRITE_TAC[GSYM CARLESON_V_EQ_NORM_W] THEN + MP_TAC(ISPECL [`\i:num. carleson_v (h:real->complex) (u i)`; `n:num`; + `x:real`] + CARGMAX_REALIZES) THEN + REWRITE_TAC[] THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[REAL_ABS_REFL; CARLESON_V_POS]);; + +(* The selected window as a function of x (Fremlin's sum_i w_i chi E_i, as *) +(* one *) +(* selector term). carleson_wsel h u n = W_n where W_n(x) = w_{u(g x)}(x), *) +(* g x = cargmax..x; it follows the same recursion as cargmax. *) +let carleson_wsel = new_definition + `carleson_wsel (h:real->complex) (u:num->real) (n:num) (x:real) = + carleson_w h (u (cargmax (\i:num. carleson_v h (u i)) n x)) x`;; + +(* Recursion for the selected window (base = w(u 0); SUC picks the larger). *) +let CARLESON_WSEL_REC = prove + (`(!(h:real->complex) u x. carleson_wsel h u 0 x = carleson_w h (u 0) x) /\ + (!(h:real->complex) u n x. + carleson_wsel h u (SUC n) x = + (if cmaxseq (\i:num. carleson_v h (u i)) n x < carleson_v h (u (SUC n)) + x + then carleson_w h (u (SUC n)) x + else carleson_wsel h u n x))`, + CONJ_TAC THENL + [REWRITE_TAC[carleson_wsel; cargmax]; + REWRITE_TAC[carleson_wsel] THEN REPEAT GEN_TAC THEN + REWRITE_TAC[cargmax] THEN + SUBGOAL_THEN + `abs(carleson_v (h:real->complex) (u (SUC n)) x) = + carleson_v h (u (SUC n)) x` + SUBST1_TAC THENL + [REWRITE_TAC[REAL_ABS_REFL; CARLESON_V_POS]; ALL_TAC] THEN + COND_CASES_TAC THEN REWRITE_TAC[]]);; + +(* R3 entry (286P E_i-partition): on the argmax cell {x | cargmax..x = i}, *) +(* the *) +(* selected window carleson_wsel collapses to the single window carleson_w h *) +(* (u i) *) +(* -- immediate from the carleson_wsel definition. *) +let CARLESON_WSEL_ON_CELL = prove + (`!(h:real->complex) u n i x. + cargmax (\i:num. carleson_v h (u i)) n x = i + ==> carleson_wsel h u n x = carleson_w h (u i) x`, + REPEAT STRIP_TAC THEN REWRITE_TAC[carleson_wsel] THEN ASM_REWRITE_TAC[]);; + +(* Each fixed-z complex window is continuous on (:real^1) (fourier of an L^1 *) +(* fn). *) +let CARLESON_W_CONTINUOUS = prove + (`!(h:real->complex) z. schwartz h + ==> (\x:real^1. carleson_w h z (drop x)) continuous_on (:real^1)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[carleson_w] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_LMUL THEN + SUBGOAL_THEN + `(\x:real^1. fourier (\y. fourier (h:real->complex) y * Cx(carleson_theta z + y)) (--drop x)) = + (\x:real^1. fourier (\y. fourier (h:real->complex) y * Cx(carleson_theta z + y)) (drop x)) o (\x. --x)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; o_THM; DROP_NEG]; ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_NEG THEN REWRITE_TAC[CONTINUOUS_ON_ID]; + MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `(:real^1)` THEN + REWRITE_TAC[SUBSET_UNIV] THEN + MP_TAC(ISPEC `\y. fourier (h:real->complex) y * Cx(carleson_theta z y)` + FOURIER_CONTINUOUS_ON) THEN + ANTS_TAC THENL + [REWRITE_TAC[] THEN MATCH_MP_TAC CARLESON_FHAT_THETA_ABSINT THEN + ASM_REWRITE_TAC[]; + REWRITE_TAC[]]]);; + +let CARLESON_W_MEASURABLE = prove + (`!(h:real->complex) z. schwartz h + ==> (\x:real^1. carleson_w h z (drop x)) measurable_on (:real^1)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_IMP_MEASURABLE_ON THEN + MATCH_MP_TAC CARLESON_W_CONTINUOUS THEN ASM_REWRITE_TAC[]);; + +(* The complex tile window carleson_w h z is absolutely integrable on any *) +(* measurable *) +(* region (continuous, CARLESON_W_CONTINUOUS, + uniformly bounded by *) +(* sqrt(2pi) int|hhat| *) +(* on the finite-measure region, CARLESON_A_WINDOW_UNIFORM_BOUND). This *) +(* supplies the *) +(* per-cell integrability the 286P(b) Fubini reindex *) +(* CARLESON_CELL_SUM_INTEGRAL needs. *) +let CARLESON_V_LIFT_CONTINUOUS = prove + (`!(h:real->complex) z. schwartz h + ==> (\x:real^1. lift(carleson_v h z (drop x))) continuous_on (:real^1)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[CARLESON_V_EQ_NORM_W] THEN + MATCH_MP_TAC CONTINUOUS_ON_LIFT_NORM_COMPOSE THEN + MATCH_MP_TAC CARLESON_W_CONTINUOUS THEN ASM_REWRITE_TAC[]);; + +(* carleson_v h z real_continuous_on the whole line (for *) +(* CMAXSEQ_CONTINUOUS). *) +let CARLESON_V_REAL_CONTINUOUS_ON = prove + (`!(h:real->complex) z. schwartz h ==> carleson_v h z real_continuous_on + (:real)`, + REPEAT STRIP_TAC THEN + SIMP_TAC[REAL_CONTINUOUS_ON_EQ_REAL_CONTINUOUS_AT; REAL_OPEN_UNIV; + IN_UNIV] THEN + X_GEN_TAC `x:real` THEN ONCE_REWRITE_TAC[CARLESON_V_ALT] THEN + MATCH_MP_TAC CARLESON_A_WINDOW_CONTINUOUS THEN ASM_REWRITE_TAC[]);; + +(* Hence cmaxseq of the windows (lift form) is continuous on (:real^1). *) +let CMAXSEQ_CARLESON_V_LIFT_CONTINUOUS = prove + (`!(h:real->complex) u n. schwartz h + ==> (\x:real^1. lift(cmaxseq (\i:num. carleson_v h (u i)) n (drop x))) + continuous_on (:real^1)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `cmaxseq (\i:num. carleson_v (h:real->complex) (u i)) n real_continuous_on + (:real)` + MP_TAC THENL + [MATCH_MP_TAC CMAXSEQ_CONTINUOUS THEN GEN_TAC THEN REWRITE_TAC[] THEN + MATCH_MP_TAC CARLESON_V_REAL_CONTINUOUS_ON THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[REAL_CONTINUOUS_ON; IMAGE_LIFT_UNIV; o_DEF]);; + +(* The argmax-cell boundary is lebesgue-measurable (open superlevel of the *) +(* continuous difference carleson_v(SUC n) - cmaxseq n). *) +let CARLESON_WSEL_PRED_MEASURABLE = prove + (`!(h:real->complex) u n. schwartz h + ==> lebesgue_measurable + {x:real^1 | cmaxseq (\i:num. carleson_v h (u i)) n (drop x) < + carleson_v h (u (SUC n)) (drop x)}`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_OPEN THEN + SUBGOAL_THEN + `{x:real^1 | cmaxseq (\i:num. carleson_v h (u i)) n (drop x) < + carleson_v h (u (SUC n)) (drop x)} = + {x:real^1 | (\w:real^1. lift(carleson_v h (u (SUC n)) (drop w)) - + lift(cmaxseq (\i:num. carleson_v h (u i)) n (drop + w))) x + IN {y:real^1 | y$1 > &0}}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN GEN_TAC THEN + REWRITE_TAC[GSYM drop; DROP_SUB; LIFT_DROP; real_gt] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_OPEN_PREIMAGE_UNIV THEN + REWRITE_TAC[OPEN_HALFSPACE_COMPONENT_GT] THEN + GEN_TAC THEN MATCH_MP_TAC CONTINUOUS_SUB THEN CONJ_TAC THENL + [MP_TAC(ISPECL [`h:real->complex`; + `(u:num->real)(SUC n)`] CARLESON_V_LIFT_CONTINUOUS) THEN + ASM_REWRITE_TAC[] THEN + SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT; OPEN_UNIV; IN_UNIV]; + MP_TAC(ISPECL [`h:real->complex`; `u:num->real`; `n:num`] + CMAXSEQ_CARLESON_V_LIFT_CONTINUOUS) THEN + ASM_REWRITE_TAC[] THEN + SIMP_TAC[CONTINUOUS_ON_EQ_CONTINUOUS_AT; OPEN_UNIV; IN_UNIV]]);; + +(* The selected window is measurable_on (:real^1) (induction on n, *) +(* MEASURABLE_ON_ CASES at each argmax step). *) +let CARLESON_WSEL_MEASURABLE = prove + (`!(h:real->complex) u n. schwartz h + ==> (\x:real^1. carleson_wsel h u n (drop x)) measurable_on (:real^1)`, + GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN DISCH_TAC THENL + [SUBGOAL_THEN + `(\x:real^1. carleson_wsel (h:real->complex) u 0 (drop x)) = + (\x:real^1. carleson_w h (u 0) (drop x))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; CARLESON_WSEL_REC]; ALL_TAC] THEN + MATCH_MP_TAC CARLESON_W_MEASURABLE THEN ASM_REWRITE_TAC[]; + SUBGOAL_THEN + `(\x:real^1. carleson_wsel (h:real->complex) u (SUC n) (drop x)) = + (\x:real^1. if cmaxseq (\i:num. carleson_v h (u i)) n (drop x) < + carleson_v h (u (SUC n)) (drop x) + then carleson_w h (u (SUC n)) (drop x) + else carleson_wsel h u n (drop x))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + REWRITE_TAC[CARLESON_WSEL_REC]; ALL_TAC] THEN + MATCH_MP_TAC MEASURABLE_ON_CASES THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CARLESON_WSEL_PRED_MEASURABLE THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC CARLESON_W_MEASURABLE THEN ASM_REWRITE_TAC[]; + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]]);; + +(* The argmax cell {x | cargmax..drop x = i} is lebesgue-measurable *) +(* (induction on n: *) +(* base cargmax 0 = 0 so cell = UNIV or {}; SUC n splits by the "new max" *) +(* predicate *) +(* superlevel CARLESON_WSEL_PRED_MEASURABLE -- i = SUC n gives that set *) +(* directly *) +(* (cargmax n <= n < SUC n so the else-branch never equals SUC n, *) +(* CARGMAX_LE), else *) +(* its complement INTER the scale-n cell). Closes MESON-free (num *) +(* COND-equality by *) +(* ARITH, never MESON with the heavy carleson_v context in scope). R3 *) +(* E_i-partition. *) +let CARLESON_CELL_MEASURABLE = prove + (`!(h:real->complex) u n i. schwartz h ==> + lebesgue_measurable {x:real^1 | cargmax (\i:num. carleson_v h (u i)) n + (drop x) = i}`, + GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN GEN_TAC THEN DISCH_TAC THENL + [REWRITE_TAC[cargmax] THEN + ASM_CASES_TAC `i = 0` THEN ASM_REWRITE_TAC[] THENL + [REWRITE_TAC[SET_RULE `{x | T} = (:real^1)`; LEBESGUE_MEASURABLE_UNIV]; + ASM_REWRITE_TAC[SET_RULE `{x | F} = {}`; LEBESGUE_MEASURABLE_EMPTY]]; + REWRITE_TAC[cargmax] THEN + SUBGOAL_THEN + `!x:real^1. abs(carleson_v h (u (SUC n)) (drop x)) = carleson_v h (u (SUC + n)) (drop x)` + (fun th -> REWRITE_TAC[th]) THENL + [REWRITE_TAC[REAL_ABS_REFL; CARLESON_V_POS]; ALL_TAC] THEN + ASM_CASES_TAC `i = SUC n` THEN ASM_REWRITE_TAC[] THENL + [SUBGOAL_THEN + `{x:real^1 | (if cmaxseq (\i:num. carleson_v h (u i)) n (drop x) < + carleson_v h (u (SUC n)) (drop x) + then SUC n else cargmax (\i:num. carleson_v h (u i)) n + (drop x)) = SUC n} = + {x | cmaxseq (\i:num. carleson_v h (u i)) n (drop x) < carleson_v h (u + (SUC n)) (drop x)}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `x:real^1` THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`\i:num. carleson_v (h:real->complex) (u i)`; `n:num`; + `drop(x:real^1)`] CARGMAX_LE) THEN + ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC CARLESON_WSEL_PRED_MEASURABLE THEN ASM_REWRITE_TAC[]; + SUBGOAL_THEN + `{x:real^1 | (if cmaxseq (\i:num. carleson_v h (u i)) n (drop x) < + carleson_v h (u (SUC n)) (drop x) + then SUC n else cargmax (\i:num. carleson_v h (u i)) n + (drop x)) = i} = + ((:real^1) DIFF {x | cmaxseq (\i:num. carleson_v h (u i)) n (drop x) < + carleson_v h (u (SUC n)) (drop x)}) + INTER {x | cargmax (\i:num. carleson_v h (u i)) n (drop x) = i}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_INTER; IN_DIFF; IN_UNIV; IN_ELIM_THM] THEN + X_GEN_TAC `x:real^1` THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC LEBESGUE_MEASURABLE_INTER THEN CONJ_TAC THENL + [MATCH_MP_TAC LEBESGUE_MEASURABLE_DIFF THEN + REWRITE_TAC[LEBESGUE_MEASURABLE_UNIV] THEN + MATCH_MP_TAC CARLESON_WSEL_PRED_MEASURABLE THEN ASM_REWRITE_TAC[]; + ASM_SIMP_TAC[]]]]);; + +(* The argmax selector g x = u(cargmax (\i. carleson_v h(u i)) n x) is a *) +(* finite *) +(* step function -- value u j on the (lebesgue-measurable) argmax cell *) +(* {cargmax..=j}, *) +(* j<=n, and those cells partition (:real) (CARGMAX_LE). So lift o g o drop *) +(* = vsum_ *) +(* {j<=n} u j % indicator(cell j) is measurable *) +(* (MEASURABLE_ON_VSUM/CMUL/INDICATOR), *) +(* i.e. g real_measurable_on (:real). This is the g-measurability *) +(* side-condition of *) +(* CARLESON_WSEL_TILE_LIMIT (286P-b), needed by 286N_SCALED at the argmax *) +(* selector. *) +let CARLESON_G_SELECTOR_MEASURABLE = prove + (`!(h:real->complex) u n. schwartz h + ==> (\x. u(cargmax (\i:num. carleson_v h (u i)) n x)) real_measurable_on + (:real)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[real_measurable_on; IMAGE_LIFT_UNIV; o_DEF] THEN + SUBGOAL_THEN + `(\x:real^1. lift(u(cargmax (\i:num. carleson_v (h:real->complex) (u i)) n + (drop x)))) = + (\x:real^1. vsum {j:num | j <= n} + (\j. (u j) % indicator {z:real^1 | cargmax (\i:num. carleson_v h (u i)) + n (drop z) = j} x))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:real^1` THEN + REWRITE_TAC[indicator; IN_ELIM_THM] THEN + SUBGOAL_THEN + `(\j. (u j) % (if cargmax (\i:num. carleson_v (h:real->complex) (u i)) n + (drop x) = j + then vec 1 else vec 0):real^1) = + (\j. if j = cargmax (\i:num. carleson_v (h:real->complex) (u i)) n (drop + x) + then lift(u (cargmax (\i:num. carleson_v h (u i)) n (drop x))) else + vec 0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `j:num` THEN + COND_CASES_TAC THENL + [FIRST_ASSUM(SUBST1_TAC o SYM) THEN + REWRITE_TAC[VECTOR_MUL_RZERO; GSYM LIFT_NUM; GSYM LIFT_CMUL; + REAL_MUL_RID]; + REWRITE_TAC[VECTOR_MUL_RZERO] THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[EQ_SYM_EQ]]; ALL_TAC] THEN + REWRITE_TAC[VSUM_DELTA; IN_ELIM_THM; CARGMAX_LE]; + MATCH_MP_TAC MEASURABLE_ON_VSUM THEN REWRITE_TAC[FINITE_NUMSEG_LE] THEN + X_GEN_TAC `j:num` THEN DISCH_TAC THEN MATCH_MP_TAC MEASURABLE_ON_CMUL THEN + REWRITE_TAC[ETA_AX; MEASURABLE_ON_INDICATOR; INTER_UNIV] THEN + ASM_SIMP_TAC[CARLESON_CELL_MEASURABLE]]);; + +(* cw_tile integrability side-condition of CARLESON_WSEL_TILE_LIMIT *) +(* (286P-b): for the *) +(* argmax selector g and measurable FF, cw_tile t is real-integrable on the *) +(* g-preimage *) +(* {x IN FF | g x IN tile_J t}. That region = FF INTER {g x IN dyho...} is *) +(* real- *) +(* lebesgue-measurable (H_PREIMAGE_DYHO_LEBESGUE at the measurable g + FF *) +(* meas), sits *) +(* inside FF (measurable), so real_measurable *) +(* (REAL_MEASURABLE_LEBMEAS_SUBSET) -> cw_tile *) +(* integrable (CWTILE_INTEGRABLE_MEASURABLE). Mirrors the 286N cw_tile leg. *) +let CARLESON_G_CWTILE_INTEGRABLE = prove + (`!(h:real->complex) u n FF t. + schwartz h /\ real_measurable FF + ==> cw_tile t real_integrable_on + {x | x IN FF /\ (u(cargmax (\i:num. carleson_v h (u i)) n x)) IN + tile_J t}`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CWTILE_INTEGRABLE_MEASURABLE THEN + MATCH_MP_TAC REAL_MEASURABLE_LEBMEAS_SUBSET THEN + EXISTS_TAC `FF:real->bool` THEN REPEAT CONJ_TAC THENL + [SUBGOAL_THEN + `{x | x IN FF /\ (u(cargmax (\i:num. carleson_v (h:real->complex) (u i)) n + x)) IN tile_J t} = + FF INTER {x | (\y. u(cargmax (\i:num. carleson_v h (u i)) n y)) x IN + tile_J t}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LEBESGUE_MEASURABLE_INTER THEN CONJ_TAC THENL + [ASM_SIMP_TAC[REAL_MEASURABLE_IMP_REAL_LEBESGUE_MEASURABLE]; + SUBGOAL_THEN + `t:int#int#int = (FST t, FST(SND t), SND(SND t))` SUBST1_TAC THENL + [REWRITE_TAC[PAIR]; ALL_TAC] THEN + REWRITE_TAC[tile_J] THEN BETA_TAC THEN + MATCH_MP_TAC H_PREIMAGE_DYHO_LEBESGUE THEN + MATCH_MP_TAC CARLESON_G_SELECTOR_MEASURABLE THEN ASM_REWRITE_TAC[]]; + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN MESON_TAC[]]);; + +(* phi_sigma s carleson_phi is Schwartz, hence absolutely integrable on *) +(* (:real^1), *) +(* hence integrable on any lebesgue-measurable subset of IMAGE lift FF (in *) +(* particular *) +(* the argmax cell-pieces). This is the `ff integrable_on cell-piece` *) +(* hypothesis *) +(* that CARLESON_CELL_SUM_INTEGRAL (the regroup-by-tile step of the *) +(* tile-limit) needs *) +(* with ff = phi_sigma. (MATCH_MP_TAC can't unify the compound phi_sigma s *) +(* carleson_ *) +(* phi against SCHWARTZ_ABSINT's `h`; use MP_TAC(ISPEC ...) forward.) *) +let CARLESON_PHISIG_PIECE_INTEGRABLE = prove + (`!(s:int#int#int) FF S. + real_measurable FF /\ S SUBSET (IMAGE lift FF) /\ lebesgue_measurable S + ==> (\z:real^1. phi_sigma s carleson_phi (drop z)) integrable_on S`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MP_TAC(ISPECL + [`\z:real^1. phi_sigma s carleson_phi (drop z)`; `(:real^1)`; + `S:real^1->bool`] + ABSOLUTELY_INTEGRABLE_ON_LEBESGUE_MEASURABLE_SUBSET) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[SUBSET_UNIV] THEN + MP_TAC(ISPEC `phi_sigma (s:int#int#int) carleson_phi` SCHWARTZ_ABSINT) THEN + ANTS_TAC THENL + [MATCH_MP_TAC PHISIG_SCHWARTZ THEN REWRITE_TAC[CARLESON_PHI_SCHWARTZ]; + REWRITE_TAC[]]; + DISCH_THEN ACCEPT_TAC]);; + +(* The argmax cells {x | cargmax..drop x = j}, j<=n, COVER (:real^1) -- *) +(* every point lands in the cell of its own cargmax value (which is <= n, *) +(* CARGMAX_LE). *) +let CARLESON_CELL_DISJOINT = prove + (`!(h:real->complex) u n j j'. + ~(j = j') + ==> {x:real^1 | cargmax (\i:num. carleson_v h (u i)) n (drop x) = j} INTER + {x:real^1 | cargmax (\i:num. carleson_v h (u i)) n (drop x) = j'} = + {}`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM; NOT_IN_EMPTY] THEN + X_GEN_TAC `x:real^1` THEN ASM_MESON_TAC[]);; + +(* Cell-merge (the set-theoretic core of Fremlin 286P(b)'s *) +(* Fubini-over-counting): the *) +(* argmax cells j (j<=n) whose selected value u j lies in V union exactly to *) +(* the *) +(* selector-preimage F' INTER {x | u(cargmax..x) IN V}. On cell j the *) +(* selector g x = *) +(* u(cargmax..x) = u j, so "u j in V" <=> "g x in V"; cells partition *) +(* (CARGMAX_LE gives *) +(* the witnessing j<=n). This links the per-cell decomposition to the *) +(* g^-1[Jr_sigma] *) +(* regions that CARLESON_286N bounds. *) +let CARLESON_CELL_MERGE = prove + (`!(h:real->complex) u n (F':real^1->bool) (V:real->bool). + UNIONS (IMAGE (\j. F' INTER {x:real^1 | cargmax (\i:num. carleson_v h (u + i)) n (drop x) = j}) + {j | j <= n /\ u j IN V}) + = F' INTER {x:real^1 | (u (cargmax (\i:num. carleson_v h (u i)) n (drop + x))) IN V}`, + REPEAT GEN_TAC THEN + REWRITE_TAC[UNIONS_IMAGE; EXTENSION; IN_ELIM_THM; IN_INTER] THEN + X_GEN_TAC `x:real^1` THEN EQ_TAC THENL + [DISCH_THEN(X_CHOOSE_THEN `j:num` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[]; + STRIP_TAC THEN + EXISTS_TAC `cargmax (\i:num. carleson_v (h:real->complex) (u i)) n (drop + x)` THEN + ASM_REWRITE_TAC[CARGMAX_LE]]);; + +(* Integral-level Fubini reindex (the CORRECT 286P(b) route -- regroup by *) +(* TILE not *) +(* per-cell-norm-triangle): for any integrand ff integrable on each *) +(* cell-piece, the *) +(* integral over the merged selector-preimage F' INTER g^-1[V] equals the *) +(* sum over the *) +(* contributing cells (u j in V) of the per-piece integrals. CELL_MERGE *) +(* (region union) *) +(* + HAS_INTEGRAL_UNIONS_IMAGE (sums over the INDEX set {j<=n /\ u j in V}, *) +(* pairwise cells *) +(* disjoint) + INTEGRAL_UNIQUE. This feeds one 286N call for the merged set. *) +let CARLESON_CELL_SUM_INTEGRAL = prove + (`!(ff:real^1->complex) (h:real->complex) u n (F':real^1->bool) + (V:real->bool). + (!j. ff integrable_on (F' INTER {x:real^1 | cargmax (\i:num. carleson_v h + (u i)) n (drop x) = j})) + ==> integral (F' INTER {x:real^1 | (u (cargmax (\i:num. carleson_v h (u + i)) n (drop x))) IN V}) ff + = vsum {j:num | j <= n /\ u j IN V} + (\j. integral (F' INTER {x:real^1 | cargmax (\i:num. carleson_v h + (u i)) n (drop x) = j}) ff)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`h:real->complex`; `u:num->real`; `n:num`; `F':real^1->bool`; + `V:real->bool`] CARLESON_CELL_MERGE) THEN + DISCH_THEN(fun th -> GEN_REWRITE_TAC (LAND_CONV o RATOR_CONV o RAND_CONV) + [SYM th]) THEN + MATCH_MP_TAC INTEGRAL_UNIQUE THEN + MATCH_MP_TAC HAS_INTEGRAL_UNIONS_IMAGE THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{j:num | j <= n}` THEN + REWRITE_TAC[FINITE_NUMSEG_LE; SUBSET; IN_ELIM_THM] THEN MESON_TAC[]; + X_GEN_TAC `j:num` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + MATCH_MP_TAC INTEGRABLE_INTEGRAL THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[pairwise; IN_ELIM_THM] THEN + MAP_EVERY X_GEN_TAC [`a:num`; `b:num`] THEN STRIP_TAC THEN + MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN + EXISTS_TAC `{}:real^1->bool` THEN REWRITE_TAC[NEGLIGIBLE_EMPTY] THEN + MP_TAC(ISPECL [`h:real->complex`; `u:num->real`; `n:num`; `a:num`; + `b:num`] CARLESON_CELL_DISJOINT) THEN + ASM_REWRITE_TAC[] THEN SET_TAC[]]);; + +(* The selected window is absolutely integrable on lift(FF) (measurable + *) +(* bounded *) +(* by the uniform-bound constant, integrable on the finite-measure FF). This *) +(* is *) +(* the hypothesis K246_SIGN_TRICK consumes. *) +let CARLESON_WSEL_ABSINT = prove + (`!(h:real->complex) u n FF. + schwartz h /\ real_measurable FF + ==> (\x:real^1. carleson_wsel h u n (drop x)) absolutely_integrable_on + (IMAGE lift FF)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `h:real->complex` CARLESON_V_UNIF_BOUND) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `B:real`) THEN + MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE THEN + EXISTS_TAC `(\x:real^1. lift B)` THEN REPEAT CONJ_TAC THENL + [MP_TAC(ISPECL [`(\x:real^1. carleson_wsel (h:real->complex) u n (drop x))`; + `IMAGE lift (FF:real->bool)`; `(:real^1)`] + MEASURABLE_ON_MEASURABLE_SUBSET) THEN + DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[SUBSET_UNIV] THEN CONJ_TAC THENL + [MATCH_MP_TAC CARLESON_WSEL_MEASURABLE THEN ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[GSYM REAL_MEASURABLE_MEASURABLE]]; + REWRITE_TAC[INTEGRABLE_ON_CONST] THEN DISJ2_TAC THEN + ASM_REWRITE_TAC[GSYM REAL_MEASURABLE_MEASURABLE]; + X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN REWRITE_TAC[LIFT_DROP] THEN + REWRITE_TAC[carleson_wsel; GSYM CARLESON_V_EQ_NORM_W] THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`(u:num->real)(cargmax (\i:num. carleson_v (h:real->complex) (u i)) n + (drop x))`; + `drop(x:real^1)`]) THEN + REAL_ARITH_TAC]);; + +(* ========================================================================= *) +(* R3b (Fremlin 286P E_i-argmax partition, 2269-2290): the *) +(* cell-decomposition *) +(* of the selected-window integral. int_F' carleson_wsel = sum_{j<=n} int *) +(* over *) +(* (F' cap argmax-cell j) of carleson_w h(u j). Via *) +(* HAS_INTEGRAL_UNIONS_IMAGE *) +(* over the disjoint F'-restricted cells (which cover F', CELL_COVERS), each *) +(* piece contributing carleson_w h(u j) (WSEL_ON_CELL). *) +(* ========================================================================= *) + +(* carleson_wsel restricted to a lebesgue-measurable subset of lift FF is *) +(* integrable. *) +let CARLESON_WSEL_PIECE_INTEGRABLE = prove + (`!(h:real->complex) u n FF S. + schwartz h /\ real_measurable FF /\ S SUBSET (IMAGE lift FF) /\ + lebesgue_measurable S + ==> (\x:real^1. carleson_wsel h u n (drop x)) integrable_on S`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN + EXISTS_TAC `IMAGE lift FF` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC CARLESON_WSEL_ABSINT THEN ASM_REWRITE_TAC[]);; + +(* The piece F' INTER cell j is lebesgue-measurable. *) +let CARLESON_WSEL_PIECE_LMEAS = prove + (`!(h:real->complex) u n F' j. + schwartz h /\ measurable F' + ==> lebesgue_measurable + (F' INTER {x:real^1 | cargmax (\i:num. carleson_v h (u i)) n (drop + x) = j})`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_INTER THEN + ASM_SIMP_TAC[MEASURABLE_IMP_LEBESGUE_MEASURABLE; CARLESON_CELL_MEASURABLE]);; + +(* Per-index: carleson_wsel has_integral (int of carleson_w) on the piece. *) +(* wsel = *) +(* carleson_w on the cell (WSEL_ON_CELL), so INTEGRAL_EQ rewrites the target *) +(* integral to *) +(* the wsel-integral, then INTEGRABLE_INTEGRAL (avoids the free y that *) +(* MATCH_MP HAS_ *) +(* INTEGRAL_SPIKE would leave). *) +let CARLESON_WSEL_PIECE_HASINT = prove + (`!(h:real->complex) u n FF F' j. + schwartz h /\ real_measurable FF /\ measurable F' /\ F' SUBSET (IMAGE lift + FF) + ==> ((\x:real^1. carleson_wsel h u n (drop x)) has_integral + integral (F' INTER {x:real^1 | cargmax (\i:num. carleson_v h (u i)) n + (drop x) = j}) + (\x. carleson_w h (u j) (drop x))) + (F' INTER {x:real^1 | cargmax (\i:num. carleson_v h (u i)) n (drop x) + = j})`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `integral (F' INTER {x:real^1 | cargmax (\i:num. carleson_v h (u i)) n (drop + x) = j}) + (\x. carleson_w h (u j) (drop x)) = + integral (F' INTER {x:real^1 | cargmax (\i:num. carleson_v h (u i)) n (drop + x) = j}) + (\x. carleson_wsel h u n (drop x))` + SUBST1_TAC THENL + [MATCH_MP_TAC INTEGRAL_EQ THEN X_GEN_TAC `x:real^1` THEN + REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN STRIP_TAC THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC CARLESON_WSEL_ON_CELL THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC INTEGRABLE_INTEGRAL THEN + MATCH_MP_TAC CARLESON_WSEL_PIECE_INTEGRABLE THEN + EXISTS_TAC `FF:real->bool` THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [ASM SET_TAC[]; + MATCH_MP_TAC CARLESON_WSEL_PIECE_LMEAS THEN ASM_REWRITE_TAC[]]]);; + +(* The F'-restricted argmax cells are pairwise negligible-intersecting. *) +let CARLESON_WSEL_PIECES_PAIRWISE = prove + (`!(h:real->complex) u n F'. + pairwise (\a b. negligible ((F' INTER {x:real^1 | cargmax (\i:num. + carleson_v h (u i)) n (drop x) = a}) INTER + (F' INTER {x:real^1 | cargmax (\i:num. + carleson_v h (u i)) n (drop x) = b}))) + {j:num | j <= n}`, + REPEAT GEN_TAC THEN REWRITE_TAC[pairwise; IN_ELIM_THM] THEN + MAP_EVERY X_GEN_TAC [`a:num`; `b:num`] THEN STRIP_TAC THEN + MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN + EXISTS_TAC `{}:real^1->bool` THEN REWRITE_TAC[NEGLIGIBLE_EMPTY] THEN + MP_TAC(ISPECL [`h:real->complex`; `u:num->real`; `n:num`; `a:num`; + `b:num`] CARLESON_CELL_DISJOINT) THEN + ASM_REWRITE_TAC[] THEN SET_TAC[]);; + +(* The cell-decomposition [R3b KEY]. F' measurable SUBSET lift FF. *) +let CARLESON_WSEL_REGION_DECOMP = prove + (`!(h:real->complex) u n FF F'. + schwartz h /\ real_measurable FF /\ measurable F' /\ F' SUBSET (IMAGE lift + FF) + ==> integral F' (\x:real^1. carleson_wsel h u n (drop x)) = + vsum {j:num | j <= n} + (\j. integral (F' INTER {x:real^1 | cargmax (\i:num. carleson_v h (u + i)) n (drop x) = j}) + (\x. carleson_w h (u j) (drop x)))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `F' = UNIONS (IMAGE (\j:num. F' INTER {x:real^1 | cargmax (\i:num. + carleson_v h (u i)) n (drop x) = j}) {j | j <= n})` + ASSUME_TAC THENL + [REWRITE_TAC[UNIONS_IMAGE; EXTENSION; IN_ELIM_THM; IN_INTER] THEN + X_GEN_TAC `x:real^1` THEN EQ_TAC THENL + [DISCH_TAC THEN + EXISTS_TAC `cargmax (\i:num. carleson_v (h:real->complex) (u i)) n (drop + x)` THEN + ASM_REWRITE_TAC[CARGMAX_LE]; + STRIP_TAC THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN + GEN_REWRITE_TAC (LAND_CONV o RATOR_CONV o RAND_CONV) + [ASSUME `F' = UNIONS (IMAGE (\j:num. F' INTER {x:real^1 | cargmax (\i:num. + carleson_v h (u i)) n (drop x) = j}) {j | j <= n})`] THEN + MP_TAC(ISPECL + [`\x:real^1. carleson_wsel h u n (drop x)`; + `\j:num. F' INTER {x:real^1 | cargmax (\i:num. carleson_v h (u i)) n (drop + x) = j}`; + `\j:num. integral (F' INTER {x:real^1 | cargmax (\i:num. carleson_v h (u + i)) n (drop x) = j}) + (\x. carleson_w h (u j) (drop x))`; + `{j:num | j <= n}`] HAS_INTEGRAL_UNIONS_IMAGE) THEN + ANTS_TAC THENL + [REWRITE_TAC[FINITE_NUMSEG_LE] THEN CONJ_TAC THENL + [X_GEN_TAC `j:num` THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN + MATCH_MP_TAC CARLESON_WSEL_PIECE_HASINT THEN + EXISTS_TAC `FF:real->bool` THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[CARLESON_WSEL_PIECES_PAIRWISE]]; + DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP INTEGRAL_UNIQUE th])]);; + +(* R3e step 1: the norm of the selected-window integral is <= the sum over *) +(* cells of the per-cell window-integral norms (triangle inequality *) +(* VSUM_NORM on the cell-decomp). Reduces the tile-bound gate to bounding *) +(* sum_j norm(int_{piece j} carleson_w h(u j)). *) +let CMAXSEQ_CARLESON_V_ABSINT = prove + (`!(h:real->complex) u n FF. + schwartz h /\ real_measurable FF + ==> (cmaxseq (\i:num. carleson_v h (u i)) n) absolutely_real_integrable_on + FF`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CMAXSEQ_ABSINT THEN + GEN_TAC THEN REWRITE_TAC[] THEN MATCH_MP_TAC CARLESON_V_ABSINT THEN + ASM_REWRITE_TAC[]);; + +(* 286P(b-i) [Fremlin mt286.tex 2280-2285]: the 246K sign trick applied to *) +(* the *) +(* selected window. For a finite selection u,n there is a measurable *) +(* F' SUBSET lift(FF) with int_FF (sup_{i<=n}|v_{u i}|) <= 4 norm(int_F' *) +(* W_n), *) +(* where W_n = carleson_wsel (Fremlin's sum_i v_i chi E_i as one selector *) +(* term). *) +(* This isolates the whole remaining depth into bounding norm(int_F' W_n). *) +let CARLESON_FINITEMAX_246K = prove + (`!(h:real->complex) u n FF. + schwartz h /\ real_measurable FF + ==> ?F'. measurable F' /\ F' SUBSET IMAGE lift FF /\ + real_integral FF (cmaxseq (\i:num. carleson_v h (u i)) n) <= + &4 * norm(integral F' (\x:real^1. carleson_wsel h u n (drop + x)))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`(\x:real^1. carleson_wsel (h:real->complex) u n (drop x))`; + `IMAGE lift (FF:real->bool)`] K246_SIGN_TRICK) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[CARLESON_WSEL_ABSINT; GSYM REAL_MEASURABLE_MEASURABLE]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `F':real^1->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `F':real^1->bool` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `real_integral FF (cmaxseq (\i:num. carleson_v (h:real->complex) (u i)) n) = + drop(integral (IMAGE lift FF) (\x:real^1. lift(norm(carleson_wsel h u n + (drop x)))))` + (fun th -> ASM_REWRITE_TAC[th]) THENL + [SUBGOAL_THEN + `cmaxseq (\i:num. carleson_v (h:real->complex) (u i)) n real_integrable_on + FF` + ASSUME_TAC THENL + [MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC CMAXSEQ_CARLESON_V_ABSINT THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_INTEGRAL] THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM; o_THM] THEN + X_GEN_TAC `x:real^1` THEN AP_TERM_TAC THEN + REWRITE_TAC[carleson_wsel] THEN REWRITE_TAC[CARLESON_W_SELECT_NORM]; + RULE_ASSUM_TAC(CONV_RULE(DEPTH_CONV BETA_CONV)) THEN ASM_REWRITE_TAC[]]);; + +(* 286O(b) per-k spatial identity, elementary half (Fremlin mt286.tex *) +(* 2139-2140): *) +(* over a lebesgue-measurable region R, the integral of a FINITE tile-sum *) +(* equals *) +(* the coefficient-weighted sum of phi_sigma integrals. Pure linearity of *) +(* the *) +(* integral over a finite vsum (INTEGRAL_VSUM), each phi_sigma integrable on *) +(* R *) +(* (PHISIG_ABSINT_LEBESGUE). The DEEP half -- that this sum converges to *) +(* 2pi int_R (hhat theta_z)check -- is the remaining b-ii filter-limit work. *) +let CHI_MEASURABLE_ON = prove + (`!(R:real^1->bool). measurable R + ==> (\x. if x IN R then Cx(&1) else Cx(&0)) measurable_on (:real^1)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC MEASURABLE_ON_CASES THEN + REPEAT CONJ_TAC THENL + [SUBGOAL_THEN `{x:real^1 | x IN R} = R` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM]; ALL_TAC] THEN + MATCH_MP_TAC MEASURABLE_IMP_LEBESGUE_MEASURABLE THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[MEASURABLE_ON_CONST]; + REWRITE_TAC[MEASURABLE_ON_CONST]]);; + +let INDICATOR_L2_UNIV = prove + (`!(R:real^1->bool). measurable R + ==> indicator R IN lspace (:real^1) (&2)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[lspace; IN_ELIM_THM] THEN CONJ_TAC THENL + [REWRITE_TAC[MEASURABLE_ON_INDICATOR] THEN + ONCE_REWRITE_TAC[INTER_COMM] THEN REWRITE_TAC[INTER_UNIV] THEN + MATCH_MP_TAC MEASURABLE_IMP_LEBESGUE_MEASURABLE THEN ASM_REWRITE_TAC[]; + SUBGOAL_THEN + `(\x:real^1. lift(norm(indicator R x) rpow &2)) = indicator R` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; indicator] THEN X_GEN_TAC `x:real^1` THEN + COND_CASES_TAC THENL + [REWRITE_TAC[NORM_REAL; GSYM drop; DROP_VEC; REAL_ABS_NUM] THEN + SIMP_TAC[RPOW_POW] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[LIFT_NUM]; + REWRITE_TAC[NORM_0] THEN + SIMP_TAC[RPOW_ZERO; REAL_OF_NUM_EQ; ARITH] THEN REWRITE_TAC[LIFT_NUM]]; + REWRITE_TAC[INTEGRABLE_ON_INDICATOR] THEN + ONCE_REWRITE_TAC[INTER_COMM] THEN REWRITE_TAC[INTER_UNIV] THEN + ASM_REWRITE_TAC[]]]);; + +(* chi_R (Cx-valued) is in L^2 over the whole line (bounded by the real^1 *) +(* indicator L^2 majorant). This is the form FOURIER_L2_REP needs (lspace *) +(* over *) +(* (:real^1), not just over R). *) +let CARLESON_CHI_L2_UNIV = prove + (`!(R:real^1->bool). measurable R + ==> (\x. if x IN R then Cx(&1) else Cx(&0)) IN lspace (:real^1) (&2)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`(:real^1)`; `&2`; + `(\x. if x IN R then Cx(&1) else Cx(&0)):real^1->complex`; + `indicator (R:real^1->bool)`] LSPACE_BOUNDED_MEASURABLE) THEN + REWRITE_TAC[REAL_ARITH `&0 < &2`] THEN DISCH_THEN MATCH_MP_TAC THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CHI_MEASURABLE_ON THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC INDICATOR_L2_UNIV THEN ASM_REWRITE_TAC[]; + X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN REWRITE_TAC[indicator] THEN + COND_CASES_TAC THEN + REWRITE_TAC[COMPLEX_NORM_CX; COMPLEX_NORM_0; NORM_REAL; GSYM drop; + DROP_VEC; NORM_0] THEN + REAL_ARITH_TAC]);; + +(* The abstract L^2 Fourier representative chi_R-hat of chi_R *) +(* (FOURIER_L2_REP): *) +(* an L^2 function g with the rep property int g*h = int chi_R * fourier h *) +(* and *) +(* norm-preserving. This is the b-slot object PARSEVAL_L2_BILINEAR consumes *) +(* in the *) +(* 286O(b) spatial pairing 2pi = 2pi (Fremlin *) +(* 2130) -- *) +(* avoids the pointwise fourier chi_R (no L1capL2-Plancherel identification *) +(* needed). *) +let CARLESON_CHIHAT_REP = prove + (`!(R:real^1->bool). measurable R + ==> ?g. g IN lspace (:real^1) (&2) /\ + lnorm (:real^1) (&2) g = lnorm (:real^1) (&2) (\x. if x IN R then + Cx(&1) else Cx(&0)) /\ + (!h. schwartz h + ==> integral (:real^1) (\z. g z * h(drop z)) = + integral (:real^1) + (\z. (if z IN R then Cx(&1) else Cx(&0)) * fourier h + (drop z)))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `(\x. if x IN R then Cx(&1) else Cx(&0)):real^1->complex` + FOURIER_L2_REP) THEN + ANTS_TAC THENL + [MATCH_MP_TAC CARLESON_CHI_L2_UNIV THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[]]);; + +(* phi_sigma and its Fourier transform are both in L^2 (both Schwartz). *) +let PHISIG_IN_LSPACE2 = prove + (`!(s:int#int#int). (\z. phi_sigma s carleson_phi (drop z)) IN lspace + (:real^1) (&2)`, + GEN_TAC THEN MATCH_MP_TAC SCHWARTZ_L2 THEN + REWRITE_TAC[ETA_AX; PHISIG_CARLESON_SCHWARTZ]);; + +let PHISIG_FOURIER_L2 = prove + (`!(s:int#int#int). (\z. fourier (phi_sigma s carleson_phi) (drop z)) IN + lspace (:real^1) (&2)`, + GEN_TAC THEN MATCH_MP_TAC SCHWARTZ_L2 THEN + ONCE_REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC SCHWARTZ_FOURIER THEN + REWRITE_TAC[PHISIG_CARLESON_SCHWARTZ]);; + +(* int_R phi_sigma = lproduct phi_sigma chi_R (chi_R real, so cnj chi_R = *) +(* chi_R; INTEGRAL_RESTRICT_UNIV turns the region integral into the *) +(* chi_R-weighted one). *) +let CARLESON_PHISIG_REGION_LPRODUCT = prove + (`!(s:int#int#int) (R:real^1->bool). + integral R (\z. phi_sigma s carleson_phi (drop z)) = + lproduct (:real^1) (\z. phi_sigma s carleson_phi (drop z)) + (\x. if x IN R then Cx(&1) else Cx(&0))`, + REPEAT GEN_TAC THEN REWRITE_TAC[lproduct] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM INTEGRAL_RESTRICT_UNIV] THEN + MATCH_MP_TAC INTEGRAL_EQ THEN X_GEN_TAC `z:real^1` THEN DISCH_TAC THEN + REWRITE_TAC[] THEN COND_CASES_TAC THEN + REWRITE_TAC[CNJ_CX; COMPLEX_MUL_RID; COMPLEX_MUL_RZERO; COMPLEX_VEC_0]);; + +(* ========================================================================= *) +(* 286O(b) entry bricks (Fremlin mt286.tex 2050-2073): the tile *) +(* inner-product in Fourier / coefficient form. These start *) +(* of the per-k tile identity 286O-b-ii, which consumes the 282-series 282L *) +(* (fourier_series.ml, CFOURIER_CONVERGENCE_DIFFERENTIABLE) and 282Rb. *) +(* ========================================================================= *) + +(* Parseval bridge (Fremlin 2050-2052, "284O"): the tile inner-product *) +(* equals *) +(* the integral of the Fourier transforms. = int hhat * *) +(* cnj(phihat_s). *) +let CARLESON_IP_FHAT = prove + (`!(h:real->complex) s. schwartz h ==> + carleson_ip h s = + integral (:real^1) + (\z. fourier h (drop z) * cnj(fourier (phi_sigma s carleson_phi) (drop + z)))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[carleson_ip; lproduct] THEN + MATCH_MP_TAC PARSEVAL_SCHWARTZ_BILINEAR THEN + ASM_SIMP_TAC[PHISIG_SCHWARTZ; CARLESON_PHI_SCHWARTZ]);; + +(* carleson_ip is COMPLEX-linear in the function slot: = *) +(* c *) +(* (LPRODUCT_LMUL, given integrability of the h*cnj(phi_sigma) pairing). *) +(* With *) +(* CARLESON_W_SCALE this is the algebra for the 286P normalization h -> *) +(* h/||h||_2. *) +let CARLESON_IP_CMUL = prove + (`!(h:real->complex) (c:complex) s. + (\z. h(drop z) * cnj(phi_sigma s carleson_phi (drop z))) integrable_on + (:real^1) + ==> carleson_ip (\x. c * h x) s = c * carleson_ip h s`, + REPEAT STRIP_TAC THEN REWRITE_TAC[carleson_ip] THEN + MP_TAC(ISPECL [`(:real^1)`; `\z. (h:real->complex)(drop z)`; + `\z. phi_sigma s carleson_phi (drop z)`; + `c:complex`] LPRODUCT_LMUL) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> REWRITE_TAC[GSYM th]) THEN + REWRITE_TAC[]);; + +(* Degenerate case for the 286P normalization: if ||h||_2 = 0 (h vanishes *) +(* a.e.) *) +(* then carleson_ip h s = 0 for every tile s. The integrand h * cnj(phi_s) *) +(* vanishes wherever h does, so its support sits inside the negligible set *) +(* {h <> 0} (LNORM_EQ_0) and the integral is 0 (HAS_INTEGRAL_NEGLIGIBLE). *) +(* This is *) +(* the ||h||_2 = 0 branch of CARLESON_286N_SCALED (the ||h||_2-homogeneous *) +(* 286N). *) +let CARLESON_IP_LNORM_ZERO = prove + (`!(h:real->complex) s. schwartz h /\ lnorm (:real^1) (&2) (\z. h(drop z)) = + &0 + ==> carleson_ip h s = Cx(&0)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[carleson_ip; lproduct] THEN + REWRITE_TAC[GSYM COMPLEX_VEC_0] THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN + MATCH_MP_TAC HAS_INTEGRAL_NEGLIGIBLE THEN + EXISTS_TAC `{z:real^1 | ~((h:real->complex)(drop z) = vec 0)}` THEN + CONJ_TAC THENL + [MP_TAC(ISPECL [`(:real^1)`; `&2`; + `\z:real^1. (h:real->complex)(drop z)`] LNORM_EQ_0) THEN + ASM_SIMP_TAC[SCHWARTZ_L2; REAL_OF_NUM_EQ; ARITH; IN_UNIV]; + REWRITE_TAC[IN_DIFF; IN_UNIV; IN_ELIM_THM] THEN X_GEN_TAC `z:real^1` THEN + REWRITE_TAC[COMPLEX_VEC_0] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[COMPLEX_MUL_LZERO]]);; + +(* The ||h||_2-homogeneous form of the uniform 286N (Fremlin's step-iv *) +(* packaging): *) +(* for ANY schwartz h (no ||h||_2<=1 normalization), the tile-sum is bounded *) +(* by *) +(* C9 * ||h||_2 * sqrt(muFF). ||h||_2 = 0 branch: h vanishes a.e. so every *) +(* carleson_ip h s = 0 (CARLESON_IP_LNORM_ZERO), sum = 0. ||h||_2 > 0 *) +(* branch: *) +(* apply uniform CARLESON_286N to f = (1/||h||_2) h (which has ||f||_2 = 1, *) +(* via *) +(* LSPACE_CMUL + LNORM_MUL), pull the scalar out with CARLESON_IP_CMUL, *) +(* rescale. *) +(* This is the ONE 286N call that the 286P tile bound needs (f = h *) +(* normalized). *) +let CARLESON_286N_SCALED = prove + (`?C9. &0 <= C9 /\ + !(g:real->real) FF (h:real->complex) P. + schwartz h /\ g real_measurable_on (:real) /\ real_measurable FF /\ + &0 < real_measure FF /\ FINITE P /\ + (!t. cw_tile t real_integrable_on {x | x IN FF /\ g x IN tile_J t}) + ==> sum P (\s. norm(carleson_ip h s * + integral (IMAGE lift {x | x IN FF /\ g x IN tile_Jr s}) + (\z. phi_sigma s carleson_phi (drop z)))) + <= C9 * lnorm (:real^1) (&2) (\z. h(drop z)) * sqrt(real_measure + FF)`, + X_CHOOSE_THEN `C9:real` STRIP_ASSUME_TAC CARLESON_286N THEN + EXISTS_TAC `C9:real` THEN ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC [`g:real->real`; `FF:real->bool`; `h:real->complex`; + `P:(int#int#int)->bool`] THEN + STRIP_TAC THEN + ASM_CASES_TAC `lnorm (:real^1) (&2) (\z. (h:real->complex)(drop z)) = &0` + THENL + [ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO] THEN + MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC SUM_EQ_0 THEN + X_GEN_TAC `s:int#int#int` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + SUBGOAL_THEN `carleson_ip (h:real->complex) s = Cx(&0)` ASSUME_TAC THENL + [MATCH_MP_TAC CARLESON_IP_LNORM_ZERO THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[COMPLEX_MUL_LZERO; COMPLEX_NORM_0]; + ABBREV_TAC `nh = lnorm (:real^1) (&2) (\z. (h:real->complex)(drop z))` THEN + SUBGOAL_THEN `&0 < nh` ASSUME_TAC THENL + [SUBGOAL_THEN `&0 <= nh` MP_TAC THENL + [EXPAND_TAC "nh" THEN MATCH_MP_TAC LNORM_POS_LE THEN + ASM_SIMP_TAC[SCHWARTZ_L2]; + ASM_REAL_ARITH_TAC]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`g:real->real`; `FF:real->bool`; + `\x. Cx(inv(nh:real)) * (h:real->complex) x`; `P:(int#int#int)->bool`] o + check(is_forall o concl)) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [SUBGOAL_THEN + `(\z. Cx(inv(nh:real)) * (h:real->complex)(drop z)) = + (\z. inv nh % (\w. (h:real->complex)(drop w)) z)` + SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM; COMPLEX_CMUL]; ALL_TAC] THEN + MATCH_MP_TAC LSPACE_CMUL THEN ASM_SIMP_TAC[SCHWARTZ_L2]; + SUBGOAL_THEN + `(\z. Cx(inv(nh:real)) * (h:real->complex)(drop z)) = + (\z. inv nh % (\w. (h:real->complex)(drop w)) z)` + SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM; COMPLEX_CMUL]; ALL_TAC] THEN + MP_TAC(ISPECL [`(:real^1)`; `&2`; + `\z:real^1. (h:real->complex)(drop z)`; `inv(nh:real)`] + LNORM_MUL) THEN + ASM_SIMP_TAC[SCHWARTZ_L2; REAL_OF_NUM_EQ; ARITH] THEN DISCH_THEN + SUBST1_TAC THEN + REWRITE_TAC[REAL_ABS_INV] THEN SUBGOAL_THEN + `abs(nh:real) = nh` SUBST1_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_MUL_LINV; REAL_LT_IMP_NZ; REAL_LE_REFL]]; + ALL_TAC] THEN + SUBGOAL_THEN + `!s. carleson_ip (\x. Cx(inv(nh:real)) * (h:real->complex) x) s = + Cx(inv(nh:real)) * carleson_ip h s` + (fun th -> REWRITE_TAC[th]) THENL + [GEN_TAC THEN MATCH_MP_TAC CARLESON_IP_CMUL THEN + MATCH_MP_TAC SCHWARTZ_CNJ_PRODUCT_INTEGRABLE THEN + ASM_SIMP_TAC[ETA_AX; PHISIG_SCHWARTZ; CARLESON_PHI_SCHWARTZ]; + ALL_TAC] THEN + REWRITE_TAC[GSYM COMPLEX_MUL_ASSOC; COMPLEX_NORM_MUL; COMPLEX_NORM_CX; + REAL_ABS_INV] THEN + SUBGOAL_THEN `abs(nh:real) = nh` SUBST1_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[SUM_LMUL] THEN DISCH_TAC THEN + REWRITE_TAC[COMPLEX_NORM_MUL] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(nh:real) * (C9 * sqrt(real_measure FF))` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(nh:real) * + (inv nh * sum P (\s. norm(carleson_ip (h:real->complex) s) * + norm(integral (IMAGE lift {x | x IN FF /\ g x IN tile_Jr s}) + (\z. phi_sigma s carleson_phi (drop z)))))` THEN + CONJ_TAC THENL + [ASM_SIMP_TAC[REAL_MUL_ASSOC; REAL_MUL_RINV; REAL_LT_IMP_NZ; + REAL_MUL_LID; REAL_LE_REFL]; + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [ASM_SIMP_TAC[REAL_LT_IMP_LE]; + ASM_SIMP_TAC[GSYM SUM_LMUL] THEN REWRITE_TAC[REAL_MUL_ASSOC] THEN + ASM_REWRITE_TAC[]]]; + MATCH_MP_TAC REAL_EQ_IMP_LE THEN CONV_TAC REAL_RING]]);; + +(* Tile-parameter arithmetic (Fremlin 2048): x_sigma * 2^{k} = n_I + 1/2, so *) +(* the modulation exponent x_s(z-y_s) becomes (n_I+1/2) t after z = 2^k t + *) +(* y_s. *) +let TILE_XMID_SCALE = prove + (`!k nI nJ:int. tile_xmid(k,nI,nJ) * &2 zpow (tile_k(k,nI,nJ)) = + real_of_int nI + &1 / &2`, + REPEAT GEN_TAC THEN REWRITE_TAC[tile_xmid; tile_k; dyho_mid] THEN + SIMP_TAC[GSYM REAL_MUL_ASSOC; GSYM REAL_ZPOW_ADD; REAL_OF_NUM_EQ; ARITH] THEN + REWRITE_TAC[INT_ARITH `--k + k:int = &0`; REAL_ZPOW_0] THEN + CONV_TAC REAL_FIELD);; + +(* cnj(phihat_sigma) for phi = carleson_phi (phihat real): the conjugate *) +(* flips only the modulation sign (Fremlin 2054-2056, the phihat_sigma *) +(* formula 286Eb). *) +let CARLESON_PHISIG_FHAT_CNJ = prove + (`!(s:int#int#int) y. + cnj(fourier (phi_sigma s carleson_phi) y) = + Cx(&1 / sqrt(&2 zpow (tile_k s))) * + cexp(ii * Cx(tile_xmid s) * Cx(y - tile_ymid s)) * + fourier carleson_phi ((y - tile_ymid s) / &2 zpow (tile_k s))`, + REPEAT GEN_TAC THEN + ASM_SIMP_TAC[PHISIG_FHAT; CARLESON_PHI_SCHWARTZ] THEN + REWRITE_TAC[CNJ_MUL; CNJ_CX; CNJ_CEXP] THEN + MP_TAC(SPEC `(y - tile_ymid s) / &2 zpow (tile_k s)` (CONJUNCT1(CONJUNCT2 + carleson_phi))) THEN + REWRITE_TAC[REAL_CNJ] THEN DISCH_THEN SUBST1_TAC THEN + AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[CNJ_NEG; CNJ_MUL; CNJ_II; CNJ_CX] THEN CONV_TAC COMPLEX_RING);; + +(* Pull a scalar Cx c out of a 4-fold product integral (used to extract the *) +(* 1/sqrt(2^k) prefactor after the tile change of variables). *) +let INTEGRAL_MID_CONST_PULL = prove + (`!(A:real^1->complex) B C c. + (\x. A x * B x * C x) integrable_on (:real^1) + ==> integral (:real^1) (\x. A x * Cx c * B x * C x) = + Cx c * integral (:real^1) (\x. A x * B x * C x)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `integral (:real^1) (\x. Cx c * (A x * B x * C x))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC INTEGRAL_EQ THEN GEN_TAC THEN DISCH_TAC THEN + CONV_TAC COMPLEX_RING; + ASM_SIMP_TAC[INTEGRAL_COMPLEX_LMUL]]);; + +(* cnj(phihat_sigma) evaluated at the dilated argument 2^k x + y_s: the tile *) +(* argument collapses ((2^k x + y_s - y_s)/2^k = x) and x_s * 2^k = n_I + *) +(* 1/2 (TILE_XMID_SCALE), giving the clean modulation cexp(ii (n_I+1/2) x). *) +let CARLESON_PHISIG_FHAT_CNJ_DILATE = prove + (`!(k:int)(nI:int)(nJ:int) x. + cnj(fourier (phi_sigma (k,nI,nJ) carleson_phi) (&2 zpow k * x + + tile_ymid(k,nI,nJ))) = + Cx(&1 / sqrt(&2 zpow k)) * cexp(ii * Cx(real_of_int nI + &1/ &2) * Cx x) * + fourier carleson_phi x`, + REPEAT GEN_TAC THEN REWRITE_TAC[CARLESON_PHISIG_FHAT_CNJ] THEN + REWRITE_TAC[tile_k] THEN + SUBGOAL_THEN + `(&2 zpow k * x + tile_ymid(k,nI,nJ)) - tile_ymid(k,nI,nJ) = &2 zpow k * x` + SUBST1_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `(&2 zpow k * x) / &2 zpow k = x` SUBST1_TAC THENL + [MP_TAC(ISPEC `(k,nI,nJ):int#int#int` PHISIG_SCALE_POS) THEN + REWRITE_TAC[tile_k] THEN + CONV_TAC REAL_FIELD; ALL_TAC] THEN + AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + MP_TAC(ISPECL [`k:int`; `nI:int`; `nJ:int`] TILE_XMID_SCALE) THEN + REWRITE_TAC[tile_k] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[CX_MUL] THEN CONV_TAC COMPLEX_RING);; + +(* sqrt(2^k) * (Cx(1/sqrt(2^k)) * z) = z: the 2^k dilation Jacobian cancels *) +(* the phi_sigma normalization; the Cx(sqrt)*Cx(1/sqrt)=1 fact fed to *) +(* COMPLEX_RING. *) +let CARLESON_SQRT_SCALE_ID = prove + (`!(k:int) (A:complex) B C. + A * B * C = Cx(sqrt(&2 zpow k)) * (A * Cx(&1 / sqrt(&2 zpow k)) * B * C)`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `Cx(sqrt(&2 zpow k)) * Cx(&1 / sqrt(&2 zpow k)) = Cx(&1)` + MP_TAC THENL + [REWRITE_TAC[GSYM CX_MUL] THEN AP_TERM_TAC THEN + SUBGOAL_THEN `&0 < sqrt(&2 zpow k)` MP_TAC THENL + [MATCH_MP_TAC SQRT_POS_LT THEN MATCH_MP_TAC REAL_ZPOW_LT THEN + REAL_ARITH_TAC; + CONV_TAC REAL_FIELD]; ALL_TAC] THEN + CONV_TAC COMPLEX_RING);; + +(* The tile-substituted integrand (Fremlin 2059's g-integral) is integrable. *) +let CARLESON_IP_TARGET_INTEGRABLE = prove + (`!(h:real->complex) (k:int) (nI:int) (nJ:int). schwartz h + ==> (\t. fourier h (&2 zpow k * drop t + tile_ymid(k,nI,nJ)) * + cexp(ii * Cx(real_of_int nI + &1/ &2) * Cx(drop t)) * + fourier carleson_phi (drop t)) integrable_on (:real^1)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\z. fourier (h:real->complex) (drop z) * + cnj(fourier (phi_sigma (k,nI,nJ) carleson_phi) (drop z))) + integrable_on (:real^1)` + ASSUME_TAC THENL + [MATCH_MP_TAC SCHWARTZ_CNJ_PRODUCT_INTEGRABLE THEN REWRITE_TAC[ETA_AX] THEN + ASM_SIMP_TAC[SCHWARTZ_FOURIER; PHISIG_SCHWARTZ; CARLESON_PHI_SCHWARTZ]; + ALL_TAC] THEN + ONCE_REWRITE_TAC[CARLESON_SQRT_SCALE_ID] THEN + MATCH_MP_TAC INTEGRABLE_COMPLEX_LMUL THEN + MP_TAC(ISPECL + [`(\z. fourier (h:real->complex) (drop z) * + cnj(fourier (phi_sigma (k,nI,nJ) carleson_phi) (drop + z))):real^1->complex`; + `&2 zpow k`; `lift(tile_ymid(k,nI,nJ))`] INTEGRABLE_DILATE_UNIV) THEN + ASM_SIMP_TAC[REAL_LT_IMP_NZ; REAL_ZPOW_LT; REAL_ARITH `&0 < &2`] THEN + REWRITE_TAC[DROP_ADD; DROP_CMUL; LIFT_DROP; + CARLESON_PHISIG_FHAT_CNJ_DILATE]);; + +(* Endgame scalar solve: from Cx(1/sqrt) TT = Cx(inv 2^k) SS recover SS = *) +(* Cx(sqrt) TT (multiply by 2^k, use 2^k/sqrt(2^k)=sqrt(2^k), 2^k inv 2^k = *) +(* 1). *) +let CARLESON_IP_SCALE_SOLVE = prove + (`!(k:int) TT SS. &0 < &2 zpow k /\ + Cx(&1 / sqrt(&2 zpow k)) * TT = Cx(inv(&2 zpow k)) * SS + ==> SS = Cx(sqrt(&2 zpow k)) * TT`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&0 < sqrt(&2 zpow k)` ASSUME_TAC THENL + [ASM_SIMP_TAC[SQRT_POS_LT]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o AP_TERM `(*) (Cx(&2 zpow k))`) THEN + REWRITE_TAC[COMPLEX_MUL_ASSOC; GSYM CX_MUL] THEN + SUBGOAL_THEN `&2 zpow k * &1 / sqrt(&2 zpow k) = sqrt(&2 zpow k) /\ + &2 zpow k * inv(&2 zpow k) = &1` + (fun th -> REWRITE_TAC[th]) THENL + [CONJ_TAC THENL + [MP_TAC(ISPEC `&2 zpow k` SQRT_POW_2) THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN + REWRITE_TAC[REAL_POW_2] THEN CONV_TAC REAL_FIELD; + MATCH_MP_TAC REAL_MUL_RINV THEN ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + REWRITE_TAC[COMPLEX_MUL_LID] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + REFL_TAC);; + +(* 286O(b), Fremlin 2059-2062: the tile inner product as a single-variable *) +(* integral after the change of variables z = 2^k t + y_s. This is the entry *) +(* to the coefficient identification = 2^{k/2} 2pi c_{-n} (2070). *) +let CARLESON_IP_SUBST = prove + (`!(h:real->complex) (k:int) (nI:int) (nJ:int). schwartz h ==> + carleson_ip h (k,nI,nJ) = + Cx(sqrt(&2 zpow k)) * + integral (:real^1) + (\t. fourier h (&2 zpow k * drop t + tile_ymid(k,nI,nJ)) * + cexp(ii * Cx(real_of_int nI + &1/ &2) * Cx(drop t)) * + fourier carleson_phi (drop t))`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[CARLESON_IP_FHAT] THEN + MP_TAC(ISPECL + [`(\z. fourier (h:real->complex) (drop z) * + cnj(fourier (phi_sigma (k,nI,nJ) carleson_phi) (drop + z))):real^1->complex`; + `&2 zpow k`; `lift(tile_ymid(k,nI,nJ))`] INTEGRAL_DILATE_UNIV) THEN + SUBGOAL_THEN + `(\z. fourier (h:real->complex) (drop z) * + cnj(fourier (phi_sigma (k,nI,nJ) carleson_phi) (drop z))) + integrable_on (:real^1)` + ASSUME_TAC THENL + [MATCH_MP_TAC SCHWARTZ_CNJ_PRODUCT_INTEGRABLE THEN REWRITE_TAC[ETA_AX] THEN + ASM_SIMP_TAC[SCHWARTZ_FOURIER; PHISIG_SCHWARTZ; CARLESON_PHI_SCHWARTZ]; + ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LT_IMP_NZ; REAL_ZPOW_LT; REAL_ARITH `&0 < &2`] THEN + REWRITE_TAC[DROP_ADD; DROP_CMUL; LIFT_DROP; + CARLESON_PHISIG_FHAT_CNJ_DILATE] THEN + ASM_SIMP_TAC[INTEGRAL_MID_CONST_PULL; CARLESON_IP_TARGET_INTEGRABLE] THEN + SUBGOAL_THEN `&0 < &2 zpow k` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < x ==> abs x = x`; COMPLEX_CMUL] THEN + DISCH_TAC THEN MATCH_MP_TAC CARLESON_IP_SCALE_SOLVE THEN ASM_REWRITE_TAC[]);; + +(* Restrict an R-integral of a function vanishing outside [-1/5,1/5] to *) +(* [-pi,pi]. *) +let INTEGRAL_TRUNCATE_PIPI = prove + (`!(G:real->complex). + (!t. &1 / &5 < abs t ==> G t = Cx(&0)) /\ + (\t. G(drop t)) integrable_on (:real^1) + ==> integral (:real^1) (\t. G(drop t)) = + integral (IMAGE lift (real_interval[--pi,pi])) (\t. G(drop t))`, + REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC RAND_CONV [GSYM INTEGRAL_RESTRICT_UNIV] THEN + REWRITE_TAC[] THEN MATCH_MP_TAC INTEGRAL_EQ THEN X_GEN_TAC `t:real^1` THEN + DISCH_TAC THEN + REWRITE_TAC[IN_IMAGE_LIFT_DROP; IN_REAL_INTERVAL] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[COMPLEX_VEC_0] THEN + FIRST_ASSUM(MATCH_MP_TAC o check (is_forall o concl)) THEN + MP_TAC PI_APPROX_32 THEN ASM_REAL_ARITH_TAC);; + +(* Cx(2pi) c_{-n}(g) = int_{[-pi,pi]} g(t) e^{i n t} dt (282A coefficient *) +(* form). *) +let CFOURIER_COEFF_INTEGRAL_ID = prove + (`!(g:real->complex) (nI:int). + Cx(&2 * pi) * cfourier_coeff g (--nI) = + integral (IMAGE lift (real_interval[--pi,pi])) + (\t. g(drop t) * cexp(ii * Cx(real_of_int nI) * Cx(drop t)))`, + REPEAT GEN_TAC THEN REWRITE_TAC[cfourier_coeff] THEN + REWRITE_TAC[COMPLEX_MUL_ASSOC; GSYM CX_MUL] THEN + SUBGOAL_THEN `Cx((&2 * pi) * inv(&2 * pi)) = Cx(&1)` SUBST1_TAC THENL + [AP_TERM_TAC THEN MP_TAC PI_POS THEN CONV_TAC REAL_FIELD; ALL_TAC] THEN + REWRITE_TAC[COMPLEX_MUL_LID] THEN + MATCH_MP_TAC INTEGRAL_EQ THEN X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN + REWRITE_TAC[int_neg_th; CX_NEG] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + CONV_TAC COMPLEX_RING);; + +(* The tile g-integrand hhat(c t + y) e^{i(n+1/2)t} phihat(t) splits as *) +(* [hhat(c t + y) e^{it/2} phihat(t)] * e^{i n t} (the 282A base g times *) +(* e^{int}). *) +let CARLESON_G_EXPSPLIT = prove + (`!(h:real->complex) c yy (nI:int) t. + fourier h (c * t + yy) * cexp(ii * Cx(real_of_int nI + &1/ &2) * Cx t) * + fourier carleson_phi t = + (fourier h (c * t + yy) * cexp(ii * Cx(&1/ &2) * Cx t) * fourier + carleson_phi t) * + cexp(ii * Cx(real_of_int nI) * Cx t)`, + REPEAT GEN_TAC THEN REWRITE_TAC[GSYM CEXP_ADD] THEN + SUBGOAL_THEN + `ii * Cx(real_of_int nI + &1/ &2) * Cx t = + (ii * Cx(&1/ &2) * Cx t) + (ii * Cx(real_of_int nI) * Cx t)` + (fun th -> ONCE_REWRITE_TAC[th]) THENL + [REWRITE_TAC[CX_ADD] THEN CONV_TAC COMPLEX_RING; ALL_TAC] THEN + REWRITE_TAC[CEXP_ADD] THEN CONV_TAC COMPLEX_RING);; + +(* The tile base g vanishes off [-1/5,1/5] (phihat support). *) +let CARLESON_G_SUPPORT = prove + (`!(h:real->complex) yy c t. &1 / &5 < abs t ==> + fourier h (c * t + yy) * cexp(ii * Cx(&1/ &2) * Cx t) * fourier + carleson_phi t = Cx(&0)`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[CARLESON_PHI_FHAT_SUPPORT] THEN CONV_TAC COMPLEX_RING);; + +(* Keystone: the product of a Schwartz function with a COMPACTLY-SUPPORTED *) +(* Schwartz function is Schwartz. The product chain (LEIBNIZ_CHAIN) inherits *) +(* the *) +(* compact support of the second factor (CHAIN_SUPPORT: derivatives of a *) +(* compactly-supported smooth chain stay supported), so it is a smooth chain *) +(* of *) +(* compact support, hence Schwartz (COMPACT_SUPPORT_SMOOTH_IMP_SCHWARTZ). *) +let SCHWARTZ_CSUPP_MUL = prove + (`!(f:real->complex) (g:real->complex) R. + &0 <= R /\ schwartz f /\ schwartz g /\ (!x. R < abs x ==> g x = Cx(&0)) + ==> schwartz (\x. f x * g x)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `df:num->real->complex` STRIP_ASSUME_TAC o + GEN_REWRITE_RULE I [schwartz]) THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `dg:num->real->complex` STRIP_ASSUME_TAC o + GEN_REWRITE_RULE I [schwartz]) THEN + MP_TAC(ISPECL [`df:num->real->complex`; + `dg:num->real->complex`] LEIBNIZ_CHAIN) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `p:num->real->complex` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `(\x. (f:real->complex) x * (g:real->complex) x) = + (p:num->real->complex) 0` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:real` THEN + ASM_REWRITE_TAC[] THEN CONV_TAC COMPLEX_RING; ALL_TAC] THEN + MP_TAC(ISPECL [`p:num->real->complex`; `R:real`] + COMPACT_SUPPORT_SMOOTH_IMP_SCHWARTZ) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + X_GEN_TAC `m:num` THEN X_GEN_TAC `x:real` THEN DISCH_TAC THEN + MP_TAC(ISPECL [`p:num->real->complex`; `R:real`] CHAIN_SUPPORT) THEN + ASM_REWRITE_TAC[real_gt] THEN ANTS_TAC THENL + [X_GEN_TAC `y:real` THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `(g:real->complex) y = Cx(&0)` SUBST1_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[]; CONV_TAC COMPLEX_RING]; + DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC]);; + +(* The tile base g(t) = hhat(2^k t + yy) e^{it/2} phihat(t) is itself *) +(* SCHWARTZ: the first factor A(t)=hhat(2^k t+yy) is Schwartz (284C + affine *) +(* reparam), and B(t)=e^{it/2} phihat(t) is Schwartz (SCHWARTZ_MODULATE on *) +(* 284C) AND compactly supported (phihat vanishes off [-1/5,1/5]); *) +(* SCHWARTZ_CSUPP_MUL closes it. This gives (for free) the C^2 chain, *) +(* integrability, decay AND periodicity g(pi)=g(-pi)=0, g'(pi)=g'(-pi)=0 *) +(* needed for the 282Rb coefficient summability. *) +let CARLESON_G_SCHWARTZ = prove + (`!(h:real->complex) k yy. schwartz h ==> + schwartz (\t. fourier h (&2 zpow k * t + yy) * + cexp(ii * Cx(&1/ &2) * Cx t) * fourier carleson_phi t)`, + REPEAT STRIP_TAC THEN + MP_TAC(BETA_RULE(ISPECL + [`\t. fourier (h:real->complex) (&2 zpow k * t + yy)`; + `\t. cexp(ii * Cx(&1/ &2) * Cx t) * fourier carleson_phi t`; + `&1 / &5`] SCHWARTZ_CSUPP_MUL)) THEN + DISCH_THEN MATCH_MP_TAC THEN + REPEAT CONJ_TAC THENL + [REAL_ARITH_TAC; + SUBGOAL_THEN `(\t. fourier (h:real->complex) (&2 zpow k * t + yy)) = + (\t. fourier h (yy + &2 zpow k * t))` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN AP_TERM_TAC THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(BETA_RULE(ISPECL [`fourier(h:real->complex)`; `&2 zpow k`; + `yy:real`] + SCHWARTZ_AFFINE)) THEN + DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL + [MATCH_MP_TAC SCHWARTZ_FOURIER THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LT_IMP_NZ THEN MATCH_MP_TAC REAL_ZPOW_LT THEN + REAL_ARITH_TAC]; + MP_TAC(BETA_RULE(ISPECL [`fourier carleson_phi`; + `&1 / &2`] SCHWARTZ_MODULATE)) THEN + DISCH_THEN MATCH_MP_TAC THEN + MATCH_MP_TAC SCHWARTZ_FOURIER THEN REWRITE_TAC[CARLESON_PHI_SCHWARTZ]; + X_GEN_TAC `t:real` THEN DISCH_TAC THEN + ASM_SIMP_TAC[CARLESON_PHI_FHAT_SUPPORT; COMPLEX_MUL_RZERO]]);; + +(* The finite tile partial sum is in L^2: it is a finite (LSPACE_VSUM) sum *) +(* of *) +(* complex multiples (LSPACE_COMPLEX_LMUL) of the L^2 tile transforms *) +(* (PHISIG_FOURIER_L2). This is hypothesis (i) of *) +(* LSPACE_DOMINATED_CONVERGENCE for *) +(* the b-ii limit of 286O(b). *) +let CARLESON_TILESUM_FOURIER_L2 = prove + (`!(h:real->complex) k nJ N. + (\z. vsum {nI:int | abs nI <= &N} + (\nI. carleson_ip h (k,nI,nJ) * + fourier (phi_sigma (k,nI,nJ) carleson_phi) (drop z))) + IN lspace (:real^1) (&2)`, + REPEAT GEN_TAC THEN MATCH_MP_TAC LSPACE_VSUM THEN + REWRITE_TAC[CFOURIER_INDEX_FINITE] THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + X_GEN_TAC `nI:int` THEN DISCH_TAC THEN + MATCH_MP_TAC LSPACE_COMPLEX_LMUL THEN + REWRITE_TAC[PHISIG_FOURIER_L2]);; + +(* The b-ii dominator envelope is L^2: \z. C * phihat((z-yy)/2^k) is a *) +(* constant *) +(* multiple of an affine reparametrisation of the Schwartz function phihat, *) +(* hence *) +(* Schwartz, hence L^2. Since the finite tile sums are bounded pointwise by *) +(* such *) +(* an envelope (CFOURIER_PARTIAL_UNIF_BOUND * |phihat|, via *) +(* CARLESON_PERK_FINITE), *) +(* this is the L^2 dominator for LSPACE_DOMINATED_CONVERGENCE. *) +let CARLESON_DOMINATOR_L2 = prove + (`!(C:real) yy k. + (\z. Cx(C) * fourier carleson_phi ((drop z - yy) / &2 zpow k)) + IN lspace (:real^1) (&2)`, + REPEAT GEN_TAC THEN MATCH_MP_TAC LSPACE_COMPLEX_LMUL THEN + SUBGOAL_THEN `~(&2 zpow k = &0)` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LT_IMP_NZ THEN + MP_TAC(ISPECL [`&2`; `k:int`] REAL_ZPOW_LT) THEN ANTS_TAC THENL + [REAL_ARITH_TAC; REWRITE_TAC[]]; ALL_TAC] THEN + SUBGOAL_THEN + `(\z. fourier carleson_phi ((drop z - yy) / &2 zpow k)) = + (\z:real^1. (\u. fourier carleson_phi (--(yy / &2 zpow k) + (inv(&2 zpow + k)) * u)) (drop z))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN REWRITE_TAC[] THEN + AP_TERM_TAC THEN + UNDISCH_TAC `~(&2 zpow k = &0)` THEN CONV_TAC REAL_FIELD; ALL_TAC] THEN + MATCH_MP_TAC SCHWARTZ_L2 THEN + MP_TAC(BETA_RULE(ISPECL [`fourier carleson_phi`; `inv(&2 zpow k)`; + `--(yy / &2 zpow k)`] + SCHWARTZ_AFFINE)) THEN + DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL + [MATCH_MP_TAC SCHWARTZ_FOURIER THEN REWRITE_TAC[CARLESON_PHI_SCHWARTZ]; + MATCH_MP_TAC REAL_LT_IMP_NZ THEN MATCH_MP_TAC REAL_LT_INV THEN + MP_TAC(ISPECL [`&2`; `k:int`] REAL_ZPOW_LT) THEN ANTS_TAC THENL + [REAL_ARITH_TAC; REWRITE_TAC[]]]);; + +(* The tile base g(t) = hhat(2^k t + yy) e^{it/2} phihat(t) is vector- *) +(* differentiable everywhere: a product of three vector-differentiable *) +(* factors *) +(* (fourier h o affine, cexp o linear, fourier phihat). Feeds *) +(* VECTOR_DIFF_IMP_ *) +(* REIM_DIFF to give the Re/Im differentiability hypotheses of the complex *) +(* 282L. *) +let CARLESON_G_DIFFERENTIABLE = prove + (`!(h:real->complex) k yy a. schwartz h ==> + (\z. fourier h (&2 zpow k * drop z + yy) * + cexp(ii * Cx(&1/ &2) * Cx(drop z)) * + fourier carleson_phi (drop z)) differentiable (at a)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC DIFFERENTIABLE_COMPLEX_MUL_AT THEN CONJ_TAC THENL + [ASM_SIMP_TAC[FOURIER_SCHWARTZ_AFFINE_DIFF]; ALL_TAC] THEN + MATCH_MP_TAC DIFFERENTIABLE_COMPLEX_MUL_AT THEN CONJ_TAC THENL + [REWRITE_TAC[COMPLEX_MUL_ASSOC] THEN REWRITE_TAC[CEXP_LINEAR_DIFF]; + ASM_SIMP_TAC[FOURIER_SCHWARTZ_DIFFERENTIABLE; CARLESON_PHI_SCHWARTZ]]);; + +(* 286O-b-ii limit (Fremlin 2099-2100): cfourier_partial g N u --> g u at an *) +(* interior u in (-pi,pi), where g(t)=hhat(2^k t+yy) e^{it/2} phihat(t). *) +(* Feeds *) +(* the tile-g differentiability (CARLESON_G_DIFFERENTIABLE) into the complex *) +(* 282L *) +(* (CFOURIER_CONVERGENCE_INTERIOR_CX): differentiability everywhere gives *) +(* both the *) +(* Re/Im interior-differentiability and the Re/Im integrability hypotheses. *) +let CARLESON_G_LIMIT = prove + (`!(h:real->complex) k yy u. schwartz h /\ --pi < u /\ u < pi + ==> ((\N. cfourier_partial + (\t. fourier h (&2 zpow k * t + yy) * + cexp(ii * Cx(&1/ &2) * Cx t) * fourier carleson_phi t) N + u) + --> (fourier h (&2 zpow k * u + yy) * + cexp(ii * Cx(&1/ &2) * Cx u) * fourier carleson_phi u)) + sequentially`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`\t. fourier h (&2 zpow k * t + yy) * + cexp(ii * Cx(&1/ &2) * Cx t) * fourier carleson_phi t`; `u:real`] + CFOURIER_CONVERGENCE_INTERIOR_CX) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [SUBGOAL_THEN + `!a. (\z. fourier h (&2 zpow k * drop z + yy) * + cexp(ii * Cx(&1/ &2) * Cx(drop z)) * + fourier carleson_phi (drop z)) differentiable (at a)` + ASSUME_TAC THENL + [GEN_TAC THEN ASM_SIMP_TAC[CARLESON_G_DIFFERENTIABLE]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[VECTOR_DIFF_IMP_REIM_ABSINT] THEN + MP_TAC(ISPECL + [`\t. fourier h (&2 zpow k * t + yy) * + cexp(ii * Cx(&1/ &2) * Cx t) * fourier carleson_phi t`; `u:real`] + VECTOR_DIFF_IMP_REIM_DIFF) THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[]);; + +(* 286O(b), Fremlin 2070: the tile inner product as a 282A Fourier *) +(* coefficient. *) +(* = 2^{k/2} 2pi c_{-n}(g), g(t) = hhat(2^k t + y_s) e^{it/2} *) +(* phihat(t). *) +(* Truncates the R-integral of CARLESON_IP_SUBST to [-pi,pi] (phihat support *) +(* in *) +(* [-1/5,1/5] subset [-pi,pi]) and identifies it with the 282A coefficient. *) +let CARLESON_IP_COEFF = prove + (`!(h:real->complex) (k:int) (nI:int) (nJ:int). schwartz h ==> + carleson_ip h (k,nI,nJ) = + Cx(sqrt(&2 zpow k)) * Cx(&2 * pi) * + cfourier_coeff + (\t. fourier h (&2 zpow k * t + tile_ymid(k,nI,nJ)) * + cexp(ii * Cx(&1/ &2) * Cx t) * fourier carleson_phi t) (--nI)`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[CARLESON_IP_SUBST] THEN + REWRITE_TAC[GSYM COMPLEX_MUL_ASSOC] THEN AP_TERM_TAC THEN + REWRITE_TAC[CFOURIER_COEFF_INTEGRAL_ID] THEN + ONCE_REWRITE_TAC[CARLESON_G_EXPSPLIT] THEN + MATCH_MP_TAC INTEGRAL_TRUNCATE_PIPI THEN CONJ_TAC THENL + [REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[CARLESON_G_SUPPORT] THEN CONV_TAC COMPLEX_RING; + REWRITE_TAC[GSYM CARLESON_G_EXPSPLIT] THEN + ASM_SIMP_TAC[CARLESON_IP_TARGET_INTEGRABLE]]);; + +(* x_sigma (y - y_s) = (n_I + 1/2) * ((y - y_s)/2^k): the tile modulation *) +(* phase in *) +(* terms of the rescaled frequency u = (y - y_s)/2^k. (dyho_mid + *) +(* REAL_ZPOW_NEG.) *) +let TILE_XMID_YDIFF = prove + (`!k nI nJ y. tile_xmid(k,nI,nJ) * (y - tile_ymid(k,nI,nJ)) = + (real_of_int nI + &1 / &2) * ((y - tile_ymid(k,nI,nJ)) / &2 zpow + k)`, + REPEAT GEN_TAC THEN REWRITE_TAC[tile_xmid; dyho_mid] THEN + SUBGOAL_THEN `~(&2 zpow k = &0)` MP_TAC THENL + [MATCH_MP_TAC REAL_LT_IMP_NZ THEN MATCH_MP_TAC REAL_ZPOW_LT THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[REAL_ZPOW_NEG] THEN CONV_TAC REAL_FIELD);; + +(* 286O-b-ii summand (Fremlin 2089-2090): the per-tile term *) +(* phihat_s(y) factored as Cx(2pi) * (c_{-nI}(g) e^{-inI u}) * (e^{-iu/2} *) +(* phihat(u)), u=(y-y_s)/2^k. *) +let CARLESON_SUMMAND_PRODUCT = prove + (`!(h:real->complex) k nI nJ y. schwartz h ==> + carleson_ip h (k,nI,nJ) * fourier (phi_sigma (k,nI,nJ) carleson_phi) y = + Cx(&2 * pi) * + (cfourier_coeff + (\t. fourier h (&2 zpow k * t + tile_ymid(k,nI,nJ)) * + cexp(ii * Cx(&1/ &2) * Cx t) * fourier carleson_phi t) (--nI) * + cexp(--(ii * Cx(real_of_int nI) * Cx((y - tile_ymid(k,nI,nJ)) / &2 zpow + k)))) * + (cexp(--(ii * Cx(&1/ &2) * Cx((y - tile_ymid(k,nI,nJ)) / &2 zpow k))) * + fourier carleson_phi ((y - tile_ymid(k,nI,nJ)) / &2 zpow k))`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[CARLESON_IP_COEFF] THEN + ASM_SIMP_TAC[PHISIG_FHAT; CARLESON_PHI_SCHWARTZ] THEN + REWRITE_TAC[tile_k] THEN + SUBGOAL_THEN + `cexp(--(ii * Cx(tile_xmid(k,nI,nJ)) * Cx(y - tile_ymid(k,nI,nJ)))) = + cexp(--(ii * Cx(real_of_int nI) * Cx((y - tile_ymid(k,nI,nJ)) / &2 zpow + k))) * + cexp(--(ii * Cx(&1/ &2) * Cx((y - tile_ymid(k,nI,nJ)) / &2 zpow k)))` + SUBST1_TAC THENL + [REWRITE_TAC[GSYM CEXP_ADD] THEN AP_TERM_TAC THEN + REWRITE_TAC[GSYM CX_MUL] THEN + MP_TAC(ISPECL [`k:int`; `nI:int`; `nJ:int`; `y:real`] TILE_XMID_YDIFF) THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN + REWRITE_TAC[CX_ADD; CX_MUL] THEN CONV_TAC COMPLEX_RING; ALL_TAC] THEN + SUBGOAL_THEN + `Cx(sqrt(&2 zpow k)) * Cx(&1 / sqrt(&2 zpow k)) = Cx(&1)` MP_TAC THENL + [REWRITE_TAC[GSYM CX_MUL] THEN AP_TERM_TAC THEN + SUBGOAL_THEN `&0 < sqrt(&2 zpow k)` MP_TAC THENL + [MATCH_MP_TAC SQRT_POS_LT THEN MATCH_MP_TAC REAL_ZPOW_LT THEN + REAL_ARITH_TAC; + CONV_TAC REAL_FIELD]; ALL_TAC] THEN + CONV_TAC COMPLEX_RING);; + +(* 286O-b-ii finite truncation (Fremlin 2087-2090): the R_k tile-sum at *) +(* fixed k,nJ over |nI|<=N equals Cx(2pi) * cfourier_partial g N u * *) +(* (e^{-iu/2} phihat(u)). (tile_ymid is nI-independent -- fixed Jhat_k -- so *) +(* g and u are constant in nI.) *) +let CARLESON_PERK_FINITE = prove + (`!(h:real->complex) k nJ y N. schwartz h ==> + vsum {nI:int | abs nI <= &N} + (\nI. carleson_ip h (k,nI,nJ) * fourier (phi_sigma (k,nI,nJ) + carleson_phi) y) = + Cx(&2 * pi) * + cfourier_partial + (\t. fourier h (&2 zpow k * t + tile_ymid(k,&0,nJ)) * + cexp(ii * Cx(&1/ &2) * Cx t) * fourier carleson_phi t) + N ((y - tile_ymid(k,&0,nJ)) / &2 zpow k) * + (cexp(--(ii * Cx(&1/ &2) * Cx((y - tile_ymid(k,&0,nJ)) / &2 zpow k))) * + fourier carleson_phi ((y - tile_ymid(k,&0,nJ)) / &2 zpow k))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`\t. fourier (h:real->complex) (&2 zpow k * t + tile_ymid(k,&0,nJ)) * + cexp(ii * Cx(&1/ &2) * Cx t) * fourier carleson_phi t`; + `N:num`; + `(y - tile_ymid(k,&0,nJ)) / &2 zpow k`; + `cexp(--(ii * Cx(&1/ &2) * Cx((y - tile_ymid(k,&0,nJ)) / &2 zpow k))) * + fourier carleson_phi ((y - tile_ymid(k,&0,nJ)) / &2 zpow k)`] + CARLESON_FINITE_REINDEX_SUM) THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC VSUM_EQ THEN X_GEN_TAC `nI:int` THEN DISCH_TAC THEN + REWRITE_TAC[] THEN + MP_TAC(ISPECL [`h:real->complex`; `k:int`; `nI:int`; `nJ:int`; `y:real`] + CARLESON_SUMMAND_PRODUCT) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + SUBGOAL_THEN `tile_ymid(k,nI,nJ) = tile_ymid(k,&0,nJ)` SUBST1_TAC THENL + [REWRITE_TAC[tile_ymid]; ALL_TAC] THEN + REFL_TAC);; + +(* Raw per-k limit: the finite tile-sum truncations converge, combining the *) +(* finite identity CARLESON_PERK_FINITE with the tile-g limit *) +(* CARLESON_G_LIMIT (LIM_COMPLEX_LMUL pulls the nI-independent Cx(2pi)*W *) +(* factor out). *) +let CARLESON_PERK_RAWLIMIT = prove + (`!(h:real->complex) k nJ y. schwartz h /\ --pi < (y - tile_ymid(k,&0,nJ)) / + &2 zpow k /\ + (y - tile_ymid(k,&0,nJ)) / &2 zpow k < pi + ==> ((\N. vsum {nI:int | abs nI <= &N} + (\nI. carleson_ip h (k,nI,nJ) * + fourier (phi_sigma (k,nI,nJ) carleson_phi) y)) + --> Cx(&2 * pi) * + (fourier h (&2 zpow k * ((y - tile_ymid(k,&0,nJ)) / &2 zpow k) + + tile_ymid(k,&0,nJ)) * + cexp(ii * Cx(&1/ &2) * Cx((y - tile_ymid(k,&0,nJ)) / &2 zpow k)) + * + fourier carleson_phi ((y - tile_ymid(k,&0,nJ)) / &2 zpow k)) * + (cexp(--(ii * Cx(&1/ &2) * Cx((y - tile_ymid(k,&0,nJ)) / &2 zpow + k))) * + fourier carleson_phi ((y - tile_ymid(k,&0,nJ)) / &2 zpow k))) + sequentially`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[CARLESON_PERK_FINITE] THEN + ABBREV_TAC `W = cexp(--(ii * Cx(&1/ &2) * Cx((y - tile_ymid(k,&0,nJ)) / &2 + zpow k))) * + fourier carleson_phi ((y - tile_ymid(k,&0,nJ)) / &2 zpow k)` + THEN + ONCE_REWRITE_TAC[COMPLEX_RING `Cx(&2 * pi) * P * W = (Cx(&2 * pi) * W) * P`] + THEN + MATCH_MP_TAC LIM_COMPLEX_LMUL THEN + MATCH_MP_TAC CARLESON_G_LIMIT THEN ASM_REWRITE_TAC[]);; + +(* 286O-b-ii (Fremlin 2105): the per-k tile identity in limit form. The *) +(* finite *) +(* tile-sum over abs nI <= N of phihat_(k,nI,nJ)(y) *) +(* converges to *) +(* 2pi hhat(y) phihat(u)^2, u=(y-yhat_k)/2^k. (phihat(u)^2 = psi_k(y).) The *) +(* RHS *) +(* simplifies via 2^k u + yhat_k = y and cexp(iu/2) cexp(-iu/2) = 1. *) +let CARLESON_PERK_LIMIT = prove + (`!(h:real->complex) k nJ y. schwartz h /\ --pi < (y - tile_ymid(k,&0,nJ)) / + &2 zpow k /\ + (y - tile_ymid(k,&0,nJ)) / &2 zpow k < pi + ==> ((\N. vsum {nI:int | abs nI <= &N} + (\nI. carleson_ip h (k,nI,nJ) * + fourier (phi_sigma (k,nI,nJ) carleson_phi) y)) + --> Cx(&2 * pi) * fourier h y * + (fourier carleson_phi ((y - tile_ymid(k,&0,nJ)) / &2 zpow k) * + fourier carleson_phi ((y - tile_ymid(k,&0,nJ)) / &2 zpow k))) + sequentially`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`h:real->complex`; `k:int`; `nJ:int`; + `y:real`] CARLESON_PERK_RAWLIMIT) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN + AP_TERM_TAC THEN + AP_TERM_TAC THEN + SUBGOAL_THEN + `&2 zpow k * ((y - tile_ymid(k,&0,nJ)) / &2 zpow k) + tile_ymid(k,&0,nJ) = + y` + SUBST1_TAC THENL + [SUBGOAL_THEN `~(&2 zpow k = &0)` MP_TAC THENL + [MATCH_MP_TAC REAL_LT_IMP_NZ THEN MATCH_MP_TAC REAL_ZPOW_LT THEN + REAL_ARITH_TAC; + CONV_TAC REAL_FIELD]; ALL_TAC] THEN + SUBGOAL_THEN + `cexp(ii * Cx(&1/ &2) * Cx((y - tile_ymid(k,&0,nJ)) / &2 zpow k)) * + cexp(--(ii * Cx(&1/ &2) * Cx((y - tile_ymid(k,&0,nJ)) / &2 zpow k))) = + Cx(&1)` + MP_TAC THENL + [REWRITE_TAC[GSYM CEXP_ADD] THEN + REWRITE_TAC[COMPLEX_RING `a + --a = Cx(&0)`; CEXP_0]; ALL_TAC] THEN + CONV_TAC COMPLEX_RING);; + +(* fourier carleson_phi is real-valued, so its complex square is Cx of the *) +(* real square of its real part -- the form the carleson_theta term uses. *) +let CARLESON_PHIHAT_SQ_RE = prove + (`!u. fourier carleson_phi u * fourier carleson_phi u = + Cx(Re(fourier carleson_phi u) pow 2)`, + GEN_TAC THEN + MP_TAC(SPEC `u:real` (CONJUNCT1(CONJUNCT2 carleson_phi))) THEN + REWRITE_TAC[REAL] THEN + DISCH_THEN(fun th -> GEN_REWRITE_TAC (LAND_CONV o BINOP_CONV) [SYM th]) THEN + REWRITE_TAC[GSYM CX_MUL; REAL_POW_2]);; + +(* 286O-b-ii in the carleson_theta-term form (Fremlin 2105): the finite *) +(* tile-sum *) +(* converges to 2pi hhat(y) * (theta-term) where the theta-term is *) +(* Re(phihat(2^{-k}(y-yhat_k)))^2 (= psi_k(y) = the single carleson_theta *) +(* summand for the scale-k tile). Normalises the frequency argument to *) +(* 2 zpow(--k)*(y-yhat_k) and uses phihat real (CARLESON_PHIHAT_SQ_RE). *) +let CARLESON_PERK_LIMIT_RE = prove + (`!(h:real->complex) k nJ y. schwartz h /\ --pi < (y - tile_ymid(k,&0,nJ)) / + &2 zpow k /\ + (y - tile_ymid(k,&0,nJ)) / &2 zpow k < pi + ==> ((\N. vsum {nI:int | abs nI <= &N} + (\nI. carleson_ip h (k,nI,nJ) * + fourier (phi_sigma (k,nI,nJ) carleson_phi) y)) + --> Cx(&2 * pi) * fourier h y * + Cx(Re(fourier carleson_phi (&2 zpow (--k) * (y - + tile_ymid(k,&0,nJ)))) pow 2)) + sequentially`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`h:real->complex`; `k:int`; `nJ:int`; + `y:real`] CARLESON_PERK_LIMIT) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN + AP_TERM_TAC THEN + AP_TERM_TAC THEN + SUBGOAL_THEN + `(y - tile_ymid(k,&0,nJ)) / &2 zpow k = &2 zpow (--k) * (y - + tile_ymid(k,&0,nJ))` + SUBST1_TAC THENL + [REWRITE_TAC[REAL_ZPOW_NEG] THEN + SUBGOAL_THEN `~(&2 zpow k = &0)` MP_TAC THENL + [MATCH_MP_TAC REAL_LT_IMP_NZ THEN MATCH_MP_TAC REAL_ZPOW_LT THEN + REAL_ARITH_TAC; + CONV_TAC REAL_FIELD]; ALL_TAC] THEN + REWRITE_TAC[CARLESON_PHIHAT_SQ_RE]);; + +(* The finite tile partial sums are dominated, uniformly in N, by an L^2 *) +(* envelope *) +(* Cx(2pi B) * phihat((z-yy)/2^k). Via CARLESON_PERK_FINITE the sum equals *) +(* Cx(2pi) cfp(G) N u (e^{-iu/2} phihat u), u=(z-yy)/2^k, and *) +(* CFOURIER_PARTIAL_UNIF_ *) +(* BOUND caps |cfp(G) N u| by B = |c_0(G)| + sum|c_k(G)| + sum|c_{-k}(G)| *) +(* (the tile *) +(* base G is Schwartz with support in [-1/5,1/5], so both 282Rb tails are *) +(* summable). *) +(* This B is the fixed dominator for LSPACE_DOMINATED_CONVERGENCE in the *) +(* b-ii limit. *) +let CARLESON_TILESUM_DOMINATED = prove + (`!(h:real->complex) k nJ. + schwartz h + ==> ?B. &0 <= B /\ + !N z. norm(vsum {nI:int | abs nI <= &N} + (\nI. carleson_ip h (k,nI,nJ) * + fourier (phi_sigma (k,nI,nJ) carleson_phi) (drop + z))) + <= norm(Cx(&2 * pi * B) * + fourier carleson_phi ((drop z - tile_ymid(k,&0,nJ)) + / &2 zpow k))`, + REPEAT STRIP_TAC THEN + ABBREV_TAC `G = \t. fourier (h:real->complex) (&2 zpow k * t + + tile_ymid(k,&0,nJ)) * + cexp(ii * Cx(&1/ &2) * Cx t) * fourier carleson_phi t` + THEN + SUBGOAL_THEN `schwartz (G:real->complex)` ASSUME_TAC THENL + [EXPAND_TAC "G" THEN MATCH_MP_TAC CARLESON_G_SCHWARTZ THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + MP_TAC(ISPEC `G:real->complex` CFOURIER_PARTIAL_UNIF_BOUND) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC SCHWARTZ_CSUPP_SUMMABLE_POS; + MATCH_MP_TAC SCHWARTZ_CSUPP_SUMMABLE_NEG] THEN + EXISTS_TAC `&1 / &5` THEN ASM_REWRITE_TAC[] THEN + (CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC]) THEN + (CONJ_TAC THENL [MP_TAC PI_APPROX_32 THEN REAL_ARITH_TAC; ALL_TAC]) THEN + EXPAND_TAC "G" THEN REWRITE_TAC[] THEN X_GEN_TAC `t:real` THEN + DISCH_TAC THEN + MATCH_MP_TAC CARLESON_G_SUPPORT THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + DISCH_TAC THEN + EXISTS_TAC `norm(cfourier_coeff (G:real->complex) (&0)) + + real_infsum (from 1) (\k. norm(cfourier_coeff G (&k))) + + real_infsum (from 1) (\k. norm(cfourier_coeff G (-- &k)))` THEN + CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPECL [`0`; `&0:real`]) THEN + MP_TAC(ISPEC `cfourier_partial (G:real->complex) 0 (&0)` NORM_POS_LE) THEN + REAL_ARITH_TAC; ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`N:num`; `z:real^1`] THEN + ASM_SIMP_TAC[CARLESON_PERK_FINITE] THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX] THEN + SUBGOAL_THEN `norm(cexp(--(ii * Cx(&1/ &2) * + Cx((drop z - tile_ymid(k,&0,nJ)) / &2 zpow k)))) = &1` + SUBST1_TAC THENL + [SUBGOAL_THEN + `--(ii * Cx(&1/ &2) * Cx((drop z - tile_ymid(k,&0,nJ)) / &2 zpow k)) = + ii * Cx(--(&1/ &2 * (drop z - tile_ymid(k,&0,nJ)) / &2 zpow k))` + SUBST1_TAC THENL + [REWRITE_TAC[CX_NEG; CX_MUL] THEN CONV_TAC COMPLEX_RING; ALL_TAC] THEN + REWRITE_TAC[NORM_CEXP_II]; ALL_TAC] THEN + REWRITE_TAC[REAL_MUL_LID] THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NUM] THEN + SUBGOAL_THEN `abs pi = pi` SUBST1_TAC THENL + [REWRITE_TAC[REAL_ABS_REFL] THEN MP_TAC PI_APPROX_32 THEN + REAL_ARITH_TAC; ALL_TAC] THEN + GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [REAL_ARITH `&2 * pi * B = (&2 * pi) + * B`] THEN + REWRITE_TAC[REAL_ARITH + `(&2 * pi) * nc * np <= ((&2 * pi) * absB) * np <=> + (&2 * pi) * nc * np <= (&2 * pi) * absB * np`] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MP_TAC PI_APPROX_32 THEN REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`N:num`; `(drop z - tile_ymid(k,&0,nJ)) / &2 zpow k`]) THEN + REAL_ARITH_TAC);; + +(* The per-k tile partial sums converge POINTWISE EVERYWHERE to 2pi hhat(y) *) +(* Re(phihat(2^{-k}(y-yy)))^2. Interior u=(y-yy)/2^k in (-pi,pi): *) +(* CARLESON_PERK_ *) +(* LIMIT_RE. Exterior |u|>=pi (>1/5): phihat(u)=0 kills the limit AND every *) +(* finite *) +(* tile sum (CARLESON_PERK_FINITE + phihat support), so it is the constant 0 *) +(* sequence. *) +let CARLESON_PERK_LIMIT_ALL = prove + (`!(h:real->complex) k nJ y. + schwartz h + ==> ((\N. vsum {nI:int | abs nI <= &N} + (\nI. carleson_ip h (k,nI,nJ) * + fourier (phi_sigma (k,nI,nJ) carleson_phi) y)) + --> Cx(&2 * pi) * fourier h y * + Cx(Re(fourier carleson_phi + (&2 zpow (--k) * (y - tile_ymid(k,&0,nJ)))) pow 2)) + sequentially`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&2 zpow (--k) * (y - tile_ymid(k,&0,nJ)) = + (y - tile_ymid(k,&0,nJ)) / &2 zpow k` ASSUME_TAC THENL + [REWRITE_TAC[REAL_ZPOW_NEG] THEN + SUBGOAL_THEN `~(&2 zpow k = &0)` MP_TAC THENL + [MATCH_MP_TAC REAL_LT_IMP_NZ THEN MATCH_MP_TAC REAL_ZPOW_LT THEN + REAL_ARITH_TAC; + CONV_TAC REAL_FIELD]; ALL_TAC] THEN + ASM_CASES_TAC `--pi < (y - tile_ymid(k,&0,nJ)) / &2 zpow k /\ + (y - tile_ymid(k,&0,nJ)) / &2 zpow k < pi` THENL + [MATCH_MP_TAC CARLESON_PERK_LIMIT_RE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `&1 / &5 < abs((y - tile_ymid(k,&0,nJ)) / &2 zpow k)` ASSUME_TAC THENL + [MP_TAC PI_APPROX_32 THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `fourier carleson_phi ((y - tile_ymid(k,&0,nJ)) / &2 zpow k) = Cx(&0)` + ASSUME_TAC THENL + [MATCH_MP_TAC CARLESON_PHI_FHAT_SUPPORT THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[RE_CX; COMPLEX_NORM_CX] THEN + REWRITE_TAC[REAL_POW_ZERO; ARITH; COMPLEX_MUL_RZERO; CX_INJ] THEN + SUBGOAL_THEN + `!N. vsum {nI:int | abs nI <= &N} + (\nI. carleson_ip h (k,nI,nJ) * + fourier (phi_sigma (k,nI,nJ) carleson_phi) y) = Cx(&0)` + (fun th -> REWRITE_TAC[th; LIM_CONST]) THEN + GEN_TAC THEN ASM_SIMP_TAC[CARLESON_PERK_FINITE] THEN + ASM_REWRITE_TAC[COMPLEX_MUL_RZERO; COMPLEX_MUL_LZERO]);; + +(* 286O(b), b-ii CORE: the per-k tile partial sums converge to 2pi hhat *) +(* psi_k IN L^2. *) +(* LSPACE_DOMINATED_CONVERGENCE: f_N = tile sum (CARLESON_TILESUM_FOURIER_L2 *) +(* in L^2), *) +(* limit g = 2pi hhat(y) Re(phihat(2^{-k}(y-yy)))^2, dominator *) +(* CARLESON_DOMINATOR_L2 *) +(* with the pointwise bound CARLESON_TILESUM_DOMINATED, pointwise conv *) +(* CARLESON_PERK_ *) +(* LIMIT_ALL (everywhere, so the exceptional set is empty). This L^2 *) +(* convergence is *) +(* what threads the spatial region integral through the tile-sum limit *) +(* (LPRODUCT_L2LIM) *) +(* in the 286O(b) filter-limit identity. *) +let CARLESON_PERK_L2LIM = prove + (`!(h:real->complex) k nJ. + schwartz h + ==> ((\N. lnorm (:real^1) (&2) + (\z. vsum {nI:int | abs nI <= &N} + (\nI. carleson_ip h (k,nI,nJ) * + fourier (phi_sigma (k,nI,nJ) carleson_phi) (drop z)) + - + Cx(&2 * pi) * fourier h (drop z) * + Cx(Re(fourier carleson_phi + (&2 zpow (--k) * (drop z - tile_ymid(k,&0,nJ)))) pow 2))) + ---> &0) sequentially`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `h:real->complex` CARLESON_TILESUM_DOMINATED) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPECL [`k:int`; `nJ:int`]) THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL + [`\N z. vsum {nI:int | abs nI <= &N} + (\nI. carleson_ip h (k,nI,nJ) * + fourier (phi_sigma (k,nI,nJ) carleson_phi) (drop z))`; + `\z:real^1. Cx(&2 * pi) * fourier h (drop z) * + Cx(Re(fourier carleson_phi + (&2 zpow (--k) * (drop z - tile_ymid(k,&0,nJ)))) pow 2)`; + `\z:real^1. Cx(&2 * pi * B) * + fourier carleson_phi ((drop z - tile_ymid(k,&0,nJ)) / &2 zpow + k)`; + `(:real^1)`; `&2`; `{}:real^1->bool`] + LSPACE_DOMINATED_CONVERGENCE) THEN + REWRITE_TAC[NEGLIGIBLE_EMPTY; DIFF_EMPTY; IN_UNIV] THEN + ANTS_TAC THENL [ALL_TAC; SIMP_TAC[]] THEN + REPEAT CONJ_TAC THENL + [REAL_ARITH_TAC; + REWRITE_TAC[CARLESON_TILESUM_FOURIER_L2]; + REWRITE_TAC[CARLESON_DOMINATOR_L2]; + ASM_REWRITE_TAC[]; + GEN_TAC THEN MATCH_MP_TAC CARLESON_PERK_LIMIT_ALL THEN + ASM_REWRITE_TAC[]]);; + +(* 286P(b,c) integral bound: int_F Ah <= 4 C9 *) +(* ||h||_2 *) +(* sqrt(mu F). Via 256Mb (int_F Ah = sup over finite {z_i} of int_F *) +(* max|v_{z_i}|), *) +(* the E_i argmax partition + 246K (K246_SIGN_TRICK), the 286O(b) *) +(* filter-limit tile identity, Fubini over counting measure on Q, and *) +(* CARLESON_286N. *) +(* Reduction to the selected-window tile bound: given *) +(* the *) +(* bound norm(int_F' carleson_wsel) <= C9 ||h||_2 sqrt(mu FF) on every *) +(* argmax-selected *) +(* window integral, CARLESON_286P_BOUND follows. Route: 256Mb (CARLESON_ *) +(* 256MB_A) reduces int_FF carleson_A h <= 4C9||h||_2 sqrt muFF to the *) +(* finite-max *) +(* integral bound for every enumeration u; the two easy legs are *) +(* CARLESON_V_ABSINT + *) +(* CARLESON_V_UNIF_BOUND; the finite-max leg is CARLESON_FINITEMAX_246K *) +(* (246K sign trick, *) +(* giving F' + factor 4) chained with the tile-bound gate. *) +let CARLESON_286P_FROM_TILEBOUND = prove + (`(?C9. &0 <= C9 /\ + !(h:real->complex) u n FF F'. + schwartz h /\ real_measurable FF /\ + measurable F' /\ F' SUBSET (IMAGE lift FF) + ==> norm(integral F' (\x:real^1. carleson_wsel h u n (drop x))) + <= C9 * lnorm (:real^1) (&2) (\z. h(drop z)) * sqrt(real_measure + FF)) + ==> ?C9. &0 <= C9 /\ + !(h:real->complex) FF. + schwartz h /\ real_measurable FF + ==> real_integral FF (carleson_A h) + <= &4 * C9 * lnorm (:real^1) (&2) (\z. h(drop z)) * + sqrt(real_measure FF)`, + DISCH_THEN(X_CHOOSE_THEN `C9:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `C9:real` THEN ASM_REWRITE_TAC[] THEN + REPEAT STRIP_TAC THEN + MATCH_MP_TAC CARLESON_256MB_A THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `u:num->real` THEN REPEAT CONJ_TAC THENL + [X_GEN_TAC `i:num` THEN REWRITE_TAC[ETA_AX] THEN + MATCH_MP_TAC CARLESON_V_ABSINT THEN ASM_REWRITE_TAC[]; + MP_TAC(ISPEC `h:real->complex` CARLESON_V_UNIF_BOUND) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN MESON_TAC[]; + X_GEN_TAC `n:num` THEN + MP_TAC(ISPECL [`h:real->complex`; `u:num->real`; `n:num`; + `FF:real->bool`] CARLESON_FINITEMAX_246K) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `F':real^1->bool` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `norm(integral F' (\x:real^1. carleson_wsel h u n (drop x))) + <= C9 * lnorm (:real^1) (&2) (\z. (h:real->complex)(drop z)) + * sqrt(real_measure FF)` + ASSUME_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + ABBREV_TAC `Q = C9 * lnorm (:real^1) (&2) (\z. (h:real->complex)(drop z)) * + sqrt(real_measure FF)` THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN ASM_REAL_ARITH_TAC]);; + +(* The symmetric integer scale-segment {k | abs k <= &K} is finite (needed *) +(* for *) +(* LIM_VSUM over scales in the tile-limit collapse). INT_ARITH recasts abs k *) +(* as *) +(* the two-sided bound --&K <= k /\ k <= &K, then FINITE_INT_SEG. *) +let CARLESON_FINITE_KSEG = prove + (`!K:num. FINITE {k:int | abs k <= &K}`, + GEN_TAC THEN + SUBGOAL_THEN `{k:int | abs k <= &K} = {k:int | --(&K) <= k /\ k <= &K}` + (fun th -> REWRITE_TAC[th; FINITE_INT_SEG]) THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN INT_ARITH_TAC);; + +(* The flat cell-scale-frequency triple index set {(j,k,nI) : j<=n, abs *) +(* k<=K, abs nI<=N} is finite (bounding CROSS product) -- for the *) +(* tile-regroup VSUM_IMAGE_GEN reindex. *) +let CARLESON_TRIPLE_FINITE = prove + (`!n K N. FINITE {(j:num,k:int,nI:int) | j <= n /\ abs k <= &K /\ abs nI <= + &N}`, + REPEAT GEN_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `{j:num | j <= n} CROSS {(k:int,nI:int) | abs k <= &K /\ abs nI <= + &N}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC FINITE_CROSS THEN CONJ_TAC THENL + [REWRITE_TAC[FINITE_NUMSEG_LE]; + MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `{k:int | abs k <= &K} CROSS {nI:int | abs nI <= &N}` THEN + REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC FINITE_CROSS THEN REWRITE_TAC[CARLESON_FINITE_KSEG]; + REWRITE_TAC[SUBSET; FORALL_PAIR_THM; IN_ELIM_PAIR_THM; IN_CROSS; + IN_ELIM_THM] THEN + MESON_TAC[]]]; + REWRITE_TAC[SUBSET; FORALL_PAIR_THM; IN_ELIM_THM; IN_CROSS; + IN_ELIM_PAIR_THM] THEN + MESON_TAC[PAIR_EQ]]);; + +(* Witness-uniqueness: for u_j witnessing scale ks (some nJ has u_j in *) +(* Jr(ks,0,nJ)), the *) +(* SELECT'd witness index @nJ.u_j in Jr(ks,0,nJ) equals nJs IFF u_j IN *) +(* Jr(ks,0,nJs). *) +(* (CARLESON_THETA_SINGLE_NJ tile-uniqueness + SELECT_CONV.) This identifies *) +(* which cells *) +(* j collapse to a given tile under (j,k,nI)|->(k,nI,@nJ.u_j in Jr(k,0,nJ)) *) +(* in the regroup. *) +let CARLESON_WITNJ_EQ = prove + (`!(u:num->real) j ks nIs nJs. + (?nJ. u j IN tile_Jr(ks,&0,nJ)) + ==> ((@nJ. u j IN tile_Jr(ks,&0,nJ)) = nJs <=> u j IN + tile_Jr(ks,&0,nJs))`, + REPEAT STRIP_TAC THEN EQ_TAC THENL + [DISCH_THEN(SUBST1_TAC o SYM) THEN CONV_TAC SELECT_CONV THEN + ASM_MESON_TAC[]; + DISCH_TAC THEN + SUBGOAL_THEN + `u (j:num) IN tile_Jr(ks,&0,(@nJ:int. u j IN tile_Jr(ks,&0,nJ)))` + ASSUME_TAC THENL + [CONV_TAC SELECT_CONV THEN ASM_MESON_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL [`ks:int`; `&0:int`; + `(@nJ:int. (u:num->real) j IN tile_Jr(ks,&0,nJ))`; + `&0:int`; `nJs:int`; + `(u:num->real) j`] CARLESON_THETA_SINGLE_NJ) THEN + ASM_REWRITE_TAC[]]);; + +(* Per-tile collapse-preimage (FIBER) identity: within the (range-bounded, *) +(* witnessed) *) +(* triple set, the fiber over a tile (ks,nIs,nJs) under the collapse map *) +(* (j,k,nI)|->(k,nI,@nJ.u_j in Jr(k,0,nJ)) is exactly {j<=n | u_j in *) +(* Jr(ks,0,nJs)}, tupled *) +(* by (\j. (j,ks,nIs)). This is the geometric heart of the tile-regroup: *) +(* cells j sharing *) +(* a witness nJs collapse to the same tile. (=>): k=ks case + *) +(* CARLESON_WITNJ_EQ; (<=): *) +(* WITNJ_EQ turns u_j in Jr(ks,0,nJs) back into witnJ = nJs. *) +let CARLESON_TILE_FIBER = prove + (`!(u:num->real) n K N ks nIs nJs. + abs ks <= &K /\ abs nIs <= &N + ==> {t | t IN {(j:num,k:int,nI:int) | j <= n /\ abs k <= &K /\ abs nI <= + &N /\ + (?nJ:int. u j IN tile_Jr(k,&0,nJ))} /\ + (\(j,k,nI). (k,nI,(@nJ:int. u j IN tile_Jr(k,&0,nJ)))) t = + (ks,nIs,nJs)} = + IMAGE (\j:num. (j,ks,nIs)) {j:num | j <= n /\ u j IN + tile_Jr(ks,&0,nJs)}`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE; FORALL_PAIR_THM; + EXISTS_PAIR_THM] THEN + REWRITE_TAC[PAIR_EQ] THEN + MAP_EVERY X_GEN_TAC [`j:num`; `k:int`; `nI:int`] THEN + REWRITE_TAC[IN_ELIM_PAIR_THM] THEN EQ_TAC THEN STRIP_TAC THENL + [EXISTS_TAC `j:num` THEN REPLICATE_TAC 2 (POP_ASSUM MP_TAC) THEN + ASM_CASES_TAC `k:int = ks` THEN ASM_REWRITE_TAC[] THEN + REPEAT DISCH_TAC THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`u:num->real`; `j:num`; `ks:int`; `nIs:int`; + `nJs:int`] CARLESON_WITNJ_EQ) THEN + (ANTS_TAC THENL [ASM_MESON_TAC[]; DISCH_TAC]) THEN ASM_MESON_TAC[]; + REPEAT (FIRST_X_ASSUM SUBST_ALL_TAC) THEN + SUBGOAL_THEN `?nJ:int. u (x:num) IN tile_Jr(ks,&0,nJ)` ASSUME_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL [`u:num->real`; `x:num`; `ks:int`; `nIs:int`; + `nJs:int`] CARLESON_WITNJ_EQ) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + REPEAT CONJ_TAC THEN TRY (ASM_MESON_TAC[]) THEN + MAP_EVERY EXISTS_TAC [`x:num`; `ks:int`; `nIs:int`] THEN + ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[]]);; + +(* Guard-into-sum: (if P then vsum s f else vec 0) = vsum s (\i. if P then f *) +(* i else 0), *) +(* for FINITE s (else-branch: VSUM_0). Lets the witness-guard move inside *) +(* the nI-sum so *) +(* the triple sum flattens cleanly. *) +let VSUM_IF_GUARD = prove + (`!P s (f:A->real^N). FINITE s + ==> (if P then vsum s f else vec 0) = vsum s (\i. if P then f i else vec + 0)`, + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[ETA_AX] THEN + ASM_SIMP_TAC[VSUM_0]);; + +(* Fiber-sum reduction (tile-regroup STEP B inner): for a range-bounded tile *) +(* (ks,nIs,nJs), *) +(* the VSUM_IMAGE_GEN inner fiber-sum over the collapse-preimage reduces to *) +(* the target *) +(* tile-summand carleson_ip h s * int_{F' cap g^-1[Jr_s]} phi_s. Chain: *) +(* CARLESON_TILE_ *) +(* FIBER (fiber = tupled j-cells) -> VSUM_IMAGE (inj tupling) -> on-set *) +(* witnJ=nJs so the *) +(* tile is literally s (VSUM_EQ + CARLESON_WITNJ_EQ) -> VSUM_COMPLEX_LMUL *) +(* (pull ) -> *) +(* CARLESON_CELL_SUM_INTEGRAL (merge j-cells; tile_Jr nI-indep aligns the *) +(* cell set). *) +let CARLESON_TILE_FIBER_SUM = prove + (`!(h:real->complex) u n FF F' K N ks nIs nJs. + schwartz h /\ real_measurable FF /\ measurable F' /\ F' SUBSET (IMAGE lift + FF) /\ + abs ks <= &K /\ abs nIs <= &N + ==> vsum {t | t IN {(j:num,k:int,nI:int) | j <= n /\ abs k <= &K /\ abs nI + <= &N /\ + (?nJ:int. u j IN tile_Jr(k,&0,nJ))} /\ + (\(j,k,nI). (k,nI,(@nJ:int. u j IN tile_Jr(k,&0,nJ)))) t = + (ks,nIs,nJs)} + (\(j,k,nI). carleson_ip h (k,nI,(@nJ:int. u j IN + tile_Jr(k,&0,nJ))) * + integral (F' INTER {x:real^1 | cargmax (\i:num. + carleson_v h (u i)) n (drop x) = j}) + (\z. phi_sigma (k,nI,(@nJ:int. u j IN + tile_Jr(k,&0,nJ))) carleson_phi (drop z))) + = carleson_ip h (ks,nIs,nJs) * + integral (F' INTER {x:real^1 | (u(cargmax (\i:num. carleson_v h (u + i)) n (drop x))) IN tile_Jr(ks,nIs,nJs)}) + (\z. phi_sigma (ks,nIs,nJs) carleson_phi (drop z))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`u:num->real`; `n:num`; `K:num`; `N:num`; `ks:int`; `nIs:int`; + `nJs:int`] CARLESON_TILE_FIBER) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + MP_TAC(ISPECL [`\j:num. (j:num,ks:int,nIs:int)`; + `\(j:num,k:int,nI:int). carleson_ip (h:real->complex) (k,nI,(@nJ:int. u j + IN tile_Jr(k,&0,nJ))) * + integral (F' INTER {x:real^1 | cargmax (\i:num. + carleson_v h (u i)) n (drop x) = j}) + (\z. phi_sigma (k,nI,(@nJ:int. u j IN + tile_Jr(k,&0,nJ))) carleson_phi (drop z))`; + `{j:num | j <= n /\ u j IN tile_Jr(ks,&0,nJs)}`] VSUM_IMAGE) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{j:num | j <= n}` THEN + REWRITE_TAC[FINITE_NUMSEG_LE; SUBSET; IN_ELIM_THM] THEN MESON_TAC[]; + REWRITE_TAC[IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o AP_TERM `FST:num#int#int->num`) THEN + REWRITE_TAC[]]; + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[o_DEF]] THEN + SUBGOAL_THEN + `FINITE {j:num | j <= n /\ u j IN tile_Jr (ks,&0,nJs)}` ASSUME_TAC THENL + [MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{j:num | j <= n}` THEN + REWRITE_TAC[FINITE_NUMSEG_LE; SUBSET; IN_ELIM_THM] THEN + MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `vsum {j | j <= n /\ u j IN tile_Jr (ks,&0,nJs)} + (\x. carleson_ip (h:real->complex) (ks,nIs,(@nJ:int. u x IN tile_Jr + (ks,&0,nJ))) * + integral (F' INTER {x' | cargmax (\i. carleson_v h (u i)) n (drop + x') = x}) + (\z. phi_sigma (ks,nIs,(@nJ:int. u x IN tile_Jr (ks,&0,nJ))) + carleson_phi (drop z))) = + vsum {j | j <= n /\ u j IN tile_Jr (ks,&0,nJs)} + (\x. carleson_ip (h:real->complex) (ks,nIs,nJs) * + integral (F' INTER {x' | cargmax (\i. carleson_v h (u i)) n (drop + x') = x}) + (\z. phi_sigma (ks,nIs,nJs) carleson_phi (drop z)))` + SUBST1_TAC THENL + [MATCH_MP_TAC VSUM_EQ THEN X_GEN_TAC `j:num` THEN + REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN + SUBGOAL_THEN + `(@nJ:int. u (j:num) IN tile_Jr (ks,&0,nJ)) = nJs` (fun th -> + REWRITE_TAC[th]) THEN + MP_TAC(ISPECL [`u:num->real`; `j:num`; `ks:int`; `nIs:int`; + `nJs:int`] CARLESON_WITNJ_EQ) THEN + ANTS_TAC THENL [ASM_MESON_TAC[]; ASM_REWRITE_TAC[]]; ALL_TAC] THEN + ASM_SIMP_TAC[VSUM_COMPLEX_LMUL] THEN AP_TERM_TAC THEN + CONV_TAC SYM_CONV THEN + SUBGOAL_THEN + `tile_Jr(ks,&0,nJs) = tile_Jr(ks,nIs,nJs)` (fun th -> ONCE_REWRITE_TAC[th]) + THENL + [REWRITE_TAC[tile_Jr]; ALL_TAC] THEN + MP_TAC(ISPECL [`\z:real^1. phi_sigma (ks,nIs,nJs) carleson_phi (drop z)`; + `h:real->complex`; `u:num->real`; `n:num`; `F':real^1->bool`; + `tile_Jr(ks,nIs,nJs)`] + CARLESON_CELL_SUM_INTEGRAL) THEN + ANTS_TAC THENL + [X_GEN_TAC `j:num` THEN + MATCH_MP_TAC CARLESON_PHISIG_PIECE_INTEGRABLE THEN + EXISTS_TAC `FF:real->bool` THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [TRANS_TAC SUBSET_TRANS `F':real^1->bool` THEN + ASM_REWRITE_TAC[INTER_SUBSET]; + MATCH_MP_TAC CARLESON_WSEL_PIECE_LMEAS THEN ASM_REWRITE_TAC[]]; + DISCH_THEN SUBST1_TAC THEN REFL_TAC]);; + +(* Guard-into-sum specialized to the N-frequency segment (pre-proved; feeds *) +(* the flatten's guard-move without an inline-MESON rewrite, which would run *) +(* away). *) +let GUARD_NSEG = prove + (`!P N (f:int->real^2). + (if P then vsum {nI:int | abs nI <= &N} f else vec 0) = + vsum {nI:int | abs nI <= &N} (\nI. if P then f nI else vec 0)`, + REPEAT GEN_TAC THEN MATCH_MP_TAC VSUM_IF_GUARD THEN + SUBGOAL_THEN `{nI:int | abs nI <= &N} = {nI:int | --(&N) <= nI /\ nI <= &N}` + (fun th -> REWRITE_TAC[th; FINITE_INT_SEG]) THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN INT_ARITH_TAC);; + +(* The frequency segment {nI | abs nI <= &N} is finite (companion of *) +(* CARLESON_FINITE_KSEG). *) +let CARLESON_FINITE_NSEG = prove + (`!N:num. FINITE {nI:int | abs nI <= &N}`, + GEN_TAC THEN SUBGOAL_THEN + `{nI:int | abs nI <= &N} = {nI:int | --(&N) <= nI /\ nI <= &N}` + (fun th -> REWRITE_TAC[th; FINITE_INT_SEG]) THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN INT_ARITH_TAC);; + +(* The scale-frequency pair segment {(k,nI) | abs k<=K /\ abs nI<=N} is *) +(* finite (CROSS). *) +let CARLESON_FINITE_KNSEG = prove + (`!K N:num. FINITE {(k:int,nI:int) | abs k <= &K /\ abs nI <= &N}`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `{(k:int,nI:int) | abs k <= &K /\ abs nI <= &N} = + {k:int | abs k <= &K} CROSS {nI:int | abs nI <= &N}` + (fun th -> REWRITE_TAC[th]) THENL + [REWRITE_TAC[EXTENSION; FORALL_PAIR_THM; IN_ELIM_PAIR_THM; IN_CROSS; + IN_ELIM_THM]; + MATCH_MP_TAC FINITE_CROSS THEN + REWRITE_TAC[CARLESON_FINITE_KSEG; CARLESON_FINITE_NSEG]]);; + +(* Tile-regroup STEP A (flatten): the nested guarded cell/scale/freq vsum of *) +(* b_{K,N} *) +(* equals a single vsum over the flat triple index set. Guard moved inside *) +(* the nI-sum *) +(* (GUARD_NSEG), then VSUM_VSUM_PRODUCT twice (inner (k,nI), outer (j,-)) *) +(* with the nested- *) +(* pair product set reconciled to the flat triple set (EXTENSION + PAIR_EQ) *) +(* + VSUM_EQ for *) +(* the summand pair-pattern. Abstract in gg,Q so it is a pure combinatorial *) +(* identity. *) +let CARLESON_WSEL_FLATTEN = prove + (`!(gg:num->int->int->real^2) (Q:num->int->bool) n K N. + vsum {j:num | j <= n} + (\j. vsum {k:int | abs k <= &K} + (\k. if Q j k then vsum {nI:int | abs nI <= &N} (\nI. gg j k nI) else + vec 0)) + = vsum {(j:num,k:int,nI:int) | j <= n /\ abs k <= &K /\ abs nI <= &N} + (\(j,k,nI). if Q j k then gg j k nI else vec 0)`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GUARD_NSEG] THEN BETA_TAC THEN + SUBGOAL_THEN + `!j:num. vsum {k:int | abs k <= &K} + (\k. vsum {nI:int | abs nI <= &N} (\nI. if Q j k then + (gg:num->int->int->real^2) j k nI else vec 0)) + = vsum {(k:int,nI:int) | abs k <= &K /\ abs nI <= &N} + (\(k,nI). if Q j k then gg j k nI else vec 0)` + (fun th -> REWRITE_TAC[th]) THENL + [GEN_TAC THEN + MP_TAC(ISPECL [`{k:int | abs k <= &K}`; `\k:int. {nI:int | abs nI <= &N}`; + `\k nI. if (Q:num->int->bool) j k then (gg:num->int->int->real^2) j k nI + else vec 0`] + VSUM_VSUM_PRODUCT) THEN + ASM_SIMP_TAC[CARLESON_FINITE_KSEG; CARLESON_FINITE_NSEG] THEN + REWRITE_TAC[IN_ELIM_THM; ETA_AX]; ALL_TAC] THEN + MP_TAC(ISPECL [`{j:num | j <= n}`; + `\j:num. {(k:int,nI:int) | abs k <= &K /\ abs nI <= &N}`; + `\j. \(k:int,nI:int). if (Q:num->int->bool) j k then + (gg:num->int->int->real^2) j k nI else vec 0`] + VSUM_VSUM_PRODUCT) THEN + ASM_SIMP_TAC[FINITE_NUMSEG_LE; CARLESON_FINITE_KNSEG] THEN DISCH_THEN + SUBST1_TAC THEN + SUBGOAL_THEN + `{(i:num,j:int#int) | i IN {j:num | j <= n} /\ j IN {(k:int,nI:int) | abs k + <= &K /\ abs nI <= &N}} + = {(j:num,k:int,nI:int) | j <= n /\ abs k <= &K /\ abs nI <= &N}` + (fun th -> REWRITE_TAC[th]) THENL + [REWRITE_TAC[EXTENSION; FORALL_PAIR_THM; IN_ELIM_THM; IN_ELIM_PAIR_THM] THEN + REWRITE_TAC[PAIR_EQ] THEN MESON_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC VSUM_EQ THEN REWRITE_TAC[FORALL_PAIR_THM; IN_ELIM_PAIR_THM] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[]);; + +(* Sequential-limit vs distance-to-limit-null bridge (topology helper for *) +(* the tile-limit diagonal extraction). (a --> L) <=> (\m. dist(a m,L)) ---> *) +(* 0. *) +let LIM_DIST_NULL_EQ = prove + (`!(a:num->real^N) L. + (a --> L) sequentially <=> ((\m. dist(a m, L)) ---> &0) sequentially`, + REPEAT GEN_TAC THEN + REWRITE_TAC[LIM_SEQUENTIALLY; REALLIM_SEQUENTIALLY; REAL_SUB_RZERO] THEN + REWRITE_TAC[MESON[dist; DIST_POS_LE; + REAL_ABS_REFL] `abs(dist(x:real^N,y)) = dist(x,y)`]);; + +(* Diagonal-sequence extraction: if a --> L and for each m the row b m N --> *) +(* a m *) +(* (as N-->inf), there is a diagonal index nfun with (\m. b m (nfun m)) --> *) +(* L. Pick *) +(* nfun m with dist(b m (nfun m), a m) < 1/(m+1); then dist(b m(nfun m),L) *) +(* <= *) +(* 1/(m+1) + dist(a m,L) --> 0 by REALLIM_NULL_COMPARISON. Keystone for *) +(* collapsing *) +(* the tile-limit's nested lim_K/lim_N into a single Qenum sequence. *) +let LIM_DIAGONAL_SEQ = prove + (`!(b:num->num->real^N) a (L:real^N). + (a --> L) sequentially /\ + (!m. ((\N. b m N) --> a m) sequentially) + ==> ?nfun:num->num. ((\m. b m (nfun m)) --> L) sequentially`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `!m:num. ?N:num. dist(b m N:real^N, a m) < inv(&m + &1)` + (fun th -> MP_TAC(REWRITE_RULE[SKOLEM_THM] th)) THENL + [X_GEN_TAC `m:num` THEN + FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN + REWRITE_TAC[LIM_SEQUENTIALLY] THEN + DISCH_THEN(MP_TAC o SPEC `inv(&m + &1)`) THEN + ANTS_TAC THENL + [MATCH_MP_TAC REAL_LT_INV THEN REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` (MP_TAC o SPEC `N:num`)) THEN + REWRITE_TAC[LE_REFL] THEN MESON_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `nfun:num->num` ASSUME_TAC) THEN + EXISTS_TAC `nfun:num->num` THEN + ONCE_REWRITE_TAC[LIM_DIST_NULL_EQ] THEN CONV_TAC(DEPTH_CONV BETA_CONV) THEN + MATCH_MP_TAC REALLIM_NULL_COMPARISON THEN + EXISTS_TAC `\m:num. inv(&m + &1) + dist(a m:real^N, L)` THEN CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `0` THEN + X_GEN_TAC `m:num` THEN DISCH_TAC THEN + SUBGOAL_THEN + `abs(dist((b:num->num->real^N) m ((nfun:num->num) m), L:real^N)) = + dist((b:num->num->real^N) m ((nfun:num->num) m), L)` + SUBST1_TAC THENL [REWRITE_TAC[REAL_ABS_REFL; DIST_POS_LE]; ALL_TAC] THEN + MP_TAC(ISPECL + [`(b:num->num->real^N) m ((nfun:num->num) m)`; + `(a:num->real^N) m`; `L:real^N`] DIST_TRIANGLE) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `m:num` o + check(fun th -> is_forall(concl th) && free_in `nfun:num->num` (concl + th))) THEN + REAL_ARITH_TAC; + MATCH_MP_TAC REALLIM_NULL_ADD THEN CONJ_TAC THENL + [REWRITE_TAC[REALLIM_1_OVER_N_OFFSET]; + ASM_MESON_TAC[LIM_DIST_NULL_EQ]]]);; + + +(* Ahat_n f integrable on any measurable set (measurable + loc-L^1 const *) +(* bound). *) +let CARLESON_AHAT_TRUNC_INTEGRABLE_GEN = prove + (`!(f:real->complex) n FF. + (\z. f(drop z)) IN lspace (:real^1) (&2) /\ &0 <= n /\ real_measurable FF + ==> (\y. carleson_Ahat_trunc f n y) real_integrable_on FF`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN + EXISTS_TAC `\y:real. inv(sqrt(&2 * pi)) * + drop(integral (IMAGE lift (real_interval[--n,n])) (\x. + lift(norm((f:real->complex)(drop x)))))` THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC REAL_MEASURABLE_ON_MEASURABLE_SUBSET THEN + EXISTS_TAC `(:real)` THEN ASM_REWRITE_TAC[SUBSET_UNIV] THEN + MATCH_MP_TAC CARLESON_AHAT_TRUNC_MEASURABLE THEN ASM_REWRITE_TAC[]; + ONCE_REWRITE_TAC[GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_INTEGRABLE_LMUL THEN + ASM_REWRITE_TAC[GSYM REAL_MEASURABLE]; + X_GEN_TAC `y:real` THEN DISCH_TAC THEN + SUBGOAL_THEN `&0 <= carleson_Ahat_trunc f n y` ASSUME_TAC THENL + [MATCH_MP_TAC CARLESON_AHAT_TRUNC_POS THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `carleson_Ahat_trunc f n y <= inv(sqrt(&2 * pi)) * + drop(integral (IMAGE lift (real_interval[--n,n])) (\x. + lift(norm((f:real->complex)(drop x)))))` + ASSUME_TAC THENL + [MATCH_MP_TAC CARLESON_AHAT_TRUNC_FINITE THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC CARLESON_LSPACE2_LOCAL_ABSINT THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_REAL_ARITH_TAC]);; + +(* Truncated Schwartz bound: int_F Ahat_n h <= C10 ||h||_2 sqrt muF (from *) +(* gate). *) +let CARLESON_286T_TRUNC_SCHWARTZ = prove + (`!(h:real->complex) FF n C10. + &0 <= C10 /\ schwartz h /\ real_measurable FF /\ &0 <= n /\ + real_integral FF (carleson_Ahat h) + <= C10 * lnorm (:real^1) (&2) (\z. h(drop z)) * sqrt(real_measure FF) + ==> real_integral FF (\y. carleson_Ahat_trunc h n y) + <= C10 * lnorm (:real^1) (&2) (\z. h(drop z)) * sqrt(real_measure + FF)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `real_integral FF (carleson_Ahat h)` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_INTEGRAL_LE THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CARLESON_AHAT_TRUNC_INTEGRABLE_GEN THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SCHWARTZ_L2 THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC CARLESON_AHAT_SCHWARTZ_INTEGRABLE THEN ASM_REWRITE_TAC[]; + X_GEN_TAC `y:real` THEN DISCH_TAC THEN BETA_TAC THEN + MATCH_MP_TAC CARLESON_AHAT_TRUNC_SCHWARTZ_LE THEN ASM_REWRITE_TAC[]]);; + +(* Integrate the 286T(c) SUB_BOUND over [-M,M]: Ahat_n f-integral vs Ahat_n *) +(* h. *) +let CARLESON_TRUNC_DENSITY_STEP = prove + (`!(f:real->complex) h M n. + &0 <= n /\ (\z. f(drop z)) IN lspace (:real^1) (&2) /\ schwartz h + ==> real_integral (real_interval[--(&M),&M]) (\y. carleson_Ahat_trunc f n + y) + <= real_integral (real_interval[--(&M),&M]) (\y. carleson_Ahat_trunc h + n y) + + (inv(sqrt(&2 * pi)) * sqrt(&2 * n) * + lnorm (:real^1) (&2) (\z. f(drop z) - h(drop z))) * (&2 * &M)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\z. (h:real->complex)(drop z)) IN lspace (:real^1) (&2)` ASSUME_TAC THENL + [MATCH_MP_TAC SCHWARTZ_L2 THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL + [`\y. carleson_Ahat_trunc (f:real->complex) n y`; + `\y. carleson_Ahat_trunc (h:real->complex) n y + + inv(sqrt(&2 * pi)) * sqrt(&2 * n) * + lnorm (:real^1) (&2) (\z. (f:real->complex)(drop z) - h(drop z))`; + `real_interval[--(&M),&M]`] REAL_INTEGRAL_LE) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CARLESON_AHAT_TRUNC_INTEGRABLE_GEN THEN + ASM_REWRITE_TAC[REAL_MEASURABLE_REAL_INTERVAL]; + MATCH_MP_TAC REAL_INTEGRABLE_ADD THEN CONJ_TAC THENL + [MATCH_MP_TAC CARLESON_AHAT_TRUNC_INTEGRABLE_GEN THEN + ASM_REWRITE_TAC[REAL_MEASURABLE_REAL_INTERVAL]; + ONCE_REWRITE_TAC[GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_INTEGRABLE_LMUL THEN + REWRITE_TAC[GSYM REAL_MEASURABLE; REAL_MEASURABLE_REAL_INTERVAL]]; + X_GEN_TAC `y:real` THEN DISCH_TAC THEN BETA_TAC THEN + MATCH_MP_TAC CARLESON_AHAT_TRUNC_SUB_BOUND THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `b = c ==> a <= b ==> a <= c`) THEN + W(MP_TAC o PART_MATCH (lhs o rand) REAL_INTEGRAL_ADD o lhs o snd) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC CARLESON_AHAT_TRUNC_INTEGRABLE_GEN THEN + ASM_REWRITE_TAC[REAL_MEASURABLE_REAL_INTERVAL]; + ONCE_REWRITE_TAC[GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_INTEGRABLE_LMUL THEN + REWRITE_TAC[GSYM REAL_MEASURABLE; REAL_MEASURABLE_REAL_INTERVAL]]; + DISCH_THEN SUBST1_TAC] THEN + AP_TERM_TAC THEN + SUBGOAL_THEN `--(&M):real <= &M` ASSUME_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_INTEGRAL_CONST] THEN REAL_ARITH_TAC);; + +(* lnorm reverse triangle: ||h||_2 <= ||f||_2 + ||f-h||_2. *) +let LNORM_TRIANGLE_SUB_H = prove + (`!(f:real->complex) h. + (\z. f(drop z)) IN lspace (:real^1) (&2) /\ (\z. h(drop z)) IN lspace + (:real^1) (&2) + ==> lnorm (:real^1) (&2) (\z. h(drop z)) + <= lnorm (:real^1) (&2) (\z. f(drop z)) + + lnorm (:real^1) (&2) (\z. f(drop z) - h(drop z))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\z:real^1. h(drop z)) = + (\z:real^1. (f:real->complex)(drop z) + --(f(drop z) - h(drop z)))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + CONV_TAC COMPLEX_RING; ALL_TAC] THEN + MP_TAC(ISPECL [`(:real^1)`; `&2`; `\z. (f:real->complex)(drop z)`; + `\z. --((f:real->complex)(drop z) - h(drop z))`] + LNORM_TRIANGLE) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [ASM_REWRITE_TAC[REAL_ARITH `&1 <= &2`] THEN + MATCH_MP_TAC LSPACE_NEG THEN MATCH_MP_TAC LSPACE_SUB THEN + ASM_REWRITE_TAC[REAL_POS]; + REWRITE_TAC[LNORM_NEG]]);; + +(* Arithmetic: 0 t*(K-1) <= eps. *) +let TRUNC_EPS_ARITH = prove + (`!K t eps. &0 < K /\ &0 <= t /\ t < eps / K /\ &0 <= K - &1 + ==> t * (K - &1) <= eps`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&0 < eps / K` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(eps / K) * (K - &1)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_RMUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE]; ALL_TAC] THEN + SUBGOAL_THEN `(eps / K) * (K - &1) <= (eps / K) * K` MP_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[REAL_DIV_RMUL; REAL_LT_IMP_NZ]);; + +(* [286T(c), H1] general truncated bound int_{[-M,M]} Ahat_n f <= C10 *) +(* ||f||_2 *) +(* sqrt(2M) for f in L^2, from the Schwartz gate by density (284N). This is *) +(* exactly the H1 hypothesis of CARLESON_286T_FROM_TRUNC / CARLESON_286U_ *) +(* EXISTS_FROM_BOUNDS. --- *) +let CARLESON_286T_TRUNC_GENERAL = prove + (`!(f:real->complex) M n C10. + &0 <= C10 /\ &0 <= n /\ (\z. f(drop z)) IN lspace (:real^1) (&2) /\ + (!(h:real->complex) FF. + schwartz h /\ real_measurable FF + ==> real_integral FF (carleson_Ahat h) + <= C10 * lnorm (:real^1) (&2) (\z. h(drop z)) * sqrt(real_measure + FF)) + ==> real_integral (real_interval[--(&M),&M]) (\y. carleson_Ahat_trunc f n + y) + <= C10 * lnorm (:real^1) (&2) (\z. f(drop z)) * sqrt(&2 * &M)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_EPSILON THEN + X_GEN_TAC `eps:real` THEN DISCH_TAC THEN + ABBREV_TAC `K = &1 + C10 * sqrt(&2 * &M) + + inv(sqrt(&2 * pi)) * sqrt(&2 * n) * (&2 * &M)` THEN + SUBGOAL_THEN `&0 <= C10 * sqrt(&2 * &M)` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN + ASM_SIMP_TAC[SQRT_POS_LE; REAL_LE_MUL; REAL_POS]; + ALL_TAC] THEN + SUBGOAL_THEN + `&0 <= inv(sqrt(&2 * pi)) * sqrt(&2 * n) * (&2 * &M)` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN + SIMP_TAC[REAL_LE_INV_EQ; SQRT_POS_LE; REAL_LE_MUL; REAL_POS; + PI_POS_LE] THEN + MATCH_MP_TAC REAL_LE_MUL THEN + ASM_SIMP_TAC[SQRT_POS_LE; REAL_LE_MUL; REAL_POS]; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < K` ASSUME_TAC THENL [EXPAND_TAC "K" THEN + ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `&0 < eps / K` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LT_DIV THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MP_TAC(ISPEC `\z. (f:real->complex)(drop z)` LSPACE_APPROXIMATE_SCHWARTZ) + THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(fun dth -> MP_TAC(MATCH_MP dth (ASSUME `&0 < eps / K`))) THEN + DISCH_THEN(X_CHOOSE_THEN `h:real->complex` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `(\z. (h:real->complex)(drop z)) IN lspace (:real^1) (&2)` ASSUME_TAC THENL + [MATCH_MP_TAC SCHWARTZ_L2 THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `real_measure(real_interval[--(&M),&M]) = &2 * &M` ASSUME_TAC THENL + [REWRITE_TAC[REAL_MEASURE_REAL_INTERVAL] THEN REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPECL [`f:real->complex`; `h:real->complex`; `M:num`; `n:real`] + CARLESON_TRUNC_DENSITY_STEP) THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`h:real->complex`; `real_interval[--(&M),&M]`; `n:real`; + `C10:real`] + CARLESON_286T_TRUNC_SCHWARTZ) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[REAL_MEASURABLE_REAL_INTERVAL] THEN + FIRST_X_ASSUM(fun th -> MP_TAC(SPECL [`h:real->complex`; + `real_interval[--(&M),&M]`] th)) THEN + ASM_REWRITE_TAC[REAL_MEASURABLE_REAL_INTERVAL]; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN DISCH_TAC THEN + MP_TAC(ISPECL [`f:real->complex`; + `h:real->complex`] LNORM_TRIANGLE_SUB_H) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`K:real`; + `lnorm (:real^1) (&2) (\z. (f:real->complex)(drop z) - h(drop z))`; + `eps:real`] TRUNC_EPS_ARITH) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC LNORM_POS_LE THEN REWRITE_TAC[REAL_ARITH `&1 <= &2`] THEN + MATCH_MP_TAC LSPACE_SUB THEN ASM_REWRITE_TAC[REAL_POS]; + EXPAND_TAC "K" THEN ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + DISCH_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `C10 * lnorm (:real^1) (&2) (\z. (h:real->complex)(drop z)) * sqrt(&2 * &M) + + + (inv(sqrt(&2 * pi)) * sqrt(&2 * n) * + lnorm (:real^1) (&2) (\z. (f:real->complex)(drop z) - h(drop z))) * (&2 * + &M)` THEN + CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `C10 * lnorm (:real^1) (&2) (\z. (h:real->complex)(drop z)) * sqrt(&2 * &M) + <= C10 * lnorm (:real^1) (&2) (\z. (f:real->complex)(drop z)) * sqrt(&2 * + &M) + + lnorm (:real^1) (&2) (\z. (f:real->complex)(drop z) - h(drop z)) * (C10 + * sqrt(&2 * &M))` + ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `C10 * (lnorm (:real^1) (&2) (\z. (f:real->complex)(drop z)) + + lnorm (:real^1) (&2) (\z. (f:real->complex)(drop z) - h(drop z))) + * + sqrt(&2 * &M)` THEN + CONJ_TAC THENL + [REWRITE_TAC[REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_RMUL THEN + SIMP_TAC[SQRT_POS_LE; REAL_LE_MUL; REAL_POS] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_ADD_RDISTRIB; REAL_ADD_LDISTRIB] THEN REAL_ARITH_TAC]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `(C10 * lnorm (:real^1) (&2) (\z. (f:real->complex)(drop z)) * sqrt(&2 * &M) + + + lnorm (:real^1) (&2) (\z. (f:real->complex)(drop z) - h(drop z)) * (C10 * + sqrt(&2 * &M))) + + (inv(sqrt(&2 * pi)) * sqrt(&2 * n) * + lnorm (:real^1) (&2) (\z. (f:real->complex)(drop z) - h(drop z))) * (&2 * + &M)` THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + FIRST_X_ASSUM(fun th -> + if can (find_term (fun t -> t = `K - &1`)) (concl th) + then MP_TAC th else NO_TAC) THEN + EXPAND_TAC "K" THEN + MATCH_MP_TAC(REAL_ARITH + `c1 = t * cc /\ c2 = t * dd + ==> t * ((&1 + cc + dd) - &1) <= eps + ==> (a + c1) + c2 <= a + eps`) THEN + CONJ_TAC THEN REAL_ARITH_TAC);; + + +(* --- 286U(b) contradiction, arithmetic core (Fremlin 3013-3020): the chain *) +(* e*muF <= (e * sqrt e)*sqrt muF forces muF <= e. (Fremlin's eps muF <= *) +(* eps^{3/2} sqrt muF => muF <= eps, with eps^{3/2} = eps*sqrt eps.) Square *) +(* the *) +(* hypothesis (both sides >= 0), use (sqrt x)^2 = x, cancel e^2*muF > 0. --- *) +let LNORM_TRUNC_CONG = prove + (`!(f:real->complex) n. + (\z. f(drop z)) IN lspace (:real^1) (&2) + ==> lnorm (:real^1) (&2) + (\z. (\x. if abs x <= &n then Cx(&0) else f x) (drop z)) = + lnorm (:real^1) (&2) + (\z. f(drop z) - (if z IN ball(vec 0,&n) then f(drop z) else vec + 0))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN + SUBGOAL_THEN + `(\z:real^1. if abs(drop z) <= &n then Cx(&0) else (f:real->complex)(drop + z)) IN + lspace (:real^1) (&2) /\ + (\z:real^1. f(drop z) - (if z IN ball(vec 0,&n) then f(drop z) else vec 0)) + IN + lspace (:real^1) (&2)` + STRIP_ASSUME_TAC THENL + [CONJ_TAC THENL + [SUBGOAL_THEN + `(\z:real^1. if abs(drop z) <= &n then Cx(&0) else + (f:real->complex)(drop z)) = + (\z:real^1. f(drop z) - + (if z IN interval[lift(--(&n)),lift(&n)] then f(drop z) else vec + 0))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `w:real^1` THEN + REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; + REAL_ARITH `--(&n) <= drop w /\ drop w <= &n <=> abs(drop w) <= &n`] + THEN + COND_CASES_TAC THEN REWRITE_TAC[COMPLEX_SUB_RZERO; COMPLEX_VEC_0] THEN + CONV_TAC COMPLEX_RING; + MATCH_MP_TAC LSPACE_SUB THEN ASM_REWRITE_TAC[REAL_POS] THEN + MATCH_MP_TAC TRUNC_IN_LSPACE THEN + ASM_REWRITE_TAC[REAL_ARITH `&0 < &2`; LEBESGUE_MEASURABLE_INTERVAL]]; + MATCH_MP_TAC LSPACE_SUB THEN ASM_REWRITE_TAC[REAL_POS] THEN + MATCH_MP_TAC TRUNC_IN_LSPACE THEN + ASM_REWRITE_TAC[REAL_ARITH `&0 < &2`; LEBESGUE_MEASURABLE_BALL]]; + ALL_TAC] THEN + REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN + CONJ_TAC THEN MATCH_MP_TAC LNORM_MONO THEN + EXISTS_TAC `{lift(&n), lift(--(&n))}` THEN + ASM_REWRITE_TAC[NEGLIGIBLE_INSERT; NEGLIGIBLE_SING; REAL_POS] THEN + X_GEN_TAC `z:real^1` THEN + REWRITE_TAC[IN_DIFF; IN_UNIV; IN_INSERT; NOT_IN_EMPTY; DE_MORGAN_THM; + GSYM DROP_EQ; LIFT_DROP] THEN + STRIP_TAC THEN + REWRITE_TAC[BALL_1; IN_INTERVAL_1; VECTOR_SUB_LZERO; VECTOR_ADD_LID; + DROP_NEG; LIFT_DROP; DROP_VEC] THEN + COND_CASES_TAC THEN COND_CASES_TAC THEN + REWRITE_TAC[COMPLEX_SUB_RZERO; COMPLEX_VEC_0; COMPLEX_SUB_REFL; + REAL_LE_REFL] THEN + ASM_REAL_ARITH_TAC);; + +let CARLESON_TRUNC_LNORM_LIM = prove + (`!(f:real->complex). + (\z. f(drop z)) IN lspace (:real^1) (&2) + ==> ((\n. lnorm (:real^1) (&2) + (\z. (\x. if abs x <= &n then Cx(&0) else f x) (drop z))) ---> + &0) + sequentially`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`sequentially`; + `\n. lnorm (:real^1) (&2) + (\z. (f:real->complex)(drop z) - + (if z IN ball(vec 0,&n) then f(drop z) else vec 0))`; + `\n. lnorm (:real^1) (&2) + (\z. if abs(drop z) <= &n then Cx(&0) else (f:real->complex)(drop + z))`; + `&0:real`] REALLIM_TRANSFORM_EVENTUALLY) THEN + REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `0` THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN CONV_TAC SYM_CONV THEN + MP_TAC(ISPECL [`f:real->complex`; `n:num`] LNORM_TRUNC_CONG) THEN + ASM_REWRITE_TAC[]; + MP_TAC(ISPECL [`\z:real^1. (f:real->complex)(drop z)`; + `&2:real`] TRUNC_LNORM_LIM) THEN + ASM_REWRITE_TAC[REAL_ARITH `&0 < &2`]]);; + +(* --- The oscillation-connector A_n -> 0 supplier: A_n = C10 ||f_1n||_2 *) +(* where *) +(* f_1n = f off [-n,n] (the truncation), so ||f_1n||_2 -> 0 *) +(* (CARLESON_TRUNC_LNORM_ *) +(* LIM) and A_n -> 0 (REALLIM_LMUL). This is the (A ---> &0) hypothesis of *) +(* CARLESON_OSC_BADSET_NEG, with C10 the 286T constant. --- *) +let CARLESON_TRUNC_COEFF_LIM = prove + (`!(f:real->complex) C10. + (\z. f(drop z)) IN lspace (:real^1) (&2) + ==> ((\n. C10 * lnorm (:real^1) (&2) + (\z. (\x. if abs x <= &n then Cx(&0) else f x) (drop z))) ---> + &0) + sequentially`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `((\n. C10 * lnorm (:real^1) (&2) + (\z. (\x. if abs x <= &n then Cx(&0) else f x) (drop z))) ---> C10 * + &0) + sequentially` + MP_TAC THENL + [MATCH_MP_TAC REALLIM_LMUL THEN + MATCH_MP_TAC CARLESON_TRUNC_LNORM_LIM THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_MUL_RZERO]]);; + +(* --- 286U(a) connector (Fremlin mt286.tex 2966-2974): inf_n gamma_n(y)=0 *) +(* (stated as: gamma_m(y) gets arbitrarily small) gives the tail-Cauchy *) +(* hypothesis of CARLESON_286U_CAUCHY/_SYMLIM for the truncated integral *) +(* II a b = Cx(1/sqrt2pi) int_[a,b] e^{-ixy}f. For e>0, pick m with *) +(* gamma_m(y) *) +(* <= e; each window-difference (a<=-m, b>=m) is a member of gamma_m's *) +(* sup-set, *) +(* hence <= gamma_m(y) <= e (pull the real scalar out of norm, member-<=-sup *) +(* via *) +(* REAL_LE_SUP with the family's ?B bound). --- *) +let CARLESON_GAMMA_INF_CAUCHY = prove + (`!(f:real->complex) y. + (!n. ?B. !a b. a <= b ==> inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[a,b])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * f(drop x)) - + integral (IMAGE lift (real_interval[--(&n),&n])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * f(drop x))) <= B) + /\ + (!e. &0 < e ==> ?m. carleson_gamma f (&m) y <= e) + ==> (!e. &0 < e ==> ?N. &0 <= N /\ + !a b. a <= --N /\ N <= b ==> + norm((\a b. Cx(inv(sqrt(&2 * pi))) * + integral (IMAGE lift (real_interval[a,b])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * f(drop x))) a b - + (\a b. Cx(inv(sqrt(&2 * pi))) * + integral (IMAGE lift (real_interval[a,b])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * f(drop x))) (--N) + N) <= e)`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `m:num`) THEN + EXISTS_TAC `&m:real` THEN REWRITE_TAC[REAL_POS] THEN + MAP_EVERY X_GEN_TAC [`a:real`; `b:real`] THEN STRIP_TAC THEN BETA_TAC THEN + REWRITE_TAC[GSYM COMPLEX_SUB_LDISTRIB; COMPLEX_NORM_MUL; + COMPLEX_NORM_CX] THEN + SUBGOAL_THEN `abs(inv(sqrt(&2 * pi))) = inv(sqrt(&2 * pi))` SUBST1_TAC THENL + [REWRITE_TAC[REAL_ABS_REFL] THEN MATCH_MP_TAC REAL_LE_INV THEN + MATCH_MP_TAC SQRT_POS_LE THEN MP_TAC PI_POS THEN + REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `carleson_gamma f (&m) y` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[carleson_gamma] THEN + FIRST_X_ASSUM(X_CHOOSE_TAC `B:real` o SPEC `m:num`) THEN + MP_TAC(ISPECL + [`{ inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[a',b'])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * (f:real->complex)(drop + x)) - + integral (IMAGE lift (real_interval[--(&m),&m])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * f(drop x))) + | a',b' | a' <= --(&m) /\ &m <= b' }`; + `inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[a,b])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * (f:real->complex)(drop x)) + - + integral (IMAGE lift (real_interval[--(&m),&m])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * f(drop x)))`; + `B:real`; + `inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[a,b])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * (f:real->complex)(drop x)) + - + integral (IMAGE lift (real_interval[--(&m),&m])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * f(drop x)))`] + REAL_LE_SUP) THEN + REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN MATCH_MP_TAC THEN + REPEAT CONJ_TAC THENL + [MAP_EVERY EXISTS_TAC [`a:real`; `b:real`] THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_LE_REFL]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC]);; + +(* --- 286U(b) measurability of the "bad set" slice: for each e, the set *) +(* {y | !m. gamma_m(y) >= e} = INTERS_m {y | gamma_m(y) >= e} is *) +(* real-lebesgue- *) +(* measurable (countable intersection of measurable superlevels). This is *) +(* the *) +(* measurability prereq for the 286U(b) negligibility argument. Each member *) +(* {gamma_(&m) >= e} is measurable by CARLESON_GAMMA_MEASURABLE (which needs *) +(* the *) +(* window family bounded above at each y, supplied here for all m). --- *) +let REAL_NEGLIGIBLE_BOUNDED_EXHAUSTION = prove + (`!S:real->bool. + (!M:num. real_negligible (S INTER real_interval[--(&M),&M])) + ==> real_negligible S`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `S = UNIONS { S INTER real_interval[--(&M),&M] | M IN (:num) }` + SUBST1_TAC THENL + [MATCH_MP_TAC(SET_RULE + `(!x. x IN S ==> ?u. u IN f /\ x IN u) /\ (!u. u IN f ==> u SUBSET S) + ==> S = UNIONS f`) THEN + CONJ_TAC THENL + [X_GEN_TAC `x:real` THEN DISCH_TAC THEN + MP_TAC(SPEC `abs x` REAL_ARCH_SIMPLE) THEN + DISCH_THEN(X_CHOOSE_THEN `M:num` ASSUME_TAC) THEN + EXISTS_TAC `S INTER real_interval[--(&M),&M]` THEN CONJ_TAC THENL + [REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `M:num` THEN + REWRITE_TAC[IN_UNIV]; + ASM_REWRITE_TAC[IN_INTER; IN_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC]; + REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN + REWRITE_TAC[INTER_SUBSET]]; + ALL_TAC] THEN + REWRITE_TAC[SIMPLE_IMAGE] THEN + MP_TAC(ISPEC `\M:num. S INTER real_interval[--(&M),&M]` + REAL_NEGLIGIBLE_COUNTABLE_UNIONS) THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[GSYM SIMPLE_IMAGE] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[]);; + +(* --- 286D->286U(b) WIRING: the truncated maximal family gives *) +(* the window-boundedness hypothesis of CARLESON_286U_EXISTS_AE a.e. Five *) +(* bricks: *) +(* (1) TRUNC_WINDOW_MEM_LE: a compact window [a,b] SUBSET [-n,n] contributes *) +(* a *) +(* member <= the truncated sup Ahat_n f y. *) +(* (2) AHAT_TRUNC_INTEGRABLE: Ahat_m f is integrable on any [-M,M] *) +(* (measurable + *) +(* bounded by the loc-L^1 constant, TRUNC_FINITE). *) +(* (3) AHAT_TRUNC_BADSET_NEG: {y | sup_m Ahat_m f y = inf} is NEGLIGIBLE, *) +(* via *) +(* 286D (CARLESON_SUP_AE_FINITE) on each [-M,M] (threaded truncated integral *) +(* bounds) + bounded exhaustion. This is the 286D output. *) +(* (4) TRUNC_FAMILY_WINDOW_BOUND: where sup_m Ahat_m f y < inf, EVERY window *) +(* DIFFERENCE (a<=b) is bounded (any [a,b] sits in some [-M,M], so its norm *) +(* <= Ahat_M f y <= K; add the fixed [-n,n] term). *) +(* (5) OFF_BADSET_BOUNDED: off the bad set, sup_m Ahat_m f y is bounded by *) +(* some *) +(* integer k+1. *) +(* Together: (\z. f(drop z)) in L^2 + uniform truncated bounds => the *) +(* window-diff *) +(* family of CARLESON_286U_EXISTS_AE is bounded off a negligible set. --- *) + +(* (1) compact window [a,b] SUBSET [-n,n] gives a member <= the truncated *) +(* sup. *) +let CARLESON_TRUNC_WINDOW_MEM_LE = prove + (`!(f:real->complex) n y a b. + &0 <= n /\ --n <= a /\ a <= b /\ b <= n /\ + (\z. f(drop z)) IN lspace (:real^1) (&2) + ==> inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[a,b])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * f(drop x))) + <= carleson_Ahat_trunc f n y`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\z. (f:real->complex)(drop z)) absolutely_integrable_on + (IMAGE lift (real_interval[--n,n]))` + ASSUME_TAC THENL + [MATCH_MP_TAC CARLESON_LSPACE2_LOCAL_ABSINT THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[carleson_Ahat_trunc] THEN + MP_TAC(ISPECL + [`{ inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[a',b'])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * (f:real->complex)(drop + x))) + | a',b' | --n <= a' /\ a' <= b' /\ b' <= n }`; + `inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[a,b])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * (f:real->complex)(drop + x)))`; + `inv(sqrt(&2 * pi)) * + drop(integral (IMAGE lift (real_interval[--n,n])) (\x. + lift(norm((f:real->complex)(drop x)))))`; + `inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[a,b])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * (f:real->complex)(drop + x)))`] + REAL_LE_SUP) THEN + REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN MATCH_MP_TAC THEN + REPEAT CONJ_TAC THENL + [MAP_EVERY EXISTS_TAC [`a:real`; `b:real`] THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_LE_REFL]; + X_GEN_TAC `w:real` THEN + DISCH_THEN(X_CHOOSE_THEN `a2:real` (X_CHOOSE_THEN + `b2:real` STRIP_ASSUME_TAC)) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INV THEN MATCH_MP_TAC SQRT_POS_LE THEN + MP_TAC PI_POS THEN REAL_ARITH_TAC; + MATCH_MP_TAC CARLESON_TRUNC_WINDOW_LE_INT THEN ASM_REWRITE_TAC[]]]);; + +(* (2) Ahat_m f is integrable on any [-M,M] (measurable, nonneg, bounded *) +(* above by *) +(* the loc-L^1 constant from TRUNC_FINITE). *) +let CARLESON_AHAT_TRUNC_INTEGRABLE = prove + (`!(f:real->complex) m M. + (\z. f(drop z)) IN lspace (:real^1) (&2) + ==> (\y. carleson_Ahat_trunc f (&m) y) + real_integrable_on real_interval[--(&M),&M]`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN + EXISTS_TAC `\y:real. inv(sqrt(&2 * pi)) * + drop(integral (IMAGE lift (real_interval[--(&m),&m])) (\x. + lift(norm((f:real->complex)(drop x)))))` THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC REAL_MEASURABLE_ON_MEASURABLE_SUBSET THEN + EXISTS_TAC `(:real)` THEN + REWRITE_TAC[SUBSET_UNIV; REAL_MEASURABLE_REAL_INTERVAL] THEN + MATCH_MP_TAC CARLESON_AHAT_TRUNC_MEASURABLE THEN ASM_REWRITE_TAC[REAL_POS]; + REWRITE_TAC[REAL_INTEGRABLE_CONST]; + X_GEN_TAC `y:real` THEN DISCH_TAC THEN + SUBGOAL_THEN `&0 <= carleson_Ahat_trunc f (&m) y` ASSUME_TAC THENL + [MATCH_MP_TAC CARLESON_AHAT_TRUNC_POS THEN + ASM_REWRITE_TAC[REAL_POS]; ALL_TAC] THEN + SUBGOAL_THEN + `carleson_Ahat_trunc f (&m) y <= inv(sqrt(&2 * pi)) * + drop(integral (IMAGE lift (real_interval[--(&m),&m])) (\x. + lift(norm((f:real->complex)(drop x)))))` + ASSUME_TAC THENL + [MATCH_MP_TAC CARLESON_AHAT_TRUNC_FINITE THEN + ASM_REWRITE_TAC[REAL_POS] THEN + MATCH_MP_TAC CARLESON_LSPACE2_LOCAL_ABSINT THEN + ASM_REWRITE_TAC[REAL_POS]; + ASM_REAL_ARITH_TAC]]);; + +(* (3) {y | sup_m Ahat_m f y = inf} is NEGLIGIBLE (286D output), given the *) +(* uniform *) +(* truncated integral bounds on each [-M,M]. *) +let CARLESON_AHAT_TRUNC_BADSET_NEG = prove + (`!(f:real->complex). + (\z. f(drop z)) IN lspace (:real^1) (&2) /\ + (!M:num. ?D. &0 <= D /\ + !m:num. real_integral (real_interval[--(&M),&M]) + (\y. carleson_Ahat_trunc f (&m) y) <= D) + ==> real_negligible + {y | !k:num. ?m:num. &k + &1 < carleson_Ahat_trunc f (&m) y}`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_NEGLIGIBLE_BOUNDED_EXHAUSTION THEN + X_GEN_TAC `M:num` THEN + FIRST_X_ASSUM(MP_TAC o SPEC `M:num`) THEN + DISCH_THEN(X_CHOOSE_THEN `D:real` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL + [`\m:num. (\y. carleson_Ahat_trunc (f:real->complex) (&m) y)`; + `real_interval[--(&M),&M]`; `D:real`] CARLESON_SUP_AE_FINITE) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [REWRITE_TAC[REAL_MEASURABLE_REAL_INTERVAL]; + ASM_REWRITE_TAC[]; + X_GEN_TAC `m:num` THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CARLESON_AHAT_TRUNC_MEASURABLE THEN + ASM_REWRITE_TAC[REAL_POS]; + MATCH_MP_TAC CARLESON_AHAT_TRUNC_INTEGRABLE THEN ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC THEN MATCH_MP_TAC CARLESON_AHAT_TRUNC_POS THEN + ASM_REWRITE_TAC[REAL_POS]; + ASM_REWRITE_TAC[]]; + MAP_EVERY X_GEN_TAC [`m:num`; `y:real`] THEN DISCH_TAC THEN + MATCH_MP_TAC CARLESON_AHAT_TRUNC_MONO THEN + ASM_REWRITE_TAC[REAL_POS; REAL_OF_NUM_LE] THEN ARITH_TAC]; + ALL_TAC] THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM] THEN + X_GEN_TAC `y:real` THEN REWRITE_TAC[CONJ_SYM]);; + +(* (4) off the bad set (sup_m Ahat_m f y <= K), EVERY window DIFFERENCE is *) +(* bounded *) +(* -- any window [a,b] sits in some [-M,M] so its norm <= Ahat_M f y <= K. *) +let CARLESON_TRUNC_FAMILY_WINDOW_BOUND = prove + (`!(f:real->complex) y. + (\z. f(drop z)) IN lspace (:real^1) (&2) /\ + (?K. !m:num. carleson_Ahat_trunc f (&m) y <= K) + ==> !n. ?B. !a b. a <= b ==> inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[a,b])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * f(drop x)) - + integral (IMAGE lift (real_interval[--(&n),&n])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * f(drop x))) <= B`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_TAC `K:real`)) THEN + X_GEN_TAC `n:num` THEN + EXISTS_TAC `K + inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[--(&n),&n])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * (f:real->complex)(drop + x)))` THEN + MAP_EVERY X_GEN_TAC [`a:real`; `b:real`] THEN DISCH_TAC THEN + MP_TAC(SPEC `max (abs a) (abs b)` REAL_ARCH_SIMPLE) THEN + DISCH_THEN(X_CHOOSE_TAC `M:num`) THEN + SUBGOAL_THEN + `--(&M) <= a /\ a <= b /\ b <= &M /\ &0 <= &M` STRIP_ASSUME_TAC THENL + [REPEAT CONJ_TAC THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[a,b])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * (f:real->complex)(drop x))) + + + inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[--(&n),&n])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * (f:real->complex)(drop + x)))` THEN + CONJ_TAC THENL + [REWRITE_TAC[GSYM REAL_ADD_LDISTRIB] THEN MATCH_MP_TAC REAL_LE_LMUL THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INV THEN MATCH_MP_TAC SQRT_POS_LE THEN + MP_TAC PI_POS THEN REAL_ARITH_TAC; + CONV_TAC NORM_ARITH]; + MATCH_MP_TAC REAL_LE_ADD2 THEN REWRITE_TAC[REAL_LE_REFL] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `carleson_Ahat_trunc f (&M) y` THEN CONJ_TAC THENL + [MP_TAC(ISPECL [`f:real->complex`; `&M:real`; `y:real`; `a:real`; + `b:real`] + CARLESON_TRUNC_WINDOW_MEM_LE) THEN ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]]]);; + +(* (5) off the bad set, sup_m Ahat_m f y is bounded by some integer k+1. *) +let CARLESON_OFF_BADSET_BOUNDED = prove + (`!(f:real->complex) y. + ~(y IN {y | !k:num. ?m:num. &k + &1 < carleson_Ahat_trunc f (&m) y}) + ==> ?K. !m:num. carleson_Ahat_trunc f (&m) y <= K`, + REPEAT GEN_TAC THEN + REWRITE_TAC[IN_ELIM_THM; NOT_FORALL_THM; NOT_EXISTS_THM] THEN + REWRITE_TAC[REAL_NOT_LT] THEN + DISCH_THEN(X_CHOOSE_TAC `k:num`) THEN + EXISTS_TAC `&k + &1` THEN ASM_REWRITE_TAC[]);; + +(* --- H2-chain (toward the oscillation per-slice gamma bound): general-FF *) +(* versions of the 286T maximal machinery + the UNTRUNCATED bound int_FF *) +(* carleson_Ahat f <= C10 ||f||_2 sqrt muFF (any f in L^2, measurable FF, *) +(* from *) +(* the 286T(b) Schwartz gate). This is the direct input to *) +(* CARLESON_GAMMA_INT_ *) +(* BOUND for the oscillation slices (Fremlin 286U(b)). --- *) +let REAL_INTEGRAL_CONST_MEASURABLE = prove + (`!c FF. real_measurable FF ==> real_integral FF (\x. c) = c * real_measure + FF`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(\x:real. c) = (\x. c * &1)` SUBST1_TAC THENL + [REWRITE_TAC[REAL_MUL_RID]; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_INTEGRAL_LMUL; GSYM REAL_MEASURABLE; + REAL_INTEGRAL_REAL_MEASURE]);; + +let CARLESON_TRUNC_DENSITY_STEP_FF = prove + (`!(f:real->complex) h FF n. + &0 <= n /\ real_measurable FF /\ + (\z. f(drop z)) IN lspace (:real^1) (&2) /\ schwartz h + ==> real_integral FF (\y. carleson_Ahat_trunc f n y) + <= real_integral FF (\y. carleson_Ahat_trunc h n y) + + (inv(sqrt(&2 * pi)) * sqrt(&2 * n) * + lnorm (:real^1) (&2) (\z. f(drop z) - h(drop z))) * (real_measure + FF)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\z. (h:real->complex)(drop z)) IN lspace (:real^1) (&2)` ASSUME_TAC THENL + [MATCH_MP_TAC SCHWARTZ_L2 THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL + [`\y. carleson_Ahat_trunc (f:real->complex) n y`; + `\y. carleson_Ahat_trunc (h:real->complex) n y + + inv(sqrt(&2 * pi)) * sqrt(&2 * n) * + lnorm (:real^1) (&2) (\z. (f:real->complex)(drop z) - h(drop z))`; + `FF:real->bool`] REAL_INTEGRAL_LE) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CARLESON_AHAT_TRUNC_INTEGRABLE_GEN THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_INTEGRABLE_ADD THEN CONJ_TAC THENL + [MATCH_MP_TAC CARLESON_AHAT_TRUNC_INTEGRABLE_GEN THEN ASM_REWRITE_TAC[]; + ONCE_REWRITE_TAC[GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_INTEGRABLE_LMUL THEN + ASM_REWRITE_TAC[GSYM REAL_MEASURABLE]]; + X_GEN_TAC `y:real` THEN DISCH_TAC THEN BETA_TAC THEN + MATCH_MP_TAC CARLESON_AHAT_TRUNC_SUB_BOUND THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `b = c ==> a <= b ==> a <= c`) THEN + W(MP_TAC o PART_MATCH (lhs o rand) REAL_INTEGRAL_ADD o lhs o snd) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC CARLESON_AHAT_TRUNC_INTEGRABLE_GEN THEN ASM_REWRITE_TAC[]; + ONCE_REWRITE_TAC[GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_INTEGRABLE_LMUL THEN + ASM_REWRITE_TAC[GSYM REAL_MEASURABLE]]; + DISCH_THEN SUBST1_TAC] THEN + AP_TERM_TAC THEN + ASM_SIMP_TAC[REAL_INTEGRAL_CONST_MEASURABLE]);; + +let CARLESON_286T_TRUNC_GENERAL_FF = prove + (`!(f:real->complex) FF n C10. + &0 <= C10 /\ &0 <= n /\ real_measurable FF /\ + (\z. f(drop z)) IN lspace (:real^1) (&2) /\ + (!(h:real->complex) GG. + schwartz h /\ real_measurable GG + ==> real_integral GG (carleson_Ahat h) + <= C10 * lnorm (:real^1) (&2) (\z. h(drop z)) * sqrt(real_measure + GG)) + ==> real_integral FF (\y. carleson_Ahat_trunc f n y) + <= C10 * lnorm (:real^1) (&2) (\z. f(drop z)) * sqrt(real_measure + FF)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_EPSILON THEN + X_GEN_TAC `eps:real` THEN DISCH_TAC THEN + ABBREV_TAC `K = &1 + C10 * sqrt(real_measure FF) + + inv(sqrt(&2 * pi)) * sqrt(&2 * n) * (real_measure FF)` THEN + SUBGOAL_THEN `&0 <= real_measure FF` ASSUME_TAC THENL + [ASM_SIMP_TAC[REAL_MEASURE_POS_LE]; ALL_TAC] THEN + SUBGOAL_THEN `&0 <= C10 * sqrt(real_measure FF)` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC[SQRT_POS_LE]; ALL_TAC] THEN + SUBGOAL_THEN + `&0 <= inv(sqrt(&2 * pi)) * sqrt(&2 * n) * (real_measure FF)` + ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN + SIMP_TAC[REAL_LE_INV_EQ; SQRT_POS_LE; REAL_LE_MUL; REAL_POS; + PI_POS_LE] THEN + MATCH_MP_TAC REAL_LE_MUL THEN + ASM_SIMP_TAC[SQRT_POS_LE; REAL_LE_MUL; REAL_POS]; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < K` ASSUME_TAC THENL [EXPAND_TAC "K" THEN + ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `&0 < eps / K` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LT_DIV THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MP_TAC(ISPEC `\z. (f:real->complex)(drop z)` LSPACE_APPROXIMATE_SCHWARTZ) + THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(fun dth -> MP_TAC(MATCH_MP dth (ASSUME `&0 < eps / K`))) THEN + DISCH_THEN(X_CHOOSE_THEN `h:real->complex` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `(\z. (h:real->complex)(drop z)) IN lspace (:real^1) (&2)` ASSUME_TAC THENL + [MATCH_MP_TAC SCHWARTZ_L2 THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL [`f:real->complex`; `h:real->complex`; `FF:real->bool`; + `n:real`] + CARLESON_TRUNC_DENSITY_STEP_FF) THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`h:real->complex`; `FF:real->bool`; `n:real`; `C10:real`] + CARLESON_286T_TRUNC_SCHWARTZ) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(fun th -> MP_TAC(SPECL [`h:real->complex`; + `FF:real->bool`] th)) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN DISCH_TAC THEN + MP_TAC(ISPECL [`f:real->complex`; + `h:real->complex`] LNORM_TRIANGLE_SUB_H) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`K:real`; + `lnorm (:real^1) (&2) (\z. (f:real->complex)(drop z) - h(drop z))`; + `eps:real`] TRUNC_EPS_ARITH) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC LNORM_POS_LE THEN REWRITE_TAC[REAL_ARITH `&1 <= &2`] THEN + MATCH_MP_TAC LSPACE_SUB THEN ASM_REWRITE_TAC[REAL_POS]; + EXPAND_TAC "K" THEN ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + DISCH_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `C10 * lnorm (:real^1) (&2) (\z. (h:real->complex)(drop z)) * + sqrt(real_measure FF) + + (inv(sqrt(&2 * pi)) * sqrt(&2 * n) * + lnorm (:real^1) (&2) (\z. (f:real->complex)(drop z) - h(drop z))) * + (real_measure FF)` THEN + CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `C10 * lnorm (:real^1) (&2) (\z. (h:real->complex)(drop z)) * + sqrt(real_measure FF) + <= C10 * lnorm (:real^1) (&2) (\z. (f:real->complex)(drop z)) * + sqrt(real_measure FF) + + lnorm (:real^1) (&2) (\z. (f:real->complex)(drop z) - h(drop z)) * (C10 + * sqrt(real_measure FF))` + ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `C10 * (lnorm (:real^1) (&2) (\z. (f:real->complex)(drop z)) + + lnorm (:real^1) (&2) (\z. (f:real->complex)(drop z) - h(drop z))) + * + sqrt(real_measure FF)` THEN + CONJ_TAC THENL + [REWRITE_TAC[REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_RMUL THEN + ASM_SIMP_TAC[SQRT_POS_LE] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_ADD_RDISTRIB; REAL_ADD_LDISTRIB] THEN REAL_ARITH_TAC]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `(C10 * lnorm (:real^1) (&2) (\z. (f:real->complex)(drop z)) * + sqrt(real_measure FF) + + lnorm (:real^1) (&2) (\z. (f:real->complex)(drop z) - h(drop z)) * (C10 * + sqrt(real_measure FF))) + + (inv(sqrt(&2 * pi)) * sqrt(&2 * n) * + lnorm (:real^1) (&2) (\z. (f:real->complex)(drop z) - h(drop z))) * + (real_measure FF)` THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + FIRST_X_ASSUM(fun th -> + if can (find_term (fun t -> t = `K - &1`)) (concl th) + then MP_TAC th else NO_TAC) THEN + EXPAND_TAC "K" THEN + MATCH_MP_TAC(REAL_ARITH + `c1 = t * cc /\ c2 = t * dd + ==> t * ((&1 + cc + dd) - &1) <= eps + ==> (a + c1) + c2 <= a + eps`) THEN + CONJ_TAC THEN REAL_ARITH_TAC);; + +let CARLESON_TRUNC_FAMILY_PLAIN_WINDOW_BOUND = prove + (`!(f:real->complex) y. + (\z. f(drop z)) IN lspace (:real^1) (&2) /\ + (?K. !m:num. carleson_Ahat_trunc f (&m) y <= K) + ==> ?B. !a b. a <= b ==> inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[a,b])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * f(drop x))) <= B`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_TAC `K:real`)) THEN + EXISTS_TAC `K:real` THEN + MAP_EVERY X_GEN_TAC [`a:real`; `b:real`] THEN DISCH_TAC THEN + MP_TAC(SPEC `max (abs a) (abs b)` REAL_ARCH_SIMPLE) THEN + DISCH_THEN(X_CHOOSE_TAC `M:num`) THEN + SUBGOAL_THEN + `--(&M) <= a /\ a <= b /\ b <= &M /\ &0 <= &M` STRIP_ASSUME_TAC THENL + [REPEAT CONJ_TAC THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `carleson_Ahat_trunc f (&M) y` THEN CONJ_TAC THENL + [MP_TAC(ISPECL [`f:real->complex`; `&M:real`; `y:real`; `a:real`; `b:real`] + CARLESON_TRUNC_WINDOW_MEM_LE) THEN ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]]);; + +let CARLESON_286T_UNTRUNC = prove + (`!(f:real->complex) FF C10. + &0 <= C10 /\ real_measurable FF /\ (\z. f(drop z)) IN lspace (:real^1) + (&2) /\ + (!(h:real->complex) GG. + schwartz h /\ real_measurable GG + ==> real_integral GG (carleson_Ahat h) + <= C10 * lnorm (:real^1) (&2) (\z. h(drop z)) * sqrt(real_measure + GG)) + ==> carleson_Ahat f real_integrable_on FF /\ + real_integral FF (carleson_Ahat f) + <= C10 * lnorm (:real^1) (&2) (\z. f(drop z)) * sqrt(real_measure + FF)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC CARLESON_286T_FROM_TRUNC THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [EXISTS_TAC + `{y | !k:num. ?m:num. &k + &1 < carleson_Ahat_trunc (f:real->complex) (&m) + y}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC CARLESON_AHAT_TRUNC_BADSET_NEG THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[]; ALL_TAC] THEN + X_GEN_TAC `M:num` THEN + EXISTS_TAC `C10 * lnorm (:real^1) (&2) (\z. (f:real->complex)(drop z)) * + sqrt(&2 * &M)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC LNORM_POS_LE THEN + ASM_REWRITE_TAC[REAL_ARITH `&1 <= &2`]; + MATCH_MP_TAC SQRT_POS_LE THEN MATCH_MP_TAC REAL_LE_MUL THEN + REWRITE_TAC[REAL_POS]]; + X_GEN_TAC `m:num` THEN + SUBGOAL_THEN + `real_measure(real_interval[--(&M),&M]) = &2 * &M` ASSUME_TAC THENL + [REWRITE_TAC[REAL_MEASURE_REAL_INTERVAL] THEN + REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPECL [`f:real->complex`; `real_interval[--(&M),&M]`; + `&m:real`; `C10:real`] + CARLESON_286T_TRUNC_GENERAL_FF) THEN + ASM_REWRITE_TAC[REAL_MEASURABLE_REAL_INTERVAL; REAL_POS]]; + X_GEN_TAC `y:real` THEN DISCH_TAC THEN + MATCH_MP_TAC CARLESON_TRUNC_FAMILY_PLAIN_WINDOW_BOUND THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC CARLESON_OFF_BADSET_BOUNDED THEN ASM_REWRITE_TAC[]]; + X_GEN_TAC `m:num` THEN CONJ_TAC THENL + [MATCH_MP_TAC CARLESON_AHAT_TRUNC_INTEGRABLE_GEN THEN + ASM_REWRITE_TAC[REAL_POS]; + MATCH_MP_TAC CARLESON_286T_TRUNC_GENERAL_FF THEN + ASM_REWRITE_TAC[REAL_POS]]]);; + +(* --- H2 outer-measure toolkit (Fremlin 286U(b) faithful, avoiding HOL's *) +(* real-sup *) +(* junk on the null set where the window family is unbounded): the *) +(* oscillation bad *) +(* set is negligible via OUTER MEASURE (a slice sits inside a small-measure *) +(* super- *) +(* level set of Ahat f_1n plus a null set), so NO per-slice *) +(* gamma-measurability is *) +(* needed. --- *) + +(* Superlevel set {y in FF | e < g y} is measurable (g integrable => *) +(* measurable on FF; g.chi_FF measurable on univ; MK_LEVEL_ID + *) +(* MK_LEBMEAS_SUBSET). *) +let CARLESON_SUPERLEVEL_MEASURABLE = prove + (`!(g:real->real) FF e. + real_measurable FF /\ g real_integrable_on FF /\ &0 < e + ==> real_measurable (FF INTER {y | e < g y})`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(g:real->real) real_measurable_on FF` ASSUME_TAC THENL + [MATCH_MP_TAC INTEGRABLE_IMP_REAL_MEASURABLE THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL [`FF INTER {y | e < (g:real->real) y}`; + `FF:real->bool`] MK_LEBMEAS_SUBSET) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[INTER_SUBSET] THEN + ASM_SIMP_TAC[MK_LEVEL_ID] THEN + MP_TAC(ISPEC `\x. if x IN FF then (g:real->real) x else &0` + REAL_MEASURABLE_ON_PREIMAGE_HALFSPACE_GT) THEN + REWRITE_TAC[REAL_MEASURABLE_ON_UNIV] THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN + REWRITE_TAC[]; + REWRITE_TAC[]]);; + +(* Markov/Chebyshev on the superlevel set: e*mu(FF INTER {ereal) FF e. + real_measurable FF /\ g real_integrable_on FF /\ &0 < e /\ + (!y. y IN FF ==> &0 <= g y) + ==> e * real_measure (FF INTER {y | e < g y}) <= real_integral FF g`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `real_measurable (FF INTER {y | e < (g:real->real) y})` ASSUME_TAC THENL + [MATCH_MP_TAC CARLESON_SUPERLEVEL_MEASURABLE THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `(g:real->real) + real_integrable_on (FF INTER {y | e < g y})` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_ON_NONNEG_MEASURABLE_SUBSET THEN + EXISTS_TAC `FF:real->bool` THEN ASM_REWRITE_TAC[INTER_SUBSET] THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_MEASURABLE_IMP_REAL_LEBESGUE_MEASURABLE THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC INTEGRABLE_IMP_REAL_MEASURABLE THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `real_integral (FF INTER {y | e < (g:real->real) y}) g` THEN + CONJ_TAC THENL + [MATCH_MP_TAC CHEBYSHEV_MEASURE THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN + ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_INTEGRAL_SUBSET_LE THEN ASM_REWRITE_TAC[INTER_SUBSET]]);; + +(* a.e.-nonneg variant: nonneg only OFF a null s0 (Ahat f_1n>=0 only where *) +(* the window family is bounded, i.e. off the null set); via SPIKE_SET on FF *) +(* DIFF s0. *) +let CARLESON_SUPERLEVEL_MEASURE_BOUND_AE = prove + (`!(g:real->real) FF s0 e. + real_measurable FF /\ g real_integrable_on FF /\ &0 < e /\ + real_negligible s0 /\ + (!y. y IN FF /\ ~(y IN s0) ==> &0 <= g y) + ==> real_measurable (FF INTER {y | e < g y}) /\ + e * real_measure (FF INTER {y | e < g y}) <= real_integral FF g`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN + `real_measurable (FF INTER {y | e < (g:real->real) y})` ASSUME_TAC THENL + [MATCH_MP_TAC CARLESON_SUPERLEVEL_MEASURABLE THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + ABBREV_TAC `FF' = FF DIFF (s0:real->bool)` THEN + SUBGOAL_THEN `real_measurable (FF':real->bool)` ASSUME_TAC THENL + [EXPAND_TAC "FF'" THEN MATCH_MP_TAC REAL_MEASURABLE_DIFF THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_MEASURABLE_MEASURABLE] THEN + MATCH_MP_TAC NEGLIGIBLE_IMP_MEASURABLE THEN + ASM_REWRITE_TAC[GSYM real_negligible]; + ALL_TAC] THEN + SUBGOAL_THEN `(g:real->real) real_integrable_on FF'` ASSUME_TAC THENL + [MP_TAC(ISPECL [`g:real->real`; `FF:real->bool`; + `FF':real->bool`] REAL_INTEGRABLE_SPIKE_SET) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + MATCH_MP_TAC REAL_NEGLIGIBLE_SUBSET THEN + EXISTS_TAC `s0:real->bool` THEN ASM_REWRITE_TAC[] THEN + EXPAND_TAC "FF'" THEN SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `real_integral FF (g:real->real) = real_integral FF' g` SUBST1_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_SPIKE_SET THEN + MATCH_MP_TAC REAL_NEGLIGIBLE_SUBSET THEN EXISTS_TAC `s0:real->bool` THEN + ASM_REWRITE_TAC[] THEN EXPAND_TAC "FF'" THEN SET_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `real_measure (FF INTER {y | e < (g:real->real) y}) = + real_measure (FF' INTER {y | e < g y})` + SUBST1_TAC THENL + [MATCH_MP_TAC REAL_MEASURE_REAL_NEGLIGIBLE_SYMDIFF THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_NEGLIGIBLE_SUBSET THEN + EXISTS_TAC `s0:real->bool` THEN ASM_REWRITE_TAC[] THEN + EXPAND_TAC "FF'" THEN + REWRITE_TAC[SUBSET; IN_UNION; IN_DIFF; IN_INTER; IN_ELIM_THM] THEN + MESON_TAC[]; + ALL_TAC] THEN + MP_TAC(ISPECL [`g:real->real`; `FF':real->bool`; + `e:real`] CARLESON_SUPERLEVEL_MEASURE_BOUND) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + X_GEN_TAC `y:real` THEN EXPAND_TAC "FF'" THEN REWRITE_TAC[IN_DIFF] THEN + STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]);; + +(* Outer-measure negligibility: FF SUBSET (L n UNION Z n) for all n, mu(L *) +(* n)<=B n, *) +(* Z n negligible, B n -> 0 ==> FF negligible (REAL_NEGLIGIBLE_OUTER_LE). *) +let CARLESON_SLICE_NEGLIGIBLE_OUTER = prove + (`!FF (L:num->real->bool) (Z:num->real->bool) B. + (!n. FF SUBSET (L n UNION Z n)) /\ + (!n. real_measurable (L n) /\ real_measure (L n) <= B n /\ real_negligible + (Z n)) /\ + (B ---> &0) sequentially + ==> real_negligible FF`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[REAL_NEGLIGIBLE_OUTER_LE] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + SUBGOAL_THEN `?N:num. (B:num->real) N <= e` STRIP_ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REALLIM_SEQUENTIALLY]) THEN + DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` (MP_TAC o SPEC `N:num`)) THEN + REWRITE_TAC[LE_REFL] THEN DISCH_TAC THEN EXISTS_TAC `N:num` THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `real_measurable ((L:num->real->bool) N) /\ real_measure (L N) <= B N /\ + real_negligible ((Z:num->real->bool) N)` + STRIP_ASSUME_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `real_measurable ((Z:num->real->bool) N)` ASSUME_TAC THENL + [REWRITE_TAC[REAL_MEASURABLE_MEASURABLE] THEN + MATCH_MP_TAC NEGLIGIBLE_IMP_MEASURABLE THEN + ASM_REWRITE_TAC[GSYM real_negligible]; ALL_TAC] THEN + EXISTS_TAC `(L:num->real->bool) N UNION Z N` THEN + REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_MEASURABLE_UNION THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `real_measure((L:num->real->bool) N) + real_measure(Z N)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_MEASURE_UNION_LE THEN ASM_REWRITE_TAC[]; + SUBGOAL_THEN `real_measure((Z:num->real->bool) N) = &0` SUBST1_TAC THENL + [MATCH_MP_TAC REAL_MEASURE_EQ_0 THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_ADD_RID] THEN ASM_REAL_ARITH_TAC]]);; + +(* --- Per-slice outer negligibility (Fremlin 286U(b) contradiction, *) +(* faithful): the *) +(* oscillation slice S_k INTER [-M,M] sits inside the superlevel *) +(* {inv(2(k+1)) 0) union the null domination-failure set s0, so it is *) +(* null by *) +(* CARLESON_SLICE_NEGLIGIBLE_OUTER -- NO gamma-measurability needed. --- *) + +(* SUBSET: off s0, inv(k+1) <= gamma_n <= Ahat f_1n, so inv(2(k+1)) < Ahat *) +(* f_1n. *) +let CARLESON_SLICE_SUBSET_SUPERLEVEL = prove + (`!(f:real->complex) k M s0 (n:num). + (!y. y IN real_interval[--(&M),&M] /\ ~(y IN s0) + ==> carleson_gamma f (&n) y + <= carleson_Ahat (\t. if abs t <= &n then Cx(&0) else f t) y) + ==> ({y | !m:num. inv(&k + &1) <= carleson_gamma f (&m) y} + INTER real_interval[--(&M),&M]) + SUBSET + ((real_interval[--(&M),&M] INTER + {y | inv(&(2 * (k+1))) < carleson_Ahat (\t. if abs t <= &n then + Cx(&0) else f t) y}) + UNION s0)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[SUBSET; IN_INTER; IN_UNION; IN_ELIM_THM] THEN + X_GEN_TAC `y:real` THEN STRIP_TAC THEN + ASM_CASES_TAC `(y:real) IN s0` THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + DISJ1_TAC THEN ASM_REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN + EXISTS_TAC `carleson_gamma f (&n) y` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `inv(&k + &1)` THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LT_INV2 THEN + REWRITE_TAC[GSYM REAL_OF_NUM_MUL; GSYM REAL_OF_NUM_ADD] THEN + REAL_ARITH_TAC; + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]);; + +(* superlevel measure bound: mu([-M,M] INTER {inv(2(k+1))complex) k M s0 A (n:num). + real_negligible s0 /\ + carleson_Ahat (\t. if abs t <= &n then Cx(&0) else f t) real_integrable_on + real_interval[--(&M),&M] /\ + real_integral (real_interval[--(&M),&M]) + (carleson_Ahat (\t. if abs t <= &n then Cx(&0) else f t)) <= A n /\ + (!y. y IN real_interval[--(&M),&M] /\ ~(y IN s0) + ==> &0 <= carleson_Ahat (\t. if abs t <= &n then Cx(&0) else f t) y) + ==> real_measurable (real_interval[--(&M),&M] INTER + {y | inv(&(2 * (k+1))) < carleson_Ahat (\t. if abs t <= &n then + Cx(&0) else f t) y}) /\ + real_measure (real_interval[--(&M),&M] INTER + {y | inv(&(2 * (k+1))) < carleson_Ahat (\t. if abs t <= &n then + Cx(&0) else f t) y}) + <= A n * &(2 * (k+1))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + ABBREV_TAC `c = inv(&(2 * (k+1)))` THEN + SUBGOAL_THEN `&0 < c` ASSUME_TAC THENL + [EXPAND_TAC "c" THEN MATCH_MP_TAC REAL_LT_INV THEN + REWRITE_TAC[REAL_OF_NUM_LT] THEN ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPECL [`carleson_Ahat (\t. if abs t <= &n then Cx(&0) else + (f:real->complex) t)`; + `real_interval[--(&M),&M]`; `s0:real->bool`; `c:real`] + CARLESON_SUPERLEVEL_MEASURE_BOUND_AE) THEN + ASM_REWRITE_TAC[REAL_MEASURABLE_REAL_INTERVAL] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `&(2 * (k + 1)) = inv c` SUBST1_TAC THENL + [EXPAND_TAC "c" THEN REWRITE_TAC[REAL_INV_INV]; ALL_TAC] THEN + REWRITE_TAC[GSYM real_div] THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ] THEN + GEN_REWRITE_TAC (LAND_CONV) [REAL_MUL_SYM] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `real_integral (real_interval[--(&M),&M]) + (carleson_Ahat (\t. if abs t <= &n then Cx(&0) else (f:real->complex) t))` + THEN + ASM_REWRITE_TAC[]);; + +let CARLESON_OSC_SLICE_NEG_AE = prove + (`!(f:real->complex) k M s0 A. + real_negligible s0 /\ (A ---> &0) sequentially /\ + (!n. carleson_Ahat (\t. if abs t <= &n then Cx(&0) else f t) + real_integrable_on + real_interval[--(&M),&M] /\ + real_integral (real_interval[--(&M),&M]) + (carleson_Ahat (\t. if abs t <= &n then Cx(&0) else f t)) <= A n /\ + (!y. y IN real_interval[--(&M),&M] /\ ~(y IN s0) + ==> &0 <= carleson_Ahat (\t. if abs t <= &n then Cx(&0) else f + t) y) /\ + (!y. y IN real_interval[--(&M),&M] /\ ~(y IN s0) + ==> carleson_gamma f (&n) y + <= carleson_Ahat (\t. if abs t <= &n then Cx(&0) else f t) + y)) + ==> real_negligible ({y | !m:num. inv(&k + &1) <= carleson_gamma f (&m) y} + INTER real_interval[--(&M),&M])`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC CARLESON_SLICE_NEGLIGIBLE_OUTER THEN + MAP_EVERY EXISTS_TAC + [`\n:num. real_interval[--(&M),&M] INTER + {y | inv(&(2 * (k+1))) < carleson_Ahat (\t. if abs t <= &n then Cx(&0) + else f t) y}`; + `\n:num. s0:real->bool`; + `\n:num. (A n) * &(2 * (k+1))`] THEN + REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [X_GEN_TAC `n:num` THEN + MATCH_MP_TAC CARLESON_SLICE_SUBSET_SUPERLEVEL THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN STRIP_TAC THEN ASM_REWRITE_TAC[]; + X_GEN_TAC `n:num` THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN STRIP_TAC THEN + CONJ_TAC THENL + [MP_TAC(ISPECL [`f:real->complex`; `k:num`; `M:num`; `s0:real->bool`; + `A:num->real`; `n:num`] + CARLESON_SLICE_SUPERLEVEL_MEASURE_AE) THEN ASM_REWRITE_TAC[] THEN + SIMP_TAC[]; + CONJ_TAC THENL + [MP_TAC(ISPECL [`f:real->complex`; `k:num`; `M:num`; `s0:real->bool`; + `A:num->real`; `n:num`] + CARLESON_SLICE_SUPERLEVEL_MEASURE_AE) THEN ASM_REWRITE_TAC[] THEN + SIMP_TAC[]; + ASM_REWRITE_TAC[]]]; + SUBGOAL_THEN + `((\n. (A:num->real) n * &(2 * (k + 1))) ---> &0 * &(2 * (k + 1))) + sequentially` + MP_TAC THENL + [MATCH_MP_TAC REALLIM_RMUL THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_MUL_LZERO]]]);; + +(* --- 286U(b) hyp3 (oscillation) FULL ASSEMBLY: set where inf_n gamma_n > 0 *) +(* is *) +(* negligible, given f in L^2 + the 286T(b) Schwartz gate. s0 = UNIONS_n *) +(* badset(f_1n) [countable union of AHAT_TRUNC_BADSET_NEG negligibles]; off *) +(* s0 *) +(* every f_1n window family is bounded so AHAT_POS/GAMMA_LE_AHAT_L2 apply. *) +(* Chains *) +(* OSC_BADSET_UNIONS + COUNTABLE_UNIONS + BOUNDED_EXHAUSTION + *) +(* OSC_SLICE_NEG_AE. --- *) +let CARLESON_TRUNC_BADSET_NEG_N = prove + (`!(f:real->complex) n C10. + &0 <= C10 /\ (\z. f(drop z)) IN lspace (:real^1) (&2) /\ + (!(h:real->complex) GG. + schwartz h /\ real_measurable GG + ==> real_integral GG (carleson_Ahat h) + <= C10 * lnorm (:real^1) (&2) (\z. h(drop z)) * sqrt(real_measure + GG)) + ==> real_negligible + {y | !k:num. ?m:num. &k + &1 < + carleson_Ahat_trunc (\t. if abs t <= &n then Cx(&0) else f t) + (&m) y}`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC CARLESON_AHAT_TRUNC_BADSET_NEG THEN + CONJ_TAC THENL + [BETA_TAC THEN MATCH_MP_TAC CARLESON_TRUNC_LSPACE2 THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + X_GEN_TAC `M:num` THEN + EXISTS_TAC `C10 * lnorm (:real^1) (&2) + (\z. (\t. if abs t <= &n then Cx(&0) else (f:real->complex) t) (drop z)) + * sqrt(&2 * &M)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC LNORM_POS_LE THEN REWRITE_TAC[REAL_ARITH `&1 <= &2`] THEN + MATCH_MP_TAC CARLESON_TRUNC_LSPACE2 THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC SQRT_POS_LE THEN MATCH_MP_TAC REAL_LE_MUL THEN + REWRITE_TAC[REAL_POS]]; + X_GEN_TAC `m:num` THEN + SUBGOAL_THEN + `real_measure(real_interval[--(&M),&M]) = &2 * &M` ASSUME_TAC THENL + [REWRITE_TAC[REAL_MEASURE_REAL_INTERVAL] THEN + REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPECL [`\t. if abs t <= &n then Cx(&0) else (f:real->complex) t`; + `real_interval[--(&M),&M]`; `&m:real`; `C10:real`] + CARLESON_286T_TRUNC_GENERAL_FF) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[REAL_MEASURABLE_REAL_INTERVAL; REAL_POS] THEN + BETA_TAC THEN MATCH_MP_TAC CARLESON_TRUNC_LSPACE2 THEN ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]]]);; + +let CARLESON_S0_UNION_NEG = prove + (`!(f:real->complex) C10. + &0 <= C10 /\ (\z. f(drop z)) IN lspace (:real^1) (&2) /\ + (!(h:real->complex) GG. + schwartz h /\ real_measurable GG + ==> real_integral GG (carleson_Ahat h) + <= C10 * lnorm (:real^1) (&2) (\z. h(drop z)) * sqrt(real_measure + GG)) + ==> real_negligible + (UNIONS { {y | !k:num. ?m:num. &k + &1 < + carleson_Ahat_trunc (\t. if abs t <= &n then Cx(&0) else f + t) (&m) y} + | n IN (:num) })`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_NEGLIGIBLE_COUNTABLE_UNIONS THEN + X_GEN_TAC `n:num` THEN + MATCH_MP_TAC CARLESON_TRUNC_BADSET_NEG_N THEN + EXISTS_TAC `C10:real` THEN ASM_REWRITE_TAC[]);; + + +(* --- 286U(b) OSCILLATION bad set negligible (Fremlin mt286.tex 2999-3020, *) +(* the *) +(* TRUE 286U(b) contradiction, distinct from the 286D maximal-finiteness *) +(* above). *) +(* The bad set {y | ~(inf_m gamma_m(y)=0)} where the tail-oscillation fails *) +(* to *) +(* vanish decomposes (CARLESON_OSC_BADSET_UNIONS) into the countable union *) +(* over k *) +(* of slices S_k = {y | !m. 1/(k+1) <= gamma_m(y)}. Each S_k is negligible: *) +(* on *) +(* S_k INTER [-M,M] (finite measure, via bounded exhaustion) apply *) +(* PERSLICE_NEG *) +(* with e = 1/(k+1) (<= gamma_m everywhere on the slice) and A_n -> 0 -- *) +(* Fremlin's *) +(* e muF <= int_F gamma_n <= A_n sqrt muF (A_n = C ||f_n||_2 -> 0 by the *) +(* truncated *) +(* 286T bound + TRUNC_LNORM_LIM) forces muF = 0. The per-slice integral *) +(* bound *) +(* (int_{S_k cap [-M,M]} gamma_n <= A_n sqrt mu) is threaded as a hypothesis *) +(* (supplied at instantiation by GAMMA_INT_BOUND + the deep 286T + *) +(* TRUNC_LNORM_LIM). *) +(* This discharges the second negligible-set hypothesis of *) +(* CARLESON_286U_EXISTS_AE. *) +(* --- *) + +(* The y-dependent bad-set decomposition (companion of *) +(* CARLESON_BADSET_UNIONS with *) +(* the family G y m depending on the set-builder variable y). Pure *) +(* set-theory + *) +(* Archimedean (REAL_ARCH_INV). *) +let CARLESON_OSC_BADSET_UNIONS = prove + (`!(G:real->num->real). + {y:real | ~(!e. &0 < e ==> ?m:num. G y m <= e)} + = UNIONS { {y:real | !m:num. inv(&k + &1) <= G y m} | k IN (:num) }`, + GEN_TAC THEN REWRITE_TAC[EXTENSION] THEN X_GEN_TAC `y:real` THEN + REWRITE_TAC[IN_UNIONS; IN_ELIM_THM] THEN EQ_TAC THENL + [REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; DE_MORGAN_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `e:real` STRIP_ASSUME_TAC) THEN + MP_TAC(SPEC `e:real` REAL_ARCH_INV) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `{v:real | !m:num. inv(&(n - 1) + &1) <= G v m}` THEN + CONJ_TAC THENL + [EXISTS_TAC `n - 1` THEN REWRITE_TAC[IN_UNIV]; + REWRITE_TAC[IN_ELIM_THM] THEN + SUBGOAL_THEN `&(n - 1) + &1 = &n` SUBST1_TAC THENL + [MP_TAC(ASSUME `~(n = 0)`) THEN SPEC_TAC(`n:num`,`n:num`) THEN + INDUCT_TAC THEN + REWRITE_TAC[SUC_SUB1; ADD1; GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + X_GEN_TAC `m:num` THEN + MP_TAC(SPEC `m:num` (REWRITE_RULE[NOT_EXISTS_THM; REAL_NOT_LE] + (ASSUME `~(?m:num. G (y:real) m <= e)`))) THEN ASM_REAL_ARITH_TAC]; + STRIP_TAC THEN FIRST_X_ASSUM SUBST_ALL_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_ELIM_THM]) THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP] THEN + EXISTS_TAC `inv(&k + &1) / &2` THEN + SUBGOAL_THEN `&0 < inv(&k + &1)` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LT_INV THEN REAL_ARITH_TAC; ALL_TAC] THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[NOT_EXISTS_THM; REAL_NOT_LE] THEN + X_GEN_TAC `m:num` THEN + FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN ASM_REAL_ARITH_TAC]);; + +(* The oscillation-badset negligibility, gamma-threaded form. *) +let CARLESON_OSC_BADSET_FROM_UNTRUNC = prove + (`!(f:real->complex) C10. + &0 <= C10 /\ (\z. f(drop z)) IN lspace (:real^1) (&2) /\ + (!(h:real->complex) GG. + schwartz h /\ real_measurable GG + ==> real_integral GG (carleson_Ahat h) + <= C10 * lnorm (:real^1) (&2) (\z. h(drop z)) * sqrt(real_measure + GG)) + ==> real_negligible {y | ~(!e. &0 < e ==> ?m:num. carleson_gamma f (&m) y + <= e)}`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `\y m:num. carleson_gamma f (&m) y` CARLESON_OSC_BADSET_UNIONS) + THEN + REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + MATCH_MP_TAC REAL_NEGLIGIBLE_COUNTABLE_UNIONS THEN + X_GEN_TAC `k:num` THEN + MATCH_MP_TAC REAL_NEGLIGIBLE_BOUNDED_EXHAUSTION THEN + X_GEN_TAC `M:num` THEN + MATCH_MP_TAC CARLESON_OSC_SLICE_NEG_AE THEN + MAP_EVERY EXISTS_TAC + [`UNIONS { {y | !k:num. ?m:num. &k + &1 < + carleson_Ahat_trunc (\t. if abs t <= &n then Cx(&0) else f t) + (&m) y} + | n IN (:num) }`; + `\n. C10 * lnorm (:real^1) (&2) + (\z. (\x. if abs x <= &n then Cx(&0) else f x) (drop z)) * sqrt(&2 * + &M)`] THEN + REPEAT CONJ_TAC THENL + [(* s0 negligible *) + MATCH_MP_TAC CARLESON_S0_UNION_NEG THEN EXISTS_TAC `C10:real` THEN + ASM_REWRITE_TAC[]; + (* A n -> 0 *) + SUBGOAL_THEN + `(\n. C10 * lnorm (:real^1) (&2) + (\z. (\x. if abs x <= &n then Cx(&0) else f x) (drop z)) * sqrt(&2 * + &M)) = + (\n. (C10 * lnorm (:real^1) (&2) + (\z. (\x. if abs x <= &n then Cx(&0) else f x) (drop z))) * sqrt(&2 + * &M))` + SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM; REAL_MUL_ASSOC]; ALL_TAC] THEN + SUBGOAL_THEN `((\n. (C10 * lnorm (:real^1) (&2) + (\z. (\x. if abs x <= &n then Cx(&0) else f x) (drop z))) * sqrt(&2 + * &M)) ---> &0 * sqrt(&2 * &M)) + sequentially` MP_TAC THENL + [MATCH_MP_TAC REALLIM_RMUL THEN + MATCH_MP_TAC CARLESON_TRUNC_COEFF_LIM THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_MUL_LZERO]]; + (* per-n hyps *) + X_GEN_TAC `n:num` THEN + SUBGOAL_THEN + `(\z. (\x. if abs x <= &n then Cx(&0) else (f:real->complex) x) (drop z)) + IN lspace (:real^1) (&2)` + ASSUME_TAC THENL + [BETA_TAC THEN MATCH_MP_TAC CARLESON_TRUNC_LSPACE2 THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL [`\t. if abs t <= &n then Cx(&0) else (f:real->complex) t`; + `real_interval[--(&M),&M]`; + `C10:real`] CARLESON_286T_UNTRUNC) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[REAL_MEASURABLE_REAL_INTERVAL]; STRIP_TAC] THEN + SUBGOAL_THEN + `real_measure(real_interval[--(&M),&M]) = &2 * &M` ASSUME_TAC THENL + [REWRITE_TAC[REAL_MEASURE_REAL_INTERVAL] THEN + REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `!y. ~(y IN UNIONS { {y | !k:num. ?m:num. &k + &1 < + carleson_Ahat_trunc (\t. if abs t <= &n then Cx(&0) else + (f:real->complex) t) (&m) y} + | n IN (:num) }) + ==> ?K. !m:num. carleson_Ahat_trunc (\t. if abs t <= &n then Cx(&0) + else f t) (&m) y <= K` + ASSUME_TAC THENL + [X_GEN_TAC `y:real` THEN DISCH_TAC THEN + MATCH_MP_TAC CARLESON_OFF_BADSET_BOUNDED THEN + FIRST_X_ASSUM(MP_TAC o check (fun th -> is_neg(concl th))) THEN + REWRITE_TAC[IN_UNIONS; IN_ELIM_THM; CONTRAPOS_THM] THEN DISCH_TAC THEN + EXISTS_TAC `{y | !k:num. ?m:num. &k + &1 < + carleson_Ahat_trunc (\t. if abs t <= &n then Cx(&0) else + (f:real->complex) t) (&m) y}` THEN + CONJ_TAC THENL [EXISTS_TAC `n:num` THEN + REWRITE_TAC[IN_UNIV]; ASM_REWRITE_TAC[IN_ELIM_THM]]; + ALL_TAC] THEN + REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + FIRST_X_ASSUM(MP_TAC o check (fun th -> can (find_term (fun t -> t = + `sqrt(real_measure(real_interval[--(&M),&M]))`)) (concl th))) THEN + ASM_REWRITE_TAC[]; + X_GEN_TAC `y:real` THEN STRIP_TAC THEN + MATCH_MP_TAC CARLESON_AHAT_POS THEN + MP_TAC(ISPECL [`\t. if abs t <= &n then Cx(&0) else (f:real->complex) t`; + `y:real`] + CARLESON_TRUNC_FAMILY_PLAIN_WINDOW_BOUND) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + X_GEN_TAC `y:real` THEN STRIP_TAC THEN + MP_TAC(ISPECL [`f:real->complex`; `y:real`; + `&n:real`] CARLESON_GAMMA_LE_AHAT_L2) THEN + ASM_REWRITE_TAC[REAL_POS] THEN DISCH_THEN MATCH_MP_TAC THEN + MP_TAC(ISPECL [`\t. if abs t <= &n then Cx(&0) else (f:real->complex) t`; + `y:real`] + CARLESON_TRUNC_FAMILY_PLAIN_WINDOW_BOUND) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]]);; + +(* --- 286U(a) a.e.-EXISTENCE of the symmetric-window Fourier limit (Fremlin *) +(* mt286.tex 2960-2975 + 3011-3020 output). Given (i) the window-difference *) +(* family bounded above at every (n,y) [so gamma_n is a genuine sup] and *) +(* (ii) the *) +(* "bad set" {y | ~(inf_n gamma_n(y)=0)} is NEGLIGIBLE [the 286U(b) *) +(* contradiction, *) +(* supplied by the per-slice negligibility + 286T], the improper symmetric *) +(* limit *) +(* g(y) = lim_{a->inf} (1/sqrt2pi) int_{-a}^a e^{-ixy}f exists for a.e. y. *) +(* Off the *) +(* bad set, inf gamma_n=0 (the !e criterion) feeds CARLESON_GAMMA_INF_CAUCHY *) +(* -> *) +(* the tail-Cauchy hyp of CARLESON_286U_SYMLIM -> the limit. (BETA_RULE *) +(* bridges *) +(* INF_CAUCHY's lambda-applied II to SYMLIM's beta-reduced hypothesis.) --- *) +let SCALED_TWO_SIDED = prove + (`!c a. &0 < c /\ &0 <= a + ==> real_integral (real_interval[--a,a]) (\u. sin(c * u) / u) = + &2 * real_integral (real_interval[&0,a]) (\u. sin(c * u) / u)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\u. sin(c * u) / u`; + `a:real`] REAL_INTEGRAL_REFLECT_AND_ADD) THEN + ANTS_TAC THENL + [MATCH_MP_TAC SIN_STRETCH_OVER_X_INTEGRABLE THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN + MP_TAC(ISPECL [`\u. sin(c * u) / u`; `&2:real`; `real_interval[&0,a]`] + REAL_INTEGRAL_LMUL) THEN + ANTS_TAC THENL + [MATCH_MP_TAC SIN_STRETCH_OVER_X_INTEGRABLE THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC(MESON[] `x = y ==> real_integral s x = real_integral s y`) THEN + REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + REWRITE_TAC[REAL_MUL_RNEG; SIN_NEG; real_div; REAL_INV_NEG] THEN + REAL_ARITH_TAC);; + +(* Brick 1 (the centering term): int_0^pi sin((n+1/2)u)/u du -> pi/2. *) +let SINEKERNEL_CENTERING_LIMIT = prove + (`((\n. real_integral (real_interval[&0,pi]) (\u. sin((&n + &1 / &2) * u) / + u)) + ---> pi / &2) sequentially`, + SUBGOAL_THEN + `!n. real_integral (real_interval[&0,pi]) (\u. sin((&n + &1 / &2) * u) / u) + = + inv(&2) * + real_integral (real_interval[--pi,pi]) (\u. sin((&n + &1 / &2) * u) / + u)` + (fun th -> ONCE_REWRITE_TAC[th]) THENL + [GEN_TAC THEN + MP_TAC(ISPECL [`&n + &1 / &2`; `pi`] SCALED_TWO_SIDED) THEN + ANTS_TAC THENL [MP_TAC PI_POS THEN REAL_ARITH_TAC; ALL_TAC] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + ONCE_REWRITE_TAC[GSYM SIN_OVER_X_SAMPLE] THEN + SUBGOAL_THEN `pi / &2 = inv(&2) * pi` SUBST1_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REALLIM_LMUL THEN REWRITE_TAC[SIN_OVER_X_SAMPLE_LIMIT]);; + +(* Periodic-reflect integrability (shared prerequisite for the fold/window *) +(* bricks): for f abs-integrable on [-pi,pi] and 2pi-periodic, (\u. f(x-u)) *) +(* is *) +(* abs-integrable on [-pi,pi] (f(x-u) may hit f OUTSIDE [-pi,pi]; *) +(* periodicity *) +(* covers it). Via ABSOLUTELY_REAL_INTEGRABLE_PERIODIC_OFFSET + reflection. *) +let PERIODIC_REFLECT_INTEGRABLE = prove + (`!(f:real->real) x. + f absolutely_real_integrable_on real_interval[--pi,pi] /\ + (!y. f(y + &2 * pi) = f y) + ==> (\u. f(x - u)) absolutely_real_integrable_on real_interval[--pi,pi]`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\u. (f:real->real)(x - u)) = (\u. f(--u + x))` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN AP_TERM_TAC THEN REAL_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(ISPECL [`f:real->real`; `--pi`; `pi`; `x:real`] + ABSOLUTELY_REAL_INTEGRABLE_PERIODIC_OFFSET) THEN + ASM_REWRITE_TAC[REAL_ARITH `pi - --pi = &2 * pi`] THEN + REWRITE_TAC[absolutely_real_integrable_on] THEN STRIP_TAC THEN CONJ_TAC THENL + [MP_TAC(ISPECL [`\v. (f:real->real)(v + x)`; `--pi:real`; `pi:real`] + REAL_INTEGRABLE_REFLECT) THEN + ASM_REWRITE_TAC[REAL_NEG_NEG] THEN DISCH_TAC THEN ASM_REWRITE_TAC[]; + MP_TAC(ISPECL [`\v. abs((f:real->real)(v + x))`; `--pi:real`; `pi:real`] + REAL_INTEGRABLE_REFLECT) THEN + ASM_REWRITE_TAC[REAL_NEG_NEG] THEN DISCH_TAC THEN ASM_REWRITE_TAC[]]);; + +(* Bound: abs(sin(cu)*inv u) <= c (c>0, u<>0), via abs(sin x)<=abs x. *) +let SINC_ABS_BOUND = prove + (`!c u. &0 < c /\ ~(u = &0) ==> abs (sin (c * u) * inv u) <= c`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_INV] THEN + MP_TAC(SPEC `c * u:real` REAL_ABS_SIN_BOUND_LE) THEN + REWRITE_TAC[REAL_ABS_MUL] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < c ==> abs c = c`] THEN DISCH_TAC THEN + SUBGOAL_THEN `c = (c * abs u) * inv(abs u)` + (fun th -> GEN_REWRITE_TAC RAND_CONV [th]) THENL + [SUBGOAL_THEN `~(abs u = &0)` ASSUME_TAC THENL + [ASM_REWRITE_TAC[REAL_ABS_ZERO]; ALL_TAC] THEN + ASM_SIMP_TAC[GSYM REAL_MUL_ASSOC; REAL_MUL_RINV; REAL_MUL_RID]; + MATCH_MP_TAC REAL_LE_RMUL THEN + ASM_REWRITE_TAC[REAL_LE_INV_EQ; REAL_ABS_POS]]);; + +(* Product integrability: sin(cu)/u (bounded) times f(x-u) *) +(* (periodic-reflect). *) +let SINC_TIMES_PERIODIC_INTEGRABLE = prove + (`!(f:real->real) x c. + f absolutely_real_integrable_on real_interval[--pi,pi] /\ + (!y. f(y + &2 * pi) = f y) /\ &0 < c + ==> (\u. sin(c * u) / u * f(x - u)) + absolutely_real_integrable_on real_interval[--pi,pi]`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_IMP_REAL_MEASURABLE THEN + MATCH_MP_TAC SIN_STRETCH_OVER_X_INTEGRABLE THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_BOUNDED_POS] THEN EXISTS_TAC `c:real` THEN + ASM_REWRITE_TAC[FORALL_IN_IMAGE] THEN X_GEN_TAC `u:real` THEN + DISCH_TAC THEN + ASM_CASES_TAC `u = &0` THENL + [ASM_REWRITE_TAC[real_div; REAL_INV_0; REAL_MUL_RZERO; REAL_ABS_NUM] THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[real_div] THEN MATCH_MP_TAC SINC_ABS_BOUND THEN + ASM_REWRITE_TAC[]]; + MATCH_MP_TAC PERIODIC_REFLECT_INTEGRABLE THEN ASM_REWRITE_TAC[]]);; + +(* The evenness fold combines the two one-sided sine-kernel integrals: *) +(* combine to the two-sided one: *) +(* int_0^pi sin(cu)/u f(x+u) + int_0^pi sin(cu)/u f(x-u) *) +(* = int_[-pi,pi] sin(cu)/u f(x-u). *) +(* Reflect the f(x+u) piece to [-pi,0] (sin(cu)/u even), then REAL_INTEGRAL_ *) +(* COMBINE (integrability via SINC_TIMES_PERIODIC_INTEGRABLE). *) +let SINEKERNEL_FOLD = prove + (`!(f:real->real) x c. + f absolutely_real_integrable_on real_interval[--pi,pi] /\ + (!y. f(y + &2 * pi) = f y) /\ &0 < c + ==> real_integral (real_interval[&0,pi]) (\u. sin(c * u) / u * f(x + u)) + + + real_integral (real_interval[&0,pi]) (\u. sin(c * u) / u * f(x - u)) + = + real_integral (real_interval[--pi,pi]) (\u. sin(c * u) / u * f(x - + u))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\u. sin(c * u) / u * f(x + u)`; `&0:real`; `pi`] + REAL_INTEGRAL_REFLECT) THEN + REWRITE_TAC[REAL_NEG_0] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + SUBGOAL_THEN + `real_integral (real_interval[--pi,&0]) + (\x'. sin (c * --x') / --x' * f (x + --x')) = + real_integral (real_interval[--pi,&0]) (\u. sin(c * u) / u * f(x - u))` + SUBST1_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_EQ THEN X_GEN_TAC `u:real` THEN DISCH_TAC THEN + BETA_TAC THEN + SUBGOAL_THEN `sin (c * --u) / --u = sin(c * u) / u` SUBST1_TAC THENL + [REWRITE_TAC[REAL_MUL_RNEG; SIN_NEG; real_div; REAL_INV_NEG] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN REAL_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(ISPECL [`\u. sin(c * u) / u * f(x - u)`; `--pi`; `pi`; `&0:real`] + REAL_INTEGRAL_COMBINE) THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < pi ==> --pi <= &0 /\ &0 <= pi`; PI_POS] THEN + DISCH_THEN MATCH_MP_TAC THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC SINC_TIMES_PERIODIC_INTEGRABLE THEN ASM_REWRITE_TAC[]);; + +(* Two-sided sinc limit: int_[-pi,pi] sin((n+1/2)u)/u du -> pi (= 2 * Brick *) +(* 1). *) +let SINEKERNEL_RL_INTERVAL = prove + (`!H a b. H absolutely_real_integrable_on real_interval[a,b] + ==> ((\n. real_integral (real_interval[a,b]) + (\u. sin((&n + &1 / &2) * u) * H u)) ---> &0) sequentially`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\n. real_integral (real_interval[a,b]) + (\u. sin((&n + &1 / &2) * u) * H u)) = + (\n. real_integral (real_interval[a,b]) (\u. H u * sin((&n + &1 / &2) * + u)))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN REAL_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(ISPECL [`\u. if u IN real_interval[a,b] then H u else &0`] + RIEMANN_LEBESGUE_RLINE) THEN + REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_RESTRICT_UNIV] THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `!c. real_integral (:real) + (\u. (if u IN real_interval[a,b] then H u else &0) * sin(c * u)) = + real_integral (real_interval[a,b]) (\u. H u * sin(c * u))` + (fun th -> REWRITE_TAC[th]) THENL + [GEN_TAC THEN + MP_TAC(ISPECL [`\u. H u * sin(c * u)`; `real_interval[a,b]`] + REAL_INTEGRAL_RESTRICT_UNIV) THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC REAL_INTEGRAL_EQ THEN + X_GEN_TAC `u:real` THEN REWRITE_TAC[IN_UNIV] THEN COND_CASES_TAC THEN + REWRITE_TAC[REAL_MUL_LZERO]; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o MATCH_MP REALLIM_POSINFINITY_SEQ_SHIFT) THEN + REWRITE_TAC[]);; + +(* Periodicity of the discrete sine-kernel term in x. For the a.e.-set *) +(* extension: the window-bridge only proves convergence for |x|real) x. + f absolutely_real_integrable_on real_interval[--pi,pi] /\ + (!y. f(y + &2 * pi) = f y) + ==> (\u. f(x + u)) absolutely_real_integrable_on real_interval[--pi,pi]`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(\u. (f:real->real)(x + u)) = (\u. f(u + x))` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN AP_TERM_TAC THEN REAL_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(ISPECL [`f:real->real`; `--pi`; `pi`; `x:real`] + ABSOLUTELY_REAL_INTEGRABLE_PERIODIC_OFFSET) THEN + ASM_REWRITE_TAC[REAL_ARITH `pi - --pi = &2 * pi`]);; + +(* Product integrability for the f(x+u) piece (mirror of *) +(* SINC_TIMES_PERIODIC_INTEGRABLE); used in the T_n split. *) +let SINC_TIMES_SHIFT_INTEGRABLE = prove + (`!(f:real->real) x c. + f absolutely_real_integrable_on real_interval[--pi,pi] /\ + (!y. f(y + &2 * pi) = f y) /\ &0 < c + ==> (\u. sin(c * u) / u * f(x + u)) + absolutely_real_integrable_on real_interval[--pi,pi]`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_IMP_REAL_MEASURABLE THEN + MATCH_MP_TAC SIN_STRETCH_OVER_X_INTEGRABLE THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_BOUNDED_POS] THEN EXISTS_TAC `c:real` THEN + ASM_REWRITE_TAC[FORALL_IN_IMAGE] THEN X_GEN_TAC `u:real` THEN + DISCH_TAC THEN + ASM_CASES_TAC `u = &0` THENL + [ASM_REWRITE_TAC[real_div; REAL_INV_0; REAL_MUL_RZERO; REAL_ABS_NUM] THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[real_div] THEN MATCH_MP_TAC SINC_ABS_BOUND THEN + ASM_REWRITE_TAC[]]; + MATCH_MP_TAC PERIODIC_SHIFT_INTEGRABLE THEN ASM_REWRITE_TAC[]]);; + +(* T_n split (algebraic heart of the window bridge): the discrete *) +(* sine-kernel *) +(* integral splits by linearity as (fold pieces) - (2 f x)(centering piece): *) +(* int_0^pi sin(cu)((f(x+u)+f(x-u))-2fx)/u *) +(* = (int sin(cu)/u f(x+u) + int sin(cu)/u f(x-u)) - (2fx) int sin(cu)/u. *) +(* Each piece integrable on [0,pi] (SINC_TIMES_SHIFT/PERIODIC + *) +(* SIN_STRETCH_OVER *) +(* _X_INTEGRABLE, restricted from [-pi,pi]); linearity via ASM_SIMP with *) +(* REAL_INTEGRAL_SUB/ADD/LMUL (handles the beta-redexes). *) +let TN_SPLIT = prove + (`!(f:real->real) x c. + f absolutely_real_integrable_on real_interval[--pi,pi] /\ + (!y. f(y + &2 * pi) = f y) /\ &0 < c + ==> real_integral (real_interval[&0,pi]) + (\u. sin(c * u) * ((f(x + u) + f(x - u)) - &2 * f x) / u) = + (real_integral (real_interval[&0,pi]) (\u. sin(c * u) / u * f(x + u)) + + + real_integral (real_interval[&0,pi]) (\u. sin(c * u) / u * f(x - + u))) - + (&2 * f x) * real_integral (real_interval[&0,pi]) (\u. sin(c * u) / + u)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `!g:real->real. g absolutely_real_integrable_on real_interval[--pi,pi] + ==> g real_integrable_on real_interval[&0,pi]` + (LABEL_TAC "RESTR") THENL + [REPEAT STRIP_TAC THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `real_interval[--pi,pi]` THEN + ASM_REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN + MP_TAC PI_POS THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `(\u. sin(c * u) / u * f(x + u)) real_integrable_on real_interval[&0,pi] /\ + (\u. sin(c * u) / u * f(x - u)) real_integrable_on + real_interval[&0,pi] /\ + (\u. sin(c * u) / u) real_integrable_on real_interval[&0,pi]` + STRIP_ASSUME_TAC THENL + [REPEAT CONJ_TAC THENL + [USE_THEN "RESTR" MATCH_MP_TAC THEN + MATCH_MP_TAC SINC_TIMES_SHIFT_INTEGRABLE THEN + ASM_REWRITE_TAC[]; + USE_THEN "RESTR" MATCH_MP_TAC THEN + MATCH_MP_TAC SINC_TIMES_PERIODIC_INTEGRABLE THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC SIN_STRETCH_OVER_X_INTEGRABLE THEN + ASM_REWRITE_TAC[]]; ALL_TAC] THEN + SUBGOAL_THEN + `(\u. sin(c * u) * ((f(x + u) + f(x - u)) - &2 * f x) / u) = + (\u. (sin(c * u) / u * f(x + u) + sin(c * u) / u * f(x - u)) - + (&2 * f x) * (sin(c * u) / u))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_INTEGRAL_SUB; REAL_INTEGRAL_ADD; REAL_INTEGRAL_LMUL; + REAL_INTEGRABLE_ADD; REAL_INTEGRABLE_LMUL]);; + +(* General substitution t = x - u: int_[a,b] G(x-u) du = int_[x-b,x-a] G(t) *) +(* dt. *) +(* Converts the continuous-sinc hypothesis's t-integral over [-pi,pi] into *) +(* the *) +(* u-window [x-pi,x+pi] carrying the PURE sin(cu) kernel, matching the *) +(* target; *) +(* the window mismatch then vanishes by SINEKERNEL_RL_INTERVAL (pure sin, no *) +(* phase). *) +let SINC_SUBST_GEN = prove + (`!(G:real->real) x a b. G real_integrable_on real_interval[x - b, x - a] + ==> real_integral (real_interval[a,b]) (\u. G(x - u)) = + real_integral (real_interval[x - b, x - a]) G`, + REPEAT STRIP_TAC THEN + ABBREV_TAC `p = x - b:real` THEN ABBREV_TAC `q = x - a:real` THEN + MP_TAC(ISPECL [`G:real->real`; `real_integral (real_interval[p:real,q]) G`; + `p:real`; `q:real`; `-- &1:real`; `x:real`] + HAS_REAL_INTEGRAL_AFFINITY) THEN + ASM_SIMP_TAC[REAL_INTEGRABLE_INTEGRAL] THEN + REWRITE_TAC[REAL_ARITH `-- &1 = &0 <=> F`] THEN + REWRITE_TAC[REAL_ARITH `-- &1 * x + c = c - x`; REAL_ABS_NEG; + REAL_ABS_NUM] THEN + REWRITE_TAC[REAL_INV_1; REAL_MUL_LID; REAL_INV_NEG] THEN + SUBGOAL_THEN + `IMAGE (\x'. -- &1 * (x' - x)) (real_interval [p:real,q]) = + real_interval[a,b]` + SUBST1_TAC THENL + [MAP_EVERY EXPAND_TAC ["p"; "q"] THEN + REWRITE_TAC[EXTENSION; IN_IMAGE; IN_REAL_INTERVAL] THEN + X_GEN_TAC `y:real` THEN + EQ_TAC THENL + [STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + STRIP_TAC THEN EXISTS_TAC `x - y:real` THEN CONJ_TAC THEN + ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + DISCH_THEN(ACCEPT_TAC o MATCH_MP REAL_INTEGRAL_UNIQUE));; + +(* Reflection integrability on the FULL hypothesis window: (\u. f(x-u)) is *) +(* abs-integrable on [x-pi,x+pi] whenever f is abs-integrable on [-pi,pi]. *) +(* PURE reflection (u |-> x-u maps [x-pi,x+pi] onto [-pi,pi]) via REAL_ *) +(* INTEGRABLE_AFFINITY on f and |f| -- NO periodicity needed. This covers *) +(* the *) +(* tail-integrability for BOTH window-mismatch tails at once (subintervals *) +(* of *) +(* [x-pi,x+pi]), sidestepping any 'periodic => integ on any interval' lemma. *) +let REFLECT_INTEGRABLE_WINDOW = prove + (`!(f:real->real) x. + f absolutely_real_integrable_on real_interval[--pi,pi] + ==> (\u. f(x - u)) absolutely_real_integrable_on real_interval[x - pi, x + + pi]`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `real_interval[x - pi, x + pi] = + IMAGE (\u. inv(-- &1) * (u - x)) (real_interval[--pi,pi])` + SUBST1_TAC THENL + [REWRITE_TAC[REAL_INV_NEG; REAL_INV_1] THEN + REWRITE_TAC[EXTENSION; IN_IMAGE; IN_REAL_INTERVAL] THEN + X_GEN_TAC `y:real` THEN + EQ_TAC THENL + [STRIP_TAC THEN EXISTS_TAC `x - y:real` THEN CONJ_TAC THEN + ASM_REAL_ARITH_TAC; + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + POP_ASSUM MP_TAC THEN REWRITE_TAC[absolutely_real_integrable_on] THEN + STRIP_TAC THEN CONJ_TAC THENL + [MP_TAC(ISPECL [`f:real->real`; `--pi`; `pi`; `-- &1:real`; `x:real`] + REAL_INTEGRABLE_AFFINITY) THEN + ASM_REWRITE_TAC[REAL_ARITH `-- &1 = &0 <=> F`] THEN + REWRITE_TAC[REAL_ARITH `-- &1 * u + x = x - u`]; + MP_TAC(ISPECL [`\t. abs((f:real->real) t)`; `--pi`; `pi`; `-- &1:real`; + `x:real`] + REAL_INTEGRABLE_AFFINITY) THEN + ASM_REWRITE_TAC[REAL_ARITH `-- &1 = &0 <=> F`] THEN + REWRITE_TAC[REAL_ARITH `-- &1 * u + x = x - u`]]);; + +(* Sinc-product integrability on the hypothesis window [x-pi,x+pi]. *) +let SINC_TIMES_REFLECT_WINDOW = prove + (`!(f:real->real) x c. + f absolutely_real_integrable_on real_interval[--pi,pi] /\ &0 < c + ==> (\u. sin(c * u) / u * f(x - u)) + absolutely_real_integrable_on real_interval[x - pi, x + pi]`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_IMP_REAL_MEASURABLE THEN + MATCH_MP_TAC SIN_STRETCH_OVER_X_INTEGRABLE THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_BOUNDED_POS] THEN EXISTS_TAC `c:real` THEN + ASM_REWRITE_TAC[FORALL_IN_IMAGE] THEN X_GEN_TAC `u:real` THEN + DISCH_TAC THEN + ASM_CASES_TAC `u = &0` THENL + [ASM_REWRITE_TAC[real_div; REAL_INV_0; REAL_MUL_RZERO; REAL_ABS_NUM] THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[real_div] THEN MATCH_MP_TAC SINC_ABS_BOUND THEN + ASM_REWRITE_TAC[]]; + MATCH_MP_TAC REFLECT_INTEGRABLE_WINDOW THEN ASM_REWRITE_TAC[]]);; + +(* The hypothesis kernel sin(c(x-t))/(x-t) is integrable on [-pi,pi]: it is *) +(* a *) +(* reflection (t |-> x-t) of the stretch sin(cu)/u, so *) +(* REAL_INTEGRABLE_AFFINITY *) +(* from SIN_STRETCH_OVER_X_INTEGRABLE on the source window [x-pi,x+pi] *) +(* (whose *) +(* image under t|->x-t is [-pi,pi]). Feeds the substitution HYP_U_FORM that *) +(* rewrites the continuous-sinc hypothesis into the pure-sin(cu) u-window *) +(* form. *) +let HYP_KERNEL_INTEGRABLE = prove + (`!c x. &0 < c + ==> (\t. sin(c * (x - t)) / (x - t)) real_integrable_on + real_interval[--pi,pi]`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `real_interval[--pi,pi] = + IMAGE (\t. inv(-- &1) * (t - x)) (real_interval[x - pi, x + + pi])` + SUBST1_TAC THENL + [REWRITE_TAC[REAL_INV_NEG; REAL_INV_1] THEN + REWRITE_TAC[EXTENSION; IN_IMAGE; IN_REAL_INTERVAL] THEN + X_GEN_TAC `y:real` THEN + EQ_TAC THENL + [STRIP_TAC THEN EXISTS_TAC `x - y:real` THEN CONJ_TAC THEN + ASM_REAL_ARITH_TAC; + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN + `(\t. sin(c * (x - t)) / (x - t)) = (\t. (\u. sin(c * u) / u)(-- &1 * t + + x))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN REWRITE_TAC[] THEN + REWRITE_TAC[REAL_ARITH `-- &1 * t + x:real = x - t`]; ALL_TAC] THEN + MATCH_MP_TAC REAL_INTEGRABLE_AFFINITY THEN + REWRITE_TAC[REAL_ARITH `-- &1 = &0 <=> F`] THEN + MATCH_MP_TAC SIN_STRETCH_OVER_X_INTEGRABLE THEN ASM_REWRITE_TAC[]);; + +(* The full hypothesis integrand sin(c(x-t))/(x-t) * f(t) is absolutely *) +(* integrable on [-pi,pi] (bounded kernel times f). *) +let HYP_INTEGRAND_INTEGRABLE = prove + (`!(f:real->real) x c. + f absolutely_real_integrable_on real_interval[--pi,pi] /\ &0 < c + ==> (\t. sin(c * (x - t)) / (x - t) * f t) + absolutely_real_integrable_on real_interval[--pi,pi]`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_IMP_REAL_MEASURABLE THEN + MATCH_MP_TAC HYP_KERNEL_INTEGRABLE THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_BOUNDED_POS] THEN EXISTS_TAC `c:real` THEN + ASM_REWRITE_TAC[FORALL_IN_IMAGE] THEN X_GEN_TAC `t:real` THEN + DISCH_TAC THEN + ASM_CASES_TAC `x - t = &0` THENL + [ASM_REWRITE_TAC[real_div; REAL_INV_0; REAL_MUL_RZERO; REAL_ABS_NUM] THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[real_div] THEN MATCH_MP_TAC SINC_ABS_BOUND THEN + ASM_REWRITE_TAC[]]; + ASM_REWRITE_TAC[]]);; + +(* HYP_U_FORM: rewrite the continuous-sinc hypothesis integral into the PURE *) +(* sin(cu) u-window form. int_[x-pi,x+pi] sin(cu)/u f(x-u) du = *) +(* int_[-pi,pi] sin(c(x-t))/(x-t) f(t) dt. SINC_SUBST_GEN (G = the hyp *) +(* integrand, a=x-pi,b=x+pi; integrable by HYP_INTEGRAND_INTEGRABLE) + REAL_ *) +(* INTEGRAL_EQ integrand-simplify (x-(x-u)=u, needs the :real-annotated *) +(* rewrite). *) +let HYP_U_FORM = prove + (`!(f:real->real) x c. + f absolutely_real_integrable_on real_interval[--pi,pi] /\ &0 < c + ==> real_integral (real_interval[x - pi, x + pi]) (\u. sin(c * u) / u * + f(x - u)) = + real_integral (real_interval[--pi,pi]) (\t. sin(c * (x - t)) / (x - + t) * f t)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\t. sin(c * (x - t)) / (x - t) * f t`; `x:real`; `x - pi`; + `x + pi`] + SINC_SUBST_GEN) THEN + REWRITE_TAC[REAL_ARITH `x - (x + pi) = --pi`; + REAL_ARITH `x - (x - pi) = pi`] THEN + ANTS_TAC THENL + [MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC HYP_INTEGRAND_INTEGRABLE THEN ASM_REWRITE_TAC[]; + DISCH_THEN(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC REAL_INTEGRAL_EQ THEN X_GEN_TAC `u:real` THEN DISCH_TAC THEN + REWRITE_TAC[REAL_ARITH `x - (x - u):real = u`]]);; + +(* Tail-kernel integrability: f(x-u)/u is abs-integrable on a tail [a,b] *) +(* that *) +(* lies in [x-pi,x+pi] and avoids 0 (so 1/u is bounded there): bounded(inv) *) +(* * *) +(* f(x-u) [REFLECT_INTEGRABLE_WINDOW restricted]. This is the H(u)=f(x-u)/u *) +(* that SINEKERNEL_RL_INTERVAL consumes for the window-mismatch tails. *) +let TAIL_KERNEL_INTEGRABLE = prove + (`!(f:real->real) x a b. + f absolutely_real_integrable_on real_interval[--pi,pi] /\ + real_interval[a,b] SUBSET real_interval[x - pi, x + pi] /\ + (!u. u IN real_interval[a,b] ==> ~(u = &0)) + ==> (\u. f(x - u) / u) absolutely_real_integrable_on real_interval[a,b]`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `inv real_continuous_on real_interval[a,b]` ASSUME_TAC THENL + [MP_TAC(ISPECL [`\x:real. x`; + `real_interval[a,b]`] REAL_CONTINUOUS_ON_INV) THEN + ASM_REWRITE_TAC[REAL_CONTINUOUS_ON_ID; ETA_AX]; ALL_TAC] THEN + REWRITE_TAC[real_div] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_IMP_REAL_MEASURABLE_ON_CLOSED_SUBSET THEN + ASM_REWRITE_TAC[REAL_CLOSED_REAL_INTERVAL]; + MATCH_MP_TAC REAL_COMPACT_IMP_BOUNDED THEN + MATCH_MP_TAC REAL_COMPACT_CONTINUOUS_IMAGE THEN + ASM_REWRITE_TAC[REAL_COMPACT_INTERVAL]; + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `real_interval[x - pi, x + pi]` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REFLECT_INTEGRABLE_WINDOW THEN ASM_REWRITE_TAC[]]);; + +(* Tail vanishing: on a tail [a,b] subset [x-pi,x+pi] avoiding 0, the sine- *) +(* kernel integral -> 0 (SINEKERNEL_RL_INTERVAL with H=f(x-u)/u, *) +(* TAIL_KERNEL_ INTEGRABLE). *) +let TAIL_VANISH = prove + (`!(f:real->real) x a b. + f absolutely_real_integrable_on real_interval[--pi,pi] /\ + real_interval[a,b] SUBSET real_interval[x - pi, x + pi] /\ + (!u. u IN real_interval[a,b] ==> ~(u = &0)) + ==> ((\n. real_integral (real_interval[a,b]) + (\u. sin((&n + &1 / &2) * u) / u * f(x - u))) ---> &0) + sequentially`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\n. real_integral (real_interval[a,b]) (\u. sin((&n + &1 / &2) * u) / u * + f(x - u))) = + (\n. real_integral (real_interval[a,b]) + (\u. sin((&n + &1 / &2) * u) * (\v. f(x - v) / v) u))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN REWRITE_TAC[] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC SINEKERNEL_RL_INTERVAL THEN + MATCH_MP_TAC TAIL_KERNEL_INTEGRABLE THEN ASM_REWRITE_TAC[]);; + +(* Window decomposition (x in (0,pi)): the [-pi,pi] sine-kernel integral *) +(* splits *) +(* as the hypothesis window [x-pi,x+pi] plus the two mismatch tails. *) +(* int_[-pi,pi] k = int_[x-pi,x+pi] k + int_[-pi,x-pi] k - int_[pi,x+pi] k, *) +(* k(u)=sin((n+1/2)u)/u f(x-u). Two REAL_INTEGRAL_COMBINEs (within [-pi,pi] *) +(* at *) +(* x-pi via SINC_TIMES_PERIODIC_INTEGRABLE, within [x-pi,x+pi] at pi via *) +(* SINC_ *) +(* TIMES_REFLECT_WINDOW) + REAL_ARITH. *) +let WINDOW_DECOMP = prove + (`!(f:real->real) x n. + f absolutely_real_integrable_on real_interval[--pi,pi] /\ + (!y. f(y + &2 * pi) = f y) /\ &0 < x /\ x < pi + ==> real_integral (real_interval[--pi,pi]) (\u. sin((&n + &1 / &2) * u) / + u * f(x - u)) = + (real_integral (real_interval[x - pi, x + pi]) (\u. sin((&n + &1 / + &2) * u) / u * f(x - u)) + + real_integral (real_interval[--pi, x - pi]) (\u. sin((&n + &1 / &2) + * u) / u * f(x - u))) - + real_integral (real_interval[pi, x + pi]) (\u. sin((&n + &1 / &2) * + u) / u * f(x - u))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&0 < &n + &1 / &2` ASSUME_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `(\u. sin((&n + &1 / &2) * u) / u * (f:real->real)(x - u)) + real_integrable_on real_interval[--pi,pi] /\ + (\u. sin((&n + &1 / &2) * u) / u * (f:real->real)(x - u)) + real_integrable_on real_interval[x - pi, x + pi]` + STRIP_ASSUME_TAC THENL + [CONJ_TAC THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE THENL + [MATCH_MP_TAC SINC_TIMES_PERIODIC_INTEGRABLE THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC SINC_TIMES_REFLECT_WINDOW THEN + ASM_REWRITE_TAC[]]; ALL_TAC] THEN + MP_TAC(ISPECL [`\u. sin((&n + &1 / &2) * u) / u * (f:real->real)(x - u)`; + `--pi`; `pi`; `x - pi`] + REAL_INTEGRAL_COMBINE) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; DISCH_TAC] THEN + MP_TAC(ISPECL [`\u. sin((&n + &1 / &2) * u) / u * (f:real->real)(x - u)`; + `x - pi`; `x + pi`; `pi`] + REAL_INTEGRAL_COMBINE) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; DISCH_TAC] THEN + ASM_REAL_ARITH_TAC);; + +(* The hypothesis-window limit: int_[x-pi,x+pi] sin((n+1/2)u)/u f(x-u) -> pi *) +(* f x from the continuous-sinc hypothesis (at a:=n+1/2) via HYP_U_FORM + *) +(* REALLIM_ POSINFINITY_SEQ_SHIFT. *) +let HN_LIMIT = prove + (`!(f:real->real) x. + f absolutely_real_integrable_on real_interval[--pi,pi] /\ &0 < x /\ x < + pi /\ + ((\a. real_integral (real_interval[--pi,pi]) (\t. sin(a * (x - t)) / (x - + t) * f t)) + ---> pi * f x) at_posinfinity + ==> ((\n. real_integral (real_interval[x - pi, x + pi]) + (\u. sin((&n + &1 / &2) * u) / u * f(x - u))) ---> pi * f x) + sequentially`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\n. real_integral (real_interval[x - pi, x + pi]) + (\u. sin((&n + &1 / &2) * u) / u * (f:real->real)(x - u))) = + (\n. (\a. real_integral (real_interval[--pi,pi]) (\t. sin(a * (x - t)) / (x + - t) * f t)) + (&n + &1 / &2))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN REWRITE_TAC[] THEN + MATCH_MP_TAC HYP_U_FORM THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC REALLIM_POSINFINITY_SEQ_SHIFT THEN ASM_REWRITE_TAC[]);; + +(* Limit-combine helper: (A->l, B->0, C->0) ==> (\n. (A n + B n) - C n) -> *) +(* l. Reusable form (l = (l+&0)-&0 + REALLIM_SUB/ADD) for the window-bridge *) +(* assembly, applied with A/B/C the three abbreviated integral-functions. *) +let LIM_SUM2_SUB = prove + (`!A B C l. (A ---> l) sequentially /\ (B ---> &0) sequentially /\ + (C ---> &0) sequentially + ==> ((\n. (A n + B n) - C n) ---> l) sequentially`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `l = (l + &0) - &0` SUBST1_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REALLIM_SUB THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REALLIM_ADD THEN ASM_REWRITE_TAC[]);; + +(* Periodicity-shifted reflect window: (\u. f(x-u)) abs-integrable on the *) +(* SHIFTED window [x-3pi,x-pi] (the k=-1 copy), needed for the LEFT window- *) +(* mismatch tail [-pi,x-pi] (x in (0,pi)) which is NOT subset [x-pi,x+pi]. *) +(* f(x-u) = f((x-2pi)-u) by periodicity = REFLECT_INTEGRABLE_WINDOW at *) +(* centre x-2pi (window [(x-2pi)-pi,(x-2pi)+pi] = [x-3pi,x-pi]). *) +let REFLECT_INTEGRABLE_WINDOW_SHIFT = prove + (`!(f:real->real) x. + f absolutely_real_integrable_on real_interval[--pi,pi] /\ (!y. f(y + &2 * + pi) = f y) + ==> (\u. f(x - u)) absolutely_real_integrable_on real_interval[x - &3 * + pi, x - pi]`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\u. (f:real->real)(x - u)) = (\u. f((x - &2 * pi) - u))` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `u:real` THEN + SUBGOAL_THEN `x - u:real = ((x - &2 * pi) - u) + &2 * pi` SUBST1_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL [`f:real->real`; `x - &2 * pi`] REFLECT_INTEGRABLE_WINDOW) THEN + ASM_REWRITE_TAC[REAL_ARITH `(x - &2 * pi) - pi = x - &3 * pi`; + REAL_ARITH `(x - &2 * pi) + pi = x - pi`]);; + +(* Shifted tail-kernel integrability: f(x-u)/u abs-integ on a tail [a,b] *) +(* subset [x-3pi,x-pi] avoiding 0 (bounded inv * *) +(* REFLECT_INTEGRABLE_WINDOW_SHIFT). *) +let TAIL_KERNEL_INTEGRABLE_SHIFT = prove + (`!(f:real->real) x a b. + f absolutely_real_integrable_on real_interval[--pi,pi] /\ (!y. f(y + &2 * + pi) = f y) /\ + real_interval[a,b] SUBSET real_interval[x - &3 * pi, x - pi] /\ + (!u. u IN real_interval[a,b] ==> ~(u = &0)) + ==> (\u. f(x - u) / u) absolutely_real_integrable_on real_interval[a,b]`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `inv real_continuous_on real_interval[a,b]` ASSUME_TAC THENL + [MP_TAC(ISPECL [`\x:real. x`; + `real_interval[a,b]`] REAL_CONTINUOUS_ON_INV) THEN + ASM_REWRITE_TAC[REAL_CONTINUOUS_ON_ID; ETA_AX]; ALL_TAC] THEN + REWRITE_TAC[real_div] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_IMP_REAL_MEASURABLE_ON_CLOSED_SUBSET THEN + ASM_REWRITE_TAC[REAL_CLOSED_REAL_INTERVAL]; + MATCH_MP_TAC REAL_COMPACT_IMP_BOUNDED THEN + MATCH_MP_TAC REAL_COMPACT_CONTINUOUS_IMAGE THEN + ASM_REWRITE_TAC[REAL_COMPACT_INTERVAL]; + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `real_interval[x - &3 * pi, x - pi]` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REFLECT_INTEGRABLE_WINDOW_SHIFT THEN ASM_REWRITE_TAC[]]);; + +(* Shifted tail vanishing (left window-mismatch tail): int_[a,b] *) +(* sin((n+1/2)u)/u f(x-u) -> 0 for [a,b] subset [x-3pi,x-pi] avoiding 0. *) +let TAIL_VANISH_SHIFT = prove + (`!(f:real->real) x a b. + f absolutely_real_integrable_on real_interval[--pi,pi] /\ (!y. f(y + &2 * + pi) = f y) /\ + real_interval[a,b] SUBSET real_interval[x - &3 * pi, x - pi] /\ + (!u. u IN real_interval[a,b] ==> ~(u = &0)) + ==> ((\n. real_integral (real_interval[a,b]) + (\u. sin((&n + &1 / &2) * u) / u * f(x - u))) ---> &0) + sequentially`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\n. real_integral (real_interval[a,b]) (\u. sin((&n + &1 / &2) * u) / u * + f(x - u))) = + (\n. real_integral (real_interval[a,b]) + (\u. sin((&n + &1 / &2) * u) * (\v. f(x - v) / v) u))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN REWRITE_TAC[] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC SINEKERNEL_RL_INTERVAL THEN + MATCH_MP_TAC TAIL_KERNEL_INTEGRABLE_SHIFT THEN ASM_REWRITE_TAC[]);; + +(* WINDOW BRIDGE (x in (0,pi)): the [-pi,pi] sine-kernel W_n -> pi f x, from *) +(* the continuous-sinc hypothesis. W_n = int_[x-pi,x+pi] + (left tail) - *) +(* (right tail) [WINDOW_DECOMP]; window integral -> pi f x [HN_LIMIT]; LEFT *) +(* tail *) +(* [-pi,x-pi] -> 0 [TAIL_VANISH_SHIFT, the k=-1 window] and RIGHT tail *) +(* [pi,x+pi] *) +(* -> 0 [TAIL_VANISH]; LIM_SUM2_SUB combines. KEY: WINDOW_DECOMP RHS written *) +(* with the 3 integrals as EXPLICIT ((\m. INTEG) n) apps so MATCH_MP_TAC *) +(* LIM_SUM2_SUB HO-unifies; DISJ2_TAC for the SUBSET_REAL_INTERVAL *) +(* disjuncts. *) +let WINDOW_BRIDGE_POS = prove + (`!(f:real->real) x. + f absolutely_real_integrable_on real_interval[--pi,pi] /\ (!y. f(y + &2 * + pi) = f y) /\ + &0 < x /\ x < pi /\ + ((\a. real_integral (real_interval[--pi,pi]) (\t. sin(a * (x - t)) / (x - + t) * f t)) + ---> pi * f x) at_posinfinity + ==> ((\n. real_integral (real_interval[--pi,pi]) + (\u. sin((&n + &1 / &2) * u) / u * f(x - u))) ---> pi * f x) + sequentially`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\n. real_integral (real_interval[--pi,pi]) (\u. sin((&n + &1 / &2) * u) / + u * (f:real->real)(x - u))) = + (\n. ((\m. real_integral (real_interval[x - pi, x + pi]) (\u. sin((&m + &1 + / &2) * u) / u * f(x - u))) n + + (\m. real_integral (real_interval[--pi, x - pi]) (\u. sin((&m + &1 / + &2) * u) / u * f(x - u))) n) - + (\m. real_integral (real_interval[pi, x + pi]) (\u. sin((&m + &1 / + &2) * u) / u * f(x - u))) n)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN REWRITE_TAC[] THEN + MATCH_MP_TAC WINDOW_DECOMP THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC LIM_SUM2_SUB THEN REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC HN_LIMIT THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC TAIL_VANISH_SHIFT THEN + ASM_REWRITE_TAC[SUBSET_REAL_INTERVAL; IN_REAL_INTERVAL] THEN + CONJ_TAC THENL [DISJ2_TAC THEN MP_TAC PI_POS THEN ASM_REAL_ARITH_TAC; + REPEAT STRIP_TAC THEN ASM_REAL_ARITH_TAC]; + MATCH_MP_TAC TAIL_VANISH THEN + ASM_REWRITE_TAC[SUBSET_REAL_INTERVAL; IN_REAL_INTERVAL] THEN + CONJ_TAC THENL [DISJ2_TAC THEN MP_TAC PI_POS THEN ASM_REAL_ARITH_TAC; + REPEAT STRIP_TAC THEN ASM_REAL_ARITH_TAC]]);; + +(* Payoff step: the discrete [0,pi] sine-kernel T_n = int_0^pi sin((n+1/2)u) *) +(* ((f(x+u)+f(x-u))-2fx)/u = W_n - (2fx)*C(n) per n [TN_SPLIT + *) +(* SINEKERNEL_FOLD], so with W_n -> pi f x and C(n) -> pi/2, T_n -> pi fx - *) +(* 2fx(pi/2) = 0. *) +let TN_SPLIT_FOLD_EQ = prove + (`!(f:real->real) x n. + f absolutely_real_integrable_on real_interval[--pi,pi] /\ (!y. f(y + &2 * + pi) = f y) + ==> real_integral (real_interval[&0,pi]) (\u. sin((&n + &1 / &2) * u) * + (((f:real->real)(x + u) + f(x - u)) - &2 * f x) / u) = + real_integral (real_interval[--pi,pi]) (\u. sin((&n + &1 / &2) * u) / + u * f(x - u)) - + (&2 * f x) * real_integral (real_interval[&0,pi]) (\u. sin((&n + &1 / + &2) * u) / u)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:real->real`; `x:real`; `&n + &1 / &2`] TN_SPLIT) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN + MP_TAC(ISPECL [`f:real->real`; `x:real`; + `&n + &1 / &2`] SINEKERNEL_FOLD) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN REFL_TAC);; + +(* T_n -> 0 (the CARLESON_286V_FROM_SINEKERNEL input) from W_n -> pi f x. *) +(* GEN_REWRITE the limit-value &0 at RATOR_CONV o RAND_CONV (NOT SUBST1, *) +(* which would also rewrite the [&0,pi] interval bound); REALLIM_SUB + *) +(* REALLIM_LMUL + SINEKERNEL_CENTERING_LIMIT. *) +let TN_ZERO = prove + (`!(f:real->real) x. + f absolutely_real_integrable_on real_interval[--pi,pi] /\ (!y. f(y + &2 * + pi) = f y) /\ + ((\n. real_integral (real_interval[--pi,pi]) + (\u. sin((&n + &1 / &2) * u) / u * f(x - u))) ---> pi * f x) + sequentially + ==> ((\n. real_integral (real_interval[&0,pi]) + (\u. sin((&n + &1 / &2) * u) * ((f(x + u) + f(x - u)) - &2 * f x) + / u)) ---> &0) sequentially`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\n. real_integral (real_interval[&0,pi]) + (\u. sin((&n + &1 / &2) * u) * (((f:real->real)(x + u) + f(x - + u)) - &2 * f x) / u)) = + (\n. real_integral (real_interval[--pi,pi]) (\u. sin((&n + &1 / &2) * u) / + u * f(x - u)) - + (&2 * f x) * real_integral (real_interval[&0,pi]) (\u. sin((&n + &1 / + &2) * u) / u))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + MATCH_MP_TAC TN_SPLIT_FOLD_EQ THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV) + [REAL_ARITH `&0 = pi * (f:real->real) x - (&2 * f x) * (pi / &2)`] THEN + MATCH_MP_TAC REALLIM_SUB THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REALLIM_LMUL THEN REWRITE_TAC[SINEKERNEL_CENTERING_LIMIT]);; + +(* ==== Negative case x in (-pi,0): +2pi-shifted mirror of the window *) +(* bridge. == *) + +(* HN_LIMIT with the (spurious) 0real) x. + f absolutely_real_integrable_on real_interval[--pi,pi] /\ + ((\a. real_integral (real_interval[--pi,pi]) (\t. sin(a * (x - t)) / (x - + t) * f t)) + ---> pi * f x) at_posinfinity + ==> ((\n. real_integral (real_interval[x - pi, x + pi]) + (\u. sin((&n + &1 / &2) * u) / u * f(x - u))) ---> pi * f x) + sequentially`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\n. real_integral (real_interval[x - pi, x + pi]) + (\u. sin((&n + &1 / &2) * u) / u * (f:real->real)(x - u))) = + (\n. (\a. real_integral (real_interval[--pi,pi]) (\t. sin(a * (x - t)) / (x + - t) * f t)) + (&n + &1 / &2))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN REWRITE_TAC[] THEN + MATCH_MP_TAC HYP_U_FORM THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC REALLIM_POSINFINITY_SEQ_SHIFT THEN ASM_REWRITE_TAC[]);; + +(* +2pi-shifted reflect window [x+pi,x+3pi] (k=+1 copy), for the RIGHT tail *) +(* [x+pi,pi] of the x in (-pi,0) mismatch (there x-u in (-2pi,-pi]). *) +let REFLECT_INTEGRABLE_WINDOW_SHIFT_POS = prove + (`!(f:real->real) x. + f absolutely_real_integrable_on real_interval[--pi,pi] /\ (!y. f(y + &2 * + pi) = f y) + ==> (\u. f(x - u)) absolutely_real_integrable_on real_interval[x + pi, x + + &3 * pi]`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\u. (f:real->real)(x - u)) = (\u. f((x + &2 * pi) - u))` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `u:real` THEN + SUBGOAL_THEN `(x + &2 * pi) - u:real = (x - u) + &2 * pi` SUBST1_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL [`f:real->real`; `x + &2 * pi`] REFLECT_INTEGRABLE_WINDOW) THEN + ASM_REWRITE_TAC[REAL_ARITH `(x + &2 * pi) - pi = x + pi`; + REAL_ARITH `(x + &2 * pi) + pi = x + &3 * pi`]);; + +let TAIL_KERNEL_INTEGRABLE_SHIFT_POS = prove + (`!(f:real->real) x a b. + f absolutely_real_integrable_on real_interval[--pi,pi] /\ (!y. f(y + &2 * + pi) = f y) /\ + real_interval[a,b] SUBSET real_interval[x + pi, x + &3 * pi] /\ + (!u. u IN real_interval[a,b] ==> ~(u = &0)) + ==> (\u. f(x - u) / u) absolutely_real_integrable_on real_interval[a,b]`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `inv real_continuous_on real_interval[a,b]` ASSUME_TAC THENL + [MP_TAC(ISPECL [`\x:real. x`; + `real_interval[a,b]`] REAL_CONTINUOUS_ON_INV) THEN + ASM_REWRITE_TAC[REAL_CONTINUOUS_ON_ID; ETA_AX]; ALL_TAC] THEN + REWRITE_TAC[real_div] THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_IMP_REAL_MEASURABLE_ON_CLOSED_SUBSET THEN + ASM_REWRITE_TAC[REAL_CLOSED_REAL_INTERVAL]; + MATCH_MP_TAC REAL_COMPACT_IMP_BOUNDED THEN + MATCH_MP_TAC REAL_COMPACT_CONTINUOUS_IMAGE THEN + ASM_REWRITE_TAC[REAL_COMPACT_INTERVAL]; + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `real_interval[x + pi, x + &3 * pi]` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REFLECT_INTEGRABLE_WINDOW_SHIFT_POS THEN ASM_REWRITE_TAC[]]);; + +let TAIL_VANISH_SHIFT_POS = prove + (`!(f:real->real) x a b. + f absolutely_real_integrable_on real_interval[--pi,pi] /\ (!y. f(y + &2 * + pi) = f y) /\ + real_interval[a,b] SUBSET real_interval[x + pi, x + &3 * pi] /\ + (!u. u IN real_interval[a,b] ==> ~(u = &0)) + ==> ((\n. real_integral (real_interval[a,b]) + (\u. sin((&n + &1 / &2) * u) / u * f(x - u))) ---> &0) + sequentially`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\n. real_integral (real_interval[a,b]) (\u. sin((&n + &1 / &2) * u) / u * + f(x - u))) = + (\n. real_integral (real_interval[a,b]) (\u. sin((&n + &1 / &2) * u) * (\v. + f(x - v) / v) u))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN REWRITE_TAC[] THEN + REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC SINEKERNEL_RL_INTERVAL THEN + MATCH_MP_TAC TAIL_KERNEL_INTEGRABLE_SHIFT_POS THEN ASM_REWRITE_TAC[]);; + +(* Window decomposition, x in (-pi,0) (ordering x-pi < -pi < x+pi < pi): *) +(* int_[-pi,pi] k = int_[x-pi,x+pi] k - int_[x-pi,-pi] k + int_[x+pi,pi] k. *) +let WINDOW_DECOMP_NEG = prove + (`!(f:real->real) x n. + f absolutely_real_integrable_on real_interval[--pi,pi] /\ + (!y. f(y + &2 * pi) = f y) /\ --pi < x /\ x < &0 + ==> real_integral (real_interval[--pi,pi]) (\u. sin((&n + &1 / &2) * u) / + u * f(x - u)) = + (real_integral (real_interval[x - pi, x + pi]) (\u. sin((&n + &1 / + &2) * u) / u * f(x - u)) - + real_integral (real_interval[x - pi, --pi]) (\u. sin((&n + &1 / &2) + * u) / u * f(x - u))) + + real_integral (real_interval[x + pi, pi]) (\u. sin((&n + &1 / &2) * + u) / u * f(x - u))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&0 < &n + &1 / &2` ASSUME_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `(\u. sin((&n + &1 / &2) * u) / u * (f:real->real)(x - u)) + real_integrable_on real_interval[--pi,pi] /\ + (\u. sin((&n + &1 / &2) * u) / u * (f:real->real)(x - u)) + real_integrable_on real_interval[x - pi, x + pi]` + STRIP_ASSUME_TAC THENL + [CONJ_TAC THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE THENL + [MATCH_MP_TAC SINC_TIMES_PERIODIC_INTEGRABLE THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC SINC_TIMES_REFLECT_WINDOW THEN + ASM_REWRITE_TAC[]]; ALL_TAC] THEN + MP_TAC(ISPECL [`\u. sin((&n + &1 / &2) * u) / u * (f:real->real)(x - u)`; + `x - pi`; `x + pi`; `--pi`] + REAL_INTEGRAL_COMBINE) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; DISCH_TAC] THEN + MP_TAC(ISPECL [`\u. sin((&n + &1 / &2) * u) / u * (f:real->real)(x - u)`; + `--pi`; `pi`; `x + pi`] + REAL_INTEGRAL_COMBINE) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; DISCH_TAC] THEN + ASM_REAL_ARITH_TAC);; + +(* Combine helper (neg): (A->l, B->0, C->0) ==> (\n. (A n - B n) + C n) -> *) +(* l. *) +let LIM_SUB2_ADD = prove + (`!A B C l. (A ---> l) sequentially /\ (B ---> &0) sequentially /\ + (C ---> &0) sequentially + ==> ((\n. (A n - B n) + C n) ---> l) sequentially`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `l = (l - &0) + &0` SUBST1_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REALLIM_ADD THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REALLIM_SUB THEN ASM_REWRITE_TAC[]);; + +(* WINDOW BRIDGE (x in (-pi,0)): mirror of WINDOW_BRIDGE_POS. LEFT tail *) +(* [x-pi,-pi] plain reflect (TAIL_VANISH), RIGHT tail [x+pi,pi] the +2pi *) +(* shift *) +(* (TAIL_VANISH_SHIFT_POS); LIM_SUB2_ADD. Nonzero legs: MP_TAC PI_POS *) +(* (x+pi>0). *) +let WINDOW_BRIDGE_NEG = prove + (`!(f:real->real) x. + f absolutely_real_integrable_on real_interval[--pi,pi] /\ (!y. f(y + &2 * + pi) = f y) /\ + --pi < x /\ x < &0 /\ + ((\a. real_integral (real_interval[--pi,pi]) (\t. sin(a * (x - t)) / (x - + t) * f t)) + ---> pi * f x) at_posinfinity + ==> ((\n. real_integral (real_interval[--pi,pi]) + (\u. sin((&n + &1 / &2) * u) / u * f(x - u))) ---> pi * f x) + sequentially`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\n. real_integral (real_interval[--pi,pi]) (\u. sin((&n + &1 / &2) * u) / + u * (f:real->real)(x - u))) = + (\n. ((\m. real_integral (real_interval[x - pi, x + pi]) (\u. sin((&m + &1 + / &2) * u) / u * f(x - u))) n - + (\m. real_integral (real_interval[x - pi, --pi]) (\u. sin((&m + &1 / + &2) * u) / u * f(x - u))) n) + + (\m. real_integral (real_interval[x + pi, pi]) (\u. sin((&m + &1 / + &2) * u) / u * f(x - u))) n)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN REWRITE_TAC[] THEN + MATCH_MP_TAC WINDOW_DECOMP_NEG THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC LIM_SUB2_ADD THEN REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC HN_LIMIT_GEN THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC TAIL_VANISH THEN + ASM_REWRITE_TAC[SUBSET_REAL_INTERVAL; IN_REAL_INTERVAL] THEN + CONJ_TAC THENL [DISJ2_TAC THEN MP_TAC PI_POS THEN ASM_REAL_ARITH_TAC; + REPEAT STRIP_TAC THEN MP_TAC PI_POS THEN + ASM_REAL_ARITH_TAC]; + MATCH_MP_TAC TAIL_VANISH_SHIFT_POS THEN + ASM_REWRITE_TAC[SUBSET_REAL_INTERVAL; IN_REAL_INTERVAL] THEN + CONJ_TAC THENL [DISJ2_TAC THEN MP_TAC PI_POS THEN ASM_REAL_ARITH_TAC; + REPEAT STRIP_TAC THEN MP_TAC PI_POS THEN + ASM_REAL_ARITH_TAC]]);; + +(* --- Helper: the discrete [0,pi] sine-kernel T_n is invariant under any *) +(* integer multiple of the 2*pi period (iterated DISCRETE_KERNEL_PERIODIC). *) +(* --- *) +let REAL_REP_MOD_2PI = prove + (`!x. ?k. integer k /\ --pi <= x - k * (&2 * pi) /\ x - k * (&2 * pi) < pi`, + GEN_TAC THEN EXISTS_TAC `floor((x + pi) / (&2 * pi))` THEN + MP_TAC(SPEC `(x + pi) / (&2 * pi)` FLOOR) THEN + ABBREV_TAC `k = floor((x + pi) / (&2 * pi))` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `&0 < &2 * pi` ASSUME_TAC THENL + [MP_TAC PI_POS THEN REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPECL [`k:real`; `(x + pi) / (&2 * pi)`; + `&2 * pi`] REAL_LE_RMUL) THEN + MP_TAC(ISPECL [`(x + pi) / (&2 * pi)`; `k + &1`; + `&2 * pi`] REAL_LT_RMUL) THEN + ASM_SIMP_TAC[REAL_DIV_RMUL; REAL_LT_IMP_NZ; REAL_LT_IMP_LE] THEN + REAL_ARITH_TAC);; + +(* --- Helper: the union over all integer 2*pi-translates of a negligible *) +(* set *) +(* is negligible (countable union of translates). --- *) +let REAL_NEGLIGIBLE_TRANSLATE_UNION = prove + (`!s. real_negligible s + ==> real_negligible {x | ?k. integer k /\ (x - k * (&2 * pi)) IN s}`, + GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_NEGLIGIBLE_SUBSET THEN + EXISTS_TAC + `UNIONS {IMAGE (\y:real. (&n * (&2 * pi)) + y) s UNION + IMAGE (\y:real. ((-- &n) * (&2 * pi)) + y) s | n IN (:num)}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_NEGLIGIBLE_COUNTABLE_UNIONS THEN + X_GEN_TAC `n:num` THEN MATCH_MP_TAC REAL_NEGLIGIBLE_UNION THEN + CONJ_TAC THEN MATCH_MP_TAC REAL_NEGLIGIBLE_TRANSLATION THEN + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_UNIONS] THEN + X_GEN_TAC `x:real` THEN STRIP_TAC THEN + FIRST_X_ASSUM(DISJ_CASES_THEN (X_CHOOSE_TAC `n:num`) o + REWRITE_RULE[INTEGER_CASES]) THEN + EXISTS_TAC + `IMAGE (\y:real. (&n * (&2 * pi)) + y) s UNION + IMAGE (\y:real. ((-- &n) * (&2 * pi)) + y) s` THEN + (CONJ_TAC THENL [MESON_TAC[IN_UNIV]; ALL_TAC]) THEN + REWRITE_TAC[IN_UNION; IN_IMAGE] THENL + [DISJ1_TAC; DISJ2_TAC] THEN + EXISTS_TAC `x - k * (&2 * pi)` THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC]);; + +(* For a representative x in (-pi,pi) *) +(* off the origin, the continuous-sinc a.e. limit gives the discrete *) +(* sine-kernel T_n(x) -> 0 (WINDOW_BRIDGE_POS/NEG + TN_ZERO). *) +let TN_ZERO_REP = prove + (`!(f:real->real) x. + f absolutely_real_integrable_on real_interval[--pi,pi] /\ + (!y. f(y + &2 * pi) = f y) /\ + --pi < x /\ x < pi /\ ~(x = &0) /\ + ((\a. real_integral (real_interval[--pi,pi]) + (\t. sin(a * (x - t)) / (x - t) * f t)) ---> pi * f x) + at_posinfinity + ==> ((\n. real_integral (real_interval[&0,pi]) + (\u. sin((&n + &1 / &2) * u) * + ((f(x + u) + f(x - u)) - &2 * f x) / u)) ---> &0) + sequentially`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC TN_ZERO THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH + `~(x = &0) ==> &0 < x \/ x < &0`)) THENL + [MATCH_MP_TAC WINDOW_BRIDGE_POS THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC WINDOW_BRIDGE_NEG THEN ASM_REWRITE_TAC[]]);; + +(* 286V: continuous sinc to discrete sine kernel (Fremlin 286V *) +(* lines 3099-3131): the bounded correction p_x(t)=(1/(2sin(t/2))-1/t)f(x-t) *) +(* is integrable, so by Riemann-Lebesgue the continuous sinc limit implies *) +(* the discrete sine-kernel limit fed to CARLESON_286V_FROM_SINEKERNEL. *) +(* The continuous-sinc hypothesis is guarded to the fundamental domain *) +(* --pi < x < pi (Fremlin's "this is where we need to know that |x| 0, not f(x)); the discrete *) +(* conclusion is extended to all x by 2*pi-periodicity of T_n *) +(* (representative reduction + DISCRETE_KERNEL_PERIODIC_MULT). *) +let CARLESON_286V_CONTINUOUS_TO_DISCRETE = prove + (`!f. f square_integrable_on real_interval[--pi,pi] /\ + (!x. f(x + &2 * pi) = f x) /\ + (?s. real_negligible s /\ + !x. --pi < x /\ x < pi /\ ~(x IN s) + ==> ((\a. inv(pi) * + real_integral (real_interval[--pi,pi]) + (\t. sin(a * (x - t)) / (x - t) * f t)) + ---> f x) at_posinfinity) + ==> (?s. real_negligible s /\ + !x. ~(x IN s) + ==> ((\n. real_integral (real_interval[&0,pi]) + (\u. sin((&n + &1 / &2) * u) * + ((f(x + u) + f(x - u)) - &2 * f x) / u)) + ---> &0) sequentially)`, + GEN_TAC THEN STRIP_TAC THEN + EXISTS_TAC + `{x | ?k. integer k /\ (x - k * (&2 * pi)) IN (s UNION {--pi, &0})}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_NEGLIGIBLE_TRANSLATE_UNION THEN + MATCH_MP_TAC REAL_NEGLIGIBLE_UNION THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_NEGLIGIBLE_COUNTABLE THEN + SIMP_TAC[COUNTABLE_INSERT; COUNTABLE_SING]; + ALL_TAC] THEN + REWRITE_TAC[IN_ELIM_THM; NOT_EXISTS_THM] THEN + X_GEN_TAC `x:real` THEN DISCH_TAC THEN + X_CHOOSE_THEN `k:real` STRIP_ASSUME_TAC (SPEC `x:real` REAL_REP_MOD_2PI) THEN + ABBREV_TAC `r = x - k * (&2 * pi)` THEN + FIRST_X_ASSUM(MP_TAC o SPEC `k:real`) THEN + ASM_REWRITE_TAC[IN_UNION; IN_INSERT; NOT_IN_EMPTY; DE_MORGAN_THM] THEN + STRIP_TAC THEN + SUBGOAL_THEN `x = r + k * (&2 * pi)` SUBST1_TAC THENL + [EXPAND_TAC "r" THEN REAL_ARITH_TAC; ALL_TAC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[REAL_PERIODIC_INTEGER_MULTIPLE]) THEN + SUBGOAL_THEN + `!n. real_integral (real_interval[&0,pi]) + (\u. sin((&n + &1 / &2) * u) * + ((f((r + k * (&2 * pi)) + u) + f((r + k * (&2 * pi)) - u)) - + &2 * f(r + k * (&2 * pi))) / u) = + real_integral (real_interval[&0,pi]) + (\u. sin((&n + &1 / &2) * u) * + ((f(r + u) + f(r - u)) - &2 * f r) / u)` + (fun th -> REWRITE_TAC[th]) THENL + [GEN_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_EQ THEN + X_GEN_TAC `u:real` THEN DISCH_TAC THEN + SUBGOAL_THEN + `f((r + k * (&2 * pi)) + u) = f(r + u) /\ + f((r + k * (&2 * pi)) - u) = f(r - u) /\ + f(r + k * (&2 * pi)):real = f r` + (fun th -> REWRITE_TAC[th]) THEN + REPEAT CONJ_TAC THEN + ONCE_REWRITE_TAC[REAL_ARITH + `(r + k * (&2 * pi)) + u:real = (r + u) + k * (&2 * pi)`; + REAL_ARITH `(r + k * (&2 * pi)) - u:real = (r - u) + k * (&2 * pi)`] THEN + ASM_SIMP_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC TN_ZERO_REP THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC SQUARE_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE THEN + ASM_REWRITE_TAC[REAL_MEASURABLE_REAL_INTERVAL]; + REWRITE_TAC[REAL_PERIODIC_INTEGER_MULTIPLE] THEN ASM_REWRITE_TAC[]; + ASM_REAL_ARITH_TAC; + ASM_REAL_ARITH_TAC; + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `!a. real_integral (real_interval[--pi,pi]) + (\t. sin(a * (r - t)) / (r - t) * f t) = + pi * (inv(pi) * real_integral (real_interval[--pi,pi]) + (\t. sin(a * (r - t)) / (r - t) * f t))` + (fun th -> ONCE_REWRITE_TAC[th]) THENL + [GEN_TAC THEN MP_TAC PI_POS THEN CONV_TAC REAL_FIELD; ALL_TAC] THEN + SUBGOAL_THEN + `((\a. inv pi * real_integral (real_interval[--pi,pi]) + (\t. sin(a * (r - t)) / (r - t) * f t)) ---> f r) at_posinfinity` + (MP_TAC o BETA_RULE o SPEC `pi` o MATCH_MP REALLIM_LMUL) THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[]]);; + +(* Continuous-sinc convergence a.e. implies Fourier-series convergence a.e. *) +(* The continuous-sinc hypothesis is on the fundamental domain --pi ((\a. inv(pi) * + real_integral (real_interval[--pi,pi]) + (\t. sin(a * (x - t)) / (x - t) * f t)) + ---> f x) at_posinfinity) + ==> ?s. real_negligible s /\ + !x. ~(x IN s) + ==> ((\n. sum(0..n) (\k. fourier_coefficient f k * + trigonometric_set k x)) + ---> f x) sequentially`, + GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC CARLESON_286V_FROM_SINEKERNEL THEN + FIRST_ASSUM(CONJUNCTS_THEN ASSUME_TAC) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC CARLESON_286V_CONTINUOUS_TO_DISCRETE THEN + ASM_REWRITE_TAC[]);; + +(* --- 286V-front sinc-kernel FT keystone (Fremlin 286V line 3072): the *) +(* window *) +(* function h_ax(y) = e^{ixy} on |y|<=a has FT hhat_ax(t) = (1/sqrt2pi) 2 *) +(* sin *) +(* ((x-t)a)/(x-t); the underlying integral is int_{[-a,a]} e^{i c y} dy = *) +(* 2 sin(a c)/c (c = x-t =/= 0), via the complex FTC (antiderivative *) +(* e^{icy}/(ic) *) +(* = CEXP_IB_VECTOR_DERIV) + the endpoint combination CEXP_ENDPOINT_ID. This *) +(* is *) +(* the concrete calc behind = (284Ob) in the 286V *) +(* descent. *) +let CARLESON_SINC_KERNEL_INTEGRAL = prove + (`!a c. &0 <= a /\ ~(c = &0) + ==> ((\y. cexp(ii * Cx c * Cx(drop y))) has_integral Cx(&2 * sin(a * c) / + c)) + (interval[lift(--a), lift a])`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`\y. cexp(ii * Cx c * Cx(drop y)) / (ii * Cx c)`; + `\y. cexp(ii * Cx c * Cx(drop y))`; + `lift(--a)`; `lift a`] FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN + REWRITE_TAC[LIFT_DROP] THEN ANTS_TAC THENL + [CONJ_TAC THENL + [REWRITE_TAC[LIFT_DROP] THEN ASM_REAL_ARITH_TAC; + REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_AT_WITHIN THEN + MP_TAC(ISPECL [`c:real`; `x:real^1`] CEXP_IB_VECTOR_DERIV) THEN + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + REWRITE_TAC[LIFT_DROP] THEN + MATCH_MP_TAC(MESON[] `x = y ==> (f has_integral x) s ==> (f has_integral y) + s`) THEN + MP_TAC(ISPECL [`a:real`; `c:real`] CEXP_ENDPOINT_ID) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[LIFT_DROP] THEN + MATCH_MP_TAC(MESON[] `p = r /\ q = s ==> p/w - q/w = r/w - s/w`) THEN + CONJ_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[CX_NEG] THEN + SIMPLE_COMPLEX_ARITH_TAC);; + +(* --- 286V-front: the window h_ax(y) = e^{ixy} on |y|<=a (0 outside), and *) +(* its *) +(* Fourier transform hhat_ax(t) = (1/sqrt2pi) 2 sin(a(x-t))/(x-t) (x =/= t). *) +(* First the raw integral int_R e^{-ity}h_ax = 2sin(a(x-t))/(x-t) [restrict *) +(* to *) +(* [-a,a] + combine exponents + CARLESON_SINC_KERNEL_INTEGRAL], then the *) +(* fourier *) +(* normalisation. --- *) +let CARLESON_HAX_FT_INTEGRAL = prove + (`!a x t. &0 <= a /\ ~(x - t = &0) + ==> integral (:real^1) + (\y. cexp(--(ii * Cx t * Cx(drop y))) * + (if abs(drop y) <= a then cexp(ii * Cx x * Cx(drop y)) else + Cx(&0))) = + Cx(&2 * sin(a * (x - t)) / (x - t))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN + SUBGOAL_THEN + `(\y. cexp(--(ii * Cx t * Cx(drop y))) * + (if abs(drop y) <= a then cexp(ii * Cx x * Cx(drop y)) else Cx(&0))) = + (\y. if y IN interval[lift(--a),lift a] + then cexp(ii * Cx(x - t) * Cx(drop y)) else vec 0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `y:real^1` THEN + REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; COMPLEX_VEC_0] THEN + REWRITE_TAC[REAL_ARITH `--a <= drop y /\ drop y <= a <=> abs(drop y) <= a`] + THEN + COND_CASES_TAC THEN REWRITE_TAC[COMPLEX_MUL_RZERO] THEN + REWRITE_TAC[GSYM CEXP_ADD] THEN AP_TERM_TAC THEN + REWRITE_TAC[CX_SUB] THEN SIMPLE_COMPLEX_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[HAS_INTEGRAL_RESTRICT_UNIV] THEN + MATCH_MP_TAC CARLESON_SINC_KERNEL_INTEGRAL THEN ASM_REWRITE_TAC[]);; + +let CARLESON_HAX_FT = prove + (`!a x t. &0 <= a /\ ~(x - t = &0) + ==> fourier (\y. if abs y <= a then cexp(ii * Cx x * Cx y) else Cx(&0)) t + = + Cx(inv(sqrt(&2 * pi))) * Cx(&2 * sin(a * (x - t)) / (x - t))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[fourier] THEN + MP_TAC(ISPECL [`a:real`; `x:real`; `t:real`] CARLESON_HAX_FT_INTEGRAL) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[GSYM CX_INV; complex_div; COMPLEX_MUL_LID]);; + +(* ------------------------------------------------------------------------- *) +(* Window-function infrastructure for the 286V sinc computation. The window *) +(* h_ax(y) = e^{ixy} on |y|<=a, 0 elsewhere, is bounded (modulus 1) with *) +(* compact support, hence both L^1 (HAX_ABSINT) and L^2 (HAX_L2). *) +(* ------------------------------------------------------------------------- *) + +let CEXP_LINEAR_CONTINUOUS = prove + (`!c:complex s:real^1->bool. (\z. cexp(c * Cx(drop z))) continuous_on s`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN + REWRITE_TAC[CONTINUOUS_ON_CONST] THEN + MATCH_MP_TAC CONTINUOUS_ON_CX_DROP THEN REWRITE_TAC[CONTINUOUS_ON_ID]; + REWRITE_TAC[CONTINUOUS_ON_CEXP]]);; + +let NORM_CEXP_II_XY = prove + (`!x y:real. norm(cexp(ii * Cx x * Cx y)) = &1`, + REPEAT GEN_TAC THEN REWRITE_TAC[NORM_CEXP] THEN + SUBGOAL_THEN `ii * Cx x * Cx y = ii * Cx(x * y)` SUBST1_TAC THENL + [REWRITE_TAC[CX_MUL] THEN SIMPLE_COMPLEX_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[RE_MUL_II; IM_CX; REAL_NEG_0; REAL_EXP_0]);; + +(* ------------------------------------------------------------------------- *) +(* Sinc L^2 domination: sin(a u)^2 / u^2 <= (2 a^2 + 2) inv(1+u^2) (u<>0); *) +(* the pointwise bound making fourier h_ax square-integrable (dominator *) +(* inv(1+u^2) is INV_SQ_REAL_INTEGRABLE). *) +(* ------------------------------------------------------------------------- *) + +let SINC_SQ_DOMINATION = prove + (`!a u:real. ~(u = &0) + ==> sin(a * u) pow 2 / u pow 2 <= (&2 * a pow 2 + &2) * inv(&1 + u pow + 2)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&0 < u pow 2` ASSUME_TAC THENL + [REWRITE_TAC[REAL_LT_LE; REAL_LE_POW_2] THEN + CONV_TAC(RAND_CONV SYM_CONV) THEN REWRITE_TAC[REAL_POW_EQ_0] THEN + ASM_REWRITE_TAC[ARITH]; ALL_TAC] THEN + SUBGOAL_THEN `&0 < &1 + u pow 2` ASSUME_TAC THENL + [MP_TAC(SPEC `u:real` REAL_LE_POW_2) THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `sin(a * u) pow 2 <= &1` ASSUME_TAC THENL + [MP_TAC(SPEC `a * u:real` SIN_BOUND) THEN DISCH_TAC THEN + SUBGOAL_THEN `sin(a * u) pow 2 <= (&1) pow 2` MP_TAC THENL + [ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN + REWRITE_TAC[GSYM REAL_LE_SQUARE_ABS] THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[REAL_POW_ONE]]; ALL_TAC] THEN + SUBGOAL_THEN `sin(a * u) pow 2 <= a pow 2 * u pow 2` ASSUME_TAC THENL + [MP_TAC(SPEC `a * u:real` REAL_ABS_SIN_BOUND_LE) THEN DISCH_TAC THEN + SUBGOAL_THEN `sin(a * u) pow 2 <= (a * u) pow 2` MP_TAC THENL + [ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN + REWRITE_TAC[GSYM REAL_LE_SQUARE_ABS] THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[REAL_POW_MUL]]; ALL_TAC] THEN + SUBGOAL_THEN + `sin(a * u) pow 2 * (&1 + u pow 2) <= (&2 * a pow 2 + &2) * u pow 2` + ASSUME_TAC THENL + [ASM_CASES_TAC `u pow 2 <= &1` THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(a pow 2 * u pow 2) * (&1 + u pow 2)` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_RMUL THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(a pow 2 * u pow 2) * &2` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_LE_POW_2]; + ASM_REAL_ARITH_TAC]; + MP_TAC(SPEC `a:real` REAL_LE_POW_2) THEN + MP_TAC(SPEC `u:real` REAL_LE_POW_2) THEN REAL_ARITH_TAC]]; + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&1 * (&1 + u pow 2)` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_RMUL THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC; + SUBGOAL_THEN `&0 <= a pow 2 * u pow 2` MP_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN + REWRITE_TAC[REAL_LE_POW_2]; ALL_TAC] THEN + MP_TAC(SPEC `u:real` REAL_LE_POW_2) THEN ASM_REAL_ARITH_TAC]]; + ALL_TAC] THEN + SUBGOAL_THEN + `sin(a * u) pow 2 / u pow 2 = + (sin(a * u) pow 2 * (&1 + u pow 2)) / (u pow 2 * (&1 + u pow 2))` + SUBST1_TAC THENL + [MP_TAC(ASSUME `&0 < u pow 2`) THEN MP_TAC(ASSUME `&0 < &1 + u pow 2`) THEN + CONV_TAC REAL_FIELD; ALL_TAC] THEN + SUBGOAL_THEN + `(&2 * a pow 2 + &2) * inv(&1 + u pow 2) = + ((&2 * a pow 2 + &2) * u pow 2) / (u pow 2 * (&1 + u pow 2))` + SUBST1_TAC THENL + [MP_TAC(ASSUME `&0 < u pow 2`) THEN MP_TAC(ASSUME `&0 < &1 + u pow 2`) THEN + CONV_TAC REAL_FIELD; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LE_DIV2_EQ; REAL_LT_MUL]);; + +let HAX_ABSINT = prove + (`!a x:real. + (\z:real^1. if abs(drop z) <= a then cexp(ii * Cx x * Cx(drop z)) else + Cx(&0)) + absolutely_integrable_on (:real^1)`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN + `(\z:real^1. if abs(drop z) <= a then cexp(ii * Cx x * Cx(drop z)) else + Cx(&0)) = + (\z:real^1. if z IN interval[lift(--a),lift a] + then cexp((ii * Cx x) * Cx(drop z)) else vec 0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `z:real^1` THEN + REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP; COMPLEX_VEC_0; + COMPLEX_MUL_ASSOC] THEN + REWRITE_TAC[REAL_ARITH `--a <= drop z /\ drop z <= a <=> abs(drop z) <= + a`]; + ALL_TAC] THEN + REWRITE_TAC[ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV] THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_CONTINUOUS THEN + REWRITE_TAC[CEXP_LINEAR_CONTINUOUS]);; + +let HAX_L2 = prove + (`!a x:real. + (\z:real^1. if abs(drop z) <= a then cexp(ii * Cx x * Cx(drop z)) else + Cx(&0)) + IN lspace (:real^1) (&2)`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN + `!z:real^1. norm(if abs(drop z) <= a then cexp(ii * Cx x * Cx(drop z)) else + Cx(&0)) + <= &1` + ASSUME_TAC THENL + [GEN_TAC THEN COND_CASES_TAC THEN + REWRITE_TAC[NORM_CEXP_II_XY; REAL_LE_REFL; COMPLEX_NORM_CX; REAL_ABS_NUM; + REAL_POS]; + ALL_TAC] THEN + REWRITE_TAC[lspace; IN_ELIM_THM] THEN CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_IMP_MEASURABLE THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + REWRITE_TAC[HAX_ABSINT]; + ALL_TAC] THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE THEN + EXISTS_TAC + `\z:real^1. lift(norm(if abs(drop z) <= a then cexp(ii * Cx x * Cx(drop z)) + else Cx(&0)))` THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_ON_LIFT_RPOW THEN + REWRITE_TAC[REAL_ARITH `&0 < &2`] THEN + MATCH_MP_TAC MEASURABLE_ON_NORM THEN + MATCH_MP_TAC INTEGRABLE_IMP_MEASURABLE THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + REWRITE_TAC[HAX_ABSINT]; + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN REWRITE_TAC[HAX_ABSINT]; + X_GEN_TAC `w:real^1` THEN DISCH_TAC THEN + REWRITE_TAC[NORM_LIFT; LIFT_DROP; RPOW_POW] THEN + SUBGOAL_THEN + `abs(norm(if abs(drop w) <= a then cexp(ii * Cx x * Cx(drop w)) else + Cx(&0)) pow 2) = + norm(if abs(drop w) <= a then cexp(ii * Cx x * Cx(drop w)) else Cx(&0)) + pow 2` + SUBST1_TAC THENL + [REWRITE_TAC[REAL_ABS_REFL] THEN MATCH_MP_TAC REAL_POW_LE THEN + REWRITE_TAC[NORM_POS_LE]; ALL_TAC] THEN + SUBGOAL_THEN + `norm(if abs(drop w) <= a then cexp(ii * Cx x * Cx(drop w)) else Cx(&0)) + pow 2 = + norm(if abs(drop w) <= a then cexp(ii * Cx x * Cx(drop w)) else Cx(&0)) * + norm(if abs(drop w) <= a then cexp(ii * Cx x * Cx(drop w)) else Cx(&0))` + SUBST1_TAC THENL [REWRITE_TAC[REAL_POW_2]; ALL_TAC] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[NORM_POS_LE]]);; + +(* ------------------------------------------------------------------------- *) +(* Pointwise square-norm bound for the window transform: |fourier h_ax(t)|^2 *) +(* <= inv(2pi) 4 (2a^2+2) inv(1+(x-t)^2) for t <> x (CARLESON_HAX_FT + *) +(* SINC_SQ_DOMINATION). The integrable dominator giving fourier h_ax in L^2. *) +(* ------------------------------------------------------------------------- *) +let HAX_FT_NORMSQ_BOUND = prove + (`!a x t:real. &0 <= a /\ ~(x - t = &0) + ==> norm(fourier (\y. if abs y <= a then cexp(ii * Cx x * Cx y) else + Cx(&0)) t) pow 2 + <= inv(&2 * pi) * &4 * (&2 * a pow 2 + &2) * inv(&1 + (x - t) pow 2)`, +REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `norm(fourier (\y. if abs y <= a then cexp(ii * Cx x * Cx y) else Cx(&0)) t) + pow 2 = + inv(&2 * pi) * (&4 * (sin(a * (x - t)) pow 2 / (x - t) pow 2))` + SUBST1_TAC THENL + [MP_TAC(ISPECL [`a:real`; `x:real`; `t:real`] CARLESON_HAX_FT) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX; REAL_POW_MUL; + REAL_POW2_ABS] THEN + SUBGOAL_THEN `inv(sqrt(&2 * pi)) pow 2 = inv(&2 * pi)` SUBST1_TAC THENL + [REWRITE_TAC[GSYM REAL_POW_INV; REAL_POW_2; GSYM REAL_INV_MUL] THEN + AP_TERM_TAC THEN MP_TAC(SPEC `&2 * pi` SQRT_POW_2) THEN + SIMP_TAC[REAL_LE_MUL; REAL_POS; PI_POS_LE; REAL_LT_IMP_LE; + REAL_POW_2] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN REFL_TAC; + AP_TERM_TAC THEN REWRITE_TAC[REAL_POW_DIV; REAL_POW_MUL] THEN + REWRITE_TAC[REAL_ARITH `&2 pow 2 = &4`]]; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < inv(&2 * pi)` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LT_INV THEN MP_TAC PI_POS THEN + REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_ARITH `inv(&2*pi) * (&4 * bc) = (&4 * bc) * inv(&2*pi)`; + REAL_ARITH `inv(&2*pi) * &4 * b * c = (&4 * (b * c)) * + inv(&2*pi)`] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [REAL_ARITH_TAC; + MP_TAC(ISPECL [`a:real`; `x - t:real`] SINC_SQ_DOMINATION) THEN + ASM_REWRITE_TAC[]]; + ASM_SIMP_TAC[REAL_LT_IMP_LE]]);; + +(* ------------------------------------------------------------------------- *) +(* The inv(1+(x-t)^2) dominator (times a constant), integrable over the line *) +(* -- a translate of DOMINATOR_SQ_INTEGRABLE (INTEGRABLE_TRANSLATION). *) +(* ------------------------------------------------------------------------- *) + +let SINC_DOMINATOR_INTEGRABLE = prove + (`!x C:real. (\z:real^1. lift(C * inv(&1 + (x - drop z) pow 2))) integrable_on + (:real^1)`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN + `(\z:real^1. lift(C * inv(&1 + (x - drop z) pow 2))) = + (\z:real^1. (\w:real^1. lift((&2 * (C / &2)) * inv(&1 + drop w pow 2))) + (--(lift x) + z))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `z:real^1` THEN + BETA_TAC THEN REWRITE_TAC[DROP_ADD; DROP_NEG; LIFT_DROP] THEN + AP_TERM_TAC THEN + SUBGOAL_THEN `&2 * C / &2 = C` SUBST1_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + MP_TAC(SPECL [`x:real`; `drop z`] + (REAL_RING `!x dz:real. (--x + dz) pow 2 = (x - dz) pow 2`)) THEN + REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN REFL_TAC; + ALL_TAC] THEN + REWRITE_TAC[INTEGRABLE_TRANSLATION] THEN + SUBGOAL_THEN + `IMAGE (\z:real^1. --(lift x) + z) (:real^1) = (:real^1)` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_UNIV] THEN + X_GEN_TAC `w:real^1` THEN EXISTS_TAC `lift x + w:real^1` THEN + VECTOR_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[DOMINATOR_SQ_INTEGRABLE]);; + +(* ------------------------------------------------------------------------- *) +(* fourier h_ax IN L^2: continuous (FOURIER_CONTINUOUS_ON) => measurable, *) +(* and *) +(* |fourier h_ax|^2 dominated a.e. by the integrable sinc dominator *) +(* (HAX_FT_NORMSQ_BOUND off the single point t=x). *) +(* ------------------------------------------------------------------------- *) + +let HAX_FT_L2 = prove + (`!a x:real. &0 <= a + ==> (\z:real^1. fourier (\y. if abs y <= a then cexp(ii * Cx x * Cx y) + else Cx(&0)) + (drop z)) + IN lspace (:real^1) (&2)`, +REPEAT STRIP_TAC THEN + ABBREV_TAC `Fh = \z:real^1. fourier (\y. if abs y <= a then cexp(ii * Cx x * + Cx y) + else Cx(&0)) (drop z)` THEN + SUBGOAL_THEN `(Fh:real^1->complex) continuous_on (:real^1)` ASSUME_TAC THENL + [EXPAND_TAC "Fh" THEN MATCH_MP_TAC FOURIER_CONTINUOUS_ON THEN + REWRITE_TAC[ETA_AX; HAX_ABSINT]; ALL_TAC] THEN + SUBGOAL_THEN `(Fh:real^1->complex) measurable_on (:real^1)` ASSUME_TAC THENL + [MATCH_MP_TAC CONTINUOUS_IMP_MEASURABLE_ON THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[lspace; IN_ELIM_THM] THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE_AE + THEN + EXISTS_TAC `\z:real^1. lift((inv(&2 * pi) * &4 * (&2 * a pow 2 + &2)) * + inv(&1 + (x - drop z) pow 2))` THEN + EXISTS_TAC `{lift x}` THEN + REWRITE_TAC[NEGLIGIBLE_SING] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_ON_LIFT_RPOW THEN + REWRITE_TAC[REAL_ARITH `&0 < &2`] THEN + MATCH_MP_TAC MEASURABLE_ON_NORM THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[SINC_DOMINATOR_INTEGRABLE]; + X_GEN_TAC `z:real^1` THEN REWRITE_TAC[IN_DIFF; IN_UNIV; IN_SING] THEN + DISCH_TAC THEN REWRITE_TAC[NORM_LIFT; LIFT_DROP; RPOW_POW] THEN + ABBREV_TAC `N = norm((Fh:real^1->complex) z)` THEN + SUBGOAL_THEN `~(x - drop z = &0)` ASSUME_TAC THENL + [REWRITE_TAC[REAL_SUB_0] THEN DISCH_TAC THEN + UNDISCH_TAC `~(z:real^1 = lift x)` THEN REWRITE_TAC[] THEN + REWRITE_TAC[GSYM LIFT_DROP] THEN + ASM_REWRITE_TAC[LIFT_DROP; LIFT_EQ]; ALL_TAC] THEN + REWRITE_TAC[real_abs] THEN COND_CASES_TAC THENL + [EXPAND_TAC "N" THEN EXPAND_TAC "Fh" THEN + MP_TAC(ISPECL [`a:real`; `x:real`; `drop z`] HAX_FT_NORMSQ_BOUND) THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_MUL_ASSOC]; + POP_ASSUM MP_TAC THEN MP_TAC(SPEC `N:real` REAL_LE_POW_2) THEN + REAL_ARITH_TAC]]);; + +(* ------------------------------------------------------------------------- *) +(* fourier h_ax represents the Fourier transform of h_ax (h_ax is L^1, so *) +(* this is just the multiplication formula 283O with a Schwartz test fn). *) +(* ------------------------------------------------------------------------- *) + +let HAX_REPS = prove + (`!a x:real. !k. schwartz k + ==> integral (:real^1) + (\z. fourier (\y. if abs y <= a then cexp(ii * Cx x * Cx y) else + Cx(&0)) + (drop z) * k(drop z)) = + integral (:real^1) + (\z. (\y. if abs y <= a then cexp(ii * Cx x * Cx y) else Cx(&0)) + (drop z) * + fourier k (drop z))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`\y. if abs y <= a then cexp(ii * Cx x * Cx y) else Cx(&0)`; + `k:real->complex`] + FOURIER_283O) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [REWRITE_TAC[ETA_AX] THEN + MP_TAC(ISPECL [`a:real`; `x:real`] HAX_ABSINT) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM]; + MATCH_MP_TAC SCHWARTZ_ABSINT THEN ASM_REWRITE_TAC[]]; + DISCH_THEN(SUBST1_TAC o SYM) THEN REFL_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* unfolds to the truncated integral INT_{[-a,a]} e^{-ixy} g(y) dy *) +(* (cnj of the window puts a minus in the exponent). *) +(* ------------------------------------------------------------------------- *) + +let LPRODUCT_G_HAX = prove + (`!a x:real g:real^1->complex. &0 <= a + ==> lproduct (:real^1) g + (\z. if abs(drop z) <= a then cexp(ii * Cx x * Cx(drop z)) else + Cx(&0)) = + integral (:real^1) + (\z. if abs(drop z) <= a then g z * cexp(--(ii * Cx x * Cx(drop z))) + else Cx(&0))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[lproduct] THEN + MATCH_MP_TAC INTEGRAL_EQ THEN X_GEN_TAC `z:real^1` THEN DISCH_TAC THEN + REWRITE_TAC[] THEN COND_CASES_TAC THEN + REWRITE_TAC[CNJ_CX; COMPLEX_MUL_RZERO] THEN + AP_TERM_TAC THEN REWRITE_TAC[CNJ_CEXP] THEN AP_TERM_TAC THEN + REWRITE_TAC[CNJ_MUL; CNJ_II; CNJ_CX] THEN SIMPLE_COMPLEX_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* If p = q a.e. then = INT f * cnj q: the second slot of the inner *) +(* product depends only on the a.e.-class (INTEGRAL_SPIKE). *) +(* ------------------------------------------------------------------------- *) + +let FOURIER_L2_UNIQUE = prove + (`!g1 g2:real^1->complex. + g1 IN lspace (:real^1) (&2) /\ g2 IN lspace (:real^1) (&2) /\ + (!h. schwartz h + ==> integral (:real^1) (\z. g1 z * h(drop z)) = + integral (:real^1) (\z. g2 z * h(drop z))) + ==> negligible {x | ~(g1 x = g2 x)}`, + REPEAT STRIP_TAC THEN + ABBREV_TAC `d = \x:real^1. (g1:real^1->complex) x - g2 x` THEN + SUBGOAL_THEN `(d:real^1->complex) IN lspace (:real^1) (&2)` ASSUME_TAC THENL + [EXPAND_TAC "d" THEN MATCH_MP_TAC LSPACE_SUB THEN ASM_REWRITE_TAC[REAL_POS]; + ALL_TAC] THEN + SUBGOAL_THEN + `!h. schwartz h + ==> integral (:real^1) (\z. (d:real^1->complex) z * h(drop z)) = + Cx(&0)` + (LABEL_TAC "DZERO") THENL + [X_GEN_TAC `h:real->complex` THEN DISCH_TAC THEN EXPAND_TAC "d" THEN + SUBGOAL_THEN + `(\z:real^1. ((g1:real^1->complex) z - g2 z) * h(drop z)) = + (\z. g1 z * h(drop z) - g2 z * h(drop z))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN SIMPLE_COMPLEX_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `(\z:real^1. cnj(h(drop z))) IN lspace (:real^1) (&2)` ASSUME_TAC THENL + [MATCH_MP_TAC LSPACE_CNJ THEN MATCH_MP_TAC SCHWARTZ_L2 THEN + ASM_REWRITE_TAC[ETA_AX]; ALL_TAC] THEN + SUBGOAL_THEN + `(\z:real^1. (g1:real^1->complex) z * h(drop z)) integrable_on (:real^1) + /\ + (\z:real^1. (g2:real^1->complex) z * h(drop z)) integrable_on (:real^1)` + STRIP_ASSUME_TAC THENL + [CONJ_TAC THEN + MP_TAC(ISPECL [`(:real^1)`; `g1:real^1->complex`; + `\z:real^1. cnj(h(drop z))`] + L2_CNJ_PRODUCT_INTEGRABLE) THEN + MP_TAC(ISPECL [`(:real^1)`; `g2:real^1->complex`; + `\z:real^1. cnj(h(drop z))`] + L2_CNJ_PRODUCT_INTEGRABLE) THEN + ASM_REWRITE_TAC[CNJ_CNJ]; + ASM_SIMP_TAC[INTEGRAL_SUB] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `h:real->complex`) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[COMPLEX_SUB_REFL]]; + ALL_TAC] THEN + MP_TAC(ISPEC `\x:real^1. cnj((d:real^1->complex) x)` SCHWARTZ_SEQ) THEN + ASM_SIMP_TAC[LSPACE_CNJ] THEN + DISCH_THEN(X_CHOOSE_THEN `kn:num->real->complex` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `lproduct (:real^1) (d:real^1->complex) d = Cx(&0)` ASSUME_TAC THENL + [MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN + EXISTS_TAC + `\n. lproduct (:real^1) d (\z:real^1. cnj((kn:num->real->complex) n (drop + z)))` THEN + REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN CONJ_TAC THENL + [MATCH_MP_TAC LPRODUCT_L2LIM_RSLOT THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC LSPACE_CNJ THEN + MATCH_MP_TAC SCHWARTZ_L2 THEN ASM_SIMP_TAC[ETA_AX]; + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(SPEC `e:real` REAL_ARCH_INV) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `N:num` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + SUBGOAL_THEN + `lnorm (:real^1) (&2) (\x. cnj((kn:num->real->complex) n (drop x)) - d + x) = + lnorm (:real^1) (&2) (\x. cnj(d x) - kn n (drop x))` + SUBST1_TAC THENL + [REWRITE_TAC[lnorm] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:real^1` THEN + AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + GEN_REWRITE_TAC LAND_CONV [GSYM COMPLEX_NORM_CNJ] THEN + REWRITE_TAC[CNJ_SUB; CNJ_CNJ] THEN REWRITE_TAC[NORM_SUB]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `inv(&n + &1)` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `inv(&N)` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INV2 THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_LT] THEN ASM_ARITH_TAC; + RULE_ASSUM_TAC(REWRITE_RULE[GE; GSYM REAL_OF_NUM_LE]) THEN + ASM_REAL_ARITH_TAC]; + ASM_SIMP_TAC[REAL_LT_IMP_LE]]]; + SUBGOAL_THEN + `!n. lproduct (:real^1) (d:real^1->complex) + (\z. cnj((kn:num->real->complex) n (drop z))) = Cx(&0)` + (fun th -> REWRITE_TAC[th; LIM_CONST]) THEN + GEN_TAC THEN REWRITE_TAC[lproduct; CNJ_CNJ] THEN + REMOVE_THEN "DZERO" MATCH_MP_TAC THEN ASM_SIMP_TAC[ETA_AX]]; + ALL_TAC] THEN + SUBGOAL_THEN `lnorm (:real^1) (&2) (d:real^1->complex) = &0` MP_TAC THENL + [SUBGOAL_THEN + `(\x:real^1. lift(norm((d:real^1->complex) x) pow 2)) integrable_on + (:real^1)` + ASSUME_TAC THENL + [MP_TAC(ISPECL [`(:real^1)`; `&2`; + `d:real^1->complex`] LSPACE_IMP_INTEGRABLE) THEN + ASM_REWRITE_TAC[RPOW_POW]; ALL_TAC] THEN + SUBGOAL_THEN + `(lnorm (:real^1) (&2) (d:real^1->complex)) pow 2 = &0` MP_TAC THENL + [MP_TAC(ISPECL [`d:real^1->complex`] LNORM2_SQ) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN SUBST1_TAC THEN + MP_TAC(ISPECL [`(:real^1)`; `d:real^1->complex`] LPRODUCT_SELF) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o AP_TERM `Re`) THEN + REWRITE_TAC[RE_CX] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[RE_CX]; + REWRITE_TAC[REAL_POW_EQ_0] THEN SIMP_TAC[]]; + ALL_TAC] THEN + MP_TAC(ISPECL [`(:real^1)`; `&2`; `d:real^1->complex`] LNORM_EQ_0) THEN + ASM_REWRITE_TAC[REAL_ARITH `~(&2 = &0)`] THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_UNIV] THEN + X_GEN_TAC `x:real^1` THEN EXPAND_TAC "d" THEN + REWRITE_TAC[COMPLEX_SUB_0; COMPLEX_VEC_0]);; + +(* ------------------------------------------------------------------------- *) +(* The L^2 norm depends only on the a.e.-equivalence class. *) +(* ------------------------------------------------------------------------- *) + +let LNORM_EQ_AE = prove + (`!s p (f:real^1->complex) g. + negligible {x | ~(f x = g x)} ==> lnorm s p f = lnorm s p g`, + REPEAT STRIP_TAC THEN REWRITE_TAC[lnorm] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + MATCH_MP_TAC INTEGRAL_SPIKE THEN + EXISTS_TAC `{x:real^1 | ~((f:real^1->complex) x = g x)}` THEN + ASM_REWRITE_TAC[IN_DIFF; IN_ELIM_THM] THEN + X_GEN_TAC `x:real^1` THEN STRIP_TAC THEN + ASM_CASES_TAC `(f:real^1->complex) x = g x` THEN ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* = Cx(||w||_2^2) for w in L^2 (self inner product is the *) +(* norm-square). *) +(* ------------------------------------------------------------------------- *) + +let LPRODUCT_SELF_NORM = ISPEC `(:real^1)` LPRODUCT_SELF_LNORM;; + +(* ------------------------------------------------------------------------- *) +(* Complex polarization identity for the L^2 inner product: *) +(* 4 = - + i - i. *) +(* Pure pointwise complex algebra under the integral (integrands merged by *) +(* INTEGRAL linearity, then COMPLEX_RING pointwise). *) +(* ------------------------------------------------------------------------- *) + +let LPRODUCT_POLARIZE = prove + (`!u v:real^1->complex. + u IN lspace (:real^1) (&2) /\ v IN lspace (:real^1) (&2) + ==> Cx(&4) * lproduct (:real^1) u v = + lproduct (:real^1) (\x. u x + v x) (\x. u x + v x) - + lproduct (:real^1) (\x. u x - v x) (\x. u x - v x) + + ii * lproduct (:real^1) (\x. u x + ii * v x) (\x. u x + ii * v x) - + ii * lproduct (:real^1) (\x. u x - ii * v x) (\x. u x - ii * v x)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\x:real^1. u x + v x) IN lspace (:real^1) (&2) /\ + (\x:real^1. u x - v x) IN lspace (:real^1) (&2) /\ + (\x:real^1. u x + ii * v x) IN lspace (:real^1) (&2) /\ + (\x:real^1. u x - ii * v x) IN lspace (:real^1) (&2)` + STRIP_ASSUME_TAC THENL + [REPEAT CONJ_TAC THEN + TRY(MATCH_MP_TAC LSPACE_ADD) THEN TRY(MATCH_MP_TAC LSPACE_SUB) THEN + ASM_REWRITE_TAC[REAL_POS] THEN + MATCH_MP_TAC LSPACE_COMPLEX_LMUL THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[lproduct] THEN + SUBGOAL_THEN + `(\x. (u x + v x) * cnj(u x + v x)) integrable_on (:real^1) /\ + (\x. (u x - v x) * cnj(u x - v x)) integrable_on (:real^1) /\ + (\x. (u x + ii * v x) * cnj(u x + ii * v x)) integrable_on (:real^1) /\ + (\x. (u x - ii * v x) * cnj(u x - ii * v x)) integrable_on (:real^1) /\ + (\x:real^1. u x * cnj(v x)) integrable_on (:real^1)` + STRIP_ASSUME_TAC THENL + [REPEAT CONJ_TAC THEN MATCH_MP_TAC L2_CNJ_PRODUCT_INTEGRABLE THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + ASM_SIMP_TAC[GSYM INTEGRAL_COMPLEX_LMUL; GSYM INTEGRAL_SUB; + GSYM INTEGRAL_ADD; + INTEGRABLE_COMPLEX_LMUL; INTEGRABLE_SUB; INTEGRABLE_ADD] THEN + MATCH_MP_TAC INTEGRAL_EQ THEN X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN + REWRITE_TAC[CNJ_ADD; CNJ_SUB; CNJ_MUL; CNJ_II] THEN CONV_TAC COMPLEX_RING);; + +(* ------------------------------------------------------------------------- *) +(* A Fourier-transform representative preserves the L^2 norm: if chat *) +(* represents the FT of c (both in L^2) then ||chat||_2 = ||c||_2. From *) +(* FOURIER_L2_REP (some g with ||g|| = ||c||) + FOURIER_L2_UNIQUE (chat = g *) +(* a.e.) + LNORM_EQ_AE. *) +(* ------------------------------------------------------------------------- *) + +let FOURIER_L2_REP_NORM = prove + (`!c chat:real^1->complex. + c IN lspace (:real^1) (&2) /\ chat IN lspace (:real^1) (&2) /\ + (!h. schwartz h + ==> integral (:real^1) (\z. chat z * h(drop z)) = + integral (:real^1) (\z. c z * fourier h (drop z))) + ==> lnorm (:real^1) (&2) chat = lnorm (:real^1) (&2) c`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `c:real^1->complex` FOURIER_L2_REP) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `g:real^1->complex` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `lnorm (:real^1) (&2) (chat:real^1->complex) = + lnorm (:real^1) (&2) (g:real^1->complex)` + SUBST1_TAC THENL + [MATCH_MP_TAC LNORM_EQ_AE THEN + MATCH_MP_TAC FOURIER_L2_UNIQUE THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `h:real->complex` THEN DISCH_TAC THEN ASM_SIMP_TAC[]; + ASM_REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Fremlin 284Ob: bilinear Parseval on L^2. If a, b in L^2 have Fourier *) +(* transforms represented by ahat, bhat then = , i.e. *) +(* INT a * cnj b = INT ahat * cnj bhat. *) +(* Proof (Fremlin's polarization): for all complex p, q the combination *) +(* p a + q b has representative p ahat + q bhat (represents relation is *) +(* linear), so

=

(both = Cx(norm^2) *) +(* and the norms agree by FOURIER_L2_REP_NORM). Expanding and *) +(* by LPRODUCT_POLARIZE, the four self-products match termwise *) +(* (p, q = 1, +-1, +-i), so 4 = 4. *) +(* ------------------------------------------------------------------------- *) + +let PARSEVAL_L2_BILINEAR = prove + (`!a b ahat bhat:real^1->complex. + a IN lspace (:real^1) (&2) /\ b IN lspace (:real^1) (&2) /\ + ahat IN lspace (:real^1) (&2) /\ bhat IN lspace (:real^1) (&2) /\ + (!h. schwartz h ==> integral (:real^1) (\z. ahat z * h(drop z)) = + integral (:real^1) (\z. a z * fourier h (drop z))) /\ + (!h. schwartz h ==> integral (:real^1) (\z. bhat z * h(drop z)) = + integral (:real^1) (\z. b z * fourier h (drop z))) + ==> lproduct (:real^1) a b = lproduct (:real^1) ahat bhat`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `!p q:complex. + lproduct (:real^1) (\x. p * a x + q * b x) (\x. p * a x + q * b x) = + lproduct (:real^1) (\x. p * ahat x + q * bhat x) + (\x. p * ahat x + q * bhat x)` + (LABEL_TAC "SELF") THENL + [REPEAT GEN_TAC THEN + SUBGOAL_THEN + `(\x:real^1. p * a x + q * b x) IN lspace (:real^1) (&2) /\ + (\x:real^1. p * ahat x + q * bhat x) IN lspace (:real^1) (&2)` + STRIP_ASSUME_TAC THENL + [CONJ_TAC THEN MATCH_MP_TAC LSPACE_ADD THEN ASM_REWRITE_TAC[REAL_POS] THEN + CONJ_TAC THEN MATCH_MP_TAC LSPACE_COMPLEX_LMUL THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + ASM_SIMP_TAC[LPRODUCT_SELF_NORM] THEN AP_TERM_TAC THEN AP_THM_TAC THEN + AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC FOURIER_L2_REP_NORM THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `h:real->complex` THEN DISCH_TAC THEN + SUBGOAL_THEN `(\z:real^1. cnj(h(drop z))) IN lspace (:real^1) (&2) /\ + (\z:real^1. cnj(fourier h(drop z))) IN lspace (:real^1) (&2)` + STRIP_ASSUME_TAC THENL + [CONJ_TAC THEN MATCH_MP_TAC LSPACE_CNJ THEN MATCH_MP_TAC SCHWARTZ_L2 THEN + ASM_SIMP_TAC[SCHWARTZ_FOURIER; ETA_AX]; + ALL_TAC] THEN + SUBGOAL_THEN + `(\x:real^1. (p * ahat x + q * bhat x) * h(drop x)) = + (\x. p * (ahat x * h(drop x)) + q * (bhat x * h(drop x)))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN SIMPLE_COMPLEX_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `(\x:real^1. (p * a x + q * b x) * fourier h (drop x)) = + (\x. p * (a x * fourier h(drop x)) + q * (b x * fourier h(drop x)))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN SIMPLE_COMPLEX_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `(\x:real^1. ahat x * h(drop x)) integrable_on (:real^1) /\ + (\x:real^1. bhat x * h(drop x)) integrable_on (:real^1) /\ + (\x:real^1. a x * fourier h(drop x)) integrable_on (:real^1) /\ + (\x:real^1. b x * fourier h(drop x)) integrable_on (:real^1)` + STRIP_ASSUME_TAC THENL + [REPEAT CONJ_TAC THENL + [MP_TAC(ISPECL [`(:real^1)`; `ahat:real^1->complex`; + `\z:real^1. cnj(h(drop z))`] + L2_CNJ_PRODUCT_INTEGRABLE) THEN ASM_REWRITE_TAC[CNJ_CNJ]; + MP_TAC(ISPECL [`(:real^1)`; `bhat:real^1->complex`; + `\z:real^1. cnj(h(drop z))`] + L2_CNJ_PRODUCT_INTEGRABLE) THEN ASM_REWRITE_TAC[CNJ_CNJ]; + MP_TAC(ISPECL [`(:real^1)`; `a:real^1->complex`; + `\z:real^1. cnj(fourier h(drop z))`] + L2_CNJ_PRODUCT_INTEGRABLE) THEN ASM_REWRITE_TAC[CNJ_CNJ]; + MP_TAC(ISPECL [`(:real^1)`; `b:real^1->complex`; + `\z:real^1. cnj(fourier h(drop z))`] + L2_CNJ_PRODUCT_INTEGRABLE) THEN ASM_REWRITE_TAC[CNJ_CNJ]]; + ALL_TAC] THEN + ASM_SIMP_TAC[INTEGRAL_ADD; INTEGRABLE_COMPLEX_LMUL; + INTEGRAL_COMPLEX_LMUL] THEN + BINOP_TAC THEN AP_TERM_TAC THEN ASM_SIMP_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `Cx(&4) * lproduct (:real^1) a b = Cx(&4) * lproduct (:real^1) ahat bhat` + MP_TAC THENL + [MP_TAC(ISPECL [`a:real^1->complex`; + `b:real^1->complex`] LPRODUCT_POLARIZE) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + MP_TAC(ISPECL [`ahat:real^1->complex`; + `bhat:real^1->complex`] LPRODUCT_POLARIZE) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + USE_THEN "SELF" (fun th -> + MP_TAC(SPECL [`Cx(&1)`; `Cx(&1)`] th) THEN + MP_TAC(SPECL [`Cx(&1)`; `--Cx(&1)`] th) THEN + MP_TAC(SPECL [`Cx(&1)`; `ii`] th) THEN + MP_TAC(SPECL [`Cx(&1)`; `--ii`] th)) THEN + REWRITE_TAC[COMPLEX_MUL_LID; COMPLEX_MUL_LNEG] THEN + REWRITE_TAC[GSYM complex_sub] THEN + DISCH_THEN SUBST1_TAC THEN DISCH_THEN SUBST1_TAC THEN + DISCH_THEN SUBST1_TAC THEN DISCH_THEN SUBST1_TAC THEN REFL_TAC; + MP_TAC(COMPLEX_RING `~(Cx(&4) = Cx(&0))`) THEN + SIMP_TAC[COMPLEX_EQ_MUL_LCANCEL]]);; + +(* Single-tile region-Parseval (Fremlin 2139-2142 per tile): the spatial *) +(* tile integral int_R phi_sigma equals the frequency pairing lproduct *) +(* phihat_sigma chi_R-hat, where g = chi_R-hat is the abstract L^2 rep *) +(* (CARLESON_CHIHAT_REP). This is the per-tile heart of the 286O(b) spatial *) +(* identity: it turns EACH int_R phi_sigma into a frequency integral against *) +(* chi_R-hat, ready for the sum-vs-integral interchange with the freq-side *) +(* tile-sum CARLESON_PERK_LIMIT_RE. *) +let CARLESON_PHISIG_REGION_PARSEVAL = prove + (`!(s:int#int#int) (R:real^1->bool) g. + measurable R /\ + g IN lspace (:real^1) (&2) /\ + (!h. schwartz h + ==> integral (:real^1) (\z. g z * h(drop z)) = + integral (:real^1) (\z. (if z IN R then Cx(&1) else Cx(&0)) * + fourier h (drop z))) + ==> integral R (\z. phi_sigma s carleson_phi (drop z)) = + lproduct (:real^1) (\z. fourier (phi_sigma s carleson_phi) (drop z)) + g`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[CARLESON_PHISIG_REGION_LPRODUCT] THEN + MATCH_MP_TAC PARSEVAL_L2_BILINEAR THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[PHISIG_IN_LSPACE2]; + MATCH_MP_TAC CARLESON_CHI_L2_UNIV THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[PHISIG_FOURIER_L2]; + ASM_REWRITE_TAC[]; + CONV_TAC(DEPTH_CONV BETA_CONV) THEN X_GEN_TAC `h:real->complex` THEN + DISCH_TAC THEN + MP_TAC(ISPECL [`phi_sigma s carleson_phi`; + `h:real->complex`] FOURIER_283O) THEN + ANTS_TAC THENL + [CONJ_TAC THEN MATCH_MP_TAC SCHWARTZ_ABSINT THEN + ONCE_REWRITE_TAC[ETA_AX] THEN + ASM_REWRITE_TAC[PHISIG_CARLESON_SCHWARTZ]; ALL_TAC] THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]); + CONV_TAC(DEPTH_CONV BETA_CONV) THEN ASM_REWRITE_TAC[]]);; + +(* 286O(b) finite-sum aggregate (Fremlin 2136-2143): summing the per-tile *) +(* region- Parseval over a FINITE tile family P converts the spatial *) +(* tile-sum integral sum_{s in P} int_R phi_s into ONE frequency *) +(* pairing of the summed transform against chi_R-hat: lproduct (sum_{s in P} *) +(* phihat_s) chi_R-hat. LPRODUCT_LSUM (pull the finite sum out of *) +(* lproduct's 1st slot) + LPRODUCT_LMUL (pull each scalar) + the *) +(* per-tile CARLESON_PHISIG_REGION_PARSEVAL. Integrability side-conditions *) +(* from L2_CNJ_PRODUCT_INTEGRABLE (phihat_s, g both L2). *) +let CARLESON_TILESUM_REGION_PARSEVAL = prove + (`!(h:real->complex) (P:(int#int#int)->bool) (R:real^1->bool) g. + FINITE P /\ measurable R /\ + g IN lspace (:real^1) (&2) /\ + (!hh. schwartz hh + ==> integral (:real^1) (\z. g z * hh(drop z)) = + integral (:real^1) (\z. (if z IN R then Cx(&1) else Cx(&0)) * + fourier hh (drop z))) + ==> vsum P (\s. carleson_ip h s * integral R (\z. phi_sigma s carleson_phi + (drop z))) = + lproduct (:real^1) + (\z. vsum P (\s. carleson_ip h s * fourier (phi_sigma s + carleson_phi) (drop z))) g`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `lproduct (:real^1) + (\z. vsum P (\s. carleson_ip h s * fourier (phi_sigma s carleson_phi) + (drop z))) g = + vsum P (\s. carleson_ip h s * + lproduct (:real^1) (\z. fourier (phi_sigma s carleson_phi) + (drop z)) g)` + SUBST1_TAC THENL + [W(MP_TAC o PART_MATCH (lhs o rand) LPRODUCT_LSUM o lhs o snd) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN X_GEN_TAC `s:int#int#int` THEN DISCH_TAC THEN + MATCH_MP_TAC L2_CNJ_PRODUCT_INTEGRABLE THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC LSPACE_COMPLEX_LMUL THEN REWRITE_TAC[PHISIG_FOURIER_L2]; + DISCH_THEN SUBST1_TAC] THEN + MATCH_MP_TAC VSUM_EQ THEN X_GEN_TAC `s:int#int#int` THEN DISCH_TAC THEN + REWRITE_TAC[] THEN + MATCH_MP_TAC LPRODUCT_LMUL THEN + MATCH_MP_TAC L2_CNJ_PRODUCT_INTEGRABLE THEN + REWRITE_TAC[PHISIG_FOURIER_L2] THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC VSUM_EQ THEN X_GEN_TAC `s:int#int#int` THEN DISCH_TAC THEN + REWRITE_TAC[] THEN AP_TERM_TAC THEN + MATCH_MP_TAC CARLESON_PHISIG_REGION_PARSEVAL THEN ASM_REWRITE_TAC[]]);; + +(* Bridge from an L^2-norm "---> 0" limit to the epsilon-delta hypothesis *) +(* form of *) +(* LPRODUCT_L2LIM. Since lnorm >= 0, abs(lnorm - 0) < e is just lnorm < e. *) +let REALLIM_TO_L2LIM_HYP = prove + (`!(gn:num->real^1->complex) (g:real^1->complex). + ((\N. lnorm (:real^1) (&2) (\x. gn N x - g x)) ---> &0) sequentially + ==> (!e. &0 < e ==> ?N. !n. n >= N + ==> lnorm (:real^1) (&2) (\x. gn n x - g x) < e)`, + REPEAT GEN_TAC THEN REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN + DISCH_TAC THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[GE] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[] THEN + REAL_ARITH_TAC);; + +(* The b-ii limit function 2pi hhat psi_k is in L^2 (extracted from the DCT *) +(* that proves CARLESON_PERK_L2LIM: LSPACE_DOMINATED_CONVERGENCE's first *) +(* conclusion). *) +let CARLESON_PERK_LIMFN_L2 = prove + (`!(h:real->complex) k nJ. + schwartz h + ==> (\z. Cx(&2 * pi) * fourier h (drop z) * + Cx(Re(fourier carleson_phi + (&2 zpow (--k) * (drop z - tile_ymid(k,&0,nJ)))) pow 2)) + IN lspace (:real^1) (&2)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `h:real->complex` CARLESON_TILESUM_DOMINATED) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPECL [`k:int`; `nJ:int`]) THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL + [`\N z. vsum {nI:int | abs nI <= &N} + (\nI. carleson_ip h (k,nI,nJ) * + fourier (phi_sigma (k,nI,nJ) carleson_phi) (drop z))`; + `\z:real^1. Cx(&2 * pi) * fourier h (drop z) * + Cx(Re(fourier carleson_phi + (&2 zpow (--k) * (drop z - tile_ymid(k,&0,nJ)))) pow 2)`; + `\z:real^1. Cx(&2 * pi * B) * + fourier carleson_phi ((drop z - tile_ymid(k,&0,nJ)) / &2 zpow + k)`; + `(:real^1)`; `&2`; `{}:real^1->bool`] + LSPACE_DOMINATED_CONVERGENCE) THEN + REWRITE_TAC[NEGLIGIBLE_EMPTY; DIFF_EMPTY; IN_UNIV] THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [REAL_ARITH_TAC; + REWRITE_TAC[CARLESON_TILESUM_FOURIER_L2]; + REWRITE_TAC[CARLESON_DOMINATOR_L2]; + ASM_REWRITE_TAC[]; + GEN_TAC THEN MATCH_MP_TAC CARLESON_PERK_LIMIT_ALL THEN + ASM_REWRITE_TAC[]]; + REWRITE_TAC[ETA_AX] THEN SIMP_TAC[]]);; + +(* The scaled bump phihat(2^{-k}(y-c)) is Schwartz (affine reparametrisation *) +(* of the Schwartz phihat, scale 2^{-k} nonzero). *) +let SCALED_PHIHAT_SCHWARTZ = prove + (`!k (c:real). schwartz (\y. fourier carleson_phi (&2 zpow (--k) * (y - c)))`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `(\y. fourier carleson_phi (&2 zpow (--k) * (y - c))) = + (\y. fourier carleson_phi (--(&2 zpow (--k) * c) + &2 zpow + (--k) * y))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN AP_TERM_TAC THEN + REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(BETA_RULE(ISPECL [`fourier carleson_phi`; `&2 zpow (--k)`; + `--(&2 zpow (--k) * c)`] + SCHWARTZ_AFFINE)) THEN + DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL + [MATCH_MP_TAC SCHWARTZ_FOURIER THEN REWRITE_TAC[CARLESON_PHI_SCHWARTZ]; + MATCH_MP_TAC REAL_LT_IMP_NZ THEN MATCH_MP_TAC REAL_ZPOW_LT THEN + REAL_ARITH_TAC]);; + +(* The scaled bump vanishes off |y - c| <= 2^k/5 (phihat support *) +(* [-1/5,1/5]). *) +let SCALED_PHIHAT_SUPPORT = prove + (`!k (c:real) y. &2 zpow k / &5 < abs(y - c) + ==> fourier carleson_phi (&2 zpow (--k) * (y - c)) = Cx(&0)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CARLESON_PHI_FHAT_SUPPORT THEN + SUBGOAL_THEN `&0 < &2 zpow k` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `&2 zpow (--k) * (y - c) = (y - c) / &2 zpow k` SUBST1_TAC THENL + [REWRITE_TAC[REAL_ZPOW_NEG] THEN UNDISCH_TAC `&0 < &2 zpow k` THEN + CONV_TAC REAL_FIELD; + ALL_TAC] THEN + REWRITE_TAC[REAL_ABS_DIV] THEN + SUBGOAL_THEN `abs(&2 zpow k) = &2 zpow k` SUBST1_TAC THENL + [REWRITE_TAC[REAL_ABS_REFL] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LT_RDIV_EQ] THEN + UNDISCH_TAC `&2 zpow k / &5 < abs(y - c)` THEN + ASM_SIMP_TAC[REAL_LT_LDIV_EQ] THEN REAL_ARITH_TAC);; + +(* The b-ii limit function m_k = 2pi hhat psi_k, *) +(* psi_k(y)=Re(phihat(2^{-k}(y-yy)))^2, *) +(* is SCHWARTZ. Rewrite Cx(Re(phihat)^2) = phihat*phihat *) +(* (CARLESON_PHIHAT_SQ_RE), so *) +(* m_k = Cx(2pi)*(hhat*(phihat_scaled*phihat_scaled)): a constant times a *) +(* Schwartz *) +(* (hhat, 284C) product with a compactly-supported Schwartz square, all *) +(* closed by *) +(* SCHWARTZ_CMUL/SCHWARTZ_CSUPP_MUL. This is stronger than *) +(* CARLESON_PERK_LIMFN_L2 *) +(* (Schwartz => absint => usable in FOURIER_283O for the R1 region *) +(* rep-step). *) +let CARLESON_PERK_LIMFN_SCHWARTZ = prove + (`!(h:real->complex) k nJ. schwartz h ==> + schwartz (\y. Cx(&2 * pi) * fourier h y * + Cx(Re(fourier carleson_phi (&2 zpow (--k) * (y - + tile_ymid(k,&0,nJ)))) pow 2))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\y. Cx(&2 * pi) * fourier h y * + Cx(Re(fourier carleson_phi (&2 zpow (--k) * (y - tile_ymid(k,&0,nJ)))) + pow 2)) = + (\y. Cx(&2 * pi) * + (fourier h y * + (fourier carleson_phi (&2 zpow (--k) * (y - tile_ymid(k,&0,nJ))) * + fourier carleson_phi (&2 zpow (--k) * (y - tile_ymid(k,&0,nJ))))))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o RAND_CONV) [GSYM + CARLESON_PHIHAT_SQ_RE] THEN + SPEC_TAC(`fourier carleson_phi (&2 zpow (--k) * (x - + tile_ymid(k,&0,nJ)))`,`C:complex`) THEN + SPEC_TAC(`fourier (h:real->complex) x`,`B:complex`) THEN + SPEC_TAC(`Cx(&2 * pi)`,`A:complex`) THEN + REPEAT GEN_TAC THEN CONV_TAC COMPLEX_RING; ALL_TAC] THEN + MP_TAC(BETA_RULE(ISPECL + [`\y. fourier (h:real->complex) y * + (fourier carleson_phi (&2 zpow (--k) * (y - tile_ymid(k,&0,nJ))) * + fourier carleson_phi (&2 zpow (--k) * (y - tile_ymid(k,&0,nJ))))`; + `Cx(&2 * pi)`] SCHWARTZ_CMUL)) THEN + DISCH_THEN MATCH_MP_TAC THEN + MP_TAC(BETA_RULE(ISPECL + [`fourier (h:real->complex)`; + `\y. fourier carleson_phi (&2 zpow (--k) * (y - tile_ymid(k,&0,nJ))) * + fourier carleson_phi (&2 zpow (--k) * (y - tile_ymid(k,&0,nJ)))`; + `&2 zpow k / &5 + abs(tile_ymid(k,&0,nJ))`] SCHWARTZ_CSUPP_MUL)) THEN + DISCH_THEN MATCH_MP_TAC THEN REPEAT CONJ_TAC THENL + [SUBGOAL_THEN `&0 < &2 zpow k` MP_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + REAL_ARITH_TAC; + MATCH_MP_TAC SCHWARTZ_FOURIER THEN ASM_REWRITE_TAC[]; + MP_TAC(BETA_RULE(ISPECL + [`\y. fourier carleson_phi (&2 zpow (--k) * (y - tile_ymid(k,&0,nJ)))`; + `\y. fourier carleson_phi (&2 zpow (--k) * (y - tile_ymid(k,&0,nJ)))`; + `&2 zpow k / &5 + abs(tile_ymid(k,&0,nJ))`] SCHWARTZ_CSUPP_MUL)) THEN + DISCH_THEN MATCH_MP_TAC THEN REPEAT CONJ_TAC THENL + [SUBGOAL_THEN `&0 < &2 zpow k` MP_TAC THENL + [MATCH_MP_TAC REAL_ZPOW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + REAL_ARITH_TAC; + REWRITE_TAC[SCALED_PHIHAT_SCHWARTZ]; + REWRITE_TAC[SCALED_PHIHAT_SCHWARTZ]; + X_GEN_TAC `y:real` THEN DISCH_TAC THEN + MATCH_MP_TAC SCALED_PHIHAT_SUPPORT THEN + ASM_REAL_ARITH_TAC]; + X_GEN_TAC `y:real` THEN DISCH_TAC THEN + SUBGOAL_THEN + `fourier carleson_phi (&2 zpow (--k) * (y - tile_ymid(k,&0,nJ))) = + Cx(&0)` + (fun th -> REWRITE_TAC[th; COMPLEX_MUL_LZERO]) THEN + MATCH_MP_TAC SCALED_PHIHAT_SUPPORT THEN ASM_REAL_ARITH_TAC]);; + +(* R2a: the b-ii limit function WITHOUT the 2pi factor, hhat(y) *) +(* Re(phihat(...))^2, is also Schwartz (= inv(2pi) times *) +(* CARLESON_PERK_LIMFN_SCHWARTZ, SCHWARTZ_CMUL). *) +let CARLESON_PERK_LIMFN0_SCHWARTZ = prove + (`!(h:real->complex) k nJ. schwartz h ==> + schwartz (\y. fourier h y * + Cx(Re(fourier carleson_phi (&2 zpow (--k) * (y - + tile_ymid(k,&0,nJ)))) pow 2))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`h:real->complex`; `k:int`; + `nJ:int`] CARLESON_PERK_LIMFN_SCHWARTZ) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `Cx(inv(&2 * pi))` o MATCH_MP SCHWARTZ_CMUL) THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN + GEN_TAC THEN + SUBGOAL_THEN `Cx(inv(&2 * pi)) * Cx(&2 * pi) = Cx(&1)` MP_TAC THENL + [REWRITE_TAC[GSYM CX_MUL] THEN AP_TERM_TAC THEN + MATCH_MP_TAC REAL_MUL_LINV THEN MP_TAC PI_POS THEN + REAL_ARITH_TAC; ALL_TAC] THEN + CONV_TAC COMPLEX_RING);; + +(* R2a: pull the Cx(2pi) scalar out of the CARLESON_PERK_286OB limit *) +(* function's *) +(* inverse transform. fourier(2pi hhat psi_k)(--x) = 2pi fourier(hhat *) +(* psi_k)(--x). *) +(* FOURIER_LMUL (integrability from SCHWARTZ_MOD_ABSINT on the no-2pi *) +(* Schwartz fn *) +(* CARLESON_PERK_LIMFN0_SCHWARTZ). This exposes the CARLESON_PERK_286OB *) +(* limit as *) +(* 2pi times the (hhat psi_k)check window -- matching carleson_w's 2pi (hhat *) +(* theta_z) *) +(* check form (carleson_w h z x = Cx(2pi) fourier(hhat*Cx theta_z)(--x)) at *) +(* a single *) +(* scale, the entry point for the R2 scale-sum. *) +let INTEGRAL_REGION_LPRODUCT = prove + (`!(f:real^1->complex) (R:real^1->bool). + integral R f = lproduct (:real^1) f (\x. if x IN R then Cx(&1) else + Cx(&0))`, + REPEAT GEN_TAC THEN REWRITE_TAC[lproduct] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM INTEGRAL_RESTRICT_UNIV] THEN + MATCH_MP_TAC INTEGRAL_EQ THEN X_GEN_TAC `z:real^1` THEN DISCH_TAC THEN + REWRITE_TAC[] THEN COND_CASES_TAC THEN + REWRITE_TAC[CNJ_CX; COMPLEX_MUL_RID; COMPLEX_MUL_RZERO; COMPLEX_VEC_0]);; + +(* The inverse transform (m)check(x)=fourier m(--x) of a Schwartz m *) +(* REPRESENTS m as an L^2 Fourier representative: int m*hh = int *) +(* (m)check*fourier hh for schwartz hh. Via FOURIER_283O on (m)check (a *) +(* reflected transform, Schwartz) plus the inversion fourier((m)check) = m *) +(* (PHI_IS_FOURIER, m Schwartz). *) +let CARLESON_CHECK_REPS = prove + (`!(m:real->complex) hh. schwartz m /\ schwartz hh + ==> integral (:real^1) (\z. m(drop z) * hh(drop z)) = + integral (:real^1) (\z. fourier m (--drop z) * fourier hh (drop z))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\x. fourier (m:real->complex) (--x)`; + `hh:real->complex`] FOURIER_283O) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [MP_TAC(ISPEC `\u. fourier (m:real->complex) (--u)` SCHWARTZ_ABSINT) THEN + ANTS_TAC THENL + [MATCH_MP_TAC SCHWARTZ_REFLECT THEN REWRITE_TAC[ETA_AX] THEN + MATCH_MP_TAC SCHWARTZ_FOURIER THEN ASM_REWRITE_TAC[]; REWRITE_TAC[]]; + MATCH_MP_TAC SCHWARTZ_ABSINT THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN + SUBGOAL_THEN `!w. fourier (\x. fourier (m:real->complex) (--x)) w = m w` + (fun th -> REWRITE_TAC[th; FOURIER_REFLECT]) THENL + [GEN_TAC THEN ASM_SIMP_TAC[PHI_IS_FOURIER]; ALL_TAC] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[]);; + +(* R1 (rep-step of 286O(b)): for Schwartz m and gg = chi_R-hat rep, *) +(* int_R (m)check = lproduct(m, gg). *) +(* int_R (m)check = lproduct((m)check, chi_R) [INTEGRAL_REGION_LPRODUCT] and *) +(* then *) +(* PARSEVAL_L2_BILINEAR (284Ob) with a=(m)check (L^2 + reps m via *) +(* CARLESON_CHECK_REPS), *) +(* b=chi_R, ahat=m, bhat=gg. Applied with m = 2pi hhat psi_k, this converts *) +(* the *) +(* CARLESON_PERK_SPATIAL_LIMIT limit lproduct(2pi hhat psi_k, chiR-hat) into *) +(* the *) +(* spatial 2pi int_R (hhat psi_k)check of Fremlin 286O-b-ii. *) +let CARLESON_PERK_WINDOW_REGION = prove + (`!(m:real->complex) (R:real^1->bool) gg. + schwartz m /\ measurable R /\ gg IN lspace (:real^1) (&2) /\ + (!hh. schwartz hh + ==> integral (:real^1) (\z. gg z * hh(drop z)) = + integral (:real^1) (\z. (if z IN R then Cx(&1) else Cx(&0)) * + fourier hh (drop z))) + ==> integral R (\z. fourier m (--drop z)) = + lproduct (:real^1) (\z. m (drop z)) gg`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[INTEGRAL_REGION_LPRODUCT] THEN + MATCH_MP_TAC PARSEVAL_L2_BILINEAR THEN + REPEAT CONJ_TAC THENL + [MP_TAC(ISPEC `\u. fourier (m:real->complex) (--u)` SCHWARTZ_L2) THEN + ANTS_TAC THENL + [MATCH_MP_TAC SCHWARTZ_REFLECT THEN REWRITE_TAC[ETA_AX] THEN + MATCH_MP_TAC SCHWARTZ_FOURIER THEN ASM_REWRITE_TAC[]; REWRITE_TAC[]]; + MATCH_MP_TAC CARLESON_CHI_L2_UNIV THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC SCHWARTZ_L2 THEN ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + CONV_TAC(DEPTH_CONV BETA_CONV) THEN X_GEN_TAC `hh:real->complex` THEN + DISCH_TAC THEN + MP_TAC(ISPECL [`m:real->complex`; + `hh:real->complex`] CARLESON_CHECK_REPS) THEN + ASM_REWRITE_TAC[]; + CONV_TAC(DEPTH_CONV BETA_CONV) THEN ASM_REWRITE_TAC[]]);; + +(* The finite spatial=frequency Parseval bridge *) +(* (CARLESON_TILESUM_REGION_PARSEVAL) reindexed by the integer nI over the *) +(* per-k tile family {(k,nI,nJ) : |nI|<=N}. The map nI |-> (k,nI,nJ) is *) +(* injective, so VSUM_IMAGE reindexes both the spatial sum and the frequency *) +(* sum inside lproduct. *) +let CARLESON_PERK_REGION_PARSEVAL = prove + (`!(h:real->complex) (k:int) (nJ:int) (N:num) (R:real^1->bool) gg. + measurable R /\ gg IN lspace (:real^1) (&2) /\ + (!hh. schwartz hh + ==> integral (:real^1) (\z. gg z * hh(drop z)) = + integral (:real^1) (\z. (if z IN R then Cx(&1) else Cx(&0)) * + fourier hh (drop z))) + ==> vsum {nI:int | abs nI <= &N} + (\nI. carleson_ip h (k,nI,nJ) * + integral R (\z. phi_sigma (k,nI,nJ) carleson_phi (drop z))) + = + lproduct (:real^1) + (\z. vsum {nI:int | abs nI <= &N} + (\nI. carleson_ip h (k,nI,nJ) * + fourier (phi_sigma (k,nI,nJ) carleson_phi) (drop z))) + gg`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `!(FF:int#int#int->real^2). + vsum (IMAGE (\nI:int. ((k:int),nI,(nJ:int))) {nI:int | abs nI <= &N}) FF + = + vsum {nI:int | abs nI <= &N} (\nI. FF(k,nI,nJ))` + ASSUME_TAC THENL + [GEN_TAC THEN + MP_TAC(ISPECL [`\nI:int. ((k:int),nI,(nJ:int))`; `FF:int#int#int->real^2`; + `{nI:int | abs nI <= &N}`] VSUM_IMAGE) THEN + REWRITE_TAC[CFOURIER_INDEX_FINITE] THEN ANTS_TAC THENL + [MAP_EVERY X_GEN_TAC [`a:int`; `b:int`] THEN REWRITE_TAC[PAIR_EQ] THEN + SIMP_TAC[]; + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[o_DEF]]; ALL_TAC] THEN + MP_TAC(ISPECL [`h:real->complex`; + `IMAGE (\nI:int. ((k:int),nI,(nJ:int))) {nI:int | abs nI <= &(N:num)}`; + `R:real^1->bool`; + `gg:real^1->complex`] CARLESON_TILESUM_REGION_PARSEVAL) THEN + ASM_SIMP_TAC[FINITE_IMAGE; CFOURIER_INDEX_FINITE]);; + +(* 286O(b) per-k SPATIAL limit: the finite tile-sum spatial region integrals *) +(* over abs nI <= N of int_R phi_(k,nI,nJ) converge (as *) +(* N->inf) to *) +(* lproduct(2pi hhat psi_k, chiR-hat). Rewrite each finite sum by the per-k *) +(* Parseval *) +(* bridge (= lproduct(tile_sum_freq_N, gg)) and pass the L^2-limit *) +(* CARLESON_PERK_L2LIM *) +(* through the inner-product's first slot (LPRODUCT_L2LIM). This is the *) +(* spatial side *) +(* of Fremlin 286O(b). *) +let CARLESON_PERK_SPATIAL_LIMIT = prove + (`!(h:real->complex) (k:int) (nJ:int) (R:real^1->bool) gg. + schwartz h /\ measurable R /\ gg IN lspace (:real^1) (&2) /\ + (!hh. schwartz hh + ==> integral (:real^1) (\z. gg z * hh(drop z)) = + integral (:real^1) (\z. (if z IN R then Cx(&1) else Cx(&0)) * + fourier hh (drop z))) + ==> ((\N. vsum {nI:int | abs nI <= &N} + (\nI. carleson_ip h (k,nI,nJ) * + integral R (\z. phi_sigma (k,nI,nJ) carleson_phi (drop + z)))) + --> lproduct (:real^1) + (\z. Cx(&2 * pi) * fourier h (drop z) * + Cx(Re(fourier carleson_phi + (&2 zpow (--k) * (drop z - tile_ymid(k,&0,nJ)))) pow 2)) + gg) + sequentially`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `!N. vsum {nI:int | abs nI <= &N} + (\nI. carleson_ip h (k,nI,nJ) * + integral R (\z. phi_sigma (k,nI,nJ) carleson_phi (drop z))) = + lproduct (:real^1) + (\z. vsum {nI:int | abs nI <= &N} + (\nI. carleson_ip h (k,nI,nJ) * + fourier (phi_sigma (k,nI,nJ) carleson_phi) (drop z))) + gg` + (fun th -> REWRITE_TAC[th]) THENL + [GEN_TAC THEN MATCH_MP_TAC CARLESON_PERK_REGION_PARSEVAL THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC LPRODUCT_L2LIM THEN ASM_REWRITE_TAC[] THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[CARLESON_TILESUM_FOURIER_L2]; + MATCH_MP_TAC CARLESON_PERK_LIMFN_L2 THEN ASM_REWRITE_TAC[]; + MP_TAC(ISPECL [`h:real->complex`; `k:int`; + `nJ:int`] CARLESON_PERK_L2LIM) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(ACCEPT_TAC o MATCH_MP REALLIM_TO_L2LIM_HYP)]);; + +(* Fremlin 286O(b-ii), per-k, in LIMIT form: the finite tile-sum spatial *) +(* region *) +(* integrals converge to 2pi int_R (hhat psi_k)check. Combine *) +(* CARLESON_PERK_SPATIAL_ *) +(* LIMIT (the limit is lproduct(2pi hhat psi_k, chiR-hat)) with *) +(* CARLESON_PERK_WINDOW_ *) +(* REGION (R1: that lproduct = int_R of the inverse transform of 2pi hhat *) +(* psi_k, since *) +(* 2pi hhat psi_k is Schwartz by CARLESON_PERK_LIMFN_SCHWARTZ). This is *) +(* exactly the *) +(* spatial side 2pi int_F (hhat psi_k)check = sum_{sigma in R_k} *) +(* int_F phi_s *) +(* of Fremlin's 286O(b-ii), read as an N->inf limit over the R_k tile index. *) +let CARLESON_PERK_286OB = prove + (`!(h:real->complex) (k:int) (nJ:int) (R:real^1->bool) gg. + schwartz h /\ measurable R /\ gg IN lspace (:real^1) (&2) /\ + (!hh. schwartz hh + ==> integral (:real^1) (\z. gg z * hh(drop z)) = + integral (:real^1) (\z. (if z IN R then Cx(&1) else Cx(&0)) * + fourier hh (drop z))) + ==> ((\N. vsum {nI:int | abs nI <= &N} + (\nI. carleson_ip h (k,nI,nJ) * + integral R (\z. phi_sigma (k,nI,nJ) carleson_phi (drop + z)))) + --> integral R (\z. fourier (\y. Cx(&2 * pi) * fourier h y * + Cx(Re(fourier carleson_phi (&2 zpow (--k) * (y - + tile_ymid(k,&0,nJ)))) pow 2)) + (--drop z))) + sequentially`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\y. Cx(&2 * pi) * fourier (h:real->complex) y * + Cx(Re(fourier carleson_phi (&2 zpow (--k) * (y - + tile_ymid(k,&0,nJ)))) pow 2)`; + `R:real^1->bool`; + `gg:real^1->complex`] CARLESON_PERK_WINDOW_REGION) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CARLESON_PERK_LIMFN_SCHWARTZ THEN + ASM_REWRITE_TAC[]; + DISCH_THEN(fun th -> REWRITE_TAC[th])] THEN + MATCH_MP_TAC CARLESON_PERK_SPATIAL_LIMIT THEN ASM_REWRITE_TAC[]);; + +(* ========================================================================= *) +(* R2d (Fremlin 286O-b-iv): the k-sum interchange. With CARLESON_PSI_SUM_ *) +(* LIMIT giving theta_z = sum_k psi_k POINTWISE (286O-a-i), the remaining *) +(* content is int_F (hhat theta_z)check = sum_k int_F (hhat psi_k)check via *) +(* dominated convergence. These bricks set up the per-K finite partial sum: *) +(* - DYHO_OUTSIDE_MID_DIST + CARLESON_PSI_BARE: since the phihat^2 bump has *) +(* support half-width 2^k/5 STRICTLY inside the dyadic cell Jl (half-width *) +(* 2^k/4 > 2^k/5), the cell-cut in carleson_psi is REDUNDANT -- when z *) +(* witnesses at scale k (z in Jr(k,0,nJ0)), carleson_psi z k equals the *) +(* bare bump Re(phihat(2^{-k}(y - ymid)))^2 for ALL y. *) +(* - CARLESON_PSI_SUMMAND_SCHWARTZ(_ALL): hence \y. hhat y * Cx(psi_k y) is *) +(* Schwartz (bare-bump case = CARLESON_PERK_LIMFN0_SCHWARTZ; no-witness *) +(* case = the zero function, SCHWARTZ_ZERO). *) +(* - CX_VSUM + CARLESON_PSI_FOURIER_KSUM: fourier of the K-partial-sum *) +(* window *) +(* = the vsum of per-k windows (FOURIER_VSUM over Schwartz summands). *) +(* ========================================================================= *) + +(* Cx is additive over finite sums (Cx(sum) = vsum(Cx . -)). *) +let CX_VSUM = prove + (`!s (f:A->real). FINITE s ==> Cx(sum s f) = vsum s (\i. Cx(f i))`, + GEN_TAC THEN GEN_TAC THEN SPEC_TAC(`s:A->bool`,`s:A->bool`) THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[SUM_CLAUSES; VSUM_CLAUSES; CX_ADD] THEN + REWRITE_TAC[GSYM COMPLEX_VEC_0; CX_INJ]);; + +(* A point outside a dyadic cell is at least a half-width from its midpoint. *) +let DYHO_OUTSIDE_MID_DIST = prove + (`!b n y. ~(y IN dyho b n) ==> &2 zpow b / &2 <= abs(y - dyho_mid b n)`, + REWRITE_TAC[dyho; dyho_mid; IN_ELIM_THM; DE_MORGAN_THM; REAL_NOT_LE; + REAL_NOT_LT] THEN + REPEAT GEN_TAC THEN MP_TAC(ISPECL [`&2:real`; `b:int`] REAL_ZPOW_LT) THEN + REWRITE_TAC[REAL_ARITH `&0 < &2`] THEN DISCH_TAC THEN + ABBREV_TAC `p = &2 zpow b` THEN ABBREV_TAC `m = real_of_int n` THEN + ASM_REAL_ARITH_TAC);; + +(* KEYSTONE: when z witnesses a scale-k right-half tile, the sharp cell-cut *) +(* in carleson_psi is redundant -- psi equals the bare phihat^2 bump *) +(* everywhere, because the bump (support 2^k/5) sits inside the cell Jl *) +(* (half-width 2^k/4). *) +let CARLESON_PSI_BARE = prove + (`!(k:int) nJ0 z y. + z IN tile_Jr(k,&0,nJ0) + ==> carleson_psi z k y = + Re(fourier carleson_phi (&2 zpow (--k) * (y - tile_ymid(k,&0,nJ0)))) + pow 2`, + REPEAT STRIP_TAC THEN REWRITE_TAC[carleson_psi] THEN COND_CASES_TAC THENL + [SUBGOAL_THEN + `(@nJ:int. z IN tile_Jr(k,&0,nJ) /\ y IN tile_Jl(k,&0,nJ)) = nJ0` + (fun th -> REWRITE_TAC[th]) THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `nJw:int` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `z IN tile_Jr(k,&0,(@nJ:int. z IN tile_Jr(k,&0,nJ) /\ y IN + tile_Jl(k,&0,nJ))) /\ + y IN tile_Jl(k,&0,(@nJ:int. z IN tile_Jr(k,&0,nJ) /\ y IN + tile_Jl(k,&0,nJ)))` + STRIP_ASSUME_TAC THENL + [CONV_TAC SELECT_CONV THEN EXISTS_TAC `nJw:int` THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL [`k:int`; `&0:int`; + `(@nJ:int. z IN tile_Jr(k,&0,nJ) /\ y IN tile_Jl(k,&0,nJ))`; + `&0:int`; `nJ0:int`; + `z:real`] CARLESON_THETA_SINGLE_NJ) THEN + ASM_REWRITE_TAC[]; + SUBGOAL_THEN `~(y IN tile_Jl(k,&0,nJ0))` ASSUME_TAC THENL + [DISCH_TAC THEN + UNDISCH_TAC `~(?nJ:int. z IN tile_Jr(k,&0,nJ) /\ + y IN tile_Jl(k,&0,nJ))` THEN + REWRITE_TAC[] THEN EXISTS_TAC `nJ0:int` THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[tile_Jl]) THEN REWRITE_TAC[tile_ymid] THEN + MP_TAC(ISPECL [`k - &1:int`; `&2 * nJ0:int`; + `y:real`] DYHO_OUTSIDE_MID_DIST) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + SUBGOAL_THEN + `fourier carleson_phi (&2 zpow (--k) * (y - dyho_mid (k - &1)(&2 * nJ0))) + = Cx(&0)` + (fun th -> REWRITE_TAC[th; RE_CX] THEN REAL_ARITH_TAC) THEN + MATCH_MP_TAC SCALED_PHIHAT_SUPPORT THEN + SUBGOAL_THEN + `&2 zpow k / &5 < &2 zpow (k - &1) / &2` (fun th -> ASM_MESON_TAC[th; + REAL_LTE_TRANS]) THEN + SUBGOAL_THEN `&2 zpow (k - &1) = &2 zpow k / &2` SUBST1_TAC THENL + [SUBGOAL_THEN `k - &1:int = k + (-- &1)` SUBST1_TAC THENL + [INT_ARITH_TAC; ALL_TAC] THEN + SIMP_TAC[REAL_ZPOW_ADD; REAL_ARITH `~(&2 = &0)`] THEN + REWRITE_TAC[REAL_ZPOW_NEG; REAL_ZPOW_1] THEN + REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPECL [`&2:real`; `k:int`] REAL_ZPOW_LT) THEN + REWRITE_TAC[REAL_ARITH `&0 < &2`] THEN REAL_ARITH_TAC]);; + +(* When z witnesses at scale k, the summand hhat * Cx(psi_k) is Schwartz. *) +let CARLESON_PSI_SUMMAND_SCHWARTZ = prove + (`!(h:real->complex) k nJ0 z. + schwartz h /\ z IN tile_Jr(k,&0,nJ0) + ==> schwartz (\y. fourier h y * Cx(carleson_psi z k y))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(\y. fourier h y * Cx(carleson_psi z k y)) = + (\y. fourier h y * Cx(Re(fourier carleson_phi + (&2 zpow (--k) * (y - tile_ymid(k,&0,nJ0)))) pow 2))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + MATCH_MP_TAC CARLESON_PSI_BARE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC CARLESON_PERK_LIMFN0_SCHWARTZ THEN ASM_REWRITE_TAC[]);; + +(* For every scale k, the summand hhat * Cx(psi_k) is Schwartz (bare-bump *) +(* when z witnesses a right-half at scale k; the zero function otherwise). *) +let CARLESON_PSI_SUMMAND_SCHWARTZ_ALL = prove + (`!(h:real->complex) k z. + schwartz h + ==> schwartz (\y. fourier h y * Cx(carleson_psi z k y))`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `?nJ:int. z IN tile_Jr(k,&0,nJ)` THENL + [FIRST_X_ASSUM(X_CHOOSE_TAC `nJ0:int`) THEN + MATCH_MP_TAC CARLESON_PSI_SUMMAND_SCHWARTZ THEN ASM_MESON_TAC[]; + SUBGOAL_THEN + `(\y. fourier h y * Cx(carleson_psi z k y)) = (\y:real. Cx(&0))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + SUBGOAL_THEN `carleson_psi z k x = &0` SUBST1_TAC THENL + [MATCH_MP_TAC CARLESON_PSI_ZERO THEN ASM_MESON_TAC[]; ALL_TAC] THEN + REWRITE_TAC[COMPLEX_MUL_RZERO]; + REWRITE_TAC[SCHWARTZ_ZERO]]]);; + +(* The Fourier transform of the K-partial-sum window equals the vsum of the *) +(* per-scale windows (finite fourier-linearity over Schwartz summands). *) +let CARLESON_PSI_FOURIER_KSUM = prove + (`!(h:real->complex) z K w. + schwartz h + ==> fourier (\y. fourier h y * Cx(sum {k:int | abs k <= &K} (\k. + carleson_psi z k y))) w = + vsum {k:int | abs k <= &K} (\k. fourier (\y. fourier h y * + Cx(carleson_psi z k y)) w)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\y. fourier h y * Cx(sum {k:int | abs k <= &K} (\k. carleson_psi z k y))) + = + (\y. vsum {k:int | abs k <= &K} (\k. fourier h y * Cx(carleson_psi z k + y)))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + SIMP_TAC[CX_VSUM; CFOURIER_INDEX_FINITE] THEN + SIMP_TAC[GSYM VSUM_COMPLEX_LMUL; CFOURIER_INDEX_FINITE]; ALL_TAC] THEN + MP_TAC(ISPECL [`{k:int | abs k <= &K}`; + `\k y. fourier (h:real->complex) y * Cx(carleson_psi z k y)`; + `w:real`] FOURIER_VSUM) THEN + REWRITE_TAC[CFOURIER_INDEX_FINITE] THEN + ANTS_TAC THENL + [X_GEN_TAC `k:int` THEN DISCH_TAC THEN + MATCH_MP_TAC CARLESON_PSI_SUMMAND_SCHWARTZ_ALL THEN ASM_REWRITE_TAC[]; + DISCH_THEN(fun th -> REWRITE_TAC[th])]);; + +(* Every finite scale-partial-sum of the bumps lies in [0,1] (each is 0 or *) +(* theta_z <= 1 by CARLESON_PSI_PARTIAL + CARLESON_THETA_BOUNDS). This is *) +(* the *) +(* |value| <= 1 fact the K-window uniform bound and the DCT dominators need. *) +let CARLESON_PSI_PARTIAL_BOUNDS = prove + (`!z y K. &0 <= sum {k:int | abs k <= &K} (\k. carleson_psi z k y) /\ + sum {k:int | abs k <= &K} (\k. carleson_psi z k y) <= &1`, + REPEAT GEN_TAC THEN + MP_TAC(ISPECL [`z:real`; `y:real`] CARLESON_THETA_BOUNDS) THEN + MP_TAC(ISPECL [`z:real`; `y:real`; + `{k:int | abs k <= &K}`] CARLESON_PSI_PARTIAL) THEN + REWRITE_TAC[CFOURIER_INDEX_FINITE] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; + +(* The K-partial-sum window integrand \y. hhat y * Cx(sum_{abs k<=K} psi_k *) +(* y) is Schwartz -- it is a FINITE vsum of the Schwartz per-scale summands *) +(* (CARLESON_ PSI_SUMMAND_SCHWARTZ_ALL), via SCHWARTZ_VSUM. *) +let CARLESON_KWINDOW_INTEGRAND_SCHWARTZ = prove + (`!(h:real->complex) z K. + schwartz h + ==> schwartz (\y. fourier h y * Cx(sum {k:int | abs k <= &K} (\k. + carleson_psi z k y)))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\y. fourier h y * Cx(sum {k:int | abs k <= &K} (\k. carleson_psi z k y))) + = + (\y. vsum {k:int | abs k <= &K} (\k. fourier h y * Cx(carleson_psi z k + y)))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + SIMP_TAC[CX_VSUM; CFOURIER_INDEX_FINITE] THEN + SIMP_TAC[GSYM VSUM_COMPLEX_LMUL; CFOURIER_INDEX_FINITE]; ALL_TAC] THEN + MP_TAC(ISPECL [`\k y. fourier (h:real->complex) y * Cx(carleson_psi z k y)`; + `{k:int | abs k <= &K}`] SCHWARTZ_VSUM) THEN + REWRITE_TAC[CFOURIER_INDEX_FINITE] THEN BETA_TAC THEN + DISCH_THEN MATCH_MP_TAC THEN + X_GEN_TAC `k:int` THEN DISCH_TAC THEN + MATCH_MP_TAC CARLESON_PSI_SUMMAND_SCHWARTZ_ALL THEN ASM_REWRITE_TAC[]);; + +(* Generic tile-window bound: for any h and any g with |g| <= 1 whose *) +(* modulated *) +(* integrand hhat * Cx g is absolutely integrable, the window 2pi (hhat *) +(* g)check *) +(* is bounded by sqrt(2pi) int|hhat|, UNIFORMLY in x. (Fremlin's window *) +(* estimate; *) +(* both the theta-window and the K-partial-sum window are instances. Only *) +(* |g|<=1 *) +(* and integrability of the modulated integrand are used -- via *) +(* FOURIER_BOUND + *) +(* int|hhat g| <= int|hhat|.) *) +let CARLESON_WINDOW_BOUND_GENERIC = prove + (`!(h:real->complex) g x. + schwartz h /\ (!y. abs(g y) <= &1) /\ + (\z. fourier h (drop z) * Cx(g(drop z))) absolutely_integrable_on + (:real^1) + ==> norm(Cx(&2 * pi) * fourier (\y. fourier h y * Cx(g y)) (--x)) + <= sqrt(&2 * pi) * + drop(integral (:real^1) (\y. lift(norm(fourier (h:real->complex) + (drop y)))))`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX] THEN + SUBGOAL_THEN `abs(&2 * pi) = &2 * pi` SUBST1_TAC THENL + [REWRITE_TAC[REAL_ABS_REFL] THEN MP_TAC PI_POS THEN + REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPECL [`\y. fourier (h:real->complex) y * Cx(g y)`; + `--x:real`] FOURIER_BOUND) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MP_TAC(ISPECL [`( * ):complex->complex->complex`; + `\u:real^1. cexp(--(ii * Cx(--x) * Cx(drop u)))`; + `\u:real^1. fourier (h:real->complex) (drop u) * Cx(g(drop + u))`; + `(:real^1)`] + ABSOLUTELY_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT) THEN + REWRITE_TAC[BILINEAR_COMPLEX_MUL] THEN BETA_TAC THEN DISCH_THEN + MATCH_MP_TAC THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_IMP_MEASURABLE_ON THEN + SUBGOAL_THEN + `(\u:real^1. cexp(--(ii * Cx(--x) * Cx(drop u)))) = + cexp o (\u. --((ii * Cx(--x)) * Cx(drop u)))` + SUBST1_TAC THENL [REWRITE_TAC[o_DEF; COMPLEX_MUL_ASSOC]; ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + REWRITE_TAC[CONTINUOUS_ON_CEXP] THEN + MATCH_MP_TAC CONTINUOUS_ON_NEG THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN + REWRITE_TAC[CONTINUOUS_ON_CONST] THEN + MATCH_MP_TAC CONTINUOUS_ON_CX_DROP THEN + REWRITE_TAC[CONTINUOUS_ON_ID]; + REWRITE_TAC[bounded; FORALL_IN_IMAGE] THEN EXISTS_TAC `&1` THEN + X_GEN_TAC `u:real^1` THEN REWRITE_TAC[IN_UNIV] THEN + SUBGOAL_THEN + `--(ii * Cx(--x) * Cx(drop u)) = + ii * Cx(--(--x * drop u))` SUBST1_TAC THENL + [REWRITE_TAC[CX_NEG; CX_MUL] THEN + SIMPLE_COMPLEX_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[NORM_CEXP_II; REAL_LE_REFL]; + ASM_REWRITE_TAC[]]; + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + DISCH_TAC THEN + SUBGOAL_THEN `&0 < sqrt(&2 * pi)` ASSUME_TAC THENL + [MATCH_MP_TAC SQRT_POS_LT THEN MP_TAC PI_POS THEN + REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `(&2 * pi) * (&1 / sqrt(&2 * pi)) = sqrt(&2 * pi)` ASSUME_TAC THENL + [MP_TAC(SPEC `&2 * pi` SQRT_POW_2) THEN + ANTS_TAC THENL [MP_TAC PI_POS THEN REAL_ARITH_TAC; ALL_TAC] THEN + POP_ASSUM MP_TAC THEN CONV_TAC REAL_FIELD; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(&2 * pi) * + (&1 / sqrt(&2 * pi) * + drop(integral (:real^1) + (\y. lift(norm(fourier (h:real->complex) (drop y) * Cx(g(drop + y)))))))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MP_TAC PI_POS THEN REAL_ARITH_TAC; ASM_REWRITE_TAC[]]; ALL_TAC] THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC INTEGRAL_DROP_LE THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN + MP_TAC(ISPEC `h:real->complex` SCHWARTZ_FHAT_ABSINT) THEN + ASM_REWRITE_TAC[]; + X_GEN_TAC `y:real^1` THEN REWRITE_TAC[IN_UNIV; LIFT_DROP] THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[NORM_POS_LE] THEN + ASM_REWRITE_TAC[]]);; + +(* R2d-1: the K-partial-sum window is bounded by sqrt(2pi) int|hhat| *) +(* uniformly *) +(* in z, K, x -- an instance of CARLESON_WINDOW_BOUND_GENERIC at g = the *) +(* partial *) +(* sum (|g|<=1 by CARLESON_PSI_PARTIAL_BOUNDS, integrand Schwartz by *) +(* CARLESON_ *) +(* KWINDOW_INTEGRAND_SCHWARTZ). This is the constant x-dominator for the *) +(* DCT. *) +let CARLESON_KWINDOW_UNIFORM_BOUND = prove + (`!(h:real->complex) z K x. + schwartz h + ==> norm(Cx(&2 * pi) * + fourier (\y. fourier h y * Cx(sum {k:int | abs k <= &K} (\k. + carleson_psi z k y))) (--x)) + <= sqrt(&2 * pi) * + drop(integral (:real^1) (\y. lift(norm(fourier (h:real->complex) + (drop y)))))`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC CARLESON_WINDOW_BOUND_GENERIC THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [GEN_TAC THEN + MP_TAC(ISPECL [`z:real`; `y:real`; `K:num`] + CARLESON_PSI_PARTIAL_BOUNDS) THEN + ABBREV_TAC `S = sum {k:int | abs k <= &K} (\k. carleson_psi z k y)` THEN + REAL_ARITH_TAC; + MP_TAC(ISPECL [`h:real->complex`; `z:real`; + `K:num`] CARLESON_KWINDOW_INTEGRAND_SCHWARTZ) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP SCHWARTZ_ABSINT) THEN + REWRITE_TAC[]]);; + +(* ========================================================================= *) +(* R2d STEP A (Fremlin 286O-b-iv, the inner dominated-convergence pass): the *) +(* K-partial-sum window converges POINTWISE IN x to the theta window. This *) +(* is DOMINATED_CONVERGENCE on the y-integral inside fourier, with dominator *) +(* norm(hhat) (|cexp|=1, |sum_K psi|<=1), then multiply through by the *) +(* fourier *) +(* constant. *) +(* ========================================================================= *) + +(* A cexp-modulated Schwartz integrand is integrable on the whole line *) +(* (bounded measurable cexp times an absolutely integrable Schwartz *) +(* function). *) +let SCHWARTZ_MODULATED_INTEGRABLE = prove + (`!(f:real->complex) x. schwartz f + ==> (\u. cexp(--(ii * Cx(--x) * Cx(drop u))) * f(drop u)) integrable_on + (:real^1)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SCHWARTZ_MOD_INT THEN ASM_REWRITE_TAC[]);; + +(* The raw fourier-integral of the K-partial-sum window converges to that of *) +(* the theta window (DOMINATED_CONVERGENCE in y; dominator norm(hhat), *) +(* ptwise limit from CARLESON_PSI_SUM_LIMIT, |sum_K psi|<=1 by *) +(* PARTIAL_BOUNDS). *) +let CARLESON_KWINDOW_INTEGRAL_LIMIT = prove + (`!(h:real->complex) z x. + schwartz h + ==> ((\K. integral (:real^1) + (\u. cexp(--(ii * Cx(--x) * Cx(drop u))) * + (fourier h (drop u) * Cx(sum {k:int | abs k <= &K} (\k. + carleson_psi z k (drop u)))))) + --> integral (:real^1) + (\u. cexp(--(ii * Cx(--x) * Cx(drop u))) * + (fourier h (drop u) * Cx(carleson_theta z (drop u))))) + sequentially`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`\K u. cexp(--(ii * Cx(--x) * Cx(drop u))) * + (fourier (h:real->complex) (drop u) * Cx(sum {k:int | abs k <= &K} + (\k. carleson_psi z k (drop u))))`; + `\u. cexp(--(ii * Cx(--x) * Cx(drop u))) * + (fourier (h:real->complex) (drop u) * Cx(carleson_theta z (drop u)))`; + `\u:real^1. lift(norm(fourier (h:real->complex) (drop u)))`; + `(:real^1)`] DOMINATED_CONVERGENCE) THEN + REWRITE_TAC[] THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [X_GEN_TAC `N:num` THEN + MP_TAC(ISPECL [`\y. fourier (h:real->complex) y * Cx(sum {k:int | abs k + <= &N} (\k. carleson_psi z k y))`; + `x:real`] SCHWARTZ_MODULATED_INTEGRABLE) THEN + REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + MATCH_MP_TAC CARLESON_KWINDOW_INTEGRAND_SCHWARTZ THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN + MP_TAC(ISPEC `h:real->complex` SCHWARTZ_FHAT_ABSINT) THEN + ASM_REWRITE_TAC[]; + MAP_EVERY X_GEN_TAC [`N:num`; `w:real^1`] THEN DISCH_TAC THEN + REWRITE_TAC[LIFT_DROP; COMPLEX_NORM_MUL; COMPLEX_NORM_CX] THEN + SUBGOAL_THEN `norm(cexp(--(ii * Cx(--x) * Cx(drop(w:real^1))))) = &1` + (fun th -> REWRITE_TAC[th]) THENL + [SUBGOAL_THEN + `--(ii * Cx(--x) * Cx(drop(w:real^1))) = ii * Cx(--(--x * drop w))` + SUBST1_TAC THENL + [REWRITE_TAC[CX_NEG; CX_MUL] THEN + SIMPLE_COMPLEX_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[NORM_CEXP_II]; ALL_TAC] THEN + REWRITE_TAC[REAL_MUL_LID] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[NORM_POS_LE] THEN + MP_TAC(ISPECL [`z:real`; `drop(w:real^1)`; + `N:num`] CARLESON_PSI_PARTIAL_BOUNDS) THEN + ABBREV_TAC `S = sum {k:int | abs k <= &N} (\k. carleson_psi z k + (drop(w:real^1)))` THEN + REAL_ARITH_TAC; + X_GEN_TAC `w:real^1` THEN DISCH_TAC THEN + REPEAT(MATCH_MP_TAC LIM_COMPLEX_LMUL) THEN + MP_TAC(ISPECL [`z:real`; `drop(w:real^1)`] CARLESON_PSI_SUM_LIMIT) THEN + REWRITE_TAC[REALLIM_COMPLEX; o_DEF]]; + DISCH_THEN(ACCEPT_TAC o CONJUNCT2)]);; + +(* Abstract fourier-value limit: if the raw modulated integrals converge, so *) +(* do *) +(* the fourier values (fourier = Cx(1/sqrt(2pi)) * that integral). *) +(* Abstracting *) +(* over the window family ff/gg keeps any inner fourier folded. *) +let FOURIER_VALUE_LIM = prove + (`!(ff:num->real->complex) gg x. + ((\K. integral (:real^1) (\u. cexp(--(ii * Cx(--x) * Cx(drop u))) * ff K + (drop u))) + --> integral (:real^1) (\u. cexp(--(ii * Cx(--x) * Cx(drop u))) * gg(drop + u))) sequentially + ==> ((\K. fourier (ff K) (--x)) --> fourier gg (--x)) sequentially`, + REPEAT STRIP_TAC THEN REWRITE_TAC[fourier] THEN + MATCH_MP_TAC LIM_COMPLEX_LMUL THEN ASM_REWRITE_TAC[]);; + +(* R2d STEP A [KEY]: the K-partial-sum window fourier value converges *) +(* pointwise in x to the theta window fourier value. *) +let CARLESON_KWINDOW_FOURIER_LIMIT = prove + (`!(h:real->complex) z x. + schwartz h + ==> ((\K. fourier (\y. fourier h y * Cx(sum {k:int | abs k <= &K} (\k. + carleson_psi z k y))) (--x)) + --> fourier (\y. fourier h y * Cx(carleson_theta z y)) (--x)) + sequentially`, + REPEAT STRIP_TAC THEN + MP_TAC(BETA_RULE(ISPECL + [`\K y. fourier (h:real->complex) y * Cx(sum {k:int | abs k <= &K} (\k. + carleson_psi z k y))`; + `\y. fourier (h:real->complex) y * Cx(carleson_theta z y)`; + `x:real`] FOURIER_VALUE_LIM)) THEN + DISCH_THEN MATCH_MP_TAC THEN + ASM_SIMP_TAC[CARLESON_KWINDOW_INTEGRAL_LIMIT]);; + +(* R2d STEP B prerequisites: the K-partial-sum complex window is continuous *) +(* in x (fourier of the L^1 K-window integrand) and absolutely integrable on *) +(* any measurable region (continuous + uniformly bounded on a finite-measure *) +(* set). These supply the DCT integrability/measurability hypotheses for the *) +(* outer x-integral pass. *) +let CARLESON_KWINDOW_CONTINUOUS = prove + (`!(h:real->complex) z K. schwartz h + ==> (\x:real^1. Cx(&2 * pi) * + fourier (\y. fourier h y * Cx(sum {k:int | abs k <= &K} + (\k. carleson_psi z k y))) (--drop x)) + continuous_on (:real^1)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_LMUL THEN + SUBGOAL_THEN + `(\x:real^1. fourier (\y. fourier (h:real->complex) y * Cx(sum {k:int | abs + k <= &K} (\k. carleson_psi z k y))) (--drop x)) = + (\x:real^1. fourier (\y. fourier (h:real->complex) y * Cx(sum {k:int | abs + k <= &K} (\k. carleson_psi z k y))) (drop x)) o (\x. --x)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; o_THM; DROP_NEG]; ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_NEG THEN REWRITE_TAC[CONTINUOUS_ON_ID]; + MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `(:real^1)` THEN + REWRITE_TAC[SUBSET_UNIV] THEN + MP_TAC(ISPEC `\y. fourier (h:real->complex) y * Cx(sum {k:int | abs k <= + &K} (\k. carleson_psi z k y))` FOURIER_CONTINUOUS_ON) THEN + ANTS_TAC THENL + [REWRITE_TAC[] THEN MATCH_MP_TAC SCHWARTZ_ABSINT THEN + MATCH_MP_TAC CARLESON_KWINDOW_INTEGRAND_SCHWARTZ THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[]]]);; + +let CARLESON_KWINDOW_ABSINT = prove + (`!(h:real->complex) z K R. + schwartz h /\ real_measurable R + ==> (\x:real^1. Cx(&2 * pi) * + fourier (\y. fourier h y * Cx(sum {k:int | abs k <= &K} (\k. + carleson_psi z k y))) (--drop x)) + absolutely_integrable_on (IMAGE lift R)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE THEN + EXISTS_TAC `\x:real^1. lift(sqrt(&2 * pi) * + drop(integral (:real^1) (\y. lift(norm(fourier + (h:real->complex) (drop y))))))` THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_ON_MEASURABLE_SUBSET THEN + EXISTS_TAC `(:real^1)` THEN + REWRITE_TAC[SUBSET_UNIV] THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_IMP_MEASURABLE_ON THEN + MATCH_MP_TAC CARLESON_KWINDOW_CONTINUOUS THEN ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[GSYM REAL_MEASURABLE_MEASURABLE]]; + REWRITE_TAC[INTEGRABLE_ON_CONST] THEN DISJ2_TAC THEN + ASM_REWRITE_TAC[GSYM REAL_MEASURABLE_MEASURABLE]; + X_GEN_TAC `w:real^1` THEN REWRITE_TAC[IN_IMAGE] THEN + DISCH_THEN(X_CHOOSE_THEN `t:real` STRIP_ASSUME_TAC) THEN + REWRITE_TAC[LIFT_DROP] THEN + MP_TAC(ISPECL [`h:real->complex`; `z:real`; `K:num`; + `drop(w:real^1)`] CARLESON_KWINDOW_UNIFORM_BOUND) THEN + ASM_REWRITE_TAC[]]);; + +(* R2d STEP B [KEY, the outer dominated-convergence pass]: over any *) +(* measurable *) +(* region R, the K-partial-sum window integral converges to the theta window *) +(* (= carleson_w) integral. DOMINATED_CONVERGENCE over IMAGE lift R (finite *) +(* measure): ptwise-in-x conv = STEP A (CARLESON_KWINDOW_FOURIER_LIMIT) *) +(* times *) +(* Cx(2pi); constant x-dominator sqrt(2pi) int|hhat| *) +(* (CARLESON_KWINDOW_UNIFORM_ *) +(* BOUND); each K-window absint on R (CARLESON_KWINDOW_ABSINT). *) +let CARLESON_W_REGION_INTEGRAL_LIMIT = prove + (`!(h:real->complex) z R. + schwartz h /\ real_measurable R + ==> ((\K. integral (IMAGE lift R) + (\x. Cx(&2 * pi) * + fourier (\y. fourier h y * Cx(sum {k:int | abs k <= &K} + (\k. carleson_psi z k y))) (--drop x))) + --> integral (IMAGE lift R) (\x. carleson_w h z (drop x))) + sequentially`, + REPEAT STRIP_TAC THEN REWRITE_TAC[carleson_w] THEN + MP_TAC(ISPECL + [`\K x:real^1. Cx(&2 * pi) * + fourier (\y. fourier (h:real->complex) y * Cx(sum {k:int | abs k <= + &K} (\k. carleson_psi z k y))) (--drop x)`; + `\x:real^1. Cx(&2 * pi) * fourier (\y. fourier (h:real->complex) y * + Cx(carleson_theta z y)) (--drop x)`; + `\x:real^1. lift(sqrt(&2 * pi) * drop(integral (:real^1) (\y. + lift(norm(fourier (h:real->complex) (drop y))))))`; + `IMAGE lift R`] DOMINATED_CONVERGENCE) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [X_GEN_TAC `N:num` THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MP_TAC(ISPECL [`h:real->complex`; `z:real`; `N:num`; + `R:real->bool`] CARLESON_KWINDOW_ABSINT) THEN + ASM_REWRITE_TAC[]; + REWRITE_TAC[INTEGRABLE_ON_CONST] THEN DISJ2_TAC THEN + ASM_REWRITE_TAC[GSYM REAL_MEASURABLE_MEASURABLE]; + MAP_EVERY X_GEN_TAC [`N:num`; `w:real^1`] THEN DISCH_TAC THEN + REWRITE_TAC[LIFT_DROP] THEN + MATCH_MP_TAC CARLESON_KWINDOW_UNIFORM_BOUND THEN ASM_REWRITE_TAC[]; + X_GEN_TAC `w:real^1` THEN DISCH_TAC THEN + MATCH_MP_TAC LIM_COMPLEX_LMUL THEN + MATCH_MP_TAC CARLESON_KWINDOW_FOURIER_LIMIT THEN ASM_REWRITE_TAC[]]; + DISCH_THEN(ACCEPT_TAC o CONJUNCT2)]);; + +(* ========================================================================= *) +(* R2d STEP C + assembly (Fremlin 286O-b-iv complete): finite integral- *) +(* linearity moves int_R inside the finite k-sum, then combine with STEP B. *) +(* ========================================================================= *) + +(* Each per-scale window is continuous in x (fourier of the Schwartz per-k *) +(* integrand) and integrable on any measurable region (continuous + bounded *) +(* via |carleson_psi z k|<=1, WINDOW_BOUND_GENERIC; 2pi>1 transfers the *) +(* Cx(2pi) window bound to the bare window). *) +let CARLESON_PERKWINDOW_CONTINUOUS = prove + (`!(h:real->complex) z k. schwartz h + ==> (\x:real^1. fourier (\y. fourier h y * Cx(carleson_psi z k y)) (--drop + x)) + continuous_on (:real^1)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\x:real^1. fourier (\y. fourier (h:real->complex) y * Cx(carleson_psi z k + y)) (--drop x)) = + (\x:real^1. fourier (\y. fourier (h:real->complex) y * Cx(carleson_psi z k + y)) (drop x)) o (\x. --x)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; o_THM; DROP_NEG]; ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_ON_NEG THEN REWRITE_TAC[CONTINUOUS_ON_ID]; + MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `(:real^1)` THEN + REWRITE_TAC[SUBSET_UNIV] THEN + MP_TAC(ISPEC `\y. fourier (h:real->complex) y * Cx(carleson_psi z k y)` + FOURIER_CONTINUOUS_ON) THEN + ANTS_TAC THENL + [REWRITE_TAC[] THEN MATCH_MP_TAC SCHWARTZ_ABSINT THEN + MATCH_MP_TAC CARLESON_PSI_SUMMAND_SCHWARTZ_ALL THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[]]]);; + +let CARLESON_PSI_ABS_LE_1 = prove + (`!z k y. abs(carleson_psi z k y) <= &1`, + REPEAT GEN_TAC THEN + MP_TAC(ISPECL [`z:real`; `y:real`] CARLESON_THETA_BOUNDS) THEN + MP_TAC(ISPECL [`z:real`; `k:int`; `y:real`] CARLESON_PSI_CASES) THEN + REAL_ARITH_TAC);; + +let CARLESON_PERKWINDOW_INTEGRABLE = prove + (`!(h:real->complex) z k R. + schwartz h /\ real_measurable R + ==> (\x:real^1. fourier (\y. fourier h y * Cx(carleson_psi z k y)) (--drop + x)) + integrable_on (IMAGE lift R)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE THEN + EXISTS_TAC `\x:real^1. lift(sqrt(&2 * pi) * + drop(integral (:real^1) (\y. lift(norm(fourier + (h:real->complex) (drop y))))))` THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_ON_MEASURABLE_SUBSET THEN + EXISTS_TAC `(:real^1)` THEN + REWRITE_TAC[SUBSET_UNIV] THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_IMP_MEASURABLE_ON THEN + MATCH_MP_TAC CARLESON_PERKWINDOW_CONTINUOUS THEN ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[GSYM REAL_MEASURABLE_MEASURABLE]]; + REWRITE_TAC[INTEGRABLE_ON_CONST] THEN DISJ2_TAC THEN + ASM_REWRITE_TAC[GSYM REAL_MEASURABLE_MEASURABLE]; + X_GEN_TAC `w:real^1` THEN REWRITE_TAC[IN_IMAGE] THEN + DISCH_THEN(X_CHOOSE_THEN `t:real` STRIP_ASSUME_TAC) THEN + REWRITE_TAC[LIFT_DROP] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `norm(Cx(&2 * pi) * fourier (\y. fourier (h:real->complex) y * + Cx(carleson_psi z k y)) (--drop w))` THEN + CONJ_TAC THENL + [REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN + MP_TAC PI_APPROX_32 THEN REAL_ARITH_TAC; + MP_TAC(ISPECL [`h:real->complex`; `\y. carleson_psi z k y`; + `drop(w:real^1)`] CARLESON_WINDOW_BOUND_GENERIC) THEN + REWRITE_TAC[ETA_AX] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[CARLESON_PSI_ABS_LE_1] THEN + MP_TAC(ISPECL [`h:real->complex`; `k:int`; + `z:real`] CARLESON_PSI_SUMMAND_SCHWARTZ_ALL) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o MATCH_MP SCHWARTZ_ABSINT) THEN + REWRITE_TAC[]]]);; + +(* STEP C: int_R of the K-partial-sum window = Cx(2pi) times the finite *) +(* k-sum of per-scale window integrals (CARLESON_PSI_FOURIER_KSUM inside + *) +(* INTEGRAL_VSUM + INTEGRAL_COMPLEX_LMUL; each per-k window integrable on *) +(* R). *) +let CARLESON_W_REGION_KSUM_EQ = prove + (`!(h:real->complex) z K R. + schwartz h /\ real_measurable R + ==> integral (IMAGE lift R) + (\x. Cx(&2 * pi) * + fourier (\y. fourier h y * Cx(sum {k:int | abs k <= &K} (\k. + carleson_psi z k y))) (--drop x)) = + Cx(&2 * pi) * + vsum {k:int | abs k <= &K} + (\k. integral (IMAGE lift R) + (\x. fourier (\y. fourier h y * Cx(carleson_psi z k y)) + (--drop x)))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `!x:real^1. fourier (\y. fourier (h:real->complex) y * Cx(sum {k:int | abs k + <= &K} (\k. carleson_psi z k y))) (--drop x) = + vsum {k:int | abs k <= &K} (\k. fourier (\y. fourier h y * + Cx(carleson_psi z k y)) (--drop x))` + ASSUME_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC CARLESON_PSI_FOURIER_KSUM THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL + [`\k x:real^1. fourier (\y. fourier (h:real->complex) y * Cx(carleson_psi z + k y)) (--drop x)`; + `IMAGE lift R`; `{k:int | abs k <= &K}`] INTEGRAL_VSUM) THEN + REWRITE_TAC[CFOURIER_INDEX_FINITE] THEN BETA_TAC THEN + ANTS_TAC THENL + [X_GEN_TAC `k:int` THEN DISCH_TAC THEN + MATCH_MP_TAC CARLESON_PERKWINDOW_INTEGRABLE THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(fun th -> REWRITE_TAC[SYM th]) THEN + ASM_SIMP_TAC[INTEGRAL_COMPLEX_LMUL; INTEGRABLE_VSUM; CFOURIER_INDEX_FINITE; + CARLESON_PERKWINDOW_INTEGRABLE]);; + +(* R2d COMPLETE (Fremlin 286O-b-iv): int_R carleson_w = lim_K Cx(2pi) * *) +(* sum_{abs k<=K} int_R (per-k window). Combines STEP B (CARLESON_W_REGION_ *) +(* INTEGRAL_LIMIT) with STEP C (CARLESON_W_REGION_KSUM_EQ) by rewriting the *) +(* K-window integral sequence. *) +let CARLESON_W_REGION_KSUM = prove + (`!(h:real->complex) z R. + schwartz h /\ real_measurable R + ==> ((\K. Cx(&2 * pi) * + vsum {k:int | abs k <= &K} + (\k. integral (IMAGE lift R) + (\x. fourier (\y. fourier h y * Cx(carleson_psi z k + y)) (--drop x)))) + --> integral (IMAGE lift R) (\x. carleson_w h z (drop x))) + sequentially`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\K. Cx(&2 * pi) * + vsum {k:int | abs k <= &K} + (\k. integral (IMAGE lift R) + (\x. fourier (\y. fourier (h:real->complex) y * + Cx(carleson_psi z k y)) (--drop x)))) = + (\K. integral (IMAGE lift R) + (\x. Cx(&2 * pi) * + fourier (\y. fourier h y * Cx(sum {k:int | abs k <= &K} (\k. + carleson_psi z k y))) (--drop x)))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `K:num` THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC CARLESON_W_REGION_KSUM_EQ THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC CARLESON_W_REGION_INTEGRAL_LIMIT THEN ASM_REWRITE_TAC[]);; + +(* R3c: the R2d k-sum over an ARBITRARY measurable real^1 piece P (not just *) +(* IMAGE *) +(* lift R). Since P = IMAGE lift (IMAGE drop P) and real_measurable(IMAGE *) +(* drop P) <=> *) +(* measurable P (REAL_MEASURABLE_MEASURABLE), CARLESON_W_REGION_KSUM applies *) +(* verbatim. *) +(* This lets the 286P cell-pieces F' INTER cell j feed the tile-sum. *) +let CARLESON_W_PIECE_KSUM = prove + (`!(h:real->complex) z P. + schwartz h /\ measurable P + ==> ((\K. Cx(&2 * pi) * + vsum {k:int | abs k <= &K} + (\k. integral P (\x. fourier (\y. fourier h y * + Cx(carleson_psi z k y)) (--drop x)))) + --> integral P (\x. carleson_w h z (drop x))) + sequentially`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`h:real->complex`; `z:real`; + `IMAGE drop (P:real^1->bool)`] CARLESON_W_REGION_KSUM) THEN + ANTS_TAC THENL + [REWRITE_TAC[REAL_MEASURABLE_MEASURABLE] THEN + SUBGOAL_THEN + `IMAGE lift (IMAGE drop (P:real^1->bool)) = P` (fun th -> + ASM_REWRITE_TAC[th]) THEN + REWRITE_TAC[GSYM IMAGE_o; o_DEF; LIFT_DROP; IMAGE_ID]; + SUBGOAL_THEN + `IMAGE lift (IMAGE drop (P:real^1->bool)) = P` SUBST1_TAC THENL + [REWRITE_TAC[GSYM IMAGE_o; o_DEF; LIFT_DROP; IMAGE_ID]; + REWRITE_TAC[]]]);; + +(* R3d helper: pull a complex scalar Cx c out of a region integral of a *) +(* Schwartz *) +(* fourier-window. Cx c * int_P fourier g(--) = int_P fourier(Cx c * g)(--), *) +(* via *) +(* FOURIER_LMUL (constant into fourier) + INTEGRAL_COMPLEX_LMUL (fourier *) +(* g(--) is absolutely integrable on P, being a reflected Schwartz Fourier *) +(* transform). *) +let FOURIER_REGION_CMUL = prove + (`!(g:real->complex) c P. + schwartz g /\ measurable P + ==> Cx c * integral P (\x. fourier g (--drop x)) = + integral P (\x. fourier (\y. Cx c * g y) (--drop x))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `!x:real^1. fourier (\y. Cx c * (g:real->complex) y) (--drop x) = Cx c * + fourier g (--drop x)` + (fun th -> REWRITE_TAC[th]) THENL + [X_GEN_TAC `x:real^1` THEN MATCH_MP_TAC FOURIER_LMUL THEN + MATCH_MP_TAC SCHWARTZ_MODULATED_INTEGRABLE THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC INTEGRAL_COMPLEX_LMUL THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN + EXISTS_TAC `(:real^1)` THEN + ASM_SIMP_TAC[SUBSET_UNIV; MEASURABLE_IMP_LEBESGUE_MEASURABLE] THEN + SUBGOAL_THEN `schwartz (\x. fourier (g:real->complex) (--x))` MP_TAC THENL + [MP_TAC(ISPEC `fourier (g:real->complex)` SCHWARTZ_REFLECT) THEN + ANTS_TAC THENL [MATCH_MP_TAC SCHWARTZ_FOURIER THEN + ASM_REWRITE_TAC[]; REWRITE_TAC[]]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o MATCH_MP SCHWARTZ_ABSINT) THEN REWRITE_TAC[]);; + +(* R3d per-cell-per-scale [KEY]: for a witnessing tile (z in Jr(k,nI0,nJ)) *) +(* and any *) +(* measurable region P, the nI-partial-sum of int_P phi_sigma *) +(* converges *) +(* to 2pi int_P (hhat psi_k)check. This is CARLESON_PERK_286OB (gg from *) +(* CHIHAT_REP, *) +(* carleson_psi = the bare Re^2 bump via PSI_BARE, Cx(2pi) pulled via *) +(* FOURIER_REGION_ *) +(* CMUL). Connects the 286N tile-sum side to the R3c PIECE_KSUM per-k window *) +(* side. *) +let CARLESON_PERK_PIECE_LIMIT = prove + (`!(h:real->complex) k nI0 nJ z P. + schwartz h /\ measurable P /\ z IN tile_Jr(k,nI0,nJ) + ==> ((\N. vsum {nI:int | abs nI <= &N} + (\nI. carleson_ip h (k,nI,nJ) * + integral P (\z. phi_sigma (k,nI,nJ) carleson_phi (drop + z)))) + --> Cx(&2 * pi) * integral P (\x. fourier (\y. fourier h y * + Cx(carleson_psi z k y)) (--drop x))) + sequentially`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `z IN tile_Jr(k,&0,nJ)` ASSUME_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE[tile_Jr]) THEN + ASM_REWRITE_TAC[tile_Jr]; ALL_TAC] THEN + SUBGOAL_THEN + `(\y. fourier (h:real->complex) y * Cx(carleson_psi z k y)) = + (\y. fourier h y * Cx(Re(fourier carleson_phi (&2 zpow (--k) * (y - + tile_ymid(k,&0,nJ)))) pow 2))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + MATCH_MP_TAC CARLESON_PSI_BARE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL [`\y. fourier (h:real->complex) y * Cx(Re(fourier carleson_phi + (&2 zpow (--k) * (y - tile_ymid(k,&0,nJ)))) pow 2)`; + `&2 * pi`; `P:real^1->bool`] FOURIER_REGION_CMUL) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CARLESON_PERK_LIMFN0_SCHWARTZ THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN + MP_TAC(ISPEC `P:real^1->bool` CARLESON_CHIHAT_REP) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `gg:real^1->complex` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`h:real->complex`; `k:int`; `nJ:int`; `P:real^1->bool`; + `gg:real^1->complex`] CARLESON_PERK_286OB) THEN + ASM_REWRITE_TAC[]);; + +(* R3e norm-limit principle: a UNIFORM-in-K bound on the K-partial tile-sum *) +(* norms transfers to the limit int_P carleson_w (LIM_NORM_UBOUND on *) +(* CARLESON_W_PIECE_KSUM). Converts a per-cell tile-sum bound into the *) +(* per-cell window-integral bound the triangle inequality *) +(* (CARLESON_WSEL_INTEGRAL_TRIANGLE) needs. *) +let CARLESON_WSEL_KSUM = prove + (`!(h:real->complex) u n FF F'. + schwartz h /\ real_measurable FF /\ measurable F' /\ F' SUBSET (IMAGE lift + FF) + ==> ((\K. Cx(&2 * pi) * + vsum {j:num | j <= n} + (\j. vsum {k:int | abs k <= &K} + (\k. integral (F' INTER {x:real^1 | cargmax (\i:num. + carleson_v h (u i)) n (drop x) = j}) + (\x. fourier (\y. fourier h y * Cx(carleson_psi (u j) k + y)) (--drop x))))) + --> integral F' (\x:real^1. carleson_wsel h u n (drop x))) + sequentially`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`h:real->complex`; `u:num->real`; `n:num`; `FF:real->bool`; + `F':real^1->bool`] + CARLESON_WSEL_REGION_DECOMP) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + SUBGOAL_THEN + `(\K. Cx(&2 * pi) * + vsum {j:num | j <= n} + (\j. vsum {k:int | abs k <= &K} + (\k. integral (F' INTER {x:real^1 | cargmax (\i:num. + carleson_v h (u i)) n (drop x) = j}) + (\x. fourier (\y. fourier h y * Cx(carleson_psi (u j) k + y)) (--drop x))))) = + (\K. vsum {j:num | j <= n} + (\j. Cx(&2 * pi) * vsum {k:int | abs k <= &K} + (\k. integral (F' INTER {x:real^1 | cargmax (\i:num. + carleson_v h (u i)) n (drop x) = j}) + (\x. fourier (\y. fourier h y * Cx(carleson_psi (u j) k + y)) (--drop x)))))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + ASM_SIMP_TAC[GSYM VSUM_COMPLEX_LMUL; FINITE_NUMSEG_LE]; ALL_TAC] THEN + MATCH_MP_TAC LIM_VSUM THEN REWRITE_TAC[FINITE_NUMSEG_LE] THEN + X_GEN_TAC `j:num` THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN + MATCH_MP_TAC CARLESON_W_PIECE_KSUM THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MEASURABLE_LEBESGUE_MEASURABLE_SUBSET THEN + EXISTS_TAC `F':real^1->bool` THEN + ASM_SIMP_TAC[CARLESON_WSEL_PIECE_LMEAS; INTER_SUBSET]);; + +(* 286P(b) reduction: a UNIFORM-in-K bound B on the aggregate double-sum *) +(* norm yields norm(int_F' carleson_wsel) <= B (LIM_NORM_UBOUND on *) +(* CARLESON_WSEL_KSUM). This reduces CARLESON_WSEL_INTEGRAL_BOUND to a *) +(* per-K finite tile-double-sum bound (then regroup-by-tile + uniform *) +(* CARLESON_286N once). *) +let CARLESON_WSEL_PERKTERM_LIMIT = prove + (`!(h:real->complex) (z:real) P k. + schwartz h /\ measurable P + ==> ((\N. if (?nJ:int. z IN tile_Jr(k,&0,nJ)) + then vsum {nI:int | abs nI <= &N} + (\nI. carleson_ip h (k,nI,(@nJ:int. z IN + tile_Jr(k,&0,nJ))) * + integral P (\w. phi_sigma (k,nI,(@nJ:int. z IN + tile_Jr(k,&0,nJ))) carleson_phi (drop w))) + else vec 0) + --> Cx(&2 * pi) * integral P (\x. fourier (\y. fourier h y * + Cx(carleson_psi z k y)) (--drop x))) + sequentially`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `?nJ:int. (z:real) IN tile_Jr(k,&0,nJ)` THEN + ASM_REWRITE_TAC[] THENL + [FIRST_X_ASSUM(X_CHOOSE_TAC `nJw:int`) THEN + SUBGOAL_THEN + `(z:real) IN tile_Jr(k,&0,(@nJ:int. z IN tile_Jr(k,&0,nJ)))` + ASSUME_TAC THENL + [CONV_TAC SELECT_CONV THEN EXISTS_TAC `nJw:int` THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL [`h:real->complex`; `k:int`; `&0:int`; + `(@nJ:int. (z:real) IN tile_Jr(k,&0,nJ))`; `z:real`; + `P:real^1->bool`] CARLESON_PERK_PIECE_LIMIT) THEN + ASM_REWRITE_TAC[]; + SUBGOAL_THEN + `!y. carleson_psi (z:real) k y = &0` (fun th -> REWRITE_TAC[th]) THENL + [GEN_TAC THEN MATCH_MP_TAC CARLESON_PSI_ZERO THEN + ASM_MESON_TAC[]; ALL_TAC] THEN + REWRITE_TAC[COMPLEX_MUL_RZERO; FOURIER_0] THEN + SUBGOAL_THEN `integral P (\x:real^1. Cx(&0)) = Cx(&0)` SUBST1_TAC THENL + [REWRITE_TAC[GSYM COMPLEX_VEC_0; INTEGRAL_0]; ALL_TAC] THEN + REWRITE_TAC[COMPLEX_MUL_RZERO; GSYM COMPLEX_VEC_0; LIM_CONST]]);; + +(* The argmax-cell piece F' INTER cell_j is measurable (F' measurable + cell *) +(* lebesgue-measurable + INTER_SUBSET, via *) +(* MEASURABLE_LEBESGUE_MEASURABLE_SUBSET). *) +let CARLESON_CELL_PIECE_MEASURABLE = prove + (`!(h:real->complex) u n F' j. + schwartz h /\ measurable F' + ==> measurable (F' INTER {x:real^1 | cargmax (\i:num. carleson_v h (u i)) n + (drop x) = j})`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_LEBESGUE_MEASURABLE_SUBSET THEN + EXISTS_TAC `F':real^1->bool` THEN + ASM_SIMP_TAC[CARLESON_WSEL_PIECE_LMEAS; INTER_SUBSET]);; + +(* Inner N-limit at fixed K: the guarded (j,k,nI) triple-sum converges *) +(* (N->inf) to *) +(* the WSEL_KSUM K-aggregate (in per-term Cx(2pi) form). Double LIM_VSUM *) +(* over the *) +(* finite cell set j<=n (FINITE_NUMSEG_LE) and scale set abs k<=K *) +(* (CARLESON_FINITE_ *) +(* KSEG), each (j,k)-term = CARLESON_WSEL_PERKTERM_LIMIT at z:=u j, P:= F' *) +(* INTER *) +(* cell_j (measurable via *) +(* CARLESON_CELL_PIECE_MEASURABLE). Cx(2pi) stays per-term (recovered *) +(* outside via *) +(* VSUM_COMPLEX_LMUL when wiring to CARLESON_WSEL_KSUM). *) +let CARLESON_WSEL_PERK_INNER_LIMIT = prove + (`!(h:real->complex) u n FF F' K. + schwartz h /\ real_measurable FF /\ measurable F' /\ F' SUBSET (IMAGE lift + FF) + ==> ((\N. vsum {j:num | j <= n} + (\j. vsum {k:int | abs k <= &K} + (\k. if (?nJ:int. (u j) IN tile_Jr(k,&0,nJ)) + then vsum {nI:int | abs nI <= &N} + (\nI. carleson_ip h (k,nI,(@nJ:int. (u j) IN + tile_Jr(k,&0,nJ))) * + integral (F' INTER {x:real^1 | cargmax + (\i:num. carleson_v h (u i)) n (drop x) = + j}) + (\w. phi_sigma (k,nI,(@nJ:int. (u j) IN + tile_Jr(k,&0,nJ))) carleson_phi (drop + w))) + else vec 0))) + --> vsum {j:num | j <= n} + (\j. vsum {k:int | abs k <= &K} + (\k. Cx(&2 * pi) * integral (F' INTER {x:real^1 | cargmax + (\i:num. carleson_v h (u i)) n (drop x) = j}) + (\x. fourier (\y. fourier h y * Cx(carleson_psi (u j) k + y)) (--drop x))))) + sequentially`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC LIM_VSUM THEN REWRITE_TAC[FINITE_NUMSEG_LE] THEN + X_GEN_TAC `j:num` THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN + MATCH_MP_TAC LIM_VSUM THEN REWRITE_TAC[CARLESON_FINITE_KSEG] THEN + X_GEN_TAC `k:int` THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`h:real->complex`; `(u:num->real) j`; + `F' INTER {x:real^1 | cargmax (\i:num. carleson_v (h:real->complex) (u i)) + n (drop x) = j}`; + `k:int`] CARLESON_WSEL_PERKTERM_LIMIT) THEN + ASM_SIMP_TAC[CARLESON_CELL_PIECE_MEASURABLE]);; + +(* WSEL_KSUM in per-term Cx(2pi) form: the K-aggregate a_K = the double sum *) +(* with *) +(* Cx(2pi) distributed inside each term (VSUM_COMPLEX_LMUL twice, over the *) +(* finite *) +(* cell + scale sets), which converges to int_F' wsel by CARLESON_WSEL_KSUM. *) +(* Matches *) +(* CARLESON_WSEL_PERK_INNER_LIMIT's RHS so the two feed LIM_DIAGONAL_SEQ. *) +let CARLESON_WSEL_KSUM_PERTERM = prove + (`!(h:real->complex) u n FF F'. + schwartz h /\ real_measurable FF /\ measurable F' /\ F' SUBSET (IMAGE lift + FF) + ==> ((\K. vsum {j:num | j <= n} + (\j. vsum {k:int | abs k <= &K} + (\k. Cx(&2 * pi) * integral (F' INTER {x:real^1 | cargmax + (\i:num. carleson_v h (u i)) n (drop x) = j}) + (\x. fourier (\y. fourier h y * Cx(carleson_psi (u j) k + y)) (--drop x))))) + --> integral F' (\x:real^1. carleson_wsel h u n (drop x))) + sequentially`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\K. vsum {j:num | j <= n} + (\j. vsum {k:int | abs k <= &K} + (\k. Cx(&2 * pi) * integral (F' INTER {x:real^1 | cargmax + (\i:num. carleson_v (h:real->complex) (u i)) n (drop x) = + j}) + (\x. fourier (\y. fourier h y * Cx(carleson_psi (u j) k + y)) (--drop x))))) = + (\K. Cx(&2 * pi) * + vsum {j:num | j <= n} + (\j. vsum {k:int | abs k <= &K} + (\k. integral (F' INTER {x:real^1 | cargmax (\i:num. + carleson_v h (u i)) n (drop x) = j}) + (\x. fourier (\y. fourier h y * Cx(carleson_psi (u j) k + y)) (--drop x)))))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `K:num` THEN + ASM_SIMP_TAC[VSUM_COMPLEX_LMUL; FINITE_NUMSEG_LE; + CARLESON_FINITE_KSEG] THEN + AP_TERM_TAC THEN MATCH_MP_TAC VSUM_EQ THEN + X_GEN_TAC `j:num` THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN + ASM_SIMP_TAC[VSUM_COMPLEX_LMUL; CARLESON_FINITE_KSEG]; ALL_TAC] THEN + MP_TAC(ISPECL [`h:real->complex`; `u:num->real`; `n:num`; `FF:real->bool`; + `F':real^1->bool`] + CARLESON_WSEL_KSUM) THEN ASM_REWRITE_TAC[]);; + +(* Diagonal collapse (LIM_DIAGONAL_SEQ): from a_K --> int_F' wsel *) +(* (KSUM_PERTERM) and *) +(* the per-fixed-K inner limit b_{K,N} --> a_K (PERK_INNER_LIMIT), extract a *) +(* single *) +(* diagonal nfun with (\K. b_{K, nfun K}) --> int_F' wsel. b_{K,N} is the *) +(* guarded *) +(* (j,k,nI) triple-sum truncated at scale K, nI-index N. This fuses the *) +(* nested lim_K/ *) +(* lim_N of the tile-limit into one sequential limit -- the analytic core of *) +(* 286P(b). *) +let CARLESON_WSEL_DIAG_LIMIT = prove + (`!(h:real->complex) u n FF F'. + schwartz h /\ real_measurable FF /\ measurable F' /\ F' SUBSET (IMAGE lift + FF) + ==> ?nfun:num->num. + ((\K. vsum {j:num | j <= n} + (\j. vsum {k:int | abs k <= &K} + (\k. if (?nJ:int. (u j) IN tile_Jr(k,&0,nJ)) + then vsum {nI:int | abs nI <= &(nfun K)} + (\nI. carleson_ip h (k,nI,(@nJ:int. (u j) IN + tile_Jr(k,&0,nJ))) * + integral (F' INTER {x:real^1 | cargmax + (\i:num. carleson_v h (u i)) n (drop x) = + j}) + (\w. phi_sigma (k,nI,(@nJ:int. (u j) IN + tile_Jr(k,&0,nJ))) carleson_phi (drop + w))) + else vec 0))) + --> integral F' (\x:real^1. carleson_wsel h u n (drop x))) + sequentially`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`\K N. vsum {j:num | j <= n} + (\j. vsum {k:int | abs k <= &K} + (\k. if (?nJ:int. (u j) IN tile_Jr(k,&0,nJ)) + then vsum {nI:int | abs nI <= &N} + (\nI. carleson_ip h (k,nI,(@nJ:int. (u j) IN + tile_Jr(k,&0,nJ))) * + integral (F' INTER {x:real^1 | cargmax + (\i:num. carleson_v h (u i)) n (drop x) = + j}) + (\w. phi_sigma (k,nI,(@nJ:int. (u j) IN + tile_Jr(k,&0,nJ))) carleson_phi (drop + w))) + else vec 0))`; + `\K. vsum {j:num | j <= n} + (\j. vsum {k:int | abs k <= &K} + (\k. Cx(&2 * pi) * integral (F' INTER {x:real^1 | cargmax + (\i:num. carleson_v h (u i)) n (drop x) = j}) + (\x. fourier (\y. fourier h y * Cx(carleson_psi (u j) k + y)) (--drop x))))`; + `integral F' (\x:real^1. carleson_wsel h u n (drop x))`] + LIM_DIAGONAL_SEQ) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [MP_TAC(ISPECL [`h:real->complex`; `u:num->real`; `n:num`; + `FF:real->bool`; `F':real^1->bool`] + CARLESON_WSEL_KSUM_PERTERM) THEN ASM_REWRITE_TAC[]; + X_GEN_TAC `K:num` THEN + MP_TAC(ISPECL [`h:real->complex`; `u:num->real`; `n:num`; + `FF:real->bool`; `F':real^1->bool`; `K:num`] + CARLESON_WSEL_PERK_INNER_LIMIT) THEN ASM_REWRITE_TAC[]]; + REWRITE_TAC[]]);; + +(* ===================================================================== *) +(* 286P(b) FUBINI-OVER-COUNTING regroup (Fremlin mt286 2315-2337): the *) +(* per-K aggregate b_{K,N} (guarded cell/scale/freq triple-sum) EQUALS the *) +(* g-selector tile-sum over Qenum = IMAGE fmap {witnessed triples}. This *) +(* is the reindex that turns the diagonal-limit's b_{K,nfun K} into the *) +(* CARLESON_WSEL_TILE_LIMIT tile-sum. STEP A (FLATTEN) + guard-restrict + *) +(* VSUM_IMAGE_GEN + per-tile STEP B (TILE_FIBER_SUM). *) +(* ===================================================================== *) + +let CARLESON_WITSET_MEM = prove + (`!(u:num->real) n K N j k nI. + (j,k,nI) IN {(j:num,k:int,nI:int) | j <= n /\ abs k <= &K /\ abs nI <= &N + /\ + (?nJ:int. u j IN tile_Jr(k,&0,nJ))} + <=> j <= n /\ abs k <= &K /\ abs nI <= &N /\ (?nJ:int. u j IN + tile_Jr(k,&0,nJ))`, + REPEAT GEN_TAC THEN REWRITE_TAC[IN_ELIM_THM; PAIR_EQ] THEN + EQ_TAC THENL + [STRIP_TAC THEN REPEAT (FIRST_X_ASSUM SUBST_ALL_TAC) THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; + STRIP_TAC THEN MAP_EVERY EXISTS_TAC [`j:num`;`k:int`;`nI:int`] THEN + ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[]]);; + +let CARLESON_GUARD_RESTRICT = prove + (`!(u:num->real) n K N (Fc:num#int#int->complex). + vsum {(j:num,k:int,nI:int) | j <= n /\ abs k <= &K /\ abs nI <= &N} + (\(j,k,nI). if (?nJ:int. (u j) IN tile_Jr(k,&0,nJ)) then Fc(j,k,nI) + else vec 0) + = vsum {(j:num,k:int,nI:int) | j <= n /\ abs k <= &K /\ abs nI <= &N /\ + (?nJ:int. u j IN tile_Jr(k,&0,nJ))} + (\(j,k,nI). Fc(j,k,nI))`, + REPEAT GEN_TAC THEN + TRANS_TAC EQ_TRANS + `vsum {(j:num,k:int,nI:int) | j <= n /\ abs k <= &K /\ abs nI <= &N /\ + (?nJ:int. u j IN tile_Jr(k,&0,nJ))} + (\(j,k,nI). if (?nJ:int. (u j) IN tile_Jr(k,&0,nJ)) then + (Fc:num#int#int->complex)(j,k,nI) else vec 0)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC VSUM_SUPERSET THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN MESON_TAC[]; + REWRITE_TAC[FORALL_PAIR_THM; CARLESON_WITSET_MEM] THEN + MAP_EVERY X_GEN_TAC [`j:num`;`k:int`;`nI:int`] THEN + REWRITE_TAC[IN_ELIM_THM; PAIR_EQ] THEN STRIP_TAC THEN + REPEAT(FIRST_X_ASSUM(SUBST_ALL_TAC o SYM o + check(fun th -> is_eq(concl th) && is_var(lhs(concl th))))) THEN + COND_CASES_TAC THEN REWRITE_TAC[] THEN + UNDISCH_TAC `~((j:num) <= n /\ abs(k:int) <= &K /\ abs(nI:int) <= &N /\ + (?nJ:int. u j IN tile_Jr(k,&0,nJ)))` THEN + ASM_REWRITE_TAC[]]; + MATCH_MP_TAC VSUM_EQ THEN + REWRITE_TAC[FORALL_PAIR_THM; CARLESON_WITSET_MEM] THEN + MAP_EVERY X_GEN_TAC [`j:num`;`k:int`;`nI:int`] THEN STRIP_TAC THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o check (fun th -> is_neg(concl th))) THEN + REWRITE_TAC[] THEN + ASM_MESON_TAC[]]);; + +let CARLESON_WSEL_TILE_REGROUP = prove + (`!(h:real->complex) u n FF F' K N. + schwartz h /\ real_measurable FF /\ measurable F' /\ F' SUBSET (IMAGE lift + FF) + ==> vsum {j:num | j <= n} + (\j. vsum {k:int | abs k <= &K} + (\k. if (?nJ:int. (u j) IN tile_Jr(k,&0,nJ)) + then vsum {nI:int | abs nI <= &N} + (\nI. carleson_ip h (k,nI,(@nJ:int. (u j) IN + tile_Jr(k,&0,nJ))) * + integral (F' INTER {x:real^1 | cargmax (\i:num. + carleson_v h (u i)) n (drop x) = j}) + (\z. phi_sigma (k,nI,(@nJ:int. (u j) IN + tile_Jr(k,&0,nJ))) carleson_phi (drop z))) + else vec 0)) + = vsum (IMAGE (\(j,k,nI). (k,nI,(@nJ:int. (u j) IN tile_Jr(k,&0,nJ)))) + {(j:num,k:int,nI:int) | j <= n /\ abs k <= &K /\ abs nI + <= &N /\ + (?nJ:int. u j IN tile_Jr(k,&0,nJ))}) + (\s. carleson_ip h s * + integral (F' INTER {x:real^1 | (u(cargmax (\i:num. carleson_v + h (u i)) n (drop x))) IN tile_Jr s}) + (\z. phi_sigma s carleson_phi (drop z)))`, + REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[CARLESON_WSEL_FLATTEN] THEN + SUBGOAL_THEN + `vsum {(j:num,k:int,nI:int) | j <= n /\ abs k <= &K /\ abs nI <= &N} + (\(j,k,nI). if (?nJ:int. (u j) IN tile_Jr(k,&0,nJ)) + then carleson_ip (h:real->complex) (k,nI,(@nJ:int. (u j) IN + tile_Jr(k,&0,nJ))) * + integral (F' INTER {x:real^1 | cargmax (\i:num. + carleson_v h (u i)) n (drop x) = j}) + (\z. phi_sigma (k,nI,(@nJ:int. (u j) IN + tile_Jr(k,&0,nJ))) carleson_phi (drop z)) + else vec 0) + = vsum {(j:num,k:int,nI:int) | j <= n /\ abs k <= &K /\ abs nI <= &N /\ + (?nJ:int. u j IN tile_Jr(k,&0,nJ))} + (\(j,k,nI). carleson_ip (h:real->complex) (k,nI,(@nJ:int. (u j) IN + tile_Jr(k,&0,nJ))) * + integral (F' INTER {x:real^1 | cargmax (\i:num. carleson_v + h (u i)) n (drop x) = j}) + (\z. phi_sigma (k,nI,(@nJ:int. (u j) IN + tile_Jr(k,&0,nJ))) carleson_phi (drop z)))` + SUBST1_TAC THENL + [CONV_TAC(DEPTH_CONV GEN_BETA_CONV) THEN + MP_TAC(ISPECL [`u:num->real`;`n:num`;`K:num`;`N:num`; + `\(j:num,k:int,nI:int). carleson_ip (h:real->complex) (k,nI,(@nJ:int. (u + j) IN tile_Jr(k,&0,nJ))) * + integral (F' INTER {x:real^1 | cargmax (\i:num. carleson_v h + (u i)) n (drop x) = j}) + (\z. phi_sigma (k,nI,(@nJ:int. (u j) IN tile_Jr(k,&0,nJ))) + carleson_phi (drop z))`] + CARLESON_GUARD_RESTRICT) THEN + CONV_TAC(DEPTH_CONV GEN_BETA_CONV) THEN DISCH_THEN + ACCEPT_TAC; ALL_TAC] THEN + MP_TAC(ISPECL + [`\(j:num,k:int,nI:int). (k,nI,(@nJ:int. (u j) IN tile_Jr(k,&0,nJ)))`; + `\(j:num,k:int,nI:int). carleson_ip (h:real->complex) (k,nI,(@nJ:int. (u j) + IN tile_Jr(k,&0,nJ))) * + integral (F' INTER {x:real^1 | cargmax (\i:num. carleson_v + h (u i)) n (drop x) = j}) + (\z. phi_sigma (k,nI,(@nJ:int. (u j) IN + tile_Jr(k,&0,nJ))) carleson_phi (drop z))`; + `{(j:num,k:int,nI:int) | j <= n /\ abs k <= &K /\ abs nI <= &N /\ (?nJ:int. + u j IN tile_Jr(k,&0,nJ))}`] + VSUM_IMAGE_GEN) THEN + ANTS_TAC THENL + [MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `{(j:num,k:int,nI:int) | j <= n /\ abs k <= &K /\ abs nI <= &N}` + THEN + REWRITE_TAC[CARLESON_TRIPLE_FINITE; SUBSET; IN_ELIM_THM] THEN MESON_TAC[]; + DISCH_THEN SUBST1_TAC] THEN + MATCH_MP_TAC VSUM_EQ THEN REWRITE_TAC[IN_IMAGE] THEN + X_GEN_TAC `s:int#int#int` THEN + DISCH_THEN(X_CHOOSE_THEN + `t:num#int#int` (CONJUNCTS_THEN2 SUBST1_TAC MP_TAC)) THEN + SPEC_TAC(`t:num#int#int`,`t:num#int#int`) THEN + REWRITE_TAC[FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC [`j0:num`;`k0:int`;`nI0:int`] THEN + REWRITE_TAC[CARLESON_WITSET_MEM] THEN STRIP_TAC THEN + MP_TAC(ISPECL [`h:real->complex`; `u:num->real`; `n:num`; `FF:real->bool`; + `F':real^1->bool`; + `K:num`; `N:num`; `k0:int`; `nI0:int`; + `(@nJ:int. (u:num->real) j0 IN tile_Jr(k0,&0,nJ))`] + CARLESON_TILE_FIBER_SUM) THEN + ASM_REWRITE_TAC[]);; + + +(* The selected-window tile bound. This *) +(* is Fremlin 286P(b)'s norm(int_F' sum_i v_i chi_Ei) <= C9 ||h||_2 sqrt(mu *) +(* F'): the *) +(* E_i-argmax cell-decomposition (CARLESON_WSEL_REGION_DECOMP) + per-cell *) +(* R2d tile-sum *) +(* (CARLESON_W_PIECE_KSUM + CARLESON_PERK_PIECE_LIMIT) + *) +(* Fubini-over-counting over the *) +(* tile set + CARLESON_286N region bound. *) +(* 286P(b) per-finite-tile-set bound: for any FINITE tile set Q, the *) +(* g-selector *) +(* tile-sum (g = the argmax selector) over the F'-RESTRICTED regions F' cap *) +(* g^-1[Jr_s] is bounded by C9 ||h||_2 sqrt muFF. VSUM_NORM (triangle) + *) +(* region-rewrite (F' cap g^-1[Jr_s] = IMAGE lift{x in drop F' | g x in *) +(* Jr_s}) + *) +(* CARLESON_286N_SCALED ONCE with FF := IMAGE drop F' (giving sqrt(mu(drop *) +(* F'))) + *) +(* sqrt-monotone sqrt(mu(drop F')) <= sqrt(mu FF) (MEASURE_SUBSET, F' SUBSET *) +(* lift FF). *) +let CARLESON_WSEL_PERM_BOUND = prove + (`?C9. &0 <= C9 /\ + !(h:real->complex) u n FF F' Q. + schwartz h /\ real_measurable FF /\ + measurable F' /\ F' SUBSET (IMAGE lift FF) /\ &0 < real_measure(IMAGE + drop F') /\ + FINITE Q /\ + (\x. u(cargmax (\i:num. carleson_v h (u i)) n x)) real_measurable_on + (:real) /\ + (!t. cw_tile t real_integrable_on + {x | x IN (IMAGE drop F') /\ (u(cargmax (\i:num. carleson_v h (u + i)) n x)) IN tile_J t}) + ==> norm(vsum Q + (\s. carleson_ip h s * + integral (F' INTER {x:real^1 | (u(cargmax (\i:num. + carleson_v h (u i)) n (drop x))) IN tile_Jr s}) + (\z. phi_sigma s carleson_phi (drop z)))) + <= C9 * lnorm (:real^1) (&2) (\z. h(drop z)) * sqrt(real_measure + FF)`, + X_CHOOSE_THEN `C9:real` STRIP_ASSUME_TAC CARLESON_286N_SCALED THEN + EXISTS_TAC `C9:real` THEN ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `real_measurable(IMAGE drop (F':real^1->bool))` ASSUME_TAC THENL + [REWRITE_TAC[REAL_MEASURABLE_MEASURABLE] THEN + SUBGOAL_THEN + `IMAGE lift (IMAGE drop (F':real^1->bool)) = F'` SUBST1_TAC THENL + [REWRITE_TAC[GSYM IMAGE_o; o_DEF; LIFT_DROP; IMAGE_ID]; + ASM_REWRITE_TAC[]]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `sum Q + (\s. norm(carleson_ip (h:real->complex) s * + integral (F' INTER {x:real^1 | (u(cargmax (\i:num. carleson_v h (u + i)) n (drop x))) IN tile_Jr s}) + (\z. phi_sigma s carleson_phi (drop z))))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC VSUM_NORM THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + (* Rewrite each F'-restricted region as the 286N FF-slot region with *) + (* FF:=drop F'. *) + SUBGOAL_THEN + `!s:int#int#int. + F' INTER {x:real^1 | (u(cargmax (\i:num. carleson_v (h:real->complex) (u + i)) n (drop x))) IN tile_Jr s} = + IMAGE lift {x | x IN (IMAGE drop F') /\ + (u(cargmax (\i:num. carleson_v h (u i)) n x)) IN tile_Jr + s}` + (fun th -> REWRITE_TAC[th]) THENL + [GEN_TAC THEN CONV_TAC SYM_CONV THEN + REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM; IN_INTER] THEN + X_GEN_TAC `y:real^1` THEN EQ_TAC THENL + [STRIP_TAC THEN ASM_REWRITE_TAC[LIFT_DROP] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_IMAGE]) THEN ASM_MESON_TAC[LIFT_DROP]; + STRIP_TAC THEN EXISTS_TAC `drop(y:real^1)` THEN + ASM_REWRITE_TAC[LIFT_DROP; IN_IMAGE] THEN + ASM_MESON_TAC[LIFT_DROP]]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `C9 * lnorm (:real^1) (&2) (\z. (h:real->complex)(drop z)) * + sqrt(real_measure(IMAGE drop (F':real^1->bool)))` THEN + CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPECL + [`\x. u(cargmax (\i:num. carleson_v (h:real->complex) (u i)) n x)`; + `IMAGE drop (F':real^1->bool)`; `h:real->complex`; + `Q:(int#int#int)->bool`] o + check(fun th -> is_forall(concl th) && + can (find_term (fun t -> t = `carleson_ip`)) (concl th) && + can (find_term (fun t -> t = `sqrt`)) (concl th))) THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC LNORM_POS_LE THEN ASM_SIMP_TAC[SCHWARTZ_L2]; ALL_TAC] THEN + MATCH_MP_TAC SQRT_MONO_LE THEN + REWRITE_TAC[REAL_MEASURE_MEASURE] THEN + SUBGOAL_THEN + `IMAGE lift (IMAGE drop (F':real^1->bool)) = F'` SUBST1_TAC THENL + [REWRITE_TAC[GSYM IMAGE_o; o_DEF; LIFT_DROP; IMAGE_ID]; ALL_TAC] THEN + MATCH_MP_TAC MEASURE_SUBSET THEN + ASM_REWRITE_TAC[GSYM REAL_MEASURABLE_MEASURABLE]]);; + +(* 286P(b) tile-limit identity (Fremlin's Fubini-over-counting / *) +(* regroup-by-tile, *) +(* mt286 2269-2358): int_F' carleson_wsel is the sequential limit of finite *) +(* g-selector tile-sums sum_{s in Qenum m} int_{F' cap g^-1[Jr_s]} *) +(* phi_s *) +(* (g x = u(cargmax..x)), where Qenum enumerates finite tile-subsets. *) +(* Regions are *) +(* F'-RESTRICTED (F' INTER {x | g(drop x) IN Jr_s}) -- F' is the 246K *) +(* sign-selection *) +(* set, a proper subset of lift FF, so the regroup is over F' rather than *) +(* all of FF. This packages the per-cell (WSEL_REGION_DECOMP) + per-scale *) +(* (PERK_PIECE_ *) +(* LIMIT) + cell-merge (CELL_SUM_INTEGRAL) triple-limit interchange over F'. *) +(* [The analytic core of 286P.] *) +(* Discharge of CARLESON_WSEL_TILE_LIMIT: Qenum := IMAGE fmap {witnessed *) +(* triples at (m,nfun m)}; the tile-sum over Qenum m = the diagonal *) +(* b_{m,nfun m} (TILE_REGROUP), which -> int_F' wsel (DIAG_LIMIT). *) +let CARLESON_WSEL_TILE_LIMIT = prove + (`!(h:real->complex) u n FF F'. + schwartz h /\ real_measurable FF /\ measurable F' /\ F' SUBSET (IMAGE lift + FF) + ==> ?Qenum:num->(int#int#int)->bool. + (!m. FINITE(Qenum m)) /\ + (\x. u(cargmax (\i:num. carleson_v h (u i)) n x)) real_measurable_on + (:real) /\ + (!t. cw_tile t real_integrable_on + {x | x IN (IMAGE drop F') /\ (u(cargmax (\i:num. carleson_v h + (u i)) n x)) IN tile_J t}) /\ + ((\m. vsum (Qenum m) + (\s. carleson_ip h s * + integral (F' INTER {x:real^1 | (u(cargmax (\i:num. + carleson_v h (u i)) n (drop x))) IN tile_Jr s}) + (\z. phi_sigma s carleson_phi (drop z)))) + --> integral F' (\x:real^1. carleson_wsel h u n (drop x))) + sequentially`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`h:real->complex`; `u:num->real`; `n:num`; `FF:real->bool`; + `F':real^1->bool`] + CARLESON_WSEL_DIAG_LIMIT) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `nfun:num->num` ASSUME_TAC) THEN + EXISTS_TAC + `\m. IMAGE (\(j,k,nI). (k,nI,(@nJ:int. (u j) IN tile_Jr(k,&0,nJ)))) + {(j:num,k:int,nI:int) | j <= n /\ abs k <= &m /\ abs nI <= &(nfun + m) /\ + (?nJ:int. u j IN tile_Jr(k,&0,nJ))}` + THEN + REPEAT CONJ_TAC THENL + [GEN_TAC THEN BETA_TAC THEN MATCH_MP_TAC FINITE_IMAGE THEN + MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `{(j:num,k:int,nI:int) | j <= n /\ abs k <= &m /\ abs nI <= + &(nfun m)}` THEN + REWRITE_TAC[CARLESON_TRIPLE_FINITE; SUBSET; IN_ELIM_THM] THEN MESON_TAC[]; + MATCH_MP_TAC CARLESON_G_SELECTOR_MEASURABLE THEN ASM_REWRITE_TAC[]; + GEN_TAC THEN MATCH_MP_TAC CARLESON_G_CWTILE_INTEGRABLE THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[REAL_MEASURABLE_MEASURABLE] THEN + SUBGOAL_THEN + `IMAGE lift (IMAGE drop (F':real^1->bool)) = F'` SUBST1_TAC THENL + [REWRITE_TAC[GSYM IMAGE_o; o_DEF; LIFT_DROP; IMAGE_ID]; + ASM_REWRITE_TAC[]]; + SUBGOAL_THEN + `(\m. vsum ((\m. IMAGE (\(j,k,nI). (k,nI,(@nJ:int. (u j) IN + tile_Jr(k,&0,nJ)))) + {(j:num,k:int,nI:int) | j <= n /\ abs k <= &m /\ abs nI <= + &(nfun m) /\ + (?nJ:int. u j IN tile_Jr(k,&0,nJ))}) + m) + (\s. carleson_ip (h:real->complex) s * + integral (F' INTER {x:real^1 | (u(cargmax (\i:num. + carleson_v h (u i)) n (drop x))) IN tile_Jr s}) + (\z. phi_sigma s carleson_phi (drop z)))) + = (\m. vsum {j:num | j <= n} + (\j. vsum {k:int | abs k <= &m} + (\k. if (?nJ:int. (u j) IN tile_Jr(k,&0,nJ)) + then vsum {nI:int | abs nI <= &(nfun m)} + (\nI. carleson_ip h (k,nI,(@nJ:int. (u j) IN + tile_Jr(k,&0,nJ))) * + integral (F' INTER {x:real^1 | cargmax + (\i:num. carleson_v h (u i)) n (drop x) + = j}) + (\w. phi_sigma (k,nI,(@nJ:int. (u j) IN + tile_Jr(k,&0,nJ))) carleson_phi (drop + w))) + else vec 0)))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `m:num` THEN BETA_TAC THEN + CONV_TAC SYM_CONV THEN + MP_TAC(ISPECL [`h:real->complex`; `u:num->real`; `n:num`; + `FF:real->bool`; `F':real^1->bool`; `m:num`; `(nfun:num->num) m`] + CARLESON_WSEL_TILE_REGROUP) THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[]]);; + +(* Tile-limit + per-finite-set bound: norm(int_F' *) +(* carleson_wsel) <= C9 ||h||_2 sqrt muFF. muFF=0: F' negligible (subset of *) +(* lift FF *) +(* with measure 0), integral 0. muFF>0: LIM_NORM_UBOUND on the tile-limit, *) +(* each *) +(* finite partial-sum bounded by CARLESON_WSEL_PERM_BOUND. *) +let CARLESON_WSEL_INTEGRAL_BOUND = prove + (`?C9. &0 <= C9 /\ + !(h:real->complex) u n FF F'. + schwartz h /\ real_measurable FF /\ + measurable F' /\ F' SUBSET (IMAGE lift FF) + ==> norm(integral F' (\x:real^1. carleson_wsel h u n (drop x))) + <= C9 * lnorm (:real^1) (&2) (\z. h(drop z)) * sqrt(real_measure + FF)`, + X_CHOOSE_THEN `C9:real` STRIP_ASSUME_TAC CARLESON_WSEL_PERM_BOUND THEN + EXISTS_TAC `C9:real` THEN ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC + [`h:real->complex`; `u:num->real`; `n:num`; `FF:real->bool`; + `F':real^1->bool`] THEN + STRIP_TAC THEN + ASM_CASES_TAC `negligible (F':real^1->bool)` THENL + [ASM_SIMP_TAC[INTEGRAL_ON_NEGLIGIBLE; NORM_0] THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN MATCH_MP_TAC REAL_LE_MUL THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC LNORM_POS_LE THEN ASM_SIMP_TAC[SCHWARTZ_L2]; + MATCH_MP_TAC SQRT_POS_LE THEN + REWRITE_TAC[REAL_MEASURE_MEASURE] THEN MATCH_MP_TAC MEASURE_POS_LE THEN + ASM_REWRITE_TAC[GSYM REAL_MEASURABLE_MEASURABLE]]; ALL_TAC] THEN + SUBGOAL_THEN + `&0 < real_measure(IMAGE drop (F':real^1->bool))` ASSUME_TAC THENL + [REWRITE_TAC[REAL_MEASURE_MEASURE] THEN + SUBGOAL_THEN + `IMAGE lift (IMAGE drop (F':real^1->bool)) = F'` SUBST1_TAC THENL + [REWRITE_TAC[GSYM IMAGE_o; o_DEF; LIFT_DROP; IMAGE_ID]; ALL_TAC] THEN + MP_TAC(ISPEC `F':real^1->bool` MEASURE_POS_LE) THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ISPEC `F':real^1->bool` NEGLIGIBLE_EQ_MEASURE_0) THEN + ASM_REWRITE_TAC[] THEN + REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPECL [`h:real->complex`; `u:num->real`; `n:num`; `FF:real->bool`; + `F':real^1->bool`] + CARLESON_WSEL_TILE_LIMIT) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN + `Qenum:num->(int#int#int)->bool` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC(ISPEC `sequentially` LIM_NORM_UBOUND) THEN + EXISTS_TAC + `\(m:num). vsum (Qenum m) + (\s. carleson_ip (h:real->complex) s * + integral (F' INTER {x:real^1 | (u(cargmax (\i:num. carleson_v h + (u i)) n (drop x))) IN tile_Jr s}) + (\z. phi_sigma s carleson_phi (drop z)))` THEN + REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY; EVENTUALLY_SEQUENTIALLY] THEN + CONJ_TAC THENL + [FIRST_X_ASSUM(fun th -> if can (find_term (fun t -> t = `carleson_wsel`)) + (concl th) + then MP_TAC th else NO_TAC) THEN REWRITE_TAC[]; + EXISTS_TAC `0` THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN BETA_TAC THEN + FIRST_ASSUM(MP_TAC o SPECL + [`h:real->complex`; `u:num->real`; `n:num`; `FF:real->bool`; + `F':real^1->bool`; + `(Qenum:num->(int#int#int)->bool) m`] o + check(fun th -> is_forall(concl th) && + can (find_term (fun t -> t = `carleson_ip`)) (concl th))) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; DISCH_THEN ACCEPT_TAC]]);; + +(* 286P(b,c) DEEP integral bound: int_F Ah <= 4 C9 ||h||_2 sqrt(mu F), from *) +(* the selected-window tile bound CARLESON_WSEL_INTEGRAL_BOUND via *) +(* CARLESON_286P_FROM_TILEBOUND. *) +let CARLESON_286P_BOUND = prove + (`?C9. &0 <= C9 /\ + !(h:real->complex) FF. + schwartz h /\ real_measurable FF + ==> real_integral FF (carleson_A h) + <= &4 * C9 * lnorm (:real^1) (&2) (\z. h(drop z)) * + sqrt(real_measure FF)`, + MATCH_MP_TAC CARLESON_286P_FROM_TILEBOUND THEN + ACCEPT_TAC CARLESON_WSEL_INTEGRAL_BOUND);; + +(* 286P (Fremlin 1939-2360): Ah is measurable (CARLESON_A_MEASURABLE) AND *) +(* int_F Ah <= 4 C9 ||h||_2 sqrt(mu F) (CARLESON_286P_BOUND, the deep gate). *) + +let CARLESON_286P = prove + (`?C9. &0 <= C9 /\ + !(h:real->complex) FF. + schwartz h /\ real_measurable FF + ==> (carleson_A h) real_measurable_on (:real) /\ + real_integral FF (carleson_A h) + <= &4 * C9 * lnorm (:real^1) (&2) (\z. h(drop z)) * + sqrt(real_measure FF)`, + X_CHOOSE_THEN `C9:real` STRIP_ASSUME_TAC CARLESON_286P_BOUND THEN + EXISTS_TAC `C9:real` THEN ASM_REWRITE_TAC[] THEN + REPEAT STRIP_TAC THENL + [MATCH_MP_TAC CARLESON_A_MEASURABLE THEN ASM_REWRITE_TAC[]; + FIRST_X_ASSUM(MP_TAC o SPECL [`h:real->complex`; `FF:real->bool`]) THEN + ASM_REWRITE_TAC[]]);; + +(* Whole-line reflection preserves lspace membership. *) +let LSPACE_REFLECT = prove + (`!g:real^1->complex. g IN lspace (:real^1) (&2) + ==> (\z. g(--z)) IN lspace (:real^1) (&2)`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o REWRITE_RULE[lspace; IN_ELIM_THM]) THEN + REWRITE_TAC[lspace; IN_ELIM_THM] THEN STRIP_TAC THEN CONJ_TAC THENL + [ONCE_REWRITE_TAC[MEASURABLE_ON_REFLECT] THEN + ASM_REWRITE_TAC[REFLECT_UNIV]; + SUBGOAL_THEN + `(\x:real^1. lift(norm((g:real^1->complex)(--x)) rpow &2)) = + (\x. (\z. lift(norm((g:real^1->complex) z) rpow &2)) (--x))` + SUBST1_TAC THENL [REWRITE_TAC[]; ALL_TAC] THEN + ONCE_REWRITE_TAC[INTEGRABLE_REFLECT_GEN] THEN + ASM_REWRITE_TAC[REFLECT_UNIV]]);; + +(* The L^p norm is reflection-invariant (same integrand after z |-> --z). *) +let LNORM_REFLECT = prove + (`!(g:real^1->complex) p. lnorm (:real^1) p (\z. g(--z)) = lnorm (:real^1) p + g`, + REPEAT GEN_TAC THEN REWRITE_TAC[lnorm] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + SUBGOAL_THEN + `(\x:real^1. lift(norm((g:real^1->complex)(--x)) rpow p)) = + (\x. (\z. lift(norm((g:real^1->complex) z) rpow p)) (--x))` + SUBST1_TAC THENL [REWRITE_TAC[]; ALL_TAC] THEN + ONCE_REWRITE_TAC[INTEGRAL_REFLECT_GEN] THEN REWRITE_TAC[REFLECT_UNIV]);; + +(* ========================================================================= *) +(* 286S(c)/286T(b) descent (Fremlin 2827-2948): from the 286P tile bound to *) +(* the linearized maximal bound. S6 = kernel domination (286S(c)), S7 = 286T *) +(* (b), S8 = assembly discharging CARLESON_286T_FROM_286P with C10 = 4 C9 *) +(* log2 *) +(* / (pi thetatilde_1(0)) (>=0 since thetatilde_1(0)>0). *) +(* ------------------------------------------------------------------------- *) +(* S6 (ATILDE_KERNEL_DOM) and S7 (AHAT_LE_ATILDE) are the two key analytic *) +(* inputs; the S8 assembly below is built FROM them. *) +(* ========================================================================= *) + +(* fourier(hcheck) = h where hcheck = \x. fourier h(--x) *) +(* [DOUBLE_TRANSFORM+REFLECT]. *) +let HCHECK_FT = prove + (`!(h:real->complex) z. schwartz h ==> fourier (\x. fourier h (--x)) z = h z`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`h:real->complex`; `z:real`] DOUBLE_TRANSFORM) THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`fourier(h:real->complex)`; `z:real`] FOURIER_REFLECT) THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]));; + +(* schwartz(hcheck). *) +let SCHWARTZ_HCHECK = prove + (`!(h:real->complex). schwartz h ==> schwartz (\x. fourier h (--x))`, + GEN_TAC THEN DISCH_TAC THEN + MP_TAC(ISPEC `fourier(h:real->complex)` SCHWARTZ_REFLECT) THEN + ANTS_TAC THENL [MATCH_MP_TAC SCHWARTZ_FOURIER THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[]);; + +(* ================================================================= *) +(* S6 = ATILDE_KERNEL_DOM (Fremlin 286S(c)) and its sub-lemmas. *) +(* Target: 2pi*norm(fourier(hhat.thetatilde_z)(-x)) *) +(* <= carleson_Atilde h x. Route: Mn(w)->tt_z(w) (DCT in a) + FOURIER *) +(* _VALUE_LIM => fourier(hhat Mn)->fourier(hhat tt_z); per-n Wn<=Aavg; *) +(* liminf. *) +(* ================================================================= *) + +(* ===== S6 STEP A: Cesaro partial qn(a,w) -> g(a,w,z), sequentially, all w *) +(* ===== *) +let QN_SEQ_LIMIT = prove + (`!alpha y z. &0 < alpha + ==> ((\n. inv(&n) * real_integral (real_interval[&0,&n]) (\beta. + carleson_theta' z alpha beta y)) + ---> carleson_g alpha y z) sequentially`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `(y:real) < z` THENL + [MP_TAC(SPECL [`alpha:real`; `y:real`; `z:real`] CARLESON_G_AVG_LIMIT) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o BETA_RULE o MATCH_MP REALLIM_POSINFINITY_SEQUENTIALLY) + THEN + REWRITE_TAC[]; + SUBGOAL_THEN `(z:real) <= y` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `carleson_g alpha y z = &0` SUBST1_TAC THENL + [MATCH_MP_TAC CARLESON_G_TRIVIAL THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `(\n. inv(&n) * real_integral (real_interval[&0,&n]) (\beta. + carleson_theta' z alpha beta y)) = + (\n. &0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + SUBGOAL_THEN + `(\beta. carleson_theta' z alpha beta y) = + (\beta:real. &0)` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + MATCH_MP_TAC CARLESON_THETA'_SUPPORT THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_INTEGRAL_0; REAL_MUL_RZERO]]; + REWRITE_TAC[REALLIM_CONST]]]);; + +(* 0 <= qn(a,w) <= 1. *) +let QN_BOUNDS = prove + (`!z alpha beta_n y. &0 <= inv(&beta_n) * real_integral + (real_interval[&0,&beta_n]) (\beta. carleson_theta' z alpha beta y) /\ + inv(&beta_n) * real_integral (real_interval[&0,&beta_n]) (\beta. + carleson_theta' z alpha beta y) <= &1`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `beta_n = 0` THENL + [ASM_REWRITE_TAC[REAL_INV_0; REAL_MUL_LZERO] THEN + REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `&0 < &beta_n` ASSUME_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_LT] THEN ASM_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `real_integral (real_interval[&0,&beta_n]) (\beta. carleson_theta' z alpha + beta y) <= &beta_n /\ + &0 <= real_integral (real_interval[&0,&beta_n]) (\beta. carleson_theta' z + alpha beta y)` + STRIP_ASSUME_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `real_integral (real_interval[&0,&beta_n]) (\beta:real. &1)` + THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_LE THEN + REWRITE_TAC[THETA'_BETA_INTEGRABLE; REAL_INTEGRABLE_CONST] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[CARLESON_THETA'_BOUNDS]; + SIMP_TAC[REAL_INTEGRAL_CONST; REAL_ARITH `&0 <= &beta_n`] THEN + REAL_ARITH_TAC]; + MATCH_MP_TAC REAL_INTEGRAL_POS THEN + REWRITE_TAC[THETA'_BETA_INTEGRABLE] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[CARLESON_THETA'_BOUNDS]]; + ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INV THEN REWRITE_TAC[REAL_POS]; ASM_REWRITE_TAC[]]; + REWRITE_TAC[GSYM REAL_LE_RDIV_EQ; real_div] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ASM_SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ] THEN + ASM_REWRITE_TAC[REAL_MUL_LID]]);; + +(* |inv a * qn| <= 1 on [1,2]. *) +let MN_INTEGRAND_BOUND = prove + (`!z w k alpha. &1 <= alpha /\ alpha <= &2 + ==> abs(inv alpha * (inv(&k) * real_integral (real_interval[&0,&k]) (\beta. + carleson_theta' z alpha beta w))) <= &1`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`z:real`; `alpha:real`; `k:num`; `w:real`] QN_BOUNDS) THEN + STRIP_TAC THEN + REWRITE_TAC[REAL_ABS_BOUNDS] THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&0` THEN CONJ_TAC THENL + [REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INV THEN ASM_REAL_ARITH_TAC; ASM_REWRITE_TAC[]]]; + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&1 * (inv(&k) * real_integral (real_interval[&0,&k]) (\beta. + carleson_theta' z alpha beta w))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_RMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_INV_LE_1 THEN ASM_REAL_ARITH_TAC; ASM_REWRITE_TAC[]]; + REWRITE_TAC[REAL_MUL_LID] THEN ASM_REWRITE_TAC[]]]);; + +(* ===== S6 STEP B: Mn(w) -> carleson_thetatilde z w (DCT in a over [1,2]) *) +(* ===== *) +let MN_SEQ_LIMIT = prove + (`!(z:real) w. + ((\n. real_integral (real_interval[&1,&2]) + (\alpha. inv alpha * (inv(&n) * real_integral + (real_interval[&0,&n]) + (\beta. carleson_theta' z alpha beta w)))) + ---> carleson_thetatilde z w) sequentially`, + REPEAT GEN_TAC THEN REWRITE_TAC[carleson_thetatilde] THEN + MP_TAC(ISPECL + [`\n alpha. inv alpha * (inv(&n) * real_integral (real_interval[&0,&n]) + (\beta. carleson_theta' z alpha beta w))`; + `\alpha. inv alpha * carleson_g alpha w z`; + `\alpha:real. &1`; + `real_interval[&1,&2]`] REAL_DOMINATED_CONVERGENCE) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [(* (1) each f n integrable on [1,2] *) + X_GEN_TAC `k:num` THEN + MATCH_MP_TAC REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN + EXISTS_TAC `(\alpha:real. &1)` THEN REPEAT CONJ_TAC THENL + [MP_TAC(ISPECL + [`\alpha:real. inv alpha`; + `\alpha:real. inv(&k) * real_integral (real_interval[&0,&k]) (\beta. + carleson_theta' z alpha beta w)`; + `real_interval[&1,&2]`] REAL_MEASURABLE_ON_MUL) THEN + REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_IMP_REAL_MEASURABLE_ON_CLOSED_SUBSET + THEN + REWRITE_TAC[REAL_CLOSED_REAL_INTERVAL] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_INV THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_ID; IN_REAL_INTERVAL] THEN + REPEAT STRIP_TAC THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[CARLESON_AN_MEASURABLE]]; + REWRITE_TAC[REAL_INTEGRABLE_CONST]; + X_GEN_TAC `alpha:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN + STRIP_TAC THEN + MATCH_MP_TAC MN_INTEGRAND_BOUND THEN ASM_REWRITE_TAC[]]; + (* (2) dominator &1 integrable *) + REWRITE_TAC[REAL_INTEGRABLE_CONST]; + (* (3) |f n alpha| <= 1 on [1,2] *) + MAP_EVERY X_GEN_TAC [`k:num`; `alpha:real`] THEN + REWRITE_TAC[IN_REAL_INTERVAL] THEN STRIP_TAC THEN + MATCH_MP_TAC MN_INTEGRAND_BOUND THEN ASM_REWRITE_TAC[]; + (* (4) f n alpha -> g alpha ptwise *) + X_GEN_TAC `alpha:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN + STRIP_TAC THEN + MATCH_MP_TAC REALLIM_LMUL THEN + MATCH_MP_TAC QN_SEQ_LIMIT THEN ASM_REAL_ARITH_TAC]; + DISCH_THEN(ACCEPT_TAC o CONJUNCT2)]);; + +(* 0 <= Mn(w) <= 1. *) +let MN_LE1 = prove + (`!z w n. &0 <= real_integral (real_interval[&1,&2]) + (\alpha. inv alpha * (inv(&n) * real_integral + (real_interval[&0,&n]) (\beta. carleson_theta' z alpha beta + w))) /\ + real_integral (real_interval[&1,&2]) + (\alpha. inv alpha * (inv(&n) * real_integral + (real_interval[&0,&n]) (\beta. carleson_theta' z alpha beta + w))) <= &1`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN + `(\alpha. inv alpha * (inv(&n) * real_integral (real_interval[&0,&n]) + (\beta. carleson_theta' z alpha beta w))) + real_integrable_on real_interval[&1,&2]` + ASSUME_TAC THENL + [MATCH_MP_TAC REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN + EXISTS_TAC `(\alpha:real. &1)` THEN REPEAT CONJ_TAC THENL + [MP_TAC(ISPECL + [`\alpha:real. inv alpha`; + `\alpha:real. inv(&n) * real_integral (real_interval[&0,&n]) (\beta. + carleson_theta' z alpha beta w)`; + `real_interval[&1,&2]`] REAL_MEASURABLE_ON_MUL) THEN + REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_IMP_REAL_MEASURABLE_ON_CLOSED_SUBSET THEN + REWRITE_TAC[REAL_CLOSED_REAL_INTERVAL] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_INV THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_ID; IN_REAL_INTERVAL] THEN + REPEAT STRIP_TAC THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[CARLESON_AN_MEASURABLE]]; + REWRITE_TAC[REAL_INTEGRABLE_CONST]; + X_GEN_TAC `alpha:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN + STRIP_TAC THEN + MATCH_MP_TAC MN_INTEGRAND_BOUND THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_POS THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `alpha:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN + STRIP_TAC THEN + MP_TAC(ISPECL [`z:real`; `alpha:real`; `n:num`; `w:real`] QN_BOUNDS) THEN + STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INV THEN ASM_REAL_ARITH_TAC; ASM_REWRITE_TAC[]]; + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `real_integral (real_interval[&1,&2]) (\alpha:real. &1)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_LE THEN + ASM_REWRITE_TAC[REAL_INTEGRABLE_CONST] THEN + X_GEN_TAC `alpha:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN + STRIP_TAC THEN + MP_TAC(ISPECL [`z:real`; `w:real`; `n:num`; + `alpha:real`] MN_INTEGRAND_BOUND) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + SIMP_TAC[REAL_INTEGRAL_CONST; REAL_ARITH `&1 <= &2`] THEN + REAL_ARITH_TAC]]);; + +(* Aavg h n x <= M0 * log2 uniformly (M0 = sqrt2pi int|hhat|); STEP D input + (guarantees the running-inf/liminf converges to a finite value). *) +let AAVG_UNIF_BOUND = prove + (`!(h:real->complex) n x. schwartz h /\ ~(n = 0) + ==> carleson_Aavg h n x + <= (sqrt(&2 * pi) * drop(integral (:real^1) (\y. lift(norm(fourier + (h:real->complex) (drop y)))))) * log(&2)`, + REPEAT STRIP_TAC THEN + ABBREV_TAC `M0 = sqrt(&2 * pi) * drop(integral (:real^1) (\y. + lift(norm(fourier (h:real->complex) (drop y)))))` THEN + SUBGOAL_THEN `&0 <= M0` ASSUME_TAC THENL + [EXPAND_TAC "M0" THEN MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC SQRT_POS_LE THEN MP_TAC PI_POS THEN REAL_ARITH_TAC; + MATCH_MP_TAC INTEGRAL_DROP_POS THEN + REWRITE_TAC[LIFT_DROP; NORM_POS_LE] THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN + MP_TAC(ISPEC `h:real->complex` SCHWARTZ_FHAT_ABSINT) THEN + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + REWRITE_TAC[carleson_Aavg; carleson_Sinner] THEN + SUBGOAL_THEN `&0 < &n` ASSUME_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_LT] THEN ASM_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `inv(&n) * real_integral (real_interval[&1,&2]) (\alpha. inv alpha + * (&n * M0))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INV THEN REWRITE_TAC[REAL_POS]; ALL_TAC] THEN + MATCH_MP_TAC REAL_INTEGRAL_LE THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC A_ITERATE_INTEGRABLE THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_INTEGRABLE_RMUL THEN MP_TAC INV_INTEGRABLE_1_2 THEN + REWRITE_TAC[ETA_AX]; + X_GEN_TAC `alpha:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN + STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INV THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `real_integral (real_interval[&0,&n]) (\beta:real. M0)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_LE THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC AMD_BSLICE_INTEGRABLE THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[REAL_INTEGRABLE_CONST]; + X_GEN_TAC `beta:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN + STRIP_TAC THEN + EXPAND_TAC "M0" THEN MATCH_MP_TAC AMD_UNIF_BOUND THEN + ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC]; + SIMP_TAC[REAL_INTEGRAL_CONST; REAL_ARITH `&0 <= &n`] THEN + REAL_ARITH_TAC]]; + SUBGOAL_THEN + `real_integral (real_interval[&1,&2]) (\alpha. inv alpha * (&n * M0)) = + real_integral (real_interval[&1,&2]) (\alpha. (&n * M0) * inv alpha)` + SUBST1_TAC THENL + [AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + REWRITE_TAC[REAL_MUL_AC]; ALL_TAC] THEN + MP_TAC(ISPECL [`\a:real. inv a`; `&n * M0:real`; + `real_interval[&1,&2]`] REAL_INTEGRAL_LMUL) THEN + ANTS_TAC THENL [REWRITE_TAC[INV_INTEGRABLE_1_2]; ALL_TAC] THEN + BETA_TAC THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[INV_INTEGRAL_1_2_LOG2] THEN + ASM_SIMP_TAC[REAL_FIELD `~(&n = &0) ==> inv(&n) * ((&n * M0) * log(&2)) = + M0 * log(&2)`; + REAL_OF_NUM_EQ] THEN REWRITE_TAC[REAL_LE_REFL]]);; + +(* STEP D core: f->L, f<=g ptwise, g bounded-below with running-inf ->G ==> *) +(* L<=G. (Abstract liminf-domination; assembles STEP D of *) +(* ATILDE_KERNEL_DOM.) *) +let LIMINF_DOM = prove + (`!f g L G. + (f ---> L) sequentially /\ + (!n:num. f n <= g n) /\ + (?b. !n. b <= g n) /\ + ((\m. inf {g n | n >= m}) ---> G) sequentially + ==> L <= G`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`sequentially`; `f:num->real`; `g:num->real`; `L:real`; + `G:real`] HAS_LIMINF_LE) THEN + REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN DISCH_THEN MATCH_MP_TAC THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC REALLIM_IMP_HAS_LIMINF THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[HAS_LIMINF_SEQUENTIALLY_REALLIM_INF] THEN CONJ_TAC THENL + [ASM_MESON_TAC[]; ASM_REWRITE_TAC[]]; + MATCH_MP_TAC ALWAYS_EVENTUALLY THEN ASM_REWRITE_TAC[]]);; + +(* STEP D input (iv): the running-inf of Aavg converges (bounded monotone). + Each inf-tail sits in [0, M0 log2] (M0 = sqrt2pi int|hhat|); the tail-inf + is nondecreasing in m (REAL_LE_INF_SUBSET on nested tails). *) +let AAVG_RUNNINGINF_CONV = prove + (`!(h:real->complex) x. schwartz h + ==> ?G. ((\m. inf {carleson_Aavg h n x | n >= m}) ---> G) sequentially`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC CONVERGENT_REAL_BOUNDED_MONOTONE THEN + ABBREV_TAC `M0 = sqrt(&2 * pi) * drop(integral (:real^1) (\y. + lift(norm(fourier (h:real->complex) (drop y)))))` THEN + SUBGOAL_THEN + `!m. &0 <= inf {carleson_Aavg h n x | n >= m} /\ + inf {carleson_Aavg h n x | n >= m} <= M0 * log(&2)` + ASSUME_TAC THENL + [GEN_TAC THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INF THEN + REWRITE_TAC[FORALL_IN_GSPEC] THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + MAP_EVERY EXISTS_TAC [`carleson_Aavg h m x`; `m:num`] THEN + REWRITE_TAC[GE; LE_REFL]; + REPEAT STRIP_TAC THEN MATCH_MP_TAC AAVG_NONNEG THEN ASM_REWRITE_TAC[]]; + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `carleson_Aavg h (m + 1) x` THEN CONJ_TAC THENL + [MATCH_MP_TAC INF_LE_ELEMENT THEN CONJ_TAC THENL + [EXISTS_TAC `&0` THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC AAVG_NONNEG THEN + ASM_REWRITE_TAC[]; + REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `m + 1` THEN + REWRITE_TAC[GE] THEN ARITH_TAC]; + EXPAND_TAC "M0" THEN MATCH_MP_TAC AAVG_UNIF_BOUND THEN + ASM_REWRITE_TAC[] THEN ARITH_TAC]]; + ALL_TAC] THEN + CONJ_TAC THENL + [REWRITE_TAC[REAL_BOUNDED_POS] THEN + EXISTS_TAC `abs(M0 * log(&2)) + &1` THEN + REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV] THEN BETA_TAC THEN CONJ_TAC THENL + [REAL_ARITH_TAC; + GEN_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `x':num`) THEN DISCH_TAC THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= i /\ i <= b ==> abs(i) <= abs(b) + &1`) + THEN + ASM_REWRITE_TAC[]]; + DISJ1_TAC THEN GEN_TAC THEN BETA_TAC THEN + MATCH_MP_TAC REAL_LE_INF_SUBSET THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + MAP_EVERY EXISTS_TAC [`carleson_Aavg h (SUC n) x`; `SUC n`] THEN + REWRITE_TAC[GE; LE_REFL]; + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN + EXISTS_TAC `n':num` THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; + EXISTS_TAC `&0` THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC AAVG_NONNEG THEN + ASM_REWRITE_TAC[]]]);; + +(* STEP D input (iii): the n=0 degenerate case of WN_LE_AAVG. At n=0 the inner + factor inv(&0)=&0 collapses the multiplier Mn_0 to &0, so the transform is + vec 0 (norm 0), and carleson_Aavg h 0 x = inv(&0)*Sinner = &0. *) +let WN_LE_AAVG_ZERO = prove + (`!(h:real->complex) z x. schwartz h + ==> &2 * pi * norm(fourier (\w. fourier h w * + Cx(real_integral (real_interval[&1,&2]) + (\alpha. inv alpha * (inv(&0) * real_integral + (real_interval[&0,&0]) + (\beta. carleson_theta' z alpha beta w))))) (--x)) + <= carleson_Aavg h 0 x`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[carleson_Aavg; REAL_INV_0; REAL_MUL_LZERO] THEN + SUBGOAL_THEN + `(\w. fourier (h:real->complex) w * + Cx(real_integral (real_interval[&1,&2]) (\alpha. inv alpha * &0))) = + (\w:real. vec 0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + REWRITE_TAC[REAL_MUL_RZERO; REAL_INTEGRAL_0] THEN + REWRITE_TAC[GSYM COMPLEX_VEC_0; COMPLEX_MUL_RZERO]; + ALL_TAC] THEN + REWRITE_TAC[fourier; COMPLEX_VEC_0; COMPLEX_MUL_RZERO] THEN + REWRITE_TAC[GSYM COMPLEX_VEC_0; INTEGRAL_0; COMPLEX_MUL_RZERO] THEN + REWRITE_TAC[COMPLEX_VEC_0; COMPLEX_MUL_RZERO; COMPLEX_NORM_0; + REAL_MUL_RZERO; REAL_LE_REFL]);; + +(* Bilinear step of Fremlin 286V: = , where f2 *) +(* represents the Fourier transform of g. Direct PARSEVAL_L2_BILINEAR with *) +(* a:=g, b:=h_ax, ahat:=f2, bhat:=fourier h_ax (HAX_L2/HAX_FT_L2 give L^2, *) +(* HAX_REPS gives that fourier h_ax represents the FT of h_ax). *) +let SINC_BILINEAR = prove + (`!a x:real g f2:real^1->complex. &0 <= a /\ + g IN lspace (:real^1) (&2) /\ f2 IN lspace (:real^1) (&2) /\ + (!k. schwartz k ==> integral (:real^1) (\z. f2 z * k(drop z)) = + integral (:real^1) (\z. g z * fourier k (drop z))) + ==> lproduct (:real^1) g + (\z. if abs(drop z) <= a then cexp(ii * Cx x * Cx(drop z)) else + Cx(&0)) = + lproduct (:real^1) f2 + (\z. fourier (\y. if abs y <= a then cexp(ii * Cx x * Cx y) else + Cx(&0)) + (drop z))`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC PARSEVAL_L2_BILINEAR THEN + ASM_REWRITE_TAC[HAX_L2] THEN CONJ_TAC THENL + [MATCH_MP_TAC HAX_FT_L2 THEN ASM_REWRITE_TAC[]; + X_GEN_TAC `k:real->complex` THEN DISCH_TAC THEN + MP_TAC(ISPECL [`a:real`; `x:real`; `k:real->complex`] HAX_REPS) THEN + ASM_REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Sinc-window algebra pieces for 286V line 3074-3079: *) +(* SINC_CONST_ID: inv(sqrt2pi)*(inv(sqrt2pi)*(2 s)) = inv pi * s; *) +(* WINDOW_INT_LPRODUCT: INT_{[-a,a]} e^{-ixt} G = ; *) +(* SINC_LPRODUCT_REAL: = INT f2(t) * (real sinc value). *) +(* ------------------------------------------------------------------------- *) + +let SINC_CONST_ID = prove + (`!s:real. inv(sqrt(&2 * pi)) * (inv(sqrt(&2 * pi)) * (&2 * s)) = inv pi * s`, + GEN_TAC THEN + SUBGOAL_THEN + `inv(sqrt(&2 * pi)) * inv(sqrt(&2 * pi)) = inv(&2 * pi)` MP_TAC THENL + [REWRITE_TAC[GSYM REAL_INV_MUL] THEN AP_TERM_TAC THEN + MP_TAC(SPEC `&2 * pi` SQRT_POW_2) THEN + SIMP_TAC[REAL_LE_MUL; REAL_POS; PI_POS_LE; REAL_LT_IMP_LE; REAL_POW_2] THEN + REWRITE_TAC[REAL_POW_2] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REFL_TAC; + DISCH_TAC THEN + SUBGOAL_THEN `inv(sqrt(&2 * pi)) * (inv(sqrt(&2 * pi)) * (&2 * s)) = + (inv(sqrt(&2 * pi)) * inv(sqrt(&2 * pi))) * &2 * s` + SUBST1_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN MP_TAC PI_POS THEN CONV_TAC REAL_FIELD]);; +let WINDOW_INT_LPRODUCT = prove + (`!a x:real G:real^1->complex. &0 <= a + ==> integral (IMAGE lift (real_interval[--a,a])) + (\z. cexp(--(ii * Cx x * Cx(drop z))) * G z) = + lproduct (:real^1) G + (\z. if abs(drop z) <= a then cexp(ii * Cx x * Cx(drop z)) else + Cx(&0))`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[LPRODUCT_G_HAX] THEN + REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL] THEN + GEN_REWRITE_TAC (LAND_CONV) [GSYM INTEGRAL_RESTRICT_UNIV] THEN + MATCH_MP_TAC INTEGRAL_EQ THEN X_GEN_TAC `z:real^1` THEN DISCH_TAC THEN + REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP] THEN + REWRITE_TAC[REAL_ARITH `--a <= drop z /\ drop z <= a <=> abs(drop z) <= a`] + THEN + COND_CASES_TAC THEN REWRITE_TAC[COMPLEX_MUL_RZERO; COMPLEX_VEC_0] THEN + SIMPLE_COMPLEX_ARITH_TAC);; +let SINC_LPRODUCT_REAL = prove + (`!a x:real f2:real^1->complex. &0 <= a + ==> lproduct (:real^1) f2 + (\z. fourier (\y. if abs y <= a then cexp(ii * Cx x * Cx y) else + Cx(&0)) (drop z)) = + integral (:real^1) + (\z. f2 z * Cx(inv(sqrt(&2 * pi)) * + (&2 * sin(a * (x - drop z)) / (x - drop z))))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[lproduct] THEN + MATCH_MP_TAC INTEGRAL_SPIKE THEN + EXISTS_TAC `{lift x}` THEN REWRITE_TAC[NEGLIGIBLE_SING] THEN + X_GEN_TAC `z:real^1` THEN REWRITE_TAC[IN_DIFF; IN_UNIV; IN_SING] THEN + DISCH_TAC THEN REWRITE_TAC[] THEN AP_TERM_TAC THEN + SUBGOAL_THEN `~(x - drop z = &0)` ASSUME_TAC THENL + [REWRITE_TAC[REAL_SUB_0] THEN DISCH_TAC THEN + UNDISCH_TAC `~(z:real^1 = lift x)` THEN REWRITE_TAC[] THEN + REWRITE_TAC[GSYM LIFT_DROP] THEN + ASM_REWRITE_TAC[LIFT_DROP; LIFT_EQ]; ALL_TAC] THEN + MP_TAC(ISPECL [`a:real`; `x:real`; `drop z`] CARLESON_HAX_FT) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[GSYM CX_MUL; CNJ_CX]);; + +(* ------------------------------------------------------------------------- *) +(* Integrability of the sinc integrand f2(t) * Cx(sin(a(x-t))/(x-t)): a.e. *) +(* equal to a scalar multiple of the L^2 product f2 * cnj(fourier h_ax). *) +(* ------------------------------------------------------------------------- *) + +let SINC_INTEGRAND_INTEGRABLE = prove + (`!a x:real f2:real^1->complex. &0 <= a /\ f2 IN lspace (:real^1) (&2) + ==> (\z. f2 z * Cx(sin(a * (x - drop z)) / (x - drop z))) integrable_on + (:real^1)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`\z:real^1. Cx(sqrt(&2 * pi) / &2) * + (f2 z * cnj(fourier (\y. if abs y <= a then cexp(ii * Cx x * Cx y) + else Cx(&0)) (drop z)))`; + `\z:real^1. f2 z * Cx(sin(a * (x - drop z)) / (x - drop z))`; + `{lift x}`; `(:real^1)`] INTEGRABLE_SPIKE) THEN + REWRITE_TAC[NEGLIGIBLE_SING] THEN + ANTS_TAC THENL + [X_GEN_TAC `z:real^1` THEN REWRITE_TAC[IN_DIFF; IN_UNIV; IN_SING] THEN + DISCH_TAC THEN + SUBGOAL_THEN `~(x - drop z = &0)` ASSUME_TAC THENL + [REWRITE_TAC[REAL_SUB_0] THEN DISCH_TAC THEN + UNDISCH_TAC `~(z:real^1 = lift x)` THEN REWRITE_TAC[] THEN + REWRITE_TAC[GSYM LIFT_DROP] THEN + ASM_REWRITE_TAC[LIFT_DROP; LIFT_EQ]; ALL_TAC] THEN + REWRITE_TAC[] THEN + MP_TAC(ISPECL [`a:real`; `x:real`; `drop z`] CARLESON_HAX_FT) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[GSYM CX_MUL; CNJ_CX] THEN + SUBGOAL_THEN + `Cx(sqrt(&2 * pi) / &2) * + (f2 z * Cx(inv(sqrt(&2 * pi)) * (&2 * sin(a * (x - drop z)) / (x - drop + z)))) = + f2 z * Cx(sqrt(&2 * pi) / &2 * + (inv(sqrt(&2 * pi)) * (&2 * sin(a * (x - drop z)) / (x - drop + z))))` + SUBST1_TAC THENL + [REWRITE_TAC[GSYM CX_MUL] THEN SIMPLE_COMPLEX_ARITH_TAC; ALL_TAC] THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN + MP_TAC(SPEC `&2 * pi` SQRT_POS_LT) THEN + ANTS_TAC THENL [MP_TAC PI_POS THEN REAL_ARITH_TAC; ALL_TAC] THEN + ABBREV_TAC `q = sqrt(&2 * pi)` THEN DISCH_TAC THEN + SUBGOAL_THEN `q * inv q = &1` MP_TAC THENL + [MATCH_MP_TAC REAL_MUL_RINV THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + CONV_TAC REAL_FIELD; + DISCH_THEN MATCH_MP_TAC THEN + MATCH_MP_TAC INTEGRABLE_COMPLEX_LMUL THEN + MATCH_MP_TAC L2_CNJ_PRODUCT_INTEGRABLE THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC HAX_FT_L2 THEN ASM_REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Fremlin 286V lines 3069-3079: the full sinc computation. For f2 *) +(* representing the FT of G, *) +(* (1/sqrt2pi) INT_{[-a,a]} e^{-ixt} G *) +(* = (1/pi) INT f2(t) sin(a(x-t))/(x-t) dt. *) +(* ------------------------------------------------------------------------- *) + +let SINC_WINDOW_IDENTITY = prove + (`!a x:real G f2:real^1->complex. &0 <= a /\ + G IN lspace (:real^1) (&2) /\ f2 IN lspace (:real^1) (&2) /\ + (!k. schwartz k ==> integral (:real^1) (\z. f2 z * k(drop z)) = + integral (:real^1) (\z. G z * fourier k (drop z))) + ==> Cx(inv(sqrt(&2 * pi))) * + integral (IMAGE lift (real_interval[--a,a])) + (\z. cexp(--(ii * Cx x * Cx(drop z))) * G z) = + Cx(inv pi) * + integral (:real^1) (\z. f2 z * Cx(sin(a * (x - drop z)) / (x - drop + z)))`, +REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[WINDOW_INT_LPRODUCT] THEN + MP_TAC(ISPECL [`a:real`; `x:real`; `G:real^1->complex`; `f2:real^1->complex`] + SINC_BILINEAR) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + ASM_SIMP_TAC[SINC_LPRODUCT_REAL] THEN + (* pull constants into both integrals *) + SUBGOAL_THEN + `Cx(inv(sqrt(&2 * pi))) * + integral (:real^1) + (\z. f2 z * Cx(inv(sqrt(&2 * pi)) * + (&2 * sin(a * (x - drop z)) / (x - drop z)))) = + integral (:real^1) + (\z. Cx(inv(sqrt(&2 * pi))) * + (f2 z * Cx(inv(sqrt(&2 * pi)) * + (&2 * sin(a * (x - drop z)) / (x - drop z)))))` + SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC INTEGRAL_COMPLEX_LMUL THEN + SUBGOAL_THEN + `(\z:real^1. f2 z * Cx(inv(sqrt(&2 * pi)) * + (&2 * sin(a * (x - drop z)) / (x - drop z)))) = + (\z:real^1. Cx(inv(sqrt(&2 * pi)) * &2) * + (f2 z * Cx(sin(a * (x - drop z)) / (x - drop z))))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN REWRITE_TAC[GSYM CX_MUL] THEN + SIMPLE_COMPLEX_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC INTEGRABLE_COMPLEX_LMUL THEN + MATCH_MP_TAC SINC_INTEGRAND_INTEGRABLE THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `Cx(inv pi) * + integral (:real^1) (\z. f2 z * Cx(sin(a * (x - drop z)) / (x - drop z))) = + integral (:real^1) + (\z. Cx(inv pi) * (f2 z * Cx(sin(a * (x - drop z)) / (x - drop z))))` + SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC INTEGRAL_COMPLEX_LMUL THEN + MATCH_MP_TAC SINC_INTEGRAND_INTEGRABLE THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC INTEGRAL_EQ THEN X_GEN_TAC `z:real^1` THEN DISCH_TAC THEN + REWRITE_TAC[] THEN + SUBGOAL_THEN + `Cx(inv(sqrt(&2 * pi))) * + (f2 z * Cx(inv(sqrt(&2 * pi)) * (&2 * sin(a * (x - drop z)) / (x - drop + z)))) = + f2 z * Cx(inv(sqrt(&2 * pi)) * + (inv(sqrt(&2 * pi)) * (&2 * (sin(a * (x - drop z)) / (x - drop + z)))))` + SUBST1_TAC THENL + [REWRITE_TAC[GSYM CX_MUL] THEN SIMPLE_COMPLEX_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `Cx(inv pi) * (f2 z * Cx(sin(a * (x - drop z)) / (x - drop z))) = + f2 z * Cx(inv pi * (sin(a * (x - drop z)) / (x - drop z)))` + SUBST1_TAC THENL + [REWRITE_TAC[GSYM CX_MUL] THEN SIMPLE_COMPLEX_ARITH_TAC; ALL_TAC] THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[SINC_CONST_ID]);; + +(* ------------------------------------------------------------------------- *) +(* L^2 is closed under reflection z |-> g(--z): measurability via *) +(* MEASURABLE_ON_REFLECT + REFLECT_UNIV, norm^2-integrability via *) +(* INTEGRABLE_REFLECT_GEN (IMAGE (--) (:real^1) = (:real^1)). *) +(* ------------------------------------------------------------------------- *) + +(* ------------------------------------------------------------------------- *) +(* Fremlin 284O(a)/284Ie (L^2 inverse-Fourier representative): for f_1 in *) +(* L^2 *) +(* there is G in L^2 with lnorm G = lnorm f_1 such that f_1 REPRESENTS the *) +(* Fourier transform of G, i.e. INT f_1 * h = INT G * fourier h for every *) +(* Schwartz h. (Equivalently, G represents the INVERSE Fourier transform of *) +(* f_1, 284Ie.) This is the honest direction needed in 286V so that the *) +(* window-limit f_2 of G lands on f_1 itself, not its reflection. *) +(* *) +(* Construction: g_0 = FOURIER_L2_REP of f_1 (g_0 represents FT of f_1); *) +(* take *) +(* G(z) = g_0(--z). Then INT G * fourier h = INT g_0(--z) fourier h(z) *) +(* = [reflect] INT g_0(w) fourier h(--w) = INT g_0 * fourier(reflect h) *) +(* = [g_0 rep, reflect h Schwartz] INT f_1 * fourier(fourier(reflect h)) *) +(* = [DOUBLE_TRANSFORM: fourier(fourier k)(w) = k(--w)] INT f_1 * h. *) +(* ------------------------------------------------------------------------- *) + +let FOURIER_L2_REP_INV = prove + (`!f1:real^1->complex. f1 IN lspace (:real^1) (&2) + ==> ?G. G IN lspace (:real^1) (&2) /\ + lnorm (:real^1) (&2) G = lnorm (:real^1) (&2) f1 /\ + (!h. schwartz h + ==> integral (:real^1) (\z. f1 z * h(drop z)) = + integral (:real^1) (\z. G z * fourier h (drop z)))`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(X_CHOOSE_THEN `g0:real^1->complex` STRIP_ASSUME_TAC o + MATCH_MP FOURIER_L2_REP) THEN + EXISTS_TAC `\z:real^1. (g0:real^1->complex)(--z)` THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC LSPACE_REFLECT THEN ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[LNORM_REFLECT]; + X_GEN_TAC `h:real->complex` THEN DISCH_TAC THEN BETA_TAC THEN + SUBGOAL_THEN + `(\z:real^1. (g0:real^1->complex)(--z) * fourier h (drop z)) = + (\z. (\w. (g0:real^1->complex) w * fourier h (drop(--w))) (--z))` + SUBST1_TAC THENL [REWRITE_TAC[VECTOR_NEG_NEG]; ALL_TAC] THEN + GEN_REWRITE_TAC (RAND_CONV) [INTEGRAL_REFLECT_GEN] THEN + REWRITE_TAC[REFLECT_UNIV; DROP_NEG] THEN + SUBGOAL_THEN + `(\w:real^1. (g0:real^1->complex) w * fourier h (--(drop w))) = + (\w. g0 w * fourier (\x. h(--x)) (drop w))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[GSYM FOURIER_REFLECT]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `fourier (\x. (h:real->complex)(--x))`) THEN + ANTS_TAC THENL + [MATCH_MP_TAC SCHWARTZ_FOURIER THEN MATCH_MP_TAC SCHWARTZ_REFLECT THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN + MATCH_MP_TAC INTEGRAL_EQ THEN X_GEN_TAC `z:real^1` THEN DISCH_TAC THEN + REWRITE_TAC[] THEN AP_TERM_TAC THEN + MP_TAC(ISPECL [`\x. (h:real->complex)(--x)`; + `--(drop z):real`] DOUBLE_TRANSFORM) THEN + ANTS_TAC THENL [MATCH_MP_TAC SCHWARTZ_REFLECT THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[REAL_NEG_NEG] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[REAL_NEG_NEG]]);; + +(* ------------------------------------------------------------------------- *) +(* 286U(c) DCT-dominator infrastructure (Fremlin 286D + 284F): the maximal *) +(* function Ahat(G) of an L^2 function G, times a Schwartz weight, is *) +(* L^1(R). *) +(* *) +(* Building block: Ahat(G) integrable on any interval [a,b] with *) +(* int_{[a,b]} Ahat(G) <= C10 ||G||_2 sqrt(b-a), from CARLESON_286T_UNTRUNC *) +(* at FF = real_interval[a,b] (muFF = b-a). *) +(* ------------------------------------------------------------------------- *) + +let CARLESON_AHAT_INTERVAL_BOUND = prove + (`!(G:real->complex) C10 a b. + &0 <= C10 /\ a <= b /\ (\z. G(drop z)) IN lspace (:real^1) (&2) /\ + (!(h:real->complex) GG. schwartz h /\ real_measurable GG + ==> real_integral GG (carleson_Ahat h) + <= C10 * lnorm (:real^1) (&2) (\z. h(drop z)) * sqrt(real_measure + GG)) + ==> carleson_Ahat G real_integrable_on real_interval[a,b] /\ + real_integral (real_interval[a,b]) (carleson_Ahat G) + <= C10 * lnorm (:real^1) (&2) (\z. G(drop z)) * sqrt(b - a)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(ISPECL [`G:real->complex`; `real_interval[a,b]`; `C10:real`] + CARLESON_286T_UNTRUNC) THEN + ASM_SIMP_TAC[REAL_MEASURABLE_REAL_INTERVAL; REAL_MEASURE_REAL_INTERVAL] THEN + ASM_SIMP_TAC[REAL_ARITH `a <= b ==> max (b - a) (&0) = b - a`]);; + +(* Finite decomposition of [0, n+1] into unit intervals: for Ff integrable *) +(* on *) +(* each [k,k+1], int_{[0,n+1]} Ff = sum_{k=0}^{n} int_{[k,k+1]} Ff. *) +(* (Iterated *) +(* REAL_INTEGRAL_COMBINE.) Feeds the uniform bound on int_{[-N,N]} *) +(* Ahat*weight. *) + +let INTERVAL_UNIT_DECOMP = prove + (`!Ff:real->real n. + (!k. Ff real_integrable_on real_interval[&k, &k + &1]) + ==> Ff real_integrable_on real_interval[&0, &(n+1)] /\ + real_integral (real_interval[&0, &(n+1)]) Ff = + sum (0..n) (\k. real_integral (real_interval[&k, &k + &1]) Ff)`, + GEN_TAC THEN INDUCT_TAC THENL + [REWRITE_TAC[ADD_CLAUSES; SUM_CLAUSES_NUMSEG] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REWRITE_TAC[REAL_ADD_LID] THEN + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `0`) THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_ADD_LID]; + DISCH_TAC THEN FIRST_X_ASSUM(fun th -> MP_TAC(MATCH_MP th (ASSUME + `!k. (Ff:real->real) real_integrable_on real_interval[&k, &k + &1]`))) + THEN + STRIP_TAC THEN + SUBGOAL_THEN `&(SUC n + 1):real = &(n + 1) + &1` SUBST1_TAC THENL + [REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_SUC] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `Ff real_integrable_on real_interval[&0, &(n+1) + &1]` + ASSUME_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_COMBINE THEN EXISTS_TAC `&(n+1):real` THEN + ASM_REWRITE_TAC[REAL_LE_ADDR; REAL_POS] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n+1`) THEN REWRITE_TAC[]; + ALL_TAC] THEN + ASM_REWRITE_TAC[SUM_CLAUSES_NUMSEG; LE_0] THEN + MP_TAC(ISPECL [`Ff:real->real`; `&0:real`; `&(n+1) + &1:real`; + `&(n+1):real`] + REAL_INTEGRAL_COMBINE) THEN + ASM_REWRITE_TAC[REAL_LE_ADDR; REAL_POS] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + AP_TERM_TAC THEN + SUBGOAL_THEN `&(SUC n):real = &(n+1) /\ (&(SUC n):real) + &1 = &(n+1) + &1` + (fun th -> REWRITE_TAC[th]) THEN + REWRITE_TAC[GSYM REAL_OF_NUM_SUC; REAL_OF_NUM_ADD] THEN + REWRITE_TAC[ADD1] THEN REAL_ARITH_TAC]);; + +(* Monotonicity of the real integral under an a.e.-inequality (f <= g off a *) +(* negligible set), both integrable. Spike f to f' = g on s (else f): f' <= *) +(* g *) +(* everywhere, int f' = int f (REAL_INTEGRAL_SPIKE), f' integrable *) +(* (REAL_INTEGRABLE_SPIKE_EQ), so REAL_INTEGRAL_LE applies. Reusable: the *) +(* maximal function Ahat is only >= 0 a.e. (junk where its window sup is *) +(* +inf). *) + +let REAL_INTEGRAL_LE_AE = prove + (`!f g s t. + real_negligible s /\ f real_integrable_on t /\ g real_integrable_on t /\ + (!x. x IN (t DIFF s) ==> f x <= g x) + ==> real_integral t f <= real_integral t g`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `real_integral t (f:real->real) = + real_integral t (\x. if x IN s then g x else f x)` + SUBST1_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_SPIKE THEN EXISTS_TAC `s:real->bool` THEN + ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_DIFF] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_INTEGRAL_LE THEN REPEAT CONJ_TAC THENL + [MP_TAC(ISPECL [`f:real->real`; + `\x. if x IN s then (g:real->real) x else f x`; + `s:real->bool`; + `t:real->bool`] REAL_INTEGRABLE_SPIKE_EQ) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_DIFF] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[]; + DISCH_THEN(fun th -> REWRITE_TAC[GSYM th] THEN ASM_REWRITE_TAC[])]; + ASM_REWRITE_TAC[]; + X_GEN_TAC `x:real` THEN DISCH_TAC THEN BETA_TAC THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_DIFF]]);; + +(* On a unit interval [k,k+1] (k a natural, so k >= 0), Ahat(G)*inv(1+y^2) *) +(* is integrable: commute to inv(1+y^2)*Ahat(G) and use *) +(* REAL_INTEGRABLE_DECREASING_ PRODUCT (inv(1+y^2) is decreasing on [k,k+1], *) +(* Ahat(G) integrable there). *) + +let SHELL_INTEGRABLE_1 = prove + (`!(G:real->complex) k. + carleson_Ahat G real_integrable_on real_interval[&k, &k + &1] + ==> (\y. carleson_Ahat G y * inv(&1 + y pow 2)) real_integrable_on + real_interval[&k, &k + &1]`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\y. carleson_Ahat (G:real->complex) y * inv(&1 + y pow 2)) = + (\y. (\x. inv(&1 + x pow 2)) y * carleson_Ahat G y)` + SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM] THEN REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPECL [`carleson_Ahat (G:real->complex)`; `\x. inv(&1 + x pow 2)`; + `&k:real`; + `&k + &1:real`] REAL_INTEGRABLE_DECREASING_PRODUCT) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + MAP_EVERY X_GEN_TAC [`x:real`; `y:real`] THEN + REWRITE_TAC[IN_REAL_INTERVAL] THEN STRIP_TAC THEN REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN CONJ_TAC THENL + [MP_TAC(SPEC `x:real` REAL_LE_POW_2) THEN REAL_ARITH_TAC; + REWRITE_TAC[REAL_LE_LADD] THEN MATCH_MP_TAC REAL_POW_LE2 THEN + ASM_REAL_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* The 0-extension of a real square-integrable f on [-pi,pi], embedded via *) +(* Cx, *) +(* is in L^2(R): measurable (MEASURABLE_ON_UNIV + Cx-compose of the real- *) +(* measurable f) and norm^2 = f^2.chi_[-pi,pi] integrable. *) +(* ------------------------------------------------------------------------- *) + +let CARLESON_H1_BOUND = prove + (`!(f:real->complex) C10. + &0 <= C10 /\ (\z. f(drop z)) IN lspace (:real^1) (&2) /\ + (!(h:real->complex) GG. schwartz h /\ real_measurable GG + ==> real_integral GG (carleson_Ahat h) + <= C10 * lnorm (:real^1) (&2) (\z. h(drop z)) * sqrt(real_measure + GG)) + ==> (!M. ?D. &0 <= D /\ + !m. real_integral (real_interval[--(&M),&M]) + (\y. carleson_Ahat_trunc f (&m) y) <= D)`, + REPEAT STRIP_TAC THEN + EXISTS_TAC `C10 * lnorm (:real^1) (&2) (\z. (f:real->complex)(drop z)) * + sqrt(&2 * &M)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC LNORM_POS_LE THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC SQRT_POS_LE THEN REAL_ARITH_TAC]; + X_GEN_TAC `m:num` THEN + MP_TAC(ISPECL [`f:real->complex`; `M:num`; `&m:real`; `C10:real`] + CARLESON_286T_TRUNC_GENERAL) THEN + ASM_REWRITE_TAC[REAL_POS]]);; + +(* Ahat(G) >= 0 almost everywhere (for L^2 G under the 286T gate). Ahat is a *) +(* HOL sup of a NONNEGATIVE set, but that sup is junk where the window *) +(* family is *) +(* unbounded (Ahat = +inf), so nonnegativity is only a.e. Off the negligible *) +(* bad set {y | !k. ?m. k+1 < Ahat_trunc G m y} *) +(* (CARLESON_AHAT_TRUNC_BADSET_NEG, *) +(* fed by CARLESON_H1_BOUND) the truncated family is bounded *) +(* (CARLESON_OFF_BADSET_BOUNDED) hence so is the window family *) +(* (CARLESON_TRUNC_FAMILY_PLAIN_WINDOW_BOUND), so CARLESON_AHAT_POS gives >= *) +(* 0. *) + +let CARLESON_AHAT_NONNEG_AE = prove + (`!(G:real->complex) C10. + &0 <= C10 /\ (\z. G(drop z)) IN lspace (:real^1) (&2) /\ + (!(h:real->complex) GG. schwartz h /\ real_measurable GG + ==> real_integral GG (carleson_Ahat h) + <= C10 * lnorm (:real^1) (&2) (\z. h(drop z)) * sqrt(real_measure + GG)) + ==> ?s. real_negligible s /\ !y. ~(y IN s) ==> &0 <= carleson_Ahat G y`, + REPEAT STRIP_TAC THEN + EXISTS_TAC `{y | !k:num. ?m:num. &k + &1 < carleson_Ahat_trunc + (G:real->complex) (&m) y}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC CARLESON_AHAT_TRUNC_BADSET_NEG THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC CARLESON_H1_BOUND THEN EXISTS_TAC `C10:real` THEN + ASM_REWRITE_TAC[]; + X_GEN_TAC `y:real` THEN DISCH_TAC THEN + MATCH_MP_TAC CARLESON_AHAT_POS THEN + MATCH_MP_TAC CARLESON_TRUNC_FAMILY_PLAIN_WINDOW_BOUND THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC CARLESON_OFF_BADSET_BOUNDED THEN ASM_REWRITE_TAC[]]);; + +(* Per-shell decay bound: int_{[k,k+1]} Ahat(G)*inv(1+y^2) <= *) +(* inv(1+k^2) * (C10 ||G||_2). Pointwise inv(1+y^2) <= inv(1+k^2) a.e. *) +(* (REAL_INTEGRAL_LE_AE off the Ahat-nonneg bad set) then int Ahat over the *) +(* unit *) +(* interval <= C10||G|| (CARLESON_AHAT_INTERVAL_BOUND, sqrt 1 = 1). Feeds *) +(* the *) +(* geometric shell-sum bound sum_k inv(1+k^2) < inf for the L^1 dominator. *) + +let CARLESON_AHAT_SHELL_BOUND = prove + (`!(G:real->complex) C10 k. + &0 <= C10 /\ (\z. G(drop z)) IN lspace (:real^1) (&2) /\ + (!(h:real->complex) GG. schwartz h /\ real_measurable GG + ==> real_integral GG (carleson_Ahat h) + <= C10 * lnorm (:real^1) (&2) (\z. h(drop z)) * sqrt(real_measure + GG)) + ==> real_integral (real_interval[&k, &k + &1]) + (\y. carleson_Ahat G y * inv(&1 + y pow 2)) + <= inv(&1 + &k pow 2) * (C10 * lnorm (:real^1) (&2) (\z. G(drop z)))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(ISPECL [`G:real->complex`; `C10:real`] CARLESON_AHAT_NONNEG_AE) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `s:real->bool` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`G:real->complex`; `C10:real`; `&k:real`; `&k + &1:real`] + CARLESON_AHAT_INTERVAL_BOUND) THEN + ASM_REWRITE_TAC[REAL_LE_ADDR; REAL_POS] THEN + REWRITE_TAC[REAL_ARITH `(&k + &1) - &k = &1`; SQRT_1; REAL_MUL_RID] THEN + STRIP_TAC THEN + TRANS_TAC REAL_LE_TRANS + `real_integral (real_interval[&k, &k + &1]) + (\y. carleson_Ahat G y * inv(&1 + &k pow 2))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_LE_AE THEN + EXISTS_TAC `s:real->bool` THEN ASM_REWRITE_TAC[] THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC SHELL_INTEGRABLE_1 THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_INTEGRABLE_RMUL THEN ASM_REWRITE_TAC[ETA_AX]; + X_GEN_TAC `y:real` THEN REWRITE_TAC[IN_DIFF; IN_REAL_INTERVAL] THEN + STRIP_TAC THEN BETA_TAC THEN MATCH_MP_TAC REAL_LE_LMUL THEN + CONJ_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LE_INV2 THEN CONJ_TAC THENL + [MP_TAC(SPEC `&k:real` REAL_LE_POW_2) THEN REAL_ARITH_TAC; + REWRITE_TAC[REAL_LE_LADD] THEN MATCH_MP_TAC REAL_POW_LE2 THEN + ASM_REWRITE_TAC[REAL_POS]]]]; + MP_TAC(ISPECL [`carleson_Ahat (G:real->complex)`; `inv(&1 + &k pow 2)`; + `real_interval[&k, &k + &1]`] REAL_INTEGRAL_RMUL) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_LE_INV_EQ] THEN + MP_TAC(SPEC `&k:real` REAL_LE_POW_2) THEN REAL_ARITH_TAC; + ASM_REWRITE_TAC[]]]);; + +(* Geometric shell-sum ingredients for the L^1 dominator. Per-shell weight *) +(* telescopes: for k >= 1, inv(1+k^2) <= inv(k^2) <= 2(inv k - inv(k+1)) *) +(* (cross-multiplied k(k+1) <= 2(1+k^2)); summing k=1..n telescopes to <= 2, *) +(* and *) +(* the k=0 term is 1, so sum_{k=0}^{n} inv(1+k^2) <= 3. *) + +let SHELL_TERM_TELESCOPE = prove + (`!k. 1 <= k ==> inv(&1 + &k pow 2) <= &2 * (inv(&k) - inv(&k + &1))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&1 <= &k` ASSUME_TAC THENL + [ASM_REWRITE_TAC[REAL_OF_NUM_LE]; ALL_TAC] THEN + SUBGOAL_THEN + `&0 < &k /\ &0 < &k + &1 /\ &0 < &1 + &k pow 2` STRIP_ASSUME_TAC THENL + [REPEAT CONJ_TAC THEN TRY(MP_TAC(SPEC `&k:real` REAL_LE_POW_2)) THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `&2 * (inv(&k) - inv(&k + &1)) = &2 / (&k * (&k + &1))` SUBST1_TAC THENL + [REWRITE_TAC[real_div] THEN MATCH_MP_TAC(REAL_FIELD + `&0 < a /\ &0 < b /\ b - a = &1 ==> &2 * (inv a - inv b) = &2 * inv(a * + b)`) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `&0 < &k * (&k + &1)` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ] THEN + SUBGOAL_THEN + `inv(&1 + &k pow 2) * (&k * (&k + &1)) = + (&k * (&k + &1)) / (&1 + &k pow 2)` + SUBST1_TAC THENL [REWRITE_TAC[real_div] THEN REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ] THEN + REWRITE_TAC[REAL_POW_2; REAL_ADD_LDISTRIB; REAL_MUL_RID] THEN + SUBGOAL_THEN `&k <= &k * &k` ASSUME_TAC THENL + [GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REAL_ARITH_TAC; ASM_REAL_ARITH_TAC]);; + +let SHELL_SUM_BOUND = prove + (`!n. sum (0..n) (\k. inv(&1 + &k pow 2)) <= &3`, + GEN_TAC THEN DISJ_CASES_TAC(ARITH_RULE `n = 0 \/ 1 <= n`) THENL + [ASM_REWRITE_TAC[SUM_SING_NUMSEG] THEN + CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN + ASM_SIMP_TAC[SUM_CLAUSES_LEFT; LE_0] THEN + REWRITE_TAC[REAL_POW_2] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + MATCH_MP_TAC(REAL_ARITH `s <= &2 ==> &1 + s <= &3`) THEN + REWRITE_TAC[ADD_CLAUSES] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum (1..n) (\k. &2 * (inv(&k) - inv(&k + &1)))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE_NUMSEG THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN + REWRITE_TAC[GSYM REAL_POW_2] THEN MATCH_MP_TAC SHELL_TERM_TELESCOPE THEN + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUM_LMUL] THEN + SUBGOAL_THEN `sum (1..n) (\k. inv(&k) - inv(&k + &1)) = + sum (1..n) (\k. (\j. inv(&j)) k - (\j. inv(&j)) (k + 1))` SUBST1_TAC + THENL + [MATCH_MP_TAC SUM_EQ_NUMSEG THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD]; + ALL_TAC] THEN + REWRITE_TAC[SUM_DIFFS] THEN ASM_REWRITE_TAC[REAL_INV_1] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= q ==> &2 * (&1 - q) <= &2`) THEN + REWRITE_TAC[REAL_LE_INV_EQ; REAL_OF_NUM_ADD; REAL_POS]]);; + +(* Uniform bound on the shell-sum decomposition of int_{[0,N+1]} *) +(* Ahat(G)*inv(1+y^2): *) +(* sum_{k=0}^{N} int_{[k,k+1]} Ahat(G)*inv(1+y^2) <= 3 (C10 ||G||_2). *) +(* Each shell integral <= inv(1+k^2)(C10||G||) (CARLESON_AHAT_SHELL_BOUND); *) +(* SUM_RMUL + SHELL_SUM_BOUND gives the geometric total <= 3(C10||G||). *) + +let AHAT_HALF_SUMBOUND = prove + (`!(G:real->complex) C10 N. + &0 <= C10 /\ (\z. G(drop z)) IN lspace (:real^1) (&2) /\ + (!(h:real->complex) GG. schwartz h /\ real_measurable GG + ==> real_integral GG (carleson_Ahat h) + <= C10 * lnorm (:real^1) (&2) (\z. h(drop z)) * sqrt(real_measure + GG)) + ==> sum (0..N) + (\k. real_integral (real_interval[&k, &k + &1]) + (\y. carleson_Ahat G y * inv(&1 + y pow 2))) + <= &3 * (C10 * lnorm (:real^1) (&2) (\z. G(drop z)))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN + `&0 <= C10 * lnorm (:real^1) (&2) (\z. (G:real->complex)(drop z))` + ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC LNORM_POS_LE THEN ASM_REWRITE_TAC[REAL_ARITH `&1 <= &2`]; + ALL_TAC] THEN + TRANS_TAC REAL_LE_TRANS + `sum (0..N) (\k. inv(&1 + &k pow 2) * + (C10 * lnorm (:real^1) (&2) (\z. (G:real->complex)(drop z))))` + THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE_NUMSEG THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN + BETA_TAC THEN + MATCH_MP_TAC CARLESON_AHAT_SHELL_BOUND THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[SUM_RMUL] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN ASM_REWRITE_TAC[SHELL_SUM_BOUND]]);; + +(* Reflection of the maximal function: carleson_Ahat G (--y) = *) +(* carleson_Ahat (\x. G(--x)) y. The window integral at [a,b] with frequency *) +(* --y *) +(* over G equals the window integral at [--b,--a] with frequency y over the *) +(* reflected function (substitution x |-> --x, INTEGRAL_REFLECT); the two *) +(* sup-sets *) +(* coincide under the bijection [a,b] <-> [--b,--a] on {a<=b}. Lets the *) +(* negative *) +(* half-line int_{[-N,0]} Ahat(G) be handled via Ahat of the reflected L^2 *) +(* function. *) + +let AHAT_WINDOW_REFLECT = prove + (`!(G:real->complex) y a b. + integral (IMAGE lift (real_interval[a,b])) + (\x. cexp(--(ii * Cx(--y) * Cx(drop x))) * G(drop x)) = + integral (IMAGE lift (real_interval[--b,--a])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * (\t. G(--t))(drop x))`, + REPEAT GEN_TAC THEN REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL] THEN + MP_TAC(ISPECL + [`\x. cexp(--(ii * Cx y * Cx(drop x))) * (G:real->complex)(--(drop x))`; + `lift(--b)`; `lift(--a)`] INTEGRAL_REFLECT) THEN + REWRITE_TAC[DROP_NEG; LIFT_DROP; VECTOR_NEG_NEG; LIFT_NEG] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC INTEGRAL_EQ THEN X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN + REWRITE_TAC[REAL_NEG_NEG; VECTOR_NEG_NEG] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[CX_NEG] THEN SIMPLE_COMPLEX_ARITH_TAC);; + +let CARLESON_AHAT_REFLECT = prove + (`!(G:real->complex) y. carleson_Ahat G (--y) = carleson_Ahat (\x. G(--x)) y`, + REPEAT GEN_TAC THEN REWRITE_TAC[carleson_Ahat] THEN AP_TERM_TAC THEN + GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `v:real` THEN + REWRITE_TAC[IN_ELIM_THM] THEN + SUBGOAL_THEN + `!a b. integral (IMAGE lift (real_interval[a,b])) + (\x. cexp(--(ii * Cx(--y) * Cx(drop x))) * (G:real->complex)(drop + x)) = + integral (IMAGE lift (real_interval[--b,--a])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * G(--drop x))` + ASSUME_TAC THENL + [REPEAT GEN_TAC THEN + MP_TAC(ISPECL [`G:real->complex`; `y:real`; `a:real`; + `b:real`] AHAT_WINDOW_REFLECT) THEN + REWRITE_TAC[]; + ALL_TAC] THEN + EQ_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `a:real` (X_CHOOSE_THEN + `b:real` STRIP_ASSUME_TAC)) THENL + [MAP_EVERY EXISTS_TAC [`--b:real`; `--a:real`] THEN + (CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN + ASM_REWRITE_TAC[] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + ASM_REWRITE_TAC[REAL_NEG_NEG]; + MAP_EVERY EXISTS_TAC [`--b:real`; `--a:real`] THEN + (CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN + ASM_REWRITE_TAC[] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`--b:real`; `--a:real`]) THEN + REWRITE_TAC[REAL_NEG_NEG] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + REFL_TAC]);; + +(* Positive half-line uniform bound: int_{[0,N+1]} Ahat(G)*inv(1+y^2) <= *) +(* 3(C10||G||_2), combining the unit-interval decomposition with the *) +(* geometric shell-sum bound. *) + +let AHAT_HALF_BOUND = prove + (`!(G:real->complex) C10 N. + &0 <= C10 /\ (\z. G(drop z)) IN lspace (:real^1) (&2) /\ + (!(h:real->complex) GG. schwartz h /\ real_measurable GG + ==> real_integral GG (carleson_Ahat h) + <= C10 * lnorm (:real^1) (&2) (\z. h(drop z)) * sqrt(real_measure + GG)) + ==> real_integral (real_interval[&0, &(N+1)]) + (\y. carleson_Ahat G y * inv(&1 + y pow 2)) + <= &3 * (C10 * lnorm (:real^1) (&2) (\z. G(drop z)))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(ISPECL [`\y. carleson_Ahat (G:real->complex) y * inv(&1 + y pow 2)`; + `N:num`] + INTERVAL_UNIT_DECOMP) THEN + ANTS_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC SHELL_INTEGRABLE_1 THEN + MP_TAC(ISPECL [`G:real->complex`; `C10:real`; `&k:real`; `&k + &1:real`] + CARLESON_AHAT_INTERVAL_BOUND) THEN + ASM_REWRITE_TAC[REAL_LE_ADDR; REAL_POS] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[]; + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC AHAT_HALF_SUMBOUND THEN ASM_REWRITE_TAC[]]);; + +(* The maximal-function integrand is reflection-related: at frequency --y *) +(* over G it equals the reflected function's at y (CARLESON_AHAT_REFLECT + *) +(* (--y)^2 = y^2). *) + +let AHAT_REFLECT_INTEGRAND = prove + (`!(G:real->complex) y. + carleson_Ahat G (--y) * inv(&1 + (--y) pow 2) = + carleson_Ahat (\x. G(--x)) y * inv(&1 + y pow 2)`, + REPEAT GEN_TAC THEN REWRITE_TAC[CARLESON_AHAT_REFLECT] THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[REAL_POW_2] THEN REAL_ARITH_TAC);; + +(* The negative half-line integral is the reflected function's positive *) +(* half-line integral (substitution y |-> --y, REAL_INTEGRAL_REFLECT + *) +(* double reflection). *) + +let AHAT_NEGHALF_REFLECT_ID = prove + (`!(G:real->complex) N. + real_integral (real_interval[--(&(N+1)), &0]) + (\y. carleson_Ahat G y * inv(&1 + y pow 2)) = + real_integral (real_interval[&0, &(N+1)]) + (\u. carleson_Ahat (\x. G(--x)) u * inv(&1 + u pow 2))`, + REPEAT GEN_TAC THEN + MP_TAC(ISPECL [`\u. carleson_Ahat (\x. (G:real->complex)(--x)) u * inv(&1 + u + pow 2)`; + `&0:real`; `&(N+1):real`] REAL_INTEGRAL_REFLECT) THEN + REWRITE_TAC[REAL_NEG_0] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC REAL_INTEGRAL_EQ THEN X_GEN_TAC `y:real` THEN + REWRITE_TAC[IN_REAL_INTERVAL] THEN STRIP_TAC THEN REWRITE_TAC[] THEN + MP_TAC(ISPECL [`\x. (G:real->complex)(--x)`; + `y:real`] CARLESON_AHAT_REFLECT) THEN + REWRITE_TAC[REAL_NEG_NEG; ETA_AX] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[REAL_POW_2] THEN REAL_ARITH_TAC);; + +(* Negative half-line uniform bound, from the positive one at the reflected *) +(* L^2 function (LSPACE_REFLECT, LNORM_REFLECT: same L^2 norm). *) + +let AHAT_NEGHALF_BOUND = prove + (`!(G:real->complex) C10 N. + &0 <= C10 /\ (\z. G(drop z)) IN lspace (:real^1) (&2) /\ + (!(h:real->complex) GG. schwartz h /\ real_measurable GG + ==> real_integral GG (carleson_Ahat h) + <= C10 * lnorm (:real^1) (&2) (\z. h(drop z)) * sqrt(real_measure + GG)) + ==> real_integral (real_interval[--(&(N+1)), &0]) + (\y. carleson_Ahat G y * inv(&1 + y pow 2)) + <= &3 * (C10 * lnorm (:real^1) (&2) (\z. G(drop z)))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + REWRITE_TAC[AHAT_NEGHALF_REFLECT_ID] THEN + SUBGOAL_THEN `lnorm (:real^1) (&2) (\z. (G:real->complex)(drop z)) = + lnorm (:real^1) (&2) (\z. (\x. G(--x))(drop z))` SUBST1_TAC + THENL + [REWRITE_TAC[DROP_NEG] THEN + MP_TAC(ISPECL [`\z:real^1. (G:real->complex)(drop z)`; + `&2`] LNORM_REFLECT) THEN + REWRITE_TAC[DROP_NEG] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REFL_TAC; + ALL_TAC] THEN + MATCH_MP_TAC AHAT_HALF_BOUND THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[DROP_NEG] THEN + MP_TAC(ISPEC `\z:real^1. (G:real->complex)(drop z)` LSPACE_REFLECT) THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[DROP_NEG]);; + +(* Integrability of Ahat(G)*inv(1+y^2) on each half-interval [0,N+1] / *) +(* [-(N+1),0] (first conjunct of INTERVAL_UNIT_DECOMP; negative half via *) +(* reflection). *) + +let AHAT_W_INTEG_POS = prove + (`!(G:real->complex) C10 N. + &0 <= C10 /\ (\z. G(drop z)) IN lspace (:real^1) (&2) /\ + (!(h:real->complex) GG. schwartz h /\ real_measurable GG + ==> real_integral GG (carleson_Ahat h) + <= C10 * lnorm (:real^1) (&2) (\z. h(drop z)) * sqrt(real_measure + GG)) + ==> (\y. carleson_Ahat G y * inv(&1 + y pow 2)) real_integrable_on + real_interval[&0, &(N+1)]`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(ISPECL [`\y. carleson_Ahat (G:real->complex) y * inv(&1 + y pow 2)`; + `N:num`] + INTERVAL_UNIT_DECOMP) THEN + ANTS_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC SHELL_INTEGRABLE_1 THEN + MP_TAC(ISPECL [`G:real->complex`; `C10:real`; `&k:real`; `&k + &1:real`] + CARLESON_AHAT_INTERVAL_BOUND) THEN + ASM_REWRITE_TAC[REAL_LE_ADDR; REAL_POS] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[]; + STRIP_TAC THEN ASM_REWRITE_TAC[]]);; + +let AHAT_W_INTEG_NEG = prove + (`!(G:real->complex) C10 N. + &0 <= C10 /\ (\z. G(drop z)) IN lspace (:real^1) (&2) /\ + (!(h:real->complex) GG. schwartz h /\ real_measurable GG + ==> real_integral GG (carleson_Ahat h) + <= C10 * lnorm (:real^1) (&2) (\z. h(drop z)) * sqrt(real_measure + GG)) + ==> (\y. carleson_Ahat G y * inv(&1 + y pow 2)) real_integrable_on + real_interval[--(&(N+1)), &0]`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + GEN_REWRITE_TAC I [GSYM REAL_INTEGRABLE_REFLECT] THEN + REWRITE_TAC[REAL_NEG_0; REAL_NEG_NEG] THEN + SUBGOAL_THEN + `(\x. carleson_Ahat (G:real->complex) (--x) * inv(&1 + (--x) pow 2)) = + (\x. carleson_Ahat (\t. G(--t)) x * inv(&1 + x pow 2))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + REWRITE_TAC[AHAT_REFLECT_INTEGRAND]; + ALL_TAC] THEN + MP_TAC(ISPECL [`\y. carleson_Ahat (\t. (G:real->complex)(--t)) y * inv(&1 + y + pow 2)`; `N:num`] + INTERVAL_UNIT_DECOMP) THEN + ANTS_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC SHELL_INTEGRABLE_1 THEN + MP_TAC(ISPECL [`\t. (G:real->complex)(--t)`; `C10:real`; `&k:real`; + `&k + &1:real`] + CARLESON_AHAT_INTERVAL_BOUND) THEN + ASM_REWRITE_TAC[REAL_LE_ADDR; REAL_POS] THEN + ANTS_TAC THENL + [REWRITE_TAC[DROP_NEG] THEN + MP_TAC(ISPEC `\z:real^1. (G:real->complex)(drop z)` LSPACE_REFLECT) THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[DROP_NEG]; + STRIP_TAC THEN ASM_REWRITE_TAC[]]; + STRIP_TAC THEN ASM_REWRITE_TAC[]]);; + +(* Combined symmetric-interval bound: int_{[-(N+1),N+1]} Ahat G*inv(1+y^2) *) +(* <= 6(C10||G||_2), via REAL_INTEGRAL_COMBINE at 0 + the two half-line *) +(* bounds. *) + +let AHAT_MM_BOUND = prove + (`!(G:real->complex) C10 N. + &0 <= C10 /\ (\z. G(drop z)) IN lspace (:real^1) (&2) /\ + (!(h:real->complex) GG. schwartz h /\ real_measurable GG + ==> real_integral GG (carleson_Ahat h) + <= C10 * lnorm (:real^1) (&2) (\z. h(drop z)) * sqrt(real_measure + GG)) + ==> real_integral (real_interval[--(&(N+1)), &(N+1)]) + (\y. carleson_Ahat G y * inv(&1 + y pow 2)) + <= &6 * (C10 * lnorm (:real^1) (&2) (\z. G(drop z)))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(ISPECL [`G:real->complex`; `C10:real`; `N:num`] AHAT_W_INTEG_NEG) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`G:real->complex`; `C10:real`; `N:num`] AHAT_W_INTEG_POS) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`\y. carleson_Ahat (G:real->complex) y * inv(&1 + y pow 2)`; + `--(&(N+1)):real`; `&(N+1):real`; + `&0:real`] REAL_INTEGRAL_COMBINE) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [REAL_ARITH_TAC; REAL_ARITH_TAC; + MATCH_MP_TAC REAL_INTEGRABLE_COMBINE THEN EXISTS_TAC `&0:real` THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THEN REAL_ARITH_TAC]; + DISCH_THEN(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC(REAL_ARITH `a <= &3 * m /\ b <= &3 * m ==> a + b <= &6 * m`) + THEN + CONJ_TAC THENL + [MP_TAC(ISPECL [`G:real->complex`; `C10:real`; + `N:num`] AHAT_NEGHALF_BOUND) THEN + ASM_REWRITE_TAC[]; + MP_TAC(ISPECL [`G:real->complex`; `C10:real`; + `N:num`] AHAT_HALF_BOUND) THEN + ASM_REWRITE_TAC[]]]);; + +(* The everywhere-nonneg version max(Ahat G,0)*inv(1+y^2) (needed for MCT: *) +(* plain Ahat*inv is nonneg only a.e., breaking pointwise monotonicity) is *) +(* integrable on [-(N+1),N+1] with the same 6(C10||G||) bound: it agrees *) +(* a.e. with Ahat G*inv (CARLESON_AHAT_NONNEG_AE) so *) +(* REAL_INTEGRABLE_SPIKE_EQ / REAL_INTEGRAL_SPIKE transfer both *) +(* integrability and the AHAT_MM_BOUND value. *) + +let AHATPOS_MM = prove + (`!(G:real->complex) C10 N. + &0 <= C10 /\ (\z. G(drop z)) IN lspace (:real^1) (&2) /\ + (!(h:real->complex) GG. schwartz h /\ real_measurable GG + ==> real_integral GG (carleson_Ahat h) + <= C10 * lnorm (:real^1) (&2) (\z. h(drop z)) * sqrt(real_measure + GG)) + ==> (\y. max (carleson_Ahat G y) (&0) * inv(&1 + y pow 2)) + real_integrable_on real_interval[--(&(N+1)), &(N+1)] /\ + real_integral (real_interval[--(&(N+1)), &(N+1)]) + (\y. max (carleson_Ahat G y) (&0) * inv(&1 + y pow 2)) + <= &6 * (C10 * lnorm (:real^1) (&2) (\z. G(drop z)))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN + `(\y. carleson_Ahat (G:real->complex) y * inv(&1 + y pow 2)) + real_integrable_on real_interval[--(&(N+1)), &(N+1)]` + ASSUME_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_COMBINE THEN EXISTS_TAC `&0:real` THEN + REPEAT CONJ_TAC THENL + [REAL_ARITH_TAC; REAL_ARITH_TAC; + MP_TAC(ISPECL [`G:real->complex`; `C10:real`; + `N:num`] AHAT_W_INTEG_NEG) THEN + ASM_REWRITE_TAC[]; + MP_TAC(ISPECL [`G:real->complex`; `C10:real`; + `N:num`] AHAT_W_INTEG_POS) THEN + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + MP_TAC(ISPECL [`G:real->complex`; `C10:real`] CARLESON_AHAT_NONNEG_AE) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `s:real->bool` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `!y. y IN (real_interval[--(&(N+1)), &(N+1)] DIFF s) + ==> max (carleson_Ahat (G:real->complex) y) (&0) * inv(&1 + y pow 2) = + carleson_Ahat G y * inv(&1 + y pow 2)` + ASSUME_TAC THENL + [X_GEN_TAC `y:real` THEN REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `y:real`) THEN ASM_REWRITE_TAC[] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + CONJ_TAC THENL + [MP_TAC(ISPECL + [`\y. carleson_Ahat (G:real->complex) y * inv(&1 + y pow 2)`; + `\y. max (carleson_Ahat (G:real->complex) y) (&0) * inv(&1 + y pow 2)`; + `s:real->bool`; + `real_interval[--(&(N+1)), &(N+1)]`] REAL_INTEGRABLE_SPIKE_EQ) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[]; + DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC[]]; + SUBGOAL_THEN + `real_integral (real_interval[--(&(N+1)), &(N+1)]) + (\y. max (carleson_Ahat (G:real->complex) y) (&0) * inv(&1 + y pow 2)) + = + real_integral (real_interval[--(&(N+1)), &(N+1)]) + (\y. carleson_Ahat G y * inv(&1 + y pow 2))` + SUBST1_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_SPIKE THEN EXISTS_TAC `s:real->bool` THEN + ASM_REWRITE_TAC[] THEN X_GEN_TAC `y:real` THEN REWRITE_TAC[IN_DIFF] THEN + STRIP_TAC THEN CONV_TAC SYM_CONV THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_DIFF]; + MATCH_MP_TAC AHAT_MM_BOUND THEN ASM_REWRITE_TAC[]]]);; + +(* Fremlin 286D conclusion (L^1 form): the maximal function Ahat(G) of an *) +(* L^2 fn, *) +(* weighted by inv(1+y^2), is integrable on the whole line. *) +(* Monotone-convergence *) +(* over the everywhere-nonneg truncations max(Ahat *) +(* G,0)*inv*chi_{[-(k+1),k+1]}: *) +(* each integrable (AHATPOS_MM + REAL_INTEGRABLE_RESTRICT_UNIV), increasing *) +(* (max>=0, *) +(* interval nesting), converging pointwise (eventually inside the window, *) +(* REAL_ARCH_SIMPLE), with truncated integrals bounded by 6(C10||G||) *) +(* (AHATPOS_MM); *) +(* the limit is a.e. equal to Ahat G*inv(1+y^2) (SPIKE off the nonneg bad *) +(* set). *) + +let AHAT_W_INTEGRABLE = prove + (`!(G:real->complex) C10. + &0 <= C10 /\ (\z. G(drop z)) IN lspace (:real^1) (&2) /\ + (!(h:real->complex) GG. schwartz h /\ real_measurable GG + ==> real_integral GG (carleson_Ahat h) + <= C10 * lnorm (:real^1) (&2) (\z. h(drop z)) * sqrt(real_measure + GG)) + ==> (\y. carleson_Ahat G y * inv(&1 + y pow 2)) real_integrable_on + (:real)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(ISPECL [`G:real->complex`; `C10:real`] CARLESON_AHAT_NONNEG_AE) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `s:real->bool` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL + [`\y. max (carleson_Ahat (G:real->complex) y) (&0) * inv(&1 + y pow 2)`; + `\y. carleson_Ahat (G:real->complex) y * inv(&1 + y pow 2)`; + `s:real->bool`; `(:real)`] REAL_INTEGRABLE_SPIKE_EQ) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN X_GEN_TAC `y:real` THEN + REWRITE_TAC[IN_DIFF; IN_UNIV] THEN + STRIP_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `y:real`) THEN ASM_REWRITE_TAC[] THEN + REAL_ARITH_TAC; + DISCH_THEN(SUBST1_TAC o SYM)] THEN + SUBGOAL_THEN + `(\y. max (carleson_Ahat (G:real->complex) y) (&0) * inv (&1 + y pow 2)) + real_integrable_on (:real) /\ + ((\k. real_integral (:real) + (\y. if y IN real_interval[--(&(k+1)), &(k+1)] + then max (carleson_Ahat (G:real->complex) y) (&0) * inv(&1 + y pow + 2) else &0)) + ---> real_integral (:real) (\y. max (carleson_Ahat (G:real->complex) y) + (&0) * inv (&1 + y pow 2))) + sequentially` + (fun th -> REWRITE_TAC[CONJUNCT1 th]) THEN + MATCH_MP_TAC REAL_MONOTONE_CONVERGENCE_INCREASING THEN + REPEAT CONJ_TAC THENL + [GEN_TAC THEN REWRITE_TAC[REAL_INTEGRABLE_RESTRICT_UNIV] THEN + MP_TAC(ISPECL [`G:real->complex`; `C10:real`; `k:num`] AHATPOS_MM) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[]; + REPEAT GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[ADD1; GSYM REAL_OF_NUM_ADD] THEN + COND_CASES_TAC THEN COND_CASES_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_REAL_INTERVAL]) THENL + [REWRITE_TAC[REAL_LE_REFL]; + ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [REAL_ARITH_TAC; + REWRITE_TAC[REAL_LE_INV_EQ] THEN + MP_TAC(SPEC `x:real` REAL_LE_POW_2) THEN REAL_ARITH_TAC]; + REWRITE_TAC[REAL_LE_REFL]]; + X_GEN_TAC `x:real` THEN DISCH_TAC THEN + MP_TAC(SPEC `abs x` REAL_ARCH_SIMPLE) THEN + DISCH_THEN(X_CHOOSE_TAC `K:num`) THEN + MATCH_MP_TAC REALLIM_EVENTUALLY THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `K:num` THEN + X_GEN_TAC `k:num` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + COND_CASES_TAC THEN REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC) THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN + SUBGOAL_THEN `&K <= &k` MP_TAC THENL + [ASM_REWRITE_TAC[REAL_OF_NUM_LE]; ALL_TAC] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[real_bounded; FORALL_IN_GSPEC; IN_UNIV] THEN + EXISTS_TAC `&6 * (C10 * lnorm (:real^1) (&2) (\z. (G:real->complex)(drop + z)))` THEN + X_GEN_TAC `k:num` THEN + REWRITE_TAC[REAL_INTEGRAL_RESTRICT_UNIV] THEN + MP_TAC(ISPECL [`G:real->complex`; `C10:real`; `k:num`] AHATPOS_MM) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + SUBGOAL_THEN `&0 <= real_integral (real_interval [-- &(k + 1),&(k + 1)]) + (\y. max (carleson_Ahat (G:real->complex) y) (&0) * inv (&1 + + y pow 2))` + ASSUME_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_POS THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `y:real` THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LE_MUL THEN + CONJ_TAC THENL [REAL_ARITH_TAC; + REWRITE_TAC[REAL_LE_INV_EQ] THEN + MP_TAC(SPEC `y:real` REAL_LE_POW_2) THEN REAL_ARITH_TAC]; + ASM_REAL_ARITH_TAC]]);; + +(* Auxiliary measurability facts for the 286U(c) DCT dominator. *) + +let ONE_PLUS_YSQ_MEASURABLE = prove + (`(\y. &1 + y pow 2) real_measurable_on (:real)`, + MATCH_MP_TAC REAL_MEASURABLE_ON_ADD THEN + REWRITE_TAC[REAL_MEASURABLE_ON_CONST] THEN + REWRITE_TAC[REAL_POW_2] THEN MATCH_MP_TAC REAL_MEASURABLE_ON_MUL THEN + CONJ_TAC THEN + MATCH_MP_TAC REAL_CONTINUOUS_IMP_REAL_MEASURABLE_ON_CLOSED_SUBSET THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_ID; REAL_CLOSED_UNIV]);; + +(* Ahat(G) is real-measurable on R for L^2 G: Ahat G = (Ahat G * *) +(* inv(1+y^2))*(1+y^2), *) +(* first factor measurable (AHAT_W_INTEGRABLE => integrable => measurable), *) +(* second *) +(* continuous. (Avoids the L^1 hypothesis of CARLESON_AHAT_MEASURABLE.) *) + +let CARLESON_AHAT_MEASURABLE_L2 = prove + (`!(G:real->complex) C10. + &0 <= C10 /\ (\z. G(drop z)) IN lspace (:real^1) (&2) /\ + (!(h:real->complex) GG. schwartz h /\ real_measurable GG + ==> real_integral GG (carleson_Ahat h) + <= C10 * lnorm (:real^1) (&2) (\z. h(drop z)) * sqrt(real_measure + GG)) + ==> carleson_Ahat G real_measurable_on (:real)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN + `carleson_Ahat (G:real->complex) = + (\y. (carleson_Ahat G y * inv(&1 + y pow 2)) * (&1 + y pow 2))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN + SUBGOAL_THEN `inv(&1 + x pow 2) * (&1 + x pow 2) = &1` SUBST1_TAC THENL + [MATCH_MP_TAC REAL_MUL_LINV THEN MP_TAC(SPEC `x:real` REAL_LE_POW_2) THEN + REAL_ARITH_TAC; + REWRITE_TAC[REAL_MUL_RID]]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_MEASURABLE_ON_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_IMP_REAL_MEASURABLE THEN + MATCH_MP_TAC AHAT_W_INTEGRABLE THEN EXISTS_TAC `C10:real` THEN + ASM_REWRITE_TAC[]; + REWRITE_TAC[ONE_PLUS_YSQ_MEASURABLE]]);; + +(* norm o (Schwartz h) is real-measurable on R (h continuous by *) +(* SCHWARTZ_CONT, norm continuous, composition measurable). *) + +let NORM_SCHWARTZ_MEASURABLE = prove + (`!h:real->complex. schwartz h ==> (\y. norm(h y)) real_measurable_on + (:real)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `h:real->complex` SCHWARTZ_CONT) THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN + REWRITE_TAC[real_measurable_on; IMAGE_LIFT_UNIV; o_DEF] THEN + MP_TAC(ISPECL [`\x:real^1. (h:real->complex)(drop x)`; + `\w:real^2. lift(norm w)`] + MEASURABLE_ON_COMPOSE_CONTINUOUS) THEN + REWRITE_TAC[o_DEF] THEN + DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_IMP_MEASURABLE_ON THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[GSYM o_DEF; CONTINUOUS_ON_LIFT_NORM]]);; + +(* Fremlin 284F / 286U(c) DCT dominator: for L^2 G and Schwartz h, *) +(* Ahat(G)*|h| is *) +(* integrable on R. Schwartz decay norm(h y) <= C*inv(1+y^2) *) +(* (SCHWARTZ_DECAY_EXISTS) *) +(* dominates by C*(max(Ahat G,0)*inv(1+y^2)); the latter is Ahat G*inv a.e. *) +(* (nonneg *) +(* bad set) hence integrable (AHAT_W_INTEGRABLE + SPIKE). Measurability of *) +(* Ahat G*|h| = CARLESON_AHAT_MEASURABLE_L2 * NORM_SCHWARTZ_MEASURABLE (via *) +(* max, since *) +(* Ahat is nonneg only a.e., use REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE at *) +(* max(Ahat,0)). *) + +let AHAT_SCHWARTZ_DOM = prove + (`!(G:real->complex) (h:real->complex) C10. + &0 <= C10 /\ (\z. G(drop z)) IN lspace (:real^1) (&2) /\ schwartz h /\ + (!(k:real->complex) GG. schwartz k /\ real_measurable GG + ==> real_integral GG (carleson_Ahat k) + <= C10 * lnorm (:real^1) (&2) (\z. k(drop z)) * sqrt(real_measure + GG)) + ==> (\y. carleson_Ahat G y * norm(h y)) real_integrable_on (:real)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(ISPEC `h:real->complex` SCHWARTZ_DECAY_EXISTS) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `C:real` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`G:real->complex`; `C10:real`] CARLESON_AHAT_NONNEG_AE) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `s:real->bool` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL + [`\y. max (carleson_Ahat (G:real->complex) y) (&0) * norm((h:real->complex) + y)`; + `\y. carleson_Ahat (G:real->complex) y * norm((h:real->complex) y)`; + `s:real->bool`; `(:real)`] REAL_INTEGRABLE_SPIKE_EQ) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN X_GEN_TAC `y:real` THEN + REWRITE_TAC[IN_DIFF; IN_UNIV] THEN + STRIP_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `y:real`) THEN ASM_REWRITE_TAC[] THEN + REAL_ARITH_TAC; + DISCH_THEN(SUBST1_TAC o SYM)] THEN + MATCH_MP_TAC REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN + EXISTS_TAC `\y. C * (max (carleson_Ahat (G:real->complex) y) (&0) * inv(&1 + + y pow 2))` THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC REAL_MEASURABLE_ON_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_MEASURABLE_ON_MAX THEN + REWRITE_TAC[REAL_MEASURABLE_ON_CONST] THEN + REWRITE_TAC[ETA_AX] THEN + MATCH_MP_TAC CARLESON_AHAT_MEASURABLE_L2 THEN EXISTS_TAC `C10:real` THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC NORM_SCHWARTZ_MEASURABLE THEN ASM_REWRITE_TAC[]]; + MATCH_MP_TAC REAL_INTEGRABLE_LMUL THEN + MP_TAC(ISPECL [`\y. carleson_Ahat (G:real->complex) y * inv(&1 + y pow 2)`; + `\y. max (carleson_Ahat (G:real->complex) y) (&0) * inv(&1 + y pow 2)`; + `s:real->bool`; `(:real)`] REAL_INTEGRABLE_SPIKE_EQ) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN X_GEN_TAC `y:real` THEN + REWRITE_TAC[IN_DIFF; IN_UNIV] THEN + STRIP_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `y:real`) THEN ASM_REWRITE_TAC[] THEN + REAL_ARITH_TAC; + DISCH_THEN(SUBST1_TAC o SYM)] THEN + MATCH_MP_TAC AHAT_W_INTEGRABLE THEN EXISTS_TAC `C10:real` THEN + ASM_REWRITE_TAC[]; + X_GEN_TAC `y:real` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + SUBGOAL_THEN + `&0 <= max (carleson_Ahat (G:real->complex) y) (&0)` ASSUME_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_ABS_MUL] THEN + SUBGOAL_THEN + `abs(max (carleson_Ahat (G:real->complex) y) (&0)) = max (carleson_Ahat G + y) (&0)` + SUBST1_TAC THENL [ASM_REWRITE_TAC[REAL_ABS_REFL]; ALL_TAC] THEN + REWRITE_TAC[REAL_ABS_NORM] THEN + SUBGOAL_THEN + `C * (max (carleson_Ahat (G:real->complex) y) (&0) * inv(&1 + y pow 2)) = + max (carleson_Ahat G y) (&0) * (C * inv(&1 + y pow 2))` + SUBST1_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[]]);; + +(* For L^2 G and Schwartz h, G * (fourier h) is integrable on R (both in *) +(* L^2, product dominated by norm(G)*norm(fourier h) which is L^1 by *) +(* LSPACE_INTEGRABLE_PRODUCT). This is the "f * hhat integrable" fact *) +(* closing the 286U(c) DCT+Fubini chain. *) + +let GFOURIERH_INTEGRABLE = prove + (`!(G:real^1->complex) h:real->complex. + G IN lspace (:real^1) (&2) /\ schwartz h + ==> (\z. G z * fourier h (drop z)) integrable_on (:real^1)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\z:real^1. fourier (h:real->complex) (drop z)) IN lspace (:real^1) (&2)` + ASSUME_TAC THENL + [MATCH_MP_TAC SCHWARTZ_FOURIER_L2 THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `(G:real^1->complex) measurable_on (:real^1)` ASSUME_TAC THENL + [UNDISCH_TAC `(G:real^1->complex) IN lspace (:real^1) (&2)` THEN + REWRITE_TAC[lspace; IN_ELIM_THM] THEN SIMP_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `(\z:real^1. fourier (h:real->complex) (drop z)) measurable_on (:real^1)` + ASSUME_TAC THENL + [UNDISCH_TAC `(\z:real^1. fourier (h:real->complex) (drop z)) IN lspace + (:real^1) (&2)` THEN + REWRITE_TAC[lspace; IN_ELIM_THM] THEN SIMP_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN + EXISTS_TAC `\z:real^1. lift(norm((G:real^1->complex) z) * norm(fourier + (h:real->complex) (drop z)))` THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_ON_COMPLEX_MUL THEN ASM_REWRITE_TAC[]; + MP_TAC(ISPECL [`(:real^1)`; `&2`; `&2`; `G:real^1->complex`; + `\z:real^1. fourier (h:real->complex) (drop z)`] + LSPACE_INTEGRABLE_PRODUCT) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV; + X_GEN_TAC `z:real^1` THEN + REWRITE_TAC[IN_UNIV; LIFT_DROP; COMPLEX_NORM_MUL] THEN + REWRITE_TAC[REAL_LE_REFL]]);; + +(* Compactly-supported Schwartz L^2-approximation (284N with the support *) +(* bound *) +(* exposed): any L^2 function is L^2-approximable by a Schwartz function *) +(* that is *) +(* ALSO compactly supported (vanishes for abs x > c). Same construction as *) +(* 284N *) +(* (eta_R * P, supported in [-(|R|+2),|R|+2] via ETA_SUPPORT). The compact *) +(* support *) +(* upgrades L^2-convergence to L^1-convergence, giving uniform *) +(* Fourier-transform *) +(* convergence -- the missing ingredient for fourier(L1capL2) in L^2. *) +let LSPACE_APPROXIMATE_SCHWARTZ_CSUPP = prove + (`!f:real^1->real^2. f IN lspace (:real^1) (&2) + ==> !e. &0 < e + ==> ?h c. schwartz h /\ (!x. abs x > c ==> h x = Cx(&0)) /\ + lnorm (:real^1) (&2) (\x. f x - (\z. h(drop z)) x) < e`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:real^1->real^2`; `&2`; `e / &2`] + LSPACE_APPROXIMATE_COMPACT_SUPPORT) THEN + ASM_REWRITE_TAC[REAL_HALF; REAL_ARITH `&0 < &2`] THEN + DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^2` + (X_CHOOSE_THEN `R:real` STRIP_ASSUME_TAC)) THEN + ABBREV_TAC `s = interval[lift(--(abs R + &2)), lift(abs R + &2)]` THEN + SUBGOAL_THEN + `bounded s /\ measurable s /\ lebesgue_measurable(s:real^1->bool)` + STRIP_ASSUME_TAC THENL + [EXPAND_TAC "s" THEN + REWRITE_TAC[BOUNDED_INTERVAL; MEASURABLE_INTERVAL; + LEBESGUE_MEASURABLE_INTERVAL]; + ALL_TAC] THEN + MP_TAC(ISPECL [`g:real^1->real^2`; `s:real^1->bool`; `&2`; `e / &2`] + LSPACE_APPROXIMATE_VECTOR_POLYNOMIAL_FUNCTION) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[REAL_HALF; REAL_ARITH `&1 <= &2`] THEN + MATCH_MP_TAC LSPACE_SUBSET THEN EXISTS_TAC `(:real^1)` THEN + ASM_REWRITE_TAC[SUBSET_UNIV]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `P:real^1->real^2` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `\x. Cx(eta (abs R) x) * (P:real^1->real^2)(lift x)` THEN + EXISTS_TAC `abs R + &2` THEN + REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC ETAP_SCHWARTZ THEN ASM_REWRITE_TAC[REAL_ABS_POS]; + X_GEN_TAC `x:real` THEN DISCH_TAC THEN + SUBGOAL_THEN `eta (abs R) x = &0` SUBST1_TAC THENL + [MATCH_MP_TAC ETA_SUPPORT THEN ASM_REWRITE_TAC[REAL_ABS_POS] THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[COMPLEX_MUL_LZERO]]; + ALL_TAC] THEN + REWRITE_TAC[LIFT_DROP] THEN + SUBGOAL_THEN + `!x:real^1. Cx(eta (abs R) (drop x)) * (g:real^1->real^2) x = g x` + ASSUME_TAC THENL + [X_GEN_TAC `x:real^1` THEN + ASM_CASES_TAC `norm(x:real^1) <= abs R` THENL + [SUBGOAL_THEN `eta (abs R) (drop x) = &1` SUBST1_TAC THENL + [MATCH_MP_TAC ETA_ONE THEN + POP_ASSUM MP_TAC THEN REWRITE_TAC[NORM_REAL; GSYM drop] THEN + REAL_ARITH_TAC; + REWRITE_TAC[COMPLEX_MUL_LID]]; + SUBGOAL_THEN `(g:real^1->real^2) x = vec 0` SUBST1_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[COMPLEX_VEC_0; COMPLEX_MUL_RZERO]]]; + ALL_TAC] THEN + SUBGOAL_THEN + `(\x:real^1. Cx(eta (abs R) (drop x)) * (P:real^1->real^2) x) IN lspace + (:real^1) (&2)` + ASSUME_TAC THENL + [SUBGOAL_THEN + `(\x:real^1. Cx(eta (abs R) (drop x)) * (P:real^1->real^2) x) = + (\z:real^1. (\x. Cx(eta (abs R) x) * P(lift x))(drop z))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; LIFT_DROP]; + MATCH_MP_TAC SCHWARTZ_L2 THEN MATCH_MP_TAC ETAP_SCHWARTZ THEN + ASM_REWRITE_TAC[REAL_ABS_POS]]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `lnorm (:real^1) (&2) (\x. f x - (g:real^1->real^2) x) + + lnorm (:real^1) (&2) (\x. (g:real^1->real^2) x - + Cx(eta (abs R) (drop x)) * P x)` THEN + CONJ_TAC THENL + [SUBGOAL_THEN + `(\x. f x - Cx(eta (abs R) (drop x)) * (P:real^1->real^2) x) = + (\x. (\x. f x - g x) x + (\x. g x - Cx(eta (abs R) (drop x)) * P x) x)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN VECTOR_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC LNORM_TRIANGLE THEN + REWRITE_TAC[REAL_ARITH `&1 <= &2`; REAL_ARITH `&0 <= &2`] THEN + CONJ_TAC THEN MATCH_MP_TAC LSPACE_SUB THEN + ASM_REWRITE_TAC[REAL_ARITH `&0 <= &2`]; + ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `a < e / &2 /\ b <= e / &2 ==> a + b < e`) THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `(\x. (g:real^1->real^2) x - Cx(eta (abs R) (drop x)) * P x) = + (\x. Cx(eta (abs R) (drop x)) * ((g:real^1->real^2) x - P x))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:real^1` THEN + REWRITE_TAC[COMPLEX_SUB_LDISTRIB] THEN ASM_REWRITE_TAC[] THEN + VECTOR_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `lnorm (:real^1) (&2) (\x. Cx(eta (abs R) (drop x)) * ((g:real^1->real^2) x + - P x)) = + lnorm s (&2) (\x. Cx(eta (abs R) (drop x)) * ((g:real^1->real^2) x - P x))` + SUBST1_TAC THENL + [MATCH_MP_TAC LNORM_SUPPORTED THEN REWRITE_TAC[REAL_ARITH `&0 < &2`] THEN + X_GEN_TAC `x:real^1` THEN EXPAND_TAC "s" THEN + REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP] THEN DISCH_TAC THEN + SUBGOAL_THEN `eta (abs R) (drop x) = &0` SUBST1_TAC THENL + [MATCH_MP_TAC ETA_SUPPORT THEN + REWRITE_TAC[REAL_ABS_POS; NORM_REAL; GSYM drop] THEN + POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; + REWRITE_TAC[COMPLEX_VEC_0; COMPLEX_MUL_LZERO]]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `lnorm s (&2) (\x. (g:real^1->real^2) x - P x)` THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN + MATCH_MP_TAC LNORM_MONO THEN EXISTS_TAC `{}:real^1->bool` THEN + REWRITE_TAC[NEGLIGIBLE_EMPTY; DIFF_EMPTY; REAL_ARITH `&0 <= &2`] THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC LSPACE_SUBSET THEN EXISTS_TAC `(:real^1)` THEN + ASM_REWRITE_TAC[SUBSET_UNIV] THEN + SUBGOAL_THEN + `(\x:real^1. Cx(eta (abs R) (drop x)) * ((g:real^1->real^2) x - P x)) = + (\x. g x - Cx(eta (abs R) (drop x)) * P x)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:real^1` THEN + REWRITE_TAC[COMPLEX_SUB_LDISTRIB] THEN ASM_REWRITE_TAC[] THEN + VECTOR_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC LSPACE_SUB THEN ASM_REWRITE_TAC[REAL_ARITH `&0 <= &2`]; + MATCH_MP_TAC LSPACE_SUB THEN ASM_REWRITE_TAC[REAL_ARITH `&0 <= &2`] THEN + MATCH_MP_TAC LSPACE_SUBSET THEN EXISTS_TAC `(:real^1)` THEN + ASM_REWRITE_TAC[SUBSET_UNIV]; + X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN + MP_TAC(SPECL [`abs R`; `drop x`] ETA_BOUNDS) THEN REAL_ARITH_TAC]);; + +(* Compactly-supported Schwartz sequence: for f in L^2 there is a sequence *) +(* of *) +(* Schwartz functions fn, each supported in [-(cn n),cn n], with ||f - *) +(* fn||_2 < *) +(* 1/(n+1). SKOLEM-wraps LSPACE_APPROXIMATE_SCHWARTZ_CSUPP (twice: fn and *) +(* cn). *) +let SCHWARTZ_SEQ_CSUPP = prove + (`!f:real^1->real^2. f IN lspace (:real^1) (&2) + ==> ?fn:num->real->complex. ?cn:num->real. + (!n. schwartz (fn n)) /\ + (!n x. abs x > cn n ==> fn n x = Cx(&0)) /\ + (!n. lnorm (:real^1) (&2) (\z. f z - fn n (drop z)) < inv(&n + + &1))`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP LSPACE_APPROXIMATE_SCHWARTZ_CSUPP) THEN + DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `inv(&n + &1)`) THEN + REWRITE_TAC[REAL_LT_INV_EQ] THEN + SIMP_TAC[REAL_ARITH `&0 <= &n ==> &0 < &n + &1`; REAL_POS] THEN + REWRITE_TAC[SKOLEM_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `fn:num->real->complex` MP_TAC) THEN + REWRITE_TAC[SKOLEM_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `cn:num->real` STRIP_ASSUME_TAC) THEN + MAP_EVERY EXISTS_TAC [`fn:num->real->complex`; `cn:num->real`] THEN + ASM_REWRITE_TAC[]);; + +(* The smooth plateau times a Schwartz function is Schwartz: eta_R * psi is *) +(* smooth *) +(* (LEIBNIZ_CHAIN of eta's chain ETA_CHAIN with psi's Schwartz chain) and *) +(* compactly *) +(* supported (in [-(R+2),R+2], CHAIN_SUPPORT from ETA_SUPPORT), hence *) +(* Schwartz *) +(* (COMPACT_SUPPORT_SMOOTH_IMP_SCHWARTZ). Mirrors ETAP_SCHWARTZ but with a *) +(* Schwartz *) +(* factor instead of a polynomial. Used to force a COMMON compact support on *) +(* the *) +(* Schwartz approximants of a compactly-supported L^2 function. *) +let ETA_SCHWARTZ_MUL = prove + (`!R (psi:real->complex). &0 <= R /\ schwartz psi + ==> schwartz (\x. Cx(eta R x) * psi x)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `en:num->real->complex` STRIP_ASSUME_TAC o + REWRITE_RULE[schwartz]) THEN + X_CHOOSE_THEN + `q:num->real->complex` STRIP_ASSUME_TAC (SPEC `R:real` ETA_CHAIN) THEN + MP_TAC(ISPECL [`q:num->real->complex`; + `en:num->real->complex`] LEIBNIZ_CHAIN) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `s:num->real->complex` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `(\x. Cx (eta R x) * (psi:real->complex) x) = (s:num->real->complex) 0` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC COMPACT_SUPPORT_SMOOTH_IMP_SCHWARTZ THEN + EXISTS_TAC `R + &2` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[real_gt] THEN MATCH_MP_TAC CHAIN_SUPPORT THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; + X_GEN_TAC `x:real` THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `eta R x = &0` SUBST1_TAC THENL + [MATCH_MP_TAC ETA_SUPPORT THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[CX_MUL; COMPLEX_MUL_LZERO; CX_INJ]]]);; + +(* For G in L^2, the windowed function WG = G.chi[-n,n] is approximated in *) +(* L^2 by a *) +(* sequence of Schwartz functions ALL supported in the FIXED interval *) +(* [-(n+2),n+2]. *) +(* Construction: psi_k = eta_n . xi_k where xi_k -> WG in L^2 *) +(* (SCHWARTZ_SEQ_CSUPP) *) +(* and eta_n is the smooth plateau = 1 on [-n,n], supported in [-(n+2),n+2]. *) +(* Since *) +(* eta_n = 1 on the support of WG, WG - eta_n.xi_k = eta_n.(WG - xi_k), *) +(* whose L^2 *) +(* norm is <= ||WG - xi_k|| -> 0. The fixed common support is what lets the *) +(* forward *) +(* transforms fourier(psi_k) converge uniformly (via L^1) to fourier(WG). *) +let FIXED_SUPP_SCHWARTZ_SEQ = prove + (`!(G:real^1->complex) n. + G IN lspace (:real^1) (&2) + ==> ?psi:num->real->complex. + (!k. schwartz (psi k)) /\ + (!k x. abs x > &n + &2 ==> psi k x = Cx(&0)) /\ + ((\k. lnorm (:real^1) (&2) + (\z. (if abs(drop z) <= &n then G z else vec 0) - psi k (drop + z))) ---> &0) + sequentially`, + REPEAT STRIP_TAC THEN + ABBREV_TAC `WG = \z:real^1. if abs(drop z) <= &n then (G:real^1->complex) z + else vec 0` THEN + SUBGOAL_THEN `(WG:real^1->complex) IN lspace (:real^1) (&2)` ASSUME_TAC THENL + [EXPAND_TAC "WG" THEN + SUBGOAL_THEN + `(\z:real^1. if abs(drop z) <= &n then (G:real^1->complex) z else vec 0) = + (\z. if z IN {z | abs(drop z) <= &n} then G z else vec 0)` + SUBST1_TAC THENL [REWRITE_TAC[IN_ELIM_THM]; ALL_TAC] THEN + MATCH_MP_TAC TRUNC_IN_LSPACE THEN + ASM_REWRITE_TAC[REAL_ARITH `&0 < &2`] THEN + SUBGOAL_THEN + `{z:real^1 | abs(drop z) <= &n} = interval[lift(--(&n)),lift(&n)]` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INTERVAL_1; LIFT_DROP] THEN + GEN_TAC THEN REAL_ARITH_TAC; + REWRITE_TAC[LEBESGUE_MEASURABLE_INTERVAL]]; ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP SCHWARTZ_SEQ_CSUPP) THEN + DISCH_THEN(X_CHOOSE_THEN `xi:num->real->complex` + (X_CHOOSE_THEN `cn:num->real` STRIP_ASSUME_TAC)) THEN + SUBGOAL_THEN + `!k. (\z:real^1. (xi:num->real->complex) k (drop z)) IN lspace (:real^1) + (&2)` ASSUME_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC SCHWARTZ_L2 THEN + ASM_SIMP_TAC[ETA_AX]; ALL_TAC] THEN + SUBGOAL_THEN + `!k. (\z:real^1. Cx(eta (&n) (drop z)) * (xi:num->real->complex) k (drop z)) + IN lspace (:real^1) (&2)` + ASSUME_TAC THENL + [GEN_TAC THEN + SUBGOAL_THEN + `(\z:real^1. Cx(eta (&n) (drop z)) * (xi:num->real->complex) k (drop z)) = + (\z. (\x. Cx(eta (&n) x) * xi k x)(drop z))` + SUBST1_TAC THENL [REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC SCHWARTZ_L2 THEN MATCH_MP_TAC ETA_SCHWARTZ_MUL THEN + ASM_SIMP_TAC[REAL_POS; ETA_AX]; + ALL_TAC] THEN + SUBGOAL_THEN + `!(k:num) z:real^1. + (WG:real^1->complex) z - Cx(eta (&n) (drop z)) * + (xi:num->real->complex) k (drop z) = + Cx(eta (&n) (drop z)) * (WG z - xi k (drop z))` + ASSUME_TAC THENL + [REPEAT GEN_TAC THEN REWRITE_TAC[COMPLEX_SUB_LDISTRIB] THEN + SUBGOAL_THEN `Cx(eta (&n) (drop z)) * (WG:real^1->complex) z = WG z` + (fun th -> REWRITE_TAC[th]) THEN + EXPAND_TAC "WG" THEN COND_CASES_TAC THENL + [SUBGOAL_THEN `eta (&n) (drop z) = &1` SUBST1_TAC THENL + [MATCH_MP_TAC ETA_ONE THEN + ASM_REWRITE_TAC[]; REWRITE_TAC[COMPLEX_MUL_LID]]; + REWRITE_TAC[COMPLEX_VEC_0; COMPLEX_MUL_RZERO]]; ALL_TAC] THEN + EXISTS_TAC `\k x. Cx(eta (&n) x) * (xi:num->real->complex) k x` THEN + REPEAT CONJ_TAC THENL + [GEN_TAC THEN REWRITE_TAC[] THEN MATCH_MP_TAC ETA_SCHWARTZ_MUL THEN + ASM_REWRITE_TAC[REAL_POS; ETA_AX]; + MAP_EVERY X_GEN_TAC [`k:num`; `x:real`] THEN REWRITE_TAC[] THEN + DISCH_TAC THEN + SUBGOAL_THEN `eta (&n) x = &0` SUBST1_TAC THENL + [MATCH_MP_TAC ETA_SUPPORT THEN REWRITE_TAC[REAL_POS] THEN + POP_ASSUM MP_TAC THEN + REWRITE_TAC[real_gt]; REWRITE_TAC[COMPLEX_MUL_LZERO]]; + REWRITE_TAC[] THEN + SUBGOAL_THEN + `!z:real^1. (if abs(drop z) <= &n then (G:real^1->complex) z else vec 0) = + WG z` + (fun th -> REWRITE_TAC[th]) THENL + [FIRST_ASSUM(SUBST1_TAC o GSYM) THEN REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC REALLIM_NULL_COMPARISON THEN + EXISTS_TAC `\k. lnorm (:real^1) (&2) (\z. (WG:real^1->complex) z - + (xi:num->real->complex) k (drop z))` THEN + CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `0` THEN + X_GEN_TAC `k:num` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= y ==> abs x <= y`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC LNORM_POS_LE THEN + ASM_SIMP_TAC[LSPACE_SUB; REAL_POS]; ALL_TAC] THEN + MATCH_MP_TAC LNORM_MONO THEN EXISTS_TAC `{}:real^1->bool` THEN + REWRITE_TAC[NEGLIGIBLE_EMPTY; DIFF_EMPTY; IN_UNIV; + REAL_ARITH `&0 <= &2`] THEN + CONJ_TAC THENL + [MATCH_MP_TAC LSPACE_SUB THEN ASM_SIMP_TAC[REAL_POS]; ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC LSPACE_SUB THEN ASM_SIMP_TAC[REAL_POS]; ALL_TAC] THEN + (X_GEN_TAC `z:real^1` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN + MP_TAC(SPECL [`&n:real`; `drop(z:real^1)`] ETA_BOUNDS) THEN + REAL_ARITH_TAC); + MATCH_MP_TAC REALLIM_NULL_COMPARISON THEN + EXISTS_TAC `\k. inv(&k + &1)` THEN CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `0` THEN + X_GEN_TAC `k:num` THEN DISCH_TAC THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x < y ==> abs x <= y`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC LNORM_POS_LE THEN + ASM_SIMP_TAC[LSPACE_SUB; REAL_POS]; ASM_SIMP_TAC[]]; + REWRITE_TAC[REALLIM_1_OVER_N_OFFSET]]]]);; + +(* Complex conjugation preserves vector derivatives (cnj is R-linear): if f *) +(* has *) +(* vector derivative f' then cnj o f has vector derivative cnj f'. Via *) +(* DIFF_CHAIN_ *) +(* AT with the linear map cnj (HAS_DERIVATIVE_LINEAR + LINEAR_CNJ). *) +let HAS_VECTOR_DERIVATIVE_CNJ = prove + (`!(f:real^1->complex) f' x. + (f has_vector_derivative f') (at x) + ==> ((\z. cnj(f z)) has_vector_derivative cnj f') (at x)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\z:real^1. cnj((f:real^1->complex) z)) = cnj o f` SUBST1_TAC THENL + [REWRITE_TAC[o_DEF]; ALL_TAC] THEN + REWRITE_TAC[has_vector_derivative] THEN + SUBGOAL_THEN + `(\y:real^1. drop y % cnj (f':complex)) = cnj o (\y. drop y % f')` + SUBST1_TAC THENL + [REWRITE_TAC[o_DEF; FUN_EQ_THM] THEN GEN_TAC THEN + REWRITE_TAC[COMPLEX_CMUL; CNJ_MUL; CNJ_CX]; ALL_TAC] THEN + MATCH_MP_TAC DIFF_CHAIN_AT THEN CONJ_TAC THENL + [UNDISCH_TAC `((f:real^1->complex) has_vector_derivative f') (at x)` THEN + REWRITE_TAC[has_vector_derivative]; + MATCH_MP_TAC HAS_DERIVATIVE_LINEAR THEN REWRITE_TAC[LINEAR_CNJ]]);; + +(* Schwartz functions are closed under complex conjugation: the derivative *) +(* chain of cnj o h is cnj of h's chain (HAS_VECTOR_DERIVATIVE_CNJ), and the *) +(* decay bounds are unchanged (norm(cnj z) = norm z). *) +let SCHWARTZ_CNJ = prove + (`!h:real->complex. schwartz h ==> schwartz (\x. cnj(h x))`, + GEN_TAC THEN REWRITE_TAC[schwartz] THEN + DISCH_THEN(X_CHOOSE_THEN `d:num->real->complex` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `\n x. cnj((d:num->real->complex) n x)` THEN + REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[FUN_EQ_THM]; + MAP_EVERY X_GEN_TAC [`n:num`; `x:real`] THEN + MP_TAC(ISPECL + [`\z:real^1. (d:num->real->complex) n (drop z)`; + `(d:num->real->complex) (SUC n) x`; + `lift x`] HAS_VECTOR_DERIVATIVE_CNJ) THEN + ASM_REWRITE_TAC[]; + MAP_EVERY X_GEN_TAC [`k:num`; `m:num`] THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`k:num`; `m:num`]) THEN + REWRITE_TAC[COMPLEX_NORM_CNJ]]);; + +(* Plain (non-cnj) product integrability: for g in L^2 and h Schwartz, g(z) *) +(* h(z) is *) +(* integrable on R. Via the cnj trick: g*h = g*cnj(cnj h), and cnj o h is in *) +(* L^2 *) +(* (LSPACE_CNJ + SCHWARTZ_L2), so L2_CNJ_PRODUCT_INTEGRABLE applies. *) +let L2_SCHWARTZ_PRODUCT_INTEGRABLE = prove + (`!(g:real^1->complex) (h:real->complex). + g IN lspace (:real^1) (&2) /\ schwartz h + ==> (\z. g z * h(drop z)) integrable_on (:real^1)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\z:real^1. cnj((h:real->complex)(drop z))) IN lspace (:real^1) (&2)` + ASSUME_TAC THENL + [MATCH_MP_TAC LSPACE_CNJ THEN MATCH_MP_TAC SCHWARTZ_L2 THEN + ASM_REWRITE_TAC[ETA_AX]; ALL_TAC] THEN + MP_TAC(ISPECL [`(:real^1)`; `g:real^1->complex`; + `\z:real^1. cnj((h:real->complex)(drop z))`] + L2_CNJ_PRODUCT_INTEGRABLE) THEN + ASM_REWRITE_TAC[CNJ_CNJ]);; + +(* L^p membership is invariant under a.e.-equality: if g in L^p and g = f *) +(* a.e., *) +(* then f in L^p. Measurability + norm^p-integrability both transfer via the *) +(* spike *) +(* lemmas (MEASURABLE_ON_SPIKE / INTEGRABLE_SPIKE on the null disagreement *) +(* set). *) +(* Used to pass "in L^2" across the a.e.-limit identifications in the *) +(* 286U(c) *) +(* value-identification. *) +let LSPACE_AE_CONG = prove + (`!(f:real^1->real^2) g p s. + g IN lspace s p /\ negligible {x:real^1 | ~(g x = f x)} + ==> f IN lspace s p`, + REPEAT GEN_TAC THEN REWRITE_TAC[lspace; IN_ELIM_THM] THEN STRIP_TAC THEN + CONJ_TAC THENL + [UNDISCH_TAC `(g:real^1->real^2) measurable_on s` THEN + MATCH_MP_TAC MEASURABLE_ON_SPIKE THEN + EXISTS_TAC `{x:real^1 | ~((g:real^1->real^2) x = f x)}` THEN + ASM_REWRITE_TAC[IN_DIFF; IN_ELIM_THM] THEN + REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN ASM_REWRITE_TAC[]; + UNDISCH_TAC `(\x:real^1. lift(norm((g:real^1->real^2) x) rpow p)) + integrable_on s` THEN + MATCH_MP_TAC INTEGRABLE_SPIKE THEN + EXISTS_TAC `{x:real^1 | ~((g:real^1->real^2) x = f x)}` THEN + ASM_REWRITE_TAC[IN_DIFF; IN_ELIM_THM] THEN + REPEAT STRIP_TAC THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + AP_TERM_TAC THEN + ASM_REWRITE_TAC[]]);; + +(* The indicator of a compact interval is in L^2 (bounded, finite measure): *) +(* measurable (MEASURABLE_ON_CASES) with norm^2-integrand = the interval *) +(* indicator *) +(* (finite-measure constant, INTEGRABLE_RESTRICT_UNIV + INTEGRABLE_CONST). A *) +(* test *) +(* function for the subinterval-integral bridge in the L^2 test-uniqueness *) +(* argument. *) +let INDICATOR_INTERVAL_L2 = prove + (`!a b:real. (\z:real^1. if z IN interval[lift a, lift b] then Cx(&1) else + Cx(&0)) + IN lspace (:real^1) (&2)`, + REPEAT GEN_TAC THEN REWRITE_TAC[lspace; IN_ELIM_THM] THEN CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_ON_CASES THEN + REWRITE_TAC[SET_RULE `{z | z IN s} = s`; LEBESGUE_MEASURABLE_INTERVAL; + MEASURABLE_ON_CONST]; + SUBGOAL_THEN + `(\z:real^1. lift(norm(if z IN interval[lift a,lift b] then Cx(&1) else + Cx(&0)) rpow &2)) = + (\z:real^1. if z IN interval[lift a,lift b] then lift(&1) else vec 0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN COND_CASES_TAC THEN + REWRITE_TAC[COMPLEX_NORM_CX; REAL_ABS_NUM] THENL + [REWRITE_TAC[RPOW_ONE]; + SIMP_TAC[RPOW_ZERO; REAL_OF_NUM_EQ; ARITH_EQ; LIFT_NUM]]; ALL_TAC] THEN + REWRITE_TAC[INTEGRABLE_RESTRICT_UNIV; INTEGRABLE_CONST]]);; + +(* L^2-to-L^1 bound for compactly-supported functions: if d in L^2 vanishes *) +(* for *) +(* abs x > c, then INT norm(d) <= K ||d||_2 for a constant K (= *) +(* ||chi[-c-1,c+1]||_2, *) +(* finite). HOELDER (p=q=2) with the second factor the indicator of the *) +(* support *) +(* interval; norm(d) = norm(d)*norm(chi) since d = 0 off the interval. Turns *) +(* L^2-convergence of compactly-supported functions into L^1-convergence. *) +let PLANCHEREL_L2_REP_ISOMETRY = prove + (`!(a:real^1->complex) b ga gb. + a IN lspace (:real^1) (&2) /\ b IN lspace (:real^1) (&2) /\ + ga IN lspace (:real^1) (&2) /\ gb IN lspace (:real^1) (&2) /\ + (!h. schwartz h ==> integral (:real^1) (\z. ga z * h(drop z)) = + integral (:real^1) (\z. a z * fourier h (drop z))) /\ + (!h. schwartz h ==> integral (:real^1) (\z. gb z * h(drop z)) = + integral (:real^1) (\z. b z * fourier h (drop z))) + ==> lnorm (:real^1) (&2) (\z. ga z - gb z) = lnorm (:real^1) (&2) (\z. a z + - b z)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `\z:real^1. (a:real^1->complex) z - b z` FOURIER_L2_REP) THEN + ASM_SIMP_TAC[LSPACE_SUB; REAL_POS] THEN + DISCH_THEN(X_CHOOSE_THEN `g':real^1->complex` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `lnorm (:real^1) (&2) (\z. (ga:real^1->complex) z - gb z) = lnorm (:real^1) + (&2) (g':real^1->complex)` + (fun th -> ASM_REWRITE_TAC[th]) THEN + MATCH_MP_TAC LNORM_EQ_AE THEN + MATCH_MP_TAC FOURIER_L2_UNIQUE THEN + ASM_SIMP_TAC[LSPACE_SUB; REAL_POS] THEN + X_GEN_TAC `h:real->complex` THEN DISCH_TAC THEN + SUBGOAL_THEN + `integral (:real^1) (\z. ((ga:real^1->complex) z - gb z) * + (h:real->complex)(drop z)) = + integral (:real^1) (\z. ((a:real^1->complex) z - b z) * fourier h (drop + z))` + (fun th -> ASM_SIMP_TAC[th]) THEN + SUBGOAL_THEN + `(\z. ((ga:real^1->complex) z - gb z) * (h:real->complex)(drop z)) = + (\z. ga z * h(drop z) - gb z * h(drop z))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + SIMPLE_COMPLEX_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `(\z. ((a:real^1->complex) z - b z) * fourier h (drop z)) = + (\z. a z * fourier h(drop z) - b z * fourier h(drop z))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + SIMPLE_COMPLEX_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `integral (:real^1) (\z. (ga:real^1->complex) z * (h:real->complex)(drop z) + - gb z * h(drop z)) = + integral (:real^1) (\z. ga z * h(drop z)) - integral (:real^1) (\z. gb z * + h(drop z))` + SUBST1_TAC THENL + [MATCH_MP_TAC INTEGRAL_SUB THEN CONJ_TAC THEN + MATCH_MP_TAC L2_SCHWARTZ_PRODUCT_INTEGRABLE THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `integral (:real^1) (\z. (a:real^1->complex) z * fourier h(drop z) - b z * + fourier h(drop z)) = + integral (:real^1) (\z. a z * fourier h(drop z)) - integral (:real^1) (\z. + b z * fourier h(drop z))` + SUBST1_TAC THENL + [MATCH_MP_TAC INTEGRAL_SUB THEN CONJ_TAC THEN + MATCH_MP_TAC GFOURIERH_INTEGRABLE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_SIMP_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* reusable Cx if-then-else real-integral bridge: integral over R of the *) +(* Cx-valued interval-restricted g equals Cx of the real interval-integral. *) +(* (The Cx-analog of CARLESON_INTERVAL_REAL_BRIDGE; used for the 2D-box *) +(* Cx-pull *) +(* in the w-outer side of MNF_FOURIER_BOX.) *) +(* ------------------------------------------------------------------------- *) +let LINEAR_CX_DROP = prove + (`linear (\v:real^1. Cx(drop v))`, + REWRITE_TAC[linear; DROP_ADD; DROP_CMUL; CX_ADD; CX_MUL] THEN + REWRITE_TAC[COMPLEX_CMUL; GSYM CX_MUL] THEN REPEAT STRIP_TAC THEN + SIMPLE_COMPLEX_ARITH_TAC);; + +let LIFT_RESTRICT_INTEGRABLE = prove + (`!(g:real->real) c d. g real_integrable_on real_interval[c,d] + ==> (\t:real^1. if c <= drop t /\ drop t <= d then lift(g(drop t)) else vec + 0) + integrable_on (:real^1)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\t:real^1. if c <= drop t /\ drop t <= d then lift(g(drop t)) else vec 0) + = + (\t:real^1. if t IN interval[lift c,lift d] then (lift o g o drop) t else + vec 0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; o_THM] THEN GEN_TAC THEN + REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP]; ALL_TAC] THEN + REWRITE_TAC[INTEGRABLE_RESTRICT_UNIV] THEN + FIRST_X_ASSUM(MP_TAC o REWRITE_RULE[REAL_INTEGRABLE_ON]) THEN + REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL; ETA_AX]);; + +let CX_INTERVAL_REAL_BRIDGE = prove + (`!(g:real->real) c d. g real_integrable_on real_interval[c,d] + ==> integral (:real^1) + (\t. if c <= drop t /\ drop t <= d then Cx(g(drop t)) else vec 0) = + Cx(real_integral (real_interval[c,d]) g)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\t:real^1. if c <= drop t /\ drop t <= d then Cx(g(drop t)) else vec 0) = + (\v:real^1. Cx(drop v)) o (\t:real^1. if c <= drop t /\ drop t <= d then + lift(g(drop t)) else vec 0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; o_THM] THEN GEN_TAC THEN COND_CASES_TAC THEN + REWRITE_TAC[LIFT_DROP; DROP_VEC; COMPLEX_VEC_0]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`\t:real^1. if c <= drop t /\ drop t <= d then lift(g(drop t)) else vec 0`; + `(:real^1)`; `\v:real^1. Cx(drop v)`] INTEGRAL_LINEAR) THEN + ASM_SIMP_TAC[LINEAR_CX_DROP; LIFT_RESTRICT_INTEGRABLE] THEN + DISCH_THEN SUBST1_TAC THEN + MP_TAC(ISPECL [`g:real->real`; `c:real`; + `d:real`] CARLESON_INTERVAL_REAL_BRIDGE) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[LIFT_DROP]);; + +(* ------------------------------------------------------------------------- *) +(* S6 keystone step (c), pieces of MNF_FOURIER_BOX (box-Fubini identity). *) +(* ------------------------------------------------------------------------- *) + +(* inner w-integral of the box kernel at fixed (a,b) (a<>0): *) +(* integral_w Cx(inv a)*(cexp(-i(-x)w)*fhat(w))*Cx(theta'_zab w) *) +(* = Cx(inv a)*Cx sqrt2pi * V_ab, V_ab = fourier(hhat.theta'_zab)(-x). *) +(* INTEGRAL_COMPLEX_LMUL (pull Cx inv a) + FOURIER_INNER_INTEGRAL; integrand *) +(* absint via FOURIER_MODULATION_ABSINT + CARLESON_FHAT_THETA'_ABSINT. *) +let MNF_INNER_W_EVAL = prove + (`!(h:real->complex) z0 x a b. schwartz h /\ ~(a = &0) + ==> integral (:real^1) + (\w. Cx(inv a) * + (cexp(--(ii * Cx(--x) * Cx(drop w))) * fourier h (drop w)) * + Cx(carleson_theta' z0 a b (drop w))) = + Cx(inv a) * Cx(sqrt(&2*pi)) * fourier (\w. fourier h w * + Cx(carleson_theta' z0 a b w)) (--x)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `!w:real^1. Cx(inv a) * + (cexp(--(ii * Cx(--x) * Cx(drop w))) * fourier h (drop w)) * + Cx(carleson_theta' z0 a b (drop w)) = + Cx(inv a) * (cexp(--(ii * Cx(--x) * Cx(drop w))) * + (\u. fourier (h:real->complex) u * Cx(carleson_theta' z0 a b + u))(drop w))` + (fun th -> REWRITE_TAC[th]) THENL + [GEN_TAC THEN REWRITE_TAC[] THEN SIMPLE_COMPLEX_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPECL + [`\w:real^1. cexp(--(ii * Cx(--x) * Cx(drop w))) * (\u. fourier + (h:real->complex) u * Cx(carleson_theta' z0 a b u))(drop w)`; + `(:real^1)`; `Cx(inv a)`] INTEGRAL_COMPLEX_LMUL) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC FOURIER_MODULATION_ABSINT THEN + MP_TAC(ISPECL [`h:real->complex`; `z0:real`; `a:real`; + `b:real`] CARLESON_FHAT_THETA'_ABSINT) THEN + ASM_REWRITE_TAC[]; + DISCH_THEN SUBST1_TAC] THEN + REWRITE_TAC[GSYM COMPLEX_MUL_ASSOC] THEN AP_TERM_TAC THEN + MP_TAC(ISPECL [`\u. fourier (h:real->complex) u * Cx(carleson_theta' z0 a b + u)`; `--x:real`] + INNER_INT_FOURIER) THEN + REWRITE_TAC[]);; + +(* (a,b)-OUTER side of the FUBINI swap: integral_ab(integral_w K) evaluates *) +(* (MNF_INNER_W_EVAL on each box slice, off-box integral of vec0 = 0) to the *) +(* box integral of Cx(inv a)*Cx sqrt2pi * V_ab. *) +let MNF_SIDE_AB = prove + (`!(h:real->complex) z0 x n. schwartz h + ==> integral (:real^(1,1)finite_sum) + (\ab. integral (:real^1) + (\w. if &1 <= drop(fstcart ab) /\ drop(fstcart ab) <= &2 /\ + &0 <= drop(sndcart ab) /\ drop(sndcart ab) <= &n + then Cx(inv(drop(fstcart ab))) * + (cexp(--(ii * Cx(--x) * Cx(drop w))) * fourier h (drop + w)) * + Cx(carleson_theta' z0 (drop(fstcart ab)) (drop(sndcart + ab)) (drop w)) + else vec 0)) = + integral (:real^(1,1)finite_sum) + (\ab. if &1 <= drop(fstcart ab) /\ drop(fstcart ab) <= &2 /\ + &0 <= drop(sndcart ab) /\ drop(sndcart ab) <= &n + then Cx(inv(drop(fstcart ab))) * Cx(sqrt(&2*pi)) * + fourier (\w. fourier h w * Cx(carleson_theta' z0 + (drop(fstcart ab)) (drop(sndcart ab)) w)) (--x) + else vec 0)`, + REPEAT STRIP_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN + X_GEN_TAC `ab:real^(1,1)finite_sum` THEN + COND_CASES_TAC THEN REWRITE_TAC[INTEGRAL_0] THEN + MP_TAC(ISPECL [`h:real->complex`; `z0:real`; `x:real`; + `drop(fstcart(ab:real^(1,1)finite_sum))`; + `drop(sndcart(ab:real^(1,1)finite_sum))`] MNF_INNER_W_EVAL) + THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL [ASM_REAL_ARITH_TAC; DISCH_THEN + ACCEPT_TAC]);; + +(* w-outer inner-b slice: at fixed a=drop x in [1,2], the b-line integral of *) +(* the *) +(* box-restricted Cx(inv a)*Cx(theta'_zab w) collapses *) +(* (CX_INTERVAL_REAL_BRIDGE + pull *) +(* the real scalar inv a) to Cx(inv a * int_[0,n] theta'_zab w). (Extracted *) +(* so the *) +(* MNF_ABBOX_CX_NESTED per-x slice is a single MATCH_MP_TAC, avoiding deep *) +(* THENL.) *) +let MNF_INNER_B_EVAL = prove + (`!z0 w n x. &1 <= drop x /\ drop x <= &2 ==> + integral(:real^1)(\y. if &1 <= drop x /\ drop x <= &2 /\ &0 <= drop y /\ + drop y <= &n + then Cx(inv(drop x)) * Cx(carleson_theta' z0 (drop + x)(drop y) w) else vec 0) + = Cx(inv(drop x) * real_integral(real_interval[&0,&n])(\b. carleson_theta' + z0 (drop x) b w))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\y. if &1 <= drop x /\ drop x <= &2 /\ &0 <= drop y /\ drop y <= &n + then Cx(inv(drop x)) * Cx(carleson_theta' z0 (drop x)(drop y) w) else + vec 0) = + (\y. if &0 <= drop y /\ drop y <= &n + then Cx(inv(drop x) * carleson_theta' z0 (drop x)(drop y) w) else vec + 0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `y:real^1` THEN + REWRITE_TAC[GSYM CX_MUL] THEN + SUBGOAL_THEN + `(&1 <= drop x /\ drop x <= &2 /\ &0 <= drop(y:real^1) /\ drop y <= &n) + <=> + (&0 <= drop y /\ drop y <= &n)` SUBST1_TAC THENL + [ASM_REAL_ARITH_TAC; REFL_TAC]; + ALL_TAC] THEN + MP_TAC(ISPECL [`\b. inv(drop(x:real^1)) * carleson_theta' z0 (drop x) b w`; + `&0:real`; `&n:real`] CX_INTERVAL_REAL_BRIDGE) THEN + ANTS_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_LMUL THEN + REWRITE_TAC[THETA'_BETA_INTEGRABLE]; ALL_TAC] THEN + DISCH_THEN(SUBST1_TAC o BETA_RULE) THEN + AP_TERM_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_LMUL THEN + REWRITE_TAC[THETA'_BETA_INTEGRABLE]);; + +(* fs-type box integral of Cx(inv a)*Cx(theta'_zab w) = Cx( int_[1,2](1/a) *) +(* int_[0,n] theta' ). *) +(* Core of the w-outer side of MNF_FOURIER_BOX. Inner (a,b)-Fubini *) +(* [MNF_ABKERNEL_FS_ABSINT] *) +(* -> per-x slice via MNF_INNER_B_EVAL (x in [1,2]) / INTEGRAL_0 (x off box) *) +(* -> outer-a CX *) +(* bridge [THETA'_A_ITERATE_INTEGRABLE]. *) +let MNF_ABBOX_CX_NESTED = prove + (`!z0:real w:real n:num. + integral (:real^(1,1)finite_sum) + (\ab. if &1 <= drop(fstcart ab) /\ drop(fstcart ab) <= &2 /\ + &0 <= drop(sndcart ab) /\ drop(sndcart ab) <= &n + then Cx(inv(drop(fstcart ab))) * Cx(carleson_theta' z0 + (drop(fstcart ab)) (drop(sndcart ab)) w) else vec 0) = + Cx(real_integral (real_interval[&1,&2]) + (\a. inv a * real_integral (real_interval[&0,&n]) (\b. + carleson_theta' z0 a b w)))`, + REPEAT GEN_TAC THEN + MP_TAC(MATCH_MP FUBINI_INTEGRAL (SPECL [`z0:real`;`w:real`;`n:num`] + MNF_ABKERNEL_FS_ABSINT)) THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN DISCH_THEN + SUBST1_TAC THEN + SUBGOAL_THEN + `(\x:real^1. integral (:real^1) + (\y. if &1 <= drop x /\ drop x <= &2 /\ &0 <= drop y /\ drop y <= &n + then Cx(inv(drop x)) * Cx(carleson_theta' z0 (drop x) (drop y) w) + else vec 0)) = + (\x:real^1. if &1 <= drop x /\ drop x <= &2 + then Cx(inv(drop x) * real_integral (real_interval[&0,&n]) (\b. + carleson_theta' z0 (drop x) b w)) + else vec 0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:real^1` THEN COND_CASES_TAC THENL + [MATCH_MP_TAC MNF_INNER_B_EVAL THEN ASM_REWRITE_TAC[]; + SUBGOAL_THEN + `(\y:real^1. if &1 <= drop x /\ drop x <= &2 /\ &0 <= drop y /\ drop y + <= &n + then Cx(inv(drop x)) * Cx(carleson_theta' z0 (drop x) (drop y) w) + else vec 0) = (\y:real^1. vec 0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN COND_CASES_TAC THEN + ASM_MESON_TAC[]; + REWRITE_TAC[INTEGRAL_0]]]; + ALL_TAC] THEN + MP_TAC(ISPECL [`\a. inv a * real_integral (real_interval[&0,&n]) (\b. + carleson_theta' z0 a b w)`; + `&1:real`; `&2:real`] CX_INTERVAL_REAL_BRIDGE) THEN + ANTS_TAC THENL + [REWRITE_TAC[THETA'_A_ITERATE_INTEGRABLE]; + DISCH_THEN(SUBST1_TAC o BETA_RULE) THEN REFL_TAC]);; + +(* w-outer inner side: at fixed w, the ab-box integral of the full transform *) +(* kernel *) +(* factors the ab-constant cexp(-i(-x)w)*fhat(w) to the front *) +(* (INTEGRAL_COMPLEX_LMUL; *) +(* box kernel integrable = MNF_ABKERNEL_FS_ABSINT) and evaluates the *) +(* remaining box *) +(* integral by MNF_ABBOX_CX_NESTED to Cx(NMn w), NMn w = int_[1,2](1/a) *) +(* int_[0,n] theta'. *) +let MNF_SIDEW_INNER = prove + (`!(h:real->complex) z0 x n w. + integral (:real^(1,1)finite_sum) + (\ab. if &1 <= drop(fstcart ab) /\ drop(fstcart ab) <= &2 /\ + &0 <= drop(sndcart ab) /\ drop(sndcart ab) <= &n + then Cx(inv(drop(fstcart ab))) * + (cexp(--(ii * Cx(--x) * Cx(drop w))) * fourier h (drop w)) * + Cx(carleson_theta' z0 (drop(fstcart ab)) (drop(sndcart ab)) + (drop w)) + else vec 0) = + (cexp(--(ii * Cx(--x) * Cx(drop w))) * fourier h (drop w)) * + Cx(real_integral (real_interval[&1,&2]) + (\a. inv a * real_integral (real_interval[&0,&n]) (\b. + carleson_theta' z0 a b (drop w))))`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN + `(\ab:real^(1,1)finite_sum. if &1 <= drop(fstcart ab) /\ drop(fstcart ab) <= + &2 /\ + &0 <= drop(sndcart ab) /\ drop(sndcart ab) <= &n + then Cx(inv(drop(fstcart ab))) * + (cexp(--(ii * Cx(--x) * Cx(drop w))) * fourier h (drop w)) * + Cx(carleson_theta' z0 (drop(fstcart ab)) (drop(sndcart ab)) + (drop w)) + else vec 0) = + (\ab:real^(1,1)finite_sum. (cexp(--(ii * Cx(--x) * Cx(drop w))) * fourier h + (drop w)) * + (if &1 <= drop(fstcart ab) /\ drop(fstcart ab) <= &2 /\ + &0 <= drop(sndcart ab) /\ drop(sndcart ab) <= &n + then Cx(inv(drop(fstcart ab))) * Cx(carleson_theta' z0 (drop(fstcart + ab)) (drop(sndcart ab)) (drop w)) + else vec 0))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN COND_CASES_TAC THEN + REWRITE_TAC[COND_CLAUSES; COMPLEX_VEC_0; COMPLEX_MUL_RZERO] THEN + ABBREV_TAC `Mp = cexp(--(ii * Cx(--x) * Cx(drop w))) * fourier + (h:real->complex)(drop w)` THEN + ABBREV_TAC `Pp = Cx(inv(drop(fstcart(x':real^(1,1)finite_sum))))` THEN + ABBREV_TAC `Sp = Cx(carleson_theta' z0 + (drop(fstcart(x':real^(1,1)finite_sum))) (drop(sndcart x')) + (drop w))` THEN + CONV_TAC COMPLEX_RING; + ALL_TAC] THEN + MP_TAC(ISPECL + [`\ab:real^(1,1)finite_sum. if &1 <= drop(fstcart ab) /\ drop(fstcart ab) <= + &2 /\ + &0 <= drop(sndcart ab) /\ drop(sndcart ab) <= &n + then Cx(inv(drop(fstcart ab))) * Cx(carleson_theta' z0 (drop(fstcart + ab)) (drop(sndcart ab)) (drop w)) + else vec 0`; + `(:real^(1,1)finite_sum)`; + `cexp(--(ii * Cx(--x) * Cx(drop w))) * fourier (h:real->complex) (drop w)`] + INTEGRAL_COMPLEX_LMUL) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + REWRITE_TAC[MNF_ABKERNEL_FS_ABSINT]; + DISCH_THEN SUBST1_TAC] THEN + AP_TERM_TAC THEN REWRITE_TAC[MNF_ABBOX_CX_NESTED]);; + +(* S6 KEYSTONE: box-Fubini identity (MNF_FOURIER_BOX, Fremlin 2827-2868). *) +(* Cx sqrt2pi * fourier(\w. fhat w * Cx(NMn w))(--x) = SIDEAB, where *) +(* NMn w = int_[1,2](1/a) int_[0,n] theta'_zab(w) (un-normalized nested avg) *) +(* and *) +(* SIDEAB = int_ab(box? Cx(inv a)*Cx sqrt2pi * V_ab : 0), V_ab = *) +(* fourier(fhat theta')(-x). *) +(* Both Fubini directions equal the pivot integral(:iterated) fullK: *) +(* LHS route: INNER_INT_FOURIER + MNF_SIDEW_INNER^-1 + *) +(* FUBINI_INTEGRAL_ALT^-1; *) +(* RHS route: FUBINI_INTEGRAL + MNF_SIDE_AB. fullK abs-int = *) +(* MNF_KERNEL_BOX_ABSINT. *) +let MNF_FOURIER_BOX = prove + (`!(h:real->complex) z0 x n. schwartz h + ==> Cx(sqrt(&2*pi)) * + fourier (\w. fourier h w * + Cx(real_integral (real_interval[&1,&2]) + (\a. inv a * real_integral (real_interval[&0,&n]) (\b. + carleson_theta' z0 a b w)))) (--x) = + integral (:real^(1,1)finite_sum) + (\ab. if &1 <= drop(fstcart ab) /\ drop(fstcart ab) <= &2 /\ + &0 <= drop(sndcart ab) /\ drop(sndcart ab) <= &n + then Cx(inv(drop(fstcart ab))) * Cx(sqrt(&2*pi)) * + fourier (\w. fourier h w * Cx(carleson_theta' z0 + (drop(fstcart ab)) (drop(sndcart ab)) w)) (--x) + else vec 0)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`\u. fourier (h:real->complex) u * + Cx(real_integral (real_interval[&1,&2]) + (\a. inv a * real_integral (real_interval[&0,&n]) (\b. + carleson_theta' z0 a b u)))`; + `--x:real`] INNER_INT_FOURIER) THEN + REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + SUBGOAL_THEN + `(\w:real^1. cexp(--(ii * Cx(--x) * Cx(drop w))) * + (fourier (h:real->complex) (drop w) * + Cx(real_integral (real_interval[&1,&2]) + (\a. inv a * real_integral (real_interval[&0,&n]) (\b. + carleson_theta' z0 a b (drop w)))))) = + (\w:real^1. integral (:real^(1,1)finite_sum) + (\ab. if &1 <= drop(fstcart ab) /\ drop(fstcart ab) <= &2 /\ + &0 <= drop(sndcart ab) /\ drop(sndcart ab) <= &n + then Cx(inv(drop(fstcart ab))) * + (cexp(--(ii * Cx(--x) * Cx(drop w))) * fourier h (drop w)) * + Cx(carleson_theta' z0 (drop(fstcart ab)) (drop(sndcart ab)) + (drop w)) + else vec 0))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `w:real^1` THEN REWRITE_TAC[] THEN + REWRITE_TAC[MNF_SIDEW_INNER] THEN + REWRITE_TAC[COMPLEX_MUL_ASSOC]; + ALL_TAC] THEN + MP_TAC(MATCH_MP FUBINI_INTEGRAL_ALT + (MATCH_MP (SPECL[`h:real->complex`;`z0:real`;`x:real`;`n:num`] + MNF_KERNEL_BOX_ABSINT) + (ASSUME `schwartz (h:real->complex)`))) THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + MP_TAC(MATCH_MP FUBINI_INTEGRAL + (MATCH_MP (SPECL[`h:real->complex`;`z0:real`;`x:real`;`n:num`] + MNF_KERNEL_BOX_ABSINT) + (ASSUME `schwartz (h:real->complex)`))) THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN + DISCH_THEN SUBST1_TAC THEN + MP_TAC(SPECL[`h:real->complex`;`z0:real`;`x:real`;`n:num`] MNF_SIDE_AB) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN ACCEPT_TAC);; + +(* ------------------------------------------------------------------------- *) +(* S6 STEP C prerequisites: the box-marginal is integrable + norm-bounded. *) +(* ------------------------------------------------------------------------- *) + +(* the (a,b)-marginal (integral_w fullK) is INTEGRABLE, via *) +(* FUBINI_ABSOLUTELY_ INTEGRABLE (2nd conjunct = has_integral) on *) +(* MNF_KERNEL_BOX_ABSINT. *) +let MNF_MARGINAL_INT = prove + (`!(h:real->complex) z0 x n. schwartz h + ==> (\ab:real^(1,1)finite_sum. integral (:real^1) + (\w. if &1 <= drop(fstcart ab) /\ drop(fstcart ab) <= &2 /\ + &0 <= drop(sndcart ab) /\ drop(sndcart ab) <= &n + then Cx(inv(drop(fstcart ab))) * + (cexp(--(ii * Cx(--x) * Cx(drop w))) * fourier h (drop w)) + * + Cx(carleson_theta' z0 (drop(fstcart ab)) (drop(sndcart ab)) + (drop w)) + else vec 0)) + integrable_on (:real^(1,1)finite_sum)`, + REPEAT STRIP_TAC THEN + MP_TAC(MATCH_MP FUBINI_ABSOLUTELY_INTEGRABLE + (MATCH_MP (SPECL[`h:real->complex`;`z0:real`;`x:real`;`n:num`] + MNF_KERNEL_BOX_ABSINT) + (ASSUME `schwartz (h:real->complex)`))) THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN + STRIP_TAC THEN ASM_MESON_TAC[integrable_on]);; + +(* abstract arithmetic for the marginal norm bound: 2p*ia*s*V <= s*ia*A from *) +(* 2p*V<=A. (name p, not pi, to avoid the pi-constant clash that makes *) +(* REAL_RING throw find.) *) +let MARGINAL_ARITH = prove + (`!s ia V A p:real. &0 <= ia /\ &0 <= s /\ &0 <= V /\ &2 * p * V <= A /\ &0 <= + p + ==> &2 * p * ia * s * V <= s * ia * A`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `s * ia * (&2 * p * V)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_EQ_IMP_LE THEN CONV_TAC REAL_RING; + SUBGOAL_THEN + `s * ia * A = + (s * ia) * A /\ s * ia * (&2 * p * V) = (s * ia) * (&2 * p * V)` + (fun th -> REWRITE_TAC[th]) THENL + [CONJ_TAC THEN CONV_TAC REAL_RING; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[REAL_LE_MUL]]);; + +(* pointwise: 2pi * norm(marginal ab) <= box? sqrt2pi*(1/a)*amd h a b x : 0. *) +(* COND_CASES_TAC reduces the w-independent box cond (also inside the \w) to *) +(* true/false; on-box, MNF_INNER_W_EVAL evaluates the integral to Cx(inv *) +(* a)*Cx sqrt2pi*V_ab, and 2pi norm V_ab <= amd (286Q, a>=1>0); off-box the *) +(* integral of vec0 is 0. *) +let MNF_MARGINAL_NORM_BOUND = prove + (`!(h:real->complex) z0 x n ab. schwartz h + ==> &2 * pi * norm(integral (:real^1) + (\w. if &1 <= drop(fstcart ab) /\ drop(fstcart ab) <= &2 /\ + &0 <= drop(sndcart ab) /\ drop(sndcart ab) <= &n + then Cx(inv(drop(fstcart ab))) * + (cexp(--(ii * Cx(--x) * Cx(drop w))) * fourier h (drop w)) + * + Cx(carleson_theta' z0 (drop(fstcart ab)) (drop(sndcart ab)) + (drop w)) + else vec 0)) + <= (if &1 <= drop(fstcart ab) /\ drop(fstcart ab) <= &2 /\ + &0 <= drop(sndcart ab) /\ drop(sndcart ab) <= &n + then sqrt(&2*pi) * (inv(drop(fstcart ab)) * + carleson_amd h (drop(fstcart ab)) (drop(sndcart ab)) x) + else &0)`, + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN REWRITE_TAC[COND_CLAUSES] THENL + [MP_TAC(ISPECL [`h:real->complex`; `z0:real`; `x:real`; + `drop(fstcart(ab:real^(1,1)finite_sum))`; + `drop(sndcart(ab:real^(1,1)finite_sum))`] MNF_INNER_W_EVAL) + THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX] THEN + SUBGOAL_THEN + `abs(inv(drop(fstcart(ab:real^(1,1)finite_sum)))) = inv(drop(fstcart + ab))` SUBST1_TAC THENL + [REWRITE_TAC[REAL_ABS_INV] THEN AP_TERM_TAC THEN + ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `abs(sqrt(&2*pi)) = sqrt(&2*pi)` SUBST1_TAC THENL + [REWRITE_TAC[REAL_ABS_REFL] THEN MATCH_MP_TAC SQRT_POS_LE THEN + MP_TAC PI_POS THEN REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPECL [`h:real->complex`; `z0:real`; + `drop(fstcart(ab:real^(1,1)finite_sum))`; + `drop(sndcart(ab:real^(1,1)finite_sum))`; + `x:real`] CARLESON_286Q_KERNEL) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[carleson_amd] THEN + ABBREV_TAC `V = norm(fourier (\w. fourier (h:real->complex) w * + Cx(carleson_theta' z0 (drop(fstcart(ab:real^(1,1)finite_sum))) + (drop(sndcart ab)) w)) (--x))` THEN + ABBREV_TAC `A = carleson_A (carleson_modulate + (drop(sndcart(ab:real^(1,1)finite_sum))) (carleson_dilate (drop(fstcart + ab)) (h:real->complex))) (x / drop(fstcart ab))` THEN + ABBREV_TAC `ia = inv(drop(fstcart(ab:real^(1,1)finite_sum)))` THEN + ABBREV_TAC `s = sqrt(&2 * pi)` THEN + SUBGOAL_THEN `&0 <= ia /\ &0 <= s` STRIP_ASSUME_TAC THENL + [CONJ_TAC THENL + [EXPAND_TAC "ia" THEN MATCH_MP_TAC REAL_LE_INV THEN ASM_REAL_ARITH_TAC; + EXPAND_TAC "s" THEN MATCH_MP_TAC SQRT_POS_LE THEN MP_TAC PI_POS THEN + REAL_ARITH_TAC]; + ALL_TAC] THEN + DISCH_TAC THEN + MATCH_MP_TAC MARGINAL_ARITH THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [EXPAND_TAC "V" THEN REWRITE_TAC[NORM_POS_LE]; MP_TAC PI_POS THEN + REAL_ARITH_TAC]; + REWRITE_TAC[INTEGRAL_0; NORM_0; REAL_MUL_RZERO; REAL_LE_REFL]]);; + +(* Mn(w) = inv n * NMn(w) as an integral identity: pull the constant inv n *) +(* out of the outer a-integral (REAL_INTEGRAL_LMUL + *) +(* THETA'_A_ITERATE_INTEGRABLE, integrand ring). *) +let MN_EQ_INVN_NMN = prove + (`!z n w. + real_integral (real_interval[&1,&2]) + (\alpha. inv alpha * (inv(&n) * real_integral (real_interval[&0,&n]) + (\beta. carleson_theta' z alpha beta w))) = + inv(&n) * real_integral (real_interval[&1,&2]) + (\a. inv a * real_integral (real_interval[&0,&n]) (\b. carleson_theta' z + a b w))`, + REPEAT GEN_TAC THEN + MP_TAC(ISPECL [`\a. inv a * real_integral (real_interval[&0,&n]) (\b. + carleson_theta' z a b w)`; + `inv(&n):real`; + `real_interval[&1,&2]`] REAL_INTEGRAL_LMUL) THEN + ANTS_TAC THENL [REWRITE_TAC[THETA'_A_ITERATE_INTEGRABLE]; ALL_TAC] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC REAL_INTEGRAL_EQ THEN X_GEN_TAC `a:real` THEN DISCH_TAC THEN + REWRITE_TAC[REAL_MUL_AC]);; + +(* ------------------------------------------------------------------------- *) +(* S6 STEP C = WN_LE_AAVG : 2pi*norm(fourier(fhat*Mn)(-x)) <= carleson_Aavg *) +(* h n x. *) +(* ------------------------------------------------------------------------- *) + +(* ------------------------------------------------------------------------- *) +(* NMn w-measurability for Step C: w |-> Cx(NMn w) is measurable. *) +(* NMn w = int_[1,2](1/a) int_[0,n] theta'_zab(w). Route: on each window *) +(* [-R,R] *) +(* the box2d x [-R,R] kernel is abs-integrable (finite measure, |.|<=1); *) +(* FUBINI *) +(* gives its w-marginal (= Cx(NMn w) on the window, MNF_ABBOX_CX_NESTED) *) +(* integrable *) +(* hence measurable; MEASURABLE_ON_LIMIT over R=&m -> Cx(NMn) measurable on *) +(* R. *) +(* ------------------------------------------------------------------------- *) + +(* real^(1,(1,1)finite_sum)finite_sum <-> real^3 shuffle (w outer): z |-> *) +(* [a;b;w] with a=fst(snd z), b=snd(snd z), w=fst z; transfers *) +(* CARLESON_THETA'_3D. *) +let SHUF3W_LINEAR = prove + (`linear (\z:real^(1,(1,1)finite_sum)finite_sum. + vector[drop(fstcart(sndcart z)); drop(sndcart(sndcart z)); + drop(fstcart z)]:real^3) /\ + (!u v:real^(1,(1,1)finite_sum)finite_sum. + (\z. vector[drop(fstcart(sndcart z)); drop(sndcart(sndcart z)); + drop(fstcart z)]:real^3) u = + (\z. vector[drop(fstcart(sndcart z)); drop(sndcart(sndcart z)); + drop(fstcart z)]:real^3) v ==> u = v)`, + CONJ_TAC THENL + [REWRITE_TAC[linear] THEN CONJ_TAC THEN REPEAT GEN_TAC THEN + REWRITE_TAC[CART_EQ; DIMINDEX_3; FORALL_3; VECTOR_3] THEN + SIMP_TAC[VECTOR_ADD_COMPONENT; VECTOR_MUL_COMPONENT; VECTOR_3; DIMINDEX_3; + ARITH] THEN + REWRITE_TAC[FSTCART_ADD; SNDCART_ADD; FSTCART_CMUL; SNDCART_CMUL; DROP_ADD; + DROP_CMUL] THEN + REWRITE_TAC[VECTOR_3] THEN REAL_ARITH_TAC; + REPEAT GEN_TAC THEN REWRITE_TAC[] THEN DISCH_TAC THEN + SUBGOAL_THEN + `drop(fstcart(sndcart(u:real^(1,(1,1)finite_sum)finite_sum))) = + drop(fstcart(sndcart v)) /\ + drop(sndcart(sndcart u)) = drop(sndcart(sndcart v)) /\ + drop(fstcart u) = drop(fstcart v)` + STRIP_ASSUME_TAC THENL + [FIRST_X_ASSUM MP_TAC THEN + REWRITE_TAC[CART_EQ; DIMINDEX_3; FORALL_3; VECTOR_3] THEN + SIMP_TAC[]; ALL_TAC] THEN + ONCE_REWRITE_TAC[PASTECART_EQ] THEN REWRITE_TAC[GSYM DROP_EQ] THEN + ASM_REWRITE_TAC[] THEN ONCE_REWRITE_TAC[PASTECART_EQ] THEN + REWRITE_TAC[GSYM DROP_EQ] THEN ASM_REWRITE_TAC[]]);; + +let SHUF3W_IMAGE = prove + (`IMAGE (\z:real^(1,(1,1)finite_sum)finite_sum. + vector[drop(fstcart(sndcart z)); drop(sndcart(sndcart z)); + drop(fstcart z)]:real^3) + (:real^(1,(1,1)finite_sum)finite_sum) = (:real^3)`, + MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN REWRITE_TAC[IN_UNIV] THEN + X_GEN_TAC `p:real^3` THEN + EXISTS_TAC `pastecart (lift((p:real^3)$3)) (pastecart (lift(p$1)) + (lift(p$2))):real^(1,(1,1)finite_sum)finite_sum` THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART; LIFT_DROP] THEN + REWRITE_TAC[CART_EQ; DIMINDEX_3; FORALL_3; VECTOR_3] THEN + CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[]);; + +let SHUF3WC = prove + (`!hh:real^3->complex. + (hh o (\z:real^(1,(1,1)finite_sum)finite_sum. + vector[drop(fstcart(sndcart z)); drop(sndcart(sndcart z)); + drop(fstcart z)]:real^3)) + measurable_on (:real^(1,(1,1)finite_sum)finite_sum) + <=> hh measurable_on (:real^3)`, + GEN_TAC THEN + MP_TAC(ISPECL + [`\z:real^(1,(1,1)finite_sum)finite_sum. vector[drop(fstcart(sndcart z)); + drop(sndcart(sndcart z)); drop(fstcart z)]:real^3`; + `hh:real^3->complex`; + `(:real^(1,(1,1)finite_sum)finite_sum)`] + MEASURABLE_ON_LINEAR_IMAGE_EQ_GEN) THEN + REWRITE_TAC[SHUF3W_LINEAR; DIMINDEX_FINITE_SUM; DIMINDEX_1; DIMINDEX_3; + ARITH] THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[SHUF3W_IMAGE]);; + +let CX_THETA_WOUTER_MEASURABLE = prove + (`!z0. (\z:real^(1,(1,1)finite_sum)finite_sum. + Cx(carleson_theta' z0 (drop(fstcart(sndcart z))) + (drop(sndcart(sndcart z))) (drop(fstcart z)))) + measurable_on (:real^(1,(1,1)finite_sum)finite_sum)`, + GEN_TAC THEN + MP_TAC(ISPEC `\p:real^3. Cx(carleson_theta' z0 (p$1) (p$2) (p$3))` SHUF3WC) + THEN + MATCH_MP_TAC(TAUT `b /\ (a <=> c) ==> (a <=> b) ==> c`) THEN CONJ_TAC THENL + [SUBGOAL_THEN + `(\p:real^3. Cx(carleson_theta' z0 (p$1) (p$2) (p$3))) = + (\v:real^1. Cx(drop v)) o (\p:real^3. lift(carleson_theta' z0 (p$1) (p$2) + (p$3)))` + SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM; o_THM; LIFT_DROP]; ALL_TAC] THEN + MATCH_MP_TAC MEASURABLE_ON_COMPOSE_CONTINUOUS THEN + REWRITE_TAC[CARLESON_THETA'_3D_MEASURABLE; CONTINUOUS_ON_CX_LIFT; + LIFT_DROP; CONTINUOUS_ON_ID]; + AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM; o_THM] THEN + GEN_TAC THEN REWRITE_TAC[VECTOR_3]]);; + +let CX_INVA_WOUTER_MEASURABLE = prove + (`(\z:real^(1,(1,1)finite_sum)finite_sum. Cx(inv(drop(fstcart(sndcart z))))) + measurable_on (:real^(1,(1,1)finite_sum)finite_sum)`, + MP_TAC(ISPEC `\p:real^3. Cx(inv(p$1))` SHUF3WC) THEN + MATCH_MP_TAC(TAUT `b /\ (a <=> c) ==> (a <=> b) ==> c`) THEN CONJ_TAC THENL + [SUBGOAL_THEN + `(\p:real^3. Cx(inv(p$1))) = (\v:real^1. Cx(drop v)) o (\p:real^3. + lift(inv(p$1)))` + SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM; o_THM; LIFT_DROP]; ALL_TAC] THEN + MATCH_MP_TAC MEASURABLE_ON_COMPOSE_CONTINUOUS THEN + REWRITE_TAC[CONTINUOUS_ON_CX_LIFT; LIFT_DROP; CONTINUOUS_ON_ID] THEN + MATCH_MP_TAC MEASURABLE_ON_LIFT_INV THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_IMP_MEASURABLE_ON THEN + MATCH_MP_TAC CONTINUOUS_ON_LIFT_COMPONENT_COMPOSE THEN + REWRITE_TAC[CONTINUOUS_ON_ID]; + REWRITE_TAC[IN_UNIV; NEGLIGIBLE_STANDARD_HYPERPLANE]]; + AP_THM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM; o_THM] THEN + GEN_TAC THEN REWRITE_TAC[VECTOR_3]]);; + +let WBOX_REGION_MEASURABLE = prove + (`!n R. measurable {z:real^(1,(1,1)finite_sum)finite_sum | + abs(drop(fstcart z)) <= R /\ + &1 <= drop(fstcart(sndcart z)) /\ drop(fstcart(sndcart z)) <= &2 + /\ + &0 <= drop(sndcart(sndcart z)) /\ drop(sndcart(sndcart z)) <= + &n}`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN + `{z:real^(1,(1,1)finite_sum)finite_sum | + abs(drop(fstcart z)) <= R /\ + &1 <= drop(fstcart(sndcart z)) /\ drop(fstcart(sndcart z)) <= &2 + /\ + &0 <= drop(sndcart(sndcart z)) /\ drop(sndcart(sndcart z)) <= &n} + = + (interval[lift(--R),lift R]) PCROSS + ((interval[lift(&1),lift(&2)]) PCROSS (interval[lift(&0),lift(&n)]))` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; FORALL_PASTECART; PASTECART_IN_PCROSS; IN_ELIM_THM; + FSTCART_PASTECART; SNDCART_PASTECART; IN_INTERVAL_1; + LIFT_DROP] THEN + REWRITE_TAC[REAL_ARITH `--R <= w /\ w <= R <=> abs w <= R`] THEN + CONV_TAC TAUT; + ONCE_REWRITE_TAC[MEASURABLE_PCROSS] THEN REPEAT DISJ2_TAC THEN + CONJ_TAC THENL + [REWRITE_TAC[MEASURABLE_INTERVAL]; + ONCE_REWRITE_TAC[MEASURABLE_PCROSS] THEN REPEAT DISJ2_TAC THEN + REWRITE_TAC[MEASURABLE_INTERVAL]]]);; + +(* window x box kernel abs-int on the w-outer iterated type. *) +let WBOX_KERNEL_ABSINT = prove + (`!z0 n R. + (\z:real^(1,(1,1)finite_sum)finite_sum. + if abs(drop(fstcart z)) <= R /\ + &1 <= drop(fstcart(sndcart z)) /\ drop(fstcart(sndcart z)) <= &2 /\ + &0 <= drop(sndcart(sndcart z)) /\ drop(sndcart(sndcart z)) <= &n + then Cx(inv(drop(fstcart(sndcart z)))) * + Cx(carleson_theta' z0 (drop(fstcart(sndcart z))) + (drop(sndcart(sndcart z))) (drop(fstcart z))) + else vec 0) + absolutely_integrable_on (:real^(1,(1,1)finite_sum)finite_sum)`, + REPEAT GEN_TAC THEN + MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE THEN + EXISTS_TAC + `\z:real^(1,(1,1)finite_sum)finite_sum. + if abs(drop(fstcart z)) <= R /\ + &1 <= drop(fstcart(sndcart z)) /\ drop(fstcart(sndcart z)) <= &2 /\ + &0 <= drop(sndcart(sndcart z)) /\ drop(sndcart(sndcart z)) <= &n + then lift(&1) else vec 0` THEN + REPEAT CONJ_TAC THENL + [SUBGOAL_THEN + `(\z:real^(1,(1,1)finite_sum)finite_sum. + if abs(drop(fstcart z)) <= R /\ + &1 <= drop(fstcart(sndcart z)) /\ drop(fstcart(sndcart z)) <= &2 /\ + &0 <= drop(sndcart(sndcart z)) /\ drop(sndcart(sndcart z)) <= &n + then Cx(inv(drop(fstcart(sndcart z)))) * + Cx(carleson_theta' z0 (drop(fstcart(sndcart z))) + (drop(sndcart(sndcart z))) (drop(fstcart z))) + else vec 0) = + (\z:real^(1,(1,1)finite_sum)finite_sum. + if z IN {z:real^(1,(1,1)finite_sum)finite_sum | + abs(drop(fstcart z)) <= R /\ + &1 <= drop(fstcart(sndcart z)) /\ drop(fstcart(sndcart z)) + <= &2 /\ + &0 <= drop(sndcart(sndcart z)) /\ drop(sndcart(sndcart z)) + <= &n} + then Cx(inv(drop(fstcart(sndcart z)))) * + Cx(carleson_theta' z0 (drop(fstcart(sndcart z))) + (drop(sndcart(sndcart z))) (drop(fstcart z))) + else vec 0)` + SUBST1_TAC THENL [REWRITE_TAC[IN_ELIM_THM]; ALL_TAC] THEN + MATCH_MP_TAC MEASURABLE_ON_RESTRICT THEN CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_ON_COMPLEX_MUL THEN + REWRITE_TAC[CX_INVA_WOUTER_MEASURABLE; CX_THETA_WOUTER_MEASURABLE]; + MATCH_MP_TAC MEASURABLE_IMP_LEBESGUE_MEASURABLE THEN + REWRITE_TAC[WBOX_REGION_MEASURABLE]]; + SUBGOAL_THEN + `(\z:real^(1,(1,1)finite_sum)finite_sum. + if abs(drop(fstcart z)) <= R /\ + &1 <= drop(fstcart(sndcart z)) /\ drop(fstcart(sndcart z)) <= &2 /\ + &0 <= drop(sndcart(sndcart z)) /\ drop(sndcart(sndcart z)) <= &n + then lift(&1) else vec 0) = + (\z:real^(1,(1,1)finite_sum)finite_sum. + if z IN {z:real^(1,(1,1)finite_sum)finite_sum | + abs(drop(fstcart z)) <= R /\ + &1 <= drop(fstcart(sndcart z)) /\ drop(fstcart(sndcart z)) + <= &2 /\ + &0 <= drop(sndcart(sndcart z)) /\ drop(sndcart(sndcart z)) + <= &n} then lift(&1) else vec 0)` + SUBST1_TAC THENL [REWRITE_TAC[IN_ELIM_THM]; ALL_TAC] THEN + REWRITE_TAC[INTEGRABLE_RESTRICT_UNIV; INTEGRABLE_ON_CONST; + WBOX_REGION_MEASURABLE]; + X_GEN_TAC `z:real^(1,(1,1)finite_sum)finite_sum` THEN + REWRITE_TAC[IN_UNIV] THEN COND_CASES_TAC THEN + REWRITE_TAC[NORM_0; NORM_LIFT; LIFT_DROP; DROP_VEC; REAL_ABS_NUM; + REAL_LE_REFL] THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `abs(inv(drop(fstcart(sndcart(z:real^(1,(1,1)finite_sum)finite_sum))))) * + &1` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN + MP_TAC(ISPECL + [`z0:real`; + `drop(fstcart(sndcart(z:real^(1,(1,1)finite_sum)finite_sum)))`; + `drop(sndcart(sndcart(z:real^(1,(1,1)finite_sum)finite_sum)))`; + `drop(fstcart(z:real^(1,(1,1)finite_sum)finite_sum))`] + CARLESON_THETA'_BOUNDS) THEN REAL_ARITH_TAC; + REWRITE_TAC[REAL_MUL_RID] THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `abs(inv(&1))` THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_ABS_INV] THEN MATCH_MP_TAC REAL_LE_INV2 THEN + ASM_REAL_ARITH_TAC; + CONV_TAC REAL_RAT_REDUCE_CONV]]]);; + +(* the windowed w-marginal (= Cx(NMn w) on |w|<=R via MNF_ABBOX_CX_NESTED) *) +(* is integrable. *) +let NMN_WINDOW_INT = prove + (`!z0 n R. + (\w:real^1. if abs(drop w) <= R + then Cx(real_integral (real_interval[&1,&2]) + (\a. inv a * real_integral (real_interval[&0,&n]) + (\b. carleson_theta' z0 a b (drop w)))) + else vec 0) + integrable_on (:real^1)`, + REPEAT GEN_TAC THEN + MP_TAC(MATCH_MP FUBINI_ABSOLUTELY_INTEGRABLE + (SPECL[`z0:real`;`n:num`;`R:real`] WBOX_KERNEL_ABSINT)) THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN + DISCH_THEN(MP_TAC o CONJUNCT2) THEN + SUBGOAL_THEN + `(\w:real^1. integral (:real^(1,1)finite_sum) + (\ab. if abs(drop w) <= R /\ + &1 <= drop(fstcart ab) /\ drop(fstcart ab) <= &2 /\ + &0 <= drop(sndcart ab) /\ drop(sndcart ab) <= &n + then Cx(inv(drop(fstcart ab))) * + Cx(carleson_theta' z0 (drop(fstcart ab)) (drop(sndcart ab)) + (drop w)) + else vec 0)) = + (\w:real^1. if abs(drop w) <= R + then Cx(real_integral (real_interval[&1,&2]) + (\a. inv a * real_integral (real_interval[&0,&n]) (\b. + carleson_theta' z0 a b (drop w)))) + else vec 0)` + (fun th -> REWRITE_TAC[th]) THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `w:real^1` THEN + ASM_CASES_TAC `abs(drop(w:real^1)) <= R` THEN ASM_REWRITE_TAC[] THENL + [MP_TAC(ISPECL [`z0:real`; `drop(w:real^1)`; + `n:num`] MNF_ABBOX_CX_NESTED) THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM]; + REWRITE_TAC[INTEGRAL_0]]; + MESON_TAC[integrable_on]]);; + +(* CX(NMn) w-measurable: MEASURABLE_ON_LIMIT over R=&m (windowed -> Cx(NMn) *) +(* ptwise). *) +let CX_NMN_W_MEASURABLE = prove + (`!z0 n. (\w:real^1. Cx(real_integral (real_interval[&1,&2]) + (\a. inv a * real_integral (real_interval[&0,&n]) (\b. + carleson_theta' z0 a b (drop w))))) + measurable_on (:real^1)`, + REPEAT GEN_TAC THEN + MATCH_MP_TAC MEASURABLE_ON_LIMIT THEN + EXISTS_TAC + `\m:num. \w:real^1. if abs(drop w) <= &m + then Cx(real_integral (real_interval[&1,&2]) + (\a. inv a * real_integral (real_interval[&0,&n]) + (\b. carleson_theta' z0 a b (drop w)))) + else vec 0` THEN + EXISTS_TAC `{}:real^1->bool` THEN + REWRITE_TAC[NEGLIGIBLE_EMPTY; DIFF_EMPTY; IN_UNIV] THEN CONJ_TAC THENL + [X_GEN_TAC `m:num` THEN MATCH_MP_TAC INTEGRABLE_IMP_MEASURABLE THEN + REWRITE_TAC[NMN_WINDOW_INT]; + X_GEN_TAC `w:real^1` THEN + MP_TAC(ISPEC `abs(drop(w:real^1))` REAL_ARCH_SIMPLE) THEN + DISCH_THEN(X_CHOOSE_TAC `M:num`) THEN + MATCH_MP_TAC LIM_EVENTUALLY THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `M:num` THEN + X_GEN_TAC `p:num` THEN DISCH_TAC THEN + COND_CASES_TAC THEN REWRITE_TAC[] THEN + SUBGOAL_THEN `abs(drop(w:real^1)) <= &p` (fun th -> ASM_MESON_TAC[th]) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&M:real` THEN + ASM_REWRITE_TAC[REAL_OF_NUM_LE]]);; + +(* 0 <= NMn <= n. *) +let NMN_BOUNDS = prove + (`!z0 n w. &0 <= real_integral (real_interval[&1,&2]) + (\a. inv a * real_integral (real_interval[&0,&n]) (\b. + carleson_theta' z0 a b w)) /\ + real_integral (real_interval[&1,&2]) + (\a. inv a * real_integral (real_interval[&0,&n]) (\b. + carleson_theta' z0 a b w)) <= &n`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN + `(\a. inv a * real_integral (real_interval[&0,&n]) (\b. carleson_theta' z0 a + b w)) real_integrable_on real_interval[&1,&2]` + ASSUME_TAC THENL [REWRITE_TAC[THETA'_A_ITERATE_INTEGRABLE]; ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_POS THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `a:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INV THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_INTEGRAL_POS THEN + REWRITE_TAC[THETA'_BETA_INTEGRABLE] THEN + X_GEN_TAC `b:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN STRIP_TAC THEN + MP_TAC(ISPECL [`z0:real`;`a:real`;`b:real`;`w:real`] + CARLESON_THETA'_BOUNDS) THEN REAL_ARITH_TAC]; + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `real_integral (real_interval[&1,&2]) (\a:real. &n)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_LE THEN + ASM_REWRITE_TAC[REAL_INTEGRABLE_CONST] THEN + X_GEN_TAC `a:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&1 * real_integral (real_interval[&0,&n]) (\b. + carleson_theta' z0 a b w)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_RMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(&1)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INV2 THEN + ASM_REAL_ARITH_TAC; CONV_TAC REAL_RAT_REDUCE_CONV]; + MATCH_MP_TAC REAL_INTEGRAL_POS THEN + REWRITE_TAC[THETA'_BETA_INTEGRABLE] THEN + X_GEN_TAC `b:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN + STRIP_TAC THEN + MP_TAC(ISPECL [`z0:real`;`a:real`;`b:real`;`w:real`] + CARLESON_THETA'_BOUNDS) THEN REAL_ARITH_TAC]; + REWRITE_TAC[REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `real_integral (real_interval[&0,&n]) (\b:real. &1)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_LE THEN + REWRITE_TAC[THETA'_BETA_INTEGRABLE; REAL_INTEGRABLE_CONST] THEN + X_GEN_TAC `b:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN + STRIP_TAC THEN + MP_TAC(ISPECL [`z0:real`;`a:real`;`b:real`;`w:real`] + CARLESON_THETA'_BOUNDS) THEN REAL_ARITH_TAC; + SIMP_TAC[REAL_INTEGRAL_CONST; REAL_ARITH `&0 <= &n`] THEN + REAL_ARITH_TAC]]; + SIMP_TAC[REAL_INTEGRAL_CONST; REAL_ARITH `&1 <= &2`] THEN + REAL_ARITH_TAC]]);; + +(* THE FINAL GATE: w |-> fhat(w)*Cx(NMn w) absolutely *) +(* integrable. measurable [fhat * CX_NMN_W_MEASURABLE] + dominated by *) +(* n*|fhat| [NMN_BOUNDS]. *) +let CARLESON_FHAT_NMN_ABSINT = prove + (`!(h:real->complex) z0 n. schwartz h + ==> (\w. fourier h (drop w) * + Cx(real_integral (real_interval[&1,&2]) + (\a. inv a * real_integral (real_interval[&0,&n]) (\b. + carleson_theta' z0 a b (drop w))))) + absolutely_integrable_on (:real^1)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE THEN + EXISTS_TAC `\w:real^1. &n % lift(norm(fourier (h:real->complex) (drop w)))` + THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_ON_COMPLEX_MUL THEN CONJ_TAC THENL + [MP_TAC(ISPEC `h:real->complex` SCHWARTZ_FHAT_ABSINT) THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[ABSOLUTELY_INTEGRABLE_MEASURABLE] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[]; + REWRITE_TAC[CX_NMN_W_MEASURABLE]]; + MATCH_MP_TAC INTEGRABLE_CMUL THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN + MP_TAC(ISPEC `h:real->complex` SCHWARTZ_FHAT_ABSINT) THEN + ASM_REWRITE_TAC[]; + X_GEN_TAC `w:real^1` THEN REWRITE_TAC[IN_UNIV] THEN BETA_TAC THEN + REWRITE_TAC[DROP_CMUL; LIFT_DROP; COMPLEX_NORM_MUL; COMPLEX_NORM_CX] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `norm(fourier (h:real->complex)(drop w)) * &n` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[NORM_POS_LE] THEN + MP_TAC(ISPECL [`z0:real`; `n:num`; `drop(w:real^1)`] NMN_BOUNDS) THEN + REAL_ARITH_TAC; + REWRITE_TAC[REAL_MUL_SYM; REAL_LE_REFL]]]);; + +(* fourier(fhat*Mn) = Cx(inv n) * fourier(fhat*NMn) (Mn = inv n * NMn, *) +(* FOURIER_LMUL). *) +let FHAT_MN_FACTOR = prove + (`!(h:real->complex) z0 x n. schwartz h ==> + fourier (\w. fourier h w * + Cx(real_integral (real_interval[&1,&2]) + (\alpha. inv alpha * (inv(&n) * real_integral + (real_interval[&0,&n]) + (\beta. carleson_theta' z0 alpha beta w))))) (--x) = + Cx(inv(&n)) * fourier (\w. fourier h w * + Cx(real_integral (real_interval[&1,&2]) + (\a. inv a * real_integral (real_interval[&0,&n]) (\b. + carleson_theta' z0 a b w)))) (--x)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[MN_EQ_INVN_NMN; CX_MUL] THEN + SUBGOAL_THEN + `(\w. fourier (h:real->complex) w * + Cx(inv(&n)) * + Cx(real_integral (real_interval[&1,&2]) + (\a. inv a * real_integral (real_interval[&0,&n]) (\b. + carleson_theta' z0 a b w)))) = + (\w. Cx(inv(&n)) * + (fourier (h:real->complex) w * + Cx(real_integral (real_interval[&1,&2]) + (\a. inv a * real_integral (real_interval[&0,&n]) (\b. + carleson_theta' z0 a b w)))))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + CONV_TAC COMPLEX_RING; ALL_TAC] THEN + MATCH_MP_TAC FOURIER_LMUL THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC FOURIER_MODULATION_ABSINT THEN + MP_TAC(ISPECL [`h:real->complex`; `z0:real`; + `n:num`] CARLESON_FHAT_NMN_ABSINT) THEN + ASM_REWRITE_TAC[]);; + +(* abstract on-box arithmetic: N <= inv s*(ia*amd) from 2p*N <= s*(ia*amd), *) +(* s*s=2p, s>0. *) +let NORMBOX_PT_ARITH = prove + (`!N ia amd s p:real. &0 < p /\ &0 < s /\ s * s = &2 * p /\ &0 <= ia /\ &0 <= + amd /\ + &2 * p * N <= s * (ia * amd) + ==> N <= inv s * (ia * amd)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&0 < &2 * p` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ONCE_REWRITE_TAC[GSYM(MATCH_MP REAL_LE_LMUL_EQ (ASSUME `&0 < &2 * p`))] THEN + SUBGOAL_THEN + `(&2 * p) * inv s * (ia * amd) = s * (ia * amd)` SUBST1_TAC THENL + [ONCE_REWRITE_TAC[GSYM(ASSUME `s * s = &2 * p`)] THEN + SUBGOAL_THEN `s * inv s = &1` MP_TAC THENL + [MATCH_MP_TAC REAL_MUL_RINV THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + CONV_TAC REAL_RING; + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN ASM_REWRITE_TAC[]]);; + +(* pointwise dominator: norm(marginal ab) <= box? inv(sqrt2pi)*(1/a)*amd : *) +(* 0. *) +let MARGINAL_NORM_DOM = prove + (`!(h:real->complex) z0 x n ab. schwartz h + ==> norm(integral (:real^1) + (\w. if &1 <= drop(fstcart ab) /\ drop(fstcart ab) <= &2 /\ + &0 <= drop(sndcart ab) /\ drop(sndcart ab) <= &n + then Cx(inv(drop(fstcart ab))) * + (cexp(--(ii * Cx(--x) * Cx(drop w))) * fourier h (drop w)) + * + Cx(carleson_theta' z0 (drop(fstcart ab)) (drop(sndcart ab)) + (drop w)) + else vec 0)) + <= (if &1 <= drop(fstcart ab) /\ drop(fstcart ab) <= &2 /\ + &0 <= drop(sndcart ab) /\ drop(sndcart ab) <= &n + then inv(sqrt(&2*pi)) * (inv(drop(fstcart ab)) * + carleson_amd h (drop(fstcart ab)) (drop(sndcart ab)) x) + else &0)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`h:real->complex`; `z0:real`; `x:real`; `n:num`; + `ab:real^(1,1)finite_sum`] + MNF_MARGINAL_NORM_BOUND) THEN + ASM_REWRITE_TAC[] THEN + COND_CASES_TAC THEN + REWRITE_TAC[INTEGRAL_0; NORM_0; REAL_LE_REFL] THEN DISCH_TAC THEN + MATCH_MP_TAC NORMBOX_PT_ARITH THEN EXISTS_TAC `pi:real` THEN + REPEAT CONJ_TAC THENL + [MP_TAC PI_POS THEN REAL_ARITH_TAC; + MATCH_MP_TAC SQRT_POS_LT THEN MP_TAC PI_POS THEN REAL_ARITH_TAC; + MP_TAC(SPEC `&2 * pi` SQRT_POW_2) THEN + ANTS_TAC THENL [MP_TAC PI_POS THEN REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_POW_2]; + MATCH_MP_TAC REAL_LE_INV THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC AMD_NONNEG THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + ASM_REWRITE_TAC[]]);; + +(* the dominator g ab = box? inv(sqrt2pi)*(1/a)*amd : 0 (lifted) is *) +(* integrable. *) +let MARGINAL_DOM_INT = prove + (`!(h:real->complex) x n. schwartz h + ==> (\ab:real^(1,1)finite_sum. + lift(if &1 <= drop(fstcart ab) /\ drop(fstcart ab) <= &2 /\ + &0 <= drop(sndcart ab) /\ drop(sndcart ab) <= &n + then inv(sqrt(&2*pi)) * (inv(drop(fstcart ab)) * + carleson_amd h (drop(fstcart ab)) (drop(sndcart ab)) x) + else &0)) + integrable_on (:real^(1,1)finite_sum)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`h:real->complex`; `n:num`; `x:real`] AMD_ABBOX_ABSINT) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE) THEN + DISCH_THEN(MP_TAC o SPEC `inv(sqrt(&2*pi))` o MATCH_MP INTEGRABLE_CMUL) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `ab:real^(1,1)finite_sum` THEN + COND_CASES_TAC THEN + REWRITE_TAC[VECTOR_MUL_RZERO; COND_CLAUSES; GSYM LIFT_CMUL; LIFT_NUM] THEN + AP_TERM_TAC THEN + SUBGOAL_THEN `drop(fstcart(ab:real^(1,1)finite_sum)) > &0` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ASM_REWRITE_TAC[]]);; + +(* int_ab(box? inv(sqrt2pi)*(1/a)*amd : 0) = inv(sqrt2pi) * Sinner. *) +let DOM_INTEGRAL_EQ = prove + (`!(h:real->complex) x n. schwartz h /\ ~(n = 0) + ==> drop(integral (:real^(1,1)finite_sum) + (\ab. lift(if &1 <= drop(fstcart ab) /\ drop(fstcart ab) <= &2 /\ + &0 <= drop(sndcart ab) /\ drop(sndcart ab) <= &n + then inv(sqrt(&2*pi)) * (inv(drop(fstcart ab)) * + carleson_amd h (drop(fstcart ab)) (drop(sndcart ab)) + x) + else &0))) + = inv(sqrt(&2*pi)) * carleson_Sinner h n x`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\ab:real^(1,1)finite_sum. lift(if &1 <= drop(fstcart ab) /\ drop(fstcart + ab) <= &2 /\ + &0 <= drop(sndcart ab) /\ drop(sndcart ab) <= &n + then inv(sqrt(&2*pi)) * (inv(drop(fstcart ab)) * + carleson_amd h (drop(fstcart ab)) (drop(sndcart ab)) + x) + else &0)) = + (\ab:real^(1,1)finite_sum. inv(sqrt(&2*pi)) % + (if &1 <= drop(fstcart ab) /\ drop(fstcart ab) <= &2 /\ + &0 <= drop(sndcart ab) /\ drop(sndcart ab) <= &n + then lift(inv(drop(fstcart ab)) * + (if drop(fstcart ab) > &0 + then carleson_amd h (drop(fstcart ab)) (drop(sndcart ab)) x else + &0)) + else vec 0))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `ab:real^(1,1)finite_sum` THEN + COND_CASES_TAC THEN + REWRITE_TAC[COND_CLAUSES; VECTOR_MUL_RZERO; LIFT_NUM; GSYM LIFT_CMUL] THEN + AP_TERM_TAC THEN + SUBGOAL_THEN `drop(fstcart(ab:real^(1,1)finite_sum)) > &0` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ASM_REWRITE_TAC[REAL_MUL_ASSOC]]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`\ab:real^(1,1)finite_sum. if &1 <= drop(fstcart ab) /\ drop(fstcart ab) <= + &2 /\ + &0 <= drop(sndcart ab) /\ drop(sndcart ab) <= &n + then lift(inv(drop(fstcart ab)) * + (if drop(fstcart ab) > &0 + then carleson_amd h (drop(fstcart ab)) (drop(sndcart ab)) x else + &0)) + else vec 0`; + `inv(sqrt(&2*pi))`; `(:real^(1,1)finite_sum)`] INTEGRAL_CMUL) THEN + ANTS_TAC THENL + [MP_TAC(ISPECL [`h:real->complex`; `n:num`; `x:real`] AMD_ABBOX_ABSINT) THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[absolutely_integrable_on] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + DISCH_THEN(SUBST1_TAC o BETA_RULE) THEN REWRITE_TAC[DROP_CMUL] THEN + MP_TAC(ISPECL [`h:real->complex`; `n:num`; `x:real`] SINNER_FIXEDX) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN REFL_TAC);; + +(* sqrt2pi * norm(int_ab marginal) <= Sinner. *) +let NORM_BOXT_LE = prove + (`!(h:real->complex) z0 x n. schwartz h /\ ~(n = 0) + ==> sqrt(&2*pi) * norm(integral (:real^(1,1)finite_sum) + (\ab. integral (:real^1) + (\w. if &1 <= drop(fstcart ab) /\ drop(fstcart ab) <= &2 /\ + &0 <= drop(sndcart ab) /\ drop(sndcart ab) <= &n + then Cx(inv(drop(fstcart ab))) * + (cexp(--(ii * Cx(--x) * Cx(drop w))) * fourier h (drop + w)) * + Cx(carleson_theta' z0 (drop(fstcart ab)) (drop(sndcart + ab)) (drop w)) + else vec 0))) + <= carleson_Sinner h n x`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`\ab:real^(1,1)finite_sum. integral (:real^1) + (\w. if &1 <= drop(fstcart ab) /\ drop(fstcart ab) <= &2 /\ + &0 <= drop(sndcart ab) /\ drop(sndcart ab) <= &n + then Cx(inv(drop(fstcart ab))) * + (cexp(--(ii * Cx(--x) * Cx(drop w))) * fourier h (drop w)) * + Cx(carleson_theta' z0 (drop(fstcart ab)) (drop(sndcart ab)) + (drop w)) + else vec 0)`; + `\ab:real^(1,1)finite_sum. + lift(if &1 <= drop(fstcart ab) /\ drop(fstcart ab) <= &2 /\ + &0 <= drop(sndcart ab) /\ drop(sndcart ab) <= &n + then inv(sqrt(&2*pi)) * (inv(drop(fstcart ab)) * + carleson_amd h (drop(fstcart ab)) (drop(sndcart ab)) x) + else &0)`; + `(:real^(1,1)finite_sum)`] INTEGRAL_NORM_BOUND_INTEGRAL) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [MATCH_MP_TAC MNF_MARGINAL_INT THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC MARGINAL_DOM_INT THEN ASM_REWRITE_TAC[]; + X_GEN_TAC `ab:real^(1,1)finite_sum` THEN + REWRITE_TAC[IN_UNIV; LIFT_DROP] THEN + MATCH_MP_TAC MARGINAL_NORM_DOM THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + MP_TAC(ISPECL [`h:real->complex`; `x:real`; `n:num`] DOM_INTEGRAL_EQ) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + SUBGOAL_THEN `&0 < sqrt(&2*pi)` ASSUME_TAC THENL + [MATCH_MP_TAC SQRT_POS_LT THEN MP_TAC PI_POS THEN + REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sqrt(&2*pi) * (inv(sqrt(&2*pi)) * carleson_Sinner h n x)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE]; + REWRITE_TAC[REAL_MUL_ASSOC] THEN + ASM_SIMP_TAC[REAL_MUL_RINV; REAL_LT_IMP_NZ; REAL_MUL_LID; REAL_LE_REFL]]);; + +(* bridge: 2pi*norm(fourier(fhat*NMn)(-x)) <= Sinner. *) +let TWOPI_NORM_F_LE_SINNER = prove + (`!(h:real->complex) z x n. schwartz h /\ ~(n = 0) + ==> &2 * pi * norm(fourier (\w. fourier h w * + Cx(real_integral (real_interval[&1,&2]) + (\a. inv a * real_integral (real_interval[&0,&n]) (\b. + carleson_theta' z a b w)))) (--x)) + <= carleson_Sinner h n x`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`h:real->complex`; `z:real`; `x:real`; + `n:num`] NORM_BOXT_LE) THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`h:real->complex`; `z:real`; `x:real`; + `n:num`] MNF_FOURIER_BOX) THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`h:real->complex`; `z:real`; `x:real`; + `n:num`] MNF_SIDE_AB) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(fun sideab -> DISCH_THEN(fun box -> + ASSUME_TAC(TRANS box (SYM sideab)))) THEN + FIRST_X_ASSUM(fun th -> REWRITE_TAC[SYM th]) THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX] THEN + SUBGOAL_THEN + `abs(sqrt(&2*pi)) = sqrt(&2*pi)` (fun th -> REWRITE_TAC[th]) THENL + [REWRITE_TAC[REAL_ABS_REFL] THEN MATCH_MP_TAC SQRT_POS_LE THEN + MP_TAC PI_POS THEN REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `a = b ==> a <= s ==> b <= s`) THEN + SUBGOAL_THEN `sqrt(&2*pi) * sqrt(&2*pi) = &2 * pi` MP_TAC THENL + [MP_TAC(SPEC `&2 * pi` SQRT_POW_2) THEN + ANTS_TAC THENL [MP_TAC PI_POS THEN REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_POW_2]; + CONV_TAC REAL_RING]);; + +(* STEP C: 2pi*norm(fourier(fhat*Mn)(-x)) <= carleson_Aavg h n x (n<>0). *) +let WN_LE_AAVG = prove + (`!(h:real->complex) z x n. schwartz h /\ ~(n = 0) + ==> &2 * pi * norm(fourier (\w. fourier h w * + Cx(real_integral (real_interval[&1,&2]) + (\alpha. inv alpha * (inv(&n) * real_integral + (real_interval[&0,&n]) + (\beta. carleson_theta' z alpha beta w))))) (--x)) + <= carleson_Aavg h n x`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`h:real->complex`; `z:real`; `x:real`; + `n:num`] FHAT_MN_FACTOR) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX; carleson_Aavg] THEN + ABBREV_TAC `Fnrm = norm(fourier (\w. fourier (h:real->complex) w * + Cx(real_integral (real_interval[&1,&2]) + (\a. inv a * real_integral (real_interval[&0,&n]) (\b. + carleson_theta' z a b w)))) (--x))` THEN + MP_TAC(ISPECL [`h:real->complex`; `z:real`; `x:real`; + `n:num`] TWOPI_NORM_F_LE_SINNER) THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `abs(inv(&n)) = inv(&n)` SUBST1_TAC THENL + [REWRITE_TAC[REAL_ABS_INV; REAL_ABS_NUM]; ALL_TAC] THEN + SUBGOAL_THEN `&0 <= inv(&n)` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_INV THEN REWRITE_TAC[REAL_POS]; ALL_TAC] THEN + DISCH_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `inv(&n) * carleson_Sinner h n x` THEN CONJ_TAC THENL + [SUBGOAL_THEN + `&2 * pi * inv(&n) * Fnrm = inv(&n) * (&2 * pi * Fnrm)` SUBST1_TAC THENL + [REWRITE_TAC[REAL_MUL_AC]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_LE_REFL]]);; + +(* ------------------------------------------------------------------------- *) +(* S6 STEP B' + D : the DCT n-average limit Wn -> 2pi norm(fourier(fhat.tt)) *) +(* and the liminf-domination assembling ATILDE_KERNEL_DOM. *) +(* ------------------------------------------------------------------------- *) + +(* Mn_n-integrand absint (from the NMn version, Mn = inv n * NMn). *) +let CARLESON_FHAT_MN_ABSINT = prove + (`!(h:real->complex) z0 n. schwartz h + ==> (\u. fourier h (drop u) * + Cx(real_integral (real_interval[&1,&2]) + (\alpha. inv alpha * (inv(&n) * real_integral + (real_interval[&0,&n]) + (\beta. carleson_theta' z0 alpha beta (drop u)))))) + absolutely_integrable_on (:real^1)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\u. fourier (h:real->complex) (drop u) * + Cx(real_integral (real_interval[&1,&2]) + (\alpha. inv alpha * (inv(&n) * real_integral + (real_interval[&0,&n]) + (\beta. carleson_theta' z0 alpha beta (drop u)))))) = + (\u. Cx(inv(&n)) * (fourier (h:real->complex) (drop u) * + Cx(real_integral (real_interval[&1,&2]) + (\a. inv a * real_integral (real_interval[&0,&n]) + (\b. carleson_theta' z0 a b (drop u))))))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + REWRITE_TAC[MN_EQ_INVN_NMN; CX_MUL] THEN + CONV_TAC COMPLEX_RING; + ALL_TAC] THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_COMPLEX_LMUL THEN + MP_TAC(ISPECL [`h:real->complex`; `z0:real`; + `n:num`] CARLESON_FHAT_NMN_ABSINT) THEN + ASM_REWRITE_TAC[]);; + +(* STEP B' integrand limit: the modulated w-integrals converge (DCT). Mn_n w *) +(* -> thetatilde z w (MN_SEQ_LIMIT), dominated by |fhat(w)| (|Mn_n|<=1). *) +let MN_INTEGRAL_LIMIT = prove + (`!(h:real->complex) z x. schwartz h + ==> ((\n. integral (:real^1) + (\u. cexp(--(ii * Cx(--x) * Cx(drop u))) * + (fourier h (drop u) * + Cx(real_integral (real_interval[&1,&2]) + (\alpha. inv alpha * (inv(&n) * real_integral + (real_interval[&0,&n]) + (\beta. carleson_theta' z alpha beta (drop + u)))))))) + --> integral (:real^1) + (\u. cexp(--(ii * Cx(--x) * Cx(drop u))) * + (fourier h (drop u) * Cx(carleson_thetatilde z (drop u))))) + sequentially`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`\n u. cexp(--(ii * Cx(--x) * Cx(drop u))) * + (fourier (h:real->complex) (drop u) * + Cx(real_integral (real_interval[&1,&2]) + (\alpha. inv alpha * (inv(&n) * real_integral + (real_interval[&0,&n]) + (\beta. carleson_theta' z alpha beta (drop u))))))`; + `\u. cexp(--(ii * Cx(--x) * Cx(drop u))) * + (fourier (h:real->complex) (drop u) * Cx(carleson_thetatilde z (drop + u)))`; + `\u:real^1. lift(norm(fourier (h:real->complex) (drop u)))`; + `(:real^1)`] DOMINATED_CONVERGENCE) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [X_GEN_TAC `N:num` THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC FOURIER_MODULATION_ABSINT THEN + MP_TAC(ISPECL [`h:real->complex`; `z:real`; + `N:num`] CARLESON_FHAT_MN_ABSINT) THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN + MP_TAC(ISPEC `h:real->complex` SCHWARTZ_FHAT_ABSINT) THEN + ASM_REWRITE_TAC[]; + MAP_EVERY X_GEN_TAC [`N:num`; `w:real^1`] THEN DISCH_TAC THEN + REWRITE_TAC[LIFT_DROP; COMPLEX_NORM_MUL; COMPLEX_NORM_CX] THEN + SUBGOAL_THEN `norm(cexp(--(ii * Cx(--x) * Cx(drop(w:real^1))))) = &1` + (fun th -> REWRITE_TAC[th]) THENL + [SUBGOAL_THEN + `--(ii * Cx(--x) * Cx(drop(w:real^1))) = ii * Cx(--(--x * drop w))` + SUBST1_TAC THENL + [REWRITE_TAC[CX_NEG; CX_MUL] THEN + SIMPLE_COMPLEX_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[NORM_CEXP_II]; ALL_TAC] THEN + REWRITE_TAC[REAL_MUL_LID] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[NORM_POS_LE] THEN + MP_TAC(ISPECL [`z:real`; `drop(w:real^1)`; `N:num`] MN_LE1) THEN + REAL_ARITH_TAC; + X_GEN_TAC `w:real^1` THEN DISCH_TAC THEN + REPEAT(MATCH_MP_TAC LIM_COMPLEX_LMUL) THEN + REWRITE_TAC[GSYM CX_MUL] THEN + MP_TAC(ISPECL [`z:real`; `drop(w:real^1)`] MN_SEQ_LIMIT) THEN + REWRITE_TAC[REALLIM_COMPLEX; o_DEF]]; + DISCH_THEN(ACCEPT_TAC o CONJUNCT2)]);; + +(* STEP B': fourier(fhat*Mn_n)(-x) -> fourier(fhat*thetatilde)(-x) *) +(* (FOURIER_VALUE_LIM). *) +let FHAT_MN_FOURIER_LIMIT = prove + (`!(h:real->complex) z x. schwartz h + ==> ((\n. fourier (\w. fourier h w * + Cx(real_integral (real_interval[&1,&2]) + (\alpha. inv alpha * (inv(&n) * real_integral + (real_interval[&0,&n]) + (\beta. carleson_theta' z alpha beta w))))) (--x)) + --> fourier (\w. fourier h w * Cx(carleson_thetatilde z w)) (--x)) + sequentially`, + REPEAT STRIP_TAC THEN + MP_TAC(BETA_RULE(ISPECL + [`\n w. fourier (h:real->complex) w * + Cx(real_integral (real_interval[&1,&2]) + (\alpha. inv alpha * (inv(&n) * real_integral + (real_interval[&0,&n]) + (\beta. carleson_theta' z alpha beta w))))`; + `\w. fourier (h:real->complex) w * Cx(carleson_thetatilde z w)`; + `x:real`] FOURIER_VALUE_LIM)) THEN + DISCH_THEN MATCH_MP_TAC THEN + MP_TAC(ISPECL [`h:real->complex`; `z:real`; `x:real`] MN_INTEGRAL_LIMIT) THEN + ASM_REWRITE_TAC[]);; + +(* WN_LIMIT: Wn n = 2pi*norm(fourier(fhat*Mn_n)(-x)) -> *) +(* 2pi*norm(fourier(fhat*thetatilde)(-x)). *) +let WN_LIMIT = prove + (`!(h:real->complex) z x. schwartz h + ==> ((\n. &2 * pi * norm(fourier (\w. fourier h w * + Cx(real_integral (real_interval[&1,&2]) + (\alpha. inv alpha * (inv(&n) * real_integral + (real_interval[&0,&n]) + (\beta. carleson_theta' z alpha beta w))))) (--x))) + ---> &2 * pi * norm(fourier (\w. fourier h w * Cx(carleson_thetatilde z + w)) (--x))) sequentially`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REALLIM_LMUL THEN + MP_TAC(ISPECL [`sequentially`; + `\n. fourier (\w. fourier (h:real->complex) w * + Cx(real_integral (real_interval[&1,&2]) + (\alpha. inv alpha * (inv(&n) * real_integral + (real_interval[&0,&n]) + (\beta. carleson_theta' z alpha beta w))))) (--x)`; + `fourier (\w. fourier (h:real->complex) w * Cx(carleson_thetatilde z w)) + (--x)`] LIM_NORM) THEN + ANTS_TAC THENL + [MP_TAC(ISPECL [`h:real->complex`; `z:real`; + `x:real`] FHAT_MN_FOURIER_LIMIT) THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[REAL_TENDSTO; o_DEF; LIFT_DROP; ETA_AX] THEN + DISCH_TAC THEN MATCH_MP_TAC REALLIM_LMUL THEN ASM_REWRITE_TAC[]);; + +(* S6 = 286S(c) KERNEL DOMINATION (Fremlin 286S(c), 2827-2868). *) +(* liminf-domination (LIMINF_DOM): Wn -> 2pi *) +(* norm(fourier(fhat.tt))(-x) [WN_LIMIT], Wn n <= Aavg h n x [WN_LE_AAVG *) +(* (n<>0) + WN_LE_AAVG_ZERO], Aavg bounded below by 0 [AAVG_NONNEG], *) +(* running-inf Aavg -> carleson_Atilde h x [AAVG_RUNNINGINF_CONV]. *) +let ATILDE_KERNEL_DOM = prove + (`!(h:real->complex) z x. schwartz h + ==> &2 * pi * norm(fourier (\w. fourier h w * Cx(carleson_thetatilde z w)) + (--x)) + <= carleson_Atilde h x`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`\n. &2 * pi * norm(fourier (\w. fourier (h:real->complex) w * + Cx(real_integral (real_interval[&1,&2]) + (\alpha. inv alpha * (inv(&n) * real_integral + (real_interval[&0,&n]) + (\beta. carleson_theta' z alpha beta w))))) (--x))`; + `\n. carleson_Aavg h n x`; + `&2 * pi * norm(fourier (\w. fourier (h:real->complex) w * + Cx(carleson_thetatilde z w)) (--x))`; + `carleson_Atilde h x`] LIMINF_DOM) THEN + REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + REPEAT CONJ_TAC THENL + [MP_TAC(ISPECL [`h:real->complex`; `z:real`; `x:real`] WN_LIMIT) THEN + ASM_REWRITE_TAC[]; + GEN_TAC THEN ASM_CASES_TAC `n = 0` THENL + [ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`h:real->complex`; `z:real`; + `x:real`] WN_LE_AAVG_ZERO) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REAL_ARITH `a = b ==> a <= c ==> b <= c`) THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN AP_TERM_TAC THEN + AP_TERM_TAC THEN + REWRITE_TAC[REAL_INV_0] THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM] THEN + GEN_TAC THEN REWRITE_TAC[]; + MP_TAC(ISPECL [`h:real->complex`; `z:real`; `x:real`; + `n:num`] WN_LE_AAVG) THEN + ASM_REWRITE_TAC[]]; + EXISTS_TAC `&0` THEN GEN_TAC THEN MATCH_MP_TAC AAVG_NONNEG THEN + ASM_REWRITE_TAC[]; + REWRITE_TAC[carleson_Atilde] THEN + MP_TAC(ISPECL [`h:real->complex`; `x:real`] AAVG_RUNNINGINF_CONV) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + SUBGOAL_THEN + `reallim sequentially (\m. inf {carleson_Aavg h n x | n >= m}) = G` + (fun th -> ASM_REWRITE_TAC[th]) THEN + MATCH_MP_TAC REALLIM_OF_CONVERGENT THEN ASM_REWRITE_TAC[]]);; + +(* S6 at H = hcheck (fourier(hcheck) = h simplifies the multiplier). *) +let KERNEL_DOM_HCHECK = prove + (`!(h:real->complex) a y. schwartz h + ==> &2 * pi * norm(fourier (\w. (h:real->complex) w * Cx(carleson_thetatilde + a w)) (y)) + <= carleson_Atilde (\x. fourier h (--x)) (--y)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\x. fourier (h:real->complex) (--x)`; `a:real`; + `--y:real`] ATILDE_KERNEL_DOM) THEN + ANTS_TAC THENL [MATCH_MP_TAC SCHWARTZ_HCHECK THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[REAL_NEG_NEG] THEN + SUBGOAL_THEN + `(\w. fourier (\x. fourier (h:real->complex) (--x)) w * + Cx(carleson_thetatilde a w)) = + (\w. (h:real->complex) w * Cx(carleson_thetatilde a w))` + (fun th -> REWRITE_TAC[th]) THEN + REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `w:real` THEN + ASM_SIMP_TAC[HCHECK_FT]);; + +(* ============ S7 = AHAT_LE_ATILDE (286T(b)) full build ============ *) +(* NB: avoid COMPLEX_RING / SIMPLE_COMPLEX_ARITH on giant integral atoms *) +(* (server-wedge risk) -- abstract integrals to fresh vars first. *) + +(* halfline lebesgue-measurable. *) +let HALFLINE_LMEAS = prove + (`!c. lebesgue_measurable {x:real^1 | drop x < c}`, + GEN_TAC THEN MATCH_MP_TAC LEBESGUE_MEASURABLE_OPEN THEN + REWRITE_TAC[drop; REWRITE_RULE[real_gt] OPEN_HALFSPACE_COMPONENT_LT]);; + +(* window over IMAGE lift[a,b] as a UNIV if-integral. *) +let WINDOW_RESTRICT = prove + (`!(h:real->complex) a b y. a <= b + ==> integral (IMAGE lift (real_interval[a,b])) (\x. cexp(--(ii * Cx y * + Cx(drop x))) * h(drop x)) = + integral (:real^1) (\x. if a <= drop x /\ drop x <= b then cexp(--(ii * + Cx y * Cx(drop x))) * h(drop x) else Cx(&0))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `integral (:real^1) (\x. if a <= drop x /\ drop x <= b + then cexp(--(ii * Cx y * Cx(drop x))) * + (h:real->complex)(drop x) else Cx(&0)) = + integral {x:real^1 | a <= drop x /\ drop x <= b} (\x. cexp(--(ii * Cx y * + Cx(drop x))) * h(drop x))` + SUBST1_TAC THENL + [MP_TAC(ISPECL [`\x:real^1. cexp(--(ii * Cx y * Cx(drop x))) * + (h:real->complex)(drop x)`; + `{x:real^1 | a <= drop x /\ drop x <= b}`] + INTEGRAL_RESTRICT_UNIV) THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + REWRITE_TAC[IN_ELIM_THM; COMPLEX_VEC_0]; + AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_IMAGE_LIFT_DROP; IN_ELIM_THM; + IN_REAL_INTERVAL]]);; + +(* L1: truncated modulated Schwartz absint on UNIV. *) +let TRUNC_ABSINT = prove + (`!(h:real->complex) c y. schwartz h + ==> (\x. cexp(--(ii * Cx y * Cx(drop x))) * (if drop x < c then + (h:real->complex)(drop x) else Cx(&0))) + absolutely_integrable_on (:real^1)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\x. cexp(--(ii * Cx y * Cx(drop x))) * (if drop x < c then + (h:real->complex)(drop x) else Cx(&0))) = + (\x. if x IN {x:real^1 | drop x < c} + then (\x. cexp(--(ii * Cx y * Cx(drop x))) * h(drop x)) x else vec 0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; IN_ELIM_THM] THEN GEN_TAC THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[COMPLEX_MUL_RZERO; COMPLEX_VEC_0]; + ALL_TAC] THEN + REWRITE_TAC[ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV] THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN + EXISTS_TAC `(:real^1)` THEN REWRITE_TAC[SUBSET_UNIV; HALFLINE_LMEAS] THEN + MATCH_MP_TAC FOURIER_MODULATION_ABSINT THEN + MATCH_MP_TAC SCHWARTZ_ABSINT THEN ASM_REWRITE_TAC[]);; + +(* L1': same, cexp INSIDE the if (matches the window integrand form). *) +let TRUNC_ABSINT2 = prove + (`!(h:real->complex) c y. schwartz h + ==> (\x. if drop x < c then cexp(--(ii * Cx y * Cx(drop x))) * + (h:real->complex)(drop x) else Cx(&0)) + absolutely_integrable_on (:real^1)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\x. if drop x < c then cexp(--(ii * Cx y * Cx(drop x))) * + (h:real->complex)(drop x) else Cx(&0)) = + (\x. if x IN {x:real^1 | drop x < c} + then (\x. cexp(--(ii * Cx y * Cx(drop x))) * h(drop x)) x else vec 0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; IN_ELIM_THM] THEN GEN_TAC THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[COMPLEX_VEC_0]; + ALL_TAC] THEN + REWRITE_TAC[ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV] THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN + EXISTS_TAC `(:real^1)` THEN REWRITE_TAC[SUBSET_UNIV; HALFLINE_LMEAS] THEN + MATCH_MP_TAC FOURIER_MODULATION_ABSINT THEN + MATCH_MP_TAC SCHWARTZ_ABSINT THEN ASM_REWRITE_TAC[]);; + +(* scalar-swap helper (div-form; applied forward to avoid complex_div *) +(* rewrite that stack-overflows when traversing the giant integral atom). *) +let CX_DIV_SWAP = prove + (`!s b (z:complex). Cx(&1)/s * (Cx b * z) = Cx b * (Cx(&1)/s * z)`, + REPEAT GEN_TAC THEN CONV_TAC COMPLEX_RING);; + +(* L2: fourier(h.tt_c)(y) = Cx tt10 * fourier(1_{complex) c y. schwartz h + ==> fourier (\w. (h:real->complex) w * Cx(carleson_thetatilde c w)) (y) = + Cx(carleson_thetatilde (&1) (&0)) * fourier (\w. if w < c then h w else + Cx(&0)) y`, + REPEAT STRIP_TAC THEN REWRITE_TAC[fourier] THEN + SUBGOAL_THEN + `(\x. cexp (--(ii * Cx y * Cx (drop x))) * + ((h:real->complex) (drop x) * Cx (carleson_thetatilde c (drop x)))) = + (\x. Cx(carleson_thetatilde (&1)(&0)) * + (cexp (--(ii * Cx y * Cx (drop x))) * + (if drop x < c then h(drop x) else Cx(&0))))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:real^1` THEN + MP_TAC(ISPECL [`drop(x:real^1)`; `c:real`] CARLESON_THETATILDE_VALUE) THEN + DISCH_THEN SUBST1_TAC THEN + COND_CASES_TAC THEN CONV_TAC COMPLEX_RING; + ALL_TAC] THEN + SUBGOAL_THEN + `integral (:real^1) (\x. Cx(carleson_thetatilde (&1)(&0)) * + (cexp (--(ii * Cx y * Cx (drop x))) * (if drop x < c then + (h:real->complex)(drop x) else Cx(&0)))) = + Cx(carleson_thetatilde (&1)(&0)) * + integral (:real^1) (\x. cexp (--(ii * Cx y * Cx (drop x))) * (if drop x < c + then h(drop x) else Cx(&0)))` + SUBST1_TAC THENL + [MATCH_MP_TAC INTEGRAL_COMPLEX_LMUL THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MP_TAC(ISPECL [`h:real->complex`; `c:real`; `y:real`] TRUNC_ABSINT) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MATCH_ACCEPT_TAC CX_DIV_SWAP);; + +(* indicator pointwise: (if xcomplex) x. a <= b + ==> (if drop x < b then G x else Cx(&0)) - (if drop x < a then G x else + Cx(&0)) = + (if a <= drop x /\ drop x < b then G x else Cx(&0))`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + REPEAT COND_CASES_TAC THEN + REWRITE_TAC[COMPLEX_SUB_REFL; COMPLEX_SUB_RZERO] THEN + ASM_REAL_ARITH_TAC);; + +(* the closed vs half-open window integrals agree ({drop x=b} null). *) +let WINDOW_HALFOPEN = prove + (`!(h:real->complex) a b y. + integral (:real^1) (\x. if a <= drop x /\ drop x <= b then cexp(--(ii * Cx + y * Cx(drop x))) * h(drop x) else Cx(&0)) = + integral (:real^1) (\x. if a <= drop x /\ drop x < b then cexp(--(ii * Cx + y * Cx(drop x))) * h(drop x) else Cx(&0))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_SPIKE THEN + EXISTS_TAC `{x:real^1 | drop x = b}` THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM COMPLEX_VEC_0] THEN + SUBGOAL_THEN + `{x:real^1 | drop x = b} = {x:real^1 | x$1 = b}` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; drop]; + REWRITE_TAC[NEGLIGIBLE_STANDARD_HYPERPLANE]]; + X_GEN_TAC `x:real^1` THEN REWRITE_TAC[IN_DIFF; IN_UNIV; IN_ELIM_THM] THEN + STRIP_TAC THEN + SUBGOAL_THEN + `(drop x <= b <=> drop x < b)` (fun th -> REWRITE_TAC[th]) THEN + ASM_REAL_ARITH_TAC]);; + +(* WINDOW_SPLIT: closed-window integral = TB - TA (half-line integrals). *) +let WINDOW_SPLIT = prove + (`!(h:real->complex) a b y. schwartz h /\ a <= b + ==> integral (:real^1) (\x. if a <= drop x /\ drop x <= b then cexp(--(ii * + Cx y * Cx(drop x))) * h(drop x) else Cx(&0)) = + integral (:real^1) (\x. if drop x < b then cexp(--(ii * Cx y * Cx(drop + x))) * h(drop x) else Cx(&0)) - + integral (:real^1) (\x. if drop x < a then cexp(--(ii * Cx y * Cx(drop + x))) * h(drop x) else Cx(&0))`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[WINDOW_HALFOPEN] THEN + MP_TAC(ISPECL [`h:real->complex`; `b:real`; `y:real`] TRUNC_ABSINT2) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(ASSUME_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE) THEN + MP_TAC(ISPECL [`h:real->complex`; `a:real`; `y:real`] TRUNC_ABSINT2) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(ASSUME_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE) THEN + MP_TAC(ISPECL + [`\x:real^1. if drop x < b then cexp(--(ii * Cx y * Cx(drop x))) * + (h:real->complex)(drop x) else Cx(&0)`; + `\x:real^1. if drop x < a then cexp(--(ii * Cx y * Cx(drop x))) * + (h:real->complex)(drop x) else Cx(&0)`; + `(:real^1)`] INTEGRAL_SUB) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:real^1` THEN + ASM_SIMP_TAC[SPLIT_INTEGRAND]);; + +(* TC = int_UNIV(if drop xcomplex) c y. + integral (:real^1) (\x. if drop x < c then cexp(--(ii * Cx y * Cx(drop + x))) * h(drop x) else Cx(&0)) = + Cx(sqrt(&2 * pi)) * fourier (\w. if w < c then h w else Cx(&0)) y`, + REPEAT STRIP_TAC THEN REWRITE_TAC[fourier] THEN + SUBGOAL_THEN + `(\x:real^1. cexp(--(ii * Cx y * Cx(drop x))) * (if drop x < c then + (h:real->complex)(drop x) else Cx(&0))) = + (\x. if drop x < c then cexp(--(ii * Cx y * Cx(drop x))) * h(drop x) else + Cx(&0))` + (fun th -> REWRITE_TAC[GSYM th]) THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN COND_CASES_TAC THEN + REWRITE_TAC[COMPLEX_MUL_RZERO]; ALL_TAC] THEN + ABBREV_TAC `II = integral (:real^1) (\x. cexp(--(ii * Cx y * Cx(drop x))) * + (if drop x < c then (h:real->complex)(drop x) else + Cx(&0)))` THEN + SUBGOAL_THEN `~(Cx(sqrt(&2 * pi)) = Cx(&0))` ASSUME_TAC THENL + [REWRITE_TAC[CX_INJ] THEN MATCH_MP_TAC REAL_LT_IMP_NZ THEN + MATCH_MP_TAC SQRT_POS_LT THEN MP_TAC PI_POS THEN + REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `Cx(sqrt(&2 * pi)) * (Cx(&1)/Cx(sqrt(&2*pi)) * II) = + (Cx(sqrt(&2*pi)) * Cx(&1)/Cx(sqrt(&2*pi))) * II` SUBST1_TAC THENL + [CONV_TAC COMPLEX_RING; ALL_TAC] THEN + ASM_SIMP_TAC[COMPLEX_DIV_LMUL; COMPLEX_MUL_LID; COMPLEX_MUL_RID]);; + +(* norm(fourier(1_{complex) c y. schwartz h + ==> norm(fourier (\w. if w < c then (h:real->complex) w else Cx(&0)) y) + <= carleson_Atilde (\x. fourier h (--x)) (--y) / (&2 * pi * + carleson_thetatilde (&1)(&0))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&0 < carleson_thetatilde (&1)(&0)` ASSUME_TAC THENL + [REWRITE_TAC[CARLESON_THETATILDE_1_0_POS]; ALL_TAC] THEN + SUBGOAL_THEN + `Cx(carleson_thetatilde (&1)(&0)) * fourier (\w. if w < c then + (h:real->complex) w else Cx(&0)) y = + fourier (\w. h w * Cx(carleson_thetatilde c w)) y` + (MP_TAC o AP_TERM `norm:complex->real`) THENL + [MP_TAC(ISPECL [`h:real->complex`; `c:real`; `y:real`] MULT_ONESIDED) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> REWRITE_TAC[th]); ALL_TAC] THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX] THEN + SUBGOAL_THEN + `abs(carleson_thetatilde (&1)(&0)) = carleson_thetatilde (&1)(&0)` + SUBST1_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + (* now hyp: tt * norm F_c = norm(fourier(h tt_c)); goal: norm F_c <= AT/(2 *) + (* pi tt). *) + DISCH_TAC THEN + MP_TAC(ISPECL [`h:real->complex`; `c:real`; `y:real`] KERNEL_DOM_HCHECK) THEN + ASM_REWRITE_TAC[] THEN + ABBREV_TAC `FC = norm(fourier (\w. if w < c then (h:real->complex) w else + Cx(&0)) y)` THEN + ABBREV_TAC `NN = norm(fourier (\w. (h:real->complex) w * + Cx(carleson_thetatilde c w)) y)` THEN + ABBREV_TAC `AT = carleson_Atilde (\x. fourier (h:real->complex) (--x)) (--y)` + THEN + ABBREV_TAC `tt = carleson_thetatilde (&1)(&0)` THEN + (* hyps: tt * FC = NN, 2 pi * NN <= AT, 0 < tt, 0 < pi (PI_POS) *) + STRIP_TAC THEN + SUBGOAL_THEN `&2 * pi * tt * FC <= AT` MP_TAC THENL + [FIRST_X_ASSUM(fun th -> if is_eq(concl th) then SUBST1_TAC th else NO_TAC) + THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `&0 < &2 * pi * tt` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC THENL + [REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LT_MUL THEN MP_TAC PI_POS THEN + ASM_REWRITE_TAC[]]; ALL_TAC] THEN + SUBGOAL_THEN + `AT / (&2 * pi * carleson_thetatilde (&1)(&0)) = AT / (&2 * pi * tt)` + SUBST1_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ] THEN + REWRITE_TAC[REAL_ARITH `FC * (&2 * pi * tt) = &2 * pi * tt * FC`] THEN + ASM_REWRITE_TAC[]);; + +(* WINDOW_LE: each Ahat window summand <= inv(pi tt10) Atilde hcheck(-y). *) +let WINDOW_LE = prove + (`!(h:real->complex) a b y. schwartz h /\ a <= b + ==> inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[a,b])) (\x. cexp(--(ii * Cx y * + Cx(drop x))) * h(drop x))) + <= inv(pi * carleson_thetatilde (&1)(&0)) * carleson_Atilde (\x. fourier + h (--x)) (--y)`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[WINDOW_RESTRICT; WINDOW_SPLIT; TC_FOURIER] THEN + SUBGOAL_THEN `&0 < carleson_thetatilde (&1)(&0)` ASSUME_TAC THENL + [REWRITE_TAC[CARLESON_THETATILDE_1_0_POS]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `inv(sqrt(&2 * pi)) * + (norm(Cx(sqrt(&2 * pi)) * fourier (\w. if w < b then (h:real->complex) w + else Cx(&0)) y) + + norm(Cx(sqrt(&2 * pi)) * fourier (\w. if w < a then (h:real->complex) w + else Cx(&0)) y))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INV THEN MATCH_MP_TAC SQRT_POS_LE THEN + MP_TAC PI_POS THEN REAL_ARITH_TAC; + NORM_ARITH_TAC]; + ALL_TAC] THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX] THEN + SUBGOAL_THEN `abs(sqrt(&2 * pi)) = sqrt(&2 * pi)` SUBST1_TAC THENL + [REWRITE_TAC[REAL_ABS_REFL] THEN MATCH_MP_TAC SQRT_POS_LE THEN + MP_TAC PI_POS THEN REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPECL [`h:real->complex`; `b:real`; `y:real`] FC_NORM_LE) THEN + MP_TAC(ISPECL [`h:real->complex`; `a:real`; `y:real`] FC_NORM_LE) THEN + ASM_REWRITE_TAC[] THEN + ABBREV_TAC `FB = norm(fourier (\w. if w < b then (h:real->complex) w else + Cx(&0)) y)` THEN + ABBREV_TAC `FA = norm(fourier (\w. if w < a then (h:real->complex) w else + Cx(&0)) y)` THEN + ABBREV_TAC `AT = carleson_Atilde (\x. fourier (h:real->complex) (--x)) (--y)` + THEN + ABBREV_TAC `tt = carleson_thetatilde (&1)(&0)` THEN + STRIP_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `&0 < sqrt(&2 * pi)` ASSUME_TAC THENL + [MATCH_MP_TAC SQRT_POS_LT THEN MP_TAC PI_POS THEN + REAL_ARITH_TAC; ALL_TAC] THEN + (* inv sqrt2pi * (sqrt2pi*FB + sqrt2pi*FA) = FB+FA <= 2*(AT/(2 pi tt)) = *) + (* AT/(pi tt) *) + SUBGOAL_THEN + `inv(sqrt(&2 * pi)) * (sqrt(&2 * pi) * FB + sqrt(&2 * pi) * FA) = FB + FA` + SUBST1_TAC THENL + [FIRST_ASSUM(MP_TAC o MATCH_MP REAL_LT_IMP_NZ) THEN + CONV_TAC REAL_FIELD; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `AT / (&2 * pi * tt) + AT / (&2 * pi * tt)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_ADD2 THEN ASM_REWRITE_TAC[]; + MP_TAC PI_POS THEN MP_TAC(ASSUME `&0 < tt`) THEN CONV_TAC REAL_FIELD]);; + +(* S7 = AHAT_LE_ATILDE: sup over windows via REAL_SUP_LE. *) +let AHAT_LE_ATILDE = prove + (`!(h:real->complex) y. schwartz h + ==> carleson_Ahat h y + <= inv(pi * carleson_thetatilde (&1) (&0)) * + carleson_Atilde (\x. fourier h (--x)) (--y)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[carleson_Ahat] THEN + MATCH_MP_TAC REAL_SUP_LE THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + MAP_EVERY EXISTS_TAC + [`inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[&0,&0])) (\x. cexp(--(ii * Cx y + * Cx(drop x))) * (h:real->complex)(drop x)))`; + `&0:real`; `&0:real`] THEN + REWRITE_TAC[REAL_LE_REFL]; + REWRITE_TAC[IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC WINDOW_LE THEN ASM_REWRITE_TAC[]]);; + +(* carleson_Atilde h integrable on FF (from the 286P hypothesis via *) +(* REAL_FATOU). *) +let ATILDE_INTEGRABLE_F = prove + (`!(h:real->complex) FF C9. + schwartz h /\ real_measurable FF /\ &0 <= C9 /\ + (!(g:real->complex) GG. schwartz g /\ real_measurable GG + ==> real_integral GG (carleson_A g) <= &4 * C9 * lnorm (:real^1) (&2) + (\z. g (drop z)) * sqrt (real_measure GG)) + ==> (\x. carleson_Atilde h x) real_integrable_on FF`, + REPEAT STRIP_TAC THEN + ABBREV_TAC `B = &4 * C9 * log(&2) * lnorm (:real^1) (&2) (\z. + (h:real->complex) (drop z)) * sqrt(real_measure FF)` THEN + MP_TAC(ISPECL [`carleson_Aavg (h:real->complex)`; `FF:real->bool`; + `B:real`] REAL_FATOU_LIMINF) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [GEN_TAC THEN GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV) [GSYM ETA_AX] THEN + MATCH_MP_TAC AAVG_ABSINT THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + CONJ_TAC THENL + [REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC AAVG_NONNEG THEN + ASM_REWRITE_TAC[]; + GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM ETA_AX] THEN + EXPAND_TAC "B" THEN MATCH_MP_TAC AAVG_INT_F_ALLN THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `g:real->real` (X_CHOOSE_THEN + `k:real->bool` STRIP_ASSUME_TAC)) THEN + MP_TAC(ISPECL [`g:real->real`; `\x. carleson_Atilde (h:real->complex) x`; + `k:real->bool`; `FF:real->bool`] REAL_INTEGRABLE_SPIKE) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_DIFF] THEN STRIP_TAC THEN + REWRITE_TAC[carleson_Atilde] THEN + MATCH_MP_TAC REALLIM_OF_CONVERGENT THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_DIFF]);; + +(* reflection preserves real-measurability. *) +let REFLECT_RMEAS = prove + (`!s. real_measurable s ==> real_measurable (IMAGE (--) s)`, + GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN `IMAGE (--) s = IMAGE (\x. --(&1) * x) s` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_IMAGE] THEN + MESON_TAC[REAL_MUL_LID; REAL_ARITH `--(&1) * x = --x`]; + ASM_SIMP_TAC[REAL_MEASURABLE_SCALING]]);; + +(* reflection preserves real-measure. *) +let REFLECT_RMEASURE = prove + (`!s. real_measurable s ==> real_measure (IMAGE (--) s) = real_measure s`, + GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN `IMAGE (--) s = IMAGE (\x. --(&1) * x) s` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_IMAGE] THEN + MESON_TAC[REAL_MUL_LID; REAL_ARITH `--(&1) * x = --x`]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_MEASURE_UNIQUE THEN + MP_TAC(ISPECL [`s:real->bool`; `--(&1):real`; + `real_measure s`] HAS_REAL_MEASURE_SCALING) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[GSYM HAS_REAL_MEASURE_MEASURE]; + REWRITE_TAC[REAL_ABS_NEG; REAL_ABS_NUM; REAL_MUL_LID]]);; + +(* ||hcheck||_2 = ||h||_2 (reflection isometry + Plancherel). *) +let HCHECK_LNORM = prove + (`!(h:real->complex). schwartz h + ==> lnorm (:real^1) (&2) (\z. fourier h (--(drop z))) = lnorm (:real^1) (&2) + (\z. h (drop z))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\z:real^1. fourier h (--(drop z))) = (\z. (\w:real^1. fourier + (h:real->complex) (drop w)) (--z))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; DROP_NEG]; ALL_TAC] THEN + REWRITE_TAC[LNORM_REFLECT] THEN + MATCH_MP_TAC PLANCHEREL_LNORM_SCHWARTZ THEN ASM_REWRITE_TAC[]);; + +(* (\y. Atilde hcheck(-y)) integrable on FF (reflection of *) +(* ATILDE_INTEGRABLE_F). *) +let REFL_ATILDE_INT = prove + (`!(h:real->complex) FF C9. + schwartz h /\ real_measurable FF /\ &0 <= C9 /\ + (!(g:real->complex) GG. schwartz g /\ real_measurable GG + ==> real_integral GG (carleson_A g) <= &4 * C9 * lnorm (:real^1) (&2) + (\z. g (drop z)) * sqrt (real_measure GG)) + ==> (\y. carleson_Atilde (\x. fourier (h:real->complex) (--x)) (--y)) + real_integrable_on FF`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[REAL_INTEGRABLE_REFLECT_GEN] THEN + MP_TAC(ISPECL [`\x. fourier (h:real->complex) (--x)`; + `IMAGE (--) (FF:real->bool)`; `C9:real`] ATILDE_INTEGRABLE_F) THEN + ASM_SIMP_TAC[SCHWARTZ_HCHECK; REFLECT_RMEAS] THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[ETA_AX]);; + +(* S8 tail: int_FF (\y. inv(pi tt10) Atilde hcheck(-y)) <= C10 ||h|| sqrt *) +(* muF. *) +let S8_TAIL = prove + (`!(h:real->complex) FF C9. + schwartz h /\ real_measurable FF /\ &0 <= C9 /\ + (!(g:real->complex) GG. schwartz g /\ real_measurable GG + ==> real_integral GG (carleson_A g) <= &4 * C9 * lnorm (:real^1) (&2) + (\z. g (drop z)) * sqrt (real_measure GG)) + ==> real_integral FF (\y. inv(pi * carleson_thetatilde (&1)(&0)) * + carleson_Atilde (\x. fourier (h:real->complex) + (--x)) (--y)) + <= (&4 * C9 * log(&2) / (pi * carleson_thetatilde (&1)(&0))) * + lnorm (:real^1) (&2) (\z. h(drop z)) * sqrt(real_measure FF)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `real_integral FF (\y. inv(pi * carleson_thetatilde (&1)(&0)) * + carleson_Atilde (\x. fourier (h:real->complex) (--x)) + (--y)) = + inv(pi * carleson_thetatilde (&1)(&0)) * + real_integral FF (\y. carleson_Atilde (\x. fourier (h:real->complex) (--x)) + (--y))` + SUBST1_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_LMUL THEN + MP_TAC(ISPECL [`h:real->complex`; `FF:real->bool`; + `C9:real`] REFL_ATILDE_INT) THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `real_integral FF (\y. carleson_Atilde (\x. fourier (h:real->complex) (--x)) + (--y)) = + real_integral (IMAGE (--) FF) (\y. carleson_Atilde (\x. fourier + (h:real->complex) (--x)) y)` + SUBST1_TAC THENL + [REWRITE_TAC[real_integral] THEN AP_TERM_TAC THEN ABS_TAC THEN + REWRITE_TAC[HAS_REAL_INTEGRAL_REFLECT_GEN]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `inv(pi * carleson_thetatilde (&1)(&0)) * + (&4 * C9 * log(&2) * lnorm (:real^1) (&2) (\z. fourier (h:real->complex) + (--(drop z))) * + sqrt(real_measure (IMAGE (--) FF)))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INV THEN + MATCH_MP_TAC REAL_LE_MUL THEN + MP_TAC PI_POS THEN MP_TAC CARLESON_THETATILDE_1_0_POS THEN + REAL_ARITH_TAC; + MP_TAC(ISPECL [`\x. fourier (h:real->complex) (--x)`; + `IMAGE (--) (FF:real->bool)`; `C9:real`] ATILDE_INT_F_BOUND) THEN + ASM_SIMP_TAC[SCHWARTZ_HCHECK; REFLECT_RMEAS] THEN + REWRITE_TAC[ETA_AX]]; ALL_TAC] THEN + ASM_SIMP_TAC[HCHECK_LNORM; REFLECT_RMEASURE] THEN + MATCH_MP_TAC REAL_EQ_IMP_LE THEN + REWRITE_TAC[real_div] THEN CONV_TAC REAL_RING);; + +(* 286Q/R/S/T reduction (Fremlin 2361-2948): the tile bound 286P propagates *) +(* via *) +(* 286Q (dilation theta') -> 286R (averaged bump theta-tilde) -> 286S (int_F *) +(* Atilde h <= 4 C9 log2 ...) -> 286T(b) (Ahat h <= (1/(pi thetatilde_1(0))) *) +(* Atilde *) +(* hcheck(-y), C10 = 4 C9 log2/(pi thetatilde_1(0))) to the linearized *) +(* maximal *) +(* operator. *) +let CARLESON_286T_FROM_286P = prove + (`(?C9. &0 <= C9 /\ + !(h:real->complex) FF. + schwartz h /\ real_measurable FF + ==> (carleson_A h) real_measurable_on (:real) /\ + real_integral FF (carleson_A h) + <= &4 * C9 * lnorm (:real^1) (&2) (\z. h(drop z)) * + sqrt(real_measure FF)) + ==> ?C10. &0 <= C10 /\ + !(h:real->complex) FF. + schwartz h /\ real_measurable FF + ==> real_integral FF (carleson_Ahat h) + <= C10 * lnorm (:real^1) (&2) (\z. h(drop z)) * + sqrt(real_measure FF)`, + DISCH_THEN(X_CHOOSE_THEN `C9:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `&4 * C9 * log(&2) / (pi * carleson_thetatilde (&1) (&0))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_DIV THEN CONJ_TAC THENL + [MATCH_MP_TAC LOG_POS THEN REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [MP_TAC PI_POS THEN REAL_ARITH_TAC; + MP_TAC CARLESON_THETATILDE_1_0_POS THEN REAL_ARITH_TAC]]; + ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`h:real->complex`; `FF:real->bool`] THEN STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `real_integral FF (\y. inv(pi * carleson_thetatilde (&1)(&0)) * + carleson_Atilde (\x. fourier (h:real->complex) (--x)) + (--y))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_LE THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CARLESON_AHAT_SCHWARTZ_INTEGRABLE THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_INTEGRABLE_LMUL THEN + MP_TAC(ISPECL [`h:real->complex`; `FF:real->bool`; + `C9:real`] REFL_ATILDE_INT) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; DISCH_THEN + ACCEPT_TAC]; + X_GEN_TAC `y:real` THEN DISCH_TAC THEN BETA_TAC THEN + MATCH_MP_TAC AHAT_LE_ATILDE THEN ASM_REWRITE_TAC[]]; + MP_TAC(ISPECL [`h:real->complex`; `FF:real->bool`; `C9:real`] S8_TAIL) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; DISCH_THEN + ACCEPT_TAC]]);; + +(* 286T(b): the Schwartz maximal bound from the 286P estimates. *) +let CARLESON_286T_SCHWARTZ = prove + (`?C10. &0 <= C10 /\ + !(h:real->complex) FF. + schwartz h /\ real_measurable FF + ==> real_integral FF (carleson_Ahat h) + <= C10 * lnorm (:real^1) (&2) (\z. h(drop z)) * sqrt(real_measure + FF)`, + MATCH_MP_TAC CARLESON_286T_FROM_286P THEN ACCEPT_TAC CARLESON_286P);; + + +(* An L^2 function on R is absolutely integrable (L^1) on any compact *) +(* interval, since the interval has finite measure: L^2 restricted to it *) +(* (LSPACE_SUBSET) then L^2 c L^1 on finite measure (LSPACE_INCLUSION, *) +(* p=1<=q=2) and lspace(&1)=absolutely_integrable. Feeds the Fubini-strip *) +(* step of 286U(c) (G|[-n,n] is L^1, so the tower's global-L^1 Fubini *) +(* machinery applies). *) + +let LSPACE_ABSINT_ON_INTERVAL = prove + (`!(G:real^1->complex) a b. + G IN lspace (:real^1) (&2) + ==> G absolutely_integrable_on (IMAGE lift (real_interval[a,b]))`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[GSYM LSPACE_1] THEN + MP_TAC(ISPECL [`IMAGE lift (real_interval[a,b])`; `&1`; `&2`] + (INST_TYPE [`:1`,`:M`; `:2`,`:N`] LSPACE_INCLUSION)) THEN + ANTS_TAC THENL + [REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL; MEASURABLE_INTERVAL] THEN + CONV_TAC REAL_RAT_REDUCE_CONV; + REWRITE_TAC[SUBSET] THEN DISCH_THEN MATCH_MP_TAC THEN + MATCH_MP_TAC LSPACE_SUBSET THEN EXISTS_TAC `(:real^1)` THEN + ASM_REWRITE_TAC[SUBSET_UNIV; IMAGE_LIFT_REAL_INTERVAL; + LEBESGUE_MEASURABLE_INTERVAL]]);; +(* An L^2 function with compact support is absolutely integrable (L^1) on *) +(* the whole line: restrict to the containing interval [-(c+1),c+1] *) +(* (LSPACE_ABSINT_ON_INTERVAL) and note it agrees with its restriction there *) +(* (vanishes outside). *) +let CSUPP_L2_ABSINT = prove + (`!(e:real^1->complex) c. + e IN lspace (:real^1) (&2) /\ &0 <= c /\ (!z. abs(drop z) > c ==> e z = + Cx(&0)) + ==> e absolutely_integrable_on (:real^1)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`e:real^1->complex`; `--(c+ &1):real`; + `c+ &1:real`] LSPACE_ABSINT_ON_INTERVAL) THEN + ASM_REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL] THEN + SUBGOAL_THEN + `e absolutely_integrable_on interval[lift(--(c+ &1)),lift(c+ &1)] <=> + (\z. if z IN interval[lift(--(c+ &1)),lift(c+ &1)] then (e:real^1->complex) + z else vec 0) + absolutely_integrable_on (:real^1)` + SUBST1_TAC THENL + [REWRITE_TAC[ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV]; ALL_TAC] THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `z:real^1` THEN COND_CASES_TAC THEN + REWRITE_TAC[COMPLEX_VEC_0] THEN CONV_TAC SYM_CONV THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN POP_ASSUM MP_TAC THEN + REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP] THEN REAL_ARITH_TAC);; + +(* Explicit-constant form of the compact-support L^2 -> L^1 bound (the *) +(* Cauchy- *) +(* Schwarz constant K = ||chi[-(c+1),c+1]||_2 is displayed rather than *) +(* existential, *) +(* so a whole SEQUENCE of csupp functions can share the same K). HOELDER *) +(* (p=q=2) *) +(* with the interval indicator; off the interval e vanishes so the *) +(* norm-product *) +(* matches norm(e) exactly. *) +let CSUPP_L2_L1_EXPLICIT = prove + (`!(e:real^1->complex) c. + e IN lspace (:real^1) (&2) /\ &0 <= c /\ (!z. abs(drop z) > c ==> e z = + Cx(&0)) + ==> drop(integral (:real^1) (\z. lift(norm(e z)))) <= + lnorm (:real^1) (&2) e * + lnorm (:real^1) (&2) (\z:real^1. if z IN interval[lift(--(c+ &1)), + lift(c+ &1)] then Cx(&1) else Cx(&0))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`(:real^1)`; `&2`; `&2`; `e:real^1->complex`; + `\z:real^1. if z IN interval[lift(--(c+ &1)), lift(c+ &1)] then Cx(&1) else + Cx(&0)`] + HOELDER_INEQUALITY) THEN + ASM_REWRITE_TAC[INDICATOR_INTERVAL_L2] THEN + ANTS_TAC THENL [CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `a = b ==> b <= c ==> a <= c`) THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN + X_GEN_TAC `z:real^1` THEN AP_TERM_TAC THEN + COND_CASES_TAC THEN + REWRITE_TAC[COMPLEX_NORM_CX; REAL_ABS_NUM; REAL_MUL_RID] THEN + SUBGOAL_THEN + `(e:real^1->complex) z = Cx(&0)` (fun th -> REWRITE_TAC[th; + COMPLEX_NORM_CX; REAL_ABS_NUM]) THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN + POP_ASSUM MP_TAC THEN REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP] THEN + REAL_ARITH_TAC; + REWRITE_TAC[REAL_MUL_RZERO]]);; + +(* L^1 convergence from L^2 convergence on a FIXED compact support: if d k *) +(* -> 0 in *) +(* L^2 and all d k vanish outside [-c,c], then int norm(d k) -> 0. *) +(* Comparison *) +(* (REALLIM_NULL_COMPARISON) against K * ||d k||_2 with the shared K from *) +(* CSUPP_L2_L1_EXPLICIT; K * ||d k|| -> 0 by REALLIM_NULL_RMUL. This turns *) +(* the *) +(* L^2-approximation into the L^1 control needed for uniform Fourier *) +(* convergence. *) +let L1_LIM_FROM_L2_CSUPP = prove + (`!(d:num->real^1->complex) c. + &0 <= c /\ + (!k. (d k) IN lspace (:real^1) (&2)) /\ + (!k z. abs(drop z) > c ==> d k z = Cx(&0)) /\ + ((\k. lnorm (:real^1) (&2) (d k)) ---> &0) sequentially + ==> ((\k. drop(integral (:real^1) (\z. lift(norm(d k z))))) ---> &0) + sequentially`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REALLIM_NULL_COMPARISON THEN + EXISTS_TAC `\k. lnorm (:real^1) (&2) ((d:num->real^1->complex) k) * + lnorm (:real^1) (&2) (\z:real^1. if z IN interval[lift(--(c+ &1)), lift(c+ + &1)] then Cx(&1) else Cx(&0))` THEN + CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `0` THEN + X_GEN_TAC `k:num` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= y ==> abs x <= y`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC INTEGRAL_DROP_POS THEN CONJ_TAC THENL + [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN + MATCH_MP_TAC CSUPP_L2_ABSINT THEN EXISTS_TAC `c:real` THEN + ASM_REWRITE_TAC[ETA_AX]; + REWRITE_TAC[LIFT_DROP; NORM_POS_LE]]; + MATCH_MP_TAC CSUPP_L2_L1_EXPLICIT THEN ASM_SIMP_TAC[]]; + MATCH_MP_TAC REALLIM_NULL_RMUL THEN ASM_REWRITE_TAC[]]);; + + +(* Distributional-uniqueness for L^2 functions: if d in L^2 pairs to zero *) +(* against *) +(* every Schwartz test function, d = 0 a.e. L2_SUBINTERVAL_ZERO gives *) +(* int_{[a,b]} *) +(* d = 0 on every interval; INTEGRAL_ZERO_ON_SUBINTERVALS_IMP_ZERO_AE_ALT *) +(* concludes; d is integrable on each interval by *) +(* LSPACE_ABSINT_ON_INTERVAL. *) +let WINDOWED_FOURIER_REPS = prove + (`!(G:real^1->complex) (h:real->complex) n. + G IN lspace (:real^1) (&2) /\ schwartz h + ==> integral (:real^1) (\z. fourier (\x. if abs x <= &n then G(lift x) + else Cx(&0)) (drop z) * h(drop z)) = + integral (:real^1) (\z. (\x. if abs x <= &n then G(lift x) else + Cx(&0))(drop z) * fourier h (drop z))`, + REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC FOURIER_283O THEN CONJ_TAC THENL + [SUBGOAL_THEN + `(\z. (\x. if abs x <= &n then (G:real^1->complex)(lift x) else + Cx(&0))(drop z)) = + (\z. if drop z IN real_interval[--(&n),&n] then G z else vec 0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + REWRITE_TAC[IN_REAL_INTERVAL] THEN + REWRITE_TAC[REAL_ARITH `--(&n) <= drop z /\ drop z <= &n <=> abs(drop z) + <= &n`] THEN + REWRITE_TAC[LIFT_DROP; COMPLEX_VEC_0]; ALL_TAC] THEN + SUBGOAL_THEN + `!z:real^1. (drop z IN real_interval[--(&n),&n]) <=> z IN + interval[lift(--(&n)), lift(&n)]` + (fun th -> ONCE_REWRITE_TAC[th]) THENL + [GEN_TAC THEN + REWRITE_TAC[IN_INTERVAL_1; IN_REAL_INTERVAL; LIFT_DROP]; ALL_TAC] THEN + REWRITE_TAC[ABSOLUTELY_INTEGRABLE_RESTRICT_UNIV] THEN + REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL] THEN + MATCH_MP_TAC LSPACE_ABSINT_ON_INTERVAL THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC SCHWARTZ_ABSINT THEN + ASM_REWRITE_TAC[]]);; + +(* The closed-window truncations phin = G*chi[-n,n] converge to G in L^2 *) +(* norm: *) +(* ||phin - G||_2 -> 0. Lebesgue dominated convergence (LSPACE_DOMINATED_ *) +(* CONVERGENCE) with dominator G and pointwise limit (eventually abs(drop x) *) +(* <= &n, *) +(* REAL_ARCH_SIMPLE). Feeds the L^2-Cauchy-ness of the window transforms. *) +let CLOSED_WINDOW_LNORM_LIM = prove + (`!(G:real^1->complex). + G IN lspace (:real^1) (&2) + ==> ((\n. lnorm (:real^1) (&2) + (\z. (if abs(drop z) <= &n then G z else vec 0) - G z)) ---> &0) + sequentially`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`\n:num. \z:real^1. if abs(drop z) <= &n then (G:real^1->complex) z else + vec 0`; + `G:real^1->complex`; `G:real^1->complex`; `(:real^1)`; `&2`; + `{}:real^1->bool`] + LSPACE_DOMINATED_CONVERGENCE) THEN + REWRITE_TAC[NEGLIGIBLE_EMPTY; DIFF_EMPTY; IN_UNIV] THEN ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [REAL_ARITH_TAC; + GEN_TAC THEN + SUBGOAL_THEN + `(\z:real^1. if abs(drop z) <= &n then (G:real^1->complex) z else vec 0) + = + (\z. if z IN {z | abs(drop z) <= &n} then G z else vec 0)` + SUBST1_TAC THENL [REWRITE_TAC[IN_ELIM_THM]; ALL_TAC] THEN + MATCH_MP_TAC TRUNC_IN_LSPACE THEN + ASM_REWRITE_TAC[REAL_ARITH `&0 < &2`] THEN + SUBGOAL_THEN + `{z:real^1 | abs(drop z) <= &n} = interval[lift(--(&n)),lift(&n)]` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INTERVAL_1; LIFT_DROP] THEN + GEN_TAC THEN REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[LEBESGUE_MEASURABLE_INTERVAL]; + ASM_REWRITE_TAC[]; + REPEAT GEN_TAC THEN COND_CASES_TAC THEN + REWRITE_TAC[NORM_0; NORM_POS_LE; REAL_LE_REFL]; + X_GEN_TAC `x:real^1` THEN MATCH_MP_TAC LIM_EVENTUALLY THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN + MP_TAC(ISPEC `abs(drop(x:real^1))` REAL_ARCH_SIMPLE) THEN + DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `N:num` THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN + SUBGOAL_THEN `abs(drop(x:real^1)) <= &n` (fun th -> REWRITE_TAC[th]) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&N:real` THEN + ASM_REWRITE_TAC[REAL_OF_NUM_LE]]; + STRIP_TAC THEN ASM_REWRITE_TAC[]]);; + +(* Modulation e^{-idx} preserves absolute integrability on any *) +(* Lebesgue-measurable set (cexp unimodular + *) +(* ABSOLUTELY_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT); the interval version *) +(* of FOURIER_MODULATION_ABSINT, needed for the strip-Fubini y-slice. *) + +let MODULATION_ABSINT_LMEAS = prove + (`!(G:real^1->complex) d s. + lebesgue_measurable s /\ G absolutely_integrable_on s + ==> (\x. cexp(--(ii * Cx d * Cx(drop x))) * G x) absolutely_integrable_on + s`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`( * ):complex->complex->complex`; + `\x:real^1. cexp(--(ii * Cx d * Cx(drop x)))`; + `G:real^1->complex`; `s:real^1->bool`] + ABSOLUTELY_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT) THEN + ASM_REWRITE_TAC[BILINEAR_COMPLEX_MUL] THEN DISCH_THEN MATCH_MP_TAC THEN + CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN + EXISTS_TAC `(:real^1)` THEN + ASM_REWRITE_TAC[SUBSET_UNIV] THEN + MATCH_MP_TAC CONTINUOUS_IMP_MEASURABLE_ON THEN + SUBGOAL_THEN `(\x:real^1. cexp(--(ii * Cx d * Cx(drop x)))) = + cexp o (\x. --((ii * Cx d) * Cx(drop x)))` + SUBST1_TAC THENL [REWRITE_TAC[o_DEF; COMPLEX_MUL_ASSOC]; ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + REWRITE_TAC[CONTINUOUS_ON_CEXP] THEN + MATCH_MP_TAC CONTINUOUS_ON_NEG THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN + REWRITE_TAC[CONTINUOUS_ON_CONST] THEN + MATCH_MP_TAC CONTINUOUS_ON_CX_DROP THEN + REWRITE_TAC[CONTINUOUS_ON_ID]; + REWRITE_TAC[bounded; FORALL_IN_IMAGE] THEN EXISTS_TAC `&1` THEN + X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN + SUBGOAL_THEN + `--(ii * Cx d * Cx(drop x)) = ii * Cx(--(d * drop x))` SUBST1_TAC THENL + [REWRITE_TAC[CX_NEG; CX_MUL] THEN SIMPLE_COMPLEX_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[NORM_CEXP_II] THEN REAL_ARITH_TAC]);; + +(* L^1 bound on the difference of Fourier transforms: norm(fhat(y) - *) +(* ghat(y)) is at *) +(* most (1/sqrt2pi) times the L^1 norm of f - g. Linearity of fourier *) +(* (FOURIER_ADD/ *) +(* FOURIER_LMUL, valid since both modulated integrands are integrable via *) +(* MODULATION_ABSINT_LMEAS) collapses fhat - ghat to fourier(f-g); then *) +(* FOURIER_BOUND. *) +let FOURIER_DIFF_L1_BOUND = prove + (`!(f:real->complex) g y. + (\z. f(drop z)) absolutely_integrable_on (:real^1) /\ + (\z. g(drop z)) absolutely_integrable_on (:real^1) + ==> norm(fourier f y - fourier g y) <= + &1 / sqrt(&2 * pi) * drop(integral (:real^1) (\z. lift(norm(f(drop z) + - g(drop z)))))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\x. cexp(--(ii * Cx y * Cx(drop x))) * (f:real->complex)(drop x)) + integrable_on (:real^1)` + ASSUME_TAC THENL + [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC MODULATION_ABSINT_LMEAS THEN + ASM_REWRITE_TAC[LEBESGUE_MEASURABLE_UNIV]; ALL_TAC] THEN + SUBGOAL_THEN + `(\x. cexp(--(ii * Cx y * Cx(drop x))) * (g:real->complex)(drop x)) + integrable_on (:real^1)` + ASSUME_TAC THENL + [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC MODULATION_ABSINT_LMEAS THEN + ASM_REWRITE_TAC[LEBESGUE_MEASURABLE_UNIV]; ALL_TAC] THEN + SUBGOAL_THEN + `fourier (f:real->complex) y - fourier g y = fourier (\x. f x - g x) y` + SUBST1_TAC THENL + [SUBGOAL_THEN `(\x. (f:real->complex) x - g x) = (\x. f x + (--(&1)) % g x)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN REWRITE_TAC[COMPLEX_CMUL] THEN + SIMPLE_COMPLEX_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `fourier (\x. (f:real->complex) x + --(&1) % g x) y = fourier f y + + fourier (\x. --(&1) % g x) y` + SUBST1_TAC THENL + [MATCH_MP_TAC FOURIER_ADD THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[COMPLEX_CMUL] THEN + SUBGOAL_THEN + `(\x. cexp(--(ii * Cx y * Cx(drop x))) * (Cx(--(&1)) * + (g:real->complex)(drop x))) = + (\x. Cx(--(&1)) * (cexp(--(ii * Cx y * Cx(drop x))) * + g(drop x)))` + SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + SIMPLE_COMPLEX_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC INTEGRABLE_COMPLEX_LMUL THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[COMPLEX_CMUL] THEN + SUBGOAL_THEN + `fourier (\x. Cx(--(&1)) * (g:real->complex) x) y = + Cx(--(&1)) * fourier g y` + SUBST1_TAC THENL + [MATCH_MP_TAC FOURIER_LMUL THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SIMPLE_COMPLEX_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPECL [`\x. (f:real->complex) x - g x`; `y:real`] FOURIER_BOUND) THEN + REWRITE_TAC[] THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [SUBGOAL_THEN + `(\x. cexp(--(ii * Cx y * Cx(drop x))) * ((f:real->complex)(drop x) - + g(drop x))) = + (\x. cexp(--(ii * Cx y * Cx(drop x))) * f(drop x) - + cexp(--(ii * Cx y * Cx(drop x))) * g(drop x))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + SIMPLE_COMPLEX_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC INTEGRABLE_SUB THEN ASM_REWRITE_TAC[]; + SUBGOAL_THEN + `(\x. lift(norm((f:real->complex)(drop x) - g(drop x)))) = + (\x. lift(norm((\z. f(drop z) - g(drop z)) x)))` SUBST1_TAC THENL + [REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_SUB THEN + ASM_REWRITE_TAC[]]; ALL_TAC] THEN + REWRITE_TAC[]);; + +(* Uniform (pointwise-everywhere) Fourier convergence from L^1 convergence: *) +(* if the *) +(* L^1 norms int norm(a k - b) -> 0, then fhat(a k)(y) -> fhat(b)(y) for *) +(* every y. *) +(* Immediate from FOURIER_DIFF_L1_BOUND via LIM_NULL_COMPARISON. This is the *) +(* pointwise *) +(* limit that gets reconciled (by FATOU) with the L^2 RIESZ limit in *) +(* WINDOWED_FOURIER_L2. *) +let FOURIER_UNIF_LIM_FROM_L1 = prove + (`!(a:num->real->complex) b y. + (!k. (\z. a k (drop z)) absolutely_integrable_on (:real^1)) /\ + (\z. b(drop z)) absolutely_integrable_on (:real^1) /\ + ((\k. drop(integral (:real^1) (\z. lift(norm(a k (drop z) - b(drop z)))))) + ---> &0) sequentially + ==> ((\k. fourier ((a:num->real->complex) k) y) --> fourier b y) + sequentially`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[LIM_NULL] THEN REWRITE_TAC[] THEN + MATCH_MP_TAC LIM_NULL_COMPARISON THEN + EXISTS_TAC `\k. &1 / sqrt(&2 * pi) * + drop(integral (:real^1) (\z. lift(norm((a:num->real->complex) k (drop z) - + b(drop z)))))` THEN + CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `0` THEN + X_GEN_TAC `k:num` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + MATCH_MP_TAC FOURIER_DIFF_L1_BOUND THEN ASM_SIMP_TAC[]; + REWRITE_TAC[LIFT_CMUL] THEN + SUBST1_TAC(VECTOR_ARITH `vec 0:real^1 = &1 / sqrt(&2 * pi) % vec 0`) THEN + MATCH_MP_TAC LIM_CMUL THEN + FIRST_X_ASSUM(MP_TAC) THEN REWRITE_TAC[TENDSTO_REAL; o_DEF; LIFT_NUM]]);; + +(* NORM_RPOW2_LIM: complex limit -> norm-rpow-2 real limit *) +let NORM_RPOW2_LIM = prove + (`!(c:num->complex) L. + ((\k. c k) --> L) sequentially + ==> ((\k. norm(c k) rpow &2) ---> norm(L) rpow &2) sequentially`, + REPEAT STRIP_TAC THEN REWRITE_TAC[RPOW_POW] THEN + MATCH_MP_TAC REALLIM_POW THEN + REWRITE_TAC[TENDSTO_REAL; o_DEF] THEN + MP_TAC(ISPECL [`sequentially`; `\k. (c:num->complex) k`; + `L:complex`] LIM_NORM) THEN + ASM_REWRITE_TAC[]);; + +(* NORM_RPOW2_LIM_VEC: complex limit -> lift(norm-rpow-2) vector limit *) +let NORM_RPOW2_LIM_VEC = prove + (`!(c:num->complex) L. + ((\k. c k) --> L) sequentially + ==> ((\k. lift(norm(c k) rpow &2)) --> lift(norm(L) rpow &2)) + sequentially`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\k. lift(norm((c:num->complex) k) rpow &2)) = + lift o (\k. norm(c k) rpow &2)` + SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN + REWRITE_TAC[GSYM TENDSTO_REAL] THEN MATCH_MP_TAC NORM_RPOW2_LIM THEN + ASM_REWRITE_TAC[]);; + +(* FATOU_L2_LIMIT_MEMBER: pointwise limit of L2 fns with uniformly bounded *) +(* L2-norm is L2 *) +let FATOU_L2_LIMIT_MEMBER = prove + (`!(gk:num->real^1->complex) g B. + (!k. (\z. gk k z) IN lspace (:real^1) (&2)) /\ + (!k. lnorm (:real^1) (&2) (\z. gk k z) <= B) /\ + (\z. g z) measurable_on (:real^1) /\ + (!z. ((\k. gk k z) --> g z) sequentially) + ==> (\z. g z) IN lspace (:real^1) (&2)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[lspace; IN_ELIM_THM] THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL + [`\k:num z:real^1. lift(norm((gk:num->real^1->complex) k z) rpow &2)`; + `\z:real^1. lift(norm((g:real^1->complex) z) rpow &2)`; + `(:real^1)`; `{}:real^1->bool`; `max (&0) (B rpow &2)`] FATOU) THEN + REWRITE_TAC[NEGLIGIBLE_EMPTY; DIFF_EMPTY; IN_UNIV] THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [GEN_TAC THEN + SUBGOAL_THEN + `(\z. (gk:num->real^1->complex) n z) IN lspace (:real^1) (&2)` + MP_TAC THENL + [ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[lspace; IN_ELIM_THM] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + CONJ_TAC THENL + [REPEAT STRIP_TAC THEN REWRITE_TAC[LIFT_DROP] THEN + MATCH_MP_TAC RPOW_POS_LE THEN REWRITE_TAC[NORM_POS_LE]; ALL_TAC] THEN + CONJ_TAC THENL + [X_GEN_TAC `z:real^1` THEN REWRITE_TAC[] THEN + MATCH_MP_TAC NORM_RPOW2_LIM_VEC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + GEN_TAC THEN + MP_TAC(ISPECL [`(:real^1)`; `&2`; + `\z. (gk:num->real^1->complex) n z`] INTEGRAL_LNORM_RPOW) THEN + ANTS_TAC THENL [ASM_SIMP_TAC[] THEN + CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN + REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[LIFT_DROP] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `B rpow &2` THEN CONJ_TAC THENL + [MATCH_MP_TAC RPOW_LE2 THEN ASM_SIMP_TAC[LNORM_POS_LE] THEN + CONV_TAC REAL_RAT_REDUCE_CONV; + REAL_ARITH_TAC]; + DISCH_THEN(ACCEPT_TAC o CONJUNCT1)]);; + +(* An L^2 function truncated to a symmetric window is still in L^2 *) +(* (TRUNC_IN_LSPACE on the interval [-n,n]). *) +let WINDOW_L2 = prove + (`!(G:real^1->complex) n. + G IN lspace (:real^1) (&2) + ==> (\z. (if abs(drop z) <= &n then (G:real^1->complex) z else vec 0)) IN + lspace (:real^1) (&2)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\z:real^1. if abs(drop z) <= &n then (G:real^1->complex) z else vec 0) = + (\z. if z IN {z | abs(drop z) <= &n} then G z else vec 0)` + SUBST1_TAC THENL [REWRITE_TAC[IN_ELIM_THM]; ALL_TAC] THEN + MATCH_MP_TAC TRUNC_IN_LSPACE THEN ASM_REWRITE_TAC[REAL_ARITH `&0 < &2`] THEN + SUBGOAL_THEN + `{z:real^1 | abs(drop z) <= &n} = interval[lift(--(&n)),lift(&n)]` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INTERVAL_1; LIFT_DROP] THEN + GEN_TAC THEN REAL_ARITH_TAC; + REWRITE_TAC[LEBESGUE_MEASURABLE_INTERVAL]]);; + +(* Uniform L^2-norm bound for an L^2-convergent sequence: if psi_k(drop) -> *) +(* phin(drop) in L^2 then ||psi_k(drop)||_2 is bounded (reverse triangle *) +(* LNORM_REV + convergent sequences are bounded). *) +let PSI_LNORM_BOUNDED = prove + (`!(phin:real->complex) (psi:num->real->complex). + (\z. (phin:real->complex)(drop z)) IN lspace (:real^1) (&2) /\ + (!k. (\z. (psi:num->real->complex) k (drop z)) IN lspace (:real^1) (&2)) + /\ + ((\k. lnorm (:real^1) (&2) (\z. (phin:real->complex)(drop z) - psi k (drop + z))) ---> &0) sequentially + ==> ?B. !k. lnorm (:real^1) (&2) (\z. (psi:num->real->complex) k (drop z)) + <= B`, + REPEAT STRIP_TAC THEN + MP_TAC(MATCH_MP REAL_CONVERGENT_IMP_BOUNDED (ASSUME + `((\k. lnorm (:real^1) (&2) (\z. (phin:real->complex)(drop z) - psi k (drop + z))) ---> &0) sequentially`)) THEN + REWRITE_TAC[REAL_BOUNDED_POS; FORALL_IN_IMAGE; IN_UNIV] THEN + DISCH_THEN(X_CHOOSE_THEN `M:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `lnorm (:real^1) (&2) (\z. (phin:real->complex)(drop z)) + M` THEN + X_GEN_TAC `k:num` THEN + MP_TAC(ISPECL [`(:real^1)`; `\z. (psi:num->real->complex) k (drop z)`; + `\z. (phin:real->complex)(drop z)`] LNORM_REV) THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `lnorm (:real^1) (&2) (\z. (psi:num->real->complex) k (drop z) - phin(drop + z)) = + lnorm (:real^1) (&2) (\z. (phin:real->complex)(drop z) - psi k + (drop z))` + SUBST1_TAC THENL + [GEN_REWRITE_TAC LAND_CONV [GSYM LNORM_NEG] THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN VECTOR_ARITH_TAC; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `k:num`) THEN REAL_ARITH_TAC);; + +(* fourier of the windowed function phin = G*chi[-n,n] (L1 cap L2) is in *) +(* L^2. FATOU on norm(fourier(psi_k)) rpow 2 (integral = ||psi_k||_2 rpow 2, *) +(* bounded) with pointwise limit norm(fourier phin) rpow 2 (uniform FT *) +(* convergence from L^1). *) +let WINDOWED_FOURIER_L2 = prove + (`!(G:real^1->complex) n. + G IN lspace (:real^1) (&2) + ==> (\z. fourier (\x. if abs x <= &n then G(lift x) else Cx(&0)) (drop z)) + IN lspace (:real^1) (&2)`, + REPEAT STRIP_TAC THEN + ABBREV_TAC `phin = \x. if abs x <= &n then (G:real^1->complex)(lift x) else + Cx(&0)` THEN + SUBGOAL_THEN + `!z:real^1. (phin:real->complex)(drop z) = (if abs(drop z) <= &n then + (G:real^1->complex) z else vec 0)` + ASSUME_TAC THENL + [X_GEN_TAC `z:real^1` THEN EXPAND_TAC "phin" THEN + REWRITE_TAC[LIFT_DROP; COMPLEX_VEC_0]; ALL_TAC] THEN + SUBGOAL_THEN + `(\z. (phin:real->complex)(drop z)) IN lspace (:real^1) (&2)` + ASSUME_TAC THENL + [SUBGOAL_THEN + `(\z. (phin:real->complex)(drop z)) = (\z. if abs(drop z) <= &n then + (G:real^1->complex) z else vec 0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC WINDOW_L2 THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL [`G:real^1->complex`; `n:num`] FIXED_SUPP_SCHWARTZ_SEQ) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `psi:num->real->complex` STRIP_ASSUME_TAC) THEN + (* L^2-approx of phin(drop) by psi_k(drop) *) + SUBGOAL_THEN + `((\k. lnorm (:real^1) (&2) (\z. (phin:real->complex)(drop z) - psi k (drop + z))) ---> &0) sequentially` + ASSUME_TAC THENL + [SUBGOAL_THEN + `(\(k:num). lnorm (:real^1) (&2) (\z. (phin:real->complex)(drop z) - + (psi:num->real->complex) k (drop z))) = + (\(k:num). lnorm (:real^1) (&2) + (\z. (if abs(drop z) <= &n then (G:real^1->complex) z else vec 0) - + psi k (drop z)))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `k:num` THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `z:real^1` THEN + AP_THM_TAC THEN AP_TERM_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + (* L1 convergence (fixed support [-(n+2),n+2]) *) + SUBGOAL_THEN + `((\k. drop(integral (:real^1) (\z. lift(norm((phin:real->complex)(drop z) - + psi k (drop z)))))) ---> &0) + sequentially` + ASSUME_TAC THENL + [MP_TAC(ISPECL [`\(k:num) (z:real^1). (phin:real->complex)(drop z) - psi k + (drop z)`; `&n + &2`] + L1_LIM_FROM_L2_CSUPP) THEN + BETA_TAC THEN DISCH_THEN MATCH_MP_TAC THEN + REWRITE_TAC[REAL_ARITH `&0 <= &n + &2`] THEN + CONJ_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC LSPACE_SUB THEN + REWRITE_TAC[REAL_POS] THEN CONJ_TAC THENL + [FIRST_ASSUM ACCEPT_TAC; + MATCH_MP_TAC SCHWARTZ_L2 THEN ASM_SIMP_TAC[ETA_AX]]; ALL_TAC] THEN + CONJ_TAC THENL + [MAP_EVERY X_GEN_TAC [`k:num`; `z:real^1`] THEN DISCH_TAC THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `(if abs(drop(z:real^1)) <= &n then (G:real^1->complex) z else vec 0) = + Cx(&0) /\ + (psi:num->real->complex) k (drop z) = Cx(&0)` + (fun th -> REWRITE_TAC[th; COMPLEX_SUB_REFL]) THEN + CONJ_TAC THENL + [COND_CASES_TAC THENL + [SUBGOAL_THEN `F` CONTR_TAC THEN + ASM_REAL_ARITH_TAC; REWRITE_TAC[COMPLEX_VEC_0]]; + FIRST_X_ASSUM(fun th -> MATCH_MP_TAC th) THEN ASM_REAL_ARITH_TAC]; + FIRST_ASSUM ACCEPT_TAC]; ALL_TAC] THEN + (* the three FOURIER_UNIF_LIM_FROM_L1 hypotheses *) + SUBGOAL_THEN + `!k. (\z. (psi:num->real->complex) k (drop z)) absolutely_integrable_on + (:real^1)` + ASSUME_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC SCHWARTZ_ABSINT THEN + ASM_SIMP_TAC[ETA_AX]; ALL_TAC] THEN + SUBGOAL_THEN + `(\z. (phin:real->complex)(drop z)) absolutely_integrable_on (:real^1)` + ASSUME_TAC THENL + [MATCH_MP_TAC CSUPP_L2_ABSINT THEN EXISTS_TAC `&n + &2` THEN + ASM_REWRITE_TAC[REAL_ARITH `&0 <= &n + &2`] THEN + X_GEN_TAC `z:real^1` THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + COND_CASES_TAC THENL + [SUBGOAL_THEN `F` CONTR_TAC THEN + ASM_REAL_ARITH_TAC; REWRITE_TAC[COMPLEX_VEC_0]]; ALL_TAC] THEN + SUBGOAL_THEN + `((\k. drop(integral (:real^1) (\z. lift(norm((psi:num->real->complex) k + (drop z) - phin(drop z)))))) ---> &0) + sequentially` + ASSUME_TAC THENL + [SUBGOAL_THEN + `(\(k:num). drop(integral (:real^1) (\z. + lift(norm((psi:num->real->complex) k (drop z) - phin(drop z)))))) = + (\(k:num). drop(integral (:real^1) (\z. + lift(norm((phin:real->complex)(drop z) - psi k (drop z))))))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `k:num` THEN AP_TERM_TAC THEN + AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `z:real^1` THEN AP_TERM_TAC THEN + REWRITE_TAC[NORM_SUB]; ALL_TAC] THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `!y. ((\k. fourier ((psi:num->real->complex) k) y) --> fourier + (phin:real->complex) y) sequentially` + ASSUME_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC FOURIER_UNIF_LIM_FROM_L1 THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + (* FATOU: fourier phin in L2, as ptwise-lim of fourier(psi_k) with bounded *) + (* L2-norm *) + SUBGOAL_THEN + `!k. (\z. (psi:num->real->complex) k (drop z)) IN lspace (:real^1) (&2)` + ASSUME_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC SCHWARTZ_L2 THEN + ASM_SIMP_TAC[ETA_AX]; ALL_TAC] THEN + SUBGOAL_THEN + `?B. !k. lnorm (:real^1) (&2) (\z. (psi:num->real->complex) k (drop z)) <= + B` + STRIP_ASSUME_TAC THENL + [MP_TAC(ISPECL [`phin:real->complex`; + `psi:num->real->complex`] PSI_LNORM_BOUNDED) THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC FATOU_L2_LIMIT_MEMBER THEN + MAP_EVERY EXISTS_TAC + [`\k:num z:real^1. fourier ((psi:num->real->complex) k) (drop z)`; + `B:real`] THEN + REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC SCHWARTZ_FOURIER_L2 THEN ASM_SIMP_TAC[ETA_AX]; + GEN_TAC THEN + SUBGOAL_THEN + `lnorm (:real^1) (&2) (\z. fourier ((psi:num->real->complex) k) (drop z)) + = + lnorm (:real^1) (&2) (\z. (psi:num->real->complex) k (drop z))` + SUBST1_TAC THENL + [MATCH_MP_TAC PLANCHEREL_LNORM_SCHWARTZ THEN + ASM_SIMP_TAC[ETA_AX]; ASM_REWRITE_TAC[]]; + MATCH_MP_TAC CONTINUOUS_IMP_MEASURABLE_ON THEN + MATCH_MP_TAC FOURIER_CONTINUOUS_ON THEN ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]]);; + +(* P3 assembly toward f2 in L2 (window transforms W_n = fourier(phin_n) -> *) +(* RIESZ limit). *) + +let PHIN_DROP_L2 = prove + (`!(G:real^1->complex) n. + G IN lspace (:real^1) (&2) + ==> (\z. (\x. if abs x <= &n then (G:real^1->complex)(lift x) else + Cx(&0))(drop z)) IN lspace (:real^1) (&2)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\z. (\x. if abs x <= &n then (G:real^1->complex)(lift x) else Cx(&0))(drop + z)) = + (\z. if abs(drop z) <= &n then (G:real^1->complex) z else vec 0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + REWRITE_TAC[LIFT_DROP; COMPLEX_VEC_0]; ALL_TAC] THEN + MATCH_MP_TAC WINDOW_L2 THEN ASM_REWRITE_TAC[]);; + +let WINDOW_TRANSFORM_ISOMETRY = prove + (`!(G:real^1->complex) m n. + G IN lspace (:real^1) (&2) + ==> lnorm (:real^1) (&2) + (\z. fourier (\x. if abs x <= &m then G(lift x) else Cx(&0)) (drop z) + - + fourier (\x. if abs x <= &n then G(lift x) else Cx(&0)) (drop + z)) = + lnorm (:real^1) (&2) + (\z. (\x. if abs x <= &m then G(lift x) else Cx(&0))(drop z) - + (\x. if abs x <= &n then G(lift x) else Cx(&0))(drop z))`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC PLANCHEREL_L2_REP_ISOMETRY THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC PHIN_DROP_L2 THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC PHIN_DROP_L2 THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC WINDOWED_FOURIER_L2 THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC WINDOWED_FOURIER_L2 THEN ASM_REWRITE_TAC[]; + GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC WINDOWED_FOURIER_REPS THEN + ASM_REWRITE_TAC[]; + GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC WINDOWED_FOURIER_REPS THEN + ASM_REWRITE_TAC[]]);; + +let PHIN_DROP_LNORM_LIM = prove + (`!(G:real^1->complex). + G IN lspace (:real^1) (&2) + ==> ((\n. lnorm (:real^1) (&2) + (\z. (\x. if abs x <= &n then (G:real^1->complex)(lift x) else + Cx(&0))(drop z) - G z)) ---> &0) + sequentially`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `!n. (\z. (\x. if abs x <= &n then (G:real^1->complex)(lift x) else + Cx(&0))(drop z) - G z) = + (\z. (if abs(drop z) <= &n then (G:real^1->complex) z else vec 0) - G + z)` + (fun th -> REWRITE_TAC[th]) THENL + [GEN_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + REWRITE_TAC[LIFT_DROP; COMPLEX_VEC_0]; ALL_TAC] THEN + MATCH_MP_TAC CLOSED_WINDOW_LNORM_LIM THEN ASM_REWRITE_TAC[]);; + +let WINDOW_TRANSFORM_CAUCHY = prove + (`!(G:real^1->complex). + G IN lspace (:real^1) (&2) + ==> !e. &0 < e ==> ?N. !m n. m >= N /\ n >= N + ==> lnorm (:real^1) (&2) + (\z. fourier (\x. if abs x <= &m then G(lift x) else Cx(&0)) + (drop z) - + fourier (\x. if abs x <= &n then G(lift x) else Cx(&0)) + (drop z)) < e`, + GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP PHIN_DROP_LNORM_LIM) THEN + REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN DISCH_TAC THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN + EXISTS_TAC `N:num` THEN MAP_EVERY X_GEN_TAC [`m:num`; `n:num`] THEN + STRIP_TAC THEN + MP_TAC(ISPECL [`G:real^1->complex`; `m:num`; + `n:num`] WINDOW_TRANSFORM_ISOMETRY) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN DISCH_THEN SUBST1_TAC THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `lnorm (:real^1) (&2) + (\z. (\x. if abs x <= &m then (G:real^1->complex)(lift x) else + Cx(&0))(drop z) - G z) + + lnorm (:real^1) (&2) + (\z. G z - (\x. if abs x <= &n then (G:real^1->complex)(lift x) else + Cx(&0))(drop z))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC LNORM_TRIANGLE_SUB THEN + ASM_SIMP_TAC[PHIN_DROP_L2]; ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `x < e / &2 /\ y < e / &2 ==> x + y < e`) THEN + CONJ_TAC THENL + [FIRST_ASSUM(MP_TAC o SPEC `m:num`) THEN ANTS_TAC THENL + [ASM_ARITH_TAC; REAL_ARITH_TAC]; + SUBGOAL_THEN + `lnorm (:real^1) (&2) + (\z. G z - (\x. if abs x <= &n then (G:real^1->complex)(lift x) else + Cx(&0))(drop z)) = + lnorm (:real^1) (&2) + (\z. (\x. if abs x <= &n then (G:real^1->complex)(lift x) else + Cx(&0))(drop z) - G z)` + SUBST1_TAC THENL + [GEN_REWRITE_TAC LAND_CONV [GSYM LNORM_NEG] THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN VECTOR_ARITH_TAC; ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o SPEC `n:num`) THEN ANTS_TAC THENL + [ASM_ARITH_TAC; REAL_ARITH_TAC]]);; + +let WINDOW_TRANSFORM_RIESZ = prove + (`!(G:real^1->complex). + G IN lspace (:real^1) (&2) + ==> ?ginf. ginf IN lspace (:real^1) (&2) /\ + !e. &0 < e ==> ?N. !n. n >= N + ==> lnorm (:real^1) (&2) + (\z. fourier (\x. if abs x <= &n then G(lift x) else + Cx(&0)) (drop z) - ginf z) < e`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`\n:num. \z:real^1. fourier (\x. if abs x <= &n then + (G:real^1->complex)(lift x) else Cx(&0)) (drop z)`; + `&2`; `(:real^1)`] RIESZ_FISCHER) THEN + REWRITE_TAC[REAL_ARITH `&1 <= &2`] THEN ANTS_TAC THENL + [CONJ_TAC THENL + [GEN_TAC THEN REWRITE_TAC[] THEN MATCH_MP_TAC WINDOWED_FOURIER_L2 THEN + ASM_REWRITE_TAC[]; + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(ISPEC `G:real^1->complex` WINDOW_TRANSFORM_CAUCHY) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[]]; + REWRITE_TAC[]]);; + +(* g_inf (the RIESZ limit of the window transforms W_n = *) +(* fourier(G.chi[-n,n])) is in *) +(* L^2 AND represents the Fourier transform of G: int g_inf.h = int *) +(* G.fourier h for *) +(* every Schwartz h. Both int(W_n.h) -> int(g_inf.h) (LPRODUCT_L2LIM, W_n -> *) +(* g_inf) *) +(* and int(W_n.h) = int(phin_n.fourier h) (WINDOWED_FOURIER_REPS) -> *) +(* int(G.fourier h) *) +(* (LPRODUCT_L2LIM, phin_n -> G); LIM_UNIQUE pins the two limits equal. *) +let STRIP286_XSLICE = prove + (`!(G:real^1->complex) (h:real->complex) n x0. + schwartz h + ==> (\y. if drop x0 IN real_interval[--(&n),&n] + then cexp(--(ii * Cx(drop x0) * Cx(drop y))) * G x0 * h(drop y) + else vec 0) absolutely_integrable_on (:real^1)`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `drop(x0:real^1) IN real_interval[--(&n),&n]` THEN + ASM_REWRITE_TAC[ABSOLUTELY_INTEGRABLE_0] THEN + SUBGOAL_THEN + `(\y. cexp(--(ii * Cx(drop x0) * Cx(drop y))) * (G:real^1->complex) x0 * + h(drop y)) = + (\y. G x0 * (cexp(--(ii * Cx(drop x0) * Cx(drop y))) * + (h:real->complex)(drop y)))` + SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + SIMPLE_COMPLEX_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_COMPLEX_LMUL THEN + MATCH_MP_TAC FOURIER_MODULATION_ABSINT THEN + MATCH_MP_TAC SCHWARTZ_ABSINT THEN ASM_REWRITE_TAC[]);; + +let STRIP286_INTEGRAND_MEASURABLE = prove + (`!(G:real^1->complex) (h:real->complex) n. + G measurable_on (:real^1) /\ schwartz h + ==> (\z:real^(1,1)finite_sum. + if drop(fstcart z) IN real_interval[--(&n),&n] + then cexp(--(ii * Cx(drop(fstcart z)) * Cx(drop(sndcart z)))) * + G(fstcart z) * h(drop(sndcart z)) + else vec 0) measurable_on (:real^(1,1)finite_sum)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_ON_CASES THEN + REWRITE_TAC[STRIP_MEASURABLE; MEASURABLE_ON_0] THEN + MATCH_MP_TAC MEASURABLE_ON_COMPLEX_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_IMP_MEASURABLE_ON THEN + REWRITE_TAC[CEXP_FSTSND_CONTINUOUS]; + ALL_TAC] THEN + MATCH_MP_TAC MEASURABLE_ON_COMPLEX_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_ON_COMPOSE_FSTCART THEN ASM_REWRITE_TAC[]; + MP_TAC(INST_TYPE [`:1`,`:M`; `:1`,`:N`] + (ISPEC `\z. (h:real->complex)(drop z)` + MEASURABLE_ON_COMPOSE_SNDCART)) THEN + REWRITE_TAC[o_DEF; ETA_AX] THEN DISCH_THEN MATCH_MP_TAC THEN + MATCH_MP_TAC CONTINUOUS_IMP_MEASURABLE_ON THEN + MATCH_MP_TAC SCHWARTZ_CONT THEN ASM_REWRITE_TAC[]]);; + +(* The inner (y-)norm-integral of the plane integrand at a fixed frequency x *) +(* is the step function 1_[-n,n](x) * norm(G x) * INT_R norm(h): both cexp *) +(* factors are modulus 1, so the norm is 1_win(x) norm(G x) norm(h y), and *) +(* INT_y pulls the x-constant. *) + +let STRIP286_INNER_NORM = prove + (`!(G:real^1->complex) (h:real->complex) n x. + schwartz h + ==> integral (:real^1) (\y. lift(norm( + if drop(fstcart(pastecart (x:real^1) y)) IN real_interval[--(&n),&n] + then cexp(--(ii * Cx(drop(fstcart(pastecart x y))) * + Cx(drop(sndcart(pastecart x y))))) * + G(fstcart(pastecart x y)) * h(drop(sndcart(pastecart x y))) + else vec 0))) = + (if drop x IN real_interval[--(&n),&n] + then norm(G x) % integral (:real^1) (\y. lift(norm(h(drop y)))) else + vec 0)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN + SUBGOAL_THEN + `!y. (norm(if drop x IN real_interval[--(&n),&n] + then cexp(--(ii * Cx(drop x) * Cx(drop y))) * (G:real^1->complex) + x * h(drop y) else vec 0)) = + (if drop x IN real_interval[--(&n),&n] then norm(G x) * + norm((h:real->complex)(drop y)) else &0)` + (fun th -> REWRITE_TAC[th]) THENL + [GEN_TAC THEN COND_CASES_TAC THEN REWRITE_TAC[NORM_0] THEN + REWRITE_TAC[COMPLEX_NORM_MUL] THEN + SUBGOAL_THEN + `norm(cexp(--(ii * Cx(drop x) * Cx(drop y)))) = &1` SUBST1_TAC THENL + [SUBGOAL_THEN + `--(ii * Cx(drop x) * Cx(drop y)) = ii * Cx(--(drop x * drop y))` + SUBST1_TAC THENL + [REWRITE_TAC[CX_NEG; CX_MUL] THEN + SIMPLE_COMPLEX_ARITH_TAC; REWRITE_TAC[NORM_CEXP_II]]; + REWRITE_TAC[REAL_MUL_LID]]; + ALL_TAC] THEN + COND_CASES_TAC THEN + ASM_REWRITE_TAC[LIFT_NUM; INTEGRAL_0] THEN + REWRITE_TAC[LIFT_CMUL] THEN + MATCH_MP_TAC INTEGRAL_CMUL THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN + MATCH_MP_TAC SCHWARTZ_ABSINT THEN ASM_REWRITE_TAC[]);; + +(* Outer x-integrability of the inner-norm step function: the x-marginal of *) +(* the *) +(* iterated norm integral (a step fn = norm(G x) times a constant vector on *) +(* the *) +(* window, 0 off it) is integrable over the whole line. This is the second *) +(* Tonelli premise for STRIP286_INTEGRAND_ABSINT (integrability of the *) +(* iterated *) +(* norm integral). norm(G x) integrable on the window = LSPACE_ABSINT_ON_ *) +(* INTERVAL + ABSOLUTELY_INTEGRABLE_NORM; the scalar-times-const map is *) +(* linear. *) +let STRIP286_INNER_INTEGRABLE = prove + (`!(G:real^1->complex) n (C:real^1). + G IN lspace (:real^1) (&2) + ==> (\x. if drop x IN real_interval[--(&n),&n] then norm(G x) % C else vec + 0) + integrable_on (:real^1)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `!x:real^1. (drop x IN real_interval[--(&n),&n]) <=> x IN + interval[lift(--(&n)), lift(&n)]` + (fun th -> ONCE_REWRITE_TAC[th]) THENL + [GEN_TAC THEN + REWRITE_TAC[IN_INTERVAL_1; IN_REAL_INTERVAL; LIFT_DROP]; ALL_TAC] THEN + REWRITE_TAC[INTEGRABLE_RESTRICT_UNIV] THEN + SUBGOAL_THEN + `(\x. norm((G:real^1->complex) x) % (C:real^1)) = + (\v:real^1. drop v % C) o (\x. lift(norm((G:real^1->complex) x)))` + SUBST1_TAC THENL [REWRITE_TAC[o_DEF; LIFT_DROP]; ALL_TAC] THEN + MATCH_MP_TAC INTEGRABLE_LINEAR THEN CONJ_TAC THENL + [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN + REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL] THEN + MATCH_MP_TAC LSPACE_ABSINT_ON_INTERVAL THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[linear; DROP_ADD; DROP_CMUL] THEN + CONJ_TAC THEN REPEAT GEN_TAC THEN VECTOR_ARITH_TAC]);; + +(* 2D ABSOLUTE integrability of the 286U(c) plane integrand: the Tonelli *) +(* premise for the Fubini order-swap in CARLESON_286U_C. FUBINI_TONELLI *) +(* given *) +(* (i) 2D measurability [STRIP286_INTEGRAND_MEASURABLE, G measurable from *) +(* L^2], *) +(* (ii) empty bad-x-slice set [each x-slice absolutely integrable, STRIP286_ *) +(* XSLICE], (iii) integrability of the iterated norm-integral *) +(* [STRIP286_INNER_ *) +(* NORM rewrites it to the step fn, STRIP286_INNER_INTEGRABLE]. *) +let STRIP286_INTEGRAND_ABSINT = prove + (`!(G:real^1->complex) (h:real->complex) n. + G IN lspace (:real^1) (&2) /\ schwartz h + ==> (\z:real^(1,1)finite_sum. + if drop(fstcart z) IN real_interval[--(&n),&n] + then cexp(--(ii * Cx(drop(fstcart z)) * Cx(drop(sndcart z)))) * + G(fstcart z) * h(drop(sndcart z)) + else vec 0) absolutely_integrable_on (:real^(1,1)finite_sum)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC + `\z:real^(1,1)finite_sum. + if drop(fstcart z) IN real_interval[--(&n),&n] + then cexp(--(ii * Cx(drop(fstcart z)) * Cx(drop(sndcart z)))) * + (G:real^1->complex)(fstcart z) * (h:real->complex)(drop(sndcart z)) + else vec 0` + (INST_TYPE [`:1`,`:M`; `:1`,`:N`] FUBINI_TONELLI)) THEN + ANTS_TAC THENL + [MATCH_MP_TAC STRIP286_INTEGRAND_MEASURABLE THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `(G:real^1->complex) IN lspace (:real^1) (&2)` THEN + REWRITE_TAC[lspace; IN_ELIM_THM] THEN SIMP_TAC[]; + ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN CONJ_TAC THENL + [REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN + SUBGOAL_THEN + `{x:real^1 | ~((\y. if drop x IN real_interval[--(&n),&n] + then cexp(--(ii * Cx(drop x) * Cx(drop y))) * + (G:real^1->complex) x * (h:real->complex)(drop + y) + else vec 0) absolutely_integrable_on (:real^1))} = + {}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN + X_GEN_TAC `x0:real^1` THEN REWRITE_TAC[] THEN + MP_TAC(ISPECL [`G:real^1->complex`; `h:real->complex`; `n:num`; + `x0:real^1`] + STRIP286_XSLICE) THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[NEGLIGIBLE_EMPTY]]; + ASM_SIMP_TAC[STRIP286_INNER_NORM] THEN + MATCH_MP_TAC STRIP286_INNER_INTEGRABLE THEN ASM_REWRITE_TAC[]]);; + +(* Per-window Fubini order swap: the 286U(c) inner double integral over the *) +(* strip abs x <= n may be evaluated x-then-y or y-then-x. Immediate from *) +(* FUBINI_INTEGRAL_SWAP + the 2D absolute integrability STRIP286_INTEGRAND_ *) +(* ABSINT. Mirrors fourier_inversion's STRIP_FUBINI_SWAP but carries the *) +(* extra *) +(* L^2 factor G(x) (vs the L^1 f there). *) +let FUBINI_STRIP_286U = prove + (`!(G:real^1->complex) (h:real->complex) n. + G IN lspace (:real^1) (&2) /\ schwartz h + ==> integral (:real^1) + (\x. integral (:real^1) (\y. + if drop(fstcart(pastecart (x:real^1) y)) IN + real_interval[--(&n),&n] + then cexp(--(ii * Cx(drop(fstcart(pastecart x y))) * + Cx(drop(sndcart(pastecart x y))))) * + G(fstcart(pastecart x y)) * h(drop(sndcart(pastecart x y))) + else vec 0)) = + integral (:real^1) + (\y. integral (:real^1) (\x. + if drop(fstcart(pastecart (x:real^1) y)) IN + real_interval[--(&n),&n] + then cexp(--(ii * Cx(drop(fstcart(pastecart x y))) * + Cx(drop(sndcart(pastecart x y))))) * + G(fstcart(pastecart x y)) * h(drop(sndcart(pastecart x y))) + else vec 0))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC + `\z:real^(1,1)finite_sum. + if drop(fstcart z) IN real_interval[--(&n),&n] + then cexp(--(ii * Cx(drop(fstcart z)) * Cx(drop(sndcart z)))) * + (G:real^1->complex)(fstcart z) * (h:real->complex)(drop(sndcart z)) + else vec 0` (INST_TYPE [`:1`,`:M`; + `:1`,`:N`] FUBINI_INTEGRAL_SWAP)) THEN + ASM_SIMP_TAC[STRIP286_INTEGRAND_ABSINT]);; + +(* --- The two evaluated sides of the per-window Fubini identity (mirrors *) +(* fourier_inversion.ml's LHS_SIDE / RHS_SIDE for 283H). *) +(* *) +(* LHS (x-outer): the inner y-integral of e^{-ixy}G(x)h(y) over the whole *) +(* line *) +(* pulls the x-constant G(x) out and reproduces sqrt2pi*fourier h (x) *) +(* [FOURIER_ *) +(* INNER_INTEGRAL]; the outer x-integral over the strip collapses to the *) +(* interval *) +(* integral of G(x) sqrt2pi hhat(x). *) +let LHS286_OUTER_INTEGRAND = prove + (`!(G:real^1->complex) (h:real->complex) n x. + schwartz h + ==> integral (:real^1) + (\y. if drop(fstcart(pastecart (x:real^1) y)) IN + real_interval[--(&n),&n] + then cexp(--(ii * Cx(drop(fstcart(pastecart x y))) * + Cx(drop(sndcart(pastecart x y))))) * + G(fstcart(pastecart x y)) * h(drop(sndcart(pastecart x + y))) + else vec 0) = + (if drop x IN real_interval[--(&n),&n] + then G x * Cx(sqrt(&2 * pi)) * fourier h (drop x) + else vec 0)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN + COND_CASES_TAC THEN REWRITE_TAC[INTEGRAL_0] THEN + SUBGOAL_THEN + `!y. cexp(--(ii * Cx(drop x) * Cx(drop y))) * (G:real^1->complex) x * + (h:real->complex)(drop y) = + G x * (cexp(--(ii * Cx(drop x) * Cx(drop y))) * h(drop y))` + (fun th -> REWRITE_TAC[th]) THENL + [GEN_TAC THEN SIMPLE_COMPLEX_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPECL + [`\y:real^1. cexp(--(ii * Cx(drop(x:real^1)) * Cx(drop y))) * + (h:real->complex)(drop y)`; + `(:real^1)`; `(G:real^1->complex) x`] INTEGRAL_COMPLEX_LMUL) THEN + ANTS_TAC THENL + [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC FOURIER_MODULATION_ABSINT THEN + MATCH_MP_TAC SCHWARTZ_ABSINT THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + DISCH_THEN(SUBST1_TAC o BETA_RULE) THEN + REWRITE_TAC[INNER_INT_FOURIER] THEN + REWRITE_TAC[COMPLEX_MUL_ASSOC]);; + +let LHS286_SIDE = prove + (`!(G:real^1->complex) (h:real->complex) n. + schwartz h + ==> integral (:real^1) + (\x. integral (:real^1) (\y. + if drop(fstcart(pastecart (x:real^1) y)) IN + real_interval[--(&n),&n] + then cexp(--(ii * Cx(drop(fstcart(pastecart x y))) * + Cx(drop(sndcart(pastecart x y))))) * + G(fstcart(pastecart x y)) * h(drop(sndcart(pastecart x y))) + else vec 0)) = + integral (interval[lift(--(&n)), lift(&n)]) + (\x. G x * Cx(sqrt(&2 * pi)) * fourier h (drop x))`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[LHS286_OUTER_INTEGRAND] THEN + SUBGOAL_THEN + `(\x. if drop x IN real_interval[--(&n),&n] + then (G:real^1->complex) x * Cx(sqrt(&2 * pi)) * fourier h (drop x) + else vec 0) = + (\x:real^1. if x IN interval[lift(--(&n)),lift(&n)] + then G x * Cx(sqrt(&2 * pi)) * fourier h (drop x) + else vec 0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + REWRITE_TAC[IN_INTERVAL_1; IN_REAL_INTERVAL; LIFT_DROP]; ALL_TAC] THEN + REWRITE_TAC[INTEGRAL_RESTRICT_UNIV]);; + +(* RHS (y-outer): the inner x-integral pulls out the y-constant h(y) and *) +(* leaves *) +(* the window transform INT_{[-n,n]} e^{-ixy}G(x)dx (G is L^1 on the compact *) +(* window, LSPACE_ABSINT_ON_INTERVAL); the outer y-integral is over the *) +(* whole *) +(* line. The cexp arg is commuted so MODULATION_ABSINT_LMEAS's fixed *) +(* frequency *) +(* (here drop y) is in front. *) +let RHS286_OUTER_INTEGRAND = prove + (`!(G:real^1->complex) (h:real->complex) n y. + G IN lspace (:real^1) (&2) + ==> integral (:real^1) + (\x. if drop(fstcart(pastecart (x:real^1) y)) IN + real_interval[--(&n),&n] + then cexp(--(ii * Cx(drop(fstcart(pastecart x y))) * + Cx(drop(sndcart(pastecart x y))))) * + G(fstcart(pastecart x y)) * h(drop(sndcart(pastecart x + y))) + else vec 0) = + h(drop y) * integral (interval[lift(--(&n)), lift(&n)]) + (\x. cexp(--(ii * Cx(drop x) * Cx(drop y))) * G x)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN + SUBGOAL_THEN + `!x:real^1. (if drop x IN real_interval[--(&n),&n] + then cexp(--(ii * Cx(drop x) * Cx(drop y))) * + (G:real^1->complex) x * (h:real->complex)(drop y) + else vec 0) = + (h:real->complex)(drop y) * (if drop x IN + real_interval[--(&n),&n] + then cexp(--(ii * Cx(drop x) * Cx(drop y))) * G x + else vec 0)` + (fun th -> REWRITE_TAC[th]) THENL + [GEN_TAC THEN COND_CASES_TAC THEN + REWRITE_TAC[COMPLEX_MUL_RZERO; COMPLEX_VEC_0] THEN + SIMPLE_COMPLEX_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPECL + [`\x:real^1. if drop x IN real_interval[--(&n),&n] + then cexp(--(ii * Cx(drop x) * Cx(drop(y:real^1)))) * + (G:real^1->complex) x + else vec 0`; + `(:real^1)`; `(h:real->complex)(drop y)`] INTEGRAL_COMPLEX_LMUL) THEN + ANTS_TAC THENL + [SUBGOAL_THEN + `!x:real^1. (drop x IN real_interval[--(&n),&n]) <=> x IN + interval[lift(--(&n)), lift(&n)]` + (fun th -> ONCE_REWRITE_TAC[th]) THENL + [GEN_TAC THEN + REWRITE_TAC[IN_INTERVAL_1; IN_REAL_INTERVAL; LIFT_DROP]; ALL_TAC] THEN + REWRITE_TAC[INTEGRABLE_RESTRICT_UNIV] THEN + SUBGOAL_THEN + `(\x:real^1. cexp(--(ii * Cx(drop x) * Cx(drop y))) * (G:real^1->complex) + x) = + (\x. cexp(--(ii * Cx(drop y) * Cx(drop x))) * G x)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + SUBGOAL_THEN + `ii * Cx(drop x) * Cx(drop y) = + ii * Cx(drop y) * Cx(drop x)` SUBST1_TAC THENL + [SIMPLE_COMPLEX_ARITH_TAC; REFL_TAC]; ALL_TAC] THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC MODULATION_ABSINT_LMEAS THEN + REWRITE_TAC[LEBESGUE_MEASURABLE_INTERVAL] THEN + REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL] THEN + MATCH_MP_TAC LSPACE_ABSINT_ON_INTERVAL THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + DISCH_THEN(SUBST1_TAC o BETA_RULE) THEN AP_TERM_TAC THEN + SUBGOAL_THEN + `(\x. if drop x IN real_interval[--(&n),&n] + then cexp(--(ii * Cx(drop x) * Cx(drop y))) * (G:real^1->complex) x + else vec 0) = + (\x:real^1. if x IN interval[lift(--(&n)),lift(&n)] + then cexp(--(ii * Cx(drop x) * Cx(drop y))) * G x + else vec 0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + REWRITE_TAC[IN_INTERVAL_1; IN_REAL_INTERVAL; LIFT_DROP]; ALL_TAC] THEN + REWRITE_TAC[INTEGRAL_RESTRICT_UNIV]);; + +let RHS286_SIDE = prove + (`!(G:real^1->complex) (h:real->complex) n. + G IN lspace (:real^1) (&2) + ==> integral (:real^1) + (\y. integral (:real^1) (\x. + if drop(fstcart(pastecart (x:real^1) y)) IN + real_interval[--(&n),&n] + then cexp(--(ii * Cx(drop(fstcart(pastecart x y))) * + Cx(drop(sndcart(pastecart x y))))) * + G(fstcart(pastecart x y)) * h(drop(sndcart(pastecart x y))) + else vec 0)) = + integral (:real^1) + (\y. h(drop y) * integral (interval[lift(--(&n)), lift(&n)]) + (\x. cexp(--(ii * Cx(drop x) * Cx(drop y))) * G + x))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_EQ THEN + X_GEN_TAC `y:real^1` THEN DISCH_TAC THEN BETA_TAC THEN + MATCH_MP_TAC RHS286_OUTER_INTEGRAND THEN ASM_REWRITE_TAC[]);; + +(* Per-window Fubini identity (Fremlin 286U(c), the n-th equality before the *) +(* n->inf limit): INT_{[-n,n]} G(x) sqrt2pi hhat(x) = INT_R h(y) (window *) +(* transform_n)(y). Chains LHS286_SIDE and RHS286_SIDE through *) +(* FUBINI_STRIP_286U. *) +let CARLESON_286U_STRIP_RAW = prove + (`!(G:real^1->complex) (h:real->complex) n. + G IN lspace (:real^1) (&2) /\ schwartz h + ==> integral (interval[lift(--(&n)), lift(&n)]) + (\x. G x * Cx(sqrt(&2 * pi)) * fourier h (drop x)) = + integral (:real^1) + (\y. h(drop y) * integral (interval[lift(--(&n)), lift(&n)]) + (\x. cexp(--(ii * Cx(drop x) * Cx(drop y))) * G + x))`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`G:real^1->complex`; `h:real->complex`; + `n:num`] LHS286_SIDE) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + MP_TAC(SPECL [`G:real^1->complex`; `h:real->complex`; + `n:num`] RHS286_SIDE) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC FUBINI_STRIP_286U THEN ASM_REWRITE_TAC[]);; + +(* --- The clean (non-DCT) half of 286U(c): the outer n->inf limit. *) +(* *) +(* G(x) sqrt2pi hhat(x) is integrable on R (GFOURIERH_INTEGRABLE scaled), so *) +(* its *) +(* symmetric-interval integrals converge to the whole-line integral *) +(* [SYMMETRIC_ *) +(* INTERVAL_LIMIT + LIM_POSINFINITY_SEQUENTIALLY]. Combined with the *) +(* per-window *) +(* Fubini identity CARLESON_286U_STRIP_RAW (termwise equal to INT_R h W_n), *) +(* this *) +(* pins lim_n INT_R h(y) W_n(y) dy = INT_R G sqrt2pi hhat. *) +let GHHAT_SCALED_INTEGRABLE = prove + (`!(G:real^1->complex) h:real->complex. + G IN lspace (:real^1) (&2) /\ schwartz h + ==> (\x. G x * Cx(sqrt(&2 * pi)) * fourier h (drop x)) integrable_on + (:real^1)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\x. (G:real^1->complex) x * Cx(sqrt(&2 * pi)) * fourier h (drop x)) = + (\x. Cx(sqrt(&2 * pi)) * (G x * fourier h (drop x)))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + SIMPLE_COMPLEX_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC INTEGRABLE_COMPLEX_LMUL THEN + MATCH_MP_TAC GFOURIERH_INTEGRABLE THEN ASM_REWRITE_TAC[]);; + +let GHHAT_INTERVAL_LIMIT = prove + (`!(G:real^1->complex) (h:real->complex). + G IN lspace (:real^1) (&2) /\ schwartz h + ==> ((\n. integral (interval[lift(--(&n)), lift(&n)]) + (\x. G x * Cx(sqrt(&2 * pi)) * fourier h (drop x))) + --> integral (:real^1) (\x. G x * Cx(sqrt(&2 * pi)) * fourier h (drop + x))) + sequentially`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC LIM_POSINFINITY_SEQUENTIALLY THEN + MATCH_MP_TAC SYMMETRIC_INTERVAL_LIMIT THEN + MATCH_MP_TAC GHHAT_SCALED_INTEGRABLE THEN ASM_REWRITE_TAC[]);; + +(* The y-marginal INT_x F_n(x,y) = h(y) W_n(y) is integrable in y: FUBINI_ *) +(* ABSOLUTELY_INTEGRABLE_ALT on the (absolutely integrable) plane integrand *) +(* yields integrability of the x-marginal, which RHS286_OUTER_INTEGRAND *) +(* rewrites as h(y) W_n(y). *) +let RHS286_MARGINAL_INTEGRABLE = prove + (`!(G:real^1->complex) (h:real->complex) n. + G IN lspace (:real^1) (&2) /\ schwartz h + ==> (\y. h(drop y) * integral (interval[lift(--(&n)), lift(&n)]) + (\x. cexp(--(ii * Cx(drop x) * Cx(drop y))) * G x)) + integrable_on (:real^1)`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`G:real^1->complex`; `h:real->complex`; + `n:num`] STRIP286_INTEGRAND_ABSINT) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o MATCH_MP (INST_TYPE [`:1`,`:M`; + `:1`,`:N`] FUBINI_ABSOLUTELY_INTEGRABLE_ALT)) THEN + REWRITE_TAC[] THEN STRIP_TAC THEN + MATCH_MP_TAC INTEGRABLE_EQ THEN + EXISTS_TAC + `\y:real^1. integral (:real^1) (\x. + if drop(fstcart(pastecart (x:real^1) y)) IN real_interval[--(&n),&n] + then cexp(--(ii * Cx(drop(fstcart(pastecart x y))) * + Cx(drop(sndcart(pastecart x y))))) * + (G:real^1->complex)(fstcart(pastecart x y)) * + (h:real->complex)(drop(sndcart(pastecart x y))) + else vec 0)` THEN + CONJ_TAC THENL + [X_GEN_TAC `y:real^1` THEN DISCH_TAC THEN + MP_TAC(SPECL [`G:real^1->complex`; `h:real->complex`; `n:num`; `y:real^1`] + RHS286_OUTER_INTEGRAND) THEN ASM_REWRITE_TAC[]; + FIRST_ASSUM(MP_TAC o MATCH_MP HAS_INTEGRAL_INTEGRABLE) THEN + REWRITE_TAC[ETA_AX]]);; + +(* The bridge to the outer limit: lim_n INT_R h(y) W_n(y) dy = INT_R G *) +(* sqrt2pi *) +(* hhat. (CARLESON_286U_STRIP_RAW makes each term equal to the interval *) +(* integral *) +(* of G sqrt2pi hhat; GHHAT_INTERVAL_LIMIT sends the sequence to its *) +(* whole-line *) +(* limit.) *) +let HWN_LIMIT = prove + (`!(G:real^1->complex) (h:real->complex). + G IN lspace (:real^1) (&2) /\ schwartz h + ==> ((\n. integral (:real^1) + (\y. h(drop y) * integral (interval[lift(--(&n)), lift(&n)]) + (\x. cexp(--(ii * Cx(drop x) * Cx(drop y))) + * G x))) + --> integral (:real^1) (\x. G x * Cx(sqrt(&2 * pi)) * fourier h (drop + x))) + sequentially`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\n. integral (:real^1) + (\y. h(drop y) * integral (interval[lift(--(&n)), lift(&n)]) + (\x. cexp(--(ii * Cx(drop x) * Cx(drop y))) * + (G:real^1->complex) x))) = + (\n. integral (interval[lift(--(&n)), lift(&n)]) + (\x. G x * Cx(sqrt(&2 * pi)) * fourier h (drop x)))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC CARLESON_286U_STRIP_RAW THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC GHHAT_INTERVAL_LIMIT THEN ASM_REWRITE_TAC[]);; + +(* --- 286U(c) DCT + Fubini heart (ABSTRACT form, Fremlin 286U(c) lines *) +(* 3040- *) +(* 3049): given the a.e. window-limit f2 (i.e. W_n(y) -> sqrt2pi f2(y) off a *) +(* null *) +(* t) and an L^1 dominator D >= norm(h W_n) off t, the representative f2 *) +(* satisfies *) +(* INT_R f2 h = INT_R G hhat (equivalently after the sqrt2pi factor). *) +(* Lebesgue *) +(* DCT [DOMINATED_CONVERGENCE_AE, per-window integrability = *) +(* RHS286_MARGINAL_ *) +(* INTEGRABLE] sends lim_n INT_R h W_n to INT_R h sqrt2pi f2; HWN_LIMIT *) +(* sends the *) +(* same sequence to INT_R G sqrt2pi hhat; LIM_UNIQUE identifies them. *) +(* *) +(* Kept abstract in (f2, t, D) so the concrete window-limit materialization *) +(* and *) +(* the Ahat-dominator (AHAT_SCHWARTZ_DOM, norm W_n <= sqrt2pi Ahat G) are *) +(* wired *) +(* in separately. *) +let CARLESON_286U_C_ABSTRACT = prove + (`!(G:real^1->complex) (h:real->complex) (f2:real^1->complex) (t:real^1->bool) + (D:real^1->real^1). + G IN lspace (:real^1) (&2) /\ schwartz h /\ negligible t /\ + D integrable_on (:real^1) /\ + (!n y. ~(y IN t) ==> + norm(h(drop y) * integral (interval[lift(--(&n)), lift(&n)]) + (\x. cexp(--(ii * Cx(drop x) * Cx(drop y))) * G x)) + <= drop(D y)) /\ + (!y. ~(y IN t) ==> + ((\n. h(drop y) * integral (interval[lift(--(&n)), lift(&n)]) + (\x. cexp(--(ii * Cx(drop x) * Cx(drop y))) * G x)) + --> h(drop y) * Cx(sqrt(&2 * pi)) * f2 y) sequentially) + ==> integral (:real^1) (\y. h(drop y) * Cx(sqrt(&2 * pi)) * f2 y) = + integral (:real^1) (\x. G x * Cx(sqrt(&2 * pi)) * fourier h (drop + x))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`\n y:real^1. (h:real->complex)(drop y) * integral (interval[lift(--(&n)), + lift(&n)]) + (\x. cexp(--(ii * Cx(drop x) * Cx(drop y))) * + (G:real^1->complex) x)`; + `\y:real^1. (h:real->complex)(drop y) * Cx(sqrt(&2 * pi)) * + (f2:real^1->complex) y`; + `D:real^1->real^1`; `(:real^1)`; + `t:real^1->bool`] DOMINATED_CONVERGENCE_AE) THEN + ASM_REWRITE_TAC[IN_DIFF; IN_UNIV] THEN + ANTS_TAC THENL + [X_GEN_TAC `k:num` THEN MATCH_MP_TAC RHS286_MARGINAL_INTEGRABLE THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + STRIP_TAC THEN + MP_TAC(SPECL [`G:real^1->complex`; `h:real->complex`] HWN_LIMIT) THEN + ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN + MP_TAC(ISPECL + [`sequentially`; + `\n. integral (:real^1) + (\y. (h:real->complex)(drop y) * integral (interval[lift(--(&n)), + lift(&n)]) + (\x. cexp(--(ii * Cx(drop x) * Cx(drop y))) * + (G:real^1->complex) x))`; + `integral (:real^1) (\y. (h:real->complex)(drop y) * Cx(sqrt(&2 * pi)) * + (f2:real^1->complex) y)`; + `integral (:real^1) (\x. (G:real^1->complex) x * Cx(sqrt(&2 * pi)) * + fourier h (drop x))`] + LIM_UNIQUE) THEN + ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY]);; + +(* Pointwise window <= maximal bound (the DCT dominator, Fremlin 286U(c) *) +(* line *) +(* 3043 "1/sqrt2pi |INT_{-n}^n e^{-ixy}f| <= Af(y)"): the STRIP window *) +(* W_n(y) = *) +(* INT_{[-n,n]} e^{-ixy}G(x)dx satisfies inv sqrt2pi norm(W_n) <= *) +(* carleson_Ahat *) +(* (G o lift)(drop y), whenever the truncated-integral family at y is *) +(* bounded *) +(* (off the null bad set). Reconciles the STRIP form (G:real^1->complex, *) +(* cexp arg drop-x first) with the Ahat form (f:real->complex via f(drop x), *) +(* freq *) +(* first) via IMAGE_LIFT_REAL_INTERVAL + cexp-arg commute + f := G o lift. *) +let WINDOW_DOMINATION_BOUND = prove + (`!(G:real^1->complex) (y:real^1) n. + (?B. !a b. a <= b ==> inv(sqrt(&2 * pi)) * + norm(integral (IMAGE lift (real_interval[a,b])) + (\x. cexp(--(ii * Cx(drop y) * Cx(drop x))) * G(lift(drop + x)))) <= B) + ==> inv(sqrt(&2 * pi)) * + norm(integral (interval[lift(--(&n)), lift(&n)]) + (\x. cexp(--(ii * Cx(drop x) * Cx(drop y))) * G x)) + <= carleson_Ahat (\u. G(lift u)) (drop y)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN + `integral (interval[lift(--(&n)), lift(&n)]) + (\x. cexp(--(ii * Cx(drop x) * Cx(drop y))) * (G:real^1->complex) x) = + integral (IMAGE lift (real_interval[--(&n),&n])) + (\x. cexp(--(ii * Cx(drop y) * Cx(drop x))) * G(lift(drop x)))` + SUBST1_TAC THENL + [REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL] THEN MATCH_MP_TAC INTEGRAL_EQ THEN + X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN REWRITE_TAC[LIFT_DROP] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + SIMPLE_COMPLEX_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPECL [`\u. (G:real^1->complex)(lift u)`; `drop(y:real^1)`; + `--(&n):real`; `&n:real`] + CARLESON_AHAT_WINDOW_LE) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [REWRITE_TAC[REAL_ARITH `--(&n) <= &n`] THEN ASM_REWRITE_TAC[]; + DISCH_THEN ACCEPT_TAC]);; + +(* The concrete DCT dominator (Fremlin 286U(c) / 284F): sqrt2pi Ahat(G o *) +(* lift) *) +(* norm(h) is integrable on R. From AHAT_SCHWARTZ_DOM (Ahat G norm h in L^1) *) +(* at *) +(* the real-fn G o lift, scaled by sqrt2pi and pushed through the *) +(* real->vector *) +(* integrability bridge REAL_INTEGRABLE_ON. *) +let DOMINATOR_286U_INTEGRABLE = prove + (`!(G:real^1->complex) (h:real->complex) C10. + &0 <= C10 /\ G IN lspace (:real^1) (&2) /\ schwartz h /\ + (!(k:real->complex) GG. schwartz k /\ real_measurable GG + ==> real_integral GG (carleson_Ahat k) + <= C10 * lnorm (:real^1) (&2) (\z. k(drop z)) * sqrt(real_measure + GG)) + ==> (\y. lift(sqrt(&2 * pi) * carleson_Ahat (\u. G(lift u)) (drop y) * + norm(h(drop y)))) + integrable_on (:real^1)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\u. (G:real^1->complex)(lift u)`; `h:real->complex`; + `C10:real`] AHAT_SCHWARTZ_DOM) THEN + ASM_REWRITE_TAC[LIFT_DROP; ETA_AX] THEN DISCH_TAC THEN + SUBGOAL_THEN + `(\y. sqrt(&2 * pi) * (carleson_Ahat (\u. (G:real^1->complex)(lift u)) y * + norm((h:real->complex) y))) + real_integrable_on (:real)` + MP_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_LMUL THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[REAL_INTEGRABLE_ON; o_DEF; LIFT_DROP; IMAGE_LIFT_UNIV] THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN AP_TERM_TAC THEN REAL_ARITH_TAC);; + +(* Scaled window reconciliation: sqrt2pi times the (normalized) Ahat-window *) +(* integral (freq drop y first, plain G x) recovers the STRIP window W_n *) +(* (freq *) +(* drop x first). Two cexp args commute; the two sqrt2pi factors cancel. *) +let WINDOW_RECONCILE_GX = prove + (`!(G:real^1->complex) (y:real^1) n. + Cx(sqrt(&2 * pi)) * + (Cx(inv(sqrt(&2 * pi))) * + integral (IMAGE lift (real_interval[--(&n),&n])) + (\x. cexp(--(ii * Cx(drop y) * Cx(drop x))) * G x)) = + integral (interval[lift(--(&n)), lift(&n)]) + (\x. cexp(--(ii * Cx(drop x) * Cx(drop y))) * G x)`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `Cx(sqrt(&2 * pi)) * Cx(inv(sqrt(&2 * pi))) = Cx(&1)` (fun th -> + REWRITE_TAC[COMPLEX_MUL_ASSOC; th; COMPLEX_MUL_LID]) THENL + [REWRITE_TAC[GSYM CX_MUL] THEN AP_TERM_TAC THEN + MATCH_MP_TAC REAL_MUL_RINV THEN + MATCH_MP_TAC REAL_LT_IMP_NZ THEN MATCH_MP_TAC SQRT_POS_LT THEN + MP_TAC PI_POS THEN REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL] THEN MATCH_MP_TAC INTEGRAL_EQ THEN + X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN BETA_TAC THEN + AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + SIMPLE_COMPLEX_ARITH_TAC);; + +let CARLESON_286U_WINDOW_AE_STRONG = prove + (`!(f:real->complex) C10. + &0 <= C10 /\ (\z. f(drop z)) IN lspace (:real^1) (&2) /\ + (!(h:real->complex) GG. schwartz h /\ real_measurable GG + ==> real_integral GG (carleson_Ahat h) + <= C10 * lnorm (:real^1) (&2) (\z. h(drop z)) * sqrt(real_measure + GG)) + ==> ?s. real_negligible s /\ + !y. ~(y IN s) + ==> (?K. !m:num. carleson_Ahat_trunc f (&m) y <= K) /\ + ?z. ((\a. Cx(inv(sqrt(&2 * pi))) * + integral (IMAGE lift (real_interval[--a,a])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * f(drop x))) + --> z) + at_posinfinity`, + REPEAT STRIP_TAC THEN + EXISTS_TAC + `{y | !k:num. ?m:num. &k + &1 < carleson_Ahat_trunc (f:real->complex) (&m) + y} UNION + {y | ~(!e. &0 < e ==> ?m:num. carleson_gamma f (&m) y <= e)}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_NEGLIGIBLE_UNION THEN CONJ_TAC THENL + [MATCH_MP_TAC CARLESON_AHAT_TRUNC_BADSET_NEG THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`f:real->complex`; `C10:real`] CARLESON_H1_BOUND) THEN + ASM_REWRITE_TAC[]; + MP_TAC(ISPECL [`f:real->complex`; + `C10:real`] CARLESON_OSC_BADSET_FROM_UNTRUNC) THEN + ASM_REWRITE_TAC[]]; ALL_TAC] THEN + X_GEN_TAC `y:real` THEN REWRITE_TAC[IN_UNION; DE_MORGAN_THM] THEN + STRIP_TAC THEN + CONJ_TAC THENL + [MATCH_MP_TAC CARLESON_OFF_BADSET_BOUNDED THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + MP_TAC(ISPEC + `\a b. Cx(inv(sqrt(&2 * pi))) * + integral (IMAGE lift (real_interval[a,b])) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * (f:real->complex)(drop x))` + CARLESON_286U_SYMLIM) THEN + REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + MP_TAC(BETA_RULE(ISPECL [`f:real->complex`; + `y:real`] CARLESON_GAMMA_INF_CAUCHY)) THEN + DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL + [MP_TAC(ISPECL [`f:real->complex`; + `y:real`] CARLESON_TRUNC_FAMILY_WINDOW_BOUND) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + MATCH_MP_TAC CARLESON_OFF_BADSET_BOUNDED THEN ASM_REWRITE_TAC[]; + UNDISCH_TAC `~(y IN {y | ~(!e. &0 < e ==> ?m:num. carleson_gamma + (f:real->complex) (&m) y <= e)})` THEN + REWRITE_TAC[IN_ELIM_THM]]);; + +(* ========================================================================= *) +(* Chebyshev machinery for L^2 -> convergence in measure (Fremlin 273). *) +(* Used to reconcile the pointwise a.e. window-limit f2 with the L^2 RIESZ *) +(* limit g_inf of the SAME window-transform sequence, giving f2 = g_inf a.e. *) +(* hence f2 IN L^2 (via LSPACE_AE_CONG). *) +(* ========================================================================= *) + +(* The superlevel set {norm(d)>=e} is measurable for d in L^2 (its indicator *) +(* is dominated by the integrable norm(d)^2/e^2). *) +let L2_SUPERLEVEL_MEASURABLE = prove + (`!(d:real^1->complex) e. d IN lspace (:real^1) (&2) /\ &0 < e + ==> measurable {x:real^1 | norm(d x) >= e}`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `lebesgue_measurable {x:real^1 | norm((d:real^1->complex) x) >= e}` + ASSUME_TAC THENL + [SUBGOAL_THEN + `(\x:real^1. lift(norm((d:real^1->complex) x))) measurable_on (:real^1)` + MP_TAC THENL + [MATCH_MP_TAC MEASURABLE_ON_NORM THEN + RULE_ASSUM_TAC(REWRITE_RULE[lspace; IN_ELIM_THM]) THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[MEASURABLE_ON_PREIMAGE_HALFSPACE_COMPONENT_GE] THEN + DISCH_THEN(MP_TAC o SPECL [`e:real`; `1`]) THEN + REWRITE_TAC[DIMINDEX_1; ARITH; GSYM drop; LIFT_DROP]; ALL_TAC] THEN + REWRITE_TAC[MEASURABLE_INTEGRABLE] THEN + MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN + EXISTS_TAC `\x:real^1. lift(norm((d:real^1->complex) x) pow 2 / e pow 2)` + THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_ON_CASES THEN + ASM_REWRITE_TAC[MEASURABLE_ON_CONST; IN_ELIM_THM]; + SUBGOAL_THEN + `(\x:real^1. lift(norm((d:real^1->complex) x) pow 2 / e pow 2)) = + (\x. inv(e pow 2) % lift(norm(d x) pow 2))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + REWRITE_TAC[GSYM DROP_EQ; DROP_CMUL; LIFT_DROP] THEN + REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC INTEGRABLE_CMUL THEN + RULE_ASSUM_TAC(REWRITE_RULE[lspace; IN_ELIM_THM]) THEN + ASM_REWRITE_TAC[GSYM RPOW_POW]; + X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN BETA_TAC THEN + REWRITE_TAC[LIFT_DROP] THEN COND_CASES_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_ELIM_THM]) THEN + REWRITE_TAC[NORM_1; DROP_VEC; REAL_ABS_NUM; NORM_0] THENL + [SUBGOAL_THEN `&0 < e pow 2` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_POW_LT THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_POW_LE2 THEN + UNDISCH_TAC `norm((d:real^1->complex) x) >= e` THEN + UNDISCH_TAC `&0 < e` THEN REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LE_DIV THEN REWRITE_TAC[REAL_LE_POW_2]]]);; + +(* Chebyshev multiplicative form: e^2 * measure{norm d>=e} <= int_univ *) +(* norm(d)^2 *) +let CHEBYSHEV_L2_MEASURE = prove + (`!(d:real^1->complex) e. + d IN lspace (:real^1) (&2) /\ &0 < e + ==> measure {x:real^1 | norm(d x) >= e} * e pow 2 <= + drop(integral (:real^1) (\x. lift(norm(d x) pow 2)))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`d:real^1->complex`; `e:real`] L2_SUPERLEVEL_MEASURABLE) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + SUBGOAL_THEN + `(\x:real^1. lift(norm((d:real^1->complex) x) pow 2)) integrable_on + (:real^1)` ASSUME_TAC THENL + [FIRST_ASSUM(MP_TAC o MATCH_MP LSPACE_IMP_INTEGRABLE) THEN + REWRITE_TAC[RPOW_POW]; ALL_TAC] THEN + SUBGOAL_THEN + `measure {x:real^1 | norm((d:real^1->complex) x) >= e} * e pow 2 = + drop(integral (:real^1) (\x. if x IN {x | norm(d x) >= e} then lift(e pow + 2) else vec 0))` + SUBST1_TAC THENL + [REWRITE_TAC[INTEGRAL_RESTRICT_UNIV] THEN + SUBGOAL_THEN + `(\x:real^1. lift(e pow 2)) = + (\x:real^1. (e pow 2) % vec 1)` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; GSYM DROP_EQ; DROP_CMUL; DROP_VEC; + LIFT_DROP] THEN REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[INTEGRAL_CMUL; INTEGRABLE_ON_CONST; INTEGRAL_MEASURE; + DROP_CMUL; LIFT_DROP] THEN + MATCH_ACCEPT_TAC REAL_MUL_SYM; ALL_TAC] THEN + MATCH_MP_TAC INTEGRAL_DROP_LE THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [REWRITE_TAC[INTEGRABLE_RESTRICT_UNIV] THEN + REWRITE_TAC[INTEGRABLE_ON_CONST] THEN DISJ2_TAC THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + X_GEN_TAC `x:real^1` THEN REWRITE_TAC[IN_UNIV] THEN BETA_TAC THEN + COND_CASES_TAC THEN + REWRITE_TAC[LIFT_DROP; DROP_VEC] THENL + [POP_ASSUM MP_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_POW_LE2 THEN + UNDISCH_TAC `norm((d:real^1->complex) x) >= e` THEN + UNDISCH_TAC `&0 < e` THEN REAL_ARITH_TAC; + REWRITE_TAC[REAL_LE_POW_2]]);; + +(* per-n Chebyshev: measure{norm(dn n - g)>=e} <= L_n^2 / e^2 *) +let MEASURE_L2_DIFF_BOUND = prove + (`!(dn:num->real^1->complex) (g:real^1->complex) e n. + (!m. dn m IN lspace (:real^1) (&2)) /\ g IN lspace (:real^1) (&2) /\ &0 < + e + ==> measure {x:real^1 | norm(dn n x - g x) >= e} <= + (lnorm (:real^1) (&2) (\x. dn n x - g x)) pow 2 / e pow 2`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\x:real^1. (dn:num->real^1->complex) n x - g x) IN lspace (:real^1) (&2)` + ASSUME_TAC THENL + [MATCH_MP_TAC LSPACE_SUB THEN + REWRITE_TAC[REAL_ARITH `&0 <= &2`; ETA_AX] THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL [`\x:real^1. (dn:num->real^1->complex) n x - g x`; + `e:real`] CHEBYSHEV_L2_MEASURE) THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`(:real^1)`; `&2`; + `\x:real^1. (dn:num->real^1->complex) n x - g x`] INTEGRAL_LNORM_RPOW) THEN + ASM_REWRITE_TAC[REAL_ARITH `~(&2 = &0)`; RPOW_POW; LIFT_DROP] THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[LIFT_DROP] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; REAL_POW_LT] THEN REAL_ARITH_TAC);; + +(* L^2 convergence implies convergence in measure (the *) +(* CONVERGENCE_IN_MEASURE hyp) *) +let L2_LIM_IMP_IN_MEASURE = prove + (`!(dn:num->real^1->complex) (g:real^1->complex). + (!n. dn n IN lspace (:real^1) (&2)) /\ g IN lspace (:real^1) (&2) /\ + ((\n. lnorm (:real^1) (&2) (\x. dn n x - g x)) ---> &0) sequentially + ==> !e. &0 < e + ==> eventually + (\n. ?t. {x:real^1 | x IN (:real^1) /\ dist(dn n x, g x) >= e} + SUBSET t /\ + measurable t /\ measure t < e) + sequentially`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `((\n. (lnorm (:real^1) (&2) (\x. (dn:num->real^1->complex) n x - g x)) pow + 2 / e pow 2) ---> &0) sequentially` + ASSUME_TAC THENL + [SUBGOAL_THEN + `(\n. (lnorm (:real^1) (&2) (\x. (dn:num->real^1->complex) n x - g x)) pow + 2 / e pow 2) = + (\n. inv(e pow 2) * (lnorm (:real^1) (&2) (\x. dn n x - g x)) pow 2)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN REWRITE_TAC[real_div] THEN + REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `&0 = inv(e pow 2) * &0` SUBST1_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REALLIM_LMUL THEN MATCH_MP_TAC REALLIM_NULL_POW THEN + ASM_REWRITE_TAC[ARITH]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o REWRITE_RULE[REALLIM_SEQUENTIALLY]) THEN + DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` (fun th -> EXISTS_TAC `N:num` THEN + ASSUME_TAC th)) THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN + REWRITE_TAC[dist] THEN + EXISTS_TAC `{x:real^1 | norm((dn:num->real^1->complex) n x - g x) >= e}` THEN + REWRITE_TAC[IN_UNIV; SUBSET_REFL] THEN CONJ_TAC THENL + [MATCH_MP_TAC L2_SUPERLEVEL_MEASURABLE THEN + ASM_SIMP_TAC[LSPACE_SUB; REAL_ARITH `&0 <= &2`; ETA_AX]; + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `(lnorm (:real^1) (&2) (\x. (dn:num->real^1->complex) n x - g + x)) pow 2 / e pow 2` THEN + CONJ_TAC THENL + [MATCH_MP_TAC MEASURE_L2_DIFF_BOUND THEN ASM_REWRITE_TAC[]; + FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[] THEN + REAL_ARITH_TAC]]);; + +(* L^2-limit g and a.e.-pointwise-limit f of the same sequence agree a.e. *) +(* (via CONVERGENCE_IN_MEASURE: extract an a.e.-convergent subsequence -> g, *) +(* which also -> f pointwise; LIM_UNIQUE pins f = g off the negligible *) +(* union). *) +let L2_AE_LIMIT_UNIQUE = prove + (`!(dn:num->real^1->complex) (g:real^1->complex) (f:real^1->complex) s0. + (!n. dn n IN lspace (:real^1) (&2)) /\ g IN lspace (:real^1) (&2) /\ + ((\n. lnorm (:real^1) (&2) (\x. dn n x - g x)) ---> &0) sequentially /\ + negligible s0 /\ + (!x. ~(x IN s0) ==> ((\n. dn n x) --> f x) sequentially) + ==> negligible {x:real^1 | ~(f x = g x)}`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`dn:num->real^1->complex`; `g:real^1->complex`; + `(:real^1)`] CONVERGENCE_IN_MEASURE) THEN + ASM_SIMP_TAC[L2_LIM_IMP_IN_MEASURE] THEN + ANTS_TAC THENL + [GEN_TAC THEN RULE_ASSUM_TAC(REWRITE_RULE[LSPACE_ALT; IN_ELIM_THM]) THEN + ASM_SIMP_TAC[LSPACE_ALT; IN_ELIM_THM]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `r:num->num` (X_CHOOSE_THEN + `t:real^1->bool` STRIP_ASSUME_TAC)) THEN + MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN + EXISTS_TAC `s0 UNION (t:real^1->bool)` THEN + ASM_SIMP_TAC[NEGLIGIBLE_UNION] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_UNION; DE_MORGAN_THM] THEN + X_GEN_TAC `x:real^1` THEN + GEN_REWRITE_TAC I [GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[DE_MORGAN_THM] THEN STRIP_TAC THEN + SUBGOAL_THEN + `((\n. (dn:num->real^1->complex) n x) --> f x) sequentially` + ASSUME_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL [`\m. (dn:num->real^1->complex) m x`; `r:num->num`; + `(f:real^1->complex) x`] LIM_SUBSEQUENCE) THEN + ASM_REWRITE_TAC[o_DEF] THEN DISCH_TAC THEN + SUBGOAL_THEN + `((\n. (dn:num->real^1->complex) (r n) x) --> g x) sequentially` ASSUME_TAC + THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `x:real^1`) THEN + ASM_REWRITE_TAC[IN_UNIV; IN_DIFF]; ALL_TAC] THEN + ASM_MESON_TAC[LIM_UNIQUE; TRIVIAL_LIMIT_SEQUENTIALLY]);; + +(* ========================================================================= *) +(* 286U(c) CONCRETE (Fremlin 286U): the a.e. window-limit f2 of G REPRESENTS *) +(* the Fourier transform of G. Materializes f2(y) via SELECT from the a.e. *) +(* window-limit (CARLESON_286U_WINDOW_AE_STRONG), proves W_n(y) -> sqrt2pi *) +(* f2(y) sequentially off the badset (WINDOW_RECONCILE_GX + LIM scaling), *) +(* and *) +(* feeds the DCT heart CARLESON_286U_C_ABSTRACT with the concrete dominator *) +(* sqrt2pi Ahat(G) norm h (DOMINATOR_286U_INTEGRABLE) and the window <= *) +(* maximal bound (WINDOW_DOMINATION_BOUND, using the pointwise boundedness *) +(* supplied at the same y). Conclusion: the sqrt2pi-scaled *) +(* representation identity int_R f2 h = int_R G hhat. *) +(* ========================================================================= *) +let WINDOW_TRUNC_INTEGRAL_AS_WN = prove + (`!(G:real^1->complex) n y. + integral (interval[lift(--(&n)), lift(&n)]) + (\x. cexp(--(ii * Cx(drop x) * Cx(drop y))) * G x) = + Cx(sqrt(&2 * pi)) * + fourier (\x. if abs x <= &n then (G:real^1->complex)(lift x) else Cx(&0)) + (drop y)`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN + `(\x:real^1. cexp(--(ii * Cx(drop x) * Cx(drop y))) * (G:real^1->complex) x) + = + (\x. cexp(--(ii * Cx(drop y) * Cx(drop x))) * G x)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:real^1` THEN + AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + SIMPLE_COMPLEX_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPECL [`\u. (G:real^1->complex)(lift u)`; `--(&n):real`; `&n:real`; + `y:real^1`] + CARLESON_TRUNC_AS_FOURIER) THEN + REWRITE_TAC[LIFT_DROP; IMAGE_LIFT_REAL_INTERVAL] THEN + DISCH_THEN(fun th -> GEN_REWRITE_TAC LAND_CONV [th]) THEN + AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `u:real` THEN + REWRITE_TAC[IN_REAL_INTERVAL] THEN + COND_CASES_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC);; + +(* f2 in L^2 (Fremlin 286U / 284Ib: the window-limit representative lies in *) +(* L^2). *) +let WINDOW_LIMIT_L2 = prove + (`!(G:real^1->complex) (f2:real^1->complex) s. + G IN lspace (:real^1) (&2) /\ real_negligible s /\ + (!y. ~(drop y IN s) ==> + ((\n. integral (interval[lift(--(&n)), lift(&n)]) + (\x. cexp(--(ii * Cx(drop x) * Cx(drop y))) * G x)) + --> Cx(sqrt(&2 * pi)) * f2 y) sequentially) + ==> f2 IN lspace (:real^1) (&2)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `G:real^1->complex` WINDOW_TRANSFORM_RIESZ) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `ginf:real^1->complex` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC LSPACE_AE_CONG THEN + EXISTS_TAC `ginf:real^1->complex` THEN ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN + MATCH_MP_TAC L2_AE_LIMIT_UNIQUE THEN + MAP_EVERY EXISTS_TAC + [`\n:num. \z:real^1. fourier (\x. if abs x <= &n then + (G:real^1->complex)(lift x) else Cx(&0)) (drop z)`; + `{y:real^1 | drop y IN s}`] THEN + REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [GEN_TAC THEN BETA_TAC THEN MATCH_MP_TAC WINDOWED_FOURIER_L2 THEN + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN + DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` ASSUME_TAC) THEN EXISTS_TAC `N:num` THEN + X_GEN_TAC `n:num` THEN REWRITE_TAC[GE] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN ANTS_TAC THENL + [ASM_REWRITE_TAC[GE]; ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x = a ==> a < e ==> abs(x - &0) < e`) + THEN + CONJ_TAC THENL + [MATCH_MP_TAC LNORM_POS_LE THEN MATCH_MP_TAC LSPACE_SUB THEN + ASM_REWRITE_TAC[REAL_POS] THEN MATCH_MP_TAC WINDOWED_FOURIER_L2 THEN + ASM_REWRITE_TAC[]; + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + REWRITE_TAC[]]; + SUBGOAL_THEN `{y:real^1 | drop y IN s} = IMAGE lift s` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE] THEN + X_GEN_TAC `y:real^1` THEN EQ_TAC THENL + [DISCH_TAC THEN EXISTS_TAC `drop(y:real^1)` THEN + ASM_REWRITE_TAC[LIFT_DROP]; + STRIP_TAC THEN ASM_REWRITE_TAC[LIFT_DROP]]; ALL_TAC] THEN + UNDISCH_TAC `real_negligible s` THEN REWRITE_TAC[real_negligible]; + X_GEN_TAC `y:real^1` THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `y:real^1`) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[WINDOW_TRUNC_INTEGRAL_AS_WN] THEN + SUBGOAL_THEN `&0 < sqrt(&2 * pi)` ASSUME_TAC THENL + [MATCH_MP_TAC SQRT_POS_LT THEN MP_TAC PI_POS THEN + REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `Cx(inv(sqrt(&2*pi)))` o MATCH_MP + LIM_COMPLEX_LMUL) THEN + SUBGOAL_THEN + `Cx(inv(sqrt(&2*pi))) * Cx(sqrt(&2 * pi)) = Cx(&1)` ASSUME_TAC THENL + [REWRITE_TAC[GSYM CX_MUL; CX_INJ] THEN MATCH_MP_TAC REAL_MUL_LINV THEN + ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `(\n. Cx(inv(sqrt(&2*pi))) * + (\n. Cx (sqrt (&2 * pi)) * + fourier (\x. if abs x <= &n then (G:real^1->complex) (lift x) + else Cx (&0)) (drop y)) n) = + (\n. fourier (\x. if abs x <= &n then (G:real^1->complex) (lift x) else + Cx (&0)) (drop y))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + REWRITE_TAC[COMPLEX_MUL_ASSOC] THEN + ASM_REWRITE_TAC[COMPLEX_MUL_LID]; ALL_TAC] THEN + REWRITE_TAC[COMPLEX_MUL_ASSOC] THEN ASM_REWRITE_TAC[COMPLEX_MUL_LID]]);; + +(* ========================================================================= *) +(* 286V-descent bricks (Fremlin 286V first half): the pieces assembling into *) +(* CARLESON_286U_SINC. *) +(* ========================================================================= *) + +(* STEP A: the Cx-lift of the zero-extension of a square-integrable f is in *) +(* L^2. norm(Cx(f t)) = abs(f t); (abs(f t))^2 = f t^2 integrable on *) +(* [-pi,pi]. *) +let CARLESON_F1_L2 = prove + (`!f. f square_integrable_on real_interval[--pi,pi] + ==> (\z:real^1. if drop z IN real_interval[--pi,pi] then Cx(f(drop z)) + else Cx(&0)) + IN lspace (:real^1) (&2)`, + GEN_TAC THEN REWRITE_TAC[square_integrable_on] THEN STRIP_TAC THEN + REWRITE_TAC[lspace; IN_ELIM_THM] THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM COMPLEX_VEC_0] THEN + SUBGOAL_THEN + `(\z:real^1. if drop z IN real_interval[--pi,pi] then Cx(f(drop z)) else + vec 0) = + (\z. if z IN IMAGE lift (real_interval[--pi,pi]) then (\w. Cx(f(drop w))) + z else vec 0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + REWRITE_TAC[IN_IMAGE_LIFT_DROP; LIFT_DROP]; ALL_TAC] THEN + REWRITE_TAC[MEASURABLE_ON_UNIV] THEN + SUBGOAL_THEN + `(\w:real^1. Cx(f(drop w))) = (\v:real^1. Cx(drop v)) o (\w:real^1. + lift(f(drop w)))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; o_THM; LIFT_DROP]; ALL_TAC] THEN + MATCH_MP_TAC MEASURABLE_ON_COMPOSE_CONTINUOUS_0 THEN REPEAT CONJ_TAC THENL + [UNDISCH_TAC `(f:real->real) real_measurable_on real_interval[--pi,pi]` + THEN + REWRITE_TAC[real_measurable_on; o_DEF]; + MATCH_MP_TAC CONTINUOUS_ON_CX_DROP THEN REWRITE_TAC[CONTINUOUS_ON_ID]; + REWRITE_TAC[DROP_VEC; COMPLEX_VEC_0]]; + SUBGOAL_THEN + `(\x:real^1. lift(norm(if drop x IN real_interval[--pi,pi] then Cx(f(drop + x)) else Cx(&0)) rpow &2)) = + (\x. if drop x IN real_interval[--pi,pi] then lift(f(drop x) pow 2) else + vec 0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:real^1` THEN + COND_CASES_TAC THEN + REWRITE_TAC[COMPLEX_NORM_CX; NORM_0; RPOW_POW] THENL + [REWRITE_TAC[REAL_POW2_ABS]; + REWRITE_TAC[REAL_ABS_NUM; REAL_POW_ZERO; ARITH; LIFT_NUM]]; + ALL_TAC] THEN + SUBGOAL_THEN + `(\x:real^1. if drop x IN real_interval[--pi,pi] then lift(f(drop x) pow + 2) else vec 0) = + (\x. if x IN IMAGE lift (real_interval[--pi,pi]) + then (\w:real^1. lift(f(drop w) pow 2)) x else vec 0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + REWRITE_TAC[IN_IMAGE_LIFT_DROP]; ALL_TAC] THEN + REWRITE_TAC[INTEGRABLE_RESTRICT_UNIV] THEN + UNDISCH_TAC `(\x. f x pow 2) real_integrable_on real_interval[--pi,pi]` + THEN + REWRITE_TAC[REAL_INTEGRABLE_ON; o_DEF]]);; + + +(* STEP B: CONCRETE quantified over ALL test functions h (f2 is *) +(* h-independent, *) +(* being the SELECT of the a.e. window limit). Identical to CARLESON_286U_C_ *) +(* CONCRETE but with the FT-representation given for every Schwartz h. *) +let SINC_REP_EQUALITY = prove + (`!(f1:real^1->complex) (f2:real^1->complex) (g:real^1->complex) + (h:real->complex). + f1 IN lspace (:real^1) (&2) /\ f2 IN lspace (:real^1) (&2) /\ + g IN lspace (:real^1) (&2) /\ schwartz h /\ + integral (:real^1) (\y. h(drop y) * Cx(sqrt(&2 * pi)) * f2 y) = + integral (:real^1) (\x. g x * Cx(sqrt(&2 * pi)) * fourier h (drop x)) /\ + integral (:real^1) (\z. f1 z * h(drop z)) = + integral (:real^1) (\z. g z * fourier h (drop z)) + ==> integral (:real^1) (\z. f2 z * h(drop z)) = + integral (:real^1) (\z. f1 z * h(drop z))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\z:real^1. cnj(h(drop z))) IN lspace (:real^1) (&2)` ASSUME_TAC THENL + [MATCH_MP_TAC LSPACE_CNJ THEN MATCH_MP_TAC SCHWARTZ_L2 THEN + ASM_REWRITE_TAC[ETA_AX]; ALL_TAC] THEN + SUBGOAL_THEN + `(\z:real^1. cnj(fourier h (drop z))) IN lspace (:real^1) (&2)` ASSUME_TAC + THENL + [MATCH_MP_TAC LSPACE_CNJ THEN MATCH_MP_TAC SCHWARTZ_L2 THEN + MP_TAC(ISPEC `fourier(h:real->complex)` SCHWARTZ_CNJ) THEN + ANTS_TAC THENL [MATCH_MP_TAC SCHWARTZ_FOURIER THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[ETA_AX] THEN DISCH_TAC THEN MATCH_MP_TAC SCHWARTZ_FOURIER THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `(\z:real^1. (f2:real^1->complex) z * h(drop z)) integrable_on (:real^1)` + ASSUME_TAC THENL + [MP_TAC(ISPECL [`(:real^1)`; `f2:real^1->complex`; + `\z:real^1. cnj(h(drop z))`] L2_CNJ_PRODUCT_INTEGRABLE) THEN + ASM_REWRITE_TAC[CNJ_CNJ]; ALL_TAC] THEN + SUBGOAL_THEN + `(\z:real^1. (g:real^1->complex) z * fourier h (drop z)) integrable_on + (:real^1)` ASSUME_TAC THENL + [MP_TAC(ISPECL [`(:real^1)`; `g:real^1->complex`; + `\z:real^1. cnj(fourier h (drop z))`] L2_CNJ_PRODUCT_INTEGRABLE) THEN + ASM_REWRITE_TAC[CNJ_CNJ]; ALL_TAC] THEN + SUBGOAL_THEN `~(Cx(sqrt(&2 * pi)) = Cx(&0))` ASSUME_TAC THENL + [REWRITE_TAC[CX_INJ] THEN MATCH_MP_TAC REAL_LT_IMP_NZ THEN + MATCH_MP_TAC SQRT_POS_LT THEN MP_TAC PI_POS THEN + REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `Cx(sqrt(&2*pi)) * integral (:real^1) (\y. (f2:real^1->complex) y * + (h:real->complex)(drop y)) = + Cx(sqrt(&2*pi)) * integral (:real^1) (\x. (g:real^1->complex) x * fourier h + (drop x))` + MP_TAC THENL + [SUBGOAL_THEN + `Cx(sqrt(&2*pi)) * integral (:real^1) (\y. (f2:real^1->complex) y * + (h:real->complex)(drop y)) = + integral (:real^1) (\y. h(drop y) * Cx(sqrt(&2 * pi)) * f2 y)` + SUBST1_TAC THENL + [MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `integral (:real^1) (\y. Cx(sqrt(&2*pi)) * + ((f2:real^1->complex) y * (h:real->complex)(drop y)))` THEN + CONJ_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC INTEGRAL_COMPLEX_LMUL THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC INTEGRAL_EQ THEN GEN_TAC THEN REWRITE_TAC[] THEN + SIMPLE_COMPLEX_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN + `Cx(sqrt(&2*pi)) * integral (:real^1) (\x. (g:real^1->complex) x * fourier + h (drop x)) = + integral (:real^1) (\x. g x * Cx(sqrt(&2 * pi)) * fourier h (drop x))` + SUBST1_TAC THENL + [MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `integral (:real^1) (\x. Cx(sqrt(&2*pi)) * + ((g:real^1->complex) x * fourier h (drop x)))` THEN + CONJ_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC INTEGRAL_COMPLEX_LMUL THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC INTEGRAL_EQ THEN GEN_TAC THEN REWRITE_TAC[] THEN + SIMPLE_COMPLEX_ARITH_TAC]; + ALL_TAC] THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[COMPLEX_EQ_MUL_LCANCEL] THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN + ASM_MESON_TAC[]);; + +(* R2: sinc kernel times f is real-integrable on [-pi,pi] *) +(* (bounded*measurable*abs-int). *) +let SINC_KERNEL_TIMES_F_INTEGRABLE = prove + (`!(f:real->real) a x. + &0 < a /\ f square_integrable_on real_interval[--pi,pi] + ==> (\t. f t * sin(a * (x - t)) / (x - t)) real_integrable_on + real_interval[--pi,pi]`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE THEN + SUBGOAL_THEN + `(\t. (f:real->real) t * sin(a * (x - t)) / (x - t)) = + (\t. (\u. sin(a * (x - u)) / (x - u)) t * f t)` + SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM] THEN REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_IMP_REAL_MEASURABLE THEN + SUBGOAL_THEN + `(\u. sin(a * (x - u)) / (x - u)) = (\u. (\t. sin(a * t) / t) (x - u))` + SUBST1_TAC THENL [REWRITE_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL [`\t. sin(a * t) / t`; `x - pi:real`; `x + pi:real`; + `-- &1:real`; `x:real`] + REAL_INTEGRABLE_AFFINITY) THEN + REWRITE_TAC[REAL_ARITH `-- &1 * u + x = x - u`; + REAL_ARITH `inv(-- &1) * (u - x) = x - u`] THEN + ANTS_TAC THENL + [REWRITE_TAC[REAL_ARITH `~(-- &1 = &0)`] THEN + MATCH_MP_TAC SIN_STRETCH_OVER_X_INTEGRABLE THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `IMAGE (\x'. x - x') (real_interval [x - pi,x + pi]) = + real_interval[--pi,pi]` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_REAL_INTERVAL] THEN + X_GEN_TAC `u:real` THEN EQ_TAC THENL + [STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + DISCH_TAC THEN EXISTS_TAC `x - u:real` THEN ASM_REAL_ARITH_TAC]; + DISCH_THEN ACCEPT_TAC]; + REWRITE_TAC[REAL_BOUNDED_POS] THEN EXISTS_TAC `a:real` THEN + ASM_REWRITE_TAC[FORALL_IN_IMAGE] THEN X_GEN_TAC `u:real` THEN + DISCH_TAC THEN + ASM_CASES_TAC `u:real = x` THENL + [ASM_REWRITE_TAC[REAL_SUB_REFL; real_div; REAL_INV_0; REAL_MUL_RZERO; + SIN_0] THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[real_div] THEN + MP_TAC(ISPECL [`a:real`; `x - u:real`] SINC_ABS_BOUND) THEN + ASM_REWRITE_TAC[REAL_SUB_0] THEN ASM_SIMP_TAC[EQ_SYM_EQ]]; + MATCH_MP_TAC SQUARE_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE THEN + ASM_REWRITE_TAC[REAL_MEASURABLE_REAL_INTERVAL]]);; + +(* R2: collapse int_R f1.Cx(sinc) = Cx(real_integral[-pi,pi] f.sinc), f1 the *) +(* Cx-ext. *) +let SINC_F1_INTEGRAL_COLLAPSE = prove + (`!(f:real->real) a x. + (\t. f t * sin(a * (x - t)) / (x - t)) real_integrable_on + real_interval[--pi,pi] + ==> integral (:real^1) + (\z. (if drop z IN real_interval[--pi,pi] then Cx(f(drop z)) else + Cx(&0)) * + Cx(sin(a * (x - drop z)) / (x - drop z))) = + Cx(real_integral (real_interval[--pi,pi]) + (\t. f t * sin(a * (x - t)) / (x - t)))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\z:real^1. (if drop z IN real_interval[--pi,pi] then Cx(f(drop z)) else + Cx(&0)) * + Cx(sin(a * (x - drop z)) / (x - drop z))) = + (\z. if z IN IMAGE lift (real_interval[--pi,pi]) + then (\w. Cx(f(drop w) * (sin(a * (x - drop w)) / (x - drop w)))) z + else vec 0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + REWRITE_TAC[IN_IMAGE_LIFT_DROP] THEN + COND_CASES_TAC THEN + REWRITE_TAC[GSYM CX_MUL; COMPLEX_VEC_0; COMPLEX_MUL_LZERO]; ALL_TAC] THEN + GEN_REWRITE_TAC (LAND_CONV) [INTEGRAL_RESTRICT_UNIV] THEN + MP_TAC(ISPECL [`\t. f t * sin(a * (x - t)) / (x - t)`; + `real_interval[--pi,pi]`] CX_REAL_INTEGRAL_BRIDGE) THEN + REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[REAL_MUL_ASSOC]);; + + +(* Clean f2-rep for all k: from the scaled ALLH/FULL rep (int k.sqrt2pi.f2 = *) +(* int g.sqrt2pi.fourier k), derive int f2.k = int g.fourier k (factor + *) +(* cancel). *) +let SINC_F2_CLEAN_REP = prove + (`!(f2:real^1->complex) (g:real^1->complex) (k:real->complex). + f2 IN lspace (:real^1) (&2) /\ g IN lspace (:real^1) (&2) /\ schwartz k /\ + integral (:real^1) (\y. k(drop y) * Cx(sqrt(&2 * pi)) * f2 y) = + integral (:real^1) (\x. g x * Cx(sqrt(&2 * pi)) * fourier k (drop x)) + ==> integral (:real^1) (\z. f2 z * k(drop z)) = + integral (:real^1) (\z. g z * fourier k (drop z))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\z:real^1. cnj(k(drop z))) IN lspace (:real^1) (&2)` ASSUME_TAC THENL + [MATCH_MP_TAC LSPACE_CNJ THEN MATCH_MP_TAC SCHWARTZ_L2 THEN + ASM_REWRITE_TAC[ETA_AX]; ALL_TAC] THEN + SUBGOAL_THEN + `(\z:real^1. cnj(fourier k (drop z))) IN lspace (:real^1) (&2)` ASSUME_TAC + THENL + [MATCH_MP_TAC LSPACE_CNJ THEN MATCH_MP_TAC SCHWARTZ_L2 THEN + MP_TAC(ISPEC `fourier(k:real->complex)` SCHWARTZ_CNJ) THEN + ANTS_TAC THENL [MATCH_MP_TAC SCHWARTZ_FOURIER THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[ETA_AX] THEN DISCH_TAC THEN MATCH_MP_TAC SCHWARTZ_FOURIER THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `(\z:real^1. (f2:real^1->complex) z * k(drop z)) integrable_on (:real^1)` + ASSUME_TAC THENL + [MP_TAC(ISPECL [`(:real^1)`; `f2:real^1->complex`; + `\z:real^1. cnj(k(drop z))`] L2_CNJ_PRODUCT_INTEGRABLE) THEN + ASM_REWRITE_TAC[CNJ_CNJ]; ALL_TAC] THEN + SUBGOAL_THEN + `(\z:real^1. (g:real^1->complex) z * fourier k (drop z)) integrable_on + (:real^1)` ASSUME_TAC THENL + [MP_TAC(ISPECL [`(:real^1)`; `g:real^1->complex`; + `\z:real^1. cnj(fourier k (drop z))`] L2_CNJ_PRODUCT_INTEGRABLE) THEN + ASM_REWRITE_TAC[CNJ_CNJ]; ALL_TAC] THEN + SUBGOAL_THEN `~(Cx(sqrt(&2 * pi)) = Cx(&0))` ASSUME_TAC THENL + [REWRITE_TAC[CX_INJ] THEN MATCH_MP_TAC REAL_LT_IMP_NZ THEN + MATCH_MP_TAC SQRT_POS_LT THEN MP_TAC PI_POS THEN + REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `Cx(sqrt(&2*pi)) * integral (:real^1) (\y. (f2:real^1->complex) y * + (k:real->complex)(drop y)) = + Cx(sqrt(&2*pi)) * integral (:real^1) (\x. (g:real^1->complex) x * fourier k + (drop x))` + MP_TAC THENL + [SUBGOAL_THEN + `Cx(sqrt(&2*pi)) * integral (:real^1) (\y. (f2:real^1->complex) y * + (k:real->complex)(drop y)) = + integral (:real^1) (\y. k(drop y) * Cx(sqrt(&2 * pi)) * f2 y)` + SUBST1_TAC THENL + [MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `integral (:real^1) (\y. Cx(sqrt(&2*pi)) * + ((f2:real^1->complex) y * (k:real->complex)(drop y)))` THEN + CONJ_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC INTEGRAL_COMPLEX_LMUL THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC INTEGRAL_EQ THEN GEN_TAC THEN REWRITE_TAC[] THEN + SIMPLE_COMPLEX_ARITH_TAC]; ALL_TAC] THEN + SUBGOAL_THEN + `Cx(sqrt(&2*pi)) * integral (:real^1) (\x. (g:real^1->complex) x * fourier + k (drop x)) = + integral (:real^1) (\x. g x * Cx(sqrt(&2 * pi)) * fourier k (drop x))` + SUBST1_TAC THENL + [MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `integral (:real^1) (\x. Cx(sqrt(&2*pi)) * + ((g:real^1->complex) x * fourier k (drop x)))` THEN + CONJ_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC INTEGRAL_COMPLEX_LMUL THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC INTEGRAL_EQ THEN GEN_TAC THEN REWRITE_TAC[] THEN + SIMPLE_COMPLEX_ARITH_TAC]; ALL_TAC] THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[COMPLEX_EQ_MUL_LCANCEL] THEN ASM_REWRITE_TAC[]);; + + +(* CARLESON_286U_C_FULL = ALLH + the at_posinfinity window limit for f2 (3rd *) +(* conjunct). *) +let CARLESON_286U_C_FULL = prove + (`!(G:real^1->complex) C10. + &0 <= C10 /\ G IN lspace (:real^1) (&2) /\ + (!(k:real->complex) GG. schwartz k /\ real_measurable GG + ==> real_integral GG (carleson_Ahat k) + <= C10 * lnorm (:real^1) (&2) (\z. k(drop z)) * sqrt(real_measure + GG)) + ==> ?f2 s. real_negligible s /\ + (!y. ~(drop y IN s) ==> + ((\a. Cx(inv(sqrt(&2 * pi))) * + integral (IMAGE lift (real_interval[--a,a])) + (\x. cexp(--(ii * Cx(drop y) * Cx(drop x))) * G x)) --> f2 + y) + at_posinfinity) /\ + (!h. schwartz h + ==> integral (:real^1) (\y. h(drop y) * Cx(sqrt(&2 * pi)) * f2 y) + = + integral (:real^1) (\x. G x * Cx(sqrt(&2 * pi)) * fourier h + (drop x)))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\u. (G:real^1->complex)(lift u)`; + `C10:real`] CARLESON_286U_WINDOW_AE_STRONG) THEN + ASM_REWRITE_TAC[LIFT_DROP; ETA_AX] THEN + DISCH_THEN(X_CHOOSE_THEN `s:real->bool` STRIP_ASSUME_TAC) THEN + ABBREV_TAC + `f2 = \y:real^1. (@z. ((\a. Cx(inv(sqrt(&2 * pi))) * + integral (IMAGE lift (real_interval[--a,a])) + (\x. cexp(--(ii * Cx(drop y) * Cx(drop x))) * + (G:real^1->complex) x)) --> z) + at_posinfinity)` THEN + EXISTS_TAC `f2:real^1->complex` THEN EXISTS_TAC `s:real->bool` THEN + ASM_REWRITE_TAC[] THEN + (* the at_posinfinity limit conjunct: f2 y = the SELECT, extract the limit *) + SUBGOAL_THEN + `!y:real^1. ~(drop y IN s) ==> + ((\a. Cx(inv(sqrt(&2 * pi))) * + integral (IMAGE lift (real_interval[--a,a])) + (\x. cexp(--(ii * Cx(drop y) * Cx(drop x))) * + (G:real^1->complex) x)) --> f2 y) + at_posinfinity` + ASSUME_TAC THENL + [X_GEN_TAC `y:real^1` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `drop(y:real^1)`) THEN + ASM_REWRITE_TAC[LIFT_DROP] THEN + DISCH_THEN(X_CHOOSE_TAC `z:complex` o CONJUNCT2) THEN + EXPAND_TAC "f2" THEN REWRITE_TAC[] THEN + CONV_TAC SELECT_CONV THEN EXISTS_TAC `z:complex` THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN X_GEN_TAC `h:real->complex` THEN DISCH_TAC THEN + MATCH_MP_TAC CARLESON_286U_C_ABSTRACT THEN + MAP_EVERY EXISTS_TAC + [`{y:real^1 | drop y IN s}`; + `\y:real^1. lift(sqrt(&2 * pi) * carleson_Ahat (\u. + (G:real^1->complex)(lift u)) (drop y) * norm((h:real->complex)(drop + y)))`] THEN + ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [SUBGOAL_THEN `{y:real^1 | drop y IN s} = IMAGE lift s` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE] THEN + X_GEN_TAC `y:real^1` THEN EQ_TAC THENL + [DISCH_TAC THEN EXISTS_TAC `drop(y:real^1)` THEN + ASM_REWRITE_TAC[LIFT_DROP]; + STRIP_TAC THEN ASM_REWRITE_TAC[LIFT_DROP]]; ALL_TAC] THEN + ASM_MESON_TAC[real_negligible]; + MATCH_MP_TAC DOMINATOR_286U_INTEGRABLE THEN EXISTS_TAC `C10:real` THEN + ASM_REWRITE_TAC[]; + X_GEN_TAC `n:num` THEN X_GEN_TAC `y:real^1` THEN + REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN + REWRITE_TAC[LIFT_DROP; COMPLEX_NORM_MUL] THEN + SUBGOAL_THEN + `sqrt(&2 * pi) * carleson_Ahat (\u. (G:real^1->complex)(lift u)) (drop y) + * norm((h:real->complex)(drop y)) = + norm(h(drop y)) * (sqrt(&2 * pi) * carleson_Ahat (\u. G(lift u)) (drop + y))` + SUBST1_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[NORM_POS_LE] THEN + MP_TAC(ISPECL [`G:real^1->complex`; `y:real^1`; + `n:num`] WINDOW_DOMINATION_BOUND) THEN + ANTS_TAC THENL + [MP_TAC(ISPECL [`\u. (G:real^1->complex)(lift u)`; `drop(y:real^1)`] + CARLESON_TRUNC_FAMILY_PLAIN_WINDOW_BOUND) THEN + REWRITE_TAC[LIFT_DROP; ETA_AX] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `drop(y:real^1)`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(ACCEPT_TAC o CONJUNCT1); + DISCH_TAC THEN + SUBGOAL_THEN `&0 < sqrt(&2 * pi)` ASSUME_TAC THENL + [MATCH_MP_TAC SQRT_POS_LT THEN MP_TAC PI_POS THEN + REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `norm(integral (interval[lift(--(&n)), lift(&n)]) + (\x. cexp(--(ii * Cx(drop x) * Cx(drop(y:real^1)))) * + (G:real^1->complex) x)) = + sqrt(&2 * pi) * (inv(sqrt(&2 * pi)) * + norm(integral (interval[lift(--(&n)), lift(&n)]) + (\x. cexp(--(ii * Cx(drop x) * Cx(drop y))) * G x)))` + SUBST1_TAC THENL + [SUBGOAL_THEN `sqrt(&2 * pi) * inv(sqrt(&2 * pi)) = &1` MP_TAC THENL + [MATCH_MP_TAC REAL_MUL_RINV THEN + ASM_REAL_ARITH_TAC; CONV_TAC REAL_FIELD]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC]; + X_GEN_TAC `y:real^1` THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN + MATCH_MP_TAC LIM_COMPLEX_LMUL THEN + (* the sequential window limit for the C_ABSTRACT hyp: derive from the *) + (* at_posinf one *) + FIRST_X_ASSUM(MP_TAC o SPEC `y:real^1`) THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN + SUBGOAL_THEN + `!n. integral (interval[lift(--(&n)), lift(&n)]) + (\x. cexp(--(ii * Cx(drop x) * Cx(drop(y:real^1)))) * + (G:real^1->complex) x) = + Cx(sqrt(&2 * pi)) * + (\a. Cx(inv(sqrt(&2 * pi))) * + integral (IMAGE lift (real_interval[--a,a])) + (\x. cexp(--(ii * Cx(drop y) * Cx(drop x))) * G x)) (&n)` + (fun th -> REWRITE_TAC[th]) THENL + [GEN_TAC THEN REWRITE_TAC[] THEN CONV_TAC SYM_CONV THEN + REWRITE_TAC[WINDOW_RECONCILE_GX]; ALL_TAC] THEN + MATCH_MP_TAC LIM_COMPLEX_LMUL THEN + MATCH_MP_TAC LIM_POSINFINITY_SEQUENTIALLY THEN ASM_REWRITE_TAC[]]);; + + +(* 286U-driven continuous-sinc convergence a.e. (Fremlin 286V lines 3056- *) +(* 3087): extend f to f_1 (0 off [-pi,pi]); let g in L^2 represent the *) +(* (inverse) Fourier transform of f_1 (PLANCHEREL_L2/284O). 286U gives *) +(* f_2(x)=lim_a (1/sqrt2pi)int_{-a}^a e^{-ixy}g = f_1(x) a.e. (284Ib); the *) +(* sinc algebra rewrites int_{-a}^a e^{-ixy}g = (2/sqrt2pi)int_{-pi}^pi *) +(* sin(a(x-t))/(x-t)f(t)dt, giving the continuous sinc limit for f. This is *) +(* the analytic heart (286U maximal-inequality a.e.-existence + sinc calc). *) +let CARLESON_286U_SINC = prove + (`!f. f square_integrable_on real_interval[--pi,pi] /\ + (!x. f(x + &2 * pi) = f x) + ==> ?s. real_negligible s /\ + !x. --pi < x /\ x < pi /\ ~(x IN s) + ==> ((\a. inv(pi) * + real_integral (real_interval[--pi,pi]) + (\t. sin(a * (x - t)) / (x - t) * f t)) + ---> f x) at_posinfinity`, + + GEN_TAC THEN STRIP_TAC THEN + MP_TAC(ISPEC `f:real->real` CARLESON_F1_L2) THEN ASM_REWRITE_TAC[] THEN + ABBREV_TAC `f1 = \z:real^1. if drop z IN real_interval[--pi,pi] then + Cx(f(drop z)) else Cx(&0)` THEN + DISCH_TAC THEN + FIRST_ASSUM(X_CHOOSE_THEN + `g:real^1->complex` STRIP_ASSUME_TAC o MATCH_MP FOURIER_L2_REP_INV) THEN + X_CHOOSE_THEN `C10:real` STRIP_ASSUME_TAC CARLESON_286T_SCHWARTZ THEN + MP_TAC(ISPECL [`g:real^1->complex`; `C10:real`] CARLESON_286U_C_FULL) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `f2:real^1->complex` (X_CHOOSE_THEN + `sw:real->bool` STRIP_ASSUME_TAC)) THEN + (* sequential window limit for f2 (WINDOW_LIMIT_L2's hyp form) from the *) + (* at_posinf one *) + SUBGOAL_THEN + `!y:real^1. ~(drop y IN sw) ==> + ((\n. integral (interval[lift(--(&n)), lift(&n)]) + (\x. cexp(--(ii * Cx(drop x) * Cx(drop y))) * + (g:real^1->complex) x)) + --> Cx(sqrt(&2 * pi)) * f2 y) sequentially` + ASSUME_TAC THENL + [X_GEN_TAC `y:real^1` THEN DISCH_TAC THEN + SUBGOAL_THEN + `!n. integral (interval[lift(--(&n)), lift(&n)]) + (\x. cexp(--(ii * Cx(drop x) * Cx(drop(y:real^1)))) * + (g:real^1->complex) x) = + Cx(sqrt(&2 * pi)) * + (\a. Cx(inv(sqrt(&2 * pi))) * + integral (IMAGE lift (real_interval[--a,a])) + (\x. cexp(--(ii * Cx(drop y) * Cx(drop x))) * g x)) (&n)` + (fun th -> REWRITE_TAC[th]) THENL + [GEN_TAC THEN REWRITE_TAC[] THEN CONV_TAC SYM_CONV THEN + REWRITE_TAC[WINDOW_RECONCILE_GX]; ALL_TAC] THEN + MATCH_MP_TAC LIM_COMPLEX_LMUL THEN + MATCH_MP_TAC LIM_POSINFINITY_SEQUENTIALLY THEN + FIRST_X_ASSUM(MP_TAC o SPEC `y:real^1`) THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + (* f2 in L2 *) + SUBGOAL_THEN `(f2:real^1->complex) IN lspace (:real^1) (&2)` ASSUME_TAC THENL + [MATCH_MP_TAC WINDOW_LIMIT_L2 THEN + MAP_EVERY EXISTS_TAC [`g:real^1->complex`; `sw:real->bool`] THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + (* clean f2-rep for all k *) + SUBGOAL_THEN + `!k. schwartz k ==> integral (:real^1) (\z. (f2:real^1->complex) z * k(drop + z)) = + integral (:real^1) (\z. (g:real^1->complex) z * fourier + k (drop z))` + ASSUME_TAC THENL + [X_GEN_TAC `k:real->complex` THEN DISCH_TAC THEN + MATCH_MP_TAC SINC_F2_CLEAN_REP THEN + ASM_SIMP_TAC[]; ALL_TAC] THEN + (* f2 = f1 a.e. *) + SUBGOAL_THEN + `negligible {x:real^1 | ~((f2:real^1->complex) x = f1 x)}` ASSUME_TAC THENL + [MATCH_MP_TAC FOURIER_L2_UNIQUE THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `h:real->complex` THEN DISCH_TAC THEN + MATCH_MP_TAC SINC_REP_EQUALITY THEN EXISTS_TAC `g:real^1->complex` THEN + ASM_SIMP_TAC[]; ALL_TAC] THEN + (* badset + per-x sinc limit *) + EXISTS_TAC `sw UNION {x:real | ~((f2:real^1->complex)(lift x) = f1(lift x))}` + THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_NEGLIGIBLE_UNION THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + REWRITE_TAC[real_negligible] THEN MATCH_MP_TAC NEGLIGIBLE_SUBSET THEN + EXISTS_TAC `{x:real^1 | ~((f2:real^1->complex) x = f1 x)}` THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[SUBSET; IN_IMAGE; IN_ELIM_THM] THEN + X_GEN_TAC `z:real^1` THEN STRIP_TAC THEN + ASM_REWRITE_TAC[LIFT_DROP]]; ALL_TAC] THEN + X_GEN_TAC `x:real` THEN + REWRITE_TAC[IN_UNION; DE_MORGAN_THM; IN_ELIM_THM] THEN STRIP_TAC THEN + (* the (1/pi) int f2.sinc at_posinf limit via R2-core *) + (* (SINC_WINDOW_IDENTITY + transfer) *) + SUBGOAL_THEN + `((\a. Cx(inv pi) * + integral (:real^1) (\z. (f2:real^1->complex) z * Cx(sin(a * (x - drop + z)) / (x - drop z)))) + --> f2(lift x)) at_posinfinity` + ASSUME_TAC THENL + [MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN + EXISTS_TAC + `\a. Cx(inv(sqrt(&2 * pi))) * + integral (IMAGE lift (real_interval[--a,a])) + (\z. cexp(--(ii * Cx x * Cx(drop z))) * (g:real^1->complex) z)` + THEN + CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_AT_POSINFINITY] THEN EXISTS_TAC `&0` THEN + X_GEN_TAC `a:real` THEN DISCH_TAC THEN + MATCH_MP_TAC SINC_WINDOW_IDENTITY THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `a >= &0` THEN REAL_ARITH_TAC; + UNDISCH_TAC + `!y:real^1. ~(drop y IN sw) + ==> ((\a. Cx (inv (sqrt (&2 * pi))) * + integral (IMAGE lift (real_interval [--a,a])) + (\x. cexp (--(ii * Cx (drop y) * Cx (drop x))) * + (g:real^1->complex) x)) --> + f2 y) at_posinfinity` THEN + DISCH_THEN(MP_TAC o SPEC `lift x`) THEN REWRITE_TAC[LIFT_DROP] THEN + ASM_REWRITE_TAC[]]; ALL_TAC] THEN + (* f2(lift x) = Cx(f x) (specific point, off the badset) *) + SUBGOAL_THEN `(f2:real^1->complex)(lift x) = Cx(f x)` ASSUME_TAC THENL + [ASM_REWRITE_TAC[] THEN EXPAND_TAC "f1" THEN REWRITE_TAC[LIFT_DROP] THEN + COND_CASES_TAC THENL + [REWRITE_TAC[]; + POP_ASSUM MP_TAC THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN + ASM_REAL_ARITH_TAC]; ALL_TAC] THEN + (* replace f2 by f1 in the integral (INTEGRAL_SPIKE) + collapse to real, *) + (* eventually a>0 *) + ONCE_REWRITE_TAC[REALLIM_COMPLEX] THEN REWRITE_TAC[o_DEF] THEN + MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN + EXISTS_TAC + `\a. Cx(inv pi) * + integral (:real^1) (\z. (f2:real^1->complex) z * Cx(sin(a * (x - drop + z)) / (x - drop z)))` THEN + CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_AT_POSINFINITY] THEN EXISTS_TAC `&1` THEN + X_GEN_TAC `a:real` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + (* int f2.sinc = int f1.sinc (SPIKE) = Cx(real_int f.sinc) (COLLAPSE); *) + (* then Cx(inv pi)*Cx r = Cx(inv pi * r) *) + SUBGOAL_THEN + `integral (:real^1) (\z. (f2:real^1->complex) z * Cx(sin(a * (x - drop z)) + / (x - drop z))) = + integral (:real^1) (\z. (f1:real^1->complex) z * Cx(sin(a * (x - drop z)) + / (x - drop z)))` + SUBST1_TAC THENL + [MATCH_MP_TAC INTEGRAL_SPIKE THEN + EXISTS_TAC `{x:real^1 | ~((f2:real^1->complex) x = f1 x)}` THEN + ASM_REWRITE_TAC[] THEN X_GEN_TAC `z:real^1` THEN + REWRITE_TAC[IN_DIFF; IN_UNIV; IN_ELIM_THM] THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[]; ALL_TAC] THEN + EXPAND_TAC "f1" THEN + MP_TAC(ISPECL [`f:real->real`; `a:real`; + `x:real`] SINC_F1_INTEGRAL_COLLAPSE) THEN + ANTS_TAC THENL + [MATCH_MP_TAC SINC_KERNEL_TIMES_F_INTEGRABLE THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `a >= &1` THEN REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[GSYM CX_MUL] THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN REAL_ARITH_TAC; + FIRST_ASSUM(SUBST1_TAC o SYM o + check(fun th -> concl th = `(f2:real^1->complex)(lift x) = Cx(f x)`)) + THEN + FIRST_ASSUM ACCEPT_TAC]);; + +(* ========================================================================= *) +(* Carleson's theorem, Fourier-series form (Fremlin 286V). *) +(* *) +(* The Fourier series of a square-integrable, 2*pi-periodic function *) +(* converges to it almost everywhere. Stated in the exact vocabulary of *) +(* 100/fourier.ml (fourier_coefficient / trigonometric_set / partial sums), *) +(* with "almost everywhere" expressed via real_negligible. *) +(* ========================================================================= *) + +let CARLESON_THEOREM = prove + (`!f. f square_integrable_on real_interval[--pi,pi] /\ + (!x. f(x + &2 * pi) = f x) + ==> ?s. real_negligible s /\ + !x. ~(x IN s) + ==> ((\n. sum(0..n) (\k. fourier_coefficient f k * + trigonometric_set k x)) + ---> f x) sequentially`, + GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC CARLESON_286V_FROM_CONTINUOUS_SINC THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC CARLESON_286U_SINC THEN ASM_REWRITE_TAC[]);; diff --git a/Autoformalization/fifteen_theorem.ml b/Autoformalization/fifteen_theorem.ml new file mode 100644 index 00000000..e7bc0ab7 --- /dev/null +++ b/Autoformalization/fifteen_theorem.ml @@ -0,0 +1,28158 @@ +(* ========================================================================= *) +(* Conway--Schneeberger Fifteen Theorem. *) +(* *) +(* This file proves that a positive-definite integral quadratic form *) +(* represents every positive integer if and only if it represents every *) +(* positive integer up to 15. Here "integral" means that the Gram matrix *) +(* has integer entries, so the associated quadratic polynomial has even *) +(* cross coefficients. *) +(* *) +(* The organizing argument follows Manjul Bhargava, "On the *) +(* Conway-Schneeberger Fifteen Theorem", in Quadratic Forms and Their *) +(* Applications, Contemporary Mathematics 272 (2000), 27--37. In *) +(* particular, it uses Bhargava's truants, escalator lattices, nine ternary *) +(* escalators, and the rank-four closure summarized in his tables. Conway's *) +(* preceding article in the same volume gives historical context and an *) +(* account of the original Conway--Schneeberger proof. *) +(* *) +(* The ternary representation results are formalized constructively from *) +(* classical methods and results in: *) +(* *) +(* L. E. Dickson, "Integers Represented by Positive Ternary Quadratic *) +(* Forms" (1927); *) +(* *) +(* B. W. Jones, "The Regularity of a Genus of Positive Ternary *) +(* Quadratic Forms" (1931); *) +(* *) +(* B. W. Jones and Gordon Pall, "Regular and Semi-Regular Positive *) +(* Ternary Quadratic Forms"; *) +(* *) +(* Gordon Pall, "Representation by Quadratic Forms" (1949), and "An *) +(* Almost Universal Form"; and *) +(* *) +(* Irving Kaplansky, "The First Nontrivial Genus of Positive Definite *) +(* Ternary Forms" (1995). *) +(* *) +(* The proof has the following shape. A form representing the required *) +(* small integers contains one of the nine ternary escalator forms. Each *) +(* ternary node is escalated once more. Positivity, integral changes of *) +(* basis, and explicit square bounds reduce the resulting rank-four forms *) +(* to finitely many families. Their universality is proved using regular *) +(* ternary subforms, Legendre's three-squares theorem, Dirichlet-prime and *) +(* genus arguments for determinants 3, 5, and 7, elementary descent, and *) +(* finite certificates for the remaining small targets. Universality then *) +(* passes from the embedded rank-four form to the original form. The reverse *) +(* implication in the final equivalence is immediate. *) +(* ========================================================================= *) + +needs "Library/isum.ml";; +needs "Autoformalization/three_squares.ml";; + +prioritize_int();; + +let qindex = new_definition + `qindex n = {i:num | i < n}`;; + +let FINITE_QINDEX = prove + (`!n. FINITE(qindex n)`, + REWRITE_TAC[qindex; FINITE_NUMSEG_LT]);; + +let iqbilin = new_definition + `iqbilin n (A:num->num->int) (x:num->int) (y:num->int) = + isum (qindex n) + (\i. isum (qindex n) (\j. A i j * x i * y j))`;; + +let iqeval = new_definition + `iqeval n (A:num->num->int) (x:num->int) = iqbilin n A x x`;; + +let iq_symmetric = new_definition + `iq_symmetric n (A:num->num->int) <=> + !i j. i < n /\ j < n ==> A i j = A j i`;; + +let iq_nonzero = new_definition + `iq_nonzero n (x:num->int) <=> ?i. i < n /\ ~(x i = &0)`;; + +let iq_positive = new_definition + `iq_positive n (A:num->num->int) <=> + !x. iq_nonzero n x ==> &0 < iqeval n A x`;; + +let iq_represents = new_definition + `iq_represents n (A:num->num->int) m <=> + ?x. iqeval n A x = m`;; + +let iq_universal = new_definition + `iq_universal n (A:num->num->int) <=> + !m:int. &0 < m ==> iq_represents n A m`;; + +let iqgram = new_definition + `iqgram n (A:num->num->int) (V:num->num->int) i j = + iqbilin n A (V i) (V j)`;; + +let iq_embeds = new_definition + `iq_embeds n d (P:num->num->int) (A:num->num->int) <=> + ?V. !i j. i < d /\ j < d ==> iqgram n A V i j = P i j`;; + +let iqcombine = new_definition + `iqcombine d (c:num->int) (V:num->num->int) k = + isum (qindex d) (\i. c i * V i k)`;; + +(* ------------------------------------------------------------------------- *) +(* Bilinearity and symmetry. *) +(* ------------------------------------------------------------------------- *) + +let IQBILIN_LADD = prove + (`!n A x y z. + iqbilin n A (\i. x i + y i) z = + iqbilin n A x z + iqbilin n A y z`, + REPEAT GEN_TAC THEN REWRITE_TAC[iqbilin] THEN + SIMP_TAC[GSYM ISUM_ADD; FINITE_QINDEX] THEN + MATCH_MP_TAC ISUM_EQ THEN REWRITE_TAC[qindex; IN_ELIM_THM] THEN + REPEAT STRIP_TAC THEN + MATCH_MP_TAC ISUM_EQ THEN REWRITE_TAC[qindex; IN_ELIM_THM] THEN + REPEAT STRIP_TAC THEN INT_ARITH_TAC);; + +let IQBILIN_RADD = prove + (`!n A x y z. + iqbilin n A x (\i. y i + z i) = + iqbilin n A x y + iqbilin n A x z`, + REPEAT GEN_TAC THEN REWRITE_TAC[iqbilin] THEN + SIMP_TAC[GSYM ISUM_ADD; FINITE_QINDEX] THEN + MATCH_MP_TAC ISUM_EQ THEN REWRITE_TAC[qindex; IN_ELIM_THM] THEN + REPEAT STRIP_TAC THEN + MATCH_MP_TAC ISUM_EQ THEN REWRITE_TAC[qindex; IN_ELIM_THM] THEN + REPEAT STRIP_TAC THEN INT_ARITH_TAC);; + +let IQBILIN_LMUL = prove + (`!n A a x y. + iqbilin n A (\i. a * x i) y = a * iqbilin n A x y`, + REPEAT GEN_TAC THEN REWRITE_TAC[iqbilin] THEN + REWRITE_TAC[GSYM ISUM_LMUL] THEN + MATCH_MP_TAC ISUM_EQ THEN REWRITE_TAC[qindex; IN_ELIM_THM] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM ISUM_LMUL] THEN + MATCH_MP_TAC ISUM_EQ THEN REWRITE_TAC[qindex; IN_ELIM_THM] THEN + REPEAT STRIP_TAC THEN INT_ARITH_TAC);; + +let IQBILIN_RMUL = prove + (`!n A a x y. + iqbilin n A x (\i. a * y i) = a * iqbilin n A x y`, + REPEAT GEN_TAC THEN REWRITE_TAC[iqbilin] THEN + REWRITE_TAC[GSYM ISUM_LMUL] THEN + MATCH_MP_TAC ISUM_EQ THEN REWRITE_TAC[qindex; IN_ELIM_THM] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM ISUM_LMUL] THEN + MATCH_MP_TAC ISUM_EQ THEN REWRITE_TAC[qindex; IN_ELIM_THM] THEN + REPEAT STRIP_TAC THEN INT_ARITH_TAC);; + +let IQBILIN_SYM = prove + (`!n A x y. + iq_symmetric n A ==> iqbilin n A x y = iqbilin n A y x`, + REPEAT GEN_TAC THEN REWRITE_TAC[iq_symmetric; iqbilin] THEN DISCH_TAC THEN + TRANS_TAC EQ_TRANS + `isum (qindex n) + (\j. isum (qindex n) (\i. A i j * y i * x j))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC ISUM_EQ THEN REWRITE_TAC[qindex; IN_ELIM_THM] THEN + X_GEN_TAC `i:num` THEN DISCH_TAC THEN + MATCH_MP_TAC ISUM_EQ THEN REWRITE_TAC[qindex; IN_ELIM_THM] THEN + X_GEN_TAC `j:num` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`i:num`; `j:num`]) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN CONV_TAC INT_RING; + MP_TAC(ISPECL + [`\j:num. \i:num. + (A:num->num->int) i j * (y:num->int) i * (x:num->int) j`; + `qindex n:num->bool`; `qindex n:num->bool`] ISUM_SWAP) THEN + REWRITE_TAC[FINITE_QINDEX]]);; + +let IQEVAL_COMBO = prove + (`!n A a b x y. + iq_symmetric n A + ==> iqeval n A (\i. a * x i + b * y i) = + a pow 2 * iqeval n A x + + &2 * a * b * iqbilin n A x y + + b pow 2 * iqeval n A y`, + REPEAT STRIP_TAC THEN REWRITE_TAC[iqeval; IQBILIN_LADD; IQBILIN_RADD; + IQBILIN_LMUL; IQBILIN_RMUL] THEN + MP_TAC(SPECL [`n:num`; `A:num->num->int`; `x:num->int`; `y:num->int`] + IQBILIN_SYM) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN CONV_TAC INT_RING);; + +(* ------------------------------------------------------------------------- *) +(* Positivity and the integral Cauchy--Schwarz bound. *) +(* ------------------------------------------------------------------------- *) + +let IQEVAL_ZERO_ON_INDEX = prove + (`!n A x. + (!i. i < n ==> x i = &0) ==> iqeval n A x = &0`, + REPEAT STRIP_TAC THEN REWRITE_TAC[iqeval; iqbilin] THEN + MATCH_MP_TAC ISUM_EQ_0 THEN REWRITE_TAC[qindex; IN_ELIM_THM] THEN + X_GEN_TAC `i:num` THEN DISCH_TAC THEN + MATCH_MP_TAC ISUM_EQ_0 THEN REWRITE_TAC[qindex; IN_ELIM_THM] THEN + X_GEN_TAC `j:num` THEN DISCH_TAC THEN ASM_SIMP_TAC[INT_MUL_RZERO]);; + +let IQ_POSITIVE_IMP_NONNEG = prove + (`!n A. iq_positive n A ==> !x. &0 <= iqeval n A x`, + REPEAT GEN_TAC THEN REWRITE_TAC[iq_positive] THEN DISCH_TAC THEN + GEN_TAC THEN ASM_CASES_TAC `iq_nonzero n (x:num->int)` THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `x:num->int`) THEN ASM_REWRITE_TAC[] THEN + INT_ARITH_TAC; + SUBGOAL_THEN `iqeval n A (x:num->int) = &0` SUBST1_TAC THENL + [MATCH_MP_TAC IQEVAL_ZERO_ON_INDEX THEN + UNDISCH_TAC `~iq_nonzero n (x:num->int)` THEN + REWRITE_TAC[iq_nonzero; NOT_EXISTS_THM] THEN MESON_TAC[]; + INT_ARITH_TAC]]);; + +let IQBILIN_SQ_LE = prove + (`!n A x y. + iq_symmetric n A /\ (!z. &0 <= iqeval n A z) + ==> iqbilin n A x y pow 2 <= iqeval n A x * iqeval n A y`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + ABBREV_TAC `a = iqeval n A (x:num->int)` THEN + ABBREV_TAC `b = iqbilin n A (x:num->int) (y:num->int)` THEN + ABBREV_TAC `c = iqeval n A (y:num->int)` THEN + SUBGOAL_THEN `&0 <= a /\ &0 <= c` STRIP_ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["a"; "c"] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_CASES_TAC `c = &0` THENL + [SUBGOAL_THEN `b = &0` SUBST1_TAC THENL + [ASM_CASES_TAC `b = &0` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `b < &0 \/ &0 < b` MP_TAC THENL + [ASM_INT_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(DISJ_CASES_THEN ASSUME_TAC) THENL + [SUBGOAL_THEN + `iqeval n A (\i:num. x i + (a + &1) * y i) = + a + &2 * ((a + &1) * b)` ASSUME_TAC THENL + [MP_TAC(SPECL + [`n:num`; `A:num->num->int`; `&1:int`; `a + &1:int`; + `x:num->int`; `y:num->int`] IQEVAL_COMBO) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(fun th -> ASSUME_TAC(REWRITE_RULE + [INT_MUL_LID; INT_POW_2; INT_MUL_RZERO; INT_ADD_RID] th)) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `(a + &1) * b <= (a + &1) * -- &1` ASSUME_TAC THENL + [MATCH_MP_TAC INT_LE_LMUL THEN ASM_INT_ARITH_TAC; + FIRST_X_ASSUM(MP_TAC o SPEC + `(\i:num. x i + (a + &1) * y i):num->int`) THEN + ASM_REWRITE_TAC[] THEN ASM_INT_ARITH_TAC]; + SUBGOAL_THEN + `iqeval n A (\i:num. x i + (--(a + &1)) * y i) = + a - &2 * ((a + &1) * b)` ASSUME_TAC THENL + [MP_TAC(SPECL + [`n:num`; `A:num->num->int`; `&1:int`; `--(a + &1):int`; + `x:num->int`; `y:num->int`] IQEVAL_COMBO) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(fun th -> ASSUME_TAC(REWRITE_RULE + [INT_MUL_LID; INT_POW_2; INT_MUL_RZERO; INT_ADD_RID] th)) THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `a + &2 * --(a + &1) * b:int` THEN + CONJ_TAC THENL [ASM_REWRITE_TAC[]; CONV_TAC INT_RING]; + ALL_TAC] THEN + SUBGOAL_THEN + `(a + &1) * &1 <= (a + &1) * b` ASSUME_TAC THENL + [MATCH_MP_TAC INT_LE_LMUL THEN ASM_INT_ARITH_TAC; + FIRST_X_ASSUM(MP_TAC o SPEC + `(\i:num. x i + (--(a + &1)) * y i):num->int`) THEN + ASM_REWRITE_TAC[] THEN ASM_INT_ARITH_TAC]]; + REWRITE_TAC[INT_POW_ZERO; INT_MUL_LZERO; INT_MUL_RZERO] THEN + REWRITE_TAC[ARITH_RULE `~(2 = 0)`] THEN + MATCH_MP_TAC INT_LE_MUL THEN ASM_REWRITE_TAC[]]; + SUBGOAL_THEN + `iqeval n A (\i:num. c * x i + --b * y i) = + c * (a * c - b pow 2)` ASSUME_TAC THENL + [MP_TAC(SPECL [`n:num`; `A:num->num->int`; `c:int`; `--b:int`; + `x:num->int`; `y:num->int`] IQEVAL_COMBO) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(fun th -> ASSUME_TAC(REWRITE_RULE + [INT_POW_2; INT_ADD_RID] th)) THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC + `(c * c) * a + &2 * c * --b * b + (--b * --b) * c:int` THEN + CONJ_TAC THENL [ASM_REWRITE_TAC[]; CONV_TAC INT_RING]; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < c` ASSUME_TAC THENL [ASM_INT_ARITH_TAC; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC + `(\i:num. c * x i + --b * y i):num->int`) THEN + ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[INT_LE_MUL_EQ] THEN INT_ARITH_TAC]);; + +let IQ_POSITIVE_BILIN_SQ_LE = prove + (`!n A x y. + iq_symmetric n A /\ iq_positive n A + ==> iqbilin n A x y pow 2 <= iqeval n A x * iqeval n A y`, + MESON_TAC[IQBILIN_SQ_LE; IQ_POSITIVE_IMP_NONNEG]);; + +(* ------------------------------------------------------------------------- *) +(* Gram pullback and transfer of representation/universality. *) +(* ------------------------------------------------------------------------- *) + +let IQBILIN_ISUM_L = prove + (`!n A (s:num->bool) f y. + FINITE s + ==> iqbilin n A (\k. isum s (\i. f i k)) y = + isum s (\i. iqbilin n A (f i) y)`, + REPEAT GEN_TAC THEN SPEC_TAC (`s:num->bool`,`s:num->bool`) THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN CONJ_TAC THENL + [SIMP_TAC[ISUM_CLAUSES; iqbilin; INT_MUL_LZERO; INT_MUL_RZERO; + ISUM_0]; + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[ISUM_CLAUSES; IQBILIN_LADD] THEN REWRITE_TAC[ETA_AX]]);; + +let IQBILIN_ISUM_R = prove + (`!n A (s:num->bool) x f. + FINITE s + ==> iqbilin n A x (\k. isum s (\i. f i k)) = + isum s (\i. iqbilin n A x (f i))`, + REPEAT GEN_TAC THEN SPEC_TAC (`s:num->bool`,`s:num->bool`) THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN CONJ_TAC THENL + [SIMP_TAC[ISUM_CLAUSES; iqbilin; INT_MUL_LZERO; INT_MUL_RZERO; + ISUM_0]; + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[ISUM_CLAUSES; IQBILIN_RADD; ETA_AX]]);; + +let IQEVAL_PULLBACK = prove + (`!n d A V c. + iqeval n A (iqcombine d c V) = + iqeval d (iqgram n A V) c`, + REPEAT GEN_TAC THEN REWRITE_TAC[iqeval] THEN + SUBGOAL_THEN + `iqcombine d c V = (\k. isum (qindex d) (\i. c i * V i k))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; iqcombine]; ALL_TAC] THEN + MP_TAC(ISPECL + [`n:num`; `A:num->num->int`; `qindex d:num->bool`; + `\i:num. \k:num. c i * V i k`; + `(\k:num. isum (qindex d) (\i. c i * V i k)):num->int`] + IQBILIN_ISUM_L) THEN + REWRITE_TAC[FINITE_QINDEX] THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN + CONV_TAC(RAND_CONV(REWRITE_CONV[iqbilin])) THEN + MATCH_MP_TAC ISUM_EQ THEN REWRITE_TAC[qindex; IN_ELIM_THM] THEN + X_GEN_TAC `i:num` THEN DISCH_TAC THEN + MP_TAC(ISPECL + [`n:num`; `A:num->num->int`; `{j:num | j < d}`; + `(\k:num. (c:num->int) (i:num) * + (V:num->num->int) i k):num->int`; + `(\j:num. \k:num. (c:num->int) j * + (V:num->num->int) j k):num->num->int`] + IQBILIN_ISUM_R) THEN + REWRITE_TAC[FINITE_NUMSEG_LT] THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN + MATCH_MP_TAC ISUM_EQ THEN REWRITE_TAC[qindex; IN_ELIM_THM] THEN + X_GEN_TAC `j:num` THEN DISCH_TAC THEN + REWRITE_TAC[IQBILIN_LMUL; IQBILIN_RMUL; iqgram; ETA_AX] THEN + CONV_TAC INT_RING);; + +let IQEVAL_EQ_ON_INDEX = prove + (`!d P R c. + (!i j. i < d /\ j < d ==> P i j = R i j) + ==> iqeval d P c = iqeval d R c`, + REPEAT STRIP_TAC THEN REWRITE_TAC[iqeval; iqbilin] THEN + MATCH_MP_TAC ISUM_EQ THEN REWRITE_TAC[qindex; IN_ELIM_THM] THEN + X_GEN_TAC `i:num` THEN DISCH_TAC THEN + MATCH_MP_TAC ISUM_EQ THEN REWRITE_TAC[qindex; IN_ELIM_THM] THEN + X_GEN_TAC `j:num` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`i:num`; `j:num`]) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN REFL_TAC);; + +let IQ_REPRESENTS_OF_EMBEDS = prove + (`!n d P A m. + iq_embeds n d P A /\ iq_represents d P m + ==> iq_represents n A m`, + REPEAT GEN_TAC THEN REWRITE_TAC[iq_embeds; iq_represents] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_TAC `V:num->num->int`) (X_CHOOSE_TAC `c:num->int`)) THEN + EXISTS_TAC `iqcombine d c V` THEN + REWRITE_TAC[IQEVAL_PULLBACK] THEN + MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `iqeval d P c` THEN + CONJ_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC IQEVAL_EQ_ON_INDEX THEN + ASM_MESON_TAC[]; + ASM_REWRITE_TAC[]]);; + +let IQ_UNIVERSAL_OF_EMBEDS = prove + (`!n d P A. + iq_embeds n d P A /\ iq_universal d P + ==> iq_universal n A`, + REPEAT GEN_TAC THEN REWRITE_TAC[iq_universal] THEN + STRIP_TAC THEN X_GEN_TAC `m:int` THEN DISCH_TAC THEN + MATCH_MP_TAC IQ_REPRESENTS_OF_EMBEDS THEN + ASM_MESON_TAC[]);; + +(* Fixed small symmetric matrices. Only entries in the indicated rank matter, + but the definitions are zero outside that rank for convenient rewriting. *) + +let iqsym = new_definition + `iqsym (A:num->num->int) i j = + if i <= j then A i j else A j i`;; + +let iqmat2 = new_definition + `iqmat2 (a:int) b c = + iqsym (\i j. + if i = 0 /\ j = 0 then a else + if i = 0 /\ j = 1 then b else + if i = 1 /\ j = 1 then c else &0)`;; + +let iqmat3 = new_definition + `iqmat3 (a:int) b c d e f = + iqsym (\i j. + if i = 0 /\ j = 0 then a else + if i = 0 /\ j = 1 then b else + if i = 0 /\ j = 2 then c else + if i = 1 /\ j = 1 then d else + if i = 1 /\ j = 2 then e else + if i = 2 /\ j = 2 then f else &0)`;; + +let iqmat4 = new_definition + `iqmat4 (a:int) b c d e f g h k l = + iqsym (\i j. + if i = 0 /\ j = 0 then a else + if i = 0 /\ j = 1 then b else + if i = 0 /\ j = 2 then c else + if i = 0 /\ j = 3 then d else + if i = 1 /\ j = 1 then e else + if i = 1 /\ j = 2 then f else + if i = 1 /\ j = 3 then g else + if i = 2 /\ j = 2 then h else + if i = 2 /\ j = 3 then k else + if i = 3 /\ j = 3 then l else &0)`;; + +let IQBILIN_MAT2 = prove + (`!a b c x y. + iqbilin 2 (iqmat2 a b c) x y = + a * x 0 * y 0 + b * x 0 * y 1 + + b * x 1 * y 0 + c * x 1 * y 1`, + REPEAT GEN_TAC THEN + REWRITE_TAC[iqbilin; qindex; NUMSEG_LT; iqmat2; iqsym] THEN + CONV_TAC NUM_REDUCE_CONV THEN + CONV_TAC(ONCE_DEPTH_CONV EXPAND_ISUM_CONV) THEN + CONV_TAC(ONCE_DEPTH_CONV EXPAND_ISUM_CONV) THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC INT_RING);; + +let IQBILIN_MAT3 = prove + (`!a b c d e f x y. + iqbilin 3 (iqmat3 a b c d e f) x y = + a * x 0 * y 0 + b * x 0 * y 1 + c * x 0 * y 2 + + b * x 1 * y 0 + d * x 1 * y 1 + e * x 1 * y 2 + + c * x 2 * y 0 + e * x 2 * y 1 + f * x 2 * y 2`, + REPEAT GEN_TAC THEN + REWRITE_TAC[iqbilin; qindex; NUMSEG_LT; iqmat3; iqsym] THEN + CONV_TAC NUM_REDUCE_CONV THEN + CONV_TAC(ONCE_DEPTH_CONV EXPAND_ISUM_CONV) THEN + CONV_TAC(ONCE_DEPTH_CONV EXPAND_ISUM_CONV) THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC INT_RING);; + +let IQEVAL_MAT3 = prove + (`!a b c d e f x. + iqeval 3 (iqmat3 a b c d e f) x = + a * x 0 pow 2 + &2 * b * x 0 * x 1 + &2 * c * x 0 * x 2 + + d * x 1 pow 2 + &2 * e * x 1 * x 2 + f * x 2 pow 2`, + REPEAT GEN_TAC THEN REWRITE_TAC[iqeval; IQBILIN_MAT3] THEN + CONV_TAC INT_RING);; + +(* ------------------------------------------------------------------------- *) +(* Pullback by an integer matrix and congruence transport. *) +(* ------------------------------------------------------------------------- *) + +let IQBILIN_EQ_ON_INDEX = prove + (`!d P R x y. + (!i j. i < d /\ j < d ==> P i j = R i j) + ==> iqbilin d P x y = iqbilin d R x y`, + REPEAT STRIP_TAC THEN REWRITE_TAC[iqbilin] THEN + MATCH_MP_TAC ISUM_EQ THEN REWRITE_TAC[qindex; IN_ELIM_THM] THEN + X_GEN_TAC `i:num` THEN DISCH_TAC THEN + MATCH_MP_TAC ISUM_EQ THEN REWRITE_TAC[qindex; IN_ELIM_THM] THEN + X_GEN_TAC `j:num` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`i:num`; `j:num`]) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN REFL_TAC);; + +let IQBILIN_PULLBACK = prove + (`!n d A V c e. + iqbilin n A (iqcombine d c V) (iqcombine d e V) = + iqbilin d (iqgram n A V) c e`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN + `iqcombine d c V = (\k. isum (qindex d) (\i. c i * V i k))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; iqcombine]; ALL_TAC] THEN + SUBGOAL_THEN + `iqcombine d e V = (\k. isum (qindex d) (\i. e i * V i k))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; iqcombine]; ALL_TAC] THEN + MP_TAC(ISPECL + [`n:num`; `A:num->num->int`; `qindex d:num->bool`; + `\i:num. \k:num. c i * V i k`; + `(\k:num. isum (qindex d) (\i. e i * V i k)):num->int`] + IQBILIN_ISUM_L) THEN + REWRITE_TAC[FINITE_QINDEX] THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN + CONV_TAC(RAND_CONV(REWRITE_CONV[iqbilin])) THEN + MATCH_MP_TAC ISUM_EQ THEN REWRITE_TAC[qindex; IN_ELIM_THM] THEN + X_GEN_TAC `i:num` THEN DISCH_TAC THEN + MP_TAC(ISPECL + [`n:num`; `A:num->num->int`; `{j:num | j < d}`; + `(\k:num. (c:num->int) i * (V:num->num->int) i k):num->int`; + `(\j:num. \k:num. (e:num->int) j * + (V:num->num->int) j k):num->num->int`] + IQBILIN_ISUM_R) THEN + REWRITE_TAC[FINITE_NUMSEG_LT] THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN + MATCH_MP_TAC ISUM_EQ THEN REWRITE_TAC[qindex; IN_ELIM_THM] THEN + X_GEN_TAC `j:num` THEN DISCH_TAC THEN + REWRITE_TAC[IQBILIN_LMUL; IQBILIN_RMUL; iqgram; ETA_AX] THEN + CONV_TAC INT_RING);; + +let IQ_EMBEDS_EQ = prove + (`!n d P R A. + iq_embeds n d P A /\ + (!i j. i < d /\ j < d ==> P i j = R i j) + ==> iq_embeds n d R A`, + REPEAT GEN_TAC THEN REWRITE_TAC[iq_embeds] THEN MESON_TAC[]);; + +let IQ_EMBEDS_CONGRUENCE = prove + (`!n d e P A U. + iq_embeds n d P A + ==> iq_embeds n e (iqgram d P U) A`, + REPEAT GEN_TAC THEN REWRITE_TAC[iq_embeds] THEN + DISCH_THEN(X_CHOOSE_TAC `V:num->num->int`) THEN + EXISTS_TAC + `\i:num. iqcombine d ((U:num->num->int) i) V` THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[iqgram; IQBILIN_PULLBACK] THEN + MATCH_MP_TAC IQBILIN_EQ_ON_INDEX THEN ASM_MESON_TAC[]);; + +let iqappend = new_definition + `iqappend d (V:num->num->int) (x:num->int) i k = + if i < d then V i k else x k`;; + +let IQAPPEND_LT = prove + (`!d V x i. + i < d ==> iqappend d (V:num->num->int) (x:num->int) i = V i`, + REPEAT STRIP_TAC THEN REWRITE_TAC[FUN_EQ_THM; iqappend] THEN + ASM_REWRITE_TAC[]);; + +let IQAPPEND_REFL = prove + (`!d V x. iqappend d (V:num->num->int) (x:num->int) d = x`, + REPEAT GEN_TAC THEN REWRITE_TAC[FUN_EQ_THM; iqappend; LT_REFL]);; + +let IQ_ESCALATION_STEP = prove + (`!n d P A t. + iq_symmetric n A /\ iq_positive n A /\ + iq_embeds n d P A /\ iq_represents n A t + ==> ?V. + (!i j. i < d /\ j < d ==> iqgram n A V i j = P i j) /\ + iqgram n A V d d = t /\ + (!i. i < d ==> iqgram n A V i d pow 2 <= P i i * t) /\ + iq_embeds n (d + 1) (iqgram n A V) A`, + REPEAT GEN_TAC THEN REWRITE_TAC[iq_embeds; iq_represents] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 + (X_CHOOSE_TAC `V:num->num->int`) + (X_CHOOSE_TAC `x:num->int`)))) THEN + EXISTS_TAC `iqappend d V x` THEN + CONJ_TAC THENL + [REPEAT STRIP_TAC THEN REWRITE_TAC[iqgram] THEN + SUBGOAL_THEN `iqappend d V x i = (V:num->num->int) i` + SUBST1_TAC THENL + [MATCH_MP_TAC IQAPPEND_LT THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `iqappend d V x j = (V:num->num->int) j` + SUBST1_TAC THENL + [MATCH_MP_TAC IQAPPEND_LT THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`i:num`; `j:num`]) THEN + ASM_REWRITE_TAC[iqgram]; + ALL_TAC] THEN + CONJ_TAC THENL + [REWRITE_TAC[iqgram] THEN + SUBGOAL_THEN `iqappend d V x d = (x:num->int)` SUBST1_TAC THENL + [REWRITE_TAC[IQAPPEND_REFL]; + ASM_MESON_TAC[iqeval]]; + ALL_TAC] THEN + CONJ_TAC THENL + [X_GEN_TAC `i:num` THEN DISCH_TAC THEN + REWRITE_TAC[iqgram] THEN + SUBGOAL_THEN `iqappend d V x i = (V:num->num->int) i` + SUBST1_TAC THENL + [MATCH_MP_TAC IQAPPEND_LT THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `iqappend d V x d = (x:num->int)` SUBST1_TAC THENL + [REWRITE_TAC[IQAPPEND_REFL]; + ALL_TAC] THEN + SUBGOAL_THEN `iqeval n A ((V:num->num->int) i) = P i i` + ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPECL [`i:num`; `i:num`]) THEN + ASM_REWRITE_TAC[iqgram; iqeval]; + ALL_TAC] THEN + MP_TAC(SPECL + [`n:num`; `A:num->num->int`; `(V:num->num->int) i`; + `x:num->int`] IQ_POSITIVE_BILIN_SQ_LE) THEN + ASM_REWRITE_TAC[]; + REWRITE_TAC[iq_embeds] THEN + EXISTS_TAC `iqappend d V x` THEN SIMP_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Square residues modulo 8, 9 and 16. *) +(* ------------------------------------------------------------------------- *) + +(* The square-residue-mod-8 facts are REM_8_CASES and SQ_MOD_8 from *) +(* three_squares.ml (loaded above). *) + +let IQ_REM_9_CASES = prove + (`!x:int. + x rem &9 = &0 \/ x rem &9 = &1 \/ x rem &9 = &2 \/ + x rem &9 = &3 \/ x rem &9 = &4 \/ x rem &9 = &5 \/ + x rem &9 = &6 \/ x rem &9 = &7 \/ x rem &9 = &8`, + GEN_TAC THEN MP_TAC(SPECL [`x:int`; `&9:int`] INT_DIVISION) THEN + INT_ARITH_TAC);; + +let IQ_SQ_MOD_9 = prove + (`!x:int. + x pow 2 rem &9 = &0 \/ + x pow 2 rem &9 = &1 \/ + x pow 2 rem &9 = &4 \/ + x pow 2 rem &9 = &7`, + GEN_TAC THEN ONCE_REWRITE_TAC[GSYM INT_POW_REM] THEN + MP_TAC(SPEC `x:int` IQ_REM_9_CASES) THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONV_TAC INT_REDUCE_CONV);; + +let IQ_SQUARE_REM_16_OF_MOD8 = prove + (`!x q r:int. + x = &8 * q + r + ==> x pow 2 rem &16 = r pow 2 rem &16`, + REPEAT STRIP_TAC THEN REWRITE_TAC[INT_REM_EQ; int_congruent] THEN + EXISTS_TAC `&4 * q pow 2 + q * r` THEN + ASM_REWRITE_TAC[] THEN CONV_TAC INT_RING);; + +let IQ_SQ_MOD_16 = prove + (`!x:int. + x pow 2 rem &16 = &0 \/ + x pow 2 rem &16 = &1 \/ + x pow 2 rem &16 = &4 \/ + x pow 2 rem &16 = &9`, + GEN_TAC THEN + SUBGOAL_THEN + `x pow 2 rem &16 = (x rem &8) pow 2 rem &16` + SUBST1_TAC THENL + [MATCH_MP_TAC IQ_SQUARE_REM_16_OF_MOD8 THEN + EXISTS_TAC `x div &8` THEN + MP_TAC(SPECL [`x:int`; `&8:int`] INT_DIVISION) THEN + ANTS_TAC THENL [INT_ARITH_TAC; INT_ARITH_TAC]; + MP_TAC(SPEC `x:int` REM_8_CASES) THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONV_TAC INT_REDUCE_CONV]);; + +(* ------------------------------------------------------------------------- *) +(* The three obstructions. *) +(* ------------------------------------------------------------------------- *) + +let IQ_122_MOD8_CORE = prove + (`!a b c:int. + (a = &0 \/ a = &1 \/ a = &4) /\ + (b = &0 \/ b = &1 \/ b = &4) /\ + (c = &0 \/ c = &1 \/ c = &4) /\ + (a + &2 * b + &2 * c) rem &8 = &7 + ==> F`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + POP_ASSUM MP_TAC THEN ASM_REWRITE_TAC[] THEN + CONV_TAC INT_REDUCE_CONV);; + +let INT_122_NOT_7 = prove + (`!x y z:int. + ~(x pow 2 + &2 * y pow 2 + &2 * z pow 2 = &7)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(SPECL + [`x pow 2 rem &8`; `y pow 2 rem &8`; `z pow 2 rem &8`] + IQ_122_MOD8_CORE) THEN + REWRITE_TAC[SQ_MOD_8] THEN + SUBGOAL_THEN + `(x pow 2 rem &8 + &2 * (y pow 2 rem &8) + + &2 * (z pow 2 rem &8)) rem &8 = + (x pow 2 + &2 * y pow 2 + &2 * z pow 2) rem &8` + SUBST1_TAC THENL + [CONV_TAC INT_REM_DOWN_CONV THEN REFL_TAC; + ASM_REWRITE_TAC[] THEN CONV_TAC INT_REDUCE_CONV]);; + +let IQ_113_MOD9_CORE = prove + (`!a b c:int. + (a = &0 \/ a = &1 \/ a = &4 \/ a = &7) /\ + (b = &0 \/ b = &1 \/ b = &4 \/ b = &7) /\ + (c = &0 \/ c = &1 \/ c = &4 \/ c = &7) /\ + (a + b + &3 * c) rem &9 = &6 + ==> F`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + POP_ASSUM MP_TAC THEN ASM_REWRITE_TAC[] THEN + CONV_TAC INT_REDUCE_CONV);; + +let INT_113_NOT_6 = prove + (`!x y z:int. + ~(x pow 2 + y pow 2 + &3 * z pow 2 = &6)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(SPECL + [`x pow 2 rem &9`; `y pow 2 rem &9`; `z pow 2 rem &9`] + IQ_113_MOD9_CORE) THEN + REWRITE_TAC[IQ_SQ_MOD_9] THEN + SUBGOAL_THEN + `(x pow 2 rem &9 + y pow 2 rem &9 + + &3 * (z pow 2 rem &9)) rem &9 = + (x pow 2 + y pow 2 + &3 * z pow 2) rem &9` + SUBST1_TAC THENL + [CONV_TAC INT_REM_DOWN_CONV THEN REFL_TAC; + ASM_REWRITE_TAC[] THEN CONV_TAC INT_REDUCE_CONV]);; + +let IQ_112_MOD16_CORE = prove + (`!a b c:int. + (a = &0 \/ a = &1 \/ a = &4 \/ a = &9) /\ + (b = &0 \/ b = &1 \/ b = &4 \/ b = &9) /\ + (c = &0 \/ c = &1 \/ c = &4 \/ c = &9) /\ + (a + b + &2 * c) rem &16 = &14 + ==> F`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + POP_ASSUM MP_TAC THEN ASM_REWRITE_TAC[] THEN + CONV_TAC INT_REDUCE_CONV);; + +let INT_112_NOT_14 = prove + (`!x y z:int. + ~(x pow 2 + y pow 2 + &2 * z pow 2 = &14)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(SPECL + [`x pow 2 rem &16`; `y pow 2 rem &16`; `z pow 2 rem &16`] + IQ_112_MOD16_CORE) THEN + REWRITE_TAC[IQ_SQ_MOD_16] THEN + SUBGOAL_THEN + `(x pow 2 rem &16 + y pow 2 rem &16 + + &2 * (z pow 2 rem &16)) rem &16 = + (x pow 2 + y pow 2 + &2 * z pow 2) rem &16` + SUBST1_TAC THENL + [CONV_TAC INT_REM_DOWN_CONV THEN REFL_TAC; + ASM_REWRITE_TAC[] THEN CONV_TAC INT_REDUCE_CONV]);; + +(* Row matrices used for integral changes of basis. *) + +let iqrows2 = new_definition + `iqrows2 (a:int) b c d i j = + if i = 0 then (if j = 0 then a else if j = 1 then b else &0) + else if i = 1 then (if j = 0 then c else if j = 1 then d else &0) + else &0`;; + +let iqrows3 = new_definition + `iqrows3 (a:int) b c d e f g h k i j = + if i = 0 then + (if j = 0 then a else if j = 1 then b else if j = 2 then c else &0) + else if i = 1 then + (if j = 0 then d else if j = 1 then e else if j = 2 then f else &0) + else if i = 2 then + (if j = 0 then g else if j = 1 then h else if j = 2 then k else &0) + else &0`;; + +let iqclear2 = new_definition + `iqclear2 a = iqrows2 (&1) (&0) (--a) (&1)`;; + +let iqclear11 = new_definition + `iqclear11 a b = + iqrows3 (&1) (&0) (&0) (&0) (&1) (&0) (--a) (--b) (&1)`;; + +let iqclear12 = new_definition + `iqclear12 a q = + iqrows3 (&1) (&0) (&0) (&0) (&1) (&0) (--a) (--q) (&1)`;; + +(* ------------------------------------------------------------------------- *) +(* Small integral square bounds used in the finite branches. *) +(* ------------------------------------------------------------------------- *) + +let INT_SQ_LE_2_CASES = prove + (`!a:int. a pow 2 <= &2 ==> a = -- &1 \/ a = &0 \/ a = &1`, + GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN `abs a < &2` ASSUME_TAC THENL + [MP_TAC(SPECL [`a:int`; `&2:int`] INT_LT_SQUARE_ABS) THEN + REWRITE_TAC[INT_ABS_NUM] THEN + CONV_TAC NUM_REDUCE_CONV THEN ASM_INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `abs a <= &1` ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; ALL_TAC] THEN + MP_TAC(SPECL [`a:int`; `&1:int`] INT_ABS_BOUNDS) THEN + ASM_REWRITE_TAC[] THEN INT_ARITH_TAC);; + +let INT_SQ_LE_3_CASES = prove + (`!a:int. a pow 2 <= &3 ==> a = -- &1 \/ a = &0 \/ a = &1`, + GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN `abs a < &2` ASSUME_TAC THENL + [MP_TAC(SPECL [`a:int`; `&2:int`] INT_LT_SQUARE_ABS) THEN + REWRITE_TAC[INT_ABS_NUM] THEN + CONV_TAC NUM_REDUCE_CONV THEN ASM_INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `abs a <= &1` ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; ALL_TAC] THEN + MP_TAC(SPECL [`a:int`; `&1:int`] INT_ABS_BOUNDS) THEN + ASM_REWRITE_TAC[] THEN INT_ARITH_TAC);; + +let INT_SQ_LE_5_CASES = prove + (`!a:int. + a pow 2 <= &5 + ==> a = -- &2 \/ a = -- &1 \/ a = &0 \/ a = &1 \/ a = &2`, + GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN `abs a < &3` ASSUME_TAC THENL + [MP_TAC(SPECL [`a:int`; `&3:int`] INT_LT_SQUARE_ABS) THEN + REWRITE_TAC[INT_ABS_NUM] THEN + CONV_TAC NUM_REDUCE_CONV THEN ASM_INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `abs a <= &2` ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; ALL_TAC] THEN + MP_TAC(SPECL [`a:int`; `&2:int`] INT_ABS_BOUNDS) THEN + ASM_REWRITE_TAC[] THEN INT_ARITH_TAC);; + +let INT_SQ_LE_10_CASES = prove + (`!a:int. + a pow 2 <= &10 + ==> a = -- &3 \/ a = -- &2 \/ a = -- &1 \/ a = &0 \/ + a = &1 \/ a = &2 \/ a = &3`, + GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN `abs a < &4` ASSUME_TAC THENL + [MP_TAC(SPECL [`a:int`; `&4:int`] INT_LT_SQUARE_ABS) THEN + REWRITE_TAC[INT_ABS_NUM] THEN + CONV_TAC NUM_REDUCE_CONV THEN ASM_INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `abs a <= &3` ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; ALL_TAC] THEN + MP_TAC(SPECL [`a:int`; `&3:int`] INT_ABS_BOUNDS) THEN + ASM_REWRITE_TAC[] THEN INT_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Positivity and symbolic clearing under an embedded Gram matrix. *) +(* ------------------------------------------------------------------------- *) + +let IQ_EMBEDDED_NONNEG = prove + (`!n d P A. + iq_positive n A /\ iq_embeds n d P A + ==> !c. &0 <= iqeval d P c`, + REPEAT GEN_TAC THEN REWRITE_TAC[iq_embeds] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (X_CHOOSE_TAC `V:num->num->int`)) THEN + X_GEN_TAC `c:num->int` THEN + SUBGOAL_THEN + `iqeval d P c = iqeval d (iqgram n A V) c` + SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC IQEVAL_EQ_ON_INDEX THEN + ASM_REWRITE_TAC[]; + REWRITE_TAC[GSYM IQEVAL_PULLBACK] THEN + MP_TAC(SPECL [`n:num`; `A:num->num->int`] + IQ_POSITIVE_IMP_NONNEG) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(fun th -> + MATCH_ACCEPT_TAC(SPEC `iqcombine d c V` th))]);; + +let IQ_EMBEDS_CLEAR_UNIT2 = prove + (`!n A a t. + iq_embeds n 2 (iqmat2 (&1) a t) A + ==> iq_embeds n 2 (iqmat2 (&1) (&0) (t - a pow 2)) A`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(ISPECL + [`n:num`; `2`; `iqgram 2 (iqmat2 (&1) a t) (iqclear2 a)`; + `iqmat2 (&1) (&0) (t - a pow 2)`; `A:num->num->int`] + IQ_EMBEDS_EQ) THEN + CONJ_TAC THENL + [MATCH_MP_TAC IQ_EMBEDS_CONGRUENCE THEN ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC THEN + (SUBGOAL_THEN `i = 0 \/ i = 1` MP_TAC THENL + [ASM_ARITH_TAC; ALL_TAC]) THEN + DISCH_THEN(DISJ_CASES_THEN SUBST_ALL_TAC) THEN + (SUBGOAL_THEN `j = 0 \/ j = 1` MP_TAC THENL + [ASM_ARITH_TAC; ALL_TAC]) THEN + DISCH_THEN(DISJ_CASES_THEN SUBST_ALL_TAC) THEN + ASM_REWRITE_TAC[iqgram; IQBILIN_MAT2; iqclear2; iqrows2; + iqmat2; iqsym] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC INT_RING]);; + +let IQ_EMBEDS_CLEAR_11 = prove + (`!n A a b t. + iq_embeds n 3 (iqmat3 (&1) (&0) a (&1) b t) A + ==> iq_embeds n 3 + (iqmat3 (&1) (&0) (&0) (&1) (&0) + (t - a pow 2 - b pow 2)) A`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(ISPECL + [`n:num`; `3`; + `iqgram 3 (iqmat3 (&1) (&0) a (&1) b t) (iqclear11 a b)`; + `iqmat3 (&1) (&0) (&0) (&1) (&0) + (t - a pow 2 - b pow 2)`; + `A:num->num->int`] IQ_EMBEDS_EQ) THEN + CONJ_TAC THENL + [MATCH_MP_TAC IQ_EMBEDS_CONGRUENCE THEN ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC THEN + (SUBGOAL_THEN `i = 0 \/ i = 1 \/ i = 2` MP_TAC THENL + [ASM_ARITH_TAC; ALL_TAC]) THEN + DISCH_THEN(DISJ_CASES_THEN2 SUBST_ALL_TAC + (DISJ_CASES_THEN SUBST_ALL_TAC)) THEN + (SUBGOAL_THEN `j = 0 \/ j = 1 \/ j = 2` MP_TAC THENL + [ASM_ARITH_TAC; ALL_TAC]) THEN + DISCH_THEN(DISJ_CASES_THEN2 SUBST_ALL_TAC + (DISJ_CASES_THEN SUBST_ALL_TAC)) THEN + ASM_REWRITE_TAC[iqgram; IQBILIN_MAT3; iqclear11; iqrows3; + iqmat3; iqsym] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC INT_RING]);; + +let IQ_EMBEDS_CLEAR_12 = prove + (`!n A a q r t. + iq_embeds n 3 (iqmat3 (&1) (&0) a (&2) (&2 * q + r) t) A + ==> iq_embeds n 3 + (iqmat3 (&1) (&0) (&0) (&2) r + (t - a pow 2 - &2 * q pow 2 - &2 * q * r)) A`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(ISPECL + [`n:num`; `3`; + `iqgram 3 + (iqmat3 (&1) (&0) a (&2) (&2 * q + r) t) (iqclear12 a q)`; + `iqmat3 (&1) (&0) (&0) (&2) r + (t - a pow 2 - &2 * q pow 2 - &2 * q * r)`; + `A:num->num->int`] IQ_EMBEDS_EQ) THEN + CONJ_TAC THENL + [MATCH_MP_TAC IQ_EMBEDS_CONGRUENCE THEN ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC THEN + (SUBGOAL_THEN `i = 0 \/ i = 1 \/ i = 2` MP_TAC THENL + [ASM_ARITH_TAC; ALL_TAC]) THEN + DISCH_THEN(DISJ_CASES_THEN2 SUBST_ALL_TAC + (DISJ_CASES_THEN SUBST_ALL_TAC)) THEN + (SUBGOAL_THEN `j = 0 \/ j = 1 \/ j = 2` MP_TAC THENL + [ASM_ARITH_TAC; ALL_TAC]) THEN + DISCH_THEN(DISJ_CASES_THEN2 SUBST_ALL_TAC + (DISJ_CASES_THEN SUBST_ALL_TAC)) THEN + ASM_REWRITE_TAC[iqgram; IQBILIN_MAT3; iqclear12; iqrows3; + iqmat3; iqsym] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC INT_RING]);; + +(* ------------------------------------------------------------------------- *) +(* Rank one to the two binary nodes. *) +(* ------------------------------------------------------------------------- *) + +let IQ_EMBEDS_ONE = prove + (`!n A. + iq_represents n A (&1) + ==> iq_embeds n 1 (iqmat2 (&1) (&0) (&0)) A`, + REPEAT GEN_TAC THEN REWRITE_TAC[iq_represents; iq_embeds] THEN + DISCH_THEN(X_CHOOSE_TAC `x:num->int`) THEN + EXISTS_TAC `\i:num. x:num->int` THEN + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `i = 0 /\ j = 0` STRIP_ASSUME_TAC THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[iqgram; GSYM iqeval; iqmat2; iqsym] THEN + CONV_TAC NUM_REDUCE_CONV);; + +let IQGRAM_SWAP = prove + (`!n A V i j. + iq_symmetric n A + ==> iqgram n A V i j = iqgram n A V j i`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[iqgram] THEN + MATCH_MP_TAC IQBILIN_SYM THEN ASM_REWRITE_TAC[]);; + +let IQ_EMBEDS_BINARY = prove + (`!n A. + iq_symmetric n A /\ iq_positive n A /\ + iq_represents n A (&1) /\ iq_represents n A (&2) + ==> iq_embeds n 2 (iqmat2 (&1) (&0) (&1)) A \/ + iq_embeds n 2 (iqmat2 (&1) (&0) (&2)) A`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN + `iq_embeds n 1 (iqmat2 (&1) (&0) (&0)) A` + ASSUME_TAC THENL + [MATCH_MP_TAC IQ_EMBEDS_ONE THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MP_TAC(SPECL + [`n:num`; `1`; `iqmat2 (&1) (&0) (&0)`; + `A:num->num->int`; `&2:int`] IQ_ESCALATION_STEP) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `V:num->num->int` STRIP_ASSUME_TAC) THEN + ABBREV_TAC `a = iqgram n A V 0 1` THEN + SUBGOAL_THEN `iqgram n A V 0 0 = &1` ASSUME_TAC THENL + [MP_TAC(SPECL [`0`; `0`] (ASSUME + `!i j. i < 1 /\ j < 1 + ==> iqgram n A V i j = iqmat2 (&1) (&0) (&0) i j`)) THEN + REWRITE_TAC[iqmat2; iqsym] THEN CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + SUBGOAL_THEN `iqgram n A V 1 0 = a` ASSUME_TAC THENL + [EXPAND_TAC "a" THEN + MATCH_MP_TAC(SPECL + [`n:num`; `A:num->num->int`; `V:num->num->int`; `1`; `0`] + IQGRAM_SWAP) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `iq_embeds n 2 (iqmat2 (&1) a (&2)) A` + ASSUME_TAC THENL + [MATCH_MP_TAC(ISPECL + [`n:num`; `2`; `iqgram n A V`; + `iqmat2 (&1) a (&2)`; `A:num->num->int`] IQ_EMBEDS_EQ) THEN + CONJ_TAC THENL [ASM_MESON_TAC[ARITH_RULE `1 + 1 = 2`]; ALL_TAC] THEN + REPEAT STRIP_TAC THEN + (SUBGOAL_THEN `i = 0 \/ i = 1` MP_TAC THENL + [ASM_ARITH_TAC; ALL_TAC]) THEN + DISCH_THEN(DISJ_CASES_THEN SUBST_ALL_TAC) THEN + (SUBGOAL_THEN `j = 0 \/ j = 1` MP_TAC THENL + [ASM_ARITH_TAC; ALL_TAC]) THEN + DISCH_THEN(DISJ_CASES_THEN SUBST_ALL_TAC) THEN + ASM_REWRITE_TAC[iqmat2; iqsym] THEN + CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + SUBGOAL_THEN `a pow 2 <= &2` ASSUME_TAC THENL + [MP_TAC(SPEC `0` (ASSUME + `!i. i < 1 + ==> iqgram n A V i 1 pow 2 <= + iqmat2 (&1) (&0) (&0) i i * &2`)) THEN + REWRITE_TAC[iqmat2; iqsym] THEN + CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC THEN + ONCE_REWRITE_TAC[GSYM(ASSUME `iqgram n A V 0 1 = a`)] THEN + ASM_INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `iq_embeds n 2 (iqmat2 (&1) (&0) (&2 - a pow 2)) A` + ASSUME_TAC THENL + [MATCH_MP_TAC IQ_EMBEDS_CLEAR_UNIT2 THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MP_TAC(MATCH_MP INT_SQ_LE_2_CASES (ASSUME `a pow 2 <= &2`)) THEN + DISCH_THEN(DISJ_CASES_THEN2 + (fun th -> SUBST_ALL_TAC th THEN DISJ1_TAC) + (DISJ_CASES_THEN2 + (fun th -> SUBST_ALL_TAC th THEN DISJ2_TAC) + (fun th -> SUBST_ALL_TAC th THEN DISJ1_TAC))) THEN + FIRST_X_ASSUM(MP_TAC) THEN + CONV_TAC INT_REDUCE_CONV);; + +(* ------------------------------------------------------------------------- *) +(* Rank two to rank three. *) +(* ------------------------------------------------------------------------- *) + +let IQ_ESCALATE_MAT2 = prove + (`!n A u v w t. + iq_symmetric n A /\ iq_positive n A /\ + iq_embeds n 2 (iqmat2 u v w) A /\ iq_represents n A t + ==> ?a b. + iq_embeds n 3 (iqmat3 u v a w b t) A /\ + a pow 2 <= u * t /\ b pow 2 <= w * t`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(SPECL + [`n:num`; `2`; `iqmat2 u v w`; + `A:num->num->int`; `t:int`] IQ_ESCALATION_STEP) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `V:num->num->int` STRIP_ASSUME_TAC) THEN + ABBREV_TAC `a = iqgram n A V 0 2` THEN + ABBREV_TAC `b = iqgram n A V 1 2` THEN + SUBGOAL_THEN `iqgram n A V 0 0 = u` ASSUME_TAC THENL + [MP_TAC(SPECL [`0`; `0`] (ASSUME + `!i j. i < 2 /\ j < 2 + ==> iqgram n A V i j = iqmat2 u v w i j`)) THEN + REWRITE_TAC[iqmat2; iqsym] THEN CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + SUBGOAL_THEN `iqgram n A V 0 1 = v` ASSUME_TAC THENL + [MP_TAC(SPECL [`0`; `1`] (ASSUME + `!i j. i < 2 /\ j < 2 + ==> iqgram n A V i j = iqmat2 u v w i j`)) THEN + REWRITE_TAC[iqmat2; iqsym] THEN CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + SUBGOAL_THEN `iqgram n A V 1 0 = v` ASSUME_TAC THENL + [MP_TAC(SPECL [`1`; `0`] (ASSUME + `!i j. i < 2 /\ j < 2 + ==> iqgram n A V i j = iqmat2 u v w i j`)) THEN + REWRITE_TAC[iqmat2; iqsym] THEN CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + SUBGOAL_THEN `iqgram n A V 1 1 = w` ASSUME_TAC THENL + [MP_TAC(SPECL [`1`; `1`] (ASSUME + `!i j. i < 2 /\ j < 2 + ==> iqgram n A V i j = iqmat2 u v w i j`)) THEN + REWRITE_TAC[iqmat2; iqsym] THEN CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + SUBGOAL_THEN `iqgram n A V 2 0 = a` ASSUME_TAC THENL + [EXPAND_TAC "a" THEN + MATCH_MP_TAC(SPECL + [`n:num`; `A:num->num->int`; `V:num->num->int`; `2`; `0`] + IQGRAM_SWAP) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `iqgram n A V 2 1 = b` ASSUME_TAC THENL + [EXPAND_TAC "b" THEN + MATCH_MP_TAC(SPECL + [`n:num`; `A:num->num->int`; `V:num->num->int`; `2`; `1`] + IQGRAM_SWAP) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MAP_EVERY EXISTS_TAC [`a:int`; `b:int`] THEN + CONJ_TAC THENL + [MATCH_MP_TAC(ISPECL + [`n:num`; `3`; `iqgram n A V`; + `iqmat3 u v a w b t`; `A:num->num->int`] IQ_EMBEDS_EQ) THEN + CONJ_TAC THENL + [ASM_MESON_TAC[ARITH_RULE `2 + 1 = 3`]; + ALL_TAC] THEN + REPEAT STRIP_TAC THEN + (SUBGOAL_THEN `i = 0 \/ i = 1 \/ i = 2` MP_TAC THENL + [ASM_ARITH_TAC; ALL_TAC]) THEN + DISCH_THEN(DISJ_CASES_THEN2 SUBST_ALL_TAC + (DISJ_CASES_THEN SUBST_ALL_TAC)) THEN + (SUBGOAL_THEN `j = 0 \/ j = 1 \/ j = 2` MP_TAC THENL + [ASM_ARITH_TAC; ALL_TAC]) THEN + DISCH_THEN(DISJ_CASES_THEN2 SUBST_ALL_TAC + (DISJ_CASES_THEN SUBST_ALL_TAC)) THEN + ASM_REWRITE_TAC[iqmat3; iqsym] THEN CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + CONJ_TAC THENL + [MP_TAC(SPEC `0` (ASSUME + `!i. i < 2 + ==> iqgram n A V i 2 pow 2 <= iqmat2 u v w i i * t`)) THEN + REWRITE_TAC[iqmat2; iqsym] THEN CONV_TAC NUM_REDUCE_CONV THEN + ONCE_REWRITE_TAC[GSYM(ASSUME `iqgram n A V 0 2 = a`)] THEN + MESON_TAC[]; + MP_TAC(SPEC `1` (ASSUME + `!i. i < 2 + ==> iqgram n A V i 2 pow 2 <= iqmat2 u v w i i * t`)) THEN + REWRITE_TAC[iqmat2; iqsym] THEN CONV_TAC NUM_REDUCE_CONV THEN + ONCE_REWRITE_TAC[GSYM(ASSUME `iqgram n A V 1 2 = b`)] THEN + MESON_TAC[]]);; + +let IQ_CORNER_11_CASES = prove + (`!a b:int. + a pow 2 <= &3 /\ b pow 2 <= &3 + ==> &3 - a pow 2 - b pow 2 = &1 \/ + &3 - a pow 2 - b pow 2 = &2 \/ + &3 - a pow 2 - b pow 2 = &3`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(MATCH_MP INT_SQ_LE_3_CASES (ASSUME `a pow 2 <= &3`)) THEN + DISCH_THEN(DISJ_CASES_THEN2 SUBST_ALL_TAC + (DISJ_CASES_THEN SUBST_ALL_TAC)) THEN + MP_TAC(MATCH_MP INT_SQ_LE_3_CASES (ASSUME `b pow 2 <= &3`)) THEN + DISCH_THEN(DISJ_CASES_THEN2 SUBST_ALL_TAC + (DISJ_CASES_THEN SUBST_ALL_TAC)) THEN + CONV_TAC INT_REDUCE_CONV);; + +let IQ_EMBEDS_TERNARY_11 = prove + (`!n A. + iq_symmetric n A /\ iq_positive n A /\ + iq_embeds n 2 (iqmat2 (&1) (&0) (&1)) A /\ + iq_represents n A (&3) + ==> iq_embeds n 3 (iqmat3 (&1) (&0) (&0) (&1) (&0) (&1)) A \/ + iq_embeds n 3 (iqmat3 (&1) (&0) (&0) (&1) (&0) (&2)) A \/ + iq_embeds n 3 (iqmat3 (&1) (&0) (&0) (&1) (&0) (&3)) A`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(SPECL + [`n:num`; `A:num->num->int`; + `&1:int`; `&0:int`; `&1:int`; `&3:int`] IQ_ESCALATE_MAT2) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `a:int` + (X_CHOOSE_THEN `b:int` STRIP_ASSUME_TAC)) THEN + SUBGOAL_THEN + `iq_embeds n 3 + (iqmat3 (&1) (&0) (&0) (&1) (&0) + (&3 - a pow 2 - b pow 2)) A` + ASSUME_TAC THENL + [MATCH_MP_TAC IQ_EMBEDS_CLEAR_11 THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `a pow 2 <= &3 /\ b pow 2 <= &3` ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; ALL_TAC] THEN + MP_TAC(MATCH_MP (SPECL [`a:int`; `b:int`] IQ_CORNER_11_CASES) + (ASSUME `a pow 2 <= &3 /\ b pow 2 <= &3`)) THEN + DISCH_THEN(DISJ_CASES_THEN2 + (fun th -> + DISJ1_TAC THEN + MATCH_ACCEPT_TAC(REWRITE_RULE[th] (ASSUME + `iq_embeds n 3 + (iqmat3 (&1) (&0) (&0) (&1) (&0) + (&3 - a pow 2 - b pow 2)) A`))) + (DISJ_CASES_THEN2 + (fun th -> + DISJ2_TAC THEN DISJ1_TAC THEN + MATCH_ACCEPT_TAC(REWRITE_RULE[th] (ASSUME + `iq_embeds n 3 + (iqmat3 (&1) (&0) (&0) (&1) (&0) + (&3 - a pow 2 - b pow 2)) A`))) + (fun th -> + DISJ2_TAC THEN DISJ2_TAC THEN + MATCH_ACCEPT_TAC(REWRITE_RULE[th] (ASSUME + `iq_embeds n 3 + (iqmat3 (&1) (&0) (&0) (&1) (&0) + (&3 - a pow 2 - b pow 2)) A`))))));; + +let INT_DIV2_DECOMP = prove + (`!b:int. + b = &2 * (b div &2) + b rem &2 /\ + (b rem &2 = &0 \/ b rem &2 = &1)`, + GEN_TAC THEN + MP_TAC(SPECL [`b:int`; `&2:int`] INT_DIVISION) THEN + CONV_TAC NUM_REDUCE_CONV THEN INT_ARITH_TAC);; + +let IQ_12_PARAMETERS = prove + (`!a b:int. + a pow 2 <= &5 /\ b pow 2 <= &10 + ==> ?q r k. + b = &2 * q + r /\ + k = &5 - a pow 2 - &2 * q pow 2 - &2 * q * r /\ + ((r = &0 /\ + (k = -- &1 \/ k = &1 \/ k = &2 \/ k = &3 \/ + k = &4 \/ k = &5)) \/ + (r = &1 /\ + (k = -- &3 \/ k = &0 \/ k = &1 \/ k = &4 \/ k = &5)))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MAP_EVERY EXISTS_TAC + [`b div &2:int`; `b rem &2:int`; + `&5 - a pow 2 - &2 * (b div &2) pow 2 - + &2 * (b div &2) * (b rem &2):int`] THEN + CONJ_TAC THENL + [MP_TAC(SPEC `b:int` INT_DIV2_DECOMP) THEN MESON_TAC[]; + ALL_TAC] THEN + CONJ_TAC THENL + [REFL_TAC; + ALL_TAC] THEN + MP_TAC(MATCH_MP INT_SQ_LE_5_CASES (ASSUME `a pow 2 <= &5`)) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + MP_TAC(MATCH_MP INT_SQ_LE_10_CASES (ASSUME `b pow 2 <= &10`)) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + CONV_TAC INT_REDUCE_CONV);; + +let iqswap12 = new_definition + `iqswap12 = + iqrows3 (&1) (&0) (&0) (&0) (&0) (&1) (&0) (&1) (&0)`;; + +let iqcross1 = new_definition + `iqcross1 = + iqrows3 (&1) (&0) (&0) (&0) (&0) (&1) (&0) (&1) (-- &1)`;; + +let IQ_EMBEDS_121_TO_112 = prove + (`!n A. + iq_embeds n 3 (iqmat3 (&1) (&0) (&0) (&2) (&0) (&1)) A + ==> iq_embeds n 3 (iqmat3 (&1) (&0) (&0) (&1) (&0) (&2)) A`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(ISPECL + [`n:num`; `3`; + `iqgram 3 (iqmat3 (&1) (&0) (&0) (&2) (&0) (&1)) iqswap12`; + `iqmat3 (&1) (&0) (&0) (&1) (&0) (&2)`; + `A:num->num->int`] IQ_EMBEDS_EQ) THEN + CONJ_TAC THENL + [MATCH_MP_TAC IQ_EMBEDS_CONGRUENCE THEN ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC THEN + (SUBGOAL_THEN `i = 0 \/ i = 1 \/ i = 2` MP_TAC THENL + [ASM_ARITH_TAC; ALL_TAC]) THEN + DISCH_THEN(DISJ_CASES_THEN2 SUBST_ALL_TAC + (DISJ_CASES_THEN SUBST_ALL_TAC)) THEN + (SUBGOAL_THEN `j = 0 \/ j = 1 \/ j = 2` MP_TAC THENL + [ASM_ARITH_TAC; ALL_TAC]) THEN + DISCH_THEN(DISJ_CASES_THEN2 SUBST_ALL_TAC + (DISJ_CASES_THEN SUBST_ALL_TAC)) THEN + ASM_REWRITE_TAC[iqgram; IQBILIN_MAT3; iqswap12; iqrows3; + iqmat3; iqsym] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC INT_RING]);; + +let IQ_EMBEDS_12X1_TO_111 = prove + (`!n A. + iq_embeds n 3 (iqmat3 (&1) (&0) (&0) (&2) (&1) (&1)) A + ==> iq_embeds n 3 (iqmat3 (&1) (&0) (&0) (&1) (&0) (&1)) A`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(ISPECL + [`n:num`; `3`; + `iqgram 3 (iqmat3 (&1) (&0) (&0) (&2) (&1) (&1)) iqcross1`; + `iqmat3 (&1) (&0) (&0) (&1) (&0) (&1)`; + `A:num->num->int`] IQ_EMBEDS_EQ) THEN + CONJ_TAC THENL + [MATCH_MP_TAC IQ_EMBEDS_CONGRUENCE THEN ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC THEN + (SUBGOAL_THEN `i = 0 \/ i = 1 \/ i = 2` MP_TAC THENL + [ASM_ARITH_TAC; ALL_TAC]) THEN + DISCH_THEN(DISJ_CASES_THEN2 SUBST_ALL_TAC + (DISJ_CASES_THEN SUBST_ALL_TAC)) THEN + (SUBGOAL_THEN `j = 0 \/ j = 1 \/ j = 2` MP_TAC THENL + [ASM_ARITH_TAC; ALL_TAC]) THEN + DISCH_THEN(DISJ_CASES_THEN2 SUBST_ALL_TAC + (DISJ_CASES_THEN SUBST_ALL_TAC)) THEN + ASM_REWRITE_TAC[iqgram; IQBILIN_MAT3; iqcross1; iqrows3; + iqmat3; iqsym] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC INT_RING]);; + +let IQ_EMBEDS_TERNARY_12 = prove + (`!n A. + iq_symmetric n A /\ iq_positive n A /\ + iq_embeds n 2 (iqmat2 (&1) (&0) (&2)) A /\ + iq_represents n A (&5) + ==> iq_embeds n 3 + (iqmat3 (&1) (&0) (&0) (&1) (&0) (&1)) A \/ + iq_embeds n 3 + (iqmat3 (&1) (&0) (&0) (&1) (&0) (&2)) A \/ + iq_embeds n 3 + (iqmat3 (&1) (&0) (&0) (&2) (&0) (&2)) A \/ + iq_embeds n 3 + (iqmat3 (&1) (&0) (&0) (&2) (&0) (&3)) A \/ + iq_embeds n 3 + (iqmat3 (&1) (&0) (&0) (&2) (&0) (&4)) A \/ + iq_embeds n 3 + (iqmat3 (&1) (&0) (&0) (&2) (&0) (&5)) A \/ + iq_embeds n 3 + (iqmat3 (&1) (&0) (&0) (&2) (&1) (&4)) A \/ + iq_embeds n 3 + (iqmat3 (&1) (&0) (&0) (&2) (&1) (&5)) A`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(SPECL + [`n:num`; `A:num->num->int`; + `&1:int`; `&0:int`; `&2:int`; `&5:int`] IQ_ESCALATE_MAT2) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `a:int` + (X_CHOOSE_THEN `b:int` STRIP_ASSUME_TAC)) THEN + SUBGOAL_THEN `a pow 2 <= &5 /\ b pow 2 <= &10` ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; ALL_TAC] THEN + MP_TAC(MATCH_MP (SPECL [`a:int`; `b:int`] IQ_12_PARAMETERS) + (ASSUME `a pow 2 <= &5 /\ b pow 2 <= &10`)) THEN + DISCH_THEN(X_CHOOSE_THEN `q:int` + (X_CHOOSE_THEN `r:int` + (X_CHOOSE_THEN `k:int` + (CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC))))) THEN + SUBGOAL_THEN + `iq_embeds n 3 + (iqmat3 (&1) (&0) a (&2) (&2 * q + r) (&5)) A` + ASSUME_TAC THENL + [MATCH_ACCEPT_TAC(REWRITE_RULE[ASSUME `b = &2 * q + r`] (ASSUME + `iq_embeds n 3 (iqmat3 (&1) (&0) a (&2) b (&5)) A`)); + ALL_TAC] THEN + SUBGOAL_THEN + `iq_embeds n 3 (iqmat3 (&1) (&0) (&0) (&2) r k) A` + ASSUME_TAC THENL + [ONCE_REWRITE_TAC[ASSUME + `k = &5 - a pow 2 - &2 * q pow 2 - &2 * q * r`] THEN + MATCH_MP_TAC IQ_EMBEDS_CLEAR_12 THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `&0 <= k` ASSUME_TAC THENL + [MP_TAC(MATCH_MP + (ISPECL + [`n:num`; `3`; `iqmat3 (&1) (&0) (&0) (&2) r k`; + `A:num->num->int`] IQ_EMBEDDED_NONNEG) + (CONJ (ASSUME `iq_positive n A`) (ASSUME + `iq_embeds n 3 (iqmat3 (&1) (&0) (&0) (&2) r k) A`))) THEN + DISCH_THEN(MP_TAC o SPEC + `\i:num. if i = 2 then &1 else &0`) THEN + REWRITE_TAC[IQEVAL_MAT3] THEN CONV_TAC NUM_REDUCE_CONV THEN + INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `r = &1 ==> &1 <= k` ASSUME_TAC THENL + [DISCH_TAC THEN + MP_TAC(MATCH_MP + (ISPECL + [`n:num`; `3`; `iqmat3 (&1) (&0) (&0) (&2) r k`; + `A:num->num->int`] IQ_EMBEDDED_NONNEG) + (CONJ (ASSUME `iq_positive n A`) (ASSUME + `iq_embeds n 3 (iqmat3 (&1) (&0) (&0) (&2) r k) A`))) THEN + DISCH_THEN(MP_TAC o SPEC + `\i:num. if i = 1 then -- &1 else if i = 2 then &2 else &0`) THEN + ASM_REWRITE_TAC[IQEVAL_MAT3] THEN + CONV_TAC NUM_REDUCE_CONV THEN INT_ARITH_TAC; + ALL_TAC] THEN + UNDISCH_TAC + `(r = &0 /\ + (k = -- &1 \/ k = &1 \/ k = &2 \/ k = &3 \/ + k = &4 \/ k = &5)) \/ + (r = &1 /\ + (k = -- &3 \/ k = &0 \/ k = &1 \/ k = &4 \/ k = &5))` THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN STRIP_ASSUME_TAC) THEN + FIRST + [ASM_INT_ARITH_TAC; + ASM_MESON_TAC[IQ_EMBEDS_121_TO_112; IQ_EMBEDS_12X1_TO_111]]);; + +let IQ_EMBEDS_TERNARY = prove + (`!n A. + iq_symmetric n A /\ iq_positive n A /\ + iq_represents n A (&1) /\ iq_represents n A (&2) /\ + iq_represents n A (&3) /\ iq_represents n A (&5) + ==> iq_embeds n 3 + (iqmat3 (&1) (&0) (&0) (&1) (&0) (&1)) A \/ + iq_embeds n 3 + (iqmat3 (&1) (&0) (&0) (&1) (&0) (&2)) A \/ + iq_embeds n 3 + (iqmat3 (&1) (&0) (&0) (&1) (&0) (&3)) A \/ + iq_embeds n 3 + (iqmat3 (&1) (&0) (&0) (&2) (&0) (&2)) A \/ + iq_embeds n 3 + (iqmat3 (&1) (&0) (&0) (&2) (&0) (&3)) A \/ + iq_embeds n 3 + (iqmat3 (&1) (&0) (&0) (&2) (&0) (&4)) A \/ + iq_embeds n 3 + (iqmat3 (&1) (&0) (&0) (&2) (&0) (&5)) A \/ + iq_embeds n 3 + (iqmat3 (&1) (&0) (&0) (&2) (&1) (&4)) A \/ + iq_embeds n 3 + (iqmat3 (&1) (&0) (&0) (&2) (&1) (&5)) A`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(SPECL [`n:num`; `A:num->num->int`] IQ_EMBEDS_BINARY) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(DISJ_CASES_THEN ASSUME_TAC) THENL + [MP_TAC(SPECL [`n:num`; `A:num->num->int`] IQ_EMBEDS_TERNARY_11) THEN + ASM_REWRITE_TAC[] THEN MESON_TAC[]; + MP_TAC(SPECL [`n:num`; `A:num->num->int`] IQ_EMBEDS_TERNARY_12) THEN + ASM_REWRITE_TAC[] THEN MESON_TAC[]]);; + +let iqdiag = new_definition + `iqdiag (a:num->int) i j = if j = i then a i else &0`;; + +let iqdiag4 = new_definition + `iqdiag4 (a:int) b c d = + iqdiag + (\i. if i = 0 then a else if i = 1 then b else + if i = 2 then c else d)`;; + +let IQEVAL_IQDIAG = prove + (`!n a x. + iqeval n (iqdiag a) x = + isum (qindex n) (\i. a i * x i pow 2)`, + REPEAT GEN_TAC THEN REWRITE_TAC[iqeval; iqbilin] THEN + MATCH_MP_TAC ISUM_EQ THEN REWRITE_TAC[qindex; IN_ELIM_THM] THEN + X_GEN_TAC `i:num` THEN DISCH_TAC THEN + SIMP_TAC[iqdiag; COND_RAND; COND_RATOR; INT_MUL_LZERO] THEN + REWRITE_TAC[ISUM_DELTA] THEN + ASM_REWRITE_TAC[IN_ELIM_THM; INT_POW_2]);; + +let IQEVAL_DIAG4 = prove + (`!a b c d x. + iqeval 4 (iqdiag4 a b c d) x = + a * x 0 pow 2 + b * x 1 pow 2 + c * x 2 pow 2 + d * x 3 pow 2`, + REPEAT GEN_TAC THEN + REWRITE_TAC[iqdiag4; IQEVAL_IQDIAG; qindex; NUMSEG_LT] THEN + CONV_TAC NUM_REDUCE_CONV THEN + CONV_TAC(ONCE_DEPTH_CONV EXPAND_ISUM_CONV) THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC INT_RING);; + +let IQ_REPRESENTS_DIAG4 = prove + (`!a b c d m. + (?x y z w:int. + a * x pow 2 + b * y pow 2 + c * z pow 2 + d * w pow 2 = m) + ==> iq_represents 4 (iqdiag4 a b c d) m`, + REPEAT GEN_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` (X_CHOOSE_THEN `y:int` + (X_CHOOSE_THEN `z:int` (X_CHOOSE_TAC `w:int`)))) THEN + REWRITE_TAC[iq_represents] THEN + EXISTS_TAC + `\i:num. if i = 0 then (x:int) else if i = 1 then y else + if i = 2 then z else w` THEN + REWRITE_TAC[IQEVAL_DIAG4] THEN + CONV_TAC NUM_REDUCE_CONV THEN ASM_REWRITE_TAC[]);; + +let INT_THREE_SQUARES_OF_LEGENDRE = prove + (`!n:num. + ~(?a m. n = 4 EXP a * (8 * m + 7)) + ==> ?x y z:int. x pow 2 + y pow 2 + z pow 2 = &n`, + GEN_TAC THEN DISCH_TAC THEN + MP_TAC(SPEC `n:num` LEGENDRE_THREE_SQUARES) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `x:num` + (X_CHOOSE_THEN `y:num` (X_CHOOSE_TAC `z:num`))) THEN + MAP_EVERY EXISTS_TAC [`&x:int`; `&y:int`; `&z:int`] THEN + REWRITE_TAC[INT_OF_NUM_ADD; INT_OF_NUM_POW] THEN + ASM_REWRITE_TAC[]);; + +let INT_SAME_PARITY_HALF = prove + (`!x y:int. + x rem &2 = y rem &2 ==> ?e. x + y = &2 * e`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MP_TAC(SPECL [`x:int`; `&2:int`] INT_DIVISION) THEN + ANTS_TAC THENL [INT_ARITH_TAC; ALL_TAC] THEN + MP_TAC(SPECL [`y:int`; `&2:int`] INT_DIVISION) THEN + ANTS_TAC THENL [INT_ARITH_TAC; ALL_TAC] THEN + REPEAT STRIP_TAC THEN + EXISTS_TAC `x div &2 + y div &2 + x rem &2` THEN + ASM_INT_ARITH_TAC);; + +let INT_PARITY_WITNESS = prove + (`!x:int. (?a. x = &2 * a) \/ (?a. x = &2 * a + &1)`, + GEN_TAC THEN MP_TAC(SPEC `x:int` INT_REM_2_CASES) THEN + DISCH_THEN(DISJ_CASES_THEN ASSUME_TAC) THENL + [DISJ1_TAC THEN EXISTS_TAC `x div &2` THEN + MP_TAC(SPECL [`x:int`; `&2:int`] INT_DIVISION) THEN + ANTS_TAC THENL + [INT_ARITH_TAC; STRIP_TAC THEN ASM_INT_ARITH_TAC]; + DISJ2_TAC THEN EXISTS_TAC `x div &2` THEN + MP_TAC(SPECL [`x:int`; `&2:int`] INT_DIVISION) THEN + ANTS_TAC THENL + [INT_ARITH_TAC; STRIP_TAC THEN ASM_INT_ARITH_TAC]]);; + +let INT_TWO_MUL_NE_ONE = prove + (`!k:int. ~(&2 * k = &1)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN `(&2:int) divides &1` MP_TAC THENL + [REWRITE_TAC[int_divides] THEN EXISTS_TAC `k:int` THEN + ASM_REWRITE_TAC[]; + REWRITE_TAC[INT_DIVIDES_ONE] THEN INT_ARITH_TAC]);; + +let INT_ONE_ODD_SQUARES_NE_DOUBLE = prove + (`!a b c n:int. + ~((&2 * a + &1) pow 2 + (&2 * b) pow 2 + (&2 * c) pow 2 = + &2 * n)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN + `&2 * (n - &2 * a pow 2 - &2 * a - + &2 * b pow 2 - &2 * c pow 2) = &1` + ASSUME_TAC THENL + [MATCH_MP_TAC(INT_RING + `(&2*a + &1) pow 2 + (&2*b) pow 2 + (&2*c) pow 2 = &2*n + ==> &2 * (n - &2*a pow 2 - &2*a - + &2*b pow 2 - &2*c pow 2) = &1`) THEN + ASM_REWRITE_TAC[]; + MP_TAC(SPEC + `n - &2 * a pow 2 - &2 * a - + &2 * b pow 2 - &2 * c pow 2` + INT_TWO_MUL_NE_ONE) THEN + ASM_REWRITE_TAC[]]);; + +let INT_EVEN_EVEN_ODD_SQUARES_NE_DOUBLE = prove + (`!a b c n:int. + ~((&2 * a) pow 2 + (&2 * b) pow 2 + (&2 * c + &1) pow 2 = + &2 * n)`, + MESON_TAC[INT_ONE_ODD_SQUARES_NE_DOUBLE; + INT_RING + `(&2*a) pow 2 + (&2*b) pow 2 + (&2*c + &1) pow 2 = &2*n + ==> (&2*c + &1) pow 2 + (&2*a) pow 2 + (&2*b) pow 2 = &2*n`]);; + +let INT_EVEN_ODD_EVEN_SQUARES_NE_DOUBLE = prove + (`!a b c n:int. + ~((&2 * a) pow 2 + (&2 * b + &1) pow 2 + (&2 * c) pow 2 = + &2 * n)`, + MESON_TAC[INT_ONE_ODD_SQUARES_NE_DOUBLE; + INT_RING + `(&2*a) pow 2 + (&2*b + &1) pow 2 + (&2*c) pow 2 = &2*n + ==> (&2*b + &1) pow 2 + (&2*a) pow 2 + (&2*c) pow 2 = &2*n`]);; + +let INT_THREE_ODD_SQUARES_NE_DOUBLE = prove + (`!a b c n:int. + ~((&2 * a + &1) pow 2 + (&2 * b + &1) pow 2 + + (&2 * c + &1) pow 2 = &2 * n)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN + `&2 * (n - &2 * a pow 2 - &2 * a - + &2 * b pow 2 - &2 * b - + &2 * c pow 2 - &2 * c - &1) = &1` + ASSUME_TAC THENL + [MATCH_MP_TAC(INT_RING + `(&2*a + &1) pow 2 + (&2*b + &1) pow 2 + + (&2*c + &1) pow 2 = &2*n + ==> &2 * (n - &2*a pow 2 - &2*a - + &2*b pow 2 - &2*b - + &2*c pow 2 - &2*c - &1) = &1`) THEN + ASM_REWRITE_TAC[]; + MP_TAC(SPEC + `n - &2 * a pow 2 - &2 * a - + &2 * b pow 2 - &2 * b - + &2 * c pow 2 - &2 * c - &1` + INT_TWO_MUL_NE_ONE) THEN + ASM_REWRITE_TAC[]]);; + +let INT_THREE_PARITY_PAIR = prove + (`!x y z:int. + (?e. x + y = &2 * e) \/ + (?e. x + z = &2 * e) \/ + (?e. y + z = &2 * e)`, + REPEAT GEN_TAC THEN + MP_TAC(SPEC `x:int` INT_REM_2_CASES) THEN + MP_TAC(SPEC `y:int` INT_REM_2_CASES) THEN + MP_TAC(SPEC `z:int` INT_REM_2_CASES) THEN + MESON_TAC[INT_SAME_PARITY_HALF]);; + +let INT_PAIR_HALF = prove + (`!c d e:int. + c + d = &2 * e + ==> ?u v. &2 * u pow 2 + &2 * v pow 2 = c pow 2 + d pow 2`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MAP_EVERY EXISTS_TAC [`e:int`; `c - e:int`] THEN + MATCH_MP_TAC(INT_RING + `c + d = &2 * e + ==> &2 * e pow 2 + &2 * (c - e) pow 2 = c pow 2 + d pow 2`) THEN + ASM_REWRITE_TAC[]);; + +let REPR_112_OF_THREE_SQUARES = prove + (`!n:int. + (?u v w. u pow 2 + v pow 2 + w pow 2 = &2 * n) + ==> ?x y z. x pow 2 + y pow 2 + &2 * z pow 2 = n`, + GEN_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `u:int` + (X_CHOOSE_THEN `v:int` (X_CHOOSE_TAC `w:int`))) THEN + MP_TAC(SPEC `u:int` INT_PARITY_WITNESS) THEN + DISCH_THEN(DISJ_CASES_THEN + (X_CHOOSE_THEN `a:int` SUBST_ALL_TAC)) THEN + MP_TAC(SPEC `v:int` INT_PARITY_WITNESS) THEN + DISCH_THEN(DISJ_CASES_THEN + (X_CHOOSE_THEN `b:int` SUBST_ALL_TAC)) THEN + MP_TAC(SPEC `w:int` INT_PARITY_WITNESS) THEN + DISCH_THEN(DISJ_CASES_THEN + (X_CHOOSE_THEN `c:int` SUBST_ALL_TAC)) THENL + [MAP_EVERY EXISTS_TAC [`a + b:int`; `a - b:int`; `c:int`] THEN + FIRST_X_ASSUM(MP_TAC) THEN CONV_TAC INT_RING; + ASM_MESON_TAC[INT_EVEN_EVEN_ODD_SQUARES_NE_DOUBLE]; + ASM_MESON_TAC[INT_EVEN_ODD_EVEN_SQUARES_NE_DOUBLE]; + MAP_EVERY EXISTS_TAC + [`b + c + &1:int`; `b - c:int`; `a:int`] THEN + FIRST_X_ASSUM(MP_TAC) THEN CONV_TAC INT_RING; + ASM_MESON_TAC[INT_ONE_ODD_SQUARES_NE_DOUBLE]; + MAP_EVERY EXISTS_TAC + [`a + c + &1:int`; `a - c:int`; `b:int`] THEN + FIRST_X_ASSUM(MP_TAC) THEN CONV_TAC INT_RING; + MAP_EVERY EXISTS_TAC + [`a + b + &1:int`; `a - b:int`; `c:int`] THEN + FIRST_X_ASSUM(MP_TAC) THEN CONV_TAC INT_RING; + ASM_MESON_TAC[INT_THREE_ODD_SQUARES_NE_DOUBLE]]);; + +let REPR_122_OF_THREE_SQUARES = prove + (`!n:int. + (?a b c. a pow 2 + b pow 2 + c pow 2 = n) + ==> ?x y z. x pow 2 + &2 * y pow 2 + &2 * z pow 2 = n`, + GEN_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `a:int` + (X_CHOOSE_THEN `b:int` (X_CHOOSE_TAC `c:int`))) THEN + MP_TAC(SPECL [`a:int`; `b:int`; `c:int`] INT_THREE_PARITY_PAIR) THEN + DISCH_THEN(DISJ_CASES_THEN2 + (X_CHOOSE_THEN `e:int` ASSUME_TAC) + (DISJ_CASES_THEN (X_CHOOSE_THEN `e:int` ASSUME_TAC))) THENL + [MP_TAC(SPECL [`a:int`; `b:int`; `e:int`] INT_PAIR_HALF); + MP_TAC(SPECL [`a:int`; `c:int`; `e:int`] INT_PAIR_HALF); + MP_TAC(SPECL [`b:int`; `c:int`; `e:int`] INT_PAIR_HALF)] THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `u:int` (X_CHOOSE_TAC `v:int`)) THENL + [MAP_EVERY EXISTS_TAC [`c:int`; `u:int`; `v:int`]; + MAP_EVERY EXISTS_TAC [`b:int`; `u:int`; `v:int`]; + MAP_EVERY EXISTS_TAC [`a:int`; `u:int`; `v:int`]] THEN + ASM_INT_ARITH_TAC);; + +let THREE_SQUARES_AVOIDS_OF_MOD = prove + (`!u:num. + ~(u MOD 4 = 0) /\ ~(u MOD 8 = 7) + ==> ~(?a m. u = 4 EXP a * (8 * m + 7))`, + GEN_TAC THEN STRIP_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `a:num` (X_CHOOSE_THEN `m:num` ASSUME_TAC)) THEN + ASM_CASES_TAC `a = 0` THENL + [UNDISCH_TAC `~(u MOD 8 = 7)` THEN + ASM_REWRITE_TAC[EXP; MULT_CLAUSES; MOD_MULT_ADD] THEN + CONV_TAC NUM_REDUCE_CONV; + MP_TAC(SPEC `a:num` num_CASES) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `k:num` SUBST_ALL_TAC) THEN + UNDISCH_TAC `~(u MOD 4 = 0)` THEN ASM_REWRITE_TAC[EXP] THEN + REWRITE_TAC[ARITH_RULE `(4 * x) * y = 4 * (x * y)`; MOD_MULT]]);; + +let THREE_SQUARES_AVOIDS_FOUR_MUL = prove + (`!u:num. + ~(?a m. u = 4 EXP a * (8 * m + 7)) + ==> ~(?a m. 4 * u = 4 EXP a * (8 * m + 7))`, + GEN_TAC THEN DISCH_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `a:num` (X_CHOOSE_THEN `m:num` ASSUME_TAC)) THEN + ASM_CASES_TAC `a = 0` THENL + [FIRST_X_ASSUM SUBST_ALL_TAC THEN + UNDISCH_TAC `4 * u = 4 EXP 0 * (8 * m + 7)` THEN + REWRITE_TAC[EXP; MULT_CLAUSES] THEN + DISCH_THEN(MP_TAC o AP_TERM `\n:num. n MOD 4`) THEN + REWRITE_TAC[ARITH_RULE `8 * m + 7 = 4 * (2 * m + 1) + 3`] THEN + SIMP_TAC[MOD_MULT_ADD; MOD_MULT] THEN CONV_TAC NUM_REDUCE_CONV; + MP_TAC(SPEC `a:num` num_CASES) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `k:num` SUBST_ALL_TAC) THEN + SUBGOAL_THEN `u = 4 EXP k * (8 * m + 7)` ASSUME_TAC THENL + [UNDISCH_TAC `4 * u = 4 EXP (SUC k) * (8 * m + 7)` THEN + REWRITE_TAC[EXP; ARITH_RULE `(4 * x) * y = 4 * (x * y)`; + ARITH_RULE `(4 * x = 4 * y) <=> x = y`]; + UNDISCH_TAC `~(?a m. u = 4 EXP a * (8 * m + 7))` THEN + ASM_MESON_TAC[]]]);; + +let IQ_UNIVERSAL_DIAG4_OF_NUM = prove + (`!a b c d. + (!n:num. 0 < n + ==> ?x y z w:int. + a * x pow 2 + b * y pow 2 + + c * z pow 2 + d * w pow 2 = &n) + ==> iq_universal 4 (iqdiag4 a b c d)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[iq_universal] THEN + X_GEN_TAC `m:int` THEN DISCH_TAC THEN + MP_TAC(EQ_MP (SYM(SPEC `m:int` INT_OF_NUM_EXISTS)) + (MATCH_MP (SPECL [`&0:int`; `m:int`] INT_LT_IMP_LE) + (ASSUME `&0 < m`))) THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` SUBST_ALL_TAC) THEN + MATCH_MP_TAC IQ_REPRESENTS_DIAG4 THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + UNDISCH_TAC `&0 < &n` THEN REWRITE_TAC[INT_OF_NUM_LT]);; + +let IQ_DIAG4_REPRESENTATION_SCALE4 = prove + (`!a b c d r:int. + (?x y z w. + a * x pow 2 + b * y pow 2 + + c * z pow 2 + d * w pow 2 = r) + ==> ?x y z w. + a * x pow 2 + b * y pow 2 + + c * z pow 2 + d * w pow 2 = &4 * r`, + REPEAT GEN_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` (X_CHOOSE_THEN `y:int` + (X_CHOOSE_THEN `z:int` (X_CHOOSE_TAC `w:int`)))) THEN + MAP_EVERY EXISTS_TAC + [`&2 * x:int`; `&2 * y:int`; `&2 * z:int`; `&2 * w:int`] THEN + FIRST_X_ASSUM(MP_TAC) THEN CONV_TAC INT_RING);; + +let IQ_UNIVERSAL_122C_OF_111C = prove + (`!c:int. + iq_universal 4 (iqdiag4 (&1:int) (&1:int) (&1:int) c) + ==> iq_universal 4 (iqdiag4 (&1:int) (&2:int) (&2:int) c)`, + GEN_TAC THEN REWRITE_TAC[iq_universal] THEN DISCH_TAC THEN + X_GEN_TAC `m:int` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `m:int`) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[iq_represents; IQEVAL_DIAG4] THEN + DISCH_THEN(X_CHOOSE_THEN `v:num->int` ASSUME_TAC) THEN + MP_TAC(SPEC + `(m:int) - (c:int) * ((v:num->int) 3) pow 2` + REPR_122_OF_THREE_SQUARES) THEN + ANTS_TAC THENL + [MAP_EVERY EXISTS_TAC + [`(v:num->int) 0`; `(v:num->int) 1`; `(v:num->int) 2`] THEN + FIRST_X_ASSUM(MP_TAC) THEN CONV_TAC INT_RING; + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` (X_CHOOSE_TAC `z:int`))) THEN + EXISTS_TAC + `\i:num. + if i = 0 then (x:int) else if i = 1 then y else + if i = 2 then z else (v:num->int) 3` THEN + REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN + FIRST_X_ASSUM(MP_TAC) THEN CONV_TAC INT_RING]);; + +let THREE_SQUARES_AVOIDS_SUB2 = prove + (`!n:num. + 0 < n /\ (n MOD 4 = 0 \/ n MOD 8 = 7) + ==> ~((n - 2) MOD 4 = 0) /\ ~((n - 2) MOD 8 = 7)`, + GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (DISJ_CASES_THEN ASSUME_TAC)) THENL + [SUBGOAL_THEN `n = n DIV 4 * 4` ASSUME_TAC THENL + [MP_TAC(SPECL [`n:num`; `4`] DIVISION) THEN + CONV_TAC NUM_REDUCE_CONV THEN ASM_REWRITE_TAC[ADD_CLAUSES] THEN + MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `n - 2 = 4 * (n DIV 4 - 1) + 2` ASSUME_TAC THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `(n - 2) MOD 4 = 2` ASSUME_TAC THENL + [ASM_REWRITE_TAC[MOD_MULT_ADD] THEN CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV; + DISCH_TAC THEN + SUBGOAL_THEN + `(n - 2) MOD 4 = (n - 2) MOD 8 MOD 4` + MP_TAC THENL + [REWRITE_TAC[ARITH_RULE `8 = 4 * 2`; MOD_MOD]; + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV]]; + SUBGOAL_THEN `n = n DIV 8 * 8 + 7` ASSUME_TAC THENL + [MP_TAC(SPECL [`n:num`; `8`] DIVISION) THEN + CONV_TAC NUM_REDUCE_CONV THEN ASM_REWRITE_TAC[] THEN MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `n - 2 = 8 * (n DIV 8) + 5` ASSUME_TAC THENL + [ASM_ARITH_TAC; + CONJ_TAC THENL + [ASM_REWRITE_TAC + [ARITH_RULE `8 * q + 5 = 4 * (2 * q + 1) + 1`; + MOD_MULT_ADD] THEN + CONV_TAC NUM_REDUCE_CONV; + ASM_REWRITE_TAC[MOD_MULT_ADD] THEN CONV_TAC NUM_REDUCE_CONV]]]);; + +let IQ_UNIVERSAL_1112_NUM = prove + (`!n:num. + 0 < n + ==> ?x y z w:int. + &1 * x pow 2 + &1 * y pow 2 + + &1 * z pow 2 + &2 * w pow 2 = &n`, + GEN_TAC THEN DISCH_TAC THEN + ASM_CASES_TAC `n MOD 4 = 0 \/ n MOD 8 = 7` THENL + [SUBGOAL_THEN `2 <= n` ASSUME_TAC THENL + [ASM_CASES_TAC `n = 1` THENL + [UNDISCH_TAC `n MOD 4 = 0 \/ n MOD 8 = 7` THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV; + ASM_ARITH_TAC]; + ALL_TAC] THEN + MP_TAC(MATCH_MP INT_THREE_SQUARES_OF_LEGENDRE + (MATCH_MP THREE_SQUARES_AVOIDS_OF_MOD + (MATCH_MP THREE_SQUARES_AVOIDS_SUB2 + (CONJ (ASSUME `0 < n`) + (ASSUME `n MOD 4 = 0 \/ n MOD 8 = 7`))))) THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` (X_CHOOSE_TAC `z:int`))) THEN + MAP_EVERY EXISTS_TAC [`x:int`; `y:int`; `z:int`; `&1:int`] THEN + FIRST_X_ASSUM(MP_TAC) THEN + ASM_SIMP_TAC[GSYM INT_OF_NUM_SUB] THEN CONV_TAC INT_RING; + SUBGOAL_THEN + `~(n MOD 4 = 0) /\ ~(n MOD 8 = 7)` + ASSUME_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + MP_TAC(MATCH_MP INT_THREE_SQUARES_OF_LEGENDRE + (MATCH_MP THREE_SQUARES_AVOIDS_OF_MOD + (ASSUME `~(n MOD 4 = 0) /\ ~(n MOD 8 = 7)`))) THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` (X_CHOOSE_TAC `z:int`))) THEN + MAP_EVERY EXISTS_TAC [`x:int`; `y:int`; `z:int`; `&0:int`] THEN + FIRST_X_ASSUM(MP_TAC) THEN CONV_TAC INT_RING]);; + +let IQ_UNIVERSAL_1112 = prove + (`iq_universal 4 (iqdiag4 (&1:int) (&1:int) (&1:int) (&2:int))`, + MATCH_MP_TAC IQ_UNIVERSAL_DIAG4_OF_NUM THEN + ACCEPT_TAC IQ_UNIVERSAL_1112_NUM);; + +let INT_THREE_SQUARES_OF_MOD = prove + (`!u:num. + ~(u MOD 4 = 0) /\ ~(u MOD 8 = 7) + ==> ?x y z:int. x pow 2 + y pow 2 + z pow 2 = &u`, + MESON_TAC[THREE_SQUARES_AVOIDS_OF_MOD; + INT_THREE_SQUARES_OF_LEGENDRE]);; + +let IQ_DIAG4_REPRESENTATION_SCALE4_NUM = prove + (`!a b c d k. + (?x y z w:int. + a * x pow 2 + b * y pow 2 + + c * z pow 2 + d * w pow 2 = &k) + ==> ?x y z w:int. + a * x pow 2 + b * y pow 2 + + c * z pow 2 + d * w pow 2 = &(4 * k)`, + REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o MATCH_MP + (SPECL [`a:int`; `b:int`; `c:int`; `d:int`; `&k:int`] + IQ_DIAG4_REPRESENTATION_SCALE4)) THEN + REWRITE_TAC[INT_OF_NUM_MUL]);; + +let IQ_DIAG4_111C_REPRESENTATION_STEP = prove + (`!c:int. !n u k:num. !d:int. + (?x y z:int. x pow 2 + y pow 2 + z pow 2 = &u) /\ + c * d pow 2 = &k /\ n = u + k + ==> ?x y z w:int. + &1 * x pow 2 + &1 * y pow 2 + + &1 * z pow 2 + c * w pow 2 = &n`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` (X_CHOOSE_TAC `z:int`))) + (CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC)) THEN + FIRST_X_ASSUM SUBST1_TAC THEN + MAP_EVERY EXISTS_TAC [`x:int`; `y:int`; `z:int`; `d:int`] THEN + REWRITE_TAC[GSYM INT_OF_NUM_ADD] THEN + FIRST_X_ASSUM(MP_TAC) THEN FIRST_X_ASSUM(MP_TAC) THEN + CONV_TAC INT_RING);; + +let MOD32_7_CASES = prove + (`!n:num. + n MOD 8 = 7 + ==> n MOD 32 = 7 \/ n MOD 32 = 15 \/ + n MOD 32 = 23 \/ n MOD 32 = 31`, + GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN `(n MOD 32) MOD 8 = 7` ASSUME_TAC THENL + [SUBGOAL_THEN `(n MOD 32) MOD 8 = n MOD 8` MP_TAC THENL + [REWRITE_TAC[ARITH_RULE `32 = 8 * 4`; MOD_MOD]; + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + MP_TAC(SPECL [`n MOD 32`; `8`] DIVISION) THEN + CONV_TAC NUM_REDUCE_CONV THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + MP_TAC(SPECL [`n:num`; `32`] DIVISION) THEN + CONV_TAC NUM_REDUCE_CONV THEN STRIP_TAC THEN + ASM_CASES_TAC `(n MOD 32) DIV 8 = 0` THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + ASM_CASES_TAC `(n MOD 32) DIV 8 = 1` THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + ASM_CASES_TAC `(n MOD 32) DIV 8 = 2` THEN ASM_ARITH_TAC);; + +let INT_THREE_SQUARES_8Q_MOD = prove + (`!q r:num. + ~(r MOD 4 = 0) /\ ~(r MOD 8 = 7) + ==> ?x y z:int. + x pow 2 + y pow 2 + z pow 2 = &(8 * q + r)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC INT_THREE_SQUARES_OF_MOD THEN CONJ_TAC THENL + [ASM_REWRITE_TAC + [ARITH_RULE `8 * q + r = 4 * (2 * q) + r`; MOD_MULT_ADD]; + ASM_REWRITE_TAC[MOD_MULT_ADD]]);; + +let INT_THREE_SQUARES_4MUL_8Q_MOD = prove + (`!q r:num. + ~(r MOD 4 = 0) /\ ~(r MOD 8 = 7) + ==> ?x y z:int. + x pow 2 + y pow 2 + z pow 2 = &(4 * (8 * q + r))`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC INT_THREE_SQUARES_OF_LEGENDRE THEN + MATCH_MP_TAC THREE_SQUARES_AVOIDS_FOUR_MUL THEN + MATCH_MP_TAC THREE_SQUARES_AVOIDS_OF_MOD THEN CONJ_TAC THENL + [ASM_REWRITE_TAC + [ARITH_RULE `8 * q + r = 4 * (2 * q) + r`; MOD_MULT_ADD]; + ASM_REWRITE_TAC[MOD_MULT_ADD]]);; + +let IQ_UNIVERSAL_1113_NUM = prove + (`!n:num. + 0 < n + ==> ?x y z w:int. + &1 * x pow 2 + &1 * y pow 2 + + &1 * z pow 2 + &3 * w pow 2 = &n`, + MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN + DISCH_TAC THEN DISCH_TAC THEN + ASM_CASES_TAC `n MOD 4 = 0` THENL + [SUBGOAL_THEN `n = 4 * (n DIV 4)` ASSUME_TAC THENL + [MP_TAC(SPECL [`n:num`; `4`] DIVISION) THEN + CONV_TAC NUM_REDUCE_CONV THEN + ASM_REWRITE_TAC[ADD_CLAUSES] THEN ARITH_TAC; + ALL_TAC] THEN + FIRST_X_ASSUM SUBST1_TAC THEN + MATCH_MP_TAC IQ_DIAG4_REPRESENTATION_SCALE4_NUM THEN + SUBGOAL_THEN + `n DIV 4 < n /\ 0 < n DIV 4` + STRIP_ASSUME_TAC THENL + [MP_TAC(SPECL [`n:num`; `4`] DIVISION) THEN + CONV_TAC NUM_REDUCE_CONV THEN + ASM_REWRITE_TAC[ADD_CLAUSES] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n DIV 4`) THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + ASM_CASES_TAC `n MOD 8 = 7` THENL + [ASM_CASES_TAC `n MOD 32 = 31` THENL + [SUBGOAL_THEN `n = 32 * (n DIV 32) + 31` ASSUME_TAC THENL + [MP_TAC(SPECL [`n:num`; `32`] DIVISION) THEN + CONV_TAC NUM_REDUCE_CONV THEN + ASM_REWRITE_TAC[] THEN ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(SPECL + [`&3:int`; `n:num`; `8 * (4 * (n DIV 32) + 2) + 3`; + `12`; `&2:int`] + IQ_DIAG4_111C_REPRESENTATION_STEP) THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC INT_THREE_SQUARES_8Q_MOD THEN + CONV_TAC NUM_REDUCE_CONV; + CONV_TAC INT_REDUCE_CONV; + ASM_ARITH_TAC]; + MP_TAC(SPEC `n:num` MOD32_7_CASES) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(DISJ_CASES_THEN2 ASSUME_TAC + (DISJ_CASES_THEN ASSUME_TAC)) THENL + [SUBGOAL_THEN `n = 32 * (n DIV 32) + 7` ASSUME_TAC THENL + [MP_TAC(SPECL [`n:num`; `32`] DIVISION) THEN + CONV_TAC NUM_REDUCE_CONV THEN + ASM_REWRITE_TAC[] THEN ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(SPECL + [`&3:int`; `n:num`; `4 * (8 * (n DIV 32) + 1)`; + `3`; `&1:int`] + IQ_DIAG4_111C_REPRESENTATION_STEP) THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC INT_THREE_SQUARES_4MUL_8Q_MOD THEN + CONV_TAC NUM_REDUCE_CONV; + CONV_TAC INT_REDUCE_CONV; + ASM_ARITH_TAC]; + SUBGOAL_THEN `n = 32 * (n DIV 32) + 15` ASSUME_TAC THENL + [MP_TAC(SPECL [`n:num`; `32`] DIVISION) THEN + CONV_TAC NUM_REDUCE_CONV THEN + ASM_REWRITE_TAC[] THEN ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(SPECL + [`&3:int`; `n:num`; `4 * (8 * (n DIV 32) + 3)`; + `3`; `&1:int`] + IQ_DIAG4_111C_REPRESENTATION_STEP) THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC INT_THREE_SQUARES_4MUL_8Q_MOD THEN + CONV_TAC NUM_REDUCE_CONV; + CONV_TAC INT_REDUCE_CONV; + ASM_ARITH_TAC]; + SUBGOAL_THEN `n = 32 * (n DIV 32) + 23` ASSUME_TAC THENL + [MP_TAC(SPECL [`n:num`; `32`] DIVISION) THEN + CONV_TAC NUM_REDUCE_CONV THEN + ASM_REWRITE_TAC[] THEN ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(SPECL + [`&3:int`; `n:num`; `4 * (8 * (n DIV 32) + 5)`; + `3`; `&1:int`] + IQ_DIAG4_111C_REPRESENTATION_STEP) THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC INT_THREE_SQUARES_4MUL_8Q_MOD THEN + CONV_TAC NUM_REDUCE_CONV; + CONV_TAC INT_REDUCE_CONV; + ASM_ARITH_TAC]]]; + MATCH_MP_TAC(SPECL + [`&3:int`; `n:num`; `n:num`; `0`; `&0:int`] + IQ_DIAG4_111C_REPRESENTATION_STEP) THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC INT_THREE_SQUARES_OF_MOD THEN ASM_REWRITE_TAC[]; + CONV_TAC INT_REDUCE_CONV; + ARITH_TAC]]);; + +let IQ_UNIVERSAL_1114_NUM = prove + (`!n:num. + 0 < n + ==> ?x y z w:int. + &1 * x pow 2 + &1 * y pow 2 + + &1 * z pow 2 + &4 * w pow 2 = &n`, + MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN + DISCH_TAC THEN DISCH_TAC THEN + ASM_CASES_TAC `n MOD 4 = 0` THENL + [SUBGOAL_THEN `n = 4 * (n DIV 4)` ASSUME_TAC THENL + [MP_TAC(SPECL [`n:num`; `4`] DIVISION) THEN + CONV_TAC NUM_REDUCE_CONV THEN + ASM_REWRITE_TAC[ADD_CLAUSES] THEN ARITH_TAC; + ALL_TAC] THEN + FIRST_X_ASSUM SUBST1_TAC THEN + MATCH_MP_TAC IQ_DIAG4_REPRESENTATION_SCALE4_NUM THEN + SUBGOAL_THEN + `n DIV 4 < n /\ 0 < n DIV 4` + STRIP_ASSUME_TAC THENL + [MP_TAC(SPECL [`n:num`; `4`] DIVISION) THEN + CONV_TAC NUM_REDUCE_CONV THEN + ASM_REWRITE_TAC[ADD_CLAUSES] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n DIV 4`) THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + ASM_CASES_TAC `n MOD 8 = 7` THENL + [SUBGOAL_THEN `n = 8 * (n DIV 8) + 7` ASSUME_TAC THENL + [MP_TAC(SPECL [`n:num`; `8`] DIVISION) THEN + CONV_TAC NUM_REDUCE_CONV THEN ASM_REWRITE_TAC[] THEN ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(SPECL + [`&4:int`; `n:num`; `8 * (n DIV 8) + 3`; `4`; `&1:int`] + IQ_DIAG4_111C_REPRESENTATION_STEP) THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC INT_THREE_SQUARES_8Q_MOD THEN + CONV_TAC NUM_REDUCE_CONV; + CONV_TAC INT_REDUCE_CONV; + ASM_ARITH_TAC]; + MATCH_MP_TAC(SPECL + [`&4:int`; `n:num`; `n:num`; `0`; `&0:int`] + IQ_DIAG4_111C_REPRESENTATION_STEP) THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC INT_THREE_SQUARES_OF_MOD THEN ASM_REWRITE_TAC[]; + CONV_TAC INT_REDUCE_CONV; + ARITH_TAC]]);; + +let IQ_UNIVERSAL_1115_NUM = prove + (`!n:num. + 0 < n + ==> ?x y z w:int. + &1 * x pow 2 + &1 * y pow 2 + + &1 * z pow 2 + &5 * w pow 2 = &n`, + MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN + DISCH_TAC THEN DISCH_TAC THEN + ASM_CASES_TAC `n MOD 4 = 0` THENL + [SUBGOAL_THEN `n = 4 * (n DIV 4)` ASSUME_TAC THENL + [MP_TAC(SPECL [`n:num`; `4`] DIVISION) THEN + CONV_TAC NUM_REDUCE_CONV THEN + ASM_REWRITE_TAC[ADD_CLAUSES] THEN ARITH_TAC; + ALL_TAC] THEN + FIRST_X_ASSUM SUBST1_TAC THEN + MATCH_MP_TAC IQ_DIAG4_REPRESENTATION_SCALE4_NUM THEN + SUBGOAL_THEN + `n DIV 4 < n /\ 0 < n DIV 4` + STRIP_ASSUME_TAC THENL + [MP_TAC(SPECL [`n:num`; `4`] DIVISION) THEN + CONV_TAC NUM_REDUCE_CONV THEN + ASM_REWRITE_TAC[ADD_CLAUSES] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n DIV 4`) THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + ASM_CASES_TAC `n MOD 8 = 7` THENL + [SUBGOAL_THEN `n = 8 * (n DIV 8) + 7` ASSUME_TAC THENL + [MP_TAC(SPECL [`n:num`; `8`] DIVISION) THEN + CONV_TAC NUM_REDUCE_CONV THEN ASM_REWRITE_TAC[] THEN ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(SPECL + [`&5:int`; `n:num`; `8 * (n DIV 8) + 2`; `5`; `&1:int`] + IQ_DIAG4_111C_REPRESENTATION_STEP) THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC INT_THREE_SQUARES_8Q_MOD THEN + CONV_TAC NUM_REDUCE_CONV; + CONV_TAC INT_REDUCE_CONV; + ASM_ARITH_TAC]; + MATCH_MP_TAC(SPECL + [`&5:int`; `n:num`; `n:num`; `0`; `&0:int`] + IQ_DIAG4_111C_REPRESENTATION_STEP) THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC INT_THREE_SQUARES_OF_MOD THEN ASM_REWRITE_TAC[]; + CONV_TAC INT_REDUCE_CONV; + ARITH_TAC]]);; + +let IQ_UNIVERSAL_1116_NUM = prove + (`!n:num. + 0 < n + ==> ?x y z w:int. + &1 * x pow 2 + &1 * y pow 2 + + &1 * z pow 2 + &6 * w pow 2 = &n`, + MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN + DISCH_TAC THEN DISCH_TAC THEN + ASM_CASES_TAC `n MOD 4 = 0` THENL + [SUBGOAL_THEN `n = 4 * (n DIV 4)` ASSUME_TAC THENL + [MP_TAC(SPECL [`n:num`; `4`] DIVISION) THEN + CONV_TAC NUM_REDUCE_CONV THEN + ASM_REWRITE_TAC[ADD_CLAUSES] THEN ARITH_TAC; + ALL_TAC] THEN + FIRST_X_ASSUM SUBST1_TAC THEN + MATCH_MP_TAC IQ_DIAG4_REPRESENTATION_SCALE4_NUM THEN + SUBGOAL_THEN + `n DIV 4 < n /\ 0 < n DIV 4` + STRIP_ASSUME_TAC THENL + [MP_TAC(SPECL [`n:num`; `4`] DIVISION) THEN + CONV_TAC NUM_REDUCE_CONV THEN + ASM_REWRITE_TAC[ADD_CLAUSES] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n DIV 4`) THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + ASM_CASES_TAC `n MOD 8 = 7` THENL + [SUBGOAL_THEN `n = 8 * (n DIV 8) + 7` ASSUME_TAC THENL + [MP_TAC(SPECL [`n:num`; `8`] DIVISION) THEN + CONV_TAC NUM_REDUCE_CONV THEN ASM_REWRITE_TAC[] THEN ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(SPECL + [`&6:int`; `n:num`; `8 * (n DIV 8) + 1`; `6`; `&1:int`] + IQ_DIAG4_111C_REPRESENTATION_STEP) THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC INT_THREE_SQUARES_8Q_MOD THEN + CONV_TAC NUM_REDUCE_CONV; + CONV_TAC INT_REDUCE_CONV; + ASM_ARITH_TAC]; + MATCH_MP_TAC(SPECL + [`&6:int`; `n:num`; `n:num`; `0`; `&0:int`] + IQ_DIAG4_111C_REPRESENTATION_STEP) THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC INT_THREE_SQUARES_OF_MOD THEN ASM_REWRITE_TAC[]; + CONV_TAC INT_REDUCE_CONV; + ARITH_TAC]]);; + +let IQ_UNIVERSAL_1117_NUM = prove + (`!n:num. + 0 < n + ==> ?x y z w:int. + &1 * x pow 2 + &1 * y pow 2 + + &1 * z pow 2 + &7 * w pow 2 = &n`, + MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN + DISCH_TAC THEN DISCH_TAC THEN + ASM_CASES_TAC `n MOD 4 = 0` THENL + [SUBGOAL_THEN `n = 4 * (n DIV 4)` ASSUME_TAC THENL + [MP_TAC(SPECL [`n:num`; `4`] DIVISION) THEN + CONV_TAC NUM_REDUCE_CONV THEN + ASM_REWRITE_TAC[ADD_CLAUSES] THEN ARITH_TAC; + ALL_TAC] THEN + FIRST_X_ASSUM SUBST1_TAC THEN + MATCH_MP_TAC IQ_DIAG4_REPRESENTATION_SCALE4_NUM THEN + SUBGOAL_THEN + `n DIV 4 < n /\ 0 < n DIV 4` + STRIP_ASSUME_TAC THENL + [MP_TAC(SPECL [`n:num`; `4`] DIVISION) THEN + CONV_TAC NUM_REDUCE_CONV THEN + ASM_REWRITE_TAC[ADD_CLAUSES] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n DIV 4`) THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + ASM_CASES_TAC `n MOD 8 = 7` THENL + [ASM_CASES_TAC `n = 7` THENL + [MAP_EVERY EXISTS_TAC + [`&0:int`; `&0:int`; `&0:int`; `&1:int`] THEN + ASM_REWRITE_TAC[] THEN CONV_TAC INT_REDUCE_CONV; + ALL_TAC] THEN + ASM_CASES_TAC `n = 23` THENL + [MAP_EVERY EXISTS_TAC + [`&4:int`; `&0:int`; `&0:int`; `&1:int`] THEN + ASM_REWRITE_TAC[] THEN CONV_TAC INT_REDUCE_CONV; + ALL_TAC] THEN + ASM_CASES_TAC `n MOD 32 = 15 \/ n MOD 32 = 31` THENL + [FIRST_X_ASSUM(DISJ_CASES_THEN ASSUME_TAC) THENL + [SUBGOAL_THEN `n = 32 * (n DIV 32) + 15` ASSUME_TAC THENL + [MP_TAC(SPECL [`n:num`; `32`] DIVISION) THEN + CONV_TAC NUM_REDUCE_CONV THEN + ASM_REWRITE_TAC[] THEN ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(SPECL + [`&7:int`; `n:num`; `4 * (8 * (n DIV 32) + 2)`; + `7`; `&1:int`] + IQ_DIAG4_111C_REPRESENTATION_STEP) THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC INT_THREE_SQUARES_4MUL_8Q_MOD THEN + CONV_TAC NUM_REDUCE_CONV; + CONV_TAC INT_REDUCE_CONV; + ASM_ARITH_TAC]; + SUBGOAL_THEN `n = 32 * (n DIV 32) + 31` ASSUME_TAC THENL + [MP_TAC(SPECL [`n:num`; `32`] DIVISION) THEN + CONV_TAC NUM_REDUCE_CONV THEN + ASM_REWRITE_TAC[] THEN ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(SPECL + [`&7:int`; `n:num`; `4 * (8 * (n DIV 32) + 6)`; + `7`; `&1:int`] + IQ_DIAG4_111C_REPRESENTATION_STEP) THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC INT_THREE_SQUARES_4MUL_8Q_MOD THEN + CONV_TAC NUM_REDUCE_CONV; + CONV_TAC INT_REDUCE_CONV; + ASM_ARITH_TAC]]; + SUBGOAL_THEN + `~(n MOD 32 = 15) /\ ~(n MOD 32 = 31)` + STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + MP_TAC(SPEC `n:num` MOD32_7_CASES) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(DISJ_CASES_THEN ASSUME_TAC) THENL + [SUBGOAL_THEN `n = 32 * (n DIV 32) + 7` ASSUME_TAC THENL + [MP_TAC(SPECL [`n:num`; `32`] DIVISION) THEN + CONV_TAC NUM_REDUCE_CONV THEN + ASM_REWRITE_TAC[] THEN ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `0 < n DIV 32` ASSUME_TAC THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC(SPECL + [`&7:int`; `n:num`; + `8 * (4 * (n DIV 32 - 1) + 1) + 3`; + `28`; `&2:int`] + IQ_DIAG4_111C_REPRESENTATION_STEP) THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC INT_THREE_SQUARES_8Q_MOD THEN + CONV_TAC NUM_REDUCE_CONV; + CONV_TAC INT_REDUCE_CONV; + ASM_ARITH_TAC]; + SUBGOAL_THEN `n = 32 * (n DIV 32) + 23` ASSUME_TAC THENL + [MP_TAC(SPECL [`n:num`; `32`] DIVISION) THEN + CONV_TAC NUM_REDUCE_CONV THEN + ASM_REWRITE_TAC[] THEN ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `0 < n DIV 32` ASSUME_TAC THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC(SPECL + [`&7:int`; `n:num`; + `8 * (4 * (n DIV 32 - 1) + 3) + 3`; + `28`; `&2:int`] + IQ_DIAG4_111C_REPRESENTATION_STEP) THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC INT_THREE_SQUARES_8Q_MOD THEN + CONV_TAC NUM_REDUCE_CONV; + CONV_TAC INT_REDUCE_CONV; + ASM_ARITH_TAC]]]; + MATCH_MP_TAC(SPECL + [`&7:int`; `n:num`; `n:num`; `0`; `&0:int`] + IQ_DIAG4_111C_REPRESENTATION_STEP) THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC INT_THREE_SQUARES_OF_MOD THEN ASM_REWRITE_TAC[]; + CONV_TAC INT_REDUCE_CONV; + ARITH_TAC]]);; + +let IQ_UNIVERSAL_1113 = prove + (`iq_universal 4 (iqdiag4 (&1:int) (&1:int) (&1:int) (&3:int))`, + MATCH_MP_TAC IQ_UNIVERSAL_DIAG4_OF_NUM THEN + ACCEPT_TAC IQ_UNIVERSAL_1113_NUM);; + +let IQ_UNIVERSAL_1114 = prove + (`iq_universal 4 (iqdiag4 (&1:int) (&1:int) (&1:int) (&4:int))`, + MATCH_MP_TAC IQ_UNIVERSAL_DIAG4_OF_NUM THEN + ACCEPT_TAC IQ_UNIVERSAL_1114_NUM);; + +let IQ_UNIVERSAL_1115 = prove + (`iq_universal 4 (iqdiag4 (&1:int) (&1:int) (&1:int) (&5:int))`, + MATCH_MP_TAC IQ_UNIVERSAL_DIAG4_OF_NUM THEN + ACCEPT_TAC IQ_UNIVERSAL_1115_NUM);; + +let IQ_UNIVERSAL_1116 = prove + (`iq_universal 4 (iqdiag4 (&1:int) (&1:int) (&1:int) (&6:int))`, + MATCH_MP_TAC IQ_UNIVERSAL_DIAG4_OF_NUM THEN + ACCEPT_TAC IQ_UNIVERSAL_1116_NUM);; + +let IQ_UNIVERSAL_1117 = prove + (`iq_universal 4 (iqdiag4 (&1:int) (&1:int) (&1:int) (&7:int))`, + MATCH_MP_TAC IQ_UNIVERSAL_DIAG4_OF_NUM THEN + ACCEPT_TAC IQ_UNIVERSAL_1117_NUM);; + +let INT_REPRESENTS_112_OF_LEGENDRE = prove + (`!n:num. + ~(?a m. 2 * n = 4 EXP a * (8 * m + 7)) + ==> ?x y z:int. x pow 2 + y pow 2 + &2 * z pow 2 = &n`, + GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(SPEC `&n:int` REPR_112_OF_THREE_SQUARES) THEN + REWRITE_TAC[INT_OF_NUM_MUL] THEN + MATCH_MP_TAC INT_THREE_SQUARES_OF_LEGENDRE THEN + ASM_REWRITE_TAC[]);; + +let MOD4_CASES = prove + (`!n:num. + n MOD 4 = 0 \/ n MOD 4 = 1 \/ n MOD 4 = 2 \/ n MOD 4 = 3`, + GEN_TAC THEN + MP_TAC(SPECL [`n:num`; `4`] DIVISION) THEN + CONV_TAC NUM_REDUCE_CONV THEN STRIP_TAC THEN + ASM_CASES_TAC `n MOD 4 = 0` THENL + [ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_CASES_TAC `n MOD 4 = 1` THENL + [ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_CASES_TAC `n MOD 4 = 2` THEN ASM_REWRITE_TAC[] THEN + ASM_ARITH_TAC);; + +let MOD2_OF_MOD4 = prove + (`!n:num. (n MOD 4) MOD 2 = n MOD 2`, + REWRITE_TAC[ARITH_RULE `4 = 2 * 2`; MOD_MOD]);; + +let NUM_MOD4_NONZERO_NONODD = prove + (`!n:num. + ~(n MOD 4 = 0) /\ ~(n MOD 2 = 1) + ==> n MOD 4 = 2`, + GEN_TAC THEN STRIP_TAC THEN + MP_TAC(SPEC `n:num` MOD4_CASES) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(DISJ_CASES_THEN2 ASSUME_TAC + (DISJ_CASES_THEN ASSUME_TAC)) THENL + [MP_TAC(SPEC `n:num` MOD2_OF_MOD4) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN + ASM_MESON_TAC[]; + ASM_REWRITE_TAC[]; + MP_TAC(SPEC `n:num` MOD2_OF_MOD4) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN + ASM_MESON_TAC[]]);; + +let MOD16_2_CASES = prove + (`!n:num. + n MOD 4 = 2 + ==> n MOD 16 = 2 \/ n MOD 16 = 6 \/ + n MOD 16 = 10 \/ n MOD 16 = 14`, + GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN `(n MOD 16) MOD 4 = 2` ASSUME_TAC THENL + [SUBGOAL_THEN `(n MOD 16) MOD 4 = n MOD 4` MP_TAC THENL + [REWRITE_TAC[ARITH_RULE `16 = 4 * 4`; MOD_MOD]; + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + MP_TAC(SPECL [`n MOD 16`; `4`] DIVISION) THEN + CONV_TAC NUM_REDUCE_CONV THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + MP_TAC(SPECL [`n:num`; `16`] DIVISION) THEN + CONV_TAC NUM_REDUCE_CONV THEN STRIP_TAC THEN + ASM_CASES_TAC `(n MOD 16) DIV 4 = 0` THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + ASM_CASES_TAC `(n MOD 16) DIV 4 = 1` THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + ASM_CASES_TAC `(n MOD 16) DIV 4 = 2` THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + ASM_CASES_TAC `(n MOD 16) DIV 4 = 3` THEN ASM_ARITH_TAC);; + +let INT_REPRESENTS_112_ODD = prove + (`!u:num. + u MOD 2 = 1 + ==> ?x y z:int. x pow 2 + y pow 2 + &2 * z pow 2 = &u`, + GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC INT_REPRESENTS_112_OF_LEGENDRE THEN + MATCH_MP_TAC THREE_SQUARES_AVOIDS_OF_MOD THEN CONJ_TAC THENL + [SUBGOAL_THEN `u = u DIV 2 * 2 + 1` ASSUME_TAC THENL + [MP_TAC(SPECL [`u:num`; `2`] DIVISION) THEN + CONV_TAC NUM_REDUCE_CONV THEN ASM_REWRITE_TAC[] THEN ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `2 * u = 4 * (u DIV 2) + 2` ASSUME_TAC THENL + [ASM_ARITH_TAC; + ASM_REWRITE_TAC[MOD_MULT_ADD] THEN CONV_TAC NUM_REDUCE_CONV]; + DISCH_TAC THEN + SUBGOAL_THEN + `(2 * u) MOD 8 MOD 2 = (2 * u) MOD 2` + MP_TAC THENL + [REWRITE_TAC[ARITH_RULE `8 = 2 * 4`; MOD_MOD]; + ASM_REWRITE_TAC[MOD_MULT] THEN CONV_TAC NUM_REDUCE_CONV]]);; + +let NUM_DECOMPOSE_MOD = prove + (`!n m r:num. + ~(m = 0) /\ n MOD m = r + ==> ?q. n = m * q + r`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + EXISTS_TAC `n DIV m` THEN + MP_TAC(SPECL [`n:num`; `m:num`] DIVISION) THEN + ASM_REWRITE_TAC[] THEN ARITH_TAC);; + +let INT_REPRESENTS_112_TWICE_8Q_MOD = prove + (`!q r:num. + ~(r MOD 4 = 0) /\ ~(r MOD 8 = 7) + ==> ?x y z:int. + x pow 2 + y pow 2 + &2 * z pow 2 = &(2 * (8 * q + r))`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC INT_REPRESENTS_112_OF_LEGENDRE THEN + REWRITE_TAC[ARITH_RULE `2 * (2 * v) = 4 * v`] THEN + MATCH_MP_TAC THREE_SQUARES_AVOIDS_FOUR_MUL THEN + MATCH_MP_TAC THREE_SQUARES_AVOIDS_OF_MOD THEN CONJ_TAC THENL + [ASM_REWRITE_TAC + [ARITH_RULE `8 * q + r = 4 * (2 * q) + r`; MOD_MULT_ADD]; + ASM_REWRITE_TAC[MOD_MULT_ADD]]);; + +let INT_REPRESENTS_112_TWO = prove + (`!u:num. + u MOD 4 = 2 /\ ~(u MOD 16 = 14) + ==> ?x y z:int. x pow 2 + y pow 2 + &2 * z pow 2 = &u`, + GEN_TAC THEN STRIP_TAC THEN + MP_TAC(SPEC `u:num` MOD16_2_CASES) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(DISJ_CASES_THEN2 ASSUME_TAC + (DISJ_CASES_THEN ASSUME_TAC)) THENL + [MP_TAC(SPECL [`u:num`; `16`; `2`] NUM_DECOMPOSE_MOD) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN + DISCH_THEN(X_CHOOSE_THEN `q:num` SUBST1_TAC) THEN + REWRITE_TAC[ARITH_RULE `16 * q + 2 = 2 * (8 * q + 1)`] THEN + MATCH_MP_TAC INT_REPRESENTS_112_TWICE_8Q_MOD THEN + CONV_TAC NUM_REDUCE_CONV; + MP_TAC(SPECL [`u:num`; `16`; `6`] NUM_DECOMPOSE_MOD) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN + DISCH_THEN(X_CHOOSE_THEN `q:num` SUBST1_TAC) THEN + REWRITE_TAC[ARITH_RULE `16 * q + 6 = 2 * (8 * q + 3)`] THEN + MATCH_MP_TAC INT_REPRESENTS_112_TWICE_8Q_MOD THEN + CONV_TAC NUM_REDUCE_CONV; + MP_TAC(SPECL [`u:num`; `16`; `10`] NUM_DECOMPOSE_MOD) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN + DISCH_THEN(X_CHOOSE_THEN `q:num` SUBST1_TAC) THEN + REWRITE_TAC[ARITH_RULE `16 * q + 10 = 2 * (8 * q + 5)`] THEN + MATCH_MP_TAC INT_REPRESENTS_112_TWICE_8Q_MOD THEN + CONV_TAC NUM_REDUCE_CONV]);; + +let INT_REPRESENTS_112_SCALE4_NUM = prove + (`!u:num. + (?x y z:int. x pow 2 + y pow 2 + &2 * z pow 2 = &u) + ==> ?x y z:int. + x pow 2 + y pow 2 + &2 * z pow 2 = &(4 * u)`, + GEN_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` (X_CHOOSE_TAC `z:int`))) THEN + MAP_EVERY EXISTS_TAC + [`&2 * x:int`; `&2 * y:int`; `&2 * z:int`] THEN + REWRITE_TAC[GSYM INT_OF_NUM_MUL] THEN + FIRST_X_ASSUM(MP_TAC) THEN CONV_TAC INT_RING);; + +let IQ_DIAG4_112C_REPRESENTATION_STEP = prove + (`!c:int. !n u k:num. !d:int. + (?x y z:int. x pow 2 + y pow 2 + &2 * z pow 2 = &u) /\ + c * d pow 2 = &k /\ n = u + k + ==> ?x y z w:int. + &1 * x pow 2 + &1 * y pow 2 + + &2 * z pow 2 + c * w pow 2 = &n`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` (X_CHOOSE_TAC `z:int`))) + (CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC)) THEN + FIRST_X_ASSUM SUBST1_TAC THEN + MAP_EVERY EXISTS_TAC [`x:int`; `y:int`; `z:int`; `d:int`] THEN + REWRITE_TAC[GSYM INT_OF_NUM_ADD] THEN + FIRST_X_ASSUM(MP_TAC) THEN FIRST_X_ASSUM(MP_TAC) THEN + CONV_TAC INT_RING);; + +let IQ_UNIVERSAL_112C_NUM_OF_BAD = prove + (`!c:num. + (!n:num. + 0 < n ==> n MOD 16 = 14 ==> + (!m:num. + m < n ==> 0 < m ==> + ?x y z w:int. + &1 * x pow 2 + &1 * y pow 2 + + &2 * z pow 2 + &c * w pow 2 = &m) + ==> ?x y z w:int. + &1 * x pow 2 + &1 * y pow 2 + + &2 * z pow 2 + &c * w pow 2 = &n) + ==> !n:num. + 0 < n + ==> ?x y z w:int. + &1 * x pow 2 + &1 * y pow 2 + + &2 * z pow 2 + &c * w pow 2 = &n`, + GEN_TAC THEN DISCH_THEN(fun bad -> + MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN + DISCH_TAC THEN DISCH_TAC THEN + ASM_CASES_TAC `n MOD 4 = 0` THENL + [SUBGOAL_THEN `n = 4 * (n DIV 4)` ASSUME_TAC THENL + [MP_TAC(SPECL [`n:num`; `4`] DIVISION) THEN + CONV_TAC NUM_REDUCE_CONV THEN + ASM_REWRITE_TAC[ADD_CLAUSES] THEN ARITH_TAC; + ALL_TAC] THEN + FIRST_X_ASSUM SUBST1_TAC THEN + MATCH_MP_TAC IQ_DIAG4_REPRESENTATION_SCALE4_NUM THEN + SUBGOAL_THEN + `n DIV 4 < n /\ 0 < n DIV 4` + STRIP_ASSUME_TAC THENL + [MP_TAC(SPECL [`n:num`; `4`] DIVISION) THEN + CONV_TAC NUM_REDUCE_CONV THEN + ASM_REWRITE_TAC[ADD_CLAUSES] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n DIV 4`) THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + ASM_CASES_TAC `n MOD 2 = 1` THENL + [MATCH_MP_TAC(SPECL + [`&c:int`; `n:num`; `n:num`; `0`; `&0:int`] + IQ_DIAG4_112C_REPRESENTATION_STEP) THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC INT_REPRESENTS_112_ODD THEN ASM_REWRITE_TAC[]; + CONV_TAC INT_REDUCE_CONV; + ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN `n MOD 4 = 2` ASSUME_TAC THENL + [MATCH_MP_TAC NUM_MOD4_NONZERO_NONODD THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + ASM_CASES_TAC `n MOD 16 = 14` THENL + [MP_TAC(SPEC `n:num` bad) THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC(SPECL + [`&c:int`; `n:num`; `n:num`; `0`; `&0:int`] + IQ_DIAG4_112C_REPRESENTATION_STEP) THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC INT_REPRESENTS_112_TWO THEN ASM_REWRITE_TAC[]; + CONV_TAC INT_REDUCE_CONV; + ARITH_TAC]]));; + +let NUM_MOD2_SUB_ODD = prove + (`!n c:num. + n MOD 2 = 0 /\ c MOD 2 = 1 /\ c <= n + ==> (n - c) MOD 2 = 1`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `n = n DIV 2 * 2` ASSUME_TAC THENL + [MP_TAC(SPECL [`n:num`; `2`] DIVISION) THEN + CONV_TAC NUM_REDUCE_CONV THEN + ASM_REWRITE_TAC[ADD_CLAUSES] THEN ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `c = c DIV 2 * 2 + 1` ASSUME_TAC THENL + [MP_TAC(SPECL [`c:num`; `2`] DIVISION) THEN + CONV_TAC NUM_REDUCE_CONV THEN ASM_REWRITE_TAC[] THEN ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `n - c = 2 * (n DIV 2 - c DIV 2 - 1) + 1` + ASSUME_TAC THENL + [ASM_ARITH_TAC; + ASM_REWRITE_TAC[MOD_MULT_ADD] THEN CONV_TAC NUM_REDUCE_CONV]);; + +let NUM_MOD2_OF_MOD16_14 = prove + (`!n:num. n MOD 16 = 14 ==> n MOD 2 = 0`, + GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN `(n MOD 16) MOD 2 = n MOD 2` MP_TAC THENL + [REWRITE_TAC[ARITH_RULE `16 = 2 * 8`; MOD_MOD]; + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN MESON_TAC[]]);; + +let IQ_UNIVERSAL_112_ODD_NUM = prove + (`!c:num. + c MOD 2 = 1 /\ 3 <= c /\ c <= 13 + ==> !n:num. + 0 < n + ==> ?x y z w:int. + &1 * x pow 2 + &1 * y pow 2 + + &2 * z pow 2 + &c * w pow 2 = &n`, + GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC(SPEC `c:num` IQ_UNIVERSAL_112C_NUM_OF_BAD) THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN DISCH_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN `(c:num) <= n` ASSUME_TAC THENL + [MP_TAC(SPECL [`n:num`; `16`] MOD_LE) THEN + ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(SPECL + [`&c:int`; `n:num`; `(n - c):num`; `c:num`; `&1:int`] + IQ_DIAG4_112C_REPRESENTATION_STEP) THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC INT_REPRESENTS_112_ODD THEN + MATCH_MP_TAC NUM_MOD2_SUB_ODD THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC NUM_MOD2_OF_MOD16_14 THEN ASM_REWRITE_TAC[]; + CONV_TAC INT_RING; + ASM_ARITH_TAC]);; + +let MOD32_14_CASES = prove + (`!n:num. + n MOD 16 = 14 + ==> n MOD 32 = 14 \/ n MOD 32 = 30`, + GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN `(n MOD 32) MOD 16 = 14` ASSUME_TAC THENL + [SUBGOAL_THEN `(n MOD 32) MOD 16 = n MOD 16` MP_TAC THENL + [REWRITE_TAC[ARITH_RULE `32 = 16 * 2`; MOD_MOD]; + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + MP_TAC(SPECL [`n MOD 32`; `16`] DIVISION) THEN + CONV_TAC NUM_REDUCE_CONV THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + MP_TAC(SPECL [`n:num`; `32`] DIVISION) THEN + CONV_TAC NUM_REDUCE_CONV THEN STRIP_TAC THEN + ASM_CASES_TAC `(n MOD 32) DIV 16 = 0` THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + ASM_CASES_TAC `(n MOD 32) DIV 16 = 1` THEN ASM_ARITH_TAC);; + +let MOD64_14_CASES = prove + (`!n:num. + n MOD 16 = 14 + ==> n MOD 64 = 14 \/ n MOD 64 = 30 \/ + n MOD 64 = 46 \/ n MOD 64 = 62`, + GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN `(n MOD 64) MOD 16 = 14` ASSUME_TAC THENL + [SUBGOAL_THEN `(n MOD 64) MOD 16 = n MOD 16` MP_TAC THENL + [REWRITE_TAC[ARITH_RULE `64 = 16 * 4`; MOD_MOD]; + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + MP_TAC(SPECL [`n MOD 64`; `16`] DIVISION) THEN + CONV_TAC NUM_REDUCE_CONV THEN ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + MP_TAC(SPECL [`n:num`; `64`] DIVISION) THEN + CONV_TAC NUM_REDUCE_CONV THEN STRIP_TAC THEN + ASM_CASES_TAC `(n MOD 64) DIV 16 = 0` THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + ASM_CASES_TAC `(n MOD 64) DIV 16 = 1` THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + ASM_CASES_TAC `(n MOD 64) DIV 16 = 2` THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + ASM_CASES_TAC `(n MOD 64) DIV 16 = 3` THEN ASM_ARITH_TAC);; + +let IQ_UNIVERSAL_1124_NUM = prove + (`!n:num. + 0 < n + ==> ?x y z w:int. + &1 * x pow 2 + &1 * y pow 2 + + &2 * z pow 2 + &4 * w pow 2 = &n`, + MATCH_MP_TAC(SPEC `4` IQ_UNIVERSAL_112C_NUM_OF_BAD) THEN + X_GEN_TAC `n:num` THEN REPEAT DISCH_TAC THEN + MP_TAC(SPECL [`n:num`; `16`; `14`] NUM_DECOMPOSE_MOD) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN + DISCH_THEN(X_CHOOSE_THEN `q:num` SUBST1_TAC) THEN + MATCH_MP_TAC(SPECL + [`&4:int`; `((16 * q + 14):num)`; `((16 * q + 10):num)`; + `4`; `&1:int`] + IQ_DIAG4_112C_REPRESENTATION_STEP) THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC INT_REPRESENTS_112_TWO THEN CONJ_TAC THENL + [REWRITE_TAC + [ARITH_RULE `16 * q + 10 = 4 * (4 * q + 2) + 2`; + MOD_MULT_ADD] THEN + CONV_TAC NUM_REDUCE_CONV; + REWRITE_TAC[MOD_MULT_ADD] THEN CONV_TAC NUM_REDUCE_CONV]; + CONV_TAC INT_REDUCE_CONV; + ARITH_TAC]);; + +let IQ_UNIVERSAL_1128_NUM = prove + (`!n:num. + 0 < n + ==> ?x y z w:int. + &1 * x pow 2 + &1 * y pow 2 + + &2 * z pow 2 + &8 * w pow 2 = &n`, + MATCH_MP_TAC(SPEC `8` IQ_UNIVERSAL_112C_NUM_OF_BAD) THEN + X_GEN_TAC `n:num` THEN REPEAT DISCH_TAC THEN + MP_TAC(SPECL [`n:num`; `16`; `14`] NUM_DECOMPOSE_MOD) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN + DISCH_THEN(X_CHOOSE_THEN `q:num` SUBST1_TAC) THEN + MATCH_MP_TAC(SPECL + [`&8:int`; `((16 * q + 14):num)`; `((16 * q + 6):num)`; + `8`; `&1:int`] + IQ_DIAG4_112C_REPRESENTATION_STEP) THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC INT_REPRESENTS_112_TWO THEN CONJ_TAC THENL + [REWRITE_TAC + [ARITH_RULE `16 * q + 6 = 4 * (4 * q + 1) + 2`; + MOD_MULT_ADD] THEN + CONV_TAC NUM_REDUCE_CONV; + REWRITE_TAC[MOD_MULT_ADD] THEN CONV_TAC NUM_REDUCE_CONV]; + CONV_TAC INT_REDUCE_CONV; + ARITH_TAC]);; + +let IQ_UNIVERSAL_11212_NUM = prove + (`!n:num. + 0 < n + ==> ?x y z w:int. + &1 * x pow 2 + &1 * y pow 2 + + &2 * z pow 2 + &12 * w pow 2 = &n`, + MATCH_MP_TAC(SPEC `12` IQ_UNIVERSAL_112C_NUM_OF_BAD) THEN + X_GEN_TAC `n:num` THEN REPEAT DISCH_TAC THEN + MP_TAC(SPECL [`n:num`; `16`; `14`] NUM_DECOMPOSE_MOD) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN + DISCH_THEN(X_CHOOSE_THEN `q:num` SUBST1_TAC) THEN + MATCH_MP_TAC(SPECL + [`&12:int`; `((16 * q + 14):num)`; `((16 * q + 2):num)`; + `12`; `&1:int`] + IQ_DIAG4_112C_REPRESENTATION_STEP) THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC INT_REPRESENTS_112_TWO THEN CONJ_TAC THENL + [REWRITE_TAC + [ARITH_RULE `16 * q + 2 = 4 * (4 * q) + 2`; + MOD_MULT_ADD] THEN + CONV_TAC NUM_REDUCE_CONV; + REWRITE_TAC[MOD_MULT_ADD] THEN CONV_TAC NUM_REDUCE_CONV]; + CONV_TAC INT_REDUCE_CONV; + ARITH_TAC]);; + +let IQ_UNIVERSAL_11210_NUM = prove + (`!n:num. + 0 < n + ==> ?x y z w:int. + &1 * x pow 2 + &1 * y pow 2 + + &2 * z pow 2 + &10 * w pow 2 = &n`, + MATCH_MP_TAC(SPEC `10` IQ_UNIVERSAL_112C_NUM_OF_BAD) THEN + X_GEN_TAC `n:num` THEN REPEAT DISCH_TAC THEN + MP_TAC(SPECL [`n:num`; `16`; `14`] NUM_DECOMPOSE_MOD) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN + DISCH_THEN(X_CHOOSE_THEN `q:num` SUBST1_TAC) THEN + MATCH_MP_TAC(SPECL + [`&10:int`; `((16 * q + 14):num)`; `((16 * q + 4):num)`; + `10`; `&1:int`] + IQ_DIAG4_112C_REPRESENTATION_STEP) THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[ARITH_RULE `16 * q + 4 = 4 * (4 * q + 1)`] THEN + MATCH_MP_TAC INT_REPRESENTS_112_SCALE4_NUM THEN + MATCH_MP_TAC INT_REPRESENTS_112_ODD THEN + REWRITE_TAC + [ARITH_RULE `4 * q + 1 = 2 * (2 * q) + 1`; MOD_MULT_ADD] THEN + CONV_TAC NUM_REDUCE_CONV; + CONV_TAC INT_REDUCE_CONV; + ARITH_TAC]);; + +let IQ_UNIVERSAL_1122_NUM = prove + (`!n:num. + 0 < n + ==> ?x y z w:int. + &1 * x pow 2 + &1 * y pow 2 + + &2 * z pow 2 + &2 * w pow 2 = &n`, + MATCH_MP_TAC(SPEC `2` IQ_UNIVERSAL_112C_NUM_OF_BAD) THEN + X_GEN_TAC `n:num` THEN REPEAT DISCH_TAC THEN + MP_TAC(SPEC `n:num` MOD32_14_CASES) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(DISJ_CASES_THEN ASSUME_TAC) THENL + [MP_TAC(SPECL [`n:num`; `32`; `14`] NUM_DECOMPOSE_MOD) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN + DISCH_THEN(X_CHOOSE_THEN `q:num` SUBST1_TAC) THEN + MATCH_MP_TAC(SPECL + [`&2:int`; `((32 * q + 14):num)`; `((32 * q + 12):num)`; + `2`; `&1:int`] + IQ_DIAG4_112C_REPRESENTATION_STEP) THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[ARITH_RULE `32 * q + 12 = 4 * (8 * q + 3)`] THEN + MATCH_MP_TAC INT_REPRESENTS_112_SCALE4_NUM THEN + MATCH_MP_TAC INT_REPRESENTS_112_ODD THEN + REWRITE_TAC + [ARITH_RULE `8 * q + 3 = 2 * (4 * q + 1) + 1`; + MOD_MULT_ADD] THEN + CONV_TAC NUM_REDUCE_CONV; + CONV_TAC INT_REDUCE_CONV; + ARITH_TAC]; + MP_TAC(SPECL [`n:num`; `32`; `30`] NUM_DECOMPOSE_MOD) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN + DISCH_THEN(X_CHOOSE_THEN `q:num` SUBST1_TAC) THEN + MATCH_MP_TAC(SPECL + [`&2:int`; `((32 * q + 30):num)`; `((32 * q + 22):num)`; + `8`; `&2:int`] + IQ_DIAG4_112C_REPRESENTATION_STEP) THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC INT_REPRESENTS_112_TWO THEN CONJ_TAC THENL + [REWRITE_TAC + [ARITH_RULE `32 * q + 22 = 4 * (8 * q + 5) + 2`; + MOD_MULT_ADD] THEN + CONV_TAC NUM_REDUCE_CONV; + REWRITE_TAC + [ARITH_RULE `32 * q + 22 = 16 * (2 * q + 1) + 6`; + MOD_MULT_ADD] THEN + CONV_TAC NUM_REDUCE_CONV]; + CONV_TAC INT_REDUCE_CONV; + ARITH_TAC]]);; + +let IQ_UNIVERSAL_1126_NUM = prove + (`!n:num. + 0 < n + ==> ?x y z w:int. + &1 * x pow 2 + &1 * y pow 2 + + &2 * z pow 2 + &6 * w pow 2 = &n`, + MATCH_MP_TAC(SPEC `6` IQ_UNIVERSAL_112C_NUM_OF_BAD) THEN + X_GEN_TAC `n:num` THEN REPEAT DISCH_TAC THEN + ASM_CASES_TAC `n MOD 64 = 62` THENL + [MP_TAC(SPECL [`n:num`; `64`; `62`] NUM_DECOMPOSE_MOD) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN + DISCH_THEN(X_CHOOSE_THEN `q:num` SUBST1_TAC) THEN + MATCH_MP_TAC(SPECL + [`&6:int`; `((64 * q + 62):num)`; `((64 * q + 38):num)`; + `24`; `&2:int`] + IQ_DIAG4_112C_REPRESENTATION_STEP) THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC INT_REPRESENTS_112_TWO THEN CONJ_TAC THENL + [REWRITE_TAC + [ARITH_RULE `64 * q + 38 = 4 * (16 * q + 9) + 2`; + MOD_MULT_ADD] THEN + CONV_TAC NUM_REDUCE_CONV; + REWRITE_TAC + [ARITH_RULE `64 * q + 38 = 16 * (4 * q + 2) + 6`; + MOD_MULT_ADD] THEN + CONV_TAC NUM_REDUCE_CONV]; + CONV_TAC INT_REDUCE_CONV; + ARITH_TAC]; + MP_TAC(SPEC `n:num` MOD64_14_CASES) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(DISJ_CASES_THEN2 ASSUME_TAC + (DISJ_CASES_THEN ASSUME_TAC)) THENL + [MP_TAC(SPECL [`n:num`; `64`; `14`] NUM_DECOMPOSE_MOD) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN + DISCH_THEN(X_CHOOSE_THEN `q:num` SUBST1_TAC) THEN + MATCH_MP_TAC(SPECL + [`&6:int`; `((64 * q + 14):num)`; `((64 * q + 8):num)`; + `6`; `&1:int`] + IQ_DIAG4_112C_REPRESENTATION_STEP) THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[ARITH_RULE `64 * q + 8 = 4 * (16 * q + 2)`] THEN + MATCH_MP_TAC INT_REPRESENTS_112_SCALE4_NUM THEN + MATCH_MP_TAC INT_REPRESENTS_112_TWO THEN CONJ_TAC THENL + [REWRITE_TAC + [ARITH_RULE `16 * q + 2 = 4 * (4 * q) + 2`; + MOD_MULT_ADD] THEN + CONV_TAC NUM_REDUCE_CONV; + REWRITE_TAC[MOD_MULT_ADD] THEN CONV_TAC NUM_REDUCE_CONV]; + CONV_TAC INT_REDUCE_CONV; + ARITH_TAC]; + MP_TAC(SPECL [`n:num`; `64`; `30`] NUM_DECOMPOSE_MOD) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN + DISCH_THEN(X_CHOOSE_THEN `q:num` SUBST1_TAC) THEN + MATCH_MP_TAC(SPECL + [`&6:int`; `((64 * q + 30):num)`; `((64 * q + 24):num)`; + `6`; `&1:int`] + IQ_DIAG4_112C_REPRESENTATION_STEP) THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[ARITH_RULE `64 * q + 24 = 4 * (16 * q + 6)`] THEN + MATCH_MP_TAC INT_REPRESENTS_112_SCALE4_NUM THEN + MATCH_MP_TAC INT_REPRESENTS_112_TWO THEN CONJ_TAC THENL + [REWRITE_TAC + [ARITH_RULE `16 * q + 6 = 4 * (4 * q + 1) + 2`; + MOD_MULT_ADD] THEN + CONV_TAC NUM_REDUCE_CONV; + REWRITE_TAC[MOD_MULT_ADD] THEN CONV_TAC NUM_REDUCE_CONV]; + CONV_TAC INT_REDUCE_CONV; + ARITH_TAC]; + MP_TAC(SPECL [`n:num`; `64`; `46`] NUM_DECOMPOSE_MOD) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN + DISCH_THEN(X_CHOOSE_THEN `q:num` SUBST1_TAC) THEN + MATCH_MP_TAC(SPECL + [`&6:int`; `((64 * q + 46):num)`; `((64 * q + 40):num)`; + `6`; `&1:int`] + IQ_DIAG4_112C_REPRESENTATION_STEP) THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[ARITH_RULE `64 * q + 40 = 4 * (16 * q + 10)`] THEN + MATCH_MP_TAC INT_REPRESENTS_112_SCALE4_NUM THEN + MATCH_MP_TAC INT_REPRESENTS_112_TWO THEN CONJ_TAC THENL + [REWRITE_TAC + [ARITH_RULE `16 * q + 10 = 4 * (4 * q + 2) + 2`; + MOD_MULT_ADD] THEN + CONV_TAC NUM_REDUCE_CONV; + REWRITE_TAC[MOD_MULT_ADD] THEN CONV_TAC NUM_REDUCE_CONV]; + CONV_TAC INT_REDUCE_CONV; + ARITH_TAC]]]);; + +let IQ_UNIVERSAL_11214_NUM = prove + (`!n:num. + 0 < n + ==> ?x y z w:int. + &1 * x pow 2 + &1 * y pow 2 + + &2 * z pow 2 + &14 * w pow 2 = &n`, + MATCH_MP_TAC(SPEC `14` IQ_UNIVERSAL_112C_NUM_OF_BAD) THEN + X_GEN_TAC `n:num` THEN REPEAT DISCH_TAC THEN + ASM_CASES_TAC `n = 14` THENL + [MAP_EVERY EXISTS_TAC + [`&0:int`; `&0:int`; `&0:int`; `&1:int`] THEN + ASM_REWRITE_TAC[] THEN CONV_TAC INT_REDUCE_CONV; + ALL_TAC] THEN + ASM_CASES_TAC `n = 46` THENL + [MAP_EVERY EXISTS_TAC + [`&0:int`; `&0:int`; `&4:int`; `&1:int`] THEN + ASM_REWRITE_TAC[] THEN CONV_TAC INT_REDUCE_CONV; + ALL_TAC] THEN + ASM_CASES_TAC `n MOD 64 = 30` THENL + [MP_TAC(SPECL [`n:num`; `64`; `30`] NUM_DECOMPOSE_MOD) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN + DISCH_THEN(X_CHOOSE_THEN `q:num` SUBST1_TAC) THEN + MATCH_MP_TAC(SPECL + [`&14:int`; `((64 * q + 30):num)`; `((64 * q + 16):num)`; + `14`; `&1:int`] + IQ_DIAG4_112C_REPRESENTATION_STEP) THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC + [ARITH_RULE `64 * q + 16 = 4 * (4 * (4 * q + 1))`] THEN + MATCH_MP_TAC INT_REPRESENTS_112_SCALE4_NUM THEN + MATCH_MP_TAC INT_REPRESENTS_112_SCALE4_NUM THEN + MATCH_MP_TAC INT_REPRESENTS_112_ODD THEN + REWRITE_TAC + [ARITH_RULE `4 * q + 1 = 2 * (2 * q) + 1`; + MOD_MULT_ADD] THEN + CONV_TAC NUM_REDUCE_CONV; + CONV_TAC INT_REDUCE_CONV; + ARITH_TAC]; + MP_TAC(SPEC `n:num` MOD64_14_CASES) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(DISJ_CASES_THEN2 ASSUME_TAC + (DISJ_CASES_THEN ASSUME_TAC)) THENL + [MP_TAC(SPECL [`n:num`; `64`; `14`] NUM_DECOMPOSE_MOD) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN + DISCH_THEN(X_CHOOSE_THEN `q:num` ASSUME_TAC) THEN + SUBGOAL_THEN `0 < q` ASSUME_TAC THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC(SPECL + [`&14:int`; `n:num`; `((64 * (q - 1) + 22):num)`; + `56`; `&2:int`] + IQ_DIAG4_112C_REPRESENTATION_STEP) THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC INT_REPRESENTS_112_TWO THEN CONJ_TAC THENL + [REWRITE_TAC + [ARITH_RULE `64 * p + 22 = 4 * (16 * p + 5) + 2`; + MOD_MULT_ADD] THEN + CONV_TAC NUM_REDUCE_CONV; + REWRITE_TAC + [ARITH_RULE `64 * p + 22 = 16 * (4 * p + 1) + 6`; + MOD_MULT_ADD] THEN + CONV_TAC NUM_REDUCE_CONV]; + CONV_TAC INT_REDUCE_CONV; + ASM_ARITH_TAC]; + MP_TAC(SPECL [`n:num`; `64`; `46`] NUM_DECOMPOSE_MOD) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN + DISCH_THEN(X_CHOOSE_THEN `q:num` ASSUME_TAC) THEN + SUBGOAL_THEN `0 < q` ASSUME_TAC THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC(SPECL + [`&14:int`; `n:num`; `((64 * (q - 1) + 54):num)`; + `56`; `&2:int`] + IQ_DIAG4_112C_REPRESENTATION_STEP) THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC INT_REPRESENTS_112_TWO THEN CONJ_TAC THENL + [REWRITE_TAC + [ARITH_RULE `64 * p + 54 = 4 * (16 * p + 13) + 2`; + MOD_MULT_ADD] THEN + CONV_TAC NUM_REDUCE_CONV; + REWRITE_TAC + [ARITH_RULE `64 * p + 54 = 16 * (4 * p + 3) + 6`; + MOD_MULT_ADD] THEN + CONV_TAC NUM_REDUCE_CONV]; + CONV_TAC INT_REDUCE_CONV; + ASM_ARITH_TAC]; + MP_TAC(SPECL [`n:num`; `64`; `62`] NUM_DECOMPOSE_MOD) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN + DISCH_THEN(X_CHOOSE_THEN `q:num` SUBST1_TAC) THEN + MATCH_MP_TAC(SPECL + [`&14:int`; `((64 * q + 62):num)`; `((64 * q + 6):num)`; + `56`; `&2:int`] + IQ_DIAG4_112C_REPRESENTATION_STEP) THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC INT_REPRESENTS_112_TWO THEN CONJ_TAC THENL + [REWRITE_TAC + [ARITH_RULE `64 * p + 6 = 4 * (16 * p + 1) + 2`; + MOD_MULT_ADD] THEN + CONV_TAC NUM_REDUCE_CONV; + REWRITE_TAC + [ARITH_RULE `64 * p + 6 = 16 * (4 * p) + 6`; + MOD_MULT_ADD] THEN + CONV_TAC NUM_REDUCE_CONV]; + CONV_TAC INT_REDUCE_CONV; + ARITH_TAC]]]);; + +let IQ_UNIVERSAL_1123_NUM = prove + (`!n:num. + 0 < n + ==> ?x y z w:int. + &1 * x pow 2 + &1 * y pow 2 + + &2 * z pow 2 + &3 * w pow 2 = &n`, + MP_TAC(SPEC `3` IQ_UNIVERSAL_112_ODD_NUM) THEN + CONV_TAC NUM_REDUCE_CONV);; + +let IQ_UNIVERSAL_1125_NUM = prove + (`!n:num. + 0 < n + ==> ?x y z w:int. + &1 * x pow 2 + &1 * y pow 2 + + &2 * z pow 2 + &5 * w pow 2 = &n`, + MP_TAC(SPEC `5` IQ_UNIVERSAL_112_ODD_NUM) THEN + CONV_TAC NUM_REDUCE_CONV);; + +let IQ_UNIVERSAL_1127_NUM = prove + (`!n:num. + 0 < n + ==> ?x y z w:int. + &1 * x pow 2 + &1 * y pow 2 + + &2 * z pow 2 + &7 * w pow 2 = &n`, + MP_TAC(SPEC `7` IQ_UNIVERSAL_112_ODD_NUM) THEN + CONV_TAC NUM_REDUCE_CONV);; + +let IQ_UNIVERSAL_1129_NUM = prove + (`!n:num. + 0 < n + ==> ?x y z w:int. + &1 * x pow 2 + &1 * y pow 2 + + &2 * z pow 2 + &9 * w pow 2 = &n`, + MP_TAC(SPEC `9` IQ_UNIVERSAL_112_ODD_NUM) THEN + CONV_TAC NUM_REDUCE_CONV);; + +let IQ_UNIVERSAL_11211_NUM = prove + (`!n:num. + 0 < n + ==> ?x y z w:int. + &1 * x pow 2 + &1 * y pow 2 + + &2 * z pow 2 + &11 * w pow 2 = &n`, + MP_TAC(SPEC `11` IQ_UNIVERSAL_112_ODD_NUM) THEN + CONV_TAC NUM_REDUCE_CONV);; + +let IQ_UNIVERSAL_11213_NUM = prove + (`!n:num. + 0 < n + ==> ?x y z w:int. + &1 * x pow 2 + &1 * y pow 2 + + &2 * z pow 2 + &13 * w pow 2 = &n`, + MP_TAC(SPEC `13` IQ_UNIVERSAL_112_ODD_NUM) THEN + CONV_TAC NUM_REDUCE_CONV);; + +let IQ_UNIVERSAL_1122 = + MATCH_MP + (SPECL [`&1:int`; `&1:int`; `&2:int`; `&2:int`] + IQ_UNIVERSAL_DIAG4_OF_NUM) + IQ_UNIVERSAL_1122_NUM;; + +let IQ_UNIVERSAL_1123 = + MATCH_MP + (SPECL [`&1:int`; `&1:int`; `&2:int`; `&3:int`] + IQ_UNIVERSAL_DIAG4_OF_NUM) + IQ_UNIVERSAL_1123_NUM;; + +let IQ_UNIVERSAL_1124 = + MATCH_MP + (SPECL [`&1:int`; `&1:int`; `&2:int`; `&4:int`] + IQ_UNIVERSAL_DIAG4_OF_NUM) + IQ_UNIVERSAL_1124_NUM;; + +let IQ_UNIVERSAL_1125 = + MATCH_MP + (SPECL [`&1:int`; `&1:int`; `&2:int`; `&5:int`] + IQ_UNIVERSAL_DIAG4_OF_NUM) + IQ_UNIVERSAL_1125_NUM;; + +let IQ_UNIVERSAL_1126 = + MATCH_MP + (SPECL [`&1:int`; `&1:int`; `&2:int`; `&6:int`] + IQ_UNIVERSAL_DIAG4_OF_NUM) + IQ_UNIVERSAL_1126_NUM;; + +let IQ_UNIVERSAL_1127 = + MATCH_MP + (SPECL [`&1:int`; `&1:int`; `&2:int`; `&7:int`] + IQ_UNIVERSAL_DIAG4_OF_NUM) + IQ_UNIVERSAL_1127_NUM;; + +let IQ_UNIVERSAL_1128 = + MATCH_MP + (SPECL [`&1:int`; `&1:int`; `&2:int`; `&8:int`] + IQ_UNIVERSAL_DIAG4_OF_NUM) + IQ_UNIVERSAL_1128_NUM;; + +let IQ_UNIVERSAL_1129 = + MATCH_MP + (SPECL [`&1:int`; `&1:int`; `&2:int`; `&9:int`] + IQ_UNIVERSAL_DIAG4_OF_NUM) + IQ_UNIVERSAL_1129_NUM;; + +let IQ_UNIVERSAL_11210 = + MATCH_MP + (SPECL [`&1:int`; `&1:int`; `&2:int`; `&10:int`] + IQ_UNIVERSAL_DIAG4_OF_NUM) + IQ_UNIVERSAL_11210_NUM;; + +let IQ_UNIVERSAL_11211 = + MATCH_MP + (SPECL [`&1:int`; `&1:int`; `&2:int`; `&11:int`] + IQ_UNIVERSAL_DIAG4_OF_NUM) + IQ_UNIVERSAL_11211_NUM;; + +let IQ_UNIVERSAL_11212 = + MATCH_MP + (SPECL [`&1:int`; `&1:int`; `&2:int`; `&12:int`] + IQ_UNIVERSAL_DIAG4_OF_NUM) + IQ_UNIVERSAL_11212_NUM;; + +let IQ_UNIVERSAL_11213 = + MATCH_MP + (SPECL [`&1:int`; `&1:int`; `&2:int`; `&13:int`] + IQ_UNIVERSAL_DIAG4_OF_NUM) + IQ_UNIVERSAL_11213_NUM;; + +let IQ_UNIVERSAL_11214 = + MATCH_MP + (SPECL [`&1:int`; `&1:int`; `&2:int`; `&14:int`] + IQ_UNIVERSAL_DIAG4_OF_NUM) + IQ_UNIVERSAL_11214_NUM;; + +let IQ_UNIVERSAL_1222 = + MATCH_MP + (SPEC `&2:int` IQ_UNIVERSAL_122C_OF_111C) + IQ_UNIVERSAL_1112;; + +let IQ_UNIVERSAL_1223 = + MATCH_MP + (SPEC `&3:int` IQ_UNIVERSAL_122C_OF_111C) + IQ_UNIVERSAL_1113;; + +let IQ_UNIVERSAL_1224 = + MATCH_MP + (SPEC `&4:int` IQ_UNIVERSAL_122C_OF_111C) + IQ_UNIVERSAL_1114;; + +let IQ_UNIVERSAL_1225 = + MATCH_MP + (SPEC `&5:int` IQ_UNIVERSAL_122C_OF_111C) + IQ_UNIVERSAL_1115;; + +let IQ_UNIVERSAL_1226 = + MATCH_MP + (SPEC `&6:int` IQ_UNIVERSAL_122C_OF_111C) + IQ_UNIVERSAL_1116;; + +let IQ_UNIVERSAL_1227 = + MATCH_MP + (SPEC `&7:int` IQ_UNIVERSAL_122C_OF_111C) + IQ_UNIVERSAL_1117;; + +let iqrows4 = new_definition + `iqrows4 (a:int) b c d e f g h k l m p q r s t i j = + if i = 0 then + (if j = 0 then a else if j = 1 then b else + if j = 2 then c else if j = 3 then d else &0) + else if i = 1 then + (if j = 0 then e else if j = 1 then f else + if j = 2 then g else if j = 3 then h else &0) + else if i = 2 then + (if j = 0 then k else if j = 1 then l else + if j = 2 then m else if j = 3 then p else &0) + else if i = 3 then + (if j = 0 then q else if j = 1 then r else + if j = 2 then s else if j = 3 then t else &0) + else &0`;; + +let IQBILIN_MAT4 = prove + (`!a b c d e f g h k l x y. + iqbilin 4 (iqmat4 a b c d e f g h k l) x y = + a * x 0 * y 0 + b * x 0 * y 1 + c * x 0 * y 2 + + d * x 0 * y 3 + + b * x 1 * y 0 + e * x 1 * y 1 + f * x 1 * y 2 + + g * x 1 * y 3 + + c * x 2 * y 0 + f * x 2 * y 1 + h * x 2 * y 2 + + k * x 2 * y 3 + + d * x 3 * y 0 + g * x 3 * y 1 + k * x 3 * y 2 + + l * x 3 * y 3`, + REPEAT GEN_TAC THEN + REWRITE_TAC[iqbilin; qindex; NUMSEG_LT; iqmat4; iqsym] THEN + CONV_TAC NUM_REDUCE_CONV THEN + CONV_TAC(ONCE_DEPTH_CONV EXPAND_ISUM_CONV) THEN + CONV_TAC(ONCE_DEPTH_CONV EXPAND_ISUM_CONV) THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC INT_RING);; + +let IQEVAL_MAT4 = prove + (`!a b c d e f g h k l x. + iqeval 4 (iqmat4 a b c d e f g h k l) x = + a * x 0 pow 2 + &2 * b * x 0 * x 1 + + &2 * c * x 0 * x 2 + &2 * d * x 0 * x 3 + + e * x 1 pow 2 + &2 * f * x 1 * x 2 + + &2 * g * x 1 * x 3 + h * x 2 pow 2 + + &2 * k * x 2 * x 3 + l * x 3 pow 2`, + REPEAT GEN_TAC THEN REWRITE_TAC[iqeval; IQBILIN_MAT4] THEN + CONV_TAC INT_RING);; + +(* ------------------------------------------------------------------------- *) +(* Rank three to rank four. *) +(* ------------------------------------------------------------------------- *) + +let IQ_ESCALATE_MAT3 = prove + (`!n A u v w x y z t. + iq_symmetric n A /\ iq_positive n A /\ + iq_embeds n 3 (iqmat3 u v w x y z) A /\ + iq_represents n A t + ==> ?a b c. + iq_embeds n 4 (iqmat4 u v w a x y b z c t) A /\ + a pow 2 <= u * t /\ + b pow 2 <= x * t /\ + c pow 2 <= z * t`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC) THEN + MP_TAC(SPECL + [`n:num`; `3`; `iqmat3 u v w x y z`; + `A:num->num->int`; `t:int`] IQ_ESCALATION_STEP) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `V:num->num->int` STRIP_ASSUME_TAC) THEN + ABBREV_TAC `a = iqgram n A V 0 3` THEN + ABBREV_TAC `b = iqgram n A V 1 3` THEN + ABBREV_TAC `c = iqgram n A V 2 3` THEN + SUBGOAL_THEN `iqgram n A V 3 0 = a` ASSUME_TAC THENL + [EXPAND_TAC "a" THEN MATCH_MP_TAC IQGRAM_SWAP THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `iqgram n A V 3 1 = b` ASSUME_TAC THENL + [EXPAND_TAC "b" THEN MATCH_MP_TAC IQGRAM_SWAP THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `iqgram n A V 3 2 = c` ASSUME_TAC THENL + [EXPAND_TAC "c" THEN MATCH_MP_TAC IQGRAM_SWAP THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `iqgram n A V 0 0 = u` ASSUME_TAC THENL + [MP_TAC(SPECL [`0`; `0`] (ASSUME + `!i j. i < 3 /\ j < 3 + ==> iqgram n A V i j = iqmat3 u v w x y z i j`)) THEN + REWRITE_TAC[iqmat3; iqsym] THEN CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + SUBGOAL_THEN `iqgram n A V 0 1 = v` ASSUME_TAC THENL + [MP_TAC(SPECL [`0`; `1`] (ASSUME + `!i j. i < 3 /\ j < 3 + ==> iqgram n A V i j = iqmat3 u v w x y z i j`)) THEN + REWRITE_TAC[iqmat3; iqsym] THEN CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + SUBGOAL_THEN `iqgram n A V 0 2 = w` ASSUME_TAC THENL + [MP_TAC(SPECL [`0`; `2`] (ASSUME + `!i j. i < 3 /\ j < 3 + ==> iqgram n A V i j = iqmat3 u v w x y z i j`)) THEN + REWRITE_TAC[iqmat3; iqsym] THEN CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + SUBGOAL_THEN `iqgram n A V 1 0 = v` ASSUME_TAC THENL + [MP_TAC(SPECL [`1`; `0`] (ASSUME + `!i j. i < 3 /\ j < 3 + ==> iqgram n A V i j = iqmat3 u v w x y z i j`)) THEN + REWRITE_TAC[iqmat3; iqsym] THEN CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + SUBGOAL_THEN `iqgram n A V 1 1 = x` ASSUME_TAC THENL + [MP_TAC(SPECL [`1`; `1`] (ASSUME + `!i j. i < 3 /\ j < 3 + ==> iqgram n A V i j = iqmat3 u v w x y z i j`)) THEN + REWRITE_TAC[iqmat3; iqsym] THEN CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + SUBGOAL_THEN `iqgram n A V 1 2 = y` ASSUME_TAC THENL + [MP_TAC(SPECL [`1`; `2`] (ASSUME + `!i j. i < 3 /\ j < 3 + ==> iqgram n A V i j = iqmat3 u v w x y z i j`)) THEN + REWRITE_TAC[iqmat3; iqsym] THEN CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + SUBGOAL_THEN `iqgram n A V 2 0 = w` ASSUME_TAC THENL + [MP_TAC(SPECL [`2`; `0`] (ASSUME + `!i j. i < 3 /\ j < 3 + ==> iqgram n A V i j = iqmat3 u v w x y z i j`)) THEN + REWRITE_TAC[iqmat3; iqsym] THEN CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + SUBGOAL_THEN `iqgram n A V 2 1 = y` ASSUME_TAC THENL + [MP_TAC(SPECL [`2`; `1`] (ASSUME + `!i j. i < 3 /\ j < 3 + ==> iqgram n A V i j = iqmat3 u v w x y z i j`)) THEN + REWRITE_TAC[iqmat3; iqsym] THEN CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + SUBGOAL_THEN `iqgram n A V 2 2 = z` ASSUME_TAC THENL + [MP_TAC(SPECL [`2`; `2`] (ASSUME + `!i j. i < 3 /\ j < 3 + ==> iqgram n A V i j = iqmat3 u v w x y z i j`)) THEN + REWRITE_TAC[iqmat3; iqsym] THEN CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + SUBGOAL_THEN `a pow 2 <= u * t` ASSUME_TAC THENL + [MP_TAC(SPEC `0` (ASSUME + `!i. i < 3 + ==> iqgram n A V i 3 pow 2 <= + iqmat3 u v w x y z i i * t`)) THEN + REWRITE_TAC[iqmat3; iqsym] THEN CONV_TAC NUM_REDUCE_CONV THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `b pow 2 <= x * t` ASSUME_TAC THENL + [MP_TAC(SPEC `1` (ASSUME + `!i. i < 3 + ==> iqgram n A V i 3 pow 2 <= + iqmat3 u v w x y z i i * t`)) THEN + REWRITE_TAC[iqmat3; iqsym] THEN CONV_TAC NUM_REDUCE_CONV THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `c pow 2 <= z * t` ASSUME_TAC THENL + [MP_TAC(SPEC `2` (ASSUME + `!i. i < 3 + ==> iqgram n A V i 3 pow 2 <= + iqmat3 u v w x y z i i * t`)) THEN + REWRITE_TAC[iqmat3; iqsym] THEN CONV_TAC NUM_REDUCE_CONV THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MAP_EVERY EXISTS_TAC [`a:int`; `b:int`; `c:int`] THEN + CONJ_TAC THENL + [MATCH_MP_TAC(ISPECL + [`n:num`; `4`; `iqgram n A V`; + `iqmat4 u v w a x y b z c t`; `A:num->num->int`] + IQ_EMBEDS_EQ) THEN + CONJ_TAC THENL + [MP_TAC(ASSUME `iq_embeds n (3 + 1) (iqgram n A V) A`) THEN + CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + REPEAT STRIP_TAC THEN + (SUBGOAL_THEN `i = 0 \/ i = 1 \/ i = 2 \/ i = 3` MP_TAC THENL + [UNDISCH_TAC `i < 4` THEN ARITH_TAC; ALL_TAC]) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + (SUBGOAL_THEN `j = 0 \/ j = 1 \/ j = 2 \/ j = 3` MP_TAC THENL + [UNDISCH_TAC `j < 4` THEN ARITH_TAC; ALL_TAC]) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + ASM_REWRITE_TAC[iqmat4; iqmat3; iqsym] THEN + CONV_TAC NUM_REDUCE_CONV; + ASM_REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Symbolic clearing of three unit columns. *) +(* ------------------------------------------------------------------------- *) + +let iqclear111 = new_definition + `iqclear111 a b c = + iqrows4 + (&1) (&0) (&0) (&0) + (&0) (&1) (&0) (&0) + (&0) (&0) (&1) (&0) + (--a) (--b) (--c) (&1)`;; + +let IQ_EMBEDS_CLEAR_111 = prove + (`!n A a b c t. + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) a + (&1) (&0) b (&1) c t) A + ==> iq_embeds n 4 + (iqdiag4 (&1) (&1) (&1) + (t - a pow 2 - b pow 2 - c pow 2)) A`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(ISPECL + [`n:num`; `4`; + `iqgram 4 + (iqmat4 (&1) (&0) (&0) a + (&1) (&0) b (&1) c t) + (iqclear111 a b c)`; + `iqdiag4 (&1) (&1) (&1) + (t - a pow 2 - b pow 2 - c pow 2)`; + `A:num->num->int`] IQ_EMBEDS_EQ) THEN + CONJ_TAC THENL + [MATCH_MP_TAC IQ_EMBEDS_CONGRUENCE THEN ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC THEN + (SUBGOAL_THEN `i = 0 \/ i = 1 \/ i = 2 \/ i = 3` MP_TAC THENL + [ASM_ARITH_TAC; ALL_TAC]) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + (SUBGOAL_THEN `j = 0 \/ j = 1 \/ j = 2 \/ j = 3` MP_TAC THENL + [ASM_ARITH_TAC; ALL_TAC]) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + ASM_REWRITE_TAC[iqgram; IQBILIN_MAT4; iqclear111; iqrows4; + iqdiag4; iqdiag] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC INT_RING]);; + +let INT_SQ_LE_7_CASES = prove + (`!a:int. + a pow 2 <= &7 + ==> a = -- &2 \/ a = -- &1 \/ a = &0 \/ a = &1 \/ a = &2`, + GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN `abs a < &3` ASSUME_TAC THENL + [MP_TAC(SPECL [`a:int`; `&3:int`] INT_LT_SQUARE_ABS) THEN + REWRITE_TAC[INT_ABS_NUM] THEN + CONV_TAC NUM_REDUCE_CONV THEN ASM_INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `abs a <= &2` ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; ALL_TAC] THEN + MP_TAC(SPECL [`a:int`; `&2:int`] INT_ABS_BOUNDS) THEN + ASM_REWRITE_TAC[] THEN INT_ARITH_TAC);; + +let IQ_111_CORNER_CASES = prove + (`!a b c:int. + a pow 2 <= &7 /\ b pow 2 <= &7 /\ c pow 2 <= &7 /\ + &0 <= &7 - a pow 2 - b pow 2 - c pow 2 + ==> &7 - a pow 2 - b pow 2 - c pow 2 = &1 \/ + &7 - a pow 2 - b pow 2 - c pow 2 = &2 \/ + &7 - a pow 2 - b pow 2 - c pow 2 = &3 \/ + &7 - a pow 2 - b pow 2 - c pow 2 = &4 \/ + &7 - a pow 2 - b pow 2 - c pow 2 = &5 \/ + &7 - a pow 2 - b pow 2 - c pow 2 = &6 \/ + &7 - a pow 2 - b pow 2 - c pow 2 = &7`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(MATCH_MP INT_SQ_LE_7_CASES (ASSUME `a pow 2 <= &7`)) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + MP_TAC(MATCH_MP INT_SQ_LE_7_CASES (ASSUME `b pow 2 <= &7`)) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + MP_TAC(MATCH_MP INT_SQ_LE_7_CASES (ASSUME `c pow 2 <= &7`)) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + CONV_TAC INT_REDUCE_CONV THEN ASM_INT_ARITH_TAC);; + +(* The k = 1 leaf contains the universal <1,1,2,2> sublattice. *) + +let iqembed1122in1111 = new_definition + `iqembed1122in1111 = + iqrows4 + (&1) (&0) (&0) (&0) + (&0) (&1) (&0) (&0) + (&0) (&0) (&1) (&1) + (&0) (&0) (&1) (-- &1)`;; + +let IQ_EMBEDS_1122_IN_1111 = prove + (`iq_embeds 4 4 + (iqdiag4 (&1) (&1) (&2) (&2)) + (iqdiag4 (&1) (&1) (&1) (&1))`, + REWRITE_TAC[iq_embeds] THEN EXISTS_TAC `iqembed1122in1111` THEN + REPEAT STRIP_TAC THEN + (SUBGOAL_THEN `i = 0 \/ i = 1 \/ i = 2 \/ i = 3` MP_TAC THENL + [ASM_ARITH_TAC; ALL_TAC]) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + (SUBGOAL_THEN `j = 0 \/ j = 1 \/ j = 2 \/ j = 3` MP_TAC THENL + [ASM_ARITH_TAC; ALL_TAC]) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + REWRITE_TAC[iqgram; iqbilin; qindex; NUMSEG_LT; + iqembed1122in1111; iqrows4; iqdiag4; iqdiag] THEN + CONV_TAC NUM_REDUCE_CONV THEN + CONV_TAC(ONCE_DEPTH_CONV EXPAND_ISUM_CONV) THEN + CONV_TAC(ONCE_DEPTH_CONV EXPAND_ISUM_CONV) THEN + CONV_TAC NUM_REDUCE_CONV THEN + CONV_TAC INT_REDUCE_CONV);; + +let IQ_UNIVERSAL_1111 = prove + (`iq_universal 4 (iqdiag4 (&1) (&1) (&1) (&1))`, + MATCH_MP_TAC(ISPECL + [`4`; `4`; `iqdiag4 (&1) (&1) (&2) (&2)`; + `iqdiag4 (&1) (&1) (&1) (&1)`] IQ_UNIVERSAL_OF_EMBEDS) THEN + REWRITE_TAC[IQ_EMBEDS_1122_IN_1111; IQ_UNIVERSAL_1122]);; + +let IQ_UNIVERSAL_OF_DIAG111_CHILD = prove + (`!n A k. + iq_embeds n 4 (iqdiag4 (&1) (&1) (&1) k) A /\ + (k = &1 \/ k = &2 \/ k = &3 \/ k = &4 \/ + k = &5 \/ k = &6 \/ k = &7) + ==> iq_universal n A`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC) THEN + MATCH_MP_TAC(ISPECL + [`n:num`; `4`; `iqdiag4 (&1) (&1) (&1) k`; + `A:num->num->int`] IQ_UNIVERSAL_OF_EMBEDS) THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + ALL_TAC] THEN + UNDISCH_TAC + `k = &1 \/ k = &2 \/ k = &3 \/ k = &4 \/ + k = &5 \/ k = &6 \/ k = &7` THEN + DISCH_THEN(DISJ_CASES_THEN2 SUBST_ALL_TAC + (DISJ_CASES_THEN2 SUBST_ALL_TAC + (DISJ_CASES_THEN2 SUBST_ALL_TAC + (DISJ_CASES_THEN2 SUBST_ALL_TAC + (DISJ_CASES_THEN2 SUBST_ALL_TAC + (DISJ_CASES_THEN SUBST_ALL_TAC)))))) THEN + ASM_REWRITE_TAC + [IQ_UNIVERSAL_1111; IQ_UNIVERSAL_1112; + IQ_UNIVERSAL_1113; IQ_UNIVERSAL_1114; IQ_UNIVERSAL_1115; + IQ_UNIVERSAL_1116; IQ_UNIVERSAL_1117]);; + +let IQ_UNIVERSAL_OF_EMBEDS_111 = prove + (`!n A. + iq_symmetric n A /\ iq_positive n A /\ + iq_embeds n 3 + (iqmat3 (&1) (&0) (&0) (&1) (&0) (&1)) A /\ + iq_represents n A (&7) + ==> iq_universal n A`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(SPECL + [`n:num`; `A:num->num->int`; + `&1:int`; `&0:int`; `&0:int`; `&1:int`; `&0:int`; `&1:int`; + `&7:int`] IQ_ESCALATE_MAT3) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `a:int` + (X_CHOOSE_THEN `b:int` + (X_CHOOSE_THEN `c:int` STRIP_ASSUME_TAC))) THEN + ABBREV_TAC `k = &7 - a pow 2 - b pow 2 - c pow 2` THEN + SUBGOAL_THEN + `iq_embeds n 4 (iqdiag4 (&1) (&1) (&1) k) A` + ASSUME_TAC THENL + [EXPAND_TAC "k" THEN MATCH_MP_TAC IQ_EMBEDS_CLEAR_111 THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `&0 <= k` ASSUME_TAC THENL + [MP_TAC(MATCH_MP + (ISPECL + [`n:num`; `4`; `iqdiag4 (&1) (&1) (&1) k`; + `A:num->num->int`] IQ_EMBEDDED_NONNEG) + (CONJ (ASSUME `iq_positive n A`) + (ASSUME `iq_embeds n 4 (iqdiag4 (&1) (&1) (&1) k) A`))) THEN + DISCH_THEN(MP_TAC o SPEC + `\i:num. if i = 3 then &1 else &0`) THEN + REWRITE_TAC[IQEVAL_DIAG4] THEN + CONV_TAC NUM_REDUCE_CONV THEN INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `k = &1 \/ k = &2 \/ k = &3 \/ k = &4 \/ + k = &5 \/ k = &6 \/ k = &7` + ASSUME_TAC THENL + [EXPAND_TAC "k" THEN MATCH_MP_TAC IQ_111_CORNER_CASES THEN + REPEAT CONJ_TAC THEN ASM_INT_ARITH_TAC; + MATCH_MP_TAC(ISPECL + [`n:num`; `A:num->num->int`; `k:int`] + IQ_UNIVERSAL_OF_DIAG111_CHILD) THEN + ASM_REWRITE_TAC[]]);; + +let iqclear112 = new_definition + `iqclear112 a b q = + iqrows4 + (&1) (&0) (&0) (&0) + (&0) (&1) (&0) (&0) + (&0) (&0) (&1) (&0) + (--a) (--b) (--q) (&1)`;; + +let IQ_EMBEDS_CLEAR_112 = prove + (`!n A a b q r t. + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) a + (&1) (&0) b (&2) (&2 * q + r) t) A + ==> iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&1) (&0) (&0) (&2) r + (t - a pow 2 - b pow 2 - + &2 * q pow 2 - &2 * q * r)) A`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(ISPECL + [`n:num`; `4`; + `iqgram 4 + (iqmat4 (&1) (&0) (&0) a + (&1) (&0) b (&2) (&2 * q + r) t) + (iqclear112 a b q)`; + `iqmat4 (&1) (&0) (&0) (&0) + (&1) (&0) (&0) (&2) r + (t - a pow 2 - b pow 2 - + &2 * q pow 2 - &2 * q * r)`; + `A:num->num->int`] IQ_EMBEDS_EQ) THEN + CONJ_TAC THENL + [MATCH_MP_TAC IQ_EMBEDS_CONGRUENCE THEN ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC THEN + (SUBGOAL_THEN `i = 0 \/ i = 1 \/ i = 2 \/ i = 3` MP_TAC THENL + [ASM_ARITH_TAC; ALL_TAC]) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + (SUBGOAL_THEN `j = 0 \/ j = 1 \/ j = 2 \/ j = 3` MP_TAC THENL + [ASM_ARITH_TAC; ALL_TAC]) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + ASM_REWRITE_TAC[iqgram; IQBILIN_MAT4; iqclear112; iqrows4; + iqmat4; iqsym] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC INT_RING]);; + +let IQ_EMBEDS_MAT4_DIAG = prove + (`!n A a b c d. + iq_embeds n 4 + (iqmat4 a (&0) (&0) (&0) + b (&0) (&0) c (&0) d) A + ==> iq_embeds n 4 (iqdiag4 a b c d) A`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(ISPECL + [`n:num`; `4`; + `iqmat4 a (&0) (&0) (&0) b (&0) (&0) c (&0) d`; + `iqdiag4 a b c d`; `A:num->num->int`] IQ_EMBEDS_EQ) THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC THEN + (SUBGOAL_THEN `i = 0 \/ i = 1 \/ i = 2 \/ i = 3` MP_TAC THENL + [ASM_ARITH_TAC; ALL_TAC]) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + (SUBGOAL_THEN `j = 0 \/ j = 1 \/ j = 2 \/ j = 3` MP_TAC THENL + [ASM_ARITH_TAC; ALL_TAC]) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + REWRITE_TAC[iqmat4; iqsym; iqdiag4; iqdiag] THEN + CONV_TAC NUM_REDUCE_CONV]);; + +let INT_SQ_LE_14_CASES = prove + (`!a:int. + a pow 2 <= &14 + ==> a = -- &3 \/ a = -- &2 \/ a = -- &1 \/ a = &0 \/ + a = &1 \/ a = &2 \/ a = &3`, + GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN `abs a < &4` ASSUME_TAC THENL + [MP_TAC(SPECL [`a:int`; `&4:int`] INT_LT_SQUARE_ABS) THEN + REWRITE_TAC[INT_ABS_NUM] THEN + CONV_TAC NUM_REDUCE_CONV THEN ASM_INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `abs a <= &3` ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; ALL_TAC] THEN + MP_TAC(SPECL [`a:int`; `&3:int`] INT_ABS_BOUNDS) THEN + ASM_REWRITE_TAC[] THEN INT_ARITH_TAC);; + +let INT_SQ_LE_28_CASES = prove + (`!a:int. + a pow 2 <= &28 + ==> a = -- &5 \/ a = -- &4 \/ a = -- &3 \/ a = -- &2 \/ + a = -- &1 \/ a = &0 \/ a = &1 \/ a = &2 \/ + a = &3 \/ a = &4 \/ a = &5`, + GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN `abs a < &6` ASSUME_TAC THENL + [MP_TAC(SPECL [`a:int`; `&6:int`] INT_LT_SQUARE_ABS) THEN + REWRITE_TAC[INT_ABS_NUM] THEN + CONV_TAC NUM_REDUCE_CONV THEN ASM_INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `abs a <= &5` ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; ALL_TAC] THEN + MP_TAC(SPECL [`a:int`; `&5:int`] INT_ABS_BOUNDS) THEN + ASM_REWRITE_TAC[] THEN INT_ARITH_TAC);; + +let IQ_112_PARAMETERS = prove + (`!a b c:int. + a pow 2 <= &14 /\ b pow 2 <= &14 /\ c pow 2 <= &28 + ==> ?q r k. + c = &2 * q + r /\ + k = &14 - a pow 2 - b pow 2 - + &2 * q pow 2 - &2 * q * r /\ + ((r = &0 /\ (k < &0 \/ (&1 <= k /\ k <= &14))) \/ + (r = &1 /\ + (k <= &0 \/ + (&1 <= k /\ k <= &14 /\ ~(k rem &4 = &3)))))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MAP_EVERY EXISTS_TAC + [`c div &2:int`; `c rem &2:int`; + `&14 - a pow 2 - b pow 2 - + &2 * (c div &2) pow 2 - &2 * (c div &2) * (c rem &2):int`] THEN + CONJ_TAC THENL + [MP_TAC(SPEC `c:int` INT_DIV2_DECOMP) THEN MESON_TAC[]; + ALL_TAC] THEN + CONJ_TAC THENL + [REFL_TAC; + ALL_TAC] THEN + MP_TAC(MATCH_MP INT_SQ_LE_14_CASES + (ASSUME `a pow 2 <= &14`)) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + MP_TAC(MATCH_MP INT_SQ_LE_14_CASES + (ASSUME `b pow 2 <= &14`)) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + MP_TAC(MATCH_MP INT_SQ_LE_28_CASES + (ASSUME `c pow 2 <= &28`)) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + CONV_TAC INT_REDUCE_CONV);; + +let IQ_EMBEDS_QUATERNARY_112 = prove + (`!n A. + iq_symmetric n A /\ iq_positive n A /\ + iq_embeds n 3 + (iqmat3 (&1) (&0) (&0) (&1) (&0) (&2)) A /\ + iq_represents n A (&14) + ==> (?k. + &1 <= k /\ k <= &14 /\ + iq_embeds n 4 (iqdiag4 (&1) (&1) (&2) k) A) \/ + (?k. + &1 <= k /\ k <= &14 /\ ~(k rem &4 = &3) /\ + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&1) (&0) (&0) (&2) (&1) k) A)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(SPECL + [`n:num`; `A:num->num->int`; + `&1:int`; `&0:int`; `&0:int`; `&1:int`; `&0:int`; `&2:int`; + `&14:int`] IQ_ESCALATE_MAT3) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `a:int` + (X_CHOOSE_THEN `b:int` + (X_CHOOSE_THEN `c:int` STRIP_ASSUME_TAC))) THEN + MP_TAC(SPECL [`a:int`; `b:int`; `c:int`] IQ_112_PARAMETERS) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THEN ASM_INT_ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `q:int` + (X_CHOOSE_THEN `r:int` + (X_CHOOSE_THEN `k:int` + (CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC))))) THEN + SUBGOAL_THEN + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) a + (&1) (&0) b (&2) (&2 * q + r) (&14)) A` + ASSUME_TAC THENL + [MATCH_ACCEPT_TAC(REWRITE_RULE[ASSUME `c = &2 * q + r`] (ASSUME + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) a + (&1) (&0) b (&2) c (&14)) A`)); + ALL_TAC] THEN + SUBGOAL_THEN + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&1) (&0) (&0) (&2) r k) A` + ASSUME_TAC THENL + [ONCE_REWRITE_TAC[ASSUME + `k = &14 - a pow 2 - b pow 2 - + &2 * q pow 2 - &2 * q * r`] THEN + MATCH_MP_TAC IQ_EMBEDS_CLEAR_112 THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `&0 <= k` ASSUME_TAC THENL + [MP_TAC(MATCH_MP + (ISPECL + [`n:num`; `4`; + `iqmat4 (&1) (&0) (&0) (&0) + (&1) (&0) (&0) (&2) r k`; + `A:num->num->int`] IQ_EMBEDDED_NONNEG) + (CONJ (ASSUME `iq_positive n A`) (ASSUME + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&1) (&0) (&0) (&2) r k) A`))) THEN + DISCH_THEN(MP_TAC o SPEC + `\i:num. if i = 3 then &1 else &0`) THEN + REWRITE_TAC[IQEVAL_MAT4] THEN + CONV_TAC NUM_REDUCE_CONV THEN INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `r = &1 ==> &1 <= k` ASSUME_TAC THENL + [DISCH_TAC THEN + MP_TAC(MATCH_MP + (ISPECL + [`n:num`; `4`; + `iqmat4 (&1) (&0) (&0) (&0) + (&1) (&0) (&0) (&2) r k`; + `A:num->num->int`] IQ_EMBEDDED_NONNEG) + (CONJ (ASSUME `iq_positive n A`) (ASSUME + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&1) (&0) (&0) (&2) r k) A`))) THEN + DISCH_THEN(MP_TAC o SPEC + `\i:num. + if i = 2 then -- &1 else if i = 3 then &2 else &0`) THEN + ASM_REWRITE_TAC[IQEVAL_MAT4] THEN + CONV_TAC NUM_REDUCE_CONV THEN INT_ARITH_TAC; + ALL_TAC] THEN + UNDISCH_TAC + `(r = &0 /\ (k < &0 \/ (&1 <= k /\ k <= &14))) \/ + (r = &1 /\ + (k <= &0 \/ (&1 <= k /\ k <= &14 /\ ~(k rem &4 = &3))))` THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN STRIP_ASSUME_TAC) THENL + [ASM_INT_ARITH_TAC; + DISJ1_TAC THEN EXISTS_TAC `k:int` THEN + CONJ_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + CONJ_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC IQ_EMBEDS_MAT4_DIAG THEN + MATCH_ACCEPT_TAC(REWRITE_RULE[ASSUME `r = &0`] (ASSUME + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&1) (&0) (&0) (&2) r k) A`)); + ASM_INT_ARITH_TAC; + DISJ2_TAC THEN EXISTS_TAC `k:int` THEN + CONJ_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + CONJ_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + CONJ_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_ACCEPT_TAC(REWRITE_RULE[ASSUME `r = &1`] (ASSUME + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&1) (&0) (&0) (&2) r k) A`))]);; + +(* ------------------------------------------------------------------------- *) +(* Diagonal children. *) +(* ------------------------------------------------------------------------- *) + +let IQ_UNIVERSAL_1121_NUM = prove + (`!n:num. + 0 < n + ==> ?x y z w:int. + &1 * x pow 2 + &1 * y pow 2 + + &2 * z pow 2 + &1 * w pow 2 = &n`, + GEN_TAC THEN DISCH_TAC THEN + MP_TAC(MATCH_MP IQ_UNIVERSAL_1112_NUM (ASSUME `0 < n`)) THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` + (X_CHOOSE_THEN `z:int` (X_CHOOSE_TAC `w:int`)))) THEN + MAP_EVERY EXISTS_TAC [`x:int`; `y:int`; `w:int`; `z:int`] THEN + FIRST_X_ASSUM(MP_TAC) THEN CONV_TAC INT_RING);; + +let IQ_UNIVERSAL_1121 = prove + (`iq_universal 4 (iqdiag4 (&1) (&1) (&2) (&1))`, + MATCH_MP_TAC IQ_UNIVERSAL_DIAG4_OF_NUM THEN + ACCEPT_TAC IQ_UNIVERSAL_1121_NUM);; + +let IQ_UNIVERSAL_OF_DIAG112_CHILD = prove + (`!n A k. + iq_embeds n 4 (iqdiag4 (&1) (&1) (&2) k) A /\ + &1 <= k /\ k <= &14 + ==> iq_universal n A`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC(ISPECL + [`n:num`; `4`; `iqdiag4 (&1) (&1) (&2) k`; + `A:num->num->int`] IQ_UNIVERSAL_OF_EMBEDS) THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `k = &1 \/ k = &2 \/ k = &3 \/ k = &4 \/ k = &5 \/ + k = &6 \/ k = &7 \/ k = &8 \/ k = &9 \/ k = &10 \/ + k = &11 \/ k = &12 \/ k = &13 \/ k = &14` + ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; + ALL_TAC] THEN + UNDISCH_TAC + `k = &1 \/ k = &2 \/ k = &3 \/ k = &4 \/ k = &5 \/ + k = &6 \/ k = &7 \/ k = &8 \/ k = &9 \/ k = &10 \/ + k = &11 \/ k = &12 \/ k = &13 \/ k = &14` THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + ASM_REWRITE_TAC + [IQ_UNIVERSAL_1121; IQ_UNIVERSAL_1122; IQ_UNIVERSAL_1123; + IQ_UNIVERSAL_1124; IQ_UNIVERSAL_1125; IQ_UNIVERSAL_1126; + IQ_UNIVERSAL_1127; IQ_UNIVERSAL_1128; IQ_UNIVERSAL_1129; + IQ_UNIVERSAL_11210; IQ_UNIVERSAL_11211; IQ_UNIVERSAL_11212; + IQ_UNIVERSAL_11213; IQ_UNIVERSAL_11214]);; + +(* ------------------------------------------------------------------------- *) +(* Cross children x^2 + y^2 + 2z^2 + 2zw + k w^2. *) +(* ------------------------------------------------------------------------- *) + +let NUM_CROSS112_TARGET_AVOIDS = prove + (`!n k:num. + n MOD 16 = 14 /\ k <= n /\ ~(k MOD 4 = 3) + ==> ~((2 * (n - k) + 1) MOD 4 = 0) /\ + ~((2 * (n - k) + 1) MOD 8 = 7)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `n MOD 4 = 2` ASSUME_TAC THENL + [SUBGOAL_THEN `(n MOD 16) MOD 4 = n MOD 4` MP_TAC THENL + [REWRITE_TAC[ARITH_RULE `16 = 4 * 4`; MOD_MOD]; + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN ARITH_TAC]; + ALL_TAC] THEN + MP_TAC(MATCH_MP (SPECL [`n:num`; `4`; `2`] NUM_DECOMPOSE_MOD) + (CONJ (ARITH_RULE `~(4 = 0)`) + (ASSUME `n MOD 4 = 2`))) THEN + DISCH_THEN(X_CHOOSE_TAC `qn:num`) THEN + MP_TAC(SPEC `k:num` MOD4_CASES) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THENL + [MP_TAC(MATCH_MP (SPECL [`k:num`; `4`; `0`] NUM_DECOMPOSE_MOD) + (CONJ (ARITH_RULE `~(4 = 0)`) + (ASSUME `k MOD 4 = 0`))) THEN + DISCH_THEN(X_CHOOSE_TAC `qk:num`) THEN + SUBGOAL_THEN `(qk:num) <= qn` ASSUME_TAC THENL + [MATCH_MP_TAC(ARITH_RULE + `4 * qk + 0 <= 4 * qn + 2 ==> qk <= qn`) THEN + REWRITE_TAC[GSYM(ASSUME `n = 4 * qn + 2`); + GSYM(ASSUME `k = 4 * qk + 0`)] THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `n - k = 4 * (qn - qk) + 2` SUBST1_TAC THENL + [ONCE_REWRITE_TAC[ASSUME `n = 4 * qn + 2`] THEN + ONCE_REWRITE_TAC[ASSUME `k = 4 * qk + 0`] THEN + MATCH_MP_TAC(ARITH_RULE + `qk <= qn + ==> (4 * qn + 2) - (4 * qk + 0) = 4 * (qn - qk) + 2`) THEN + ASM_REWRITE_TAC[ASSUME `(qk:num) <= qn`]; + ALL_TAC] THEN + CONJ_TAC THENL + [REWRITE_TAC + [ARITH_RULE `2 * (4 * d + 2) + 1 = 4 * (2 * d + 1) + 1`; + MOD_MULT_ADD] THEN CONV_TAC NUM_REDUCE_CONV; + REWRITE_TAC + [ARITH_RULE `2 * (4 * d + 2) + 1 = 8 * d + 5`; + MOD_MULT_ADD] THEN CONV_TAC NUM_REDUCE_CONV]; + MP_TAC(MATCH_MP (SPECL [`k:num`; `4`; `1`] NUM_DECOMPOSE_MOD) + (CONJ (ARITH_RULE `~(4 = 0)`) + (ASSUME `k MOD 4 = 1`))) THEN + DISCH_THEN(X_CHOOSE_TAC `qk:num`) THEN + SUBGOAL_THEN `(qk:num) <= qn` ASSUME_TAC THENL + [MATCH_MP_TAC(ARITH_RULE + `4 * qk + 1 <= 4 * qn + 2 ==> qk <= qn`) THEN + REWRITE_TAC[GSYM(ASSUME `n = 4 * qn + 2`); + GSYM(ASSUME `k = 4 * qk + 1`)] THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `n - k = 4 * (qn - qk) + 1` SUBST1_TAC THENL + [ONCE_REWRITE_TAC[ASSUME `n = 4 * qn + 2`] THEN + ONCE_REWRITE_TAC[ASSUME `k = 4 * qk + 1`] THEN + MATCH_MP_TAC(ARITH_RULE + `qk <= qn + ==> (4 * qn + 2) - (4 * qk + 1) = 4 * (qn - qk) + 1`) THEN + ASM_REWRITE_TAC[ASSUME `(qk:num) <= qn`]; + ALL_TAC] THEN + CONJ_TAC THENL + [REWRITE_TAC + [ARITH_RULE `2 * (4 * d + 1) + 1 = 4 * (2 * d) + 3`; + MOD_MULT_ADD] THEN CONV_TAC NUM_REDUCE_CONV; + REWRITE_TAC + [ARITH_RULE `2 * (4 * d + 1) + 1 = 8 * d + 3`; + MOD_MULT_ADD] THEN CONV_TAC NUM_REDUCE_CONV]; + MP_TAC(MATCH_MP (SPECL [`k:num`; `4`; `2`] NUM_DECOMPOSE_MOD) + (CONJ (ARITH_RULE `~(4 = 0)`) + (ASSUME `k MOD 4 = 2`))) THEN + DISCH_THEN(X_CHOOSE_TAC `qk:num`) THEN + SUBGOAL_THEN `(qk:num) <= qn` ASSUME_TAC THENL + [MATCH_MP_TAC(ARITH_RULE + `4 * qk + 2 <= 4 * qn + 2 ==> qk <= qn`) THEN + REWRITE_TAC[GSYM(ASSUME `n = 4 * qn + 2`); + GSYM(ASSUME `k = 4 * qk + 2`)] THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `n - k = 4 * (qn - qk)` SUBST1_TAC THENL + [ONCE_REWRITE_TAC[ASSUME `n = 4 * qn + 2`] THEN + ONCE_REWRITE_TAC[ASSUME `k = 4 * qk + 2`] THEN + MATCH_MP_TAC(ARITH_RULE + `qk <= qn + ==> (4 * qn + 2) - (4 * qk + 2) = 4 * (qn - qk)`) THEN + ASM_REWRITE_TAC[ASSUME `(qk:num) <= qn`]; + ALL_TAC] THEN + CONJ_TAC THENL + [REWRITE_TAC + [ARITH_RULE `2 * (4 * d) + 1 = 4 * (2 * d) + 1`; + MOD_MULT_ADD] THEN CONV_TAC NUM_REDUCE_CONV; + REWRITE_TAC + [ARITH_RULE `2 * (4 * d) + 1 = 8 * d + 1`; + MOD_MULT_ADD] THEN CONV_TAC NUM_REDUCE_CONV]; + ASM_MESON_TAC[]]);; + +let INT_REPRESENTS_CROSS112_BAD = prove + (`!k n:num. + 1 <= k /\ k <= 14 /\ ~(k MOD 4 = 3) /\ n MOD 16 = 14 + ==> ?x y z:int. + x pow 2 + y pow 2 + &2 * z pow 2 + &2 * z + &k = &n`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `14 <= n` ASSUME_TAC THENL + [MP_TAC(SPECL [`n:num`; `16`; `14`] NUM_DECOMPOSE_MOD) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN + DISCH_THEN(X_CHOOSE_TAC `q:num`) THEN ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `(k:num) <= n` ASSUME_TAC THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + MP_TAC(MATCH_MP REPR_122_OF_THREE_SQUARES + (MATCH_MP INT_THREE_SQUARES_OF_MOD + (MATCH_MP (SPECL [`n:num`; `k:num`] NUM_CROSS112_TARGET_AVOIDS) + (CONJ (ASSUME `n MOD 16 = 14`) + (CONJ (ASSUME `(k:num) <= n`) + (ASSUME `~(k MOD 4 = 3)`)))))) THEN + DISCH_THEN(X_CHOOSE_THEN `u:int` + (X_CHOOSE_THEN `x:int` (X_CHOOSE_THEN `y:int` ASSUME_TAC))) THEN + SUBGOAL_THEN + `u pow 2 + &2 * x pow 2 + &2 * y pow 2 = + &2 * (&n - &k) + &1` + ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC) THEN + ASM_SIMP_TAC[INT_OF_NUM_ADD; INT_OF_NUM_MUL; INT_OF_NUM_SUB]; + ALL_TAC] THEN + MP_TAC(SPEC `u:int` INT_PARITY_WITNESS) THEN + DISCH_THEN(DISJ_CASES_THEN (X_CHOOSE_TAC `z:int`)) THENL + [SUBGOAL_THEN + `&2 * (&2 * z pow 2 + x pow 2 + y pow 2 - (&n - &k)) = &1` + ASSUME_TAC THENL + [MATCH_ACCEPT_TAC + (MATCH_MP + (MATCH_MP + (INT_RING + `u = &2 * z + ==> u pow 2 + &2 * x pow 2 + &2 * y pow 2 = + &2 * (nn - kk) + &1 + ==> &2 * + (&2 * z pow 2 + x pow 2 + y pow 2 - (nn - kk)) = + &1`) + (ASSUME `u = &2 * z`)) + (ASSUME + `u pow 2 + &2 * x pow 2 + &2 * y pow 2 = + &2 * (&n - &k) + &1`)); + MP_TAC(SPEC + `&2 * z pow 2 + x pow 2 + y pow 2 - (&n - &k):int` + INT_TWO_MUL_NE_ONE) THEN ASM_REWRITE_TAC[]]; + MAP_EVERY EXISTS_TAC [`x:int`; `y:int`; `z:int`] THEN + MATCH_ACCEPT_TAC + (MATCH_MP + (MATCH_MP + (INT_RING + `u = &2 * z + &1 + ==> u pow 2 + &2 * x pow 2 + &2 * y pow 2 = + &2 * (nn - kk) + &1 + ==> x pow 2 + y pow 2 + &2 * z pow 2 + &2 * z + kk = + nn`) + (ASSUME `u = &2 * z + &1`)) + (ASSUME + `u pow 2 + &2 * x pow 2 + &2 * y pow 2 = + &2 * (&n - &k) + &1`))]);; + +let INT_UNIVERSAL_CROSS112_NUM = prove + (`!k:num. + 1 <= k /\ k <= 14 /\ ~(k MOD 4 = 3) + ==> !n:num. + 0 < n + ==> ?x y z w:int. + x pow 2 + y pow 2 + &2 * z pow 2 + + &2 * z * w + &k * w pow 2 = &n`, + GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN + DISCH_TAC THEN DISCH_TAC THEN + ASM_CASES_TAC `n MOD 4 = 0` THENL + [SUBGOAL_THEN `n = 4 * (n DIV 4)` SUBST1_TAC THENL + [MP_TAC(SPECL [`n:num`; `4`] DIVISION) THEN + CONV_TAC NUM_REDUCE_CONV THEN + ASM_REWRITE_TAC[ADD_CLAUSES] THEN ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `n DIV 4 < n /\ 0 < n DIV 4` STRIP_ASSUME_TAC THENL + [MP_TAC(SPECL [`n:num`; `4`] DIVISION) THEN + CONV_TAC NUM_REDUCE_CONV THEN + ASM_REWRITE_TAC[ADD_CLAUSES] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(MATCH_MP + (MATCH_MP + (SPEC `n DIV 4` (ASSUME + `!m. m < n + ==> 0 < m + ==> ?x y z w:int. + x pow 2 + y pow 2 + &2 * z pow 2 + + &2 * z * w + &k * w pow 2 = &m`)) + (ASSUME `n DIV 4 < n`)) + (ASSUME `0 < n DIV 4`)) THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` + (X_CHOOSE_THEN `z:int` (X_CHOOSE_TAC `w:int`)))) THEN + MAP_EVERY EXISTS_TAC + [`&2 * x:int`; `&2 * y:int`; `&2 * z:int`; `&2 * w:int`] THEN + FIRST_X_ASSUM(MP_TAC) THEN + REWRITE_TAC[GSYM INT_OF_NUM_MUL] THEN CONV_TAC INT_RING; + ALL_TAC] THEN + ASM_CASES_TAC `n MOD 2 = 1` THENL + [MP_TAC(MATCH_MP INT_REPRESENTS_112_ODD + (ASSUME `n MOD 2 = 1`)) THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` (X_CHOOSE_TAC `z:int`))) THEN + MAP_EVERY EXISTS_TAC [`x:int`; `y:int`; `z:int`; `&0:int`] THEN + FIRST_X_ASSUM(MP_TAC) THEN CONV_TAC INT_RING; + ALL_TAC] THEN + SUBGOAL_THEN `n MOD 4 = 2` ASSUME_TAC THENL + [MATCH_MP_TAC NUM_MOD4_NONZERO_NONODD THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + ASM_CASES_TAC `n MOD 16 = 14` THENL + [MP_TAC(MATCH_MP (SPECL [`k:num`; `n:num`] + INT_REPRESENTS_CROSS112_BAD) + (CONJ (ASSUME `1 <= k`) + (CONJ (ASSUME `k <= 14`) + (CONJ (ASSUME `~(k MOD 4 = 3)`) + (ASSUME `n MOD 16 = 14`))))) THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` (X_CHOOSE_TAC `z:int`))) THEN + MAP_EVERY EXISTS_TAC [`x:int`; `y:int`; `z:int`; `&1:int`] THEN + FIRST_X_ASSUM(MP_TAC) THEN CONV_TAC INT_RING; + MP_TAC(MATCH_MP INT_REPRESENTS_112_TWO + (CONJ (ASSUME `n MOD 4 = 2`) + (ASSUME `~(n MOD 16 = 14)`))) THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` (X_CHOOSE_TAC `z:int`))) THEN + MAP_EVERY EXISTS_TAC [`x:int`; `y:int`; `z:int`; `&0:int`] THEN + FIRST_X_ASSUM(MP_TAC) THEN CONV_TAC INT_RING]);; + +let IQ_UNIVERSAL_CROSS112_NUM = prove + (`!k:num. + 1 <= k /\ k <= 14 /\ ~(k MOD 4 = 3) + ==> iq_universal 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&1) (&0) (&0) (&2) (&1) (&k))`, + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[iq_universal] THEN + X_GEN_TAC `m:int` THEN DISCH_TAC THEN + MP_TAC(EQ_MP (SYM(SPEC `m:int` INT_OF_NUM_EXISTS)) + (MATCH_MP (SPECL [`&0:int`; `m:int`] INT_LT_IMP_LE) + (ASSUME `&0 < m`))) THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` SUBST_ALL_TAC) THEN + MP_TAC(MATCH_MP (SPEC `k:num` INT_UNIVERSAL_CROSS112_NUM) + (ASSUME `1 <= k /\ k <= 14 /\ ~(k MOD 4 = 3)`)) THEN + DISCH_THEN(MP_TAC o SPEC `n:num`) THEN + ANTS_TAC THENL + [UNDISCH_TAC `&0 < &n` THEN REWRITE_TAC[INT_OF_NUM_LT]; + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` + (X_CHOOSE_THEN `z:int` (X_CHOOSE_TAC `w:int`)))) THEN + REWRITE_TAC[iq_represents] THEN + EXISTS_TAC + `\i:num. + if i = 0 then (x:int) else if i = 1 then y else + if i = 2 then z else w` THEN + REWRITE_TAC[IQEVAL_MAT4] THEN + CONV_TAC NUM_REDUCE_CONV THEN + FIRST_X_ASSUM(MP_TAC) THEN CONV_TAC INT_RING]);; + +let IQ_UNIVERSAL_OF_CROSS112_CHILD = prove + (`!n A k. + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&1) (&0) (&0) (&2) (&1) k) A /\ + &1 <= k /\ k <= &14 /\ ~(k rem &4 = &3) + ==> iq_universal n A`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(EQ_MP (SYM(SPEC `k:int` INT_OF_NUM_EXISTS)) + (MATCH_MP (INT_ARITH `&1 <= k ==> &0 <= k`) + (ASSUME `&1 <= k`))) THEN + DISCH_THEN(X_CHOOSE_THEN `c:num` SUBST_ALL_TAC) THEN + SUBGOAL_THEN + `1 <= c /\ c <= 14 /\ ~(c MOD 4 = 3)` + ASSUME_TAC THENL + [UNDISCH_TAC `&1 <= &c` THEN + UNDISCH_TAC `&c <= &14` THEN + UNDISCH_TAC `~(&c rem &4 = &3)` THEN + REWRITE_TAC[INT_OF_NUM_REM; INT_OF_NUM_LE; INT_OF_NUM_EQ] THEN + ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(ISPECL + [`n:num`; `4`; + `iqmat4 (&1) (&0) (&0) (&0) + (&1) (&0) (&0) (&2) (&1) (&c)`; + `A:num->num->int`] IQ_UNIVERSAL_OF_EMBEDS) THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + MATCH_MP_TAC(SPEC `c:num` IQ_UNIVERSAL_CROSS112_NUM) THEN + ASM_REWRITE_TAC[]]);; + +let IQ_UNIVERSAL_OF_EMBEDS_112 = prove + (`!n A. + iq_symmetric n A /\ iq_positive n A /\ + iq_embeds n 3 + (iqmat3 (&1) (&0) (&0) (&1) (&0) (&2)) A /\ + iq_represents n A (&14) + ==> iq_universal n A`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(SPECL [`n:num`; `A:num->num->int`] + IQ_EMBEDS_QUATERNARY_112) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(DISJ_CASES_THEN + (X_CHOOSE_THEN `k:int` STRIP_ASSUME_TAC)) THENL + [MATCH_MP_TAC(ISPECL [`n:num`; `A:num->num->int`; `k:int`] + IQ_UNIVERSAL_OF_DIAG112_CHILD) THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC(ISPECL [`n:num`; `A:num->num->int`; `k:int`] + IQ_UNIVERSAL_OF_CROSS112_CHILD) THEN ASM_REWRITE_TAC[]]);; + +let iqclear122 = new_definition + `iqclear122 a b c = + iqrows4 + (&1) (&0) (&0) (&0) + (&0) (&1) (&0) (&0) + (&0) (&0) (&1) (&0) + (--a) (--b) (--c) (&1)`;; + +let IQ_EMBEDS_CLEAR_122 = prove + (`!n A a b c rb rc t. + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) a + (&2) (&0) (&2 * b + rb) (&2) (&2 * c + rc) t) A + ==> iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&2) rc + (t - a pow 2 - + &2 * b pow 2 - &2 * b * rb - + &2 * c pow 2 - &2 * c * rc)) A`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(ISPECL + [`n:num`; `4`; + `iqgram 4 + (iqmat4 (&1) (&0) (&0) a + (&2) (&0) (&2 * b + rb) (&2) (&2 * c + rc) t) + (iqclear122 a b c)`; + `iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&2) rc + (t - a pow 2 - + &2 * b pow 2 - &2 * b * rb - + &2 * c pow 2 - &2 * c * rc)`; + `A:num->num->int`] IQ_EMBEDS_EQ) THEN + CONJ_TAC THENL + [MATCH_MP_TAC IQ_EMBEDS_CONGRUENCE THEN ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC THEN + (SUBGOAL_THEN `i = 0 \/ i = 1 \/ i = 2 \/ i = 3` MP_TAC THENL + [ASM_ARITH_TAC; ALL_TAC]) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + (SUBGOAL_THEN `j = 0 \/ j = 1 \/ j = 2 \/ j = 3` MP_TAC THENL + [ASM_ARITH_TAC; ALL_TAC]) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + ASM_REWRITE_TAC[iqgram; IQBILIN_MAT4; iqclear122; iqrows4; + iqmat4; iqsym] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC INT_RING]);; + +let IQ_122_PARAMETERS = prove + (`!a b c:int. + a pow 2 <= &7 /\ b pow 2 <= &14 /\ c pow 2 <= &14 + ==> ?qb rb qc rc k. + b = &2 * qb + rb /\ + c = &2 * qc + rc /\ + k = &7 - a pow 2 - + &2 * qb pow 2 - &2 * qb * rb - + &2 * qc pow 2 - &2 * qc * rc /\ + ((rb = &0 /\ rc = &0 /\ + (k < &0 \/ k = &0 \/ (&1 <= k /\ k <= &7))) \/ + (rb = &0 /\ rc = &1 /\ + (k <= &0 \/ (&1 <= k /\ k <= &7))) \/ + (rb = &1 /\ rc = &0 /\ + (k <= &0 \/ (&1 <= k /\ k <= &7))) \/ + (rb = &1 /\ rc = &1 /\ + (k <= &0 \/ k = &2 \/ k = &3 \/ k = &6 \/ k = &7)))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MAP_EVERY EXISTS_TAC + [`b div &2:int`; `b rem &2:int`; + `c div &2:int`; `c rem &2:int`; + `&7 - a pow 2 - + &2 * (b div &2) pow 2 - &2 * (b div &2) * (b rem &2) - + &2 * (c div &2) pow 2 - &2 * (c div &2) * (c rem &2):int`] THEN + CONJ_TAC THENL + [MP_TAC(SPEC `b:int` INT_DIV2_DECOMP) THEN MESON_TAC[]; + ALL_TAC] THEN + CONJ_TAC THENL + [MP_TAC(SPEC `c:int` INT_DIV2_DECOMP) THEN MESON_TAC[]; + ALL_TAC] THEN + CONJ_TAC THENL + [REFL_TAC; + ALL_TAC] THEN + MP_TAC(MATCH_MP INT_SQ_LE_7_CASES + (ASSUME `a pow 2 <= &7`)) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + MP_TAC(MATCH_MP INT_SQ_LE_14_CASES + (ASSUME `b pow 2 <= &14`)) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + MP_TAC(MATCH_MP INT_SQ_LE_14_CASES + (ASSUME `c pow 2 <= &14`)) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + CONV_TAC INT_REDUCE_CONV);; + +let IQ_EMBEDS_QUATERNARY_122 = prove + (`!n A. + iq_symmetric n A /\ iq_positive n A /\ + iq_embeds n 3 + (iqmat3 (&1) (&0) (&0) (&2) (&0) (&2)) A /\ + iq_represents n A (&7) + ==> (?k. + &1 <= k /\ k <= &7 /\ + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&0) (&2) (&0) k) A) \/ + (?k. + &1 <= k /\ k <= &7 /\ + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&0) (&2) (&1) k) A) \/ + (?k. + &1 <= k /\ k <= &7 /\ + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&2) (&0) k) A) \/ + (?k. + (k = &2 \/ k = &3 \/ k = &6 \/ k = &7) /\ + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&2) (&1) k) A)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(SPECL + [`n:num`; `A:num->num->int`; + `&1:int`; `&0:int`; `&0:int`; `&2:int`; `&0:int`; `&2:int`; + `&7:int`] IQ_ESCALATE_MAT3) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `a:int` + (X_CHOOSE_THEN `b:int` + (X_CHOOSE_THEN `c:int` STRIP_ASSUME_TAC))) THEN + MP_TAC(SPECL [`a:int`; `b:int`; `c:int`] IQ_122_PARAMETERS) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THEN ASM_INT_ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `qb:int` + (X_CHOOSE_THEN `rb:int` + (X_CHOOSE_THEN `qc:int` + (X_CHOOSE_THEN `rc:int` + (X_CHOOSE_THEN `k:int` + (CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC)))))))) THEN + SUBGOAL_THEN + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) a + (&2) (&0) (&2 * qb + rb) + (&2) (&2 * qc + rc) (&7)) A` + ASSUME_TAC THENL + [MATCH_ACCEPT_TAC + (REWRITE_RULE + [ASSUME `b = &2 * qb + rb`; ASSUME `c = &2 * qc + rc`] + (ASSUME + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) a + (&2) (&0) b (&2) c (&7)) A`)); + ALL_TAC] THEN + SUBGOAL_THEN + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&2) rc k) A` + ASSUME_TAC THENL + [ONCE_REWRITE_TAC[ASSUME + `k = &7 - a pow 2 - + &2 * qb pow 2 - &2 * qb * rb - + &2 * qc pow 2 - &2 * qc * rc`] THEN + MATCH_MP_TAC IQ_EMBEDS_CLEAR_122 THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `&0 <= k` ASSUME_TAC THENL + [MP_TAC(MATCH_MP + (ISPECL + [`n:num`; `4`; + `iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&2) rc k`; + `A:num->num->int`] IQ_EMBEDDED_NONNEG) + (CONJ (ASSUME `iq_positive n A`) (ASSUME + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&2) rc k) A`))) THEN + DISCH_THEN(MP_TAC o SPEC + `\i:num. if i = 3 then &1 else &0`) THEN + REWRITE_TAC[IQEVAL_MAT4] THEN + CONV_TAC NUM_REDUCE_CONV THEN INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `(rb = &1 /\ rc = &0) \/ (rb = &0 /\ rc = &1) + ==> &1 <= k` + ASSUME_TAC THENL + [STRIP_TAC THEN + MP_TAC(MATCH_MP + (ISPECL + [`n:num`; `4`; + `iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&2) rc k`; + `A:num->num->int`] IQ_EMBEDDED_NONNEG) + (CONJ (ASSUME `iq_positive n A`) (ASSUME + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&2) rc k) A`))) THENL + [DISCH_THEN(MP_TAC o SPEC + `\i:num. + if i = 1 then -- &1 else if i = 3 then &2 else &0`) THEN + ASM_REWRITE_TAC[IQEVAL_MAT4] THEN + CONV_TAC NUM_REDUCE_CONV THEN INT_ARITH_TAC; + DISCH_THEN(MP_TAC o SPEC + `\i:num. + if i = 2 then -- &1 else if i = 3 then &2 else &0`) THEN + ASM_REWRITE_TAC[IQEVAL_MAT4] THEN + CONV_TAC NUM_REDUCE_CONV THEN INT_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN `rb = &1 /\ rc = &1 ==> &1 <= k` ASSUME_TAC THENL + [STRIP_TAC THEN + MP_TAC(MATCH_MP + (ISPECL + [`n:num`; `4`; + `iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&2) rc k`; + `A:num->num->int`] IQ_EMBEDDED_NONNEG) + (CONJ (ASSUME `iq_positive n A`) (ASSUME + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&2) rc k) A`))) THEN + DISCH_THEN(MP_TAC o SPEC + `\i:num. + if i = 1 then -- &1 else if i = 2 then -- &1 else + if i = 3 then &2 else &0`) THEN + ASM_REWRITE_TAC[IQEVAL_MAT4] THEN + CONV_TAC NUM_REDUCE_CONV THEN INT_ARITH_TAC; + ALL_TAC] THEN + UNDISCH_TAC + `(rb = &0 /\ rc = &0 /\ + (k < &0 \/ k = &0 \/ (&1 <= k /\ k <= &7))) \/ + (rb = &0 /\ rc = &1 /\ + (k <= &0 \/ (&1 <= k /\ k <= &7))) \/ + (rb = &1 /\ rc = &0 /\ + (k <= &0 \/ (&1 <= k /\ k <= &7))) \/ + (rb = &1 /\ rc = &1 /\ + (k <= &0 \/ k = &2 \/ k = &3 \/ k = &6 \/ k = &7))` THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN STRIP_ASSUME_TAC) THENL + [CONTR_TAC + (MP (MP (INT_ARITH `&0 <= k ==> k < &0 ==> F`) + (ASSUME `&0 <= k`)) + (ASSUME `k < &0`)); + SUBGOAL_THEN + `a pow 2 + &2 * qb pow 2 + &2 * qc pow 2 = &7` + ASSUME_TAC THENL + [MATCH_ACCEPT_TAC + (MP (MP (MP (MP + (INT_RING + `k = &0 ==> rb = &0 ==> rc = &0 ==> + k = &7 - a pow 2 - + &2 * qb pow 2 - &2 * qb * rb - + &2 * qc pow 2 - &2 * qc * rc + ==> a pow 2 + &2 * qb pow 2 + &2 * qc pow 2 = &7`) + (ASSUME `k = &0`)) + (ASSUME `rb = &0`)) + (ASSUME `rc = &0`)) + (ASSUME + `k = &7 - a pow 2 - + &2 * qb pow 2 - &2 * qb * rb - + &2 * qc pow 2 - &2 * qc * rc`)); + CONTR_TAC + (MP (NOT_ELIM + (SPECL [`a:int`; `qb:int`; `qc:int`] INT_122_NOT_7)) + (ASSUME + `a pow 2 + &2 * qb pow 2 + &2 * qc pow 2 = &7`))]; + DISJ1_TAC THEN EXISTS_TAC `k:int` THEN + CONJ_TAC THENL + [MATCH_ACCEPT_TAC(ASSUME `&1 <= k`); + CONJ_TAC THENL + [MATCH_ACCEPT_TAC(ASSUME `k <= &7`); + MATCH_ACCEPT_TAC + (REWRITE_RULE[ASSUME `rb = &0`; ASSUME `rc = &0`] + (ASSUME + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&2) rc k) A`))]]; + CONTR_TAC + (MP (MP (INT_ARITH `&1 <= k ==> k <= &0 ==> F`) + (MP + (ASSUME + `(rb = &1 /\ rc = &0) \/ (rb = &0 /\ rc = &1) + ==> &1 <= k`) + (DISJ2 `rb = &1 /\ rc = &0` + (CONJ (ASSUME `rb = &0`) (ASSUME `rc = &1`))))) + (ASSUME `k <= &0`)); + DISJ2_TAC THEN DISJ1_TAC THEN EXISTS_TAC `k:int` THEN + CONJ_TAC THENL + [MATCH_ACCEPT_TAC(ASSUME `&1 <= k`); + CONJ_TAC THENL + [MATCH_ACCEPT_TAC(ASSUME `k <= &7`); + MATCH_ACCEPT_TAC + (REWRITE_RULE[ASSUME `rb = &0`; ASSUME `rc = &1`] + (ASSUME + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&2) rc k) A`))]]; + CONTR_TAC + (MP (MP (INT_ARITH `&1 <= k ==> k <= &0 ==> F`) + (MP + (ASSUME + `(rb = &1 /\ rc = &0) \/ (rb = &0 /\ rc = &1) + ==> &1 <= k`) + (DISJ1 + (CONJ (ASSUME `rb = &1`) (ASSUME `rc = &0`)) + `rb = &0 /\ rc = &1`))) + (ASSUME `k <= &0`)); + DISJ2_TAC THEN DISJ2_TAC THEN DISJ1_TAC THEN + EXISTS_TAC `k:int` THEN + CONJ_TAC THENL + [MATCH_ACCEPT_TAC(ASSUME `&1 <= k`); + CONJ_TAC THENL + [MATCH_ACCEPT_TAC(ASSUME `k <= &7`); + MATCH_ACCEPT_TAC + (REWRITE_RULE[ASSUME `rb = &1`; ASSUME `rc = &0`] + (ASSUME + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&2) rc k) A`))]]; + CONTR_TAC + (MP (MP (INT_ARITH `&1 <= k ==> k <= &0 ==> F`) + (MP (ASSUME `rb = &1 /\ rc = &1 ==> &1 <= k`) + (CONJ (ASSUME `rb = &1`) (ASSUME `rc = &1`)))) + (ASSUME `k <= &0`)); + DISJ2_TAC THEN DISJ2_TAC THEN DISJ2_TAC THEN + EXISTS_TAC `k:int` THEN CONJ_TAC THENL + [DISJ1_TAC THEN MATCH_ACCEPT_TAC(ASSUME `k = &2`); + MATCH_ACCEPT_TAC + (REWRITE_RULE[ASSUME `rb = &1`; ASSUME `rc = &1`] + (ASSUME + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&2) rc k) A`))]; + DISJ2_TAC THEN DISJ2_TAC THEN DISJ2_TAC THEN + EXISTS_TAC `k:int` THEN CONJ_TAC THENL + [DISJ2_TAC THEN DISJ1_TAC THEN MATCH_ACCEPT_TAC(ASSUME `k = &3`); + MATCH_ACCEPT_TAC + (REWRITE_RULE[ASSUME `rb = &1`; ASSUME `rc = &1`] + (ASSUME + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&2) rc k) A`))]; + DISJ2_TAC THEN DISJ2_TAC THEN DISJ2_TAC THEN + EXISTS_TAC `k:int` THEN CONJ_TAC THENL + [DISJ2_TAC THEN DISJ2_TAC THEN DISJ1_TAC THEN + MATCH_ACCEPT_TAC(ASSUME `k = &6`); + MATCH_ACCEPT_TAC + (REWRITE_RULE[ASSUME `rb = &1`; ASSUME `rc = &1`] + (ASSUME + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&2) rc k) A`))]; + DISJ2_TAC THEN DISJ2_TAC THEN DISJ2_TAC THEN + EXISTS_TAC `k:int` THEN CONJ_TAC THENL + [DISJ2_TAC THEN DISJ2_TAC THEN DISJ2_TAC THEN + MATCH_ACCEPT_TAC(ASSUME `k = &7`); + MATCH_ACCEPT_TAC + (REWRITE_RULE[ASSUME `rb = &1`; ASSUME `rc = &1`] + (ASSUME + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&2) rc k) A`))]]);; + +(* ------------------------------------------------------------------------- *) +(* Diagonal children. *) +(* ------------------------------------------------------------------------- *) + +let IQ_UNIVERSAL_1221_NUM = prove + (`!n:num. + 0 < n + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + + &2 * z pow 2 + w pow 2 = &n`, + GEN_TAC THEN DISCH_TAC THEN + MP_TAC(MATCH_MP IQ_UNIVERSAL_1122_NUM (ASSUME `0 < n`)) THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` + (X_CHOOSE_THEN `z:int` (X_CHOOSE_TAC `w:int`)))) THEN + MAP_EVERY EXISTS_TAC [`x:int`; `z:int`; `w:int`; `y:int`] THEN + FIRST_X_ASSUM(MP_TAC) THEN CONV_TAC INT_RING);; + +let IQ_UNIVERSAL_1221 = prove + (`iq_universal 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&0) (&2) (&0) (&1))`, + REWRITE_TAC[iq_universal] THEN + X_GEN_TAC `m:int` THEN DISCH_TAC THEN + MP_TAC(EQ_MP (SYM(SPEC `m:int` INT_OF_NUM_EXISTS)) + (MATCH_MP (SPECL [`&0:int`; `m:int`] INT_LT_IMP_LE) + (ASSUME `&0 < m`))) THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` SUBST_ALL_TAC) THEN + MP_TAC(MATCH_MP IQ_UNIVERSAL_1221_NUM + (REWRITE_RULE[INT_OF_NUM_LT] (ASSUME `&0 < &n`))) THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` + (X_CHOOSE_THEN `z:int` (X_CHOOSE_TAC `w:int`)))) THEN + REWRITE_TAC[iq_represents] THEN + EXISTS_TAC + `\i:num. + if i = 0 then (x:int) else if i = 1 then y else + if i = 2 then z else w` THEN + REWRITE_TAC[IQEVAL_MAT4] THEN + CONV_TAC NUM_REDUCE_CONV THEN + FIRST_X_ASSUM(MP_TAC) THEN CONV_TAC INT_RING);; + +let IQ_UNIVERSAL_MAT4_DIAG = prove + (`!a b c d. + iq_universal 4 (iqdiag4 a b c d) + ==> iq_universal 4 + (iqmat4 a (&0) (&0) (&0) + b (&0) (&0) c (&0) d)`, + REPEAT GEN_TAC THEN REWRITE_TAC[iq_universal] THEN + DISCH_TAC THEN X_GEN_TAC `m:int` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `m:int`) THEN + ASM_REWRITE_TAC[iq_represents] THEN + DISCH_THEN(X_CHOOSE_THEN `x:num->int` ASSUME_TAC) THEN + EXISTS_TAC `x:num->int` THEN + ONCE_REWRITE_TAC[GSYM(ASSUME + `iqeval 4 (iqdiag4 a b c d) x = m`)] THEN + REWRITE_TAC[IQEVAL_MAT4; IQEVAL_DIAG4] THEN + CONV_TAC INT_RING);; + +let IQ_UNIVERSAL_MAT1222 = + MATCH_MP + (SPECL [`&1:int`; `&2:int`; `&2:int`; `&2:int`] + IQ_UNIVERSAL_MAT4_DIAG) + IQ_UNIVERSAL_1222;; + +let IQ_UNIVERSAL_MAT1223 = + MATCH_MP + (SPECL [`&1:int`; `&2:int`; `&2:int`; `&3:int`] + IQ_UNIVERSAL_MAT4_DIAG) + IQ_UNIVERSAL_1223;; + +let IQ_UNIVERSAL_MAT1224 = + MATCH_MP + (SPECL [`&1:int`; `&2:int`; `&2:int`; `&4:int`] + IQ_UNIVERSAL_MAT4_DIAG) + IQ_UNIVERSAL_1224;; + +let IQ_UNIVERSAL_MAT1225 = + MATCH_MP + (SPECL [`&1:int`; `&2:int`; `&2:int`; `&5:int`] + IQ_UNIVERSAL_MAT4_DIAG) + IQ_UNIVERSAL_1225;; + +let IQ_UNIVERSAL_MAT1226 = + MATCH_MP + (SPECL [`&1:int`; `&2:int`; `&2:int`; `&6:int`] + IQ_UNIVERSAL_MAT4_DIAG) + IQ_UNIVERSAL_1226;; + +let IQ_UNIVERSAL_MAT1227 = + MATCH_MP + (SPECL [`&1:int`; `&2:int`; `&2:int`; `&7:int`] + IQ_UNIVERSAL_MAT4_DIAG) + IQ_UNIVERSAL_1227;; + +let IQ_UNIVERSAL_OF_DIAG122_CHILD = prove + (`!n A k. + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&0) (&2) (&0) k) A /\ + &1 <= k /\ k <= &7 + ==> iq_universal n A`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC(ISPECL + [`n:num`; `4`; + `iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&0) (&2) (&0) k`; + `A:num->num->int`] IQ_UNIVERSAL_OF_EMBEDS) THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `k = &1 \/ k = &2 \/ k = &3 \/ k = &4 \/ + k = &5 \/ k = &6 \/ k = &7` + ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; + ALL_TAC] THEN + UNDISCH_TAC + `k = &1 \/ k = &2 \/ k = &3 \/ k = &4 \/ + k = &5 \/ k = &6 \/ k = &7` THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + ASM_REWRITE_TAC + [IQ_UNIVERSAL_1221; IQ_UNIVERSAL_MAT1222; + IQ_UNIVERSAL_MAT1223; IQ_UNIVERSAL_MAT1224; + IQ_UNIVERSAL_MAT1225; IQ_UNIVERSAL_MAT1226; + IQ_UNIVERSAL_MAT1227]);; + +(* ------------------------------------------------------------------------- *) +(* Single-cross children. *) +(* ------------------------------------------------------------------------- *) + +let INT_REPRESENTS_124_ODD = prove + (`!n:num. + n MOD 2 = 1 + ==> ?x y z:int. + x pow 2 + &2 * y pow 2 + &4 * z pow 2 = &n`, + GEN_TAC THEN DISCH_TAC THEN + MP_TAC(MATCH_MP (SPECL [`n:num`; `2`; `1`] NUM_DECOMPOSE_MOD) + (CONJ (ARITH_RULE `~(2 = 0)`) (ASSUME `n MOD 2 = 1`))) THEN + DISCH_THEN(X_CHOOSE_TAC `q:num`) THEN + MP_TAC(MATCH_MP INT_REPRESENTS_112_ODD + (ASSUME `n MOD 2 = 1`)) THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` (X_CHOOSE_THEN `z:int` ASSUME_TAC))) THEN + MP_TAC(SPEC `x:int` INT_PARITY_WITNESS) THEN + DISCH_THEN(DISJ_CASES_THEN (X_CHOOSE_TAC `a:int`)) THENL + [MAP_EVERY EXISTS_TAC [`y:int`; `z:int`; `a:int`] THEN + MATCH_ACCEPT_TAC + (MATCH_MP + (MATCH_MP + (INT_RING + `x = &2 * a + ==> x pow 2 + y pow 2 + &2 * z pow 2 = nn + ==> y pow 2 + &2 * z pow 2 + &4 * a pow 2 = nn`) + (ASSUME `x = &2 * a`)) + (ASSUME + `x pow 2 + y pow 2 + &2 * z pow 2 = &n`)); + MP_TAC(SPEC `y:int` INT_PARITY_WITNESS) THEN + DISCH_THEN(DISJ_CASES_THEN (X_CHOOSE_TAC `b:int`)) THENL + [MAP_EVERY EXISTS_TAC [`x:int`; `z:int`; `b:int`] THEN + MATCH_ACCEPT_TAC + (MATCH_MP + (MATCH_MP + (INT_RING + `y = &2 * b + ==> x pow 2 + y pow 2 + &2 * z pow 2 = nn + ==> x pow 2 + &2 * z pow 2 + &4 * b pow 2 = nn`) + (ASSUME `y = &2 * b`)) + (ASSUME + `x pow 2 + y pow 2 + &2 * z pow 2 = &n`)); + SUBGOAL_THEN `&n = &2 * &q + &1` ASSUME_TAC THENL + [ASM_REWRITE_TAC[GSYM INT_OF_NUM_ADD; GSYM INT_OF_NUM_MUL]; + ALL_TAC] THEN + SUBGOAL_THEN + `&2 * + (&2 * a pow 2 + &2 * a + + &2 * b pow 2 + &2 * b + &1 + z pow 2 - &q) = &1` + ASSUME_TAC THENL + [MATCH_ACCEPT_TAC + (MATCH_MP + (MATCH_MP + (MATCH_MP + (MATCH_MP + (INT_RING + `x = &2 * a + &1 + ==> y = &2 * b + &1 + ==> x pow 2 + y pow 2 + &2 * z pow 2 = nn + ==> nn = &2 * qq + &1 + ==> &2 * + (&2 * a pow 2 + &2 * a + &2 * b pow 2 + + &2 * b + &1 + z pow 2 - qq) = + &1`) + (ASSUME `x = &2 * a + &1`)) + (ASSUME `y = &2 * b + &1`)) + (ASSUME + `x pow 2 + y pow 2 + &2 * z pow 2 = &n`)) + (ASSUME `&n = &2 * &q + &1`)); + MP_TAC(SPEC + `&2 * a pow 2 + &2 * a + + &2 * b pow 2 + &2 * b + &1 + z pow 2 - &q:int` + INT_TWO_MUL_NE_ONE) THEN ASM_REWRITE_TAC[]]]]);; + +let NUM_CROSSA122_TARGET_ODD = prove + (`!n k:num. k <= n ==> (2 * (n - k) + 1) MOD 2 = 1`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[MOD_MULT_ADD] THEN CONV_TAC NUM_REDUCE_CONV);; + +let INT_UNIVERSAL_CROSSA122_NUM = prove + (`!k:num. + 1 <= k /\ k <= 7 + ==> !n:num. + 0 < n + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &2 * z pow 2 + + &2 * y * w + &k * w pow 2 = &n`, + GEN_TAC THEN STRIP_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + ASM_CASES_TAC `(k:num) <= n` THENL + [MP_TAC(MATCH_MP INT_REPRESENTS_124_ODD + (MATCH_MP (SPECL [`n:num`; `k:num`] NUM_CROSSA122_TARGET_ODD) + (ASSUME `(k:num) <= n`))) THEN + DISCH_THEN(X_CHOOSE_THEN `X:int` + (X_CHOOSE_THEN `Y:int` (X_CHOOSE_THEN `Z:int` ASSUME_TAC))) THEN + SUBGOAL_THEN + `X pow 2 + &2 * Y pow 2 + &4 * Z pow 2 = + &2 * (&n - &k) + &1` + ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC) THEN + ASM_SIMP_TAC[INT_OF_NUM_ADD; INT_OF_NUM_MUL; INT_OF_NUM_SUB]; + ALL_TAC] THEN + MP_TAC(SPEC `X:int` INT_PARITY_WITNESS) THEN + DISCH_THEN(DISJ_CASES_THEN (X_CHOOSE_TAC `y:int`)) THENL + [SUBGOAL_THEN + `&2 * (&2 * y pow 2 + Y pow 2 + &2 * Z pow 2 - + (&n - &k)) = &1` + ASSUME_TAC THENL + [MATCH_ACCEPT_TAC + (MATCH_MP + (MATCH_MP + (INT_RING + `X = &2 * y + ==> X pow 2 + &2 * Y pow 2 + &4 * Z pow 2 = + &2 * (nn - kk) + &1 + ==> &2 * + (&2 * y pow 2 + Y pow 2 + &2 * Z pow 2 - + (nn - kk)) = &1`) + (ASSUME `X = &2 * y`)) + (ASSUME + `X pow 2 + &2 * Y pow 2 + &4 * Z pow 2 = + &2 * (&n - &k) + &1`)); + MP_TAC(SPEC + `&2 * y pow 2 + Y pow 2 + &2 * Z pow 2 - + (&n - &k):int` INT_TWO_MUL_NE_ONE) THEN + ASM_REWRITE_TAC[]]; + MAP_EVERY EXISTS_TAC [`Y:int`; `y:int`; `Z:int`; `&1:int`] THEN + MATCH_ACCEPT_TAC + (MATCH_MP + (MATCH_MP + (INT_RING + `X = &2 * y + &1 + ==> X pow 2 + &2 * Y pow 2 + &4 * Z pow 2 = + &2 * (nn - kk) + &1 + ==> Y pow 2 + &2 * y pow 2 + &2 * Z pow 2 + + &2 * y * &1 + kk * &1 pow 2 = nn`) + (ASSUME `X = &2 * y + &1`)) + (ASSUME + `X pow 2 + &2 * Y pow 2 + &4 * Z pow 2 = + &2 * (&n - &k) + &1`))]; + SUBGOAL_THEN + `n = 1 \/ n = 2 \/ n = 3 \/ n = 4 \/ n = 5 \/ n = 6` + ASSUME_TAC THENL + [ASM_ARITH_TAC; + ALL_TAC] THEN + UNDISCH_TAC + `n = 1 \/ n = 2 \/ n = 3 \/ n = 4 \/ n = 5 \/ n = 6` THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THENL + [MAP_EVERY EXISTS_TAC + [`&1:int`; `&0:int`; `&0:int`; `&0:int`] THEN + CONV_TAC INT_REDUCE_CONV; + MAP_EVERY EXISTS_TAC + [`&0:int`; `&1:int`; `&0:int`; `&0:int`] THEN + CONV_TAC INT_REDUCE_CONV; + MAP_EVERY EXISTS_TAC + [`&1:int`; `&1:int`; `&0:int`; `&0:int`] THEN + CONV_TAC INT_REDUCE_CONV; + MAP_EVERY EXISTS_TAC + [`&2:int`; `&0:int`; `&0:int`; `&0:int`] THEN + CONV_TAC INT_REDUCE_CONV; + MAP_EVERY EXISTS_TAC + [`&1:int`; `&1:int`; `&1:int`; `&0:int`] THEN + CONV_TAC INT_REDUCE_CONV; + MAP_EVERY EXISTS_TAC + [`&2:int`; `&1:int`; `&0:int`; `&0:int`] THEN + CONV_TAC INT_REDUCE_CONV]]);; + +let INT_UNIVERSAL_CROSSA122_Z_NUM = prove + (`!k n:num. + 1 <= k /\ k <= 7 /\ 0 < n + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &2 * z pow 2 + + &2 * z * w + &k * w pow 2 = &n`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(MATCH_MP (SPEC `k:num` INT_UNIVERSAL_CROSSA122_NUM) + (CONJ (ASSUME `1 <= k`) (ASSUME `k <= 7`))) THEN + DISCH_THEN(MP_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` + (X_CHOOSE_THEN `z:int` (X_CHOOSE_TAC `w:int`)))) THEN + MAP_EVERY EXISTS_TAC [`x:int`; `z:int`; `y:int`; `w:int`] THEN + FIRST_X_ASSUM(MP_TAC) THEN CONV_TAC INT_RING);; + +let IQ_UNIVERSAL_CROSSA122_Y_NUM = prove + (`!k:num. + 1 <= k /\ k <= 7 + ==> iq_universal 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&2) (&0) (&k))`, + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[iq_universal] THEN + X_GEN_TAC `m:int` THEN DISCH_TAC THEN + MP_TAC(EQ_MP (SYM(SPEC `m:int` INT_OF_NUM_EXISTS)) + (MATCH_MP (SPECL [`&0:int`; `m:int`] INT_LT_IMP_LE) + (ASSUME `&0 < m`))) THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` SUBST_ALL_TAC) THEN + MP_TAC(MATCH_MP (SPEC `k:num` INT_UNIVERSAL_CROSSA122_NUM) + (ASSUME `1 <= k /\ k <= 7`)) THEN + DISCH_THEN(MP_TAC o SPEC `n:num`) THEN + ANTS_TAC THENL + [UNDISCH_TAC `&0 < &n` THEN REWRITE_TAC[INT_OF_NUM_LT]; + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` + (X_CHOOSE_THEN `z:int` (X_CHOOSE_TAC `w:int`)))) THEN + REWRITE_TAC[iq_represents] THEN + EXISTS_TAC + `\i:num. + if i = 0 then (x:int) else if i = 1 then y else + if i = 2 then z else w` THEN + REWRITE_TAC[IQEVAL_MAT4] THEN + CONV_TAC NUM_REDUCE_CONV THEN + FIRST_X_ASSUM(MP_TAC) THEN CONV_TAC INT_RING]);; + +let IQ_UNIVERSAL_CROSSA122_Z_NUM = prove + (`!k:num. + 1 <= k /\ k <= 7 + ==> iq_universal 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&0) (&2) (&1) (&k))`, + GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[iq_universal] THEN + X_GEN_TAC `m:int` THEN DISCH_TAC THEN + MP_TAC(EQ_MP (SYM(SPEC `m:int` INT_OF_NUM_EXISTS)) + (MATCH_MP (SPECL [`&0:int`; `m:int`] INT_LT_IMP_LE) + (ASSUME `&0 < m`))) THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` SUBST_ALL_TAC) THEN + MP_TAC(SPECL [`k:num`; `n:num`] INT_UNIVERSAL_CROSSA122_Z_NUM) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + UNDISCH_TAC `&0 < &n` THEN REWRITE_TAC[INT_OF_NUM_LT]]; + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` + (X_CHOOSE_THEN `z:int` (X_CHOOSE_TAC `w:int`)))) THEN + REWRITE_TAC[iq_represents] THEN + EXISTS_TAC + `\i:num. + if i = 0 then (x:int) else if i = 1 then y else + if i = 2 then z else w` THEN + REWRITE_TAC[IQEVAL_MAT4] THEN + CONV_TAC NUM_REDUCE_CONV THEN + FIRST_X_ASSUM(MP_TAC) THEN CONV_TAC INT_RING]);; + +let IQ_UNIVERSAL_OF_CROSSA122_Y_CHILD = prove + (`!n A k. + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&2) (&0) k) A /\ + &1 <= k /\ k <= &7 + ==> iq_universal n A`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(EQ_MP (SYM(SPEC `k:int` INT_OF_NUM_EXISTS)) + (MATCH_MP (INT_ARITH `&1 <= k ==> &0 <= k`) + (ASSUME `&1 <= k`))) THEN + DISCH_THEN(X_CHOOSE_THEN `c:num` SUBST_ALL_TAC) THEN + MATCH_MP_TAC(ISPECL + [`n:num`; `4`; + `iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&2) (&0) (&c)`; + `A:num->num->int`] IQ_UNIVERSAL_OF_EMBEDS) THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + MATCH_MP_TAC(SPEC `c:num` IQ_UNIVERSAL_CROSSA122_Y_NUM) THEN + UNDISCH_TAC `&1 <= &c` THEN + UNDISCH_TAC `&c <= &7` THEN + REWRITE_TAC[INT_OF_NUM_LE] THEN ARITH_TAC]);; + +let IQ_UNIVERSAL_OF_CROSSA122_Z_CHILD = prove + (`!n A k. + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&0) (&2) (&1) k) A /\ + &1 <= k /\ k <= &7 + ==> iq_universal n A`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(EQ_MP (SYM(SPEC `k:int` INT_OF_NUM_EXISTS)) + (MATCH_MP (INT_ARITH `&1 <= k ==> &0 <= k`) + (ASSUME `&1 <= k`))) THEN + DISCH_THEN(X_CHOOSE_THEN `c:num` SUBST_ALL_TAC) THEN + MATCH_MP_TAC(ISPECL + [`n:num`; `4`; + `iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&0) (&2) (&1) (&c)`; + `A:num->num->int`] IQ_UNIVERSAL_OF_EMBEDS) THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + MATCH_MP_TAC(SPEC `c:num` IQ_UNIVERSAL_CROSSA122_Z_NUM) THEN + UNDISCH_TAC `&1 <= &c` THEN + UNDISCH_TAC `&c <= &7` THEN + REWRITE_TAC[INT_OF_NUM_LE] THEN ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Double-cross children. *) +(* ------------------------------------------------------------------------- *) + +let INT_REPRESENTS_122_AVOIDS = prove + (`!m:num. + ~(m MOD 4 = 0) /\ ~(m MOD 8 = 7) + ==> ?x y z:int. + x pow 2 + &2 * y pow 2 + &2 * z pow 2 = &m`, + GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC REPR_122_OF_THREE_SQUARES THEN + MATCH_MP_TAC INT_THREE_SQUARES_OF_MOD THEN + ASM_REWRITE_TAC[]);; + +let NUM_MOD4_1_AVOIDS = prove + (`!m:num. + m MOD 4 = 1 + ==> ~(m MOD 4 = 0) /\ ~(m MOD 8 = 7)`, + GEN_TAC THEN DISCH_TAC THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[] THEN ARITH_TAC; + DISCH_TAC THEN + SUBGOAL_THEN `(m MOD 8) MOD 4 = m MOD 4` MP_TAC THENL + [REWRITE_TAC[ARITH_RULE `8 = 4 * 2`; MOD_MOD]; + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV]]);; + +let INT_CROSSB122_ASSEMBLE = prove + (`!k n:num. + !s t x a b:int. + s = &2 * a + &1 /\ t = &2 * b /\ + s pow 2 + t pow 2 + x pow 2 = &n - &k + &1 + ==> ?X Y Z W:int. + X pow 2 + &2 * Y pow 2 + &2 * Z pow 2 + + &2 * Y * W + &2 * Z * W + &k * W pow 2 = &n`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MAP_EVERY EXISTS_TAC + [`x:int`; `a + b:int`; `a - b:int`; `&1:int`] THEN + MATCH_ACCEPT_TAC + (MATCH_MP + (MATCH_MP + (MATCH_MP + (INT_RING + `s = &2 * a + &1 + ==> t = &2 * b + ==> s pow 2 + t pow 2 + x pow 2 = nn - kk + &1 + ==> x pow 2 + &2 * (a + b) pow 2 + + &2 * (a - b) pow 2 + &2 * (a + b) * &1 + + &2 * (a - b) * &1 + kk * &1 pow 2 = nn`) + (ASSUME `s = &2 * a + &1`)) + (ASSUME `t = &2 * b`)) + (ASSUME + `s pow 2 + t pow 2 + x pow 2 = &n - &k + &1`)));; + +let INT_REPRESENTS_CROSSB122_W1 = prove + (`!k n:num. + k <= n /\ ((n + 1) - k) MOD 4 = 1 + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &2 * z pow 2 + + &2 * y * w + &2 * z * w + &k * w pow 2 = &n`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(MATCH_MP + (SPECL [`(n + 1) - k`; `4`; `1`] NUM_DECOMPOSE_MOD) + (CONJ (ARITH_RULE `~(4 = 0)`) + (ASSUME `((n + 1) - k) MOD 4 = 1`))) THEN + DISCH_THEN(X_CHOOSE_TAC `d:num`) THEN + MP_TAC(MATCH_MP INT_THREE_SQUARES_OF_MOD + (MATCH_MP (SPEC `(n + 1) - k` NUM_MOD4_1_AVOIDS) + (ASSUME `((n + 1) - k) MOD 4 = 1`))) THEN + DISCH_THEN(X_CHOOSE_THEN `p:int` + (X_CHOOSE_THEN `q:int` (X_CHOOSE_THEN `r:int` ASSUME_TAC))) THEN + SUBGOAL_THEN `(n + 1) - k = (n - k) + 1` ASSUME_TAC THENL + [MATCH_MP_TAC(ARITH_RULE + `(k:num) <= n ==> (n + 1) - k = (n - k) + 1`) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `p pow 2 + q pow 2 + r pow 2 = &n - &k + &1` + ASSUME_TAC THENL + [ONCE_REWRITE_TAC[ASSUME + `p pow 2 + q pow 2 + r pow 2 = &((n + 1) - k)`] THEN + ONCE_REWRITE_TAC[ASSUME `(n + 1) - k = (n - k) + 1`] THEN + REWRITE_TAC[GSYM INT_OF_NUM_ADD] THEN + ONCE_REWRITE_TAC[GSYM(MATCH_MP (SPECL [`k:num`; `n:num`] + INT_OF_NUM_SUB) (ASSUME `(k:num) <= n`))] THEN + REFL_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `p pow 2 + q pow 2 + r pow 2 = &4 * &d + &1` + ASSUME_TAC THENL + [ONCE_REWRITE_TAC[ASSUME + `p pow 2 + q pow 2 + r pow 2 = &((n + 1) - k)`] THEN + ONCE_REWRITE_TAC[ASSUME `(n + 1) - k = 4 * d + 1`] THEN + REWRITE_TAC[GSYM INT_OF_NUM_ADD; GSYM INT_OF_NUM_MUL]; + ALL_TAC] THEN + MP_TAC(SPEC `p:int` INT_PARITY_WITNESS) THEN + DISCH_THEN(DISJ_CASES_THEN (X_CHOOSE_TAC `a:int`)) THENL + [MP_TAC(SPEC `q:int` INT_PARITY_WITNESS) THEN + DISCH_THEN(DISJ_CASES_THEN (X_CHOOSE_TAC `b:int`)) THENL + [MP_TAC(SPEC `r:int` INT_PARITY_WITNESS) THEN + DISCH_THEN(DISJ_CASES_THEN (X_CHOOSE_TAC `c:int`)) THENL + [SUBGOAL_THEN + `&4 * (a pow 2 + b pow 2 + c pow 2) = &4 * &d + &1` + ASSUME_TAC THENL + [MATCH_ACCEPT_TAC + (MATCH_MP + (MATCH_MP + (MATCH_MP + (MATCH_MP + (INT_RING + `p = &2 * a + ==> q = &2 * b + ==> r = &2 * c + ==> p pow 2 + q pow 2 + r pow 2 = + &4 * dd + &1 + ==> &4 * (a pow 2 + b pow 2 + c pow 2) = + &4 * dd + &1`) + (ASSUME `p = &2 * a`)) + (ASSUME `q = &2 * b`)) + (ASSUME `r = &2 * c`)) + (ASSUME + `p pow 2 + q pow 2 + r pow 2 = &4 * &d + &1`)); + SUBGOAL_THEN + `&2 * + (&2 * (a pow 2 + b pow 2 + c pow 2) - &2 * &d) = &1` + ASSUME_TAC THENL + [MATCH_ACCEPT_TAC + (MATCH_MP + (INT_RING + `&4 * aa = &4 * dd + &1 + ==> &2 * (&2 * aa - &2 * dd) = &1`) + (ASSUME + `&4 * (a pow 2 + b pow 2 + c pow 2) = + &4 * &d + &1`)); + MP_TAC(SPEC + `&2 * (a pow 2 + b pow 2 + c pow 2) - &2 * &d:int` + INT_TWO_MUL_NE_ONE) THEN ASM_REWRITE_TAC[]]]; + MATCH_ACCEPT_TAC + (MATCH_MP + (SPECL + [`k:num`; `n:num`; `r:int`; `p:int`; `q:int`; + `c:int`; `a:int`] INT_CROSSB122_ASSEMBLE) + (CONJ (ASSUME `r = &2 * c + &1`) + (CONJ (ASSUME `p = &2 * a`) + (MATCH_MP + (INT_RING + `p pow 2 + q pow 2 + r pow 2 = nn + ==> r pow 2 + p pow 2 + q pow 2 = nn`) + (ASSUME + `p pow 2 + q pow 2 + r pow 2 = + &n - &k + &1`)))))]; + MATCH_ACCEPT_TAC + (MATCH_MP + (SPECL + [`k:num`; `n:num`; `q:int`; `p:int`; `r:int`; + `b:int`; `a:int`] INT_CROSSB122_ASSEMBLE) + (CONJ (ASSUME `q = &2 * b + &1`) + (CONJ (ASSUME `p = &2 * a`) + (MATCH_MP + (INT_RING + `p pow 2 + q pow 2 + r pow 2 = nn + ==> q pow 2 + p pow 2 + r pow 2 = nn`) + (ASSUME + `p pow 2 + q pow 2 + r pow 2 = + &n - &k + &1`)))))]; + MP_TAC(SPEC `q:int` INT_PARITY_WITNESS) THEN + DISCH_THEN(DISJ_CASES_THEN (X_CHOOSE_TAC `b:int`)) THENL + [MATCH_ACCEPT_TAC + (MATCH_MP + (SPECL + [`k:num`; `n:num`; `p:int`; `q:int`; `r:int`; + `a:int`; `b:int`] INT_CROSSB122_ASSEMBLE) + (CONJ (ASSUME `p = &2 * a + &1`) + (CONJ (ASSUME `q = &2 * b`) + (ASSUME + `p pow 2 + q pow 2 + r pow 2 = + &n - &k + &1`)))); + MP_TAC(SPEC `r:int` INT_PARITY_WITNESS) THEN + DISCH_THEN(DISJ_CASES_THEN (X_CHOOSE_TAC `c:int`)) THENL + [SUBGOAL_THEN + `&4 * (a pow 2 + a + b pow 2 + b + c pow 2) + &2 = + &4 * &d + &1` + ASSUME_TAC THENL + [MATCH_ACCEPT_TAC + (MATCH_MP + (MATCH_MP + (MATCH_MP + (MATCH_MP + (INT_RING + `p = &2 * a + &1 + ==> q = &2 * b + &1 + ==> r = &2 * c + ==> p pow 2 + q pow 2 + r pow 2 = + &4 * dd + &1 + ==> &4 * + (a pow 2 + a + b pow 2 + b + c pow 2) + &2 = + &4 * dd + &1`) + (ASSUME `p = &2 * a + &1`)) + (ASSUME `q = &2 * b + &1`)) + (ASSUME `r = &2 * c`)) + (ASSUME + `p pow 2 + q pow 2 + r pow 2 = &4 * &d + &1`)); + SUBGOAL_THEN + `&2 * + (&2 * &d - + &2 * (a pow 2 + a + b pow 2 + b + c pow 2)) = &1` + ASSUME_TAC THENL + [MATCH_ACCEPT_TAC + (MATCH_MP + (INT_RING + `&4 * aa + &2 = &4 * dd + &1 + ==> &2 * (&2 * dd - &2 * aa) = &1`) + (ASSUME + `&4 * (a pow 2 + a + b pow 2 + b + c pow 2) + + &2 = &4 * &d + &1`)); + MP_TAC(SPEC + `&2 * &d - + &2 * (a pow 2 + a + b pow 2 + b + c pow 2):int` + INT_TWO_MUL_NE_ONE) THEN ASM_REWRITE_TAC[]]]; + SUBGOAL_THEN + `&4 * + (a pow 2 + a + b pow 2 + b + c pow 2 + c) + &3 = + &4 * &d + &1` + ASSUME_TAC THENL + [MATCH_ACCEPT_TAC + (MATCH_MP + (MATCH_MP + (MATCH_MP + (MATCH_MP + (INT_RING + `p = &2 * a + &1 + ==> q = &2 * b + &1 + ==> r = &2 * c + &1 + ==> p pow 2 + q pow 2 + r pow 2 = + &4 * dd + &1 + ==> &4 * + (a pow 2 + a + b pow 2 + b + + c pow 2 + c) + &3 = &4 * dd + &1`) + (ASSUME `p = &2 * a + &1`)) + (ASSUME `q = &2 * b + &1`)) + (ASSUME `r = &2 * c + &1`)) + (ASSUME + `p pow 2 + q pow 2 + r pow 2 = &4 * &d + &1`)); + SUBGOAL_THEN + `&2 * + (&d - + (a pow 2 + a + b pow 2 + b + c pow 2 + c)) = &1` + ASSUME_TAC THENL + [MATCH_ACCEPT_TAC + (MATCH_MP + (INT_RING + `&4 * aa + &3 = &4 * dd + &1 + ==> &2 * (dd - aa) = &1`) + (ASSUME + `&4 * + (a pow 2 + a + b pow 2 + b + c pow 2 + c) + + &3 = &4 * &d + &1`)); + MP_TAC(SPEC + `&d - + (a pow 2 + a + b pow 2 + b + c pow 2 + c):int` + INT_TWO_MUL_NE_ONE) THEN ASM_REWRITE_TAC[]]]]]]);; + +let INT_CROSSB122_SHIFT_NUM = prove + (`!k n:num. + 1 <= k /\ 4 * (k - 1) <= n /\ + (?x y z:int. + x pow 2 + &2 * y pow 2 + &2 * z pow 2 = + &(n - 4 * (k - 1))) + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &2 * z pow 2 + + &2 * y * w + &2 * z * w + &k * w pow 2 = &n`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC + (X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` (X_CHOOSE_TAC `z:int`))))) THEN + MAP_EVERY EXISTS_TAC + [`x:int`; `y - &1:int`; `z - &1:int`; `&2:int`] THEN + SUBGOAL_THEN + `x pow 2 + &2 * y pow 2 + &2 * z pow 2 = + &n - &4 * (&k - &1)` + ASSUME_TAC THENL + [ONCE_REWRITE_TAC[ASSUME + `x pow 2 + &2 * y pow 2 + &2 * z pow 2 = + &(n - 4 * (k - 1))`] THEN + ONCE_REWRITE_TAC[GSYM(MATCH_MP + (SPECL [`4 * (k - 1)`; `n:num`] INT_OF_NUM_SUB) + (ASSUME `4 * (k - 1) <= n`))] THEN + REWRITE_TAC[GSYM INT_OF_NUM_MUL] THEN + ONCE_REWRITE_TAC[GSYM(MATCH_MP + (SPECL [`1`; `k:num`] INT_OF_NUM_SUB) + (ASSUME `1 <= k`))] THEN + REFL_TAC; + MATCH_ACCEPT_TAC + (MATCH_MP + (INT_RING + `x pow 2 + &2 * y pow 2 + &2 * z pow 2 = + nn - &4 * (kk - &1) + ==> x pow 2 + &2 * (y - &1) pow 2 + + &2 * (z - &1) pow 2 + &2 * (y - &1) * &2 + + &2 * (z - &1) * &2 + kk * &2 pow 2 = nn`) + (ASSUME + `x pow 2 + &2 * y pow 2 + &2 * z pow 2 = + &n - &4 * (&k - &1)`))]);; + +let NUM_CROSSB122_SHIFT2 = prove + (`!n:num. + n MOD 8 = 7 + ==> 4 <= n /\ + ~((n - 4) MOD 4 = 0) /\ ~((n - 4) MOD 8 = 7)`, + GEN_TAC THEN DISCH_TAC THEN + MP_TAC(MATCH_MP (SPECL [`n:num`; `8`; `7`] NUM_DECOMPOSE_MOD) + (CONJ (ARITH_RULE `~(8 = 0)`) (ASSUME `n MOD 8 = 7`))) THEN + DISCH_THEN(X_CHOOSE_THEN `q:num` SUBST_ALL_TAC) THEN + REWRITE_TAC[ARITH_RULE `(8 * q + 7) - 4 = 8 * q + 3`] THEN + CONJ_TAC THENL + [ARITH_TAC; + CONJ_TAC THENL + [REWRITE_TAC + [ARITH_RULE `8 * q + 3 = 4 * (2 * q) + 3`; MOD_MULT_ADD]; + REWRITE_TAC[MOD_MULT_ADD]] THEN + CONV_TAC NUM_REDUCE_CONV]);; + +let NUM_CROSSB122_W1_3 = prove + (`!n:num. + n MOD 8 = 7 + ==> 3 <= n /\ (((n + 1) - 3) MOD 4 = 1)`, + GEN_TAC THEN DISCH_TAC THEN + MP_TAC(MATCH_MP (SPECL [`n:num`; `8`; `7`] NUM_DECOMPOSE_MOD) + (CONJ (ARITH_RULE `~(8 = 0)`) (ASSUME `n MOD 8 = 7`))) THEN + DISCH_THEN(X_CHOOSE_THEN `q:num` SUBST_ALL_TAC) THEN + REWRITE_TAC + [ARITH_RULE + `((8 * q + 7) + 1) - 3 = 4 * (2 * q + 1) + 1`; + MOD_MULT_ADD] THEN + CONV_TAC NUM_REDUCE_CONV THEN ARITH_TAC);; + +let NUM_CROSSB122_SHIFT6 = prove + (`!n:num. + n MOD 8 = 7 /\ ~(n = 7) /\ ~(n = 15) + ==> 20 <= n /\ + ~((n - 20) MOD 4 = 0) /\ ~((n - 20) MOD 8 = 7)`, + GEN_TAC THEN STRIP_TAC THEN + MP_TAC(MATCH_MP (SPECL [`n:num`; `8`; `7`] NUM_DECOMPOSE_MOD) + (CONJ (ARITH_RULE `~(8 = 0)`) (ASSUME `n MOD 8 = 7`))) THEN + DISCH_THEN(X_CHOOSE_THEN `q:num` SUBST_ALL_TAC) THEN + SUBGOAL_THEN `2 <= q` ASSUME_TAC THENL + [ASM_CASES_TAC `q = 0` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `q = 1` THEN ASM_REWRITE_TAC[] THEN + ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `(8 * q + 7) - 20 = 8 * (q - 2) + 3` + SUBST1_TAC THENL + [MATCH_MP_TAC(ARITH_RULE + `2 <= q ==> (8 * q + 7) - 20 = 8 * (q - 2) + 3`) THEN + ASM_REWRITE_TAC[]; + CONJ_TAC THENL + [ASM_ARITH_TAC; + CONJ_TAC THENL + [REWRITE_TAC + [ARITH_RULE `8 * q + 3 = 4 * (2 * q) + 3`; MOD_MULT_ADD]; + REWRITE_TAC[MOD_MULT_ADD]] THEN + CONV_TAC NUM_REDUCE_CONV]]);; + +let NUM_CROSSB122_W1_7 = prove + (`!n:num. + n MOD 8 = 7 + ==> 7 <= n /\ (((n + 1) - 7) MOD 4 = 1)`, + GEN_TAC THEN DISCH_TAC THEN + MP_TAC(MATCH_MP (SPECL [`n:num`; `8`; `7`] NUM_DECOMPOSE_MOD) + (CONJ (ARITH_RULE `~(8 = 0)`) (ASSUME `n MOD 8 = 7`))) THEN + DISCH_THEN(X_CHOOSE_THEN `q:num` SUBST_ALL_TAC) THEN + REWRITE_TAC + [ARITH_RULE + `((8 * q + 7) + 1) - 7 = 4 * (2 * q) + 1`; + MOD_MULT_ADD] THEN + CONV_TAC NUM_REDUCE_CONV THEN ARITH_TAC);; + +let INT_UNIVERSAL_CROSSB122_NUM = prove + (`!k:num. + k = 2 \/ k = 3 \/ k = 6 \/ k = 7 + ==> !n:num. + 0 < n + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &2 * z pow 2 + + &2 * y * w + &2 * z * w + &k * w pow 2 = &n`, + GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN + DISCH_TAC THEN DISCH_TAC THEN + ASM_CASES_TAC `n MOD 4 = 0` THENL + [SUBGOAL_THEN `n = 4 * (n DIV 4)` SUBST1_TAC THENL + [MP_TAC(SPECL [`n:num`; `4`] DIVISION) THEN + CONV_TAC NUM_REDUCE_CONV THEN + ASM_REWRITE_TAC[ADD_CLAUSES] THEN ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `n DIV 4 < n /\ 0 < n DIV 4` STRIP_ASSUME_TAC THENL + [MP_TAC(SPECL [`n:num`; `4`] DIVISION) THEN + CONV_TAC NUM_REDUCE_CONV THEN + ASM_REWRITE_TAC[ADD_CLAUSES] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(MATCH_MP + (MATCH_MP + (SPEC `n DIV 4` (ASSUME + `!m. m < n + ==> 0 < m + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &2 * z pow 2 + + &2 * y * w + &2 * z * w + &k * w pow 2 = &m`)) + (ASSUME `n DIV 4 < n`)) + (ASSUME `0 < n DIV 4`)) THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` + (X_CHOOSE_THEN `z:int` (X_CHOOSE_TAC `w:int`)))) THEN + MAP_EVERY EXISTS_TAC + [`&2 * x:int`; `&2 * y:int`; `&2 * z:int`; `&2 * w:int`] THEN + FIRST_X_ASSUM(MP_TAC) THEN + REWRITE_TAC[GSYM INT_OF_NUM_MUL] THEN CONV_TAC INT_RING; + ALL_TAC] THEN + ASM_CASES_TAC `n MOD 8 = 7` THENL + [UNDISCH_TAC `k = 2 \/ k = 3 \/ k = 6 \/ k = 7` THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THENL + [MP_TAC(MATCH_MP (SPEC `n:num` NUM_CROSSB122_SHIFT2) + (ASSUME `n MOD 8 = 7`)) THEN + STRIP_TAC THEN + MATCH_MP_TAC(SPECL [`2`; `n:num`] INT_CROSSB122_SHIFT_NUM) THEN + CONJ_TAC THENL + [CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + CONJ_TAC THENL + [CONV_TAC NUM_REDUCE_CONV THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC INT_REPRESENTS_122_AVOIDS THEN + CONV_TAC NUM_REDUCE_CONV THEN ASM_REWRITE_TAC[]]; + MP_TAC(MATCH_MP (SPEC `n:num` NUM_CROSSB122_W1_3) + (ASSUME `n MOD 8 = 7`)) THEN + STRIP_TAC THEN + MATCH_MP_TAC(SPECL [`3`; `n:num`] + INT_REPRESENTS_CROSSB122_W1) THEN + CONV_TAC NUM_REDUCE_CONV THEN ASM_REWRITE_TAC[]; + ASM_CASES_TAC `n = 7` THENL + [ASM_REWRITE_TAC[] THEN + MAP_EVERY EXISTS_TAC + [`&1:int`; `&0:int`; `&0:int`; `&1:int`] THEN + CONV_TAC INT_REDUCE_CONV; + ALL_TAC] THEN + ASM_CASES_TAC `n = 15` THENL + [ASM_REWRITE_TAC[] THEN + MAP_EVERY EXISTS_TAC + [`&1:int`; `&1:int`; `&1:int`; `&1:int`] THEN + CONV_TAC INT_REDUCE_CONV; + ALL_TAC] THEN + MP_TAC(MATCH_MP (SPEC `n:num` NUM_CROSSB122_SHIFT6) + (CONJ (ASSUME `n MOD 8 = 7`) + (CONJ (ASSUME `~(n = 7)`) (ASSUME `~(n = 15)`)))) THEN + STRIP_TAC THEN + MATCH_MP_TAC(SPECL [`6`; `n:num`] INT_CROSSB122_SHIFT_NUM) THEN + CONJ_TAC THENL + [CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + CONJ_TAC THENL + [CONV_TAC NUM_REDUCE_CONV THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC INT_REPRESENTS_122_AVOIDS THEN + CONV_TAC NUM_REDUCE_CONV THEN ASM_REWRITE_TAC[]]; + MP_TAC(MATCH_MP (SPEC `n:num` NUM_CROSSB122_W1_7) + (ASSUME `n MOD 8 = 7`)) THEN + STRIP_TAC THEN + MATCH_MP_TAC(SPECL [`7`; `n:num`] + INT_REPRESENTS_CROSSB122_W1) THEN + CONV_TAC NUM_REDUCE_CONV THEN ASM_REWRITE_TAC[]]; + MP_TAC(MATCH_MP INT_REPRESENTS_122_AVOIDS + (CONJ (ASSUME `~(n MOD 4 = 0)`) + (ASSUME `~(n MOD 8 = 7)`))) THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` (X_CHOOSE_TAC `z:int`))) THEN + MAP_EVERY EXISTS_TAC [`x:int`; `y:int`; `z:int`; `&0:int`] THEN + FIRST_X_ASSUM(MP_TAC) THEN CONV_TAC INT_RING]);; + +let IQ_UNIVERSAL_CROSSB122_NUM = prove + (`!k:num. + k = 2 \/ k = 3 \/ k = 6 \/ k = 7 + ==> iq_universal 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&2) (&1) (&k))`, + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[iq_universal] THEN + X_GEN_TAC `m:int` THEN DISCH_TAC THEN + MP_TAC(EQ_MP (SYM(SPEC `m:int` INT_OF_NUM_EXISTS)) + (MATCH_MP (SPECL [`&0:int`; `m:int`] INT_LT_IMP_LE) + (ASSUME `&0 < m`))) THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` SUBST_ALL_TAC) THEN + MP_TAC(MATCH_MP (SPEC `k:num` INT_UNIVERSAL_CROSSB122_NUM) + (ASSUME `k = 2 \/ k = 3 \/ k = 6 \/ k = 7`)) THEN + DISCH_THEN(MP_TAC o SPEC `n:num`) THEN + ANTS_TAC THENL + [UNDISCH_TAC `&0 < &n` THEN REWRITE_TAC[INT_OF_NUM_LT]; + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` + (X_CHOOSE_THEN `z:int` (X_CHOOSE_TAC `w:int`)))) THEN + REWRITE_TAC[iq_represents] THEN + EXISTS_TAC + `\i:num. + if i = 0 then (x:int) else if i = 1 then y else + if i = 2 then z else w` THEN + REWRITE_TAC[IQEVAL_MAT4] THEN + CONV_TAC NUM_REDUCE_CONV THEN + FIRST_X_ASSUM(MP_TAC) THEN CONV_TAC INT_RING]);; + +let IQ_UNIVERSAL_CROSSB122_2 = + CONV_RULE NUM_REDUCE_CONV + (SPEC `2` IQ_UNIVERSAL_CROSSB122_NUM);; + +let IQ_UNIVERSAL_CROSSB122_3 = + CONV_RULE NUM_REDUCE_CONV + (SPEC `3` IQ_UNIVERSAL_CROSSB122_NUM);; + +let IQ_UNIVERSAL_CROSSB122_6 = + CONV_RULE NUM_REDUCE_CONV + (SPEC `6` IQ_UNIVERSAL_CROSSB122_NUM);; + +let IQ_UNIVERSAL_CROSSB122_7 = + CONV_RULE NUM_REDUCE_CONV + (SPEC `7` IQ_UNIVERSAL_CROSSB122_NUM);; + +let IQ_UNIVERSAL_OF_CROSSB122_CHILD = prove + (`!n A k. + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&2) (&1) k) A /\ + (k = &2 \/ k = &3 \/ k = &6 \/ k = &7) + ==> iq_universal n A`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC)) THENL + [MATCH_MP_TAC(ISPECL + [`n:num`; `4`; + `iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&2) (&1) (&2)`; + `A:num->num->int`] IQ_UNIVERSAL_OF_EMBEDS) THEN + ASM_REWRITE_TAC[IQ_UNIVERSAL_CROSSB122_2]; + MATCH_MP_TAC(ISPECL + [`n:num`; `4`; + `iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&2) (&1) (&3)`; + `A:num->num->int`] IQ_UNIVERSAL_OF_EMBEDS) THEN + ASM_REWRITE_TAC[IQ_UNIVERSAL_CROSSB122_3]; + MATCH_MP_TAC(ISPECL + [`n:num`; `4`; + `iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&2) (&1) (&6)`; + `A:num->num->int`] IQ_UNIVERSAL_OF_EMBEDS) THEN + ASM_REWRITE_TAC[IQ_UNIVERSAL_CROSSB122_6]; + MATCH_MP_TAC(ISPECL + [`n:num`; `4`; + `iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&2) (&1) (&7)`; + `A:num->num->int`] IQ_UNIVERSAL_OF_EMBEDS) THEN + ASM_REWRITE_TAC[IQ_UNIVERSAL_CROSSB122_7]]);; + +let IQ_UNIVERSAL_OF_EMBEDS_122 = prove + (`!n A. + iq_symmetric n A /\ iq_positive n A /\ + iq_embeds n 3 + (iqmat3 (&1) (&0) (&0) (&2) (&0) (&2)) A /\ + iq_represents n A (&7) + ==> iq_universal n A`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(SPECL [`n:num`; `A:num->num->int`] + IQ_EMBEDS_QUATERNARY_122) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN + (X_CHOOSE_THEN `k:int` + (REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC))) THENL + [MATCH_MP_TAC(ISPECL [`n:num`; `A:num->num->int`; `k:int`] + IQ_UNIVERSAL_OF_DIAG122_CHILD) THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC(ISPECL [`n:num`; `A:num->num->int`; `k:int`] + IQ_UNIVERSAL_OF_CROSSA122_Z_CHILD) THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC(ISPECL [`n:num`; `A:num->num->int`; `k:int`] + IQ_UNIVERSAL_OF_CROSSA122_Y_CHILD) THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC(ISPECL [`n:num`; `A:num->num->int`; `k:int`] + IQ_UNIVERSAL_OF_CROSSB122_CHILD) THEN + ASM_REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Primitive positive binary forms of determinant 3. *) +(* ------------------------------------------------------------------------- *) + +let BINARY_DISC3 = prove + (`!A11. &0 < A11 + ==> !A12 A22. + A11 * A22 - A12 pow 2 = &3 /\ + ~(&2 divides A11 /\ &2 divides A22) + ==> !n. + (?x y. + A11 * x pow 2 + &2 * A12 * x * y + A22 * y pow 2 = n) + ==> ?u v:int. u pow 2 + &3 * v pow 2 = n`, + ONCE_REWRITE_TAC[MESON[] + `(!A11. &0 < A11 ==> P A11) <=> + (!m A11. num_of_int A11 = m /\ &0 < A11 ==> P A11)`] THEN + MATCH_MP_TAC num_WF THEN GEN_TAC THEN STRIP_TAC THEN + GEN_TAC THEN STRIP_TAC THEN REPEAT GEN_TAC THEN STRIP_TAC THEN + GEN_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` (X_CHOOSE_TAC `y:int`)) THEN + ASM_CASES_TAC `A11 = &1` THENL + [POP_ASSUM SUBST_ALL_TAC THEN + MAP_EVERY EXISTS_TAC [`x + A12 * y:int`; `y:int`] THEN + MP_TAC(ASSUME `&1 * A22 - A12 pow 2 = &3`) THEN + MP_TAC(ASSUME + `&1 * x pow 2 + &2 * A12 * x * y + A22 * y pow 2 = n`) THEN + CONV_TAC INT_RING; + ALL_TAC] THEN + MP_TAC(SPECL [`A12:int`; `A11:int`] INT_BALANCED_REM) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `b:int`) THEN + ABBREV_TAC `r = --b:int` THEN + ABBREV_TAC `A12' = A12 + A11 * r` THEN + ABBREV_TAC `A22' = A11 * r pow 2 + &2 * A12 * r + A22` THEN + SUBGOAL_THEN `abs A12' * &2 <= A11` ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["A12'"; "r"] THEN + UNDISCH_TAC `abs (A12 - A11 * b) * &2 <= A11` THEN + REWRITE_TAC[INT_ARITH + `A12 + A11 * --b = A12 - A11 * b`]; + ALL_TAC] THEN + SUBGOAL_THEN `A11 * A22' - A12' pow 2 = &3` ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["A12'"; "A22'"] THEN + UNDISCH_TAC `A11 * A22 - A12 pow 2 = &3` THEN + CONV_TAC INT_RING; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < A22'` ASSUME_TAC THENL + [SUBGOAL_THEN `&0 < A11 * A22'` MP_TAC THENL + [SUBGOAL_THEN `A11 * A22' = &3 + A12' pow 2` SUBST1_TAC THENL + [ASM_INT_ARITH_TAC; + MP_TAC(SPEC `A12':int` INT_LE_POW_2) THEN INT_ARITH_TAC]; + ASM_SIMP_TAC[INT_LT_MUL_EQ]]; + ALL_TAC] THEN + ASM_CASES_TAC `A11 = &2` THENL + [SUBGOAL_THEN `~(&2 divides A12)` ASSUME_TAC THENL + [DISCH_THEN(X_CHOOSE_TAC `e:int` o REWRITE_RULE[int_divides]) THEN + UNDISCH_TAC `A11 * A22 - A12 pow 2 = &3` THEN + DISCH_THEN(MP_TAC o AP_TERM `\z:int. z rem &2`) THEN + ASM_REWRITE_TAC[INT_POW_2] THEN + CONV_TAC INT_REDUCE_CONV THEN + REWRITE_TAC[CONJUNCT2 NOT_INT_REM_2; INT_REM_2_DIVIDES; + INT_2_DIVIDES_SUB; INT_2_DIVIDES_MUL; INT_DIVIDES_REFL]; + ALL_TAC] THEN + MP_TAC(MATCH_MP (SPEC `A12:int` INT_ODD_FORM) + (ASSUME `~(&2 divides A12)`)) THEN + DISCH_THEN(X_CHOOSE_TAC `q:int`) THEN + SUBGOAL_THEN `A22 = &2 * (q pow 2 + q + &1)` ASSUME_TAC THENL + [MP_TAC(ASSUME `A11 * A22 - A12 pow 2 = &3`) THEN + REWRITE_TAC[ASSUME `A11 = &2`; + ASSUME `A12 = &2 * q + &1`; + INT_RING + `(&2 * q + &1) pow 2 = &4 * (q pow 2 + q) + &1`] THEN + INT_ARITH_TAC; + SUBGOAL_THEN `&2 divides A11 /\ &2 divides A22` MP_TAC THENL + [CONJ_TAC THEN REWRITE_TAC[int_divides] THENL + [EXISTS_TAC `&1:int` THEN + REWRITE_TAC[ASSUME `A11 = &2`] THEN CONV_TAC INT_RING; + EXISTS_TAC `q pow 2 + q + &1:int` THEN + REWRITE_TAC[ASSUME + `A22 = &2 * (q pow 2 + q + &1)`]]; + ASM_REWRITE_TAC[]]]; + ALL_TAC] THEN + SUBGOAL_THEN `&3 * A11 pow 2 > &12` ASSUME_TAC THENL + [SUBGOAL_THEN `&3 <= A11` ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; + SUBGOAL_THEN `&9 <= A11 pow 2` MP_TAC THENL + [MP_TAC(SPECL [`2`; `&3:int`; `A11:int`] INT_POW_LE2) THEN + ANTS_TAC THENL [ASM_INT_ARITH_TAC; CONV_TAC INT_REDUCE_CONV]; + INT_ARITH_TAC]]; + ALL_TAC] THEN + SUBGOAL_THEN `A22' < A11` ASSUME_TAC THENL + [SUBGOAL_THEN `&4 * (A11 * A22') <= &12 + A11 pow 2` + ASSUME_TAC THENL + [SUBGOAL_THEN `A11 * A22' = &3 + A12' pow 2` + (fun th -> REWRITE_TAC[th]) THENL + [ASM_INT_ARITH_TAC; + MP_TAC(MATCH_MP SQ_BOUND + (ASSUME `abs A12' * &2 <= A11`)) THEN INT_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN `A11 * (&4 * A22') < A11 * (&4 * A11)` MP_TAC THENL + [MATCH_MP_TAC INT_LET_TRANS THEN + EXISTS_TAC `&12 + A11 pow 2` THEN + CONJ_TAC THENL + [ONCE_REWRITE_TAC[INT_RING + `A11 * (&4 * A22') = &4 * (A11 * A22')`] THEN + ASM_REWRITE_TAC[]; + ONCE_REWRITE_TAC[INT_RING + `A11 * (&4 * A11) = &4 * A11 pow 2`] THEN + UNDISCH_TAC `&3 * A11 pow 2 > &12` THEN INT_ARITH_TAC]; + ASM_SIMP_TAC[INT_LT_LMUL_EQ] THEN INT_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN + `~(&2 divides A22' /\ &2 divides A11)` ASSUME_TAC THENL + [DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_TAC `e:int` o REWRITE_RULE[int_divides]) + (X_CHOOSE_TAC `f:int` o REWRITE_RULE[int_divides])) THEN + SUBGOAL_THEN `&2 divides A11 /\ &2 divides A22` MP_TAC THENL + [CONJ_TAC THEN REWRITE_TAC[int_divides] THENL + [EXISTS_TAC `f:int` THEN ASM_REWRITE_TAC[]; + EXISTS_TAC `e - f * r pow 2 - A12 * r:int` THEN + MP_TAC(ASSUME `A22' = &2 * e`) THEN + MP_TAC(ASSUME `A11 = &2 * f`) THEN + MP_TAC(ASSUME + `A11 * r pow 2 + &2 * A12 * r + A22 = A22'`) THEN + CONV_TAC INT_RING]; + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `num_of_int A22'`) THEN + SUBGOAL_THEN `num_of_int A22' < m` ASSUME_TAC THENL + [FIRST_X_ASSUM(SUBST1_TAC o SYM o + check (fun th -> rand(concl th) = `m:num`)) THEN + REWRITE_TAC[GSYM INT_OF_NUM_LT] THEN + SUBGOAL_THEN + `&(num_of_int A22') = A22' /\ &(num_of_int A11) = A11` + (CONJUNCTS_THEN SUBST1_TAC) THENL + [CONJ_TAC THEN MATCH_MP_TAC INT_OF_NUM_OF_INT THEN ASM_INT_ARITH_TAC; + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `A22':int`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPECL [`A12':int`; `A11:int`]) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN ASM_INT_ARITH_TAC; + DISCH_THEN MATCH_MP_TAC THEN + MAP_EVERY EXISTS_TAC [`y:int`; `x - r * y:int`] THEN + MAP_EVERY EXPAND_TAC ["A12'"; "A22'"] THEN + UNDISCH_TAC + `A11 * x pow 2 + &2 * A12 * x * y + A22 * y pow 2 = n` THEN + CONV_TAC INT_RING]);; + +(* ------------------------------------------------------------------------- *) +(* Oddity 5, expressed by a characteristic vector. *) +(* ------------------------------------------------------------------------- *) + +let tqeval = new_definition + `tqeval a11 a12 a13 a22 a23 a33 x1 x2 x3 = + a11 * x1 pow 2 + a22 * x2 pow 2 + a33 * x3 pow 2 + + &2 * a12 * x1 * x2 + &2 * a13 * x1 * x3 + + &2 * a23 * x2 * x3`;; + +let tqbilin = new_definition + `tqbilin a11 a12 a13 a22 a23 a33 x1 x2 x3 y1 y2 y3 = + a11 * x1 * y1 + a12 * (x1 * y2 + x2 * y1) + + a13 * (x1 * y3 + x3 * y1) + a22 * x2 * y2 + + a23 * (x2 * y3 + x3 * y2) + a33 * x3 * y3`;; + +let ternary_type5 = new_definition + `ternary_type5 a11 a12 a13 a22 a23 a33 <=> + ?w1 w2 w3 q:int. + (!x1 x2 x3. + &2 divides + (tqeval a11 a12 a13 a22 a23 a33 x1 x2 x3 - + tqbilin a11 a12 a13 a22 a23 a33 x1 x2 x3 w1 w2 w3)) /\ + tqeval a11 a12 a13 a22 a23 a33 w1 w2 w3 = &8 * q + &5`;; + +let CONJ_TYPE5 = prove + (`!a11 a12 a13 a22 a23 a33 v1 v2 v3 c12 c13 c22 c23 c32 c33 + b11 b12 b13 b22 b23 b33:int. + v1 * (c22 * c33 - c23 * c32) - + c12 * (v2 * c33 - c23 * v3) + + c13 * (v2 * c32 - c22 * v3) = &1 /\ + b11 = a11 * v1 pow 2 + &2 * a12 * v1 * v2 + + &2 * a13 * v1 * v3 + a22 * v2 pow 2 + + &2 * a23 * v2 * v3 + a33 * v3 pow 2 /\ + b22 = a11 * c12 pow 2 + &2 * a12 * c12 * c22 + + &2 * a13 * c12 * c32 + a22 * c22 pow 2 + + &2 * a23 * c22 * c32 + a33 * c32 pow 2 /\ + b33 = a11 * c13 pow 2 + &2 * a12 * c13 * c23 + + &2 * a13 * c13 * c33 + a22 * c23 pow 2 + + &2 * a23 * c23 * c33 + a33 * c33 pow 2 /\ + b12 = a11 * v1 * c12 + a12 * (v1 * c22 + v2 * c12) + + a13 * (v1 * c32 + v3 * c12) + + a22 * v2 * c22 + a23 * (v2 * c32 + v3 * c22) + + a33 * v3 * c32 /\ + b13 = a11 * v1 * c13 + a12 * (v1 * c23 + v2 * c13) + + a13 * (v1 * c33 + v3 * c13) + + a22 * v2 * c23 + a23 * (v2 * c33 + v3 * c23) + + a33 * v3 * c33 /\ + b23 = a11 * c12 * c13 + a12 * (c12 * c23 + c22 * c13) + + a13 * (c12 * c33 + c32 * c13) + + a22 * c22 * c23 + a23 * (c22 * c33 + c32 * c23) + + a33 * c32 * c33 /\ + ternary_type5 a11 a12 a13 a22 a23 a33 + ==> ternary_type5 b11 b12 b13 b22 b23 b33`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o REWRITE_RULE[ternary_type5]) THEN + DISCH_THEN(X_CHOOSE_THEN `w1:int` (X_CHOOSE_THEN `w2:int` + (X_CHOOSE_THEN `w3:int` (X_CHOOSE_THEN `q:int` STRIP_ASSUME_TAC)))) THEN + MP_TAC(SPECL + [`v1:int`; `v2:int`; `v3:int`; `c12:int`; `c22:int`; `c32:int`; + `c13:int`; `c23:int`; `c33:int`; `w1:int`; `w2:int`; `w3:int`] + ADJ_PREIMAGE) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `y1:int` (X_CHOOSE_THEN `y2:int` + (X_CHOOSE_THEN `y3:int` STRIP_ASSUME_TAC))) THEN + REWRITE_TAC[ternary_type5] THEN + MAP_EVERY EXISTS_TAC [`y1:int`; `y2:int`; `y3:int`; `q:int`] THEN + CONJ_TAC THENL + [MAP_EVERY X_GEN_TAC [`z1:int`; `z2:int`; `z3:int`] THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`z1 * v1 + z2 * c12 + z3 * c13:int`; + `z1 * v2 + z2 * c22 + z3 * c23:int`; + `z1 * v3 + z2 * c32 + z3 * c33:int`] o + check (fun th -> is_forall(concl th))) THEN + REWRITE_TAC[int_divides] THEN + DISCH_THEN(X_CHOOSE_TAC `d:int`) THEN EXISTS_TAC `d:int` THEN + POP_ASSUM_LIST + (fun ths -> MAP_EVERY MP_TAC (filter (is_eq o concl) ths)) THEN + REWRITE_TAC[tqeval; tqbilin] THEN CONV_TAC INT_RING; + POP_ASSUM_LIST + (fun ths -> MAP_EVERY MP_TAC (filter (is_eq o concl) ths)) THEN + REWRITE_TAC[tqeval; tqbilin] THEN CONV_TAC INT_RING]);; + +let INT_DISC3_OFFDIAG_ODD = prove + (`!g11 g12 g22:int. + g11 * g22 - g12 pow 2 = &3 /\ + &2 divides g11 /\ &2 divides g22 + ==> ~(&2 divides g12)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN `&2 divides (g11 * g22 - g12 pow 2)` MP_TAC THENL + [ASM_REWRITE_TAC[INT_2_DIVIDES_SUB; INT_2_DIVIDES_MUL; + INT_2_DIVIDES_POW] THEN CONV_TAC NUM_REDUCE_CONV; + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[GSYM INT_REM_2_DIVIDES] THEN + CONV_TAC INT_REDUCE_CONV]);; + +let INT_CHAR_BINARY_EVEN = prove + (`!g11 g12 w2 w3:int. + &2 divides g11 /\ ~(&2 divides g12) /\ + &2 divides (g11 - (g11 * w2 + g12 * w3)) + ==> &2 divides w3`, + REPEAT GEN_TAC THEN + REWRITE_TAC[INT_2_DIVIDES_SUB; INT_2_DIVIDES_ADD; + INT_2_DIVIDES_MUL] THEN MESON_TAC[]);; + +let INT_ODDITY1_MOD8 = prove + (`!l g11 g12 g22 w2 w3:int. + ~(&2 divides l) /\ + &2 divides g11 /\ &2 divides g22 /\ + &2 divides w2 /\ &2 divides w3 + ==> (l pow 2 + g11 * w2 pow 2 + &2 * g12 * w2 * w3 + + g22 * w3 pow 2) rem &8 = &1`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + FIRST_X_ASSUM(X_CHOOSE_TAC `a:int` o REWRITE_RULE[int_divides] o + check (fun th -> rand(concl th) = `g11:int`)) THEN + FIRST_X_ASSUM(X_CHOOSE_TAC `c:int` o REWRITE_RULE[int_divides] o + check (fun th -> rand(concl th) = `g22:int`)) THEN + FIRST_X_ASSUM(X_CHOOSE_TAC `s:int` o REWRITE_RULE[int_divides] o + check (fun th -> rand(concl th) = `w2:int`)) THEN + FIRST_X_ASSUM(X_CHOOSE_TAC `t:int` o REWRITE_RULE[int_divides] o + check (fun th -> rand(concl th) = `w3:int`)) THEN + SUBGOAL_THEN + `l pow 2 + g11 * w2 pow 2 + &2 * g12 * w2 * w3 + + g22 * w3 pow 2 = + &8 * (a * s pow 2 + g12 * s * t + c * t pow 2) + l pow 2` + SUBST1_TAC THENL + [MP_TAC(ASSUME `g11 = &2 * a`) THEN + MP_TAC(ASSUME `g22 = &2 * c`) THEN + MP_TAC(ASSUME `w2 = &2 * s`) THEN + MP_TAC(ASSUME `w3 = &2 * t`) THEN CONV_TAC INT_RING; + REWRITE_TAC[INT_REM_MUL_ADD] THEN + REWRITE_TAC[ODD_SQ_MOD_8] THEN ASM_REWRITE_TAC[]]);; + +let TYPE5_DISC3_BINARY_PRIMITIVE = prove + (`!b12 b13 b22 b23 b33:int. + &1 * (b22 * b33 - b23 pow 2) - + b12 * (b12 * b33 - b23 * b13) + + b13 * (b12 * b23 - b22 * b13) = &3 /\ + ternary_type5 (&1) b12 b13 b22 b23 b33 + ==> ~(&2 divides (b22 - b12 pow 2) /\ + &2 divides (b33 - b13 pow 2))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + ABBREV_TAC `g11 = b22 - b12 pow 2` THEN + ABBREV_TAC `g12 = b23 - b12 * b13` THEN + ABBREV_TAC `g22 = b33 - b13 pow 2` THEN + SUBGOAL_THEN `g11 * g22 - g12 pow 2 = &3` ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["g11"; "g12"; "g22"] THEN + UNDISCH_TAC + `&1 * (b22 * b33 - b23 pow 2) - + b12 * (b12 * b33 - b23 * b13) + + b13 * (b12 * b23 - b22 * b13) = &3` THEN + CONV_TAC INT_RING; + ALL_TAC] THEN + DISCH_TAC THEN + SUBGOAL_THEN `&2 divides g11 /\ &2 divides g22` + STRIP_ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["g11"; "g22"] THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `~(&2 divides g12)` ASSUME_TAC THENL + [MATCH_MP_TAC INT_DISC3_OFFDIAG_ODD THEN + MAP_EVERY EXISTS_TAC [`g11:int`; `g22:int`] THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MP_TAC(REWRITE_RULE[ternary_type5] + (ASSUME `ternary_type5 (&1) b12 b13 b22 b23 b33`)) THEN + DISCH_THEN(X_CHOOSE_THEN `w1:int` (X_CHOOSE_THEN `w2:int` + (X_CHOOSE_THEN `w3:int` (X_CHOOSE_THEN `q:int` STRIP_ASSUME_TAC)))) THEN + ABBREV_TAC `l = w1 + b12 * w2 + b13 * w3` THEN + SUBGOAL_THEN `~(&2 divides l)` ASSUME_TAC THENL + [MP_TAC(SPECL [`&1:int`; `&0:int`; `&0:int`] + (ASSUME + `!x1 x2 x3. + &2 divides + (tqeval (&1) b12 b13 b22 b23 b33 x1 x2 x3 - + tqbilin (&1) b12 b13 b22 b23 b33 + x1 x2 x3 w1 w2 w3)`)) THEN + SUBGOAL_THEN + `tqeval (&1) b12 b13 b22 b23 b33 (&1) (&0) (&0) - + tqbilin (&1) b12 b13 b22 b23 b33 + (&1) (&0) (&0) w1 w2 w3 = &1 - l` + (fun th -> REWRITE_TAC[th]) THENL + [EXPAND_TAC "l" THEN REWRITE_TAC[tqeval; tqbilin] THEN + CONV_TAC INT_RING; + REWRITE_TAC[INT_2_DIVIDES_SUB] THEN + SUBGOAL_THEN `~(&2 divides (&1:int))` MP_TAC THENL + [REWRITE_TAC[GSYM(CONJUNCT1 INT_REM_2_DIVIDES)] THEN + CONV_TAC INT_REDUCE_CONV; + MESON_TAC[]]]; + ALL_TAC] THEN + SUBGOAL_THEN + `&2 divides (g11 - (g11 * w2 + g12 * w3))` + ASSUME_TAC THENL + [MP_TAC(SPECL [`--b12:int`; `&1:int`; `&0:int`] + (ASSUME + `!x1 x2 x3. + &2 divides + (tqeval (&1) b12 b13 b22 b23 b33 x1 x2 x3 - + tqbilin (&1) b12 b13 b22 b23 b33 + x1 x2 x3 w1 w2 w3)`)) THEN + MAP_EVERY EXPAND_TAC ["g11"; "g12"] THEN + REWRITE_TAC[tqeval; tqbilin; int_divides] THEN + DISCH_THEN(X_CHOOSE_TAC `d:int`) THEN EXISTS_TAC `d:int` THEN + POP_ASSUM MP_TAC THEN CONV_TAC INT_RING; + ALL_TAC] THEN + SUBGOAL_THEN + `&2 divides (g22 - (g12 * w2 + g22 * w3))` + ASSUME_TAC THENL + [MP_TAC(SPECL [`--b13:int`; `&0:int`; `&1:int`] + (ASSUME + `!x1 x2 x3. + &2 divides + (tqeval (&1) b12 b13 b22 b23 b33 x1 x2 x3 - + tqbilin (&1) b12 b13 b22 b23 b33 + x1 x2 x3 w1 w2 w3)`)) THEN + MAP_EVERY EXPAND_TAC ["g12"; "g22"] THEN + REWRITE_TAC[tqeval; tqbilin; int_divides] THEN + DISCH_THEN(X_CHOOSE_TAC `d:int`) THEN EXISTS_TAC `d:int` THEN + POP_ASSUM MP_TAC THEN CONV_TAC INT_RING; + ALL_TAC] THEN + SUBGOAL_THEN `&2 divides w3` ASSUME_TAC THENL + [MATCH_MP_TAC INT_CHAR_BINARY_EVEN THEN + MAP_EVERY EXISTS_TAC [`g11:int`; `g12:int`; `w2:int`] THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `&2 divides w2` ASSUME_TAC THENL + [MATCH_MP_TAC INT_CHAR_BINARY_EVEN THEN + MAP_EVERY EXISTS_TAC [`g22:int`; `g12:int`; `w3:int`] THEN + ASM_REWRITE_TAC[INT_MUL_SYM; INT_ADD_SYM]; + ALL_TAC] THEN + SUBGOAL_THEN + `(l pow 2 + g11 * w2 pow 2 + &2 * g12 * w2 * w3 + + g22 * w3 pow 2) rem &8 = &1` + ASSUME_TAC THENL + [MATCH_MP_TAC INT_ODDITY1_MOD8 THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `tqeval (&1) b12 b13 b22 b23 b33 w1 w2 w3 = + l pow 2 + g11 * w2 pow 2 + &2 * g12 * w2 * w3 + + g22 * w3 pow 2` + ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["l"; "g11"; "g12"; "g22"] THEN + REWRITE_TAC[tqeval] THEN CONV_TAC INT_RING; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o AP_TERM `\z:int. z rem &8` o + check (fun th -> lhand(concl th) = + `tqeval (&1) b12 b13 b22 b23 b33 w1 w2 w3`)) THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[INT_REM_MUL_ADD] THEN + CONV_TAC INT_REDUCE_CONV);; + +(* ------------------------------------------------------------------------- *) +(* Hermite reduction for positive ternary forms of determinant 3. *) +(* ------------------------------------------------------------------------- *) + +let HERMITE_CUBE_DISC3 = prove + (`!a G:int. + &0 < a /\ &0 < G /\ + &3 * a pow 2 <= &4 * G /\ &3 * G pow 2 <= &4 * (&3 * a) + ==> &9 * a pow 3 <= &64`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(&3 * a pow 2) pow 2 <= (&4 * G) pow 2` MP_TAC THENL + [MATCH_MP_TAC INT_POW_LE2 THEN CONJ_TAC THENL + [MATCH_MP_TAC INT_LE_MUL THEN REWRITE_TAC[INT_LE_POW_2] THEN + INT_ARITH_TAC; + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + REWRITE_TAC[INT_POW_MUL] THEN DISCH_TAC THEN + MATCH_MP_TAC INT_LE_RCANCEL_IMP THEN EXISTS_TAC `a:int` THEN + CONJ_TAC THENL [FIRST_ASSUM ACCEPT_TAC; ALL_TAC] THEN + MATCH_MP_TAC INT_LE_TRANS THEN EXISTS_TAC `&16 * G pow 2` THEN + CONJ_TAC THENL + [MP_TAC + (ASSUME `&3 pow 2 * a pow 2 pow 2 <= &4 pow 2 * G pow 2`) THEN + REWRITE_TAC[INT_ARITH `a pow 2 pow 2 = a pow 3 * a`; INT_POW_2] THEN + INT_ARITH_TAC; + MP_TAC(ASSUME `&3 * G pow 2 <= &4 * (&3 * a)`) THEN + INT_ARITH_TAC]);; + +let HERMITE_DISC3_A1 = prove + (`!b11 b12 b13 b22 b23 b33:int. + &0 < b11 /\ + b11 * (b22 * b33 - b23 pow 2) - + b12 * (b12 * b33 - b13 * b23) + + b13 * (b12 * b23 - b13 * b22) = &3 /\ + &0 < b11 * b22 - b12 pow 2 /\ + (!x y z. ~(x = &0 /\ y = &0 /\ z = &0) + ==> b11 <= b11 * x pow 2 + b22 * y pow 2 + + b33 * z pow 2 + &2 * b12 * x * y + + &2 * b13 * x * z + &2 * b23 * y * z) + ==> b11 = &1`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + ABBREV_TAC `G11 = b11 * b22 - b12 pow 2` THEN + ABBREV_TAC `G12 = b11 * b23 - b12 * b13` THEN + ABBREV_TAC `G22 = b11 * b33 - b13 pow 2` THEN + SUBGOAL_THEN `G11 * G22 - G12 pow 2 = &3 * b11` ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["G11"; "G12"; "G22"] THEN + REWRITE_TAC[DISC_G] THEN + MP_TAC + (ASSUME + `b11 * (b22 * b33 - b23 pow 2) - + b12 * (b12 * b33 - b13 * b23) + + b13 * (b12 * b23 - b13 * b22) = &3`) THEN + CONV_TAC INT_RING; + ALL_TAC] THEN + MP_TAC(SPEC `&3 * b11:int` BINARY_HERMITE) THEN + ANTS_TAC THENL [ASM_INT_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `G11:int`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPECL [`G12:int`; `G22:int`]) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `s:int` + (X_CHOOSE_THEN `t:int` STRIP_ASSUME_TAC)) THEN + ABBREV_TAC + `Gst = G11 * s pow 2 + &2 * G12 * s * t + G22 * t pow 2` THEN + MP_TAC(SPECL [`b12 * s + b13 * t:int`; `b11:int`] + INT_BALANCED_REM) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `bb:int`) THEN + ABBREV_TAC `x1 = --bb:int` THEN + SUBGOAL_THEN + `&4 * (b11 * x1 + b12 * s + b13 * t) pow 2 <= b11 pow 2` + ASSUME_TAC THENL + [MP_TAC(MATCH_MP SQ_BOUND + (ASSUME + `abs ((b12 * s + b13 * t) - b11 * bb) * &2 <= b11`)) THEN + EXPAND_TAC "x1" THEN + REWRITE_TAC + [INT_ARITH + `b11 * --bb + b12 * s + b13 * t = + (b12 * s + b13 * t) - b11 * bb`] THEN + INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `&3 * b11 pow 2 <= &4 * Gst` ASSUME_TAC THENL + [MATCH_MP_TAC HERMITE_LOWER THEN + MAP_EVERY EXISTS_TAC + [`b12:int`; `b13:int`; `b22:int`; `b23:int`; `b33:int`; + `x1:int`; `s:int`; `t:int`] THEN + ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [FIRST_X_ASSUM + (fun th -> + MP_TAC(SPECL [`x1:int`; `s:int`; `t:int`] th) THEN + ANTS_TAC THENL + [UNDISCH_TAC `~(s = &0 /\ t = &0)` THEN MESON_TAC[]; + ALL_TAC] THEN + DISCH_THEN(fun th2 -> ACCEPT_TAC th2 ORELSE MP_TAC th2)); + EXPAND_TAC "Gst" THEN + MP_TAC(SPECL + [`b11:int`; `b12:int`; `b13:int`; `b22:int`; `b23:int`; + `b33:int`; `x1:int`; `s:int`; `t:int`] TERNARY_COMPLETE) THEN + MAP_EVERY (fun e -> UNDISCH_TAC e) + [`b11 * b22 - b12 pow 2 = G11`; + `b11 * b23 - b12 * b13 = G12`; + `b11 * b33 - b13 pow 2 = G22`] THEN + CONV_TAC INT_RING]; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < Gst` ASSUME_TAC THENL + [EXPAND_TAC "Gst" THEN + MP_TAC(SPECL [`G11:int`; `G12:int`; `G22:int`] + POSDEF_BINARY_CRITERION) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN ASM_INT_ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPECL [`s:int`; `t:int`]) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; REWRITE_TAC[]]; + ALL_TAC] THEN + MP_TAC(SPECL [`b11:int`; `Gst:int`] HERMITE_CUBE_DISC3) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + SUBGOAL_THEN `~(&2 <= b11)` ASSUME_TAC THENL + [DISCH_TAC THEN MP_TAC(SPEC `b11:int` CUBE_GE_8) THEN + ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `&9 * b11 pow 3 <= &64` THEN INT_ARITH_TAC; + ALL_TAC] THEN + ASM_INT_ARITH_TAC);; + +let TERNARY_DISC3_TYPE5_A11_1 = prove + (`!a12 a13 a22 a23 a33 n:int. + &0 < &1 * a22 - a12 pow 2 /\ + &1 * (a22 * a33 - a23 pow 2) - + a12 * (a12 * a33 - a23 * a13) + + a13 * (a12 * a23 - a22 * a13) = &3 /\ + ternary_type5 (&1) a12 a13 a22 a23 a33 /\ + (?x1 x2 x3. + &1 * x1 pow 2 + a22 * x2 pow 2 + a33 * x3 pow 2 + + &2 * a12 * x1 * x2 + &2 * a13 * x1 * x3 + + &2 * a23 * x2 * x3 = n) + ==> ?u v w:int. u pow 2 + v pow 2 + &3 * w pow 2 = n`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + ABBREV_TAC `G11 = a22 - a12 pow 2` THEN + ABBREV_TAC `G12 = a23 - a12 * a13` THEN + ABBREV_TAC `G22 = a33 - a13 pow 2` THEN + SUBGOAL_THEN `G11 * G22 - G12 pow 2 = &3` ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["G11"; "G12"; "G22"] THEN + UNDISCH_TAC + `&1 * (a22 * a33 - a23 pow 2) - + a12 * (a12 * a33 - a23 * a13) + + a13 * (a12 * a23 - a22 * a13) = &3` THEN + CONV_TAC INT_RING; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < G11` ASSUME_TAC THENL + [EXPAND_TAC "G11" THEN + UNDISCH_TAC `&0 < &1 * a22 - a12 pow 2` THEN INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `~(&2 divides G11 /\ &2 divides G22)` ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["G11"; "G22"] THEN + MATCH_MP_TAC(SPECL + [`a12:int`; `a13:int`; `a22:int`; `a23:int`; `a33:int`] + TYPE5_DISC3_BINARY_PRIMITIVE) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + ABBREV_TAC `L = x1 + a12 * x2 + a13 * x3` THEN + MP_TAC(SPEC `G11:int` BINARY_DISC3) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPECL [`G12:int`; `G22:int`]) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `n - L pow 2`) THEN + ANTS_TAC THENL + [MAP_EVERY EXISTS_TAC [`x2:int`; `x3:int`] THEN + MP_TAC(SPECL + [`&1:int`; `a12:int`; `a13:int`; `a22:int`; `a23:int`; `a33:int`; + `x1:int`; `x2:int`; `x3:int`] TERNARY_COMPLETE) THEN + ASM_REWRITE_TAC[INT_MUL_LID] THEN + MAP_EVERY EXPAND_TAC ["G11"; "G12"; "G22"; "L"] THEN + INT_ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `u:int` (X_CHOOSE_TAC `v:int`)) THEN + MAP_EVERY EXISTS_TAC [`L:int`; `u:int`; `v:int`] THEN + UNDISCH_TAC `u pow 2 + &3 * v pow 2 = n - L pow 2` THEN + INT_ARITH_TAC);; + +let TERNARY_DISC3_TYPE5 = prove + (`!a11 a12 a13 a22 a23 a33 n:int. + &0 < a11 /\ + &0 < a11 * a22 - a12 pow 2 /\ + a11 * (a22 * a33 - a23 pow 2) - + a12 * (a12 * a33 - a23 * a13) + + a13 * (a12 * a23 - a22 * a13) = &3 /\ + ternary_type5 a11 a12 a13 a22 a23 a33 /\ + (?x1 x2 x3. + a11 * x1 pow 2 + a22 * x2 pow 2 + a33 * x3 pow 2 + + &2 * a12 * x1 * x2 + &2 * a13 * x1 * x3 + + &2 * a23 * x2 * x3 = n) + ==> ?u v w:int. u pow 2 + v pow 2 + &3 * w pow 2 = n`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN + `!x y z. ~(x = &0 /\ y = &0 /\ z = &0) + ==> &0 < a11 * x pow 2 + a22 * y pow 2 + a33 * z pow 2 + + &2 * a12 * x * y + &2 * a13 * x * z + + &2 * a23 * y * z` + ASSUME_TAC THENL + [MATCH_MP_TAC TERNARY_POSDEF THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC + `a11 * (a22 * a33 - a23 pow 2) - + a12 * (a12 * a33 - a23 * a13) + + a13 * (a12 * a23 - a22 * a13) = &3` THEN + INT_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(SPECL + [`a11:int`; `a12:int`; `a13:int`; `a22:int`; `a23:int`; `a33:int`] + TERNARY_MIN) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `v1:int` (X_CHOOSE_THEN `v2:int` + (X_CHOOSE_THEN `v3:int` STRIP_ASSUME_TAC))) THEN + SUBGOAL_THEN `?p q s. v1 * p + v2 * q + v3 * s = &1` + STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC MIN_PRIMITIVE THEN + MAP_EVERY EXISTS_TAC + [`a11:int`; `a12:int`; `a13:int`; `a22:int`; `a23:int`; `a33:int`] THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MP_TAC(SPECL [`v1:int`; `v2:int`; `v3:int`] SL3_EXTEND) THEN + ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `c12:int` (X_CHOOSE_THEN `c13:int` + (X_CHOOSE_THEN `c22:int` (X_CHOOSE_THEN `c23:int` + (X_CHOOSE_THEN `c32:int` + (X_CHOOSE_THEN `c33:int` ASSUME_TAC)))))) THEN + ABBREV_TAC + `b11 = a11 * v1 pow 2 + &2 * a12 * v1 * v2 + + &2 * a13 * v1 * v3 + a22 * v2 pow 2 + + &2 * a23 * v2 * v3 + a33 * v3 pow 2` THEN + ABBREV_TAC + `b22 = a11 * c12 pow 2 + &2 * a12 * c12 * c22 + + &2 * a13 * c12 * c32 + a22 * c22 pow 2 + + &2 * a23 * c22 * c32 + a33 * c32 pow 2` THEN + ABBREV_TAC + `b33 = a11 * c13 pow 2 + &2 * a12 * c13 * c23 + + &2 * a13 * c13 * c33 + a22 * c23 pow 2 + + &2 * a23 * c23 * c33 + a33 * c33 pow 2` THEN + ABBREV_TAC + `b12 = a11 * v1 * c12 + a12 * (v1 * c22 + v2 * c12) + + a13 * (v1 * c32 + v3 * c12) + a22 * v2 * c22 + + a23 * (v2 * c32 + v3 * c22) + a33 * v3 * c32` THEN + ABBREV_TAC + `b13 = a11 * v1 * c13 + a12 * (v1 * c23 + v2 * c13) + + a13 * (v1 * c33 + v3 * c13) + a22 * v2 * c23 + + a23 * (v2 * c33 + v3 * c23) + a33 * v3 * c33` THEN + ABBREV_TAC + `b23 = a11 * c12 * c13 + a12 * (c12 * c23 + c22 * c13) + + a13 * (c12 * c33 + c32 * c13) + a22 * c22 * c23 + + a23 * (c22 * c33 + c32 * c23) + a33 * c32 * c33` THEN + SUBGOAL_THEN + `!x y z. ~(x = &0 /\ y = &0 /\ z = &0) + ==> b11 <= b11 * x pow 2 + b22 * y pow 2 + b33 * z pow 2 + + &2 * b12 * x * y + &2 * b13 * x * z + + &2 * b23 * y * z` + ASSUME_TAC THENL + [MATCH_MP_TAC CONJ_MIN THEN + MAP_EVERY EXISTS_TAC + [`a11:int`; `a12:int`; `a13:int`; `a22:int`; `a23:int`; `a33:int`; + `v1:int`; `v2:int`; `v3:int`; `c12:int`; `c13:int`; `c22:int`; + `c23:int`; `c32:int`; `c33:int`] THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < b11` ASSUME_TAC THENL + [FIRST_X_ASSUM + (fun th -> + MP_TAC(SPECL [`v1:int`; `v2:int`; `v3:int`] th) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + DISCH_THEN + (fun t -> + if rand(rator(concl t)) = `&0` then MP_TAC t else NO_TAC)) THEN + MP_TAC + (ASSUME + `a11 * v1 pow 2 + &2 * a12 * v1 * v2 + + &2 * a13 * v1 * v3 + a22 * v2 pow 2 + + &2 * a23 * v2 * v3 + a33 * v3 pow 2 = b11`) THEN + INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `b11 * (b22 * b33 - b23 pow 2) - + b12 * (b12 * b33 - b13 * b23) + + b13 * (b12 * b23 - b13 * b22) = &3` + ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["b11"; "b12"; "b13"; "b22"; "b23"; "b33"] THEN + MP_TAC + (ASSUME + `v1 * (c22 * c33 - c23 * c32) - + c12 * (v2 * c33 - c23 * v3) + + c13 * (v2 * c32 - c22 * v3) = &1`) THEN + MP_TAC + (ASSUME + `a11 * (a22 * a33 - a23 pow 2) - + a12 * (a12 * a33 - a23 * a13) + + a13 * (a12 * a23 - a22 * a13) = &3`) THEN + CONV_TAC INT_RING; + ALL_TAC] THEN + SUBGOAL_THEN `ternary_type5 b11 b12 b13 b22 b23 b33` + ASSUME_TAC THENL + [MATCH_MP_TAC(SPECL + [`a11:int`; `a12:int`; `a13:int`; `a22:int`; `a23:int`; `a33:int`; + `v1:int`; `v2:int`; `v3:int`; `c12:int`; `c13:int`; `c22:int`; + `c23:int`; `c32:int`; `c33:int`; `b11:int`; `b12:int`; `b13:int`; + `b22:int`; `b23:int`; `b33:int`] CONJ_TYPE5) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `!x y z. ~(x = &0 /\ y = &0 /\ z = &0) + ==> &0 < b11 * x pow 2 + b22 * y pow 2 + b33 * z pow 2 + + &2 * b12 * x * y + &2 * b13 * x * z + + &2 * b23 * y * z` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN + MATCH_MP_TAC INT_LTE_TRANS THEN EXISTS_TAC `b11:int` THEN + ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < b11 * b22 - b12 pow 2` ASSUME_TAC THENL + [MATCH_MP_TAC POSDEF_MINOR2 THEN + MAP_EVERY EXISTS_TAC [`b13:int`; `b23:int`; `b33:int`] THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `b11 = &1` ASSUME_TAC THENL + [MATCH_MP_TAC HERMITE_DISC3_A1 THEN + MAP_EVERY EXISTS_TAC + [`b12:int`; `b13:int`; `b22:int`; `b23:int`; `b33:int`] THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `?y1 y2 y3. + b11 * y1 pow 2 + b22 * y2 pow 2 + b33 * y3 pow 2 + + &2 * b12 * y1 * y2 + &2 * b13 * y1 * y3 + + &2 * b23 * y2 * y3 = n` + STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC CONJ_REPS THEN + MAP_EVERY EXISTS_TAC + [`a11:int`; `a12:int`; `a13:int`; `a22:int`; `a23:int`; `a33:int`; + `v1:int`; `v2:int`; `v3:int`; `c12:int`; `c13:int`; `c22:int`; + `c23:int`; `c32:int`; `c33:int`] THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC TERNARY_DISC3_TYPE5_A11_1 THEN + MAP_EVERY EXISTS_TAC + [`b12:int`; `b13:int`; `b22:int`; `b23:int`; `b33:int`] THEN + SUBST1_TAC(ASSUME `b11 = &1`) THEN + REPEAT CONJ_TAC THENL + [UNDISCH_TAC `&0 < b11 * b22 - b12 pow 2` THEN + SUBST1_TAC(ASSUME `b11 = &1`) THEN REWRITE_TAC[INT_MUL_LID]; + UNDISCH_TAC + `b11 * (b22 * b33 - b23 pow 2) - + b12 * (b12 * b33 - b13 * b23) + + b13 * (b12 * b23 - b13 * b22) = &3` THEN + SUBST1_TAC(ASSUME `b11 = &1`) THEN REWRITE_TAC[INT_MUL_LID] THEN + CONV_TAC INT_RING; + UNDISCH_TAC `ternary_type5 b11 b12 b13 b22 b23 b33` THEN + SUBST1_TAC(ASSUME `b11 = &1`) THEN REWRITE_TAC[]; + MAP_EVERY EXISTS_TAC [`y1:int`; `y2:int`; `y3:int`] THEN + UNDISCH_TAC + `b11 * y1 pow 2 + b22 * y2 pow 2 + b33 * y3 pow 2 + + &2 * b12 * y1 * y2 + &2 * b13 * y1 * y3 + + &2 * b23 * y2 * y3 = n` THEN + SUBST1_TAC(ASSUME `b11 = &1`) THEN REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* A concrete oddity-5 determinant-three model. *) +(* ------------------------------------------------------------------------- *) + +let INT_SQ_SUB_SELF_EVEN = prove + (`!x:int. &2 divides (x pow 2 - x)`, + GEN_TAC THEN REWRITE_TAC[INT_2_DIVIDES_SUB; INT_2_DIVIDES_POW] THEN + CONV_TAC NUM_REDUCE_CONV);; + +let TERNARY_CHARACTERISTIC = prove + (`!a11 a12 a13 a22 a23 a33 w1 w2 w3:int. + &2 divides (a11 - (a11 * w1 + a12 * w2 + a13 * w3)) /\ + &2 divides (a22 - (a12 * w1 + a22 * w2 + a23 * w3)) /\ + &2 divides (a33 - (a13 * w1 + a23 * w2 + a33 * w3)) + ==> !x1 x2 x3. + &2 divides + (tqeval a11 a12 a13 a22 a23 a33 x1 x2 x3 - + tqbilin a11 a12 a13 a22 a23 a33 + x1 x2 x3 w1 w2 w3)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN REPEAT GEN_TAC THEN + FIRST_X_ASSUM + (X_CHOOSE_TAC `k1:int` o REWRITE_RULE[int_divides] o + check + (fun th -> + rand(concl th) = + `a11 - (a11 * w1 + a12 * w2 + a13 * w3):int`)) THEN + FIRST_X_ASSUM + (X_CHOOSE_TAC `k2:int` o REWRITE_RULE[int_divides] o + check + (fun th -> + rand(concl th) = + `a22 - (a12 * w1 + a22 * w2 + a23 * w3):int`)) THEN + FIRST_X_ASSUM + (X_CHOOSE_TAC `k3:int` o REWRITE_RULE[int_divides] o + check + (fun th -> + rand(concl th) = + `a33 - (a13 * w1 + a23 * w2 + a33 * w3):int`)) THEN + MP_TAC(SPEC `x1:int` INT_SQ_SUB_SELF_EVEN) THEN + REWRITE_TAC[int_divides] THEN DISCH_THEN(X_CHOOSE_TAC `e1:int`) THEN + MP_TAC(SPEC `x2:int` INT_SQ_SUB_SELF_EVEN) THEN + REWRITE_TAC[int_divides] THEN DISCH_THEN(X_CHOOSE_TAC `e2:int`) THEN + MP_TAC(SPEC `x3:int` INT_SQ_SUB_SELF_EVEN) THEN + REWRITE_TAC[int_divides] THEN DISCH_THEN(X_CHOOSE_TAC `e3:int`) THEN + REWRITE_TAC[tqeval; tqbilin; int_divides] THEN + EXISTS_TAC + `x1 * k1 + x2 * k2 + x3 * k3 + + a11 * e1 + a22 * e2 + a33 * e3 + + a12 * x1 * x2 + a13 * x1 * x3 + a23 * x2 * x3:int` THEN + POP_ASSUM_LIST + (fun ths -> MAP_EVERY MP_TAC (filter (is_eq o concl) ths)) THEN + CONV_TAC INT_RING);; + +let TERNARY_TYPE5_OF_CHARACTERISTIC = prove + (`!a11 a12 a13 a22 a23 a33 w1 w2 w3 q:int. + &2 divides (a11 - (a11 * w1 + a12 * w2 + a13 * w3)) /\ + &2 divides (a22 - (a12 * w1 + a22 * w2 + a23 * w3)) /\ + &2 divides (a33 - (a13 * w1 + a23 * w2 + a33 * w3)) /\ + tqeval a11 a12 a13 a22 a23 a33 w1 w2 w3 = &8 * q + &5 + ==> ternary_type5 a11 a12 a13 a22 a23 a33`, + REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[ternary_type5] THEN + MAP_EVERY EXISTS_TAC [`w1:int`; `w2:int`; `w3:int`; `q:int`] THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC TERNARY_CHARACTERISTIC THEN + ASM_REWRITE_TAC[]);; + +let INT_PARITY_DISC_EVEN = prove + (`!a p t d:int. + a * p - t pow 2 = d /\ &2 divides d /\ ~(&2 divides p) + ==> &2 divides (a - t)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&2 divides (a * p - t pow 2)` MP_TAC THENL + [ASM_REWRITE_TAC[]; + REWRITE_TAC + [INT_2_DIVIDES_SUB; INT_2_DIVIDES_MUL; INT_2_DIVIDES_POW] THEN + CONV_TAC NUM_REDUCE_CONV THEN + UNDISCH_TAC `~(&2 divides p)` THEN + REWRITE_TAC[INT_2_DIVIDES_SUB] THEN MESON_TAC[]]);; + +let TERNARY_TYPE5_MODEL = prove + (`!a p t d n j:int. + a * p - t pow 2 = d /\ d = &24 * j + &4 /\ p = d * n - &3 + ==> ternary_type5 a t (&1) p (&0) n`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `&2 divides d` ASSUME_TAC THENL + [REWRITE_TAC[int_divides] THEN EXISTS_TAC `&12 * j + &2:int` THEN + ASM_REWRITE_TAC[] THEN CONV_TAC INT_RING; + ALL_TAC] THEN + SUBGOAL_THEN `~(&2 divides p)` ASSUME_TAC THENL + [SUBGOAL_THEN + `p = &2 * ((&12 * j + &2) * n - &2) + &1` + ASSUME_TAC THENL + [POP_ASSUM_LIST + (fun ths -> MAP_EVERY MP_TAC (filter (is_eq o concl) ths)) THEN + CONV_TAC INT_RING; + ALL_TAC] THEN + REWRITE_TAC + [ASSUME `p = &2 * ((&12 * j + &2) * n - &2) + &1`; + GSYM(CONJUNCT2 INT_REM_2_DIVIDES); INT_REM_MUL_ADD] THEN + CONV_TAC INT_REDUCE_CONV; + ALL_TAC] THEN + SUBGOAL_THEN `&2 divides (a - t)` ASSUME_TAC THENL + [MATCH_MP_TAC INT_PARITY_DISC_EVEN THEN + MAP_EVERY EXISTS_TAC [`p:int`; `d:int`] THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + ASM_CASES_TAC `&2 divides n` THENL + [X_CHOOSE_TAC `m:int` + (REWRITE_RULE[int_divides] (ASSUME `&2 divides n`)) THEN + MATCH_MP_TAC(SPECL + [`a:int`; `t:int`; `&1:int`; `p:int`; `&0:int`; `n:int`; + `&0:int`; `&1:int`; `&0:int`; `&6 * j * m + m - &1:int`] + TERNARY_TYPE5_OF_CHARACTERISTIC) THEN + REWRITE_TAC + [INT_MUL_LZERO; INT_MUL_RZERO; INT_MUL_LID; INT_MUL_RID; + INT_ADD_LID; INT_ADD_RID] THEN + REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + REWRITE_TAC[INT_SUB_REFL; INT_DIVIDES_0]; + REWRITE_TAC[int_divides] THEN EXISTS_TAC `m:int` THEN + ASM_REWRITE_TAC[INT_SUB_RZERO]; + REWRITE_TAC[tqeval] THEN + MP_TAC(ASSUME `d = &24 * j + &4`) THEN + MP_TAC(ASSUME `p = d * n - &3`) THEN + MP_TAC(ASSUME `n = &2 * m`) THEN CONV_TAC INT_RING]; + ALL_TAC] THEN + MP_TAC(MATCH_MP (SPEC `n:int` INT_ODD_FORM) + (ASSUME `~(&2 divides n)`)) THEN + DISCH_THEN(X_CHOOSE_TAC `m:int`) THEN + ABBREV_TAC `P = &6 * j * m + &3 * j + m:int` THEN + SUBGOAL_THEN `p = &8 * P + &1` ASSUME_TAC THENL + [EXPAND_TAC "P" THEN + MP_TAC(ASSUME `d = &24 * j + &4`) THEN + MP_TAC(ASSUME `p = d * n - &3`) THEN + MP_TAC(ASSUME `n = &2 * m + &1`) THEN CONV_TAC INT_RING; + ALL_TAC] THEN + ASM_CASES_TAC `&2 divides t` THENL + [X_CHOOSE_TAC `r:int` + (REWRITE_RULE[int_divides] (ASSUME `&2 divides t`)) THEN + SUBGOAL_THEN `&2 divides (r pow 2 + r)` MP_TAC THENL + [MP_TAC(SPEC `--r:int` INT_SQ_SUB_SELF_EVEN) THEN + REWRITE_TAC[INT_RING `(--r) pow 2 - --r = r pow 2 + r`]; + REWRITE_TAC[int_divides]] THEN + DISCH_THEN(X_CHOOSE_TAC `s:int`) THEN + MATCH_MP_TAC(SPECL + [`a:int`; `t:int`; `&1:int`; `p:int`; `&0:int`; `n:int`; + `&1:int`; `&1:int`; `&0:int`; + `&3 * j + P - P * a + s:int`] + TERNARY_TYPE5_OF_CHARACTERISTIC) THEN + REWRITE_TAC + [INT_MUL_LZERO; INT_MUL_RZERO; INT_MUL_LID; INT_MUL_RID; + INT_ADD_LID; INT_ADD_RID] THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[int_divides] THEN EXISTS_TAC `--r:int` THEN + MP_TAC(ASSUME `t = &2 * r`) THEN CONV_TAC INT_RING; + REWRITE_TAC[int_divides] THEN EXISTS_TAC `--r:int` THEN + MP_TAC(ASSUME `t = &2 * r`) THEN CONV_TAC INT_RING; + REWRITE_TAC[int_divides] THEN EXISTS_TAC `m:int` THEN + MP_TAC(ASSUME `n = &2 * m + &1`) THEN CONV_TAC INT_RING; + REWRITE_TAC[tqeval] THEN + MP_TAC(ASSUME `a * p - t pow 2 = d`) THEN + MP_TAC(ASSUME `d = &24 * j + &4`) THEN + MP_TAC(ASSUME `p = &8 * P + &1`) THEN + MP_TAC(ASSUME `t = &2 * r`) THEN + MP_TAC(ASSUME `r pow 2 + r = &2 * s`) THEN + CONV_TAC INT_RING]; + ALL_TAC] THEN + MP_TAC(MATCH_MP (SPEC `t:int` INT_ODD_FORM) + (ASSUME `~(&2 divides t)`)) THEN + DISCH_THEN(X_CHOOSE_TAC `r:int`) THEN + SUBGOAL_THEN `&2 divides (r pow 2 + r)` MP_TAC THENL + [MP_TAC(SPEC `--r:int` INT_SQ_SUB_SELF_EVEN) THEN + REWRITE_TAC[INT_RING `(--r) pow 2 - --r = r pow 2 + r`]; + REWRITE_TAC[int_divides]] THEN + DISCH_THEN(X_CHOOSE_TAC `s:int`) THEN + MATCH_MP_TAC(SPECL + [`a:int`; `t:int`; `&1:int`; `p:int`; `&0:int`; `n:int`; + `&1:int`; `&0:int`; `&0:int`; `&3 * j + s - P * a:int`] + TERNARY_TYPE5_OF_CHARACTERISTIC) THEN + REWRITE_TAC + [INT_MUL_LZERO; INT_MUL_RZERO; INT_MUL_LID; INT_MUL_RID; + INT_ADD_LID; INT_ADD_RID] THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[INT_SUB_REFL; INT_DIVIDES_0]; + REWRITE_TAC[int_divides] THEN EXISTS_TAC `&4 * P - r:int` THEN + MP_TAC(ASSUME `p = &8 * P + &1`) THEN + MP_TAC(ASSUME `t = &2 * r + &1`) THEN CONV_TAC INT_RING; + REWRITE_TAC[int_divides] THEN EXISTS_TAC `m:int` THEN + MP_TAC(ASSUME `n = &2 * m + &1`) THEN CONV_TAC INT_RING; + REWRITE_TAC[tqeval] THEN + MP_TAC(ASSUME `a * p - t pow 2 = d`) THEN + MP_TAC(ASSUME `d = &24 * j + &4`) THEN + MP_TAC(ASSUME `p = &8 * P + &1`) THEN + MP_TAC(ASSUME `t = &2 * r + &1`) THEN + MP_TAC(ASSUME `r pow 2 + r = &2 * s`) THEN + CONV_TAC INT_RING]);; + +(* The model needed when the represented integer is three times an integer. *) + +let TERNARY_TYPE5_MODEL_3 = prove + (`!a q t d m j:int. + a * q - t pow 2 = d /\ + d = &24 * j + &4 /\ + &3 * q + &1 = d * m + ==> ternary_type5 a t (&3) q (&0) (&3 * m)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `&2 divides d` ASSUME_TAC THENL + [REWRITE_TAC[int_divides] THEN + EXISTS_TAC `&12 * j + &2:int` THEN + ASM_REWRITE_TAC[] THEN CONV_TAC INT_RING; + ALL_TAC] THEN + SUBGOAL_THEN `~(&2 divides q)` ASSUME_TAC THENL + [SUBGOAL_THEN + `q = &2 * ((&12 * j + &2) * m - q - &1) + &1` + ASSUME_TAC THENL + [POP_ASSUM_LIST + (fun ths -> MAP_EVERY MP_TAC (filter (is_eq o concl) ths)) THEN + CONV_TAC INT_RING; + ALL_TAC] THEN + REWRITE_TAC[GSYM(CONJUNCT2 INT_REM_2_DIVIDES)] THEN + SUBST1_TAC(ASSUME + `q = &2 * ((&12 * j + &2) * m - q - &1) + &1`) THEN + REWRITE_TAC[INT_REM_MUL_ADD] THEN CONV_TAC INT_REDUCE_CONV; + ALL_TAC] THEN + SUBGOAL_THEN `&2 divides (a - t)` ASSUME_TAC THENL + [MATCH_MP_TAC INT_PARITY_DISC_EVEN THEN + MAP_EVERY EXISTS_TAC [`q:int`; `d:int`] THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + ASM_CASES_TAC `&2 divides m` THENL + [X_CHOOSE_TAC `k:int` + (REWRITE_RULE[int_divides] (ASSUME `&2 divides m`)) THEN + ABBREV_TAC `P = &18 * j * k + &3 * k - q - &1:int` THEN + SUBGOAL_THEN `q = &8 * P + &5` ASSUME_TAC THENL + [EXPAND_TAC "P" THEN + MP_TAC(ASSUME `&3 * q + &1 = d * m`) THEN + MP_TAC(ASSUME `d = &24 * j + &4`) THEN + MP_TAC(ASSUME `m = &2 * k`) THEN CONV_TAC INT_RING; + ALL_TAC] THEN + MATCH_MP_TAC(SPECL + [`a:int`; `t:int`; `&3:int`; `q:int`; `&0:int`; `&3 * m:int`; + `&0:int`; `&1:int`; `&0:int`; `P:int`] + TERNARY_TYPE5_OF_CHARACTERISTIC) THEN + REWRITE_TAC + [INT_MUL_LZERO; INT_MUL_RZERO; INT_MUL_LID; INT_MUL_RID; + INT_ADD_LID; INT_ADD_RID] THEN + REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + REWRITE_TAC[INT_SUB_REFL; INT_DIVIDES_0]; + REWRITE_TAC[int_divides] THEN EXISTS_TAC `&3 * k:int` THEN + MP_TAC(ASSUME `m = &2 * k`) THEN CONV_TAC INT_RING; + REWRITE_TAC[tqeval] THEN + MP_TAC(ASSUME `q = &8 * P + &5`) THEN CONV_TAC INT_RING]; + ALL_TAC] THEN + MP_TAC(MATCH_MP (SPEC `m:int` INT_ODD_FORM) + (ASSUME `~(&2 divides m)`)) THEN + DISCH_THEN(X_CHOOSE_TAC `k:int`) THEN + ABBREV_TAC `P = &18 * j * k + &9 * j + &3 * k + &1 - q:int` THEN + SUBGOAL_THEN `q = &8 * P + &1` ASSUME_TAC THENL + [EXPAND_TAC "P" THEN + MP_TAC(ASSUME `&3 * q + &1 = d * m`) THEN + MP_TAC(ASSUME `d = &24 * j + &4`) THEN + MP_TAC(ASSUME `m = &2 * k + &1`) THEN CONV_TAC INT_RING; + ALL_TAC] THEN + ASM_CASES_TAC `&2 divides t` THENL + [X_CHOOSE_TAC `r:int` + (REWRITE_RULE[int_divides] (ASSUME `&2 divides t`)) THEN + SUBGOAL_THEN `&2 divides (r pow 2 + r)` MP_TAC THENL + [MP_TAC(SPEC `--r:int` INT_SQ_SUB_SELF_EVEN) THEN + REWRITE_TAC[INT_RING `(--r) pow 2 - --r = r pow 2 + r`]; + REWRITE_TAC[int_divides]] THEN + DISCH_THEN(X_CHOOSE_TAC `s:int`) THEN + MATCH_MP_TAC(SPECL + [`a:int`; `t:int`; `&3:int`; `q:int`; `&0:int`; `&3 * m:int`; + `&1:int`; `&1:int`; `&0:int`; `&3 * j + P - P * a + s:int`] + TERNARY_TYPE5_OF_CHARACTERISTIC) THEN + REWRITE_TAC + [INT_MUL_LZERO; INT_MUL_RZERO; INT_MUL_LID; INT_MUL_RID; + INT_ADD_LID; INT_ADD_RID] THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[int_divides] THEN EXISTS_TAC `--r:int` THEN + MP_TAC(ASSUME `t = &2 * r`) THEN CONV_TAC INT_RING; + REWRITE_TAC[int_divides] THEN EXISTS_TAC `--r:int` THEN + MP_TAC(ASSUME `t = &2 * r`) THEN CONV_TAC INT_RING; + REWRITE_TAC[int_divides] THEN EXISTS_TAC `&3 * k:int` THEN + MP_TAC(ASSUME `m = &2 * k + &1`) THEN CONV_TAC INT_RING; + REWRITE_TAC[tqeval] THEN + MP_TAC(ASSUME `a * q - t pow 2 = d`) THEN + MP_TAC(ASSUME `d = &24 * j + &4`) THEN + MP_TAC(ASSUME `q = &8 * P + &1`) THEN + MP_TAC(ASSUME `t = &2 * r`) THEN + MP_TAC(ASSUME `r pow 2 + r = &2 * s`) THEN + CONV_TAC INT_RING]; + ALL_TAC] THEN + MP_TAC(MATCH_MP (SPEC `t:int` INT_ODD_FORM) + (ASSUME `~(&2 divides t)`)) THEN + DISCH_THEN(X_CHOOSE_TAC `r:int`) THEN + SUBGOAL_THEN `&2 divides (r pow 2 + r)` MP_TAC THENL + [MP_TAC(SPEC `--r:int` INT_SQ_SUB_SELF_EVEN) THEN + REWRITE_TAC[INT_RING `(--r) pow 2 - --r = r pow 2 + r`]; + REWRITE_TAC[int_divides]] THEN + DISCH_THEN(X_CHOOSE_TAC `s:int`) THEN + MATCH_MP_TAC(SPECL + [`a:int`; `t:int`; `&3:int`; `q:int`; `&0:int`; `&3 * m:int`; + `&1:int`; `&0:int`; `&0:int`; `&3 * j + s - P * a:int`] + TERNARY_TYPE5_OF_CHARACTERISTIC) THEN + REWRITE_TAC + [INT_MUL_LZERO; INT_MUL_RZERO; INT_MUL_LID; INT_MUL_RID; + INT_ADD_LID; INT_ADD_RID] THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[INT_SUB_REFL; INT_DIVIDES_0]; + REWRITE_TAC[int_divides] THEN EXISTS_TAC `&4 * P - r:int` THEN + MP_TAC(ASSUME `q = &8 * P + &1`) THEN + MP_TAC(ASSUME `t = &2 * r + &1`) THEN CONV_TAC INT_RING; + REWRITE_TAC[int_divides] THEN EXISTS_TAC `&3 * k:int` THEN + MP_TAC(ASSUME `m = &2 * k + &1`) THEN CONV_TAC INT_RING; + REWRITE_TAC[tqeval] THEN + MP_TAC(ASSUME `a * q - t pow 2 = d`) THEN + MP_TAC(ASSUME `d = &24 * j + &4`) THEN + MP_TAC(ASSUME `q = &8 * P + &1`) THEN + MP_TAC(ASSUME `t = &2 * r + &1`) THEN + MP_TAC(ASSUME `r pow 2 + r = &2 * s`) THEN + CONV_TAC INT_RING]);; + +let LEMMA_113 = prove + (`!n j t:int. + &1 < n /\ &0 <= j /\ + ((&24 * j + &4) * n - &3) divides + (t pow 2 + (&24 * j + &4)) + ==> ?u v w:int. u pow 2 + v pow 2 + &3 * w pow 2 = n`, + REPEAT STRIP_TAC THEN + ABBREV_TAC `d = &24 * j + &4:int` THEN + ABBREV_TAC `p = d * n - &3:int` THEN + UNDISCH_TAC `p divides (t pow 2 + d)` THEN + REWRITE_TAC[int_divides] THEN + DISCH_THEN(X_CHOOSE_TAC `a:int`) THEN + SUBGOAL_THEN `&0 < d` ASSUME_TAC THENL + [EXPAND_TAC "d" THEN ASM_INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < p` ASSUME_TAC THENL + [EXPAND_TAC "p" THEN + SUBGOAL_THEN `&4 * &2 <= d * n` MP_TAC THENL + [MATCH_MP_TAC INT_LE_MUL2 THEN ASM_INT_ARITH_TAC; + INT_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN `a * p - t pow 2 = d` ASSUME_TAC THENL + [MP_TAC(ASSUME `t pow 2 + d = p * a`) THEN INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < a` ASSUME_TAC THENL + [SUBGOAL_THEN `&0 < a * p` MP_TAC THENL + [SUBGOAL_THEN `a * p = t pow 2 + d` SUBST1_TAC THENL + [ASM_INT_ARITH_TAC; + MP_TAC(ISPEC `t:int` INT_LE_POW_2) THEN ASM_INT_ARITH_TAC]; + ASM_SIMP_TAC[INT_LT_MUL_EQ]]; + ALL_TAC] THEN + MATCH_MP_TAC TERNARY_DISC3_TYPE5 THEN + MAP_EVERY EXISTS_TAC + [`a:int`; `t:int`; `&1:int`; `p:int`; `&0:int`; `n:int`] THEN + REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + MP_TAC(ASSUME `a * p - t pow 2 = d`) THEN ASM_INT_ARITH_TAC; + MP_TAC(ASSUME `a * p - t pow 2 = d`) THEN + MP_TAC(ASSUME `d * n - &3 = p`) THEN CONV_TAC INT_RING; + MATCH_MP_TAC(SPECL + [`a:int`; `p:int`; `t:int`; `d:int`; `n:int`; `j:int`] + TERNARY_TYPE5_MODEL) THEN + ASM_REWRITE_TAC[]; + MAP_EVERY EXISTS_TAC [`&0:int`; `&0:int`; `&1:int`] THEN + CONV_TAC INT_RING]);; + +let LEMMA_113_3 = prove + (`!m j q t:int. + &0 < m /\ + &0 <= j /\ + &3 * q + &1 = (&24 * j + &4) * m /\ + q divides (t pow 2 + (&24 * j + &4)) + ==> ?u v w:int. u pow 2 + v pow 2 + &3 * w pow 2 = &3 * m`, + REPEAT STRIP_TAC THEN + ABBREV_TAC `d = &24 * j + &4:int` THEN + UNDISCH_TAC `q divides (t pow 2 + d)` THEN + REWRITE_TAC[int_divides] THEN + DISCH_THEN(X_CHOOSE_TAC `a:int`) THEN + SUBGOAL_THEN `&0 < d` ASSUME_TAC THENL + [EXPAND_TAC "d" THEN ASM_INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < q` ASSUME_TAC THENL + [SUBGOAL_THEN `&4 * &1 <= d * m` MP_TAC THENL + [MATCH_MP_TAC INT_LE_MUL2 THEN ASM_INT_ARITH_TAC; + MP_TAC(ASSUME `&3 * q + &1 = d * m`) THEN INT_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN `a * q - t pow 2 = d` ASSUME_TAC THENL + [MP_TAC(ASSUME `t pow 2 + d = q * a`) THEN INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < a` ASSUME_TAC THENL + [SUBGOAL_THEN `&0 < a * q` MP_TAC THENL + [SUBGOAL_THEN `a * q = t pow 2 + d` SUBST1_TAC THENL + [ASM_INT_ARITH_TAC; + MP_TAC(ISPEC `t:int` INT_LE_POW_2) THEN ASM_INT_ARITH_TAC]; + ASM_SIMP_TAC[INT_LT_MUL_EQ]]; + ALL_TAC] THEN + MATCH_MP_TAC TERNARY_DISC3_TYPE5 THEN + MAP_EVERY EXISTS_TAC + [`a:int`; `t:int`; `&3:int`; `q:int`; `&0:int`; `&3 * m:int`] THEN + REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + MP_TAC(ASSUME `a * q - t pow 2 = d`) THEN ASM_INT_ARITH_TAC; + MP_TAC(ASSUME `a * q - t pow 2 = d`) THEN + MP_TAC(ASSUME `&3 * q + &1 = d * m`) THEN CONV_TAC INT_RING; + MATCH_MP_TAC(SPECL + [`a:int`; `q:int`; `t:int`; `d:int`; `m:int`; `j:int`] + TERNARY_TYPE5_MODEL_3) THEN + ASM_REWRITE_TAC[]; + MAP_EVERY EXISTS_TAC [`&0:int`; `&0:int`; `&1:int`] THEN + CONV_TAC INT_RING]);; + +(* ------------------------------------------------------------------------- *) +(* The Dirichlet progression used when 3 does not divide the target. *) +(* ------------------------------------------------------------------------- *) + +let COPRIME_A_N = prove + (`!n:num. 1 <= n /\ coprime(3,n) ==> coprime(4*n-3,n)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[COPRIME] THEN X_GEN_TAC `e:num` THEN EQ_TAC THENL + [STRIP_TAC THEN + SUBGOAL_THEN `e divides 4*n` ASSUME_TAC THENL + [MATCH_MP_TAC(SPECL [`e:num`;`n:num`;`4`] DIVIDES_LMUL) THEN + FIRST_X_ASSUM ACCEPT_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `e divides 3` ASSUME_TAC THENL + [SUBGOAL_THEN `3 = 4*n - (4*n-3)` SUBST1_TAC THENL + [ASM_ARITH_TAC; + MATCH_MP_TAC(SPECL [`e:num`;`4*n`;`4*n-3`] DIVIDES_SUB) THEN + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + MP_TAC(SPEC `e:num` + (REWRITE_RULE[COPRIME] (ASSUME `coprime(3,n)`))) THEN + ASM_REWRITE_TAC[]; + DISCH_TAC THEN ASM_REWRITE_TAC[DIVIDES_1]]);; + +let CONG_A_3_TEST = prove + (`!n:num. 1 <= n ==> (4*n-3 == n) (mod 3)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `4*n-3 = (n-1)*3+n` SUBST1_TAC THENL + [ASM_ARITH_TAC; + REWRITE_TAC[CONG] THEN SIMP_TAC[MOD_MULT_ADD]]);; + +let COPRIME_A_24 = prove + (`!n:num. 1 <= n /\ ~(3 divides n) ==> coprime(4*n-3,24)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `ODD(4*n-3)` ASSUME_TAC THENL + [REWRITE_TAC[ODD_EXISTS] THEN EXISTS_TAC `2*n-2` THEN ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `~(3 divides (4*n-3))` ASSUME_TAC THENL + [MP_TAC(MATCH_MP (SPECL [`4*n-3`;`n:num`;`3`] CONG_DIVIDES) + (MATCH_MP (SPEC `n:num` CONG_A_3_TEST) (ASSUME `1 <= n`))) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[ARITH_RULE `24 = 2*2*2*3`; COPRIME_RMUL] THEN + ASM_REWRITE_TAC[CONJUNCT2 COPRIME_2] THEN + ONCE_REWRITE_TAC[COPRIME_SYM] THEN + ASM_REWRITE_TAC[MATCH_MP (SPEC `3` PRIME_COPRIME_EQ) + (EQT_ELIM(PRIME_CONV `prime 3`))]);; + +let COPRIME_DIRICHLET_113 = prove + (`!n:num. 1 <= n /\ ~(3 divides n) + ==> coprime(4*n-3,24*n)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[COPRIME_RMUL] THEN CONJ_TAC THENL + [MATCH_MP_TAC COPRIME_A_24 THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC COPRIME_A_N THEN + ASM_REWRITE_TAC[MATCH_MP (SPEC `3` PRIME_COPRIME_EQ) + (EQT_ELIM(PRIME_CONV `prime 3`))]]);; + +let COPRIME_3_6J1 = prove + (`!j:num. coprime(3,6*j+1)`, + GEN_TAC THEN REWRITE_TAC[COPRIME_BEZOUT] THEN + MAP_EVERY EXISTS_TAC [`1`;`2*j`] THEN DISJ2_TAC THEN ARITH_TAC);; + +let CONG_6J1_3 = NUMBER_RULE + `!j:num. (6*j+1 == 1) (mod 3)`;; + +let CONG_NEG3_6J1 = prove + (`!n j:num. + 1 <= n + ==> (4*n*(6*j+1)-3 == 3*(6*j+1)-3) (mod (6*j+1))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONG_SUB THEN + REPEAT CONJ_TAC THENL + [CONV_TAC NUMBER_RULE; + REWRITE_TAC[CONG_REFL]; + ASM_ARITH_TAC; + ARITH_TAC]);; + +let JACOBI_3_6J1 = prove + (`!j:num. + jacobi(3,6*j+1) = --(&1) pow (((6*j+1)-1) DIV 2)`, + GEN_TAC THEN + SUBGOAL_THEN `ODD(6*j+1)` ASSUME_TAC THENL + [REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH]; + ALL_TAC] THEN + SUBGOAL_THEN `coprime(3,6*j+1)` ASSUME_TAC THENL + [REWRITE_TAC[COPRIME_3_6J1]; + ALL_TAC] THEN + SUBGOAL_THEN `jacobi(6*j+1,3) = &1` ASSUME_TAC THENL + [TRANS_TAC EQ_TRANS `jacobi(1,3)` THEN CONJ_TAC THENL + [MATCH_MP_TAC JACOBI_CONG THEN REWRITE_TAC[CONG_6J1_3]; + REWRITE_TAC[JACOBI_1]]; + ALL_TAC] THEN + MP_TAC(SPECL [`3`;`6*j+1`] JACOBI_RECIPROCITY) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[INT_POW_1; MULT_CLAUSES] THEN DISCH_TAC THEN + MATCH_MP_TAC(INT_RING `s * s = &1 /\ &1 = s * x ==> x = s`) THEN + CONJ_TAC THENL + [REWRITE_TAC + [GSYM INT_POW_ADD; ARITH_RULE `k+k = 2*k`; + INT_POW_NEG; EVEN_MULT; INT_POW_ONE; ARITH]; + ACCEPT_TAC(ASSUME + `&1 = --(&1) pow (((6*j+1)-1) DIV 2) * jacobi(3,6*j+1)`) ]);; + +let JACOBI_NEG3_6J1 = prove + (`!n j:num. + 1 <= n ==> jacobi(4*n*(6*j+1)-3,6*j+1) = &1`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `ODD(6*j+1)` ASSUME_TAC THENL + [REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH]; + ALL_TAC] THEN + TRANS_TAC EQ_TRANS `jacobi(3*(6*j+1)-3,6*j+1)` THEN CONJ_TAC THENL + [MATCH_MP_TAC JACOBI_CONG THEN + MATCH_MP_TAC CONG_NEG3_6J1 THEN ASM_REWRITE_TAC[]; + REWRITE_TAC + [ARITH_RULE `3*h-3 = 3*(h-1)`; JACOBI_LMUL; JACOBI_3_6J1] THEN + ASM_SIMP_TAC[JACOBI_MINUS1] THEN + REWRITE_TAC + [GSYM INT_POW_ADD; ARITH_RULE `k+k = 2*k`; + INT_POW_NEG; EVEN_MULT; INT_POW_ONE; ARITH]]);; + +let DIRICHLET_PRIME_113 = prove + (`!n:num. + 1 <= n /\ ~(3 divides n) + ==> ?p. prime p /\ (p == 4*n-3) (mod (24*n))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC DIRICHLET_PRIME_CONG THEN + ASM_SIMP_TAC[COPRIME_DIRICHLET_113] THEN ASM_ARITH_TAC);; + +let COPRIME_P_H_113 = prove + (`!n j p:num. + 1 <= n /\ p = 4*n*(6*j+1)-3 + ==> coprime(p,6*j+1)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(p == 3*(6*j+1)-3) (mod (6*j+1))` + ASSUME_TAC THENL + [ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC CONG_NEG3_6J1 THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `coprime(6*j+1,3*(6*j+1)-3)` + ASSUME_TAC THENL + [REWRITE_TAC + [ARITH_RULE `3*h-3 = 3*(h-1)`; COPRIME_RMUL] THEN + CONJ_TAC THENL + [ONCE_REWRITE_TAC[COPRIME_SYM] THEN + REWRITE_TAC[COPRIME_3_6J1]; + ONCE_REWRITE_TAC[COPRIME_SYM] THEN + MATCH_MP_TAC COPRIME_MINUS1 THEN ARITH_TAC]; + ALL_TAC] THEN + MATCH_MP_TAC(fst(EQ_IMP_RULE + (SPECL [`6*j+1`;`p:num`] COPRIME_SYM))) THEN + MATCH_MP_TAC(snd(EQ_IMP_RULE + (MATCH_MP + (SPECL [`p:num`;`3*(6*j+1)-3`;`6*j+1`] CONG_COPRIME) + (ASSUME `(p == 3*(6*j+1)-3) (mod (6*j+1))`)))) THEN + ASM_REWRITE_TAC[]);; + +let CONG_P_1MOD4_113 = prove + (`!n j p:num. + 1 <= n /\ p = 4*n*(6*j+1)-3 + ==> (p == 1) (mod 4)`, + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[CONG] THEN + SUBGOAL_THEN + `4*n*(6*j+1)-3 = (n*(6*j+1)-1)*4+1` + SUBST1_TAC THENL + [ASM_ARITH_TAC; + SIMP_TAC[MOD_MULT_ADD] THEN CONV_TAC NUM_REDUCE_CONV]);; + +let QR_113 = prove + (`!n j p:num. + 1 <= n /\ prime p /\ p = 4*n*(6*j+1)-3 + ==> ?t. (t EXP 2 + (24*j+4) == 0) (mod p)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `ODD(6*j+1)` ASSUME_TAC THENL + [REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH]; + ALL_TAC] THEN + SUBGOAL_THEN `coprime(p:num,6*j+1)` ASSUME_TAC THENL + [MATCH_MP_TAC(SPECL [`n:num`;`j:num`;`p:num`] COPRIME_P_H_113) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `(p == 1) (mod 4)` ASSUME_TAC THENL + [MATCH_MP_TAC(SPECL [`n:num`;`j:num`;`p:num`] CONG_P_1MOD4_113) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `jacobi(p,6*j+1) = &1` ASSUME_TAC THENL + [ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(SPECL [`n:num`;`j:num`] JACOBI_NEG3_6J1) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MP_TAC(SPECL [`p:num`;`6*j+1`] QR_MOD_P_1MOD4) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `x:num`) THEN + EXISTS_TAC `2*x` THEN + SUBGOAL_THEN + `(2*x) EXP 2 + 24*j+4 = 4*(x EXP 2 + 6*j+1)` + SUBST1_TAC THENL + [CONV_TAC NUM_RING; + MP_TAC(MATCH_MP + (SPECL + [`4`;`x EXP 2 + 6*j+1`;`0`;`4*n*(6*j+1)-3`] CONG_LMUL) + (ASSUME + `(x EXP 2 + 6*j+1 == 0) (mod (4*n*(6*j+1)-3))`)) THEN + REWRITE_TAC[MULT_CLAUSES]]);; + +let RESIDUE_113 = prove + (`!n:num. + 1 <= n /\ ~(3 divides n) + ==> ?j t. + ((24*j+4)*n-3) divides (t EXP 2 + (24*j+4))`, + REPEAT STRIP_TAC THEN + MP_TAC(SPEC `n:num` DIRICHLET_PRIME_113) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `p:num` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `?j. p = 24*n*j + (4*n-3)` + (X_CHOOSE_TAC `j:num`) THENL + [MP_TAC(SPECL [`24*n`;`4*n-3`;`p:num`] CONG_CASE) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `p = 4*n*(6*j+1)-3` ASSUME_TAC THENL + [UNDISCH_TAC `p = 24*n*j + (4*n-3)` THEN ASM_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(MATCH_MP + (SPECL [`n:num`;`j:num`;`p:num`] QR_113) + (CONJ (ASSUME `1 <= n`) + (CONJ (ASSUME `prime p`) + (ASSUME `p = 4*n*(6*j+1)-3`)))) THEN + DISCH_THEN(X_CHOOSE_TAC `t:num`) THEN + MAP_EVERY EXISTS_TAC [`j:num`;`t:num`] THEN + SUBGOAL_THEN + `p = (24*j+4)*n-3` + (fun th -> REWRITE_TAC[GSYM th]) THENL + [UNDISCH_TAC `p = 24*n*j + (4*n-3)` THEN ASM_ARITH_TAC; + MP_TAC(ASSUME `(t EXP 2 + 24*j+4 == 0) (mod p)`) THEN + REWRITE_TAC[CONG_0_DIVIDES]]);; + +let REGULAR_113_COPRIME3 = prove + (`!n:num. + 1 < n /\ ~(3 divides n) + ==> ?u v w:int. u pow 2 + v pow 2 + &3*w pow 2 = &n`, + REPEAT STRIP_TAC THEN + MP_TAC(SPEC `n:num` RESIDUE_113) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `j:num` (X_CHOOSE_TAC `t:num`)) THEN + MATCH_MP_TAC(SPECL [`&n:int`;`&j:int`;`&t:int`] LEMMA_113) THEN + REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[INT_OF_NUM_LT]; + REWRITE_TAC[INT_POS]; + MP_TAC(ASSUME + `((24*j+4)*n-3) divides (t EXP 2 + (24*j+4))`) THEN + REWRITE_TAC + [num_divides; INT_OF_NUM_ADD; INT_OF_NUM_MUL; INT_OF_NUM_POW] THEN + DISCH_TAC THEN + SUBGOAL_THEN + `&((24*j+4)*n) - &3 = &((24*j+4)*n-3):int` + (fun th -> ONCE_REWRITE_TAC[th] THEN ASM_REWRITE_TAC[]) THEN + MATCH_MP_TAC INT_OF_NUM_SUB THEN ASM_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* The Dirichlet progression used for integers congruent to 3 modulo 9. *) +(* ------------------------------------------------------------------------- *) + +let COPRIME_DIRICHLET_113_3 = prove + (`!k:num. coprime(4*k+1,8*(3*k+1))`, + GEN_TAC THEN + REWRITE_TAC + [ARITH_RULE `8 = 2*2*2`; COPRIME_RMUL; CONJUNCT2 COPRIME_2] THEN + CONJ_TAC THENL + [REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH]; + REWRITE_TAC[COPRIME_BEZOUT] THEN + MAP_EVERY EXISTS_TAC [`4`;`3`] THEN DISJ2_TAC THEN ARITH_TAC]);; + +let DIRICHLET_PRIME_113_3 = prove + (`!k:num. + ?q. prime q /\ (q == 4*k+1) (mod (8*(3*k+1)))`, + GEN_TAC THEN MATCH_MP_TAC DIRICHLET_PRIME_CONG THEN + REWRITE_TAC[COPRIME_DIRICHLET_113_3] THEN ARITH_TAC);; + +let JACOBI_Q_113_3 = prove + (`!m j q:num. + 3*q+1 = 4*(6*j+1)*m + ==> jacobi(q,6*j+1) = &1`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `ODD(6*j+1)` ASSUME_TAC THENL + [REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH]; + ALL_TAC] THEN + SUBGOAL_THEN + `(3*q == (6*j+1)-1) (mod (6*j+1))` + ASSUME_TAC THENL + [REWRITE_TAC[CONG_MINUS1] THEN DISJ2_TAC THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `4*(6*j+1)*m = (6*j+1)*(4*m)` + SUBST1_TAC THENL + [CONV_TAC NUM_RING; + MATCH_MP_TAC DIVIDES_RMUL THEN REWRITE_TAC[DIVIDES_REFL]]; + ALL_TAC] THEN + SUBGOAL_THEN + `jacobi(3*q,6*j+1) = jacobi((6*j+1)-1,6*j+1)` + ASSUME_TAC THENL + [MATCH_MP_TAC JACOBI_CONG THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MP_TAC(ASSUME + `jacobi(3*q,6*j+1) = jacobi((6*j+1)-1,6*j+1)`) THEN + REWRITE_TAC[JACOBI_LMUL; JACOBI_3_6J1] THEN + ASM_SIMP_TAC[JACOBI_MINUS1] THEN DISCH_TAC THEN + MATCH_MP_TAC(SPECL + [`-- &1 pow (((6*j+1)-1) DIV 2)`; `jacobi(q,6*j+1)`] + (INT_RING `!s x:int. s*s = &1 /\ s*x = s ==> x = &1`)) THEN + CONJ_TAC THENL + [REWRITE_TAC + [GSYM INT_POW_ADD; ARITH_RULE `k+k = 2*k`; + INT_POW_NEG; EVEN_MULT; INT_POW_ONE; ARITH]; + ACCEPT_TAC(ASSUME + `-- &1 pow (((6*j+1)-1) DIV 2) * jacobi(q,6*j+1) = + -- &1 pow (((6*j+1)-1) DIV 2)`)]);; + +let QR_113_3 = prove + (`!m j q:num. + prime q /\ + 3*q+1 = 4*(6*j+1)*m /\ + (q == 1) (mod 4) + ==> ?t. (t EXP 2 + (24*j+4) == 0) (mod q)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `ODD(6*j+1)` ASSUME_TAC THENL + [REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH]; + ALL_TAC] THEN + SUBGOAL_THEN `jacobi(q,6*j+1) = &1` ASSUME_TAC THENL + [MATCH_MP_TAC(SPECL [`m:num`;`j:num`;`q:num`] JACOBI_Q_113_3) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `coprime(q,6*j+1)` ASSUME_TAC THENL + [MP_TAC(SPECL [`q:num`;`6*j+1`] JACOBI_EQ_0) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC INT_REDUCE_CONV; + ALL_TAC] THEN + MP_TAC(SPECL [`q:num`;`6*j+1`] QR_MOD_P_1MOD4) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `x:num`) THEN + EXISTS_TAC `2*x` THEN + SUBGOAL_THEN + `(2*x) EXP 2 + 24*j+4 = 4*(x EXP 2 + 6*j+1)` + SUBST1_TAC THENL + [CONV_TAC NUM_RING; + MP_TAC(MATCH_MP + (SPECL [`4`;`x EXP 2 + 6*j+1`;`0`;`q:num`] CONG_LMUL) + (ASSUME `(x EXP 2 + 6*j+1 == 0) (mod q)`)) THEN + REWRITE_TAC[MULT_CLAUSES]]);; + +let RESIDUE_113_3 = prove + (`!k:num. + ?j q t. + 3*q+1 = (24*j+4)*(3*k+1) /\ + q divides (t EXP 2 + (24*j+4))`, + GEN_TAC THEN + MP_TAC(SPEC `k:num` DIRICHLET_PRIME_113_3) THEN + DISCH_THEN(X_CHOOSE_THEN `q:num` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `?j. q = 8*(3*k+1)*j + (4*k+1)` + (X_CHOOSE_TAC `j:num`) THENL + [MP_TAC(SPECL + [`8*(3*k+1)`;`4*k+1`;`q:num`] CONG_CASE) THEN + ANTS_TAC THENL [ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `3*q+1 = (24*j+4)*(3*k+1)` + ASSUME_TAC THENL + [UNDISCH_TAC `q = 8*(3*k+1)*j + (4*k+1)` THEN ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `3*q+1 = 4*(6*j+1)*(3*k+1)` + ASSUME_TAC THENL + [MP_TAC(ASSUME `3*q+1 = (24*j+4)*(3*k+1)`) THEN ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `(q == 1) (mod 4)` ASSUME_TAC THENL + [UNDISCH_TAC `q = 8*(3*k+1)*j + (4*k+1)` THEN + DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC + [CONG; + ARITH_RULE + `8*(3*k+1)*j + (4*k+1) = (2*(3*k+1)*j+k)*4+1`] THEN + SIMP_TAC[MOD_MULT_ADD] THEN CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + MP_TAC(MATCH_MP + (SPECL [`3*k+1`;`j:num`;`q:num`] QR_113_3) + (CONJ (ASSUME `prime q`) + (CONJ (ASSUME `3*q+1 = 4*(6*j+1)*(3*k+1)`) + (ASSUME `(q == 1) (mod 4)`)))) THEN + DISCH_THEN(X_CHOOSE_TAC `t:num`) THEN + MAP_EVERY EXISTS_TAC [`j:num`;`q:num`;`t:num`] THEN + CONJ_TAC THENL + [ACCEPT_TAC(ASSUME `3*q+1 = (24*j+4)*(3*k+1)`); + MP_TAC(ASSUME `(t EXP 2 + 24*j+4 == 0) (mod q)`) THEN + REWRITE_TAC[CONG_0_DIVIDES]]);; + +let REGULAR_113_3MOD9 = prove + (`!k:num. + ?u v w:int. + u pow 2 + v pow 2 + &3*w pow 2 = &3 * &(3*k+1)`, + GEN_TAC THEN + MP_TAC(SPEC `k:num` RESIDUE_113_3) THEN + DISCH_THEN(X_CHOOSE_THEN `j:num` + (X_CHOOSE_THEN `q:num` + (X_CHOOSE_THEN `t:num` STRIP_ASSUME_TAC))) THEN + MATCH_MP_TAC(SPECL + [`&(3*k+1):int`;`&j:int`;`&q:int`;`&t:int`] LEMMA_113_3) THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[INT_OF_NUM_LT] THEN ARITH_TAC; + REWRITE_TAC[INT_POS]; + MP_TAC(AP_TERM `int_of_num` + (ASSUME `3*q+1 = (24*j+4)*(3*k+1)`)) THEN + REWRITE_TAC[INT_OF_NUM_ADD; INT_OF_NUM_MUL]; + MP_TAC(ASSUME `q divides (t EXP 2 + (24*j+4))`) THEN + REWRITE_TAC + [num_divides; INT_OF_NUM_ADD; INT_OF_NUM_MUL; INT_OF_NUM_POW]]);; + +(* ------------------------------------------------------------------------- *) +(* Descent by 9 and the full regularity direction. *) +(* ------------------------------------------------------------------------- *) + +let MOD9_COPRIME3 = prove + (`!n:num. + (n MOD 9 = 1 \/ n MOD 9 = 2 \/ n MOD 9 = 4 \/ + n MOD 9 = 5 \/ n MOD 9 = 7 \/ n MOD 9 = 8) + ==> ~(3 divides n)`, + GEN_TAC THEN REWRITE_TAC[DIVIDES_MOD] THEN + SUBGOAL_THEN `n MOD 3 = n MOD 9 MOD 3` SUBST1_TAC THENL + [REWRITE_TAC[ARITH_RULE `9 = 3*3`; MOD_MOD]; + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV]);; + +let MOD9_3_REP_113 = prove + (`!n:num. + n MOD 9 = 3 + ==> ?u v w:int. u pow 2 + v pow 2 + &3*w pow 2 = &n`, + REPEAT STRIP_TAC THEN + MP_TAC(SPEC `n DIV 9` REGULAR_113_3MOD9) THEN + DISCH_THEN(X_CHOOSE_THEN `u:int` + (X_CHOOSE_THEN `v:int` (X_CHOOSE_TAC `w:int`))) THEN + MAP_EVERY EXISTS_TAC [`u:int`;`v:int`;`w:int`] THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(AP_TERM `int_of_num` + (SPECL [`n:num`;`9`] (CONJUNCT1 DIVISION_SIMP))) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[INT_OF_NUM_EQ]) THEN + ONCE_REWRITE_TAC[GSYM INT_OF_NUM_MUL] THEN + REWRITE_TAC[INT_OF_NUM_EQ] THEN ASM_ARITH_TAC);; + +let MOD9_6_FORM_113 = prove + (`!n:num. + n MOD 9 = 6 + ==> ?a b. n = 9 EXP a * (9*b+6)`, + GEN_TAC THEN DISCH_TAC THEN + MAP_EVERY EXISTS_TAC [`0:num`;`n DIV 9`] THEN + REWRITE_TAC[EXP; MULT_CLAUSES] THEN + MP_TAC(SPECL [`n:num`;`9`] (CONJUNCT1 DIVISION_SIMP)) THEN + ASM_REWRITE_TAC[] THEN ARITH_TAC);; + +let REP_113_MUL9 = prove + (`!n:int. + (?x y z:int. x pow 2 + y pow 2 + &3*z pow 2 = n) + ==> ?x y z:int. x pow 2 + y pow 2 + &3*z pow 2 = &9*n`, + REPEAT STRIP_TAC THEN + MAP_EVERY EXISTS_TAC [`&3*x:int`;`&3*y:int`;`&3*z:int`] THEN + MP_TAC(ASSUME `x pow 2 + y pow 2 + &3*z pow 2 = n`) THEN + CONV_TAC INT_RING);; + +let DESCENT_113_NOT_FORM = prove + (`!n:num. + 9 divides n /\ + ~(?a b. n = 9 EXP a * (9*b+6)) + ==> ~(?a b. n DIV 9 = 9 EXP a * (9*b+6))`, + GEN_TAC THEN STRIP_TAC THEN + REWRITE_TAC[NOT_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:num`;`b:num`] THEN DISCH_TAC THEN + UNDISCH_TAC `~(?a b. n = 9 EXP a * (9*b+6))` THEN + REWRITE_TAC[] THEN + MAP_EVERY EXISTS_TAC [`SUC a`;`b:num`] THEN + REWRITE_TAC[EXP; GSYM MULT_ASSOC] THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + FIRST_ASSUM(MP_TAC o REWRITE_RULE[divides]) THEN + DISCH_THEN(X_CHOOSE_TAC `c:num`) THEN + ASM_REWRITE_TAC[ARITH_RULE `9*c = c*9`; DIV_MULT; ARITH] THEN + SUBGOAL_THEN `(c*9) DIV 9 = c` SUBST1_TAC THENL + [REWRITE_TAC[ARITH_RULE `c*9 = 9*c`] THEN + SIMP_TAC[DIV_MULT; ARITH]; + REFL_TAC]);; + +let DIV9_LESS = prove + (`!n:num. ~(n=0) /\ 9 divides n ==> n DIV 9 < n`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o REWRITE_RULE[divides]) THEN + DISCH_THEN(X_CHOOSE_THEN `c:num` SUBST_ALL_TAC) THEN + SUBGOAL_THEN `(9*c) DIV 9 = c` SUBST1_TAC THENL + [SIMP_TAC[DIV_MULT; ARITH]; + ASM_ARITH_TAC]);; + +let REP_113_DESCEND9 = prove + (`!n:num. + 9 divides n /\ + (?x y z:int. x pow 2 + y pow 2 + &3*z pow 2 = &(n DIV 9)) + ==> ?x y z:int. x pow 2 + y pow 2 + &3*z pow 2 = &n`, + REPEAT STRIP_TAC THEN + MP_TAC(MATCH_MP + (SPEC `&(n DIV 9):int` REP_113_MUL9) + (ASSUME + `?x y z:int. x pow 2 + y pow 2 + &3*z pow 2 = &(n DIV 9)`)) THEN + SUBGOAL_THEN + `&9 * &(n DIV 9) = &n:int` + (fun th -> ASM_REWRITE_TAC[th]) THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `c:num` SUBST1_TAC o + REWRITE_RULE[divides]) THEN + SIMP_TAC[DIV_MULT; ARITH; INT_OF_NUM_MUL]);; + +let REGULAR_113_NOT_FORM = prove + (`!n:num. + ~(?a b. n = 9 EXP a * (9*b+6)) + ==> ?x y z:int. x pow 2 + y pow 2 + &3*z pow 2 = &n`, + MATCH_MP_TAC num_WF THEN + X_GEN_TAC `n:num` THEN STRIP_TAC THEN DISCH_TAC THEN + ASM_CASES_TAC `n = 0` THENL + [MAP_EVERY EXISTS_TAC [`&0:int`;`&0:int`;`&0:int`] THEN + ASM_REWRITE_TAC[] THEN CONV_TAC INT_RING; + ALL_TAC] THEN + ASM_CASES_TAC `n = 1` THENL + [MAP_EVERY EXISTS_TAC [`&1:int`;`&0:int`;`&0:int`] THEN + ASM_REWRITE_TAC[] THEN CONV_TAC INT_RING; + ALL_TAC] THEN + DISJ_CASES_TAC(ARITH_RULE + `(n MOD 9 = 1 \/ n MOD 9 = 2 \/ n MOD 9 = 4 \/ + n MOD 9 = 5 \/ n MOD 9 = 7 \/ n MOD 9 = 8) \/ + n MOD 9 = 3 \/ n MOD 9 = 0 \/ n MOD 9 = 6`) THENL + [MATCH_MP_TAC REGULAR_113_COPRIME3 THEN CONJ_TAC THENL + [ASM_ARITH_TAC; + MATCH_MP_TAC MOD9_COPRIME3 THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + FIRST_X_ASSUM DISJ_CASES_TAC THENL + [MATCH_MP_TAC MOD9_3_REP_113 THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + FIRST_X_ASSUM DISJ_CASES_TAC THENL + [SUBGOAL_THEN `9 divides n` ASSUME_TAC THENL + [REWRITE_TAC[DIVIDES_MOD] THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC REP_113_DESCEND9 THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n DIV 9`) THEN + ANTS_TAC THENL + [MATCH_MP_TAC DIV9_LESS THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + DISCH_THEN MATCH_MP_TAC THEN + MATCH_MP_TAC DESCENT_113_NOT_FORM THEN ASM_REWRITE_TAC[]; + MP_TAC(SPEC `n:num` MOD9_6_FORM_113) THEN ASM_REWRITE_TAC[]]);; + +let iqclear113 = new_definition + `iqclear113 a b q = + iqrows4 + (&1) (&0) (&0) (&0) + (&0) (&1) (&0) (&0) + (&0) (&0) (&1) (&0) + (--a) (--b) (--q) (&1)`;; + +let iqflip113 = new_definition + `iqflip113 = + iqrows4 + (&1) (&0) (&0) (&0) + (&0) (&1) (&0) (&0) + (&0) (&0) (-- &1) (&0) + (&0) (&0) (&0) (&1)`;; + +let IQ_EMBEDS_CLEAR_113 = prove + (`!n A a b q r t. + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) a + (&1) (&0) b (&3) (&3 * q + r) t) A + ==> iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&1) (&0) (&0) (&3) r + (t - a pow 2 - b pow 2 - + &3 * q pow 2 - &2 * q * r)) A`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(ISPECL + [`n:num`; `4`; + `iqgram 4 + (iqmat4 (&1) (&0) (&0) a + (&1) (&0) b (&3) (&3 * q + r) t) + (iqclear113 a b q)`; + `iqmat4 (&1) (&0) (&0) (&0) + (&1) (&0) (&0) (&3) r + (t - a pow 2 - b pow 2 - + &3 * q pow 2 - &2 * q * r)`; + `A:num->num->int`] IQ_EMBEDS_EQ) THEN + CONJ_TAC THENL + [MATCH_MP_TAC IQ_EMBEDS_CONGRUENCE THEN ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC THEN + (SUBGOAL_THEN `i = 0 \/ i = 1 \/ i = 2 \/ i = 3` MP_TAC THENL + [ASM_ARITH_TAC; ALL_TAC]) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + (SUBGOAL_THEN `j = 0 \/ j = 1 \/ j = 2 \/ j = 3` MP_TAC THENL + [ASM_ARITH_TAC; ALL_TAC]) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + ASM_REWRITE_TAC[iqgram; IQBILIN_MAT4; iqclear113; iqrows4; + iqmat4; iqsym] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC INT_RING]);; + +let IQ_EMBEDS_FLIP_113 = prove + (`!n A k. + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&1) (&0) (&0) (&3) (-- &1) k) A + ==> iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&1) (&0) (&0) (&3) (&1) k) A`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(ISPECL + [`n:num`; `4`; + `iqgram 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&1) (&0) (&0) (&3) (-- &1) k) + iqflip113`; + `iqmat4 (&1) (&0) (&0) (&0) + (&1) (&0) (&0) (&3) (&1) k`; + `A:num->num->int`] IQ_EMBEDS_EQ) THEN + CONJ_TAC THENL + [MATCH_MP_TAC IQ_EMBEDS_CONGRUENCE THEN ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC THEN + (SUBGOAL_THEN `i = 0 \/ i = 1 \/ i = 2 \/ i = 3` MP_TAC THENL + [ASM_ARITH_TAC; ALL_TAC]) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + (SUBGOAL_THEN `j = 0 \/ j = 1 \/ j = 2 \/ j = 3` MP_TAC THENL + [ASM_ARITH_TAC; ALL_TAC]) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + ASM_REWRITE_TAC[iqgram; IQBILIN_MAT4; iqflip113; iqrows4; + iqmat4; iqsym] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC INT_RING]);; + +let INT_DIV3_DECOMP = prove + (`!c:int. + ?q r. c = &3 * q + r /\ (r = &0 \/ r = &1 \/ r = &2)`, + GEN_TAC THEN + MAP_EVERY EXISTS_TAC [`c div &3:int`; `c rem &3:int`] THEN + MP_TAC(SPECL [`c:int`; `&3:int`] INT_DIVISION) THEN + CONV_TAC NUM_REDUCE_CONV THEN INT_ARITH_TAC);; + +let INT_3Q2_ADD_2Q_NONNEG = prove + (`!q:int. &0 <= &3 * q pow 2 + &2 * q`, + GEN_TAC THEN + SUBGOAL_THEN `&3 * q pow 2 + &2 * q = q * (&3 * q + &2)` + SUBST1_TAC THENL + [CONV_TAC INT_RING; + ASM_CASES_TAC `&0 <= q` THENL + [MATCH_MP_TAC INT_LE_MUL THEN ASM_INT_ARITH_TAC; + SUBGOAL_THEN + `q * (&3 * q + &2) = (--q) * (--(&3 * q + &2))` + SUBST1_TAC THENL + [CONV_TAC INT_RING; + MATCH_MP_TAC INT_LE_MUL THEN ASM_INT_ARITH_TAC]]]);; + +let INT_3Q2_SUB_2Q_NONNEG = prove + (`!q:int. &0 <= &3 * q pow 2 - &2 * q`, + GEN_TAC THEN + SUBGOAL_THEN `&3 * q pow 2 - &2 * q = q * (&3 * q - &2)` + SUBST1_TAC THENL + [CONV_TAC INT_RING; + ASM_CASES_TAC `&1 <= q` THENL + [MATCH_MP_TAC INT_LE_MUL THEN ASM_INT_ARITH_TAC; + SUBGOAL_THEN + `q * (&3 * q - &2) = (--q) * (--(&3 * q - &2))` + SUBST1_TAC THENL + [CONV_TAC INT_RING; + MATCH_MP_TAC INT_LE_MUL THEN ASM_INT_ARITH_TAC]]]);; + +let IQ_CROSS113_CORNER_LOWER = prove + (`!n A k. + iq_positive n A /\ + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&1) (&0) (&0) (&3) (&1) k) A + ==> &1 <= k`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(MATCH_MP + (ISPECL + [`n:num`; `4`; + `iqmat4 (&1) (&0) (&0) (&0) + (&1) (&0) (&0) (&3) (&1) k`; + `A:num->num->int`] IQ_EMBEDDED_NONNEG) + (CONJ (ASSUME `iq_positive n A`) + (ASSUME + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&1) (&0) (&0) (&3) (&1) k) A`))) THEN + DISCH_THEN(MP_TAC o SPEC + `\i:num. + if i = 2 then &1 else if i = 3 then -- &3 else &0`) THEN + REWRITE_TAC[IQEVAL_MAT4] THEN + CONV_TAC NUM_REDUCE_CONV THEN INT_ARITH_TAC);; + +let IQ_EMBEDS_QUATERNARY_113 = prove + (`!n A. + iq_symmetric n A /\ iq_positive n A /\ + iq_embeds n 3 + (iqmat3 (&1) (&0) (&0) (&1) (&0) (&3)) A /\ + iq_represents n A (&6) + ==> (?k. + &1 <= k /\ k <= &6 /\ + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&1) (&0) (&0) (&3) (&0) k) A) \/ + (?k. + &1 <= k /\ k <= &6 /\ + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&1) (&0) (&0) (&3) (&1) k) A)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(SPECL + [`n:num`; `A:num->num->int`; + `&1:int`; `&0:int`; `&0:int`; `&1:int`; `&0:int`; `&3:int`; + `&6:int`] IQ_ESCALATE_MAT3) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `a:int` + (X_CHOOSE_THEN `b:int` + (X_CHOOSE_THEN `c:int` STRIP_ASSUME_TAC))) THEN + MP_TAC(SPEC `c:int` INT_DIV3_DECOMP) THEN + DISCH_THEN(X_CHOOSE_THEN `q:int` + (X_CHOOSE_THEN `r:int` + (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC))) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THENL + [ABBREV_TAC + `k = &6 - a pow 2 - b pow 2 - + &3 * q pow 2 - &2 * q * &0` THEN + SUBGOAL_THEN + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&1) (&0) (&0) (&3) (&0) k) A` + ASSUME_TAC THENL + [EXPAND_TAC "k" THEN MATCH_MP_TAC IQ_EMBEDS_CLEAR_113 THEN + MATCH_ACCEPT_TAC + (REWRITE_RULE[ASSUME `c = &3 * q + &0`] + (ASSUME + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) a + (&1) (&0) b (&3) c (&6)) A`)); + ALL_TAC] THEN + SUBGOAL_THEN `&0 <= k` ASSUME_TAC THENL + [MP_TAC(MATCH_MP + (ISPECL + [`n:num`; `4`; + `iqmat4 (&1) (&0) (&0) (&0) + (&1) (&0) (&0) (&3) (&0) k`; + `A:num->num->int`] IQ_EMBEDDED_NONNEG) + (CONJ (ASSUME `iq_positive n A`) + (ASSUME + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&1) (&0) (&0) (&3) (&0) k) A`))) THEN + DISCH_THEN(MP_TAC o SPEC + `\i:num. if i = 3 then &1 else &0`) THEN + REWRITE_TAC[IQEVAL_MAT4] THEN + CONV_TAC NUM_REDUCE_CONV THEN INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `k <= &6` ASSUME_TAC THENL + [EXPAND_TAC "k" THEN + MP_TAC(SPEC `a:int` INT_LE_POW_2) THEN + MP_TAC(SPEC `b:int` INT_LE_POW_2) THEN + MP_TAC(SPEC `q:int` INT_LE_POW_2) THEN INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `~(k = &0)` ASSUME_TAC THENL + [DISCH_TAC THEN + SUBGOAL_THEN + `a pow 2 + b pow 2 + &3 * q pow 2 = &6` + ASSUME_TAC THENL + [EXPAND_TAC "k" THEN ASM_INT_ARITH_TAC; + CONTR_TAC + (MP (NOT_ELIM(SPECL [`a:int`; `b:int`; `q:int`] + INT_113_NOT_6)) + (ASSUME `a pow 2 + b pow 2 + &3 * q pow 2 = &6`))]; + ALL_TAC] THEN + SUBGOAL_THEN `&1 <= k` ASSUME_TAC THENL + [MATCH_ACCEPT_TAC + (MP (MP (INT_ARITH + `&0 <= k ==> ~(k = &0) ==> &1 <= k`) + (ASSUME `&0 <= k`)) + (ASSUME `~(k = &0)`)); + ALL_TAC] THEN + DISJ1_TAC THEN EXISTS_TAC `k:int` THEN + CONJ_TAC THENL + [MATCH_ACCEPT_TAC(ASSUME `&1 <= k`); + CONJ_TAC THENL + [MATCH_ACCEPT_TAC(ASSUME `k <= &6`); + MATCH_ACCEPT_TAC + (ASSUME + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&1) (&0) (&0) (&3) (&0) k) A`)]]; + ABBREV_TAC + `k = &6 - a pow 2 - b pow 2 - + &3 * q pow 2 - &2 * q * &1` THEN + SUBGOAL_THEN + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&1) (&0) (&0) (&3) (&1) k) A` + ASSUME_TAC THENL + [EXPAND_TAC "k" THEN MATCH_MP_TAC IQ_EMBEDS_CLEAR_113 THEN + MATCH_ACCEPT_TAC + (REWRITE_RULE[ASSUME `c = &3 * q + &1`] + (ASSUME + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) a + (&1) (&0) b (&3) c (&6)) A`)); + ALL_TAC] THEN + SUBGOAL_THEN `&1 <= k` ASSUME_TAC THENL + [MATCH_MP_TAC(ISPECL + [`n:num`; `A:num->num->int`; `k:int`] + IQ_CROSS113_CORNER_LOWER) THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `k <= &6` ASSUME_TAC THENL + [EXPAND_TAC "k" THEN + MP_TAC(SPEC `a:int` INT_LE_POW_2) THEN + MP_TAC(SPEC `b:int` INT_LE_POW_2) THEN + MP_TAC(SPEC `q:int` INT_3Q2_ADD_2Q_NONNEG) THEN INT_ARITH_TAC; + ALL_TAC] THEN + DISJ2_TAC THEN EXISTS_TAC `k:int` THEN + CONJ_TAC THENL + [MATCH_ACCEPT_TAC(ASSUME `&1 <= k`); + CONJ_TAC THENL + [MATCH_ACCEPT_TAC(ASSUME `k <= &6`); + MATCH_ACCEPT_TAC + (ASSUME + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&1) (&0) (&0) (&3) (&1) k) A`)]]; + ABBREV_TAC + `k = &6 - a pow 2 - b pow 2 - + &3 * (q + &1) pow 2 - &2 * (q + &1) * (-- &1)` THEN + SUBGOAL_THEN + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&1) (&0) (&0) (&3) (-- &1) k) A` + ASSUME_TAC THENL + [EXPAND_TAC "k" THEN MATCH_MP_TAC IQ_EMBEDS_CLEAR_113 THEN + MATCH_ACCEPT_TAC + (REWRITE_RULE + [ASSUME `c = &3 * q + &2`; + INT_RING `&3 * q + &2 = &3 * (q + &1) + -- &1`] + (ASSUME + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) a + (&1) (&0) b (&3) c (&6)) A`)); + ALL_TAC] THEN + SUBGOAL_THEN + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&1) (&0) (&0) (&3) (&1) k) A` + ASSUME_TAC THENL + [MATCH_MP_TAC IQ_EMBEDS_FLIP_113 THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `&1 <= k` ASSUME_TAC THENL + [MATCH_MP_TAC(ISPECL + [`n:num`; `A:num->num->int`; `k:int`] + IQ_CROSS113_CORNER_LOWER) THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `k <= &6` ASSUME_TAC THENL + [EXPAND_TAC "k" THEN + MP_TAC(SPEC `a:int` INT_LE_POW_2) THEN + MP_TAC(SPEC `b:int` INT_LE_POW_2) THEN + MP_TAC(SPEC `q + &1:int` INT_3Q2_SUB_2Q_NONNEG) THEN + INT_ARITH_TAC; + ALL_TAC] THEN + DISJ2_TAC THEN EXISTS_TAC `k:int` THEN + CONJ_TAC THENL + [MATCH_ACCEPT_TAC(ASSUME `&1 <= k`); + CONJ_TAC THENL + [MATCH_ACCEPT_TAC(ASSUME `k <= &6`); + MATCH_ACCEPT_TAC + (ASSUME + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&1) (&0) (&0) (&3) (&1) k) A`)]]]);; + +let IQ_UNIVERSAL_CROSS113_OF_NUM = prove + (`!k:num. + (!n:num. + 0 < n + ==> ?x y z w:int. + x pow 2 + y pow 2 + &3 * z pow 2 + + &2 * z * w + &k * w pow 2 = &n) + ==> iq_universal 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&1) (&0) (&0) (&3) (&1) (&k))`, + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[iq_universal] THEN + X_GEN_TAC `m:int` THEN DISCH_TAC THEN + MP_TAC(EQ_MP (SYM(SPEC `m:int` INT_OF_NUM_EXISTS)) + (MATCH_MP (SPECL [`&0:int`; `m:int`] INT_LT_IMP_LE) + (ASSUME `&0 < m`))) THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` SUBST_ALL_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN + ANTS_TAC THENL + [UNDISCH_TAC `&0 < &n` THEN REWRITE_TAC[INT_OF_NUM_LT]; + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` + (X_CHOOSE_THEN `z:int` (X_CHOOSE_TAC `w:int`)))) THEN + REWRITE_TAC[iq_represents] THEN + EXISTS_TAC + `\i:num. + if i = 0 then (x:int) else if i = 1 then y else + if i = 2 then z else w` THEN + REWRITE_TAC[IQEVAL_MAT4] THEN + CONV_TAC NUM_REDUCE_CONV THEN + FIRST_X_ASSUM(MP_TAC) THEN CONV_TAC INT_RING]);; + +let NUM_AVOIDS_113_OF_MOD9 = prove + (`!n:num. + ~(n MOD 9 = 6) /\ ~(n MOD 9 = 0) + ==> ~(?a b. n = 9 EXP a * (9*b+6))`, + GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[NOT_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:num`; `b:num`] THEN DISCH_TAC THEN + ASM_CASES_TAC `a = 0` THENL + [UNDISCH_TAC `~(n MOD 9 = 6)` THEN + ASM_REWRITE_TAC[EXP; MULT_CLAUSES] THEN + REWRITE_TAC[MOD_MULT_ADD] THEN CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + MP_TAC(SPEC `a:num` num_CASES) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `c:num` SUBST_ALL_TAC) THEN + UNDISCH_TAC `~(n MOD 9 = 0)` THEN + REWRITE_TAC[GSYM DIVIDES_MOD; ASSUME `n = 9 EXP SUC c * (9*b+6)`; + EXP; divides] THEN + EXISTS_TAC `9 EXP c * (9*b+6):num` THEN CONV_TAC NUM_RING);; + +let NUM_AVOIDS_113_MUL9 = prove + (`!n:num. + ~(?a b. n = 9 EXP a * (9*b+6)) + ==> ~(?a b. 9*n = 9 EXP a * (9*b+6))`, + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[NOT_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:num`; `b:num`] THEN DISCH_TAC THEN + ASM_CASES_TAC `a = 0` THENL + [FIRST_X_ASSUM SUBST_ALL_TAC THEN + UNDISCH_TAC `9*n = 9 EXP 0 * (9*b+6)` THEN + REWRITE_TAC[EXP; MULT_CLAUSES] THEN + DISCH_THEN(MP_TAC o AP_TERM `\q:num. q MOD 9`) THEN + REWRITE_TAC[MOD_MULT; MOD_MULT_ADD] THEN CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + MP_TAC(SPEC `a:num` num_CASES) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `c:num` SUBST_ALL_TAC) THEN + UNDISCH_TAC `~(?a b. n = 9 EXP a * (9*b+6))` THEN + REWRITE_TAC[] THEN MAP_EVERY EXISTS_TAC [`c:num`; `b:num`] THEN + UNDISCH_TAC `9*n = 9 EXP SUC c * (9*b+6)` THEN + REWRITE_TAC[EXP; GSYM MULT_ASSOC] THEN ARITH_TAC);; + +let INT_REM_3_CASES = prove + (`!x:int. x rem &3 = &0 \/ x rem &3 = &1 \/ x rem &3 = &2`, + GEN_TAC THEN MP_TAC(SPECL [`x:int`; `&3:int`] INT_DIVISION) THEN + INT_ARITH_TAC);; + +let INT_3_DIVIDES_SUM_SQUARES = prove + (`!x y:int. + &3 divides (x pow 2 + y pow 2) + ==> &3 divides x /\ &3 divides y`, + REPEAT GEN_TAC THEN REWRITE_TAC[GSYM INT_REM_EQ_0] THEN DISCH_TAC THEN + MP_TAC(SPEC `x:int` INT_REM_3_CASES) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THEN + MP_TAC(SPEC `y:int` INT_REM_3_CASES) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THEN + (UNDISCH_TAC `(x pow 2 + y pow 2) rem &3 = &0` THEN + SUBGOAL_THEN + `(x pow 2 + y pow 2) rem &3 = + (((x rem &3) pow 2) rem &3 + + ((y rem &3) pow 2) rem &3) rem &3` + SUBST1_TAC THENL + [CONV_TAC INT_REM_DOWN_CONV THEN REFL_TAC; + ASM_REWRITE_TAC[] THEN CONV_TAC INT_REDUCE_CONV]));; + +let INT_SQUARE_1MOD3_DECOMP = prove + (`!x t:int. + x pow 2 = &3 * t + &1 + ==> ?z. x pow 2 = (&3 * z + &1) pow 2`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`x:int`; `&3:int`] INT_DIVISION) THEN + ANTS_TAC THENL [CONV_TAC INT_REDUCE_CONV; STRIP_TAC] THEN + MP_TAC(SPEC `x:int` INT_REM_3_CASES) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THENL + [SUBGOAL_THEN `&3 divides &1` MP_TAC THENL + [REWRITE_TAC[int_divides] THEN + EXISTS_TAC `&3 * (x div &3) pow 2 - t:int` THEN + MAP_EVERY UNDISCH_TAC + [`x pow 2 = &3 * t + &1`; + `x = x div &3 * &3 + x rem &3`; + `x rem &3 = &0`] THEN + CONV_TAC INT_RING; + REWRITE_TAC[INT_DIVIDES_ONE] THEN CONV_TAC INT_REDUCE_CONV]; + EXISTS_TAC `x div &3:int` THEN + MAP_EVERY UNDISCH_TAC + [`x = x div &3 * &3 + x rem &3`; `x rem &3 = &1`] THEN + CONV_TAC INT_RING; + EXISTS_TAC `--(x div &3) - &1:int` THEN + MAP_EVERY UNDISCH_TAC + [`x = x div &3 * &3 + x rem &3`; `x rem &3 = &2`] THEN + CONV_TAC INT_RING]);; + +let INT_REPR_133_ONE_MOD3_NUM = prove + (`!N:num. + N MOD 3 = 1 + ==> ?Z x y:int. Z pow 2 + &3*x pow 2 + &3*y pow 2 = &N`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(3*N) MOD 9 = 3` ASSUME_TAC THENL + [MP_TAC(MATCH_MP (SPECL [`N:num`; `3`; `1`] NUM_DECOMPOSE_MOD) + (CONJ (ARITH_RULE `~(3 = 0)`) (ASSUME `N MOD 3 = 1`))) THEN + DISCH_THEN(X_CHOOSE_THEN `q:num` SUBST1_TAC) THEN + REWRITE_TAC[ARITH_RULE `3 * (3*q+1) = 9*q+3`; MOD_MULT_ADD] THEN + CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + SUBGOAL_THEN + `~(?a b. 3*N = 9 EXP a * (9*b+6))` + ASSUME_TAC THENL + [MATCH_MP_TAC(SPEC `3*N` NUM_AVOIDS_113_OF_MOD9) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + MP_TAC(MATCH_MP (SPEC `3*N` REGULAR_113_NOT_FORM) + (ASSUME `~(?a b. 3*N = 9 EXP a * (9*b+6))`)) THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` (X_CHOOSE_THEN `Z:int` ASSUME_TAC))) THEN + SUBGOAL_THEN `&3 divides (x pow 2 + y pow 2)` ASSUME_TAC THENL + [REWRITE_TAC[int_divides] THEN + EXISTS_TAC `&N - Z pow 2` THEN + MP_TAC(ASSUME + `x pow 2 + y pow 2 + &3 * Z pow 2 = &(3*N)`) THEN + ONCE_REWRITE_TAC[GSYM INT_OF_NUM_MUL] THEN CONV_TAC INT_RING; + ALL_TAC] THEN + MP_TAC(MATCH_MP (SPECL [`x:int`; `y:int`] + INT_3_DIVIDES_SUM_SQUARES) + (ASSUME `&3 divides (x pow 2 + y pow 2)`)) THEN + REWRITE_TAC[int_divides] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `u:int` ASSUME_TAC) + (X_CHOOSE_THEN `v:int` ASSUME_TAC)) THEN + MAP_EVERY EXISTS_TAC [`Z:int`; `u:int`; `v:int`] THEN + MP_TAC(ASSUME + `x pow 2 + y pow 2 + &3 * Z pow 2 = &(3*N)`) THEN + ONCE_REWRITE_TAC[GSYM INT_OF_NUM_MUL] THEN + MAP_EVERY UNDISCH_TAC [`x = &3 * u`; `y = &3 * v`] THEN + CONV_TAC INT_RING);; + +let INT_UNIVERSAL_CROSS113_NUM = prove + (`!k:num. + 1 <= k /\ k <= 6 + ==> !n:num. + 0 < n + ==> ?x y z w:int. + x pow 2 + y pow 2 + &3*z pow 2 + + &2*z*w + &k*w pow 2 = &n`, + GEN_TAC THEN STRIP_TAC THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + ASM_CASES_TAC `(k:num) <= n` THENL + [SUBGOAL_THEN `(3*(n-k)+1) MOD 3 = 1` ASSUME_TAC THENL + [REWRITE_TAC[MOD_MULT_ADD] THEN CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + MP_TAC(MATCH_MP (SPEC `3*(n-k)+1` INT_REPR_133_ONE_MOD3_NUM) + (ASSUME `(3*(n-k)+1) MOD 3 = 1`)) THEN + DISCH_THEN(X_CHOOSE_THEN `Z:int` + (X_CHOOSE_THEN `x:int` (X_CHOOSE_THEN `y:int` ASSUME_TAC))) THEN + SUBGOAL_THEN + `&(3*(n-k)+1) = &3 * (&n - &k) + &1:int` + ASSUME_TAC THENL + [ASM_SIMP_TAC[INT_OF_NUM_ADD; INT_OF_NUM_MUL; INT_OF_NUM_SUB]; + ALL_TAC] THEN + SUBGOAL_THEN + `Z pow 2 = + &3 * ((&n - &k) - x pow 2 - y pow 2) + &1` + ASSUME_TAC THENL + [MP_TAC(ASSUME + `Z pow 2 + &3*x pow 2 + &3*y pow 2 = &(3*(n-k)+1)`) THEN + ONCE_REWRITE_TAC + [ASSUME `&(3*(n-k)+1) = &3 * (&n - &k) + &1`] THEN + CONV_TAC INT_RING; + ALL_TAC] THEN + MP_TAC(MATCH_MP + (SPECL [`Z:int`; `(&n - &k) - x pow 2 - y pow 2`] + INT_SQUARE_1MOD3_DECOMP) + (ASSUME + `Z pow 2 = + &3 * ((&n - &k) - x pow 2 - y pow 2) + &1`)) THEN + DISCH_THEN(X_CHOOSE_TAC `z:int`) THEN + MAP_EVERY EXISTS_TAC [`x:int`; `y:int`; `z:int`; `&1:int`] THEN + MP_TAC(ASSUME `Z pow 2 = (&3 * z + &1) pow 2`) THEN + MP_TAC(ASSUME + `Z pow 2 = + &3 * ((&n - &k) - x pow 2 - y pow 2) + &1`) THEN + CONV_TAC INT_RING; + SUBGOAL_THEN + `n = 1 \/ n = 2 \/ n = 3 \/ n = 4 \/ n = 5` + ASSUME_TAC THENL + [ASM_ARITH_TAC; + ALL_TAC] THEN + UNDISCH_TAC `n = 1 \/ n = 2 \/ n = 3 \/ n = 4 \/ n = 5` THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THENL + [MAP_EVERY EXISTS_TAC [`&1:int`; `&0:int`; `&0:int`; `&0:int`]; + MAP_EVERY EXISTS_TAC [`&1:int`; `&1:int`; `&0:int`; `&0:int`]; + MAP_EVERY EXISTS_TAC [`&0:int`; `&0:int`; `&1:int`; `&0:int`]; + MAP_EVERY EXISTS_TAC [`&2:int`; `&0:int`; `&0:int`; `&0:int`]; + MAP_EVERY EXISTS_TAC [`&2:int`; `&1:int`; `&0:int`; `&0:int`]] THEN + CONV_TAC INT_REDUCE_CONV]);; + +(* Arithmetic for the diagonal children of <1,1,3>. *) + +let NUM_DIAG113_SHIFT_LT6 = prove + (`!n c:num. + n MOD 9 = 6 /\ 1 <= c /\ c < 6 + ==> 0 < n - c /\ + ~((n - c) MOD 9 = 6) /\ ~((n - c) MOD 9 = 0)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(MATCH_MP (SPECL [`n:num`; `9`; `6`] NUM_DECOMPOSE_MOD) + (CONJ (ARITH_RULE `~(9 = 0)`) (ASSUME `n MOD 9 = 6`))) THEN + DISCH_THEN(X_CHOOSE_THEN `q:num` ASSUME_TAC) THEN + SUBGOAL_THEN `n - c = 9 * q + (6 - c)` SUBST1_TAC THENL + [ASM_ARITH_TAC; + REWRITE_TAC[MOD_MULT_ADD] THEN + SUBGOAL_THEN `(6 - c) MOD 9 = 6 - c` SUBST1_TAC THENL + [MATCH_MP_TAC MOD_LT THEN ASM_ARITH_TAC; + ASM_ARITH_TAC]]);; + +let NUM_113_FORM_SUB2_RESIDUE = prove + (`!q:num. + (?a b. q = 9 EXP a * (9*b+6)) + ==> (q - 2) MOD 9 = 4 \/ (q - 2) MOD 9 = 7`, + GEN_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `a:num` + (X_CHOOSE_THEN `b:num` ASSUME_TAC)) THEN + ASM_CASES_TAC `a = 0` THENL + [SUBGOAL_THEN `q - 2 = 9 * b + 4` SUBST1_TAC THENL + [ASM_REWRITE_TAC[EXP; MULT_CLAUSES] THEN ARITH_TAC; + REWRITE_TAC[MOD_MULT_ADD] THEN CONV_TAC NUM_REDUCE_CONV]; + MP_TAC(SPEC `a:num` num_CASES) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST_ALL_TAC) THEN + MP_TAC(SPECL [`d:num`; `9`] EXP_LT_0) THEN + CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC THEN + SUBGOAL_THEN + `9 EXP SUC d * (9*b+6) - 2 = + 9 * (9 EXP d * (9*b+6) - 1) + 7` + SUBST1_TAC THENL + [REWRITE_TAC[EXP] THEN ASM_ARITH_TAC; + REWRITE_TAC[MOD_MULT_ADD] THEN CONV_TAC NUM_REDUCE_CONV]]);; + +let NUM_113_FORM_SUB2_AVOIDS = prove + (`!q:num. + (?a b. q = 9 EXP a * (9*b+6)) + ==> ~(?a b. 9 * (q - 2) = 9 EXP a * (9*b+6))`, + GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC NUM_AVOIDS_113_MUL9 THEN + MATCH_MP_TAC NUM_AVOIDS_113_OF_MOD9 THEN + MP_TAC(MATCH_MP (SPEC `q:num` NUM_113_FORM_SUB2_RESIDUE) + (ASSUME `?a b. q = 9 EXP a * (9*b+6)`)) THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV);; + +let INT_UNIVERSAL_DIAG113_NUM = prove + (`!c:num. + 1 <= c /\ c <= 6 + ==> !n:num. + 0 < n + ==> ?x y z w:int. + x pow 2 + y pow 2 + &3*z pow 2 + &c*w pow 2 = &n`, + GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN + DISCH_TAC THEN DISCH_TAC THEN + ASM_CASES_TAC `n MOD 9 = 0` THENL + [SUBGOAL_THEN `n = 9 * (n DIV 9)` ASSUME_TAC THENL + [MP_TAC(SPECL [`n:num`; `9`] DIVISION) THEN + CONV_TAC NUM_REDUCE_CONV THEN + ASM_REWRITE_TAC[ADD_CLAUSES] THEN ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `n DIV 9 < n /\ 0 < n DIV 9` STRIP_ASSUME_TAC THENL + [MP_TAC(SPECL [`n:num`; `9`] DIVISION) THEN + CONV_TAC NUM_REDUCE_CONV THEN + ASM_REWRITE_TAC[ADD_CLAUSES] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(MATCH_MP + (MATCH_MP + (SPEC `n DIV 9` (ASSUME + `!m. m < n + ==> 0 < m + ==> ?x y z w:int. + x pow 2 + y pow 2 + &3*z pow 2 + + &c*w pow 2 = &m`)) + (ASSUME `n DIV 9 < n`)) + (ASSUME `0 < n DIV 9`)) THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` + (X_CHOOSE_THEN `z:int` (X_CHOOSE_TAC `w:int`)))) THEN + MAP_EVERY EXISTS_TAC + [`&3*x:int`; `&3*y:int`; `&3*z:int`; `&3*w:int`] THEN + SUBGOAL_THEN `&n = &9 * &(n DIV 9):int` ASSUME_TAC THENL + [MP_TAC(AP_TERM `\r:num. &r:int` + (ASSUME `n = 9 * (n DIV 9)`)) THEN + REWRITE_TAC[INT_OF_NUM_MUL]; + ALL_TAC] THEN + ONCE_REWRITE_TAC[ASSUME `&n = &9 * &(n DIV 9)`] THEN + MP_TAC(ASSUME + `x pow 2 + y pow 2 + &3*z pow 2 + &c*w pow 2 = + &(n DIV 9)`) THEN + CONV_TAC INT_RING; + ALL_TAC] THEN + ASM_CASES_TAC `n MOD 9 = 6` THENL + [ASM_CASES_TAC `c < 6` THENL + [MP_TAC(MATCH_MP (SPECL [`n:num`; `c:num`] + NUM_DIAG113_SHIFT_LT6) + (CONJ (ASSUME `n MOD 9 = 6`) + (CONJ (ASSUME `1 <= c`) (ASSUME `c < 6`)))) THEN + STRIP_TAC THEN + MP_TAC(MATCH_MP (SPEC `n-c:num` REGULAR_113_NOT_FORM) + (MATCH_MP (SPEC `n-c:num` NUM_AVOIDS_113_OF_MOD9) + (CONJ (ASSUME `~((n - c) MOD 9 = 6)`) + (ASSUME `~((n - c) MOD 9 = 0)`)))) THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` (X_CHOOSE_TAC `z:int`))) THEN + MAP_EVERY EXISTS_TAC [`x:int`; `y:int`; `z:int`; `&1:int`] THEN + SUBGOAL_THEN `&(n-c) = &n - &c:int` ASSUME_TAC THENL + [MATCH_MP_TAC EQ_SYM THEN MATCH_MP_TAC INT_OF_NUM_SUB THEN + ASM_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(ASSUME + `x pow 2 + y pow 2 + &3*z pow 2 = &(n-c)`) THEN + ONCE_REWRITE_TAC[ASSUME `&(n-c) = &n - &c`] THEN + CONV_TAC INT_RING; + ALL_TAC] THEN + SUBGOAL_THEN `c = 6` SUBST_ALL_TAC THENL + [ASM_ARITH_TAC; + ALL_TAC] THEN + ASM_CASES_TAC `n = 6` THENL + [MAP_EVERY EXISTS_TAC [`&0:int`; `&0:int`; `&0:int`; `&1:int`] THEN + ASM_REWRITE_TAC[] THEN CONV_TAC INT_REDUCE_CONV; + ALL_TAC] THEN + MP_TAC(MATCH_MP (SPECL [`n:num`; `9`; `6`] NUM_DECOMPOSE_MOD) + (CONJ (ARITH_RULE `~(9 = 0)`) (ASSUME `n MOD 9 = 6`))) THEN + DISCH_THEN(X_CHOOSE_THEN `q:num` ASSUME_TAC) THEN + SUBGOAL_THEN `0 < q` ASSUME_TAC THENL + [ASM_ARITH_TAC; + ALL_TAC] THEN + ASM_CASES_TAC `?a b. q = 9 EXP a * (9*b+6)` THENL + [SUBGOAL_THEN `6 <= q` ASSUME_TAC THENL + [MP_TAC(ASSUME `?a b. q = 9 EXP a * (9*b+6)`) THEN + DISCH_THEN(X_CHOOSE_THEN `a:num` + (X_CHOOSE_THEN `b:num` ASSUME_TAC)) THEN + MP_TAC(SPECL [`a:num`; `9`] EXP_LT_0) THEN + CONV_TAC NUM_REDUCE_CONV THEN DISCH_TAC THEN + SUBST1_TAC(ASSUME `q = 9 EXP a * (9*b+6)`) THEN + MATCH_MP_TAC(ARITH_RULE + `1 * 6 <= e * t ==> 6 <= e * t`) THEN + MATCH_MP_TAC LE_MULT2 THEN ASM_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(MATCH_MP (SPEC `9*(q-2)` REGULAR_113_NOT_FORM) + (MATCH_MP (SPEC `q:num` NUM_113_FORM_SUB2_AVOIDS) + (ASSUME `?a b. q = 9 EXP a * (9*b+6)`))) THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` (X_CHOOSE_TAC `z:int`))) THEN + MAP_EVERY EXISTS_TAC [`x:int`; `y:int`; `z:int`; `&2:int`] THEN + SUBGOAL_THEN `&(q-2) = &q - &2:int` ASSUME_TAC THENL + [MATCH_MP_TAC EQ_SYM THEN MATCH_MP_TAC INT_OF_NUM_SUB THEN + ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `&n = &9 * &q + &6:int` ASSUME_TAC THENL + [MP_TAC(AP_TERM `\r:num. &r:int` (ASSUME `n = 9*q+6`)) THEN + REWRITE_TAC[INT_OF_NUM_ADD; INT_OF_NUM_MUL]; + ALL_TAC] THEN + ONCE_REWRITE_TAC[ASSUME `&n = &9 * &q + &6`] THEN + MP_TAC(ASSUME + `x pow 2 + y pow 2 + &3*z pow 2 = &(9*(q-2))`) THEN + REWRITE_TAC[GSYM INT_OF_NUM_MUL] THEN + ONCE_REWRITE_TAC[ASSUME `&(q-2) = &q - &2`] THEN + CONV_TAC INT_RING; + MP_TAC(MATCH_MP (SPEC `9*q` REGULAR_113_NOT_FORM) + (MATCH_MP (SPEC `q:num` NUM_AVOIDS_113_MUL9) + (ASSUME `~(?a b. q = 9 EXP a * (9*b+6))`))) THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` (X_CHOOSE_TAC `z:int`))) THEN + MAP_EVERY EXISTS_TAC [`x:int`; `y:int`; `z:int`; `&1:int`] THEN + SUBGOAL_THEN `&n = &9 * &q + &6:int` ASSUME_TAC THENL + [MP_TAC(AP_TERM `\r:num. &r:int` (ASSUME `n = 9*q+6`)) THEN + REWRITE_TAC[INT_OF_NUM_ADD; INT_OF_NUM_MUL]; + ALL_TAC] THEN + ONCE_REWRITE_TAC[ASSUME `&n = &9 * &q + &6`] THEN + MP_TAC(ASSUME + `x pow 2 + y pow 2 + &3*z pow 2 = &(9*q)`) THEN + REWRITE_TAC[GSYM INT_OF_NUM_MUL] THEN CONV_TAC INT_RING]; + MP_TAC(MATCH_MP (SPEC `n:num` REGULAR_113_NOT_FORM) + (MATCH_MP (SPEC `n:num` NUM_AVOIDS_113_OF_MOD9) + (CONJ (ASSUME `~(n MOD 9 = 6)`) + (ASSUME `~(n MOD 9 = 0)`)))) THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` (X_CHOOSE_TAC `z:int`))) THEN + MAP_EVERY EXISTS_TAC [`x:int`; `y:int`; `z:int`; `&0:int`] THEN + MP_TAC(ASSUME `x pow 2 + y pow 2 + &3*z pow 2 = &n`) THEN + CONV_TAC INT_RING]);; + +(* Matrix-level universality and closure of the <1,1,3> node. *) + +let IQ_UNIVERSAL_CROSS113_NUM = prove + (`!k:num. + 1 <= k /\ k <= 6 + ==> iq_universal 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&1) (&0) (&0) (&3) (&1) (&k))`, + GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(SPEC `k:num` IQ_UNIVERSAL_CROSS113_OF_NUM) THEN + MATCH_MP_TAC(SPEC `k:num` INT_UNIVERSAL_CROSS113_NUM) THEN + ASM_REWRITE_TAC[]);; + +let IQ_UNIVERSAL_DIAG113_NUM = prove + (`!c:num. + 1 <= c /\ c <= 6 + ==> iq_universal 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&1) (&0) (&0) (&3) (&0) (&c))`, + GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC + (SPECL [`&1:int`; `&1:int`; `&3:int`; `&c:int`] + IQ_UNIVERSAL_MAT4_DIAG) THEN + MATCH_MP_TAC + (SPECL [`&1:int`; `&1:int`; `&3:int`; `&c:int`] + IQ_UNIVERSAL_DIAG4_OF_NUM) THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN + MP_TAC(MATCH_MP + (MATCH_MP (SPEC `c:num` INT_UNIVERSAL_DIAG113_NUM) + (ASSUME `1 <= c /\ c <= 6`)) + (ASSUME `0 < n`)) THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` + (X_CHOOSE_THEN `z:int` (X_CHOOSE_TAC `w:int`)))) THEN + MAP_EVERY EXISTS_TAC [`x:int`; `y:int`; `z:int`; `w:int`] THEN + FIRST_X_ASSUM(MP_TAC) THEN CONV_TAC INT_RING);; + +let IQ_UNIVERSAL_OF_DIAG113_CHILD = prove + (`!n A k. + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&1) (&0) (&0) (&3) (&0) k) A /\ + &1 <= k /\ k <= &6 + ==> iq_universal n A`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(EQ_MP (SYM(SPEC `k:int` INT_OF_NUM_EXISTS)) + (MATCH_MP (INT_ARITH `&1 <= k ==> &0 <= k`) + (ASSUME `&1 <= k`))) THEN + DISCH_THEN(X_CHOOSE_THEN `c:num` SUBST_ALL_TAC) THEN + SUBGOAL_THEN `1 <= c /\ c <= 6` ASSUME_TAC THENL + [UNDISCH_TAC `&1 <= &c` THEN + UNDISCH_TAC `&c <= &6` THEN + REWRITE_TAC[INT_OF_NUM_LE] THEN ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(ISPECL + [`n:num`; `4`; + `iqmat4 (&1) (&0) (&0) (&0) + (&1) (&0) (&0) (&3) (&0) (&c)`; + `A:num->num->int`] IQ_UNIVERSAL_OF_EMBEDS) THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + MATCH_MP_TAC(SPEC `c:num` IQ_UNIVERSAL_DIAG113_NUM) THEN + ASM_REWRITE_TAC[]]);; + +let IQ_UNIVERSAL_OF_CROSS113_CHILD = prove + (`!n A k. + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&1) (&0) (&0) (&3) (&1) k) A /\ + &1 <= k /\ k <= &6 + ==> iq_universal n A`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(EQ_MP (SYM(SPEC `k:int` INT_OF_NUM_EXISTS)) + (MATCH_MP (INT_ARITH `&1 <= k ==> &0 <= k`) + (ASSUME `&1 <= k`))) THEN + DISCH_THEN(X_CHOOSE_THEN `c:num` SUBST_ALL_TAC) THEN + SUBGOAL_THEN `1 <= c /\ c <= 6` ASSUME_TAC THENL + [UNDISCH_TAC `&1 <= &c` THEN + UNDISCH_TAC `&c <= &6` THEN + REWRITE_TAC[INT_OF_NUM_LE] THEN ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(ISPECL + [`n:num`; `4`; + `iqmat4 (&1) (&0) (&0) (&0) + (&1) (&0) (&0) (&3) (&1) (&c)`; + `A:num->num->int`] IQ_UNIVERSAL_OF_EMBEDS) THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + MATCH_MP_TAC(SPEC `c:num` IQ_UNIVERSAL_CROSS113_NUM) THEN + ASM_REWRITE_TAC[]]);; + +let IQ_UNIVERSAL_OF_EMBEDS_113 = prove + (`!n A. + iq_symmetric n A /\ iq_positive n A /\ + iq_embeds n 3 + (iqmat3 (&1) (&0) (&0) (&1) (&0) (&3)) A /\ + iq_represents n A (&6) + ==> iq_universal n A`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(SPECL [`n:num`; `A:num->num->int`] + IQ_EMBEDS_QUATERNARY_113) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(DISJ_CASES_THEN + (X_CHOOSE_THEN `k:int` STRIP_ASSUME_TAC)) THENL + [MATCH_MP_TAC(ISPECL [`n:num`; `A:num->num->int`; `k:int`] + IQ_UNIVERSAL_OF_DIAG113_CHILD) THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC(ISPECL [`n:num`; `A:num->num->int`; `k:int`] + IQ_UNIVERSAL_OF_CROSS113_CHILD) THEN + ASM_REWRITE_TAC[]]);; + +let INT_REPR123_OF_PATTERN = prove + (`!m A B C:int. + A pow 2 + B pow 2 + C pow 2 = &6 * m /\ + &6 divides (B - A) /\ &6 divides (A + B - C) + ==> ?x y z:int. x pow 2 + &2*y pow 2 + &3*z pow 2 = m`, + REPEAT GEN_TAC THEN + REWRITE_TAC[int_divides] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 + (X_CHOOSE_THEN `z:int` ASSUME_TAC) + (X_CHOOSE_THEN `w:int` ASSUME_TAC))) THEN + MAP_EVERY EXISTS_TAC [`A + &3*z - &2*w:int`; `w:int`; `z:int`] THEN + MATCH_MP_TAC(INT_RING `&6 * r = &6 * m ==> r = m`) THEN + MAP_EVERY UNDISCH_TAC + [`A pow 2 + B pow 2 + C pow 2 = &6 * m`; + `B - A = &6 * z`; `A + B - C = &6 * w`] THEN + CONV_TAC INT_RING);; + +let INT_SIGN_MOD3_1 = prove + (`!v:int. + ~(&3 divides v) + ==> ?w. (w = v \/ w = --v) /\ w rem &3 = &1`, + GEN_TAC THEN REWRITE_TAC[GSYM INT_REM_EQ_0] THEN DISCH_TAC THEN + MP_TAC(SPEC `v:int` INT_REM_3_CASES) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THENL + [ASM_MESON_TAC[]; + EXISTS_TAC `v:int` THEN ASM_REWRITE_TAC[]; + EXISTS_TAC `--v:int` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[INT_REM_LNEG] THEN ASM_REWRITE_TAC[] THEN + CONV_TAC INT_REDUCE_CONV]);; + +let INT_SIGN_MOD3_2 = prove + (`!v:int. + ~(&3 divides v) + ==> ?w. (w = v \/ w = --v) /\ w rem &3 = &2`, + GEN_TAC THEN REWRITE_TAC[GSYM INT_REM_EQ_0] THEN DISCH_TAC THEN + MP_TAC(SPEC `v:int` INT_REM_3_CASES) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THENL + [ASM_MESON_TAC[]; + EXISTS_TAC `--v:int` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[INT_REM_LNEG] THEN ASM_REWRITE_TAC[] THEN + CONV_TAC INT_REDUCE_CONV; + EXISTS_TAC `v:int` THEN ASM_REWRITE_TAC[]]);; + +let INT_DIVIDES_SQUARE = prove + (`!d x:int. d divides x ==> d divides x pow 2`, + REPEAT STRIP_TAC THEN REWRITE_TAC[INT_POW_2] THEN + MATCH_MP_TAC INT_DIVIDES_RMUL THEN ASM_REWRITE_TAC[]);; + +let INT_3_DIVIDES_SUM_THREE_SQUARES = prove + (`!a b c:int. + &3 divides (a pow 2 + b pow 2 + c pow 2) + ==> (&3 divides a /\ &3 divides b /\ &3 divides c) \/ + (~(&3 divides a) /\ ~(&3 divides b) /\ ~(&3 divides c))`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + ASM_CASES_TAC `&3 divides a` THENL + [DISJ1_TAC THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `&3 divides (b pow 2 + c pow 2)` ASSUME_TAC THENL + [MP_TAC(MATCH_MP (SPECL [`&3:int`; `a:int`] INT_DIVIDES_SQUARE) + (ASSUME `&3 divides a`)) THEN + REWRITE_TAC[int_divides] THEN + UNDISCH_TAC `&3 divides (a pow 2 + b pow 2 + c pow 2)` THEN + REWRITE_TAC[int_divides] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[int_divides] THEN + EXISTS_TAC `x - x':int` THEN ASM_INT_ARITH_TAC; + MP_TAC(MATCH_MP (SPECL [`b:int`; `c:int`] + INT_3_DIVIDES_SUM_SQUARES) + (ASSUME `&3 divides (b pow 2 + c pow 2)`)) THEN + MESON_TAC[]]; + DISJ2_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [DISCH_TAC THEN + SUBGOAL_THEN `&3 divides (a pow 2 + c pow 2)` ASSUME_TAC THENL + [MP_TAC(MATCH_MP (SPECL [`&3:int`; `b:int`] INT_DIVIDES_SQUARE) + (ASSUME `&3 divides b`)) THEN + REWRITE_TAC[int_divides] THEN + UNDISCH_TAC `&3 divides (a pow 2 + b pow 2 + c pow 2)` THEN + REWRITE_TAC[int_divides] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[int_divides] THEN + EXISTS_TAC `x - x':int` THEN ASM_INT_ARITH_TAC; + MP_TAC(MATCH_MP (SPECL [`a:int`; `c:int`] + INT_3_DIVIDES_SUM_SQUARES) + (ASSUME `&3 divides (a pow 2 + c pow 2)`)) THEN + ASM_MESON_TAC[]]; + DISCH_TAC THEN + SUBGOAL_THEN `&3 divides (a pow 2 + b pow 2)` ASSUME_TAC THENL + [MP_TAC(MATCH_MP (SPECL [`&3:int`; `c:int`] INT_DIVIDES_SQUARE) + (ASSUME `&3 divides c`)) THEN + REWRITE_TAC[int_divides] THEN + UNDISCH_TAC `&3 divides (a pow 2 + b pow 2 + c pow 2)` THEN + REWRITE_TAC[int_divides] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[int_divides] THEN + EXISTS_TAC `x - x':int` THEN ASM_INT_ARITH_TAC; + MP_TAC(MATCH_MP (SPECL [`a:int`; `b:int`] + INT_3_DIVIDES_SUM_SQUARES) + (ASSUME `&3 divides (a pow 2 + b pow 2)`)) THEN + ASM_MESON_TAC[]]]]);; + +let INT_COPRIME_3_2 = prove + (`coprime(&3:int,&2)`, + REWRITE_TAC[INT_COPRIME_BEZOUT] THEN + MAP_EVERY EXISTS_TAC [`&1:int`; `-- &1:int`] THEN + CONV_TAC INT_REDUCE_CONV);; + +let INT_6_DIVIDES_OF_2_3 = prove + (`!d:int. &2 divides d /\ &3 divides d ==> &6 divides d`, + GEN_TAC THEN + REWRITE_TAC[int_divides] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `u:int` ASSUME_TAC) + (X_CHOOSE_THEN `v:int` ASSUME_TAC)) THEN + SUBGOAL_THEN `&3 divides u` MP_TAC THENL + [MATCH_MP_TAC(SPECL [`&3:int`; `&2:int`; `u:int`] + INT_COPRIME_DIVPROD) THEN + CONJ_TAC THENL + [REWRITE_TAC[int_divides] THEN EXISTS_TAC `v:int` THEN + ASM_INT_ARITH_TAC; + ACCEPT_TAC INT_COPRIME_3_2]; + REWRITE_TAC[int_divides] THEN + DISCH_THEN(X_CHOOSE_THEN `t:int` ASSUME_TAC) THEN + EXISTS_TAC `t:int` THEN ASM_INT_ARITH_TAC]);; + +let INT_NEG_REM2 = prove + (`!v:int. (--v) rem &2 = v rem &2`, + GEN_TAC THEN REWRITE_TAC[INT_REM_EQ; int_congruent] THEN + EXISTS_TAC `--v:int` THEN CONV_TAC INT_RING);; + +let INT_DIVIDES_SUB_OF_REM_EQ = prove + (`!a b p:int. a rem p = b rem p ==> p divides (a - b)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[INT_REM_EQ; int_congruent; int_divides]);; + +let INT_PATTERN123_OF_SLOTS = prove + (`!m p q r:int. + p pow 2 + q pow 2 + r pow 2 = &6 * m /\ + p rem &2 = q rem &2 /\ r rem &2 = &0 /\ + ~(&3 divides p) /\ ~(&3 divides q) /\ ~(&3 divides r) + ==> ?A B C:int. + A pow 2 + B pow 2 + C pow 2 = &6 * m /\ + &6 divides (B - A) /\ &6 divides (A + B - C)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(MATCH_MP (SPEC `p:int` INT_SIGN_MOD3_1) + (ASSUME `~(&3 divides p)`)) THEN + DISCH_THEN(X_CHOOSE_THEN `A:int` + (CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC)) THEN + MP_TAC(MATCH_MP (SPEC `q:int` INT_SIGN_MOD3_1) + (ASSUME `~(&3 divides q)`)) THEN + DISCH_THEN(X_CHOOSE_THEN `B:int` + (CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC)) THEN + MP_TAC(MATCH_MP (SPEC `r:int` INT_SIGN_MOD3_2) + (ASSUME `~(&3 divides r)`)) THEN + DISCH_THEN(X_CHOOSE_THEN `C:int` + (CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC)) THEN + SUBGOAL_THEN `A pow 2 = p pow 2` ASSUME_TAC THENL + [UNDISCH_TAC `A = p \/ A = --p` THEN + DISCH_THEN(DISJ_CASES_THEN SUBST_ALL_TAC) THEN CONV_TAC INT_RING; + ALL_TAC] THEN + SUBGOAL_THEN `B pow 2 = q pow 2` ASSUME_TAC THENL + [UNDISCH_TAC `B = q \/ B = --q` THEN + DISCH_THEN(DISJ_CASES_THEN SUBST_ALL_TAC) THEN CONV_TAC INT_RING; + ALL_TAC] THEN + SUBGOAL_THEN `C pow 2 = r pow 2` ASSUME_TAC THENL + [UNDISCH_TAC `C = r \/ C = --r` THEN + DISCH_THEN(DISJ_CASES_THEN SUBST_ALL_TAC) THEN CONV_TAC INT_RING; + ALL_TAC] THEN + SUBGOAL_THEN `A rem &2 = p rem &2` ASSUME_TAC THENL + [UNDISCH_TAC `A = p \/ A = --p` THEN + DISCH_THEN(DISJ_CASES_THEN SUBST_ALL_TAC) THEN + ASM_REWRITE_TAC[INT_NEG_REM2]; + ALL_TAC] THEN + SUBGOAL_THEN `B rem &2 = q rem &2` ASSUME_TAC THENL + [UNDISCH_TAC `B = q \/ B = --q` THEN + DISCH_THEN(DISJ_CASES_THEN SUBST_ALL_TAC) THEN + ASM_REWRITE_TAC[INT_NEG_REM2]; + ALL_TAC] THEN + SUBGOAL_THEN `C rem &2 = r rem &2` ASSUME_TAC THENL + [UNDISCH_TAC `C = r \/ C = --r` THEN + DISCH_THEN(DISJ_CASES_THEN SUBST_ALL_TAC) THEN + ASM_REWRITE_TAC[INT_NEG_REM2]; + ALL_TAC] THEN + MAP_EVERY EXISTS_TAC [`A:int`; `B:int`; `C:int`] THEN + CONJ_TAC THENL + [MAP_EVERY UNDISCH_TAC + [`p pow 2 + q pow 2 + r pow 2 = &6 * m`; + `A pow 2 = p pow 2`; `B pow 2 = q pow 2`; + `C pow 2 = r pow 2`] THEN + CONV_TAC INT_RING; + ALL_TAC] THEN + SUBGOAL_THEN `&2 divides (B - A)` ASSUME_TAC THENL + [MATCH_MP_TAC(SPECL [`B:int`; `A:int`; `&2:int`] + INT_DIVIDES_SUB_OF_REM_EQ) THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `&3 divides (B - A)` ASSUME_TAC THENL + [MATCH_MP_TAC(SPECL [`B:int`; `A:int`; `&3:int`] + INT_DIVIDES_SUB_OF_REM_EQ) THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC(SPEC `B - A:int` INT_6_DIVIDES_OF_2_3) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `&2 divides C` ASSUME_TAC THENL + [REWRITE_TAC[GSYM INT_REM_EQ_0] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `&2 divides (A + B - C)` ASSUME_TAC THENL + [MP_TAC(REWRITE_RULE[int_divides] + (ASSUME `&2 divides (B - A)`)) THEN + DISCH_THEN(X_CHOOSE_THEN `u:int` ASSUME_TAC) THEN + MP_TAC(REWRITE_RULE[int_divides] + (ASSUME `&2 divides C`)) THEN + DISCH_THEN(X_CHOOSE_THEN `v:int` ASSUME_TAC) THEN + REWRITE_TAC[int_divides] THEN EXISTS_TAC `A + u - v:int` THEN + MAP_EVERY UNDISCH_TAC + [`B - A = &2*u`; `C = &2*v`] THEN INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `&3 divides (A - &1)` ASSUME_TAC THENL + [MATCH_MP_TAC(SPECL [`A:int`; `&1:int`; `&3:int`] + INT_DIVIDES_SUB_OF_REM_EQ) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC INT_REDUCE_CONV; + ALL_TAC] THEN + SUBGOAL_THEN `&3 divides (B - &1)` ASSUME_TAC THENL + [MATCH_MP_TAC(SPECL [`B:int`; `&1:int`; `&3:int`] + INT_DIVIDES_SUB_OF_REM_EQ) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC INT_REDUCE_CONV; + ALL_TAC] THEN + SUBGOAL_THEN `&3 divides (C - &2)` ASSUME_TAC THENL + [MATCH_MP_TAC(SPECL [`C:int`; `&2:int`; `&3:int`] + INT_DIVIDES_SUB_OF_REM_EQ) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC INT_REDUCE_CONV; + ALL_TAC] THEN + SUBGOAL_THEN `&3 divides (A + B - C)` ASSUME_TAC THENL + [MP_TAC(REWRITE_RULE[int_divides] + (ASSUME `&3 divides (A - &1)`)) THEN + DISCH_THEN(X_CHOOSE_THEN `a:int` ASSUME_TAC) THEN + MP_TAC(REWRITE_RULE[int_divides] + (ASSUME `&3 divides (B - &1)`)) THEN + DISCH_THEN(X_CHOOSE_THEN `b:int` ASSUME_TAC) THEN + MP_TAC(REWRITE_RULE[int_divides] + (ASSUME `&3 divides (C - &2)`)) THEN + DISCH_THEN(X_CHOOSE_THEN `c:int` ASSUME_TAC) THEN + REWRITE_TAC[int_divides] THEN EXISTS_TAC `a + b - c:int` THEN + MAP_EVERY UNDISCH_TAC + [`A - &1 = &3*a`; `B - &1 = &3*b`; `C - &2 = &3*c`] THEN + INT_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(SPEC `A + B - C:int` INT_6_DIVIDES_OF_2_3) THEN + ASM_REWRITE_TAC[]);; + +let INT_COPRIME3_OF_SUM_THREE_SQUARES = prove + (`!m a b c:int. + ~(&3 divides m) /\ + a pow 2 + b pow 2 + c pow 2 = &6 * m + ==> ~(&3 divides a) /\ ~(&3 divides b) /\ ~(&3 divides c)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `&3 divides (a pow 2 + b pow 2 + c pow 2)` + ASSUME_TAC THENL + [REWRITE_TAC[int_divides] THEN EXISTS_TAC `&2*m:int` THEN + ASM_REWRITE_TAC[] THEN CONV_TAC INT_RING; + ALL_TAC] THEN + MP_TAC(MATCH_MP (SPECL [`a:int`; `b:int`; `c:int`] + INT_3_DIVIDES_SUM_THREE_SQUARES) + (ASSUME `&3 divides (a pow 2 + b pow 2 + c pow 2)`)) THEN + DISCH_THEN(DISJ_CASES_THEN2 STRIP_ASSUME_TAC STRIP_ASSUME_TAC) THENL + [SUBGOAL_THEN `&3 divides (&2*m)` ASSUME_TAC THENL + [MP_TAC(REWRITE_RULE[int_divides] (ASSUME `&3 divides a`)) THEN + DISCH_THEN(X_CHOOSE_THEN `u:int` ASSUME_TAC) THEN + MP_TAC(REWRITE_RULE[int_divides] (ASSUME `&3 divides b`)) THEN + DISCH_THEN(X_CHOOSE_THEN `v:int` ASSUME_TAC) THEN + MP_TAC(REWRITE_RULE[int_divides] (ASSUME `&3 divides c`)) THEN + DISCH_THEN(X_CHOOSE_THEN `w:int` ASSUME_TAC) THEN + REWRITE_TAC[int_divides] THEN + EXISTS_TAC `u pow 2 + v pow 2 + w pow 2` THEN + MAP_EVERY UNDISCH_TAC + [`a = &3*u`; `b = &3*v`; `c = &3*w`; + `a pow 2 + b pow 2 + c pow 2 = &6*m`] THEN + CONV_TAC INT_RING; + ALL_TAC] THEN + SUBGOAL_THEN `&3 divides m` MP_TAC THENL + [MATCH_MP_TAC(SPECL [`&3:int`; `&2:int`; `m:int`] + INT_COPRIME_DIVPROD) THEN + ASM_REWRITE_TAC[INT_COPRIME_3_2]; + ASM_REWRITE_TAC[]]; + ASM_REWRITE_TAC[]]);; + +let INT_EXISTS_PATTERN123 = prove + (`!m a b c:int. + ~(&3 divides m) /\ + a pow 2 + b pow 2 + c pow 2 = &6 * m + ==> ?A B C:int. + A pow 2 + B pow 2 + C pow 2 = &6 * m /\ + &6 divides (B - A) /\ &6 divides (A + B - C)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(MATCH_MP + (SPECL [`m:int`; `a:int`; `b:int`; `c:int`] + INT_COPRIME3_OF_SUM_THREE_SQUARES) + (CONJ (ASSUME `~(&3 divides m)`) + (ASSUME `a pow 2 + b pow 2 + c pow 2 = &6*m`))) THEN + STRIP_TAC THEN + MP_TAC(SPEC `a:int` INT_PARITY_WITNESS) THEN + DISCH_THEN(DISJ_CASES_THEN (X_CHOOSE_TAC `u:int`)) THEN + MP_TAC(SPEC `b:int` INT_PARITY_WITNESS) THEN + DISCH_THEN(DISJ_CASES_THEN (X_CHOOSE_TAC `v:int`)) THEN + MP_TAC(SPEC `c:int` INT_PARITY_WITNESS) THEN + DISCH_THEN(DISJ_CASES_THEN (X_CHOOSE_TAC `w:int`)) THENL + [MATCH_MP_TAC(SPECL [`m:int`; `a:int`; `b:int`; `c:int`] + INT_PATTERN123_OF_SLOTS) THEN + REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[INT_REM_MUL; INT_REM_MUL_ADD] THEN + CONV_TAC INT_REDUCE_CONV; + ASM_REWRITE_TAC[INT_REM_MUL; INT_REM_MUL_ADD] THEN + CONV_TAC INT_REDUCE_CONV; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]]; + ASM_MESON_TAC[INT_EVEN_EVEN_ODD_SQUARES_NE_DOUBLE; + INT_RING `&6*m = &2 * (&3*m)`]; + ASM_MESON_TAC[INT_EVEN_ODD_EVEN_SQUARES_NE_DOUBLE; + INT_RING `&6*m = &2 * (&3*m)`]; + MATCH_MP_TAC(SPECL [`m:int`; `b:int`; `c:int`; `a:int`] + INT_PATTERN123_OF_SLOTS) THEN + REPEAT CONJ_TAC THENL + [MP_TAC(ASSUME `a pow 2 + b pow 2 + c pow 2 = &6*m`) THEN + CONV_TAC INT_RING; + ASM_REWRITE_TAC[INT_REM_MUL; INT_REM_MUL_ADD] THEN + CONV_TAC INT_REDUCE_CONV; + ASM_REWRITE_TAC[INT_REM_MUL; INT_REM_MUL_ADD] THEN + CONV_TAC INT_REDUCE_CONV; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]]; + ASM_MESON_TAC[INT_ONE_ODD_SQUARES_NE_DOUBLE; + INT_RING `&6*m = &2 * (&3*m)`]; + MATCH_MP_TAC(SPECL [`m:int`; `a:int`; `c:int`; `b:int`] + INT_PATTERN123_OF_SLOTS) THEN + REPEAT CONJ_TAC THENL + [MP_TAC(ASSUME `a pow 2 + b pow 2 + c pow 2 = &6*m`) THEN + CONV_TAC INT_RING; + ASM_REWRITE_TAC[INT_REM_MUL; INT_REM_MUL_ADD] THEN + CONV_TAC INT_REDUCE_CONV; + ASM_REWRITE_TAC[INT_REM_MUL; INT_REM_MUL_ADD] THEN + CONV_TAC INT_REDUCE_CONV; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]]; + MATCH_MP_TAC(SPECL [`m:int`; `a:int`; `b:int`; `c:int`] + INT_PATTERN123_OF_SLOTS) THEN + REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[INT_REM_MUL; INT_REM_MUL_ADD] THEN + CONV_TAC INT_REDUCE_CONV; + ASM_REWRITE_TAC[INT_REM_MUL; INT_REM_MUL_ADD] THEN + CONV_TAC INT_REDUCE_CONV; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]]; + ASM_MESON_TAC[INT_THREE_ODD_SQUARES_NE_DOUBLE; + INT_RING `&6*m = &2 * (&3*m)`]]);; + +let NUM_TRIPLE_EQ_16B14_MOD16 = prove + (`!m b:num. 3*m = 16*b+14 ==> m MOD 16 = 10`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN `b MOD 3 = 1` ASSUME_TAC THENL + [SUBGOAL_THEN + `b MOD 3 = 0 \/ b MOD 3 = 1 \/ b MOD 3 = 2` + MP_TAC THENL + [MP_TAC(SPECL [`b:num`; `3`] DIVISION) THEN + CONV_TAC NUM_REDUCE_CONV THEN ARITH_TAC; + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THENL + [UNDISCH_TAC `3*m = 16*b+14` THEN + DISCH_THEN(MP_TAC o AP_TERM `\x:num. x MOD 3`) THEN + BETA_TAC THEN + REWRITE_TAC[MOD_MULT; + ARITH_RULE `16*b+14 = 3*(5*b+4)+(b+2)`; + MOD_MULT_ADD] THEN + ONCE_REWRITE_TAC[GSYM MOD_ADD_MOD] THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV; + ASM_REWRITE_TAC[]; + UNDISCH_TAC `3*m = 16*b+14` THEN + DISCH_THEN(MP_TAC o AP_TERM `\x:num. x MOD 3`) THEN + BETA_TAC THEN + REWRITE_TAC[MOD_MULT; + ARITH_RULE `16*b+14 = 3*(5*b+4)+(b+2)`; + MOD_MULT_ADD] THEN + ONCE_REWRITE_TAC[GSYM MOD_ADD_MOD] THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV]]; + ALL_TAC] THEN + MP_TAC(MATCH_MP (SPECL [`b:num`; `3`; `1`] NUM_DECOMPOSE_MOD) + (CONJ (ARITH_RULE `~(3 = 0)`) (ASSUME `b MOD 3 = 1`))) THEN + DISCH_THEN(X_CHOOSE_THEN `q:num` SUBST_ALL_TAC) THEN + SUBGOAL_THEN `m = 16*q+10` SUBST1_TAC THENL + [UNDISCH_TAC `3*m = 16*(3*q+1)+14` THEN ARITH_TAC; + REWRITE_TAC[MOD_MULT_ADD] THEN CONV_TAC NUM_REDUCE_CONV]);; + +let NUM_6M_EQ_16T_IMP_DIV4 = prove + (`!m t:num. 6*m = 16*t ==> 4 divides m`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN `t MOD 3 = 0` ASSUME_TAC THENL + [UNDISCH_TAC `6*m = 16*t` THEN + DISCH_THEN(MP_TAC o AP_TERM `\x:num. x MOD 3`) THEN + BETA_TAC THEN + REWRITE_TAC + [ARITH_RULE `6*m = 3*(2*m)+0`; + ARITH_RULE `16*t = 3*(5*t)+t`; + MOD_MULT_ADD] THEN + CONV_TAC NUM_REDUCE_CONV THEN MESON_TAC[]; + ALL_TAC] THEN + MP_TAC(MATCH_MP (SPECL [`t:num`; `3`; `0`] NUM_DECOMPOSE_MOD) + (CONJ (ARITH_RULE `~(3 = 0)`) (ASSUME `t MOD 3 = 0`))) THEN + DISCH_THEN(X_CHOOSE_THEN `q:num` SUBST_ALL_TAC) THEN + REWRITE_TAC[divides] THEN EXISTS_TAC `2*q:num` THEN + ASM_ARITH_TAC);; + +let NUM_6M_AVOIDS_THREE_SQUARE_FORM = prove + (`!m:num. + ~(4 divides m) /\ ~(m MOD 16 = 10) + ==> ~(?a b. 6*m = 4 EXP a * (8*b+7))`, + GEN_TAC THEN STRIP_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `a:num` + (X_CHOOSE_THEN `b:num` ASSUME_TAC)) THEN + ASM_CASES_TAC `a = 0` THENL + [UNDISCH_TAC `6*m = 4 EXP a * (8*b+7)` THEN + ASM_REWRITE_TAC[EXP; MULT_CLAUSES] THEN + DISCH_THEN(MP_TAC o AP_TERM `\x:num. x MOD 2`) THEN + BETA_TAC THEN + REWRITE_TAC + [ARITH_RULE `6*m = 2*(3*m)+0`; + ARITH_RULE `8*b+7 = 2*(4*b+3)+1`; + MOD_MULT_ADD] THEN + CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + MP_TAC(SPEC `a:num` num_CASES) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST_ALL_TAC) THEN + ASM_CASES_TAC `d = 0` THENL + [SUBGOAL_THEN `m MOD 16 = 10` MP_TAC THENL + [MATCH_MP_TAC(SPECL [`m:num`; `b:num`] + NUM_TRIPLE_EQ_16B14_MOD16) THEN + UNDISCH_TAC `6*m = 4 EXP SUC d * (8*b+7)` THEN + ASM_REWRITE_TAC[EXP; MULT_CLAUSES] THEN ARITH_TAC; + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + MP_TAC(SPEC `d:num` num_CASES) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `e:num` SUBST_ALL_TAC) THEN + SUBGOAL_THEN `4 divides m` MP_TAC THENL + [MATCH_MP_TAC(SPECL + [`m:num`; `4 EXP e * (8*b+7)`] + NUM_6M_EQ_16T_IMP_DIV4) THEN + UNDISCH_TAC `6*m = 4 EXP SUC (SUC e) * (8*b+7)` THEN + REWRITE_TAC[EXP] THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN + CONV_TAC NUM_RING; + ASM_REWRITE_TAC[]]);; + +let INT_REPR123_CORE = prove + (`!m:num. + ~(3 divides m) /\ ~(4 divides m) /\ ~(m MOD 16 = 10) + ==> ?x y z:int. x pow 2 + &2*y pow 2 + &3*z pow 2 = &m`, + GEN_TAC THEN STRIP_TAC THEN + MP_TAC(MATCH_MP (SPEC `6*m` INT_THREE_SQUARES_OF_LEGENDRE) + (MATCH_MP (SPEC `m:num` NUM_6M_AVOIDS_THREE_SQUARE_FORM) + (CONJ (ASSUME `~(4 divides m)`) + (ASSUME `~(m MOD 16 = 10)`)))) THEN + DISCH_THEN(X_CHOOSE_THEN `a:int` + (X_CHOOSE_THEN `b:int` (X_CHOOSE_THEN `c:int` ASSUME_TAC))) THEN + SUBGOAL_THEN + `a pow 2 + b pow 2 + c pow 2 = &6 * &m` + ASSUME_TAC THENL + [MP_TAC(ASSUME `a pow 2 + b pow 2 + c pow 2 = &(6*m)`) THEN + REWRITE_TAC[INT_OF_NUM_MUL]; + ALL_TAC] THEN + SUBGOAL_THEN `~(&3 divides &m)` ASSUME_TAC THENL + [UNDISCH_TAC `~(3 divides m)` THEN REWRITE_TAC[num_divides]; + ALL_TAC] THEN + MP_TAC(MATCH_MP + (SPECL [`&m:int`; `a:int`; `b:int`; `c:int`] + INT_EXISTS_PATTERN123) + (CONJ (ASSUME `~(&3 divides &m)`) + (ASSUME `a pow 2 + b pow 2 + c pow 2 = &6 * &m`))) THEN + DISCH_THEN(X_CHOOSE_THEN `A:int` + (X_CHOOSE_THEN `B:int` + (X_CHOOSE_THEN `C:int` STRIP_ASSUME_TAC))) THEN + MATCH_MP_TAC(SPECL [`&m:int`; `A:int`; `B:int`; `C:int`] + INT_REPR123_OF_PATTERN) THEN + ASM_REWRITE_TAC[]);; + +let INT_REPR123_THREE_MUL = prove + (`!u:num. + ~(?a b. 2*u = 4 EXP a * (8*b+7)) + ==> ?x y z:int. + x pow 2 + &2*y pow 2 + &3*z pow 2 = &(3*u)`, + GEN_TAC THEN DISCH_TAC THEN + MP_TAC(MATCH_MP (SPEC `u:num` INT_REPRESENTS_112_OF_LEGENDRE) + (ASSUME `~(?a b. 2*u = 4 EXP a * (8*b+7))`)) THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` (X_CHOOSE_TAC `z:int`))) THEN + MAP_EVERY EXISTS_TAC [`y + &2*z:int`; `y - z:int`; `x:int`] THEN + MP_TAC(ASSUME `x pow 2 + y pow 2 + &2*z pow 2 = &u`) THEN + REWRITE_TAC[GSYM INT_OF_NUM_MUL] THEN CONV_TAC INT_RING);; + +let REGULAR_123_NOT_FORM = prove + (`!n:num. + ~(?a b. n = 4 EXP a * (16*b+10)) + ==> ?x y z:int. x pow 2 + &2*y pow 2 + &3*z pow 2 = &n`, + MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN + DISCH_TAC THEN DISCH_TAC THEN + ASM_CASES_TAC `n = 0` THENL + [MAP_EVERY EXISTS_TAC [`&0:int`; `&0:int`; `&0:int`] THEN + ASM_REWRITE_TAC[] THEN CONV_TAC INT_RING; + ALL_TAC] THEN + ASM_CASES_TAC `4 divides n` THENL + [FIRST_X_ASSUM(X_CHOOSE_THEN `q:num` ASSUME_TAC o + REWRITE_RULE[divides]) THEN + SUBGOAL_THEN `(q:num) < (n:num)` ASSUME_TAC THENL + [MATCH_MP_TAC(SPECL [`n:num`; `q:num`] + (ARITH_RULE + `!n q:num. n = 4*q /\ ~(n = 0) ==> q < n`)) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `~(?a b. q = 4 EXP a * (16*b+10))` + ASSUME_TAC THENL + [REWRITE_TAC[NOT_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:num`; `b:num`] THEN DISCH_TAC THEN + UNDISCH_TAC `~(?a b. n = 4 EXP a * (16*b+10))` THEN + REWRITE_TAC[] THEN MAP_EVERY EXISTS_TAC [`SUC a`; `b:num`] THEN + ASM_REWRITE_TAC[EXP; GSYM MULT_ASSOC]; + ALL_TAC] THEN + SUBGOAL_THEN + `?x y z:int. x pow 2 + &2*y pow 2 + &3*z pow 2 = &q` + MP_TAC THENL + [MATCH_MP_TAC(MATCH_MP + (SPEC `q:num` (ASSUME + `!m. m < n + ==> ~(?a b. m = 4 EXP a * (16*b+10)) + ==> ?x y z:int. + x pow 2 + &2*y pow 2 + &3*z pow 2 = &m`)) + (ASSUME `(q:num) < (n:num)`)) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` (X_CHOOSE_TAC `z:int`))) THEN + MAP_EVERY EXISTS_TAC [`&2*x:int`; `&2*y:int`; `&2*z:int`] THEN + MP_TAC(ASSUME `x pow 2 + &2*y pow 2 + &3*z pow 2 = &q`) THEN + SUBGOAL_THEN `&n = &4 * &q:int` ASSUME_TAC THENL + [MP_TAC(AP_TERM `\r:num. &r:int` (ASSUME `n = 4*q`)) THEN + REWRITE_TAC[INT_OF_NUM_MUL]; + ALL_TAC] THEN + ONCE_REWRITE_TAC[ASSUME `&n = &4 * &q`] THEN + CONV_TAC INT_RING; + ALL_TAC] THEN + ASM_CASES_TAC `3 divides n` THENL + [FIRST_X_ASSUM(X_CHOOSE_THEN `u:num` ASSUME_TAC o + REWRITE_RULE[divides]) THEN + SUBGOAL_THEN `~(?a b. 2*u = 4 EXP a * (8*b+7))` + ASSUME_TAC THENL + [REWRITE_TAC[NOT_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:num`; `b:num`] THEN DISCH_TAC THEN + ASM_CASES_TAC `a = 0` THENL + [UNDISCH_TAC `2*u = 4 EXP a * (8*b+7)` THEN + ASM_REWRITE_TAC[EXP; MULT_CLAUSES] THEN + DISCH_THEN(MP_TAC o AP_TERM `\x:num. x MOD 2`) THEN + BETA_TAC THEN + REWRITE_TAC + [MOD_MULT; + ARITH_RULE `8*b+7 = 2*(4*b+3)+1`; + MOD_MULT_ADD] THEN + CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + MP_TAC(SPEC `a:num` num_CASES) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST_ALL_TAC) THEN + UNDISCH_TAC `~(?a b. n = 4 EXP a * (16*b+10))` THEN + REWRITE_TAC[] THEN MAP_EVERY EXISTS_TAC [`d:num`; `3*b+2`] THEN + MAP_EVERY UNDISCH_TAC + [`n = 3*u`; `2*u = 4 EXP SUC d * (8*b+7)`] THEN + REWRITE_TAC[EXP] THEN ARITH_TAC; + ALL_TAC] THEN + MP_TAC(MATCH_MP (SPEC `u:num` INT_REPR123_THREE_MUL) + (ASSUME `~(?a b. 2*u = 4 EXP a * (8*b+7))`)) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `~(n MOD 16 = 10)` ASSUME_TAC THENL + [DISCH_TAC THEN + UNDISCH_TAC `~(?a b. n = 4 EXP a * (16*b+10))` THEN + REWRITE_TAC[] THEN MAP_EVERY EXISTS_TAC [`0`; `n DIV 16`] THEN + REWRITE_TAC[EXP; MULT_CLAUSES] THEN + MP_TAC(SPECL [`n:num`; `16`] DIVISION) THEN + CONV_TAC NUM_REDUCE_CONV THEN ASM_REWRITE_TAC[] THEN ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(SPEC `n:num` INT_REPR123_CORE) THEN + ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* The truant 10 and the two-column clearing transformations. *) +(* ------------------------------------------------------------------------- *) + +let IQ_123_MOD16_CORE = prove + (`!a b c:int. + (a = &0 \/ a = &1 \/ a = &4 \/ a = &9) /\ + (b = &0 \/ b = &1 \/ b = &4 \/ b = &9) /\ + (c = &0 \/ c = &1 \/ c = &4 \/ c = &9) /\ + (a + &2 * b + &3 * c) rem &16 = &10 + ==> F`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + POP_ASSUM MP_TAC THEN ASM_REWRITE_TAC[] THEN + CONV_TAC INT_REDUCE_CONV);; + +let INT_123_NOT_10 = prove + (`!x y z:int. + ~(x pow 2 + &2 * y pow 2 + &3 * z pow 2 = &10)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(SPECL + [`x pow 2 rem &16`; `y pow 2 rem &16`; `z pow 2 rem &16`] + IQ_123_MOD16_CORE) THEN + REWRITE_TAC[IQ_SQ_MOD_16] THEN + SUBGOAL_THEN + `(x pow 2 rem &16 + &2 * (y pow 2 rem &16) + + &3 * (z pow 2 rem &16)) rem &16 = + (x pow 2 + &2 * y pow 2 + &3 * z pow 2) rem &16` + SUBST1_TAC THENL + [CONV_TAC INT_REM_DOWN_CONV THEN REFL_TAC; + ASM_REWRITE_TAC[] THEN CONV_TAC INT_REDUCE_CONV]);; + +let iqclear123 = new_definition + `iqclear123 a b c = + iqrows4 + (&1) (&0) (&0) (&0) + (&0) (&1) (&0) (&0) + (&0) (&0) (&1) (&0) + (--a) (--b) (--c) (&1)`;; + +let iqflip123 = new_definition + `iqflip123 = + iqrows4 + (&1) (&0) (&0) (&0) + (&0) (&1) (&0) (&0) + (&0) (&0) (-- &1) (&0) + (&0) (&0) (&0) (&1)`;; + +let IQ_EMBEDS_CLEAR_123 = prove + (`!n A a b c rb rc t. + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) a + (&2) (&0) (&2 * b + rb) + (&3) (&3 * c + rc) t) A + ==> iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&3) rc + (t - a pow 2 - + &2 * b pow 2 - &2 * b * rb - + &3 * c pow 2 - &2 * c * rc)) A`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(ISPECL + [`n:num`; `4`; + `iqgram 4 + (iqmat4 (&1) (&0) (&0) a + (&2) (&0) (&2 * b + rb) + (&3) (&3 * c + rc) t) + (iqclear123 a b c)`; + `iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&3) rc + (t - a pow 2 - + &2 * b pow 2 - &2 * b * rb - + &3 * c pow 2 - &2 * c * rc)`; + `A:num->num->int`] IQ_EMBEDS_EQ) THEN + CONJ_TAC THENL + [MATCH_MP_TAC IQ_EMBEDS_CONGRUENCE THEN ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC THEN + (SUBGOAL_THEN `i = 0 \/ i = 1 \/ i = 2 \/ i = 3` MP_TAC THENL + [ASM_ARITH_TAC; ALL_TAC]) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + (SUBGOAL_THEN `j = 0 \/ j = 1 \/ j = 2 \/ j = 3` MP_TAC THENL + [ASM_ARITH_TAC; ALL_TAC]) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + ASM_REWRITE_TAC[iqgram; IQBILIN_MAT4; iqclear123; iqrows4; + iqmat4; iqsym] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC INT_RING]);; + +let IQ_EMBEDS_FLIP_123 = prove + (`!n A rb k. + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&3) (-- &1) k) A + ==> iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&3) (&1) k) A`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(ISPECL + [`n:num`; `4`; + `iqgram 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&3) (-- &1) k) + iqflip123`; + `iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&3) (&1) k`; + `A:num->num->int`] IQ_EMBEDS_EQ) THEN + CONJ_TAC THENL + [MATCH_MP_TAC IQ_EMBEDS_CONGRUENCE THEN ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC THEN + (SUBGOAL_THEN `i = 0 \/ i = 1 \/ i = 2 \/ i = 3` MP_TAC THENL + [ASM_ARITH_TAC; ALL_TAC]) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + (SUBGOAL_THEN `j = 0 \/ j = 1 \/ j = 2 \/ j = 3` MP_TAC THENL + [ASM_ARITH_TAC; ALL_TAC]) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + ASM_REWRITE_TAC[iqgram; IQBILIN_MAT4; iqflip123; iqrows4; + iqmat4; iqsym] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC INT_RING]);; + +(* ------------------------------------------------------------------------- *) +(* Positivity forces every crossed lower-right corner to be positive. *) +(* ------------------------------------------------------------------------- *) + +let IQ_ZC123_CORNER_LOWER = prove + (`!n A k. + iq_positive n A /\ + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&0) (&3) (&1) k) A + ==> &1 <= k`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(MATCH_MP + (ISPECL + [`n:num`; `4`; + `iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&0) (&3) (&1) k`; + `A:num->num->int`] IQ_EMBEDDED_NONNEG) + (CONJ (ASSUME `iq_positive n A`) + (ASSUME + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&0) (&3) (&1) k) A`))) THEN + DISCH_THEN(MP_TAC o SPEC + `\i:num. + if i = 2 then &1 else if i = 3 then -- &3 else &0`) THEN + REWRITE_TAC[IQEVAL_MAT4] THEN + CONV_TAC NUM_REDUCE_CONV THEN INT_ARITH_TAC);; + +let IQ_YC123_CORNER_LOWER = prove + (`!n A k. + iq_positive n A /\ + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&3) (&0) k) A + ==> &1 <= k`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(MATCH_MP + (ISPECL + [`n:num`; `4`; + `iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&3) (&0) k`; + `A:num->num->int`] IQ_EMBEDDED_NONNEG) + (CONJ (ASSUME `iq_positive n A`) + (ASSUME + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&3) (&0) k) A`))) THEN + DISCH_THEN(MP_TAC o SPEC + `\i:num. + if i = 1 then &1 else if i = 3 then -- &2 else &0`) THEN + REWRITE_TAC[IQEVAL_MAT4] THEN + CONV_TAC NUM_REDUCE_CONV THEN INT_ARITH_TAC);; + +let IQ_DC123_CORNER_LOWER = prove + (`!n A k. + iq_positive n A /\ + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&3) (&1) k) A + ==> &1 <= k`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(MATCH_MP + (ISPECL + [`n:num`; `4`; + `iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&3) (&1) k`; + `A:num->num->int`] IQ_EMBEDDED_NONNEG) + (CONJ (ASSUME `iq_positive n A`) + (ASSUME + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&3) (&1) k) A`))) THEN + DISCH_THEN(MP_TAC o SPEC + `\i:num. + if i = 1 then &1 else if i = 2 then &1 else + if i = 3 then -- &2 else &0`) THEN + REWRITE_TAC[IQEVAL_MAT4] THEN + CONV_TAC NUM_REDUCE_CONV THEN INT_ARITH_TAC);; + +let INT_2Q2_ADD_2Q_NONNEG = prove + (`!q:int. &0 <= &2 * q pow 2 + &2 * q`, + GEN_TAC THEN ASM_CASES_TAC `&0 <= q` THENL + [ONCE_REWRITE_TAC + [INT_RING + `&2 * q pow 2 + &2 * q = &2 * (q * (q + &1))`] THEN + MATCH_MP_TAC(SPECL [`&2:int`; `q * (q + &1):int`] INT_LE_MUL) THEN + CONJ_TAC THENL + [INT_ARITH_TAC; + MATCH_MP_TAC(SPECL [`q:int`; `q + &1:int`] INT_LE_MUL) THEN + ASM_INT_ARITH_TAC]; + ONCE_REWRITE_TAC + [INT_RING + `&2 * q pow 2 + &2 * q = &2 * ((--q) * (--q - &1))`] THEN + MATCH_MP_TAC + (SPECL [`&2:int`; `(--q) * (--q - &1):int`] INT_LE_MUL) THEN + CONJ_TAC THENL + [INT_ARITH_TAC; + MATCH_MP_TAC + (SPECL [`--q:int`; `--q - &1:int`] INT_LE_MUL) THEN + ASM_INT_ARITH_TAC]]);; + +let IQ_REPRESENTS_REDUCED_123 = prove + (`!a b c rb rc k:int. + k = &10 - a pow 2 - + &2 * b pow 2 - &2 * b * rb - + &3 * c pow 2 - &2 * c * rc + ==> iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&3) rc k) (&10)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[iq_represents] THEN + EXISTS_TAC + `\i:num. + if i = 0 then a else if i = 1 then b else + if i = 2 then c else &1` THEN + REWRITE_TAC[IQEVAL_MAT4] THEN + CONV_TAC NUM_REDUCE_CONV THEN + ASM_REWRITE_TAC[] THEN CONV_TAC INT_RING);; + +let INT_DIV2_QR = prove + (`!b:int. + ?q r. b = &2 * q + r /\ (r = &0 \/ r = &1)`, + GEN_TAC THEN + MAP_EVERY EXISTS_TAC [`b div &2:int`; `b rem &2:int`] THEN + MATCH_ACCEPT_TAC(SPEC `b:int` INT_DIV2_DECOMP));; + +(* ------------------------------------------------------------------------- *) +(* The six residue branches collapse to four quaternary child families. *) +(* ------------------------------------------------------------------------- *) + +let IQ_EMBEDS_QUATERNARY_123 = prove + (`!n A. + iq_symmetric n A /\ iq_positive n A /\ + iq_embeds n 3 + (iqmat3 (&1) (&0) (&0) (&2) (&0) (&3)) A /\ + iq_represents n A (&10) + ==> (?k. + &1 <= k /\ k <= &10 /\ + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&0) (&3) (&0) k) A) \/ + (?k. + &1 <= k /\ k <= &10 /\ + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&0) (&3) (&1) k) A) \/ + (?k. + &1 <= k /\ k <= &10 /\ + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&3) (&0) k) A /\ + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&3) (&0) k) (&10)) \/ + (?k. + &1 <= k /\ k <= &10 /\ + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&3) (&1) k) A /\ + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&3) (&1) k) (&10))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(SPECL + [`n:num`; `A:num->num->int`; + `&1:int`; `&0:int`; `&0:int`; `&2:int`; `&0:int`; `&3:int`; + `&10:int`] IQ_ESCALATE_MAT3) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `a:int` + (X_CHOOSE_THEN `b:int` + (X_CHOOSE_THEN `c:int` STRIP_ASSUME_TAC))) THEN + MP_TAC(SPEC `b:int` INT_DIV2_QR) THEN + DISCH_THEN(X_CHOOSE_THEN `qb:int` + (X_CHOOSE_THEN `rb:int` + (CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC))) THEN + MP_TAC(SPEC `c:int` INT_DIV3_DECOMP) THEN + DISCH_THEN(X_CHOOSE_THEN `qc:int` + (X_CHOOSE_THEN `rc:int` + (CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC))) THEN + UNDISCH_TAC `rb = &0 \/ rb = &1` THEN + DISCH_THEN(DISJ_CASES_THEN SUBST_ALL_TAC) THEN + UNDISCH_TAC `rc = &0 \/ rc = &1 \/ rc = &2` THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THENL + [(* (rb,rc) = (0,0): diagonal child. *) + ABBREV_TAC + `k = &10 - a pow 2 - + &2 * qb pow 2 - &2 * qb * &0 - + &3 * qc pow 2 - &2 * qc * &0` THEN + SUBGOAL_THEN + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&0) (&3) (&0) k) A` + ASSUME_TAC THENL + [EXPAND_TAC "k" THEN MATCH_MP_TAC IQ_EMBEDS_CLEAR_123 THEN + MATCH_ACCEPT_TAC + (REWRITE_RULE + [ASSUME `b = &2 * qb + &0`; + ASSUME `c = &3 * qc + &0`] + (ASSUME + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) a + (&2) (&0) b (&3) c (&10)) A`)); + ALL_TAC] THEN + SUBGOAL_THEN `&0 <= k` ASSUME_TAC THENL + [MP_TAC(MATCH_MP + (ISPECL + [`n:num`; `4`; + `iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&0) (&3) (&0) k`; + `A:num->num->int`] IQ_EMBEDDED_NONNEG) + (CONJ (ASSUME `iq_positive n A`) + (ASSUME + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&0) (&3) (&0) k) A`))) THEN + DISCH_THEN(MP_TAC o SPEC + `\i:num. if i = 3 then &1 else &0`) THEN + REWRITE_TAC[IQEVAL_MAT4] THEN + CONV_TAC NUM_REDUCE_CONV THEN INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `~(k = &0)` ASSUME_TAC THENL + [DISCH_TAC THEN + SUBGOAL_THEN + `a pow 2 + &2 * qb pow 2 + &3 * qc pow 2 = &10` + ASSUME_TAC THENL + [EXPAND_TAC "k" THEN ASM_INT_ARITH_TAC; + CONTR_TAC + (MP (NOT_ELIM(SPECL [`a:int`; `qb:int`; `qc:int`] + INT_123_NOT_10)) + (ASSUME + `a pow 2 + &2 * qb pow 2 + &3 * qc pow 2 = &10`))]; + ALL_TAC] THEN + SUBGOAL_THEN `&1 <= k` ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `k <= &10` ASSUME_TAC THENL + [EXPAND_TAC "k" THEN + MP_TAC(SPEC `a:int` INT_LE_POW_2) THEN + MP_TAC(SPEC `qb:int` INT_LE_POW_2) THEN + MP_TAC(SPEC `qc:int` INT_LE_POW_2) THEN INT_ARITH_TAC; + ALL_TAC] THEN + DISJ1_TAC THEN EXISTS_TAC `k:int` THEN ASM_REWRITE_TAC[]; + + (* (rb,rc) = (0,1): z-cross child. *) + ABBREV_TAC + `k = &10 - a pow 2 - + &2 * qb pow 2 - &2 * qb * &0 - + &3 * qc pow 2 - &2 * qc * &1` THEN + SUBGOAL_THEN + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&0) (&3) (&1) k) A` + ASSUME_TAC THENL + [EXPAND_TAC "k" THEN MATCH_MP_TAC IQ_EMBEDS_CLEAR_123 THEN + MATCH_ACCEPT_TAC + (REWRITE_RULE + [ASSUME `b = &2 * qb + &0`; + ASSUME `c = &3 * qc + &1`] + (ASSUME + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) a + (&2) (&0) b (&3) c (&10)) A`)); + ALL_TAC] THEN + SUBGOAL_THEN `&1 <= k` ASSUME_TAC THENL + [MATCH_MP_TAC(ISPECL [`n:num`; `A:num->num->int`; `k:int`] + IQ_ZC123_CORNER_LOWER) THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `k <= &10` ASSUME_TAC THENL + [EXPAND_TAC "k" THEN + MP_TAC(SPEC `a:int` INT_LE_POW_2) THEN + MP_TAC(SPEC `qb:int` INT_LE_POW_2) THEN + MP_TAC(SPEC `qc:int` INT_3Q2_ADD_2Q_NONNEG) THEN + INT_ARITH_TAC; + ALL_TAC] THEN + DISJ2_TAC THEN DISJ1_TAC THEN + EXISTS_TAC `k:int` THEN ASM_REWRITE_TAC[]; + + (* (rb,rc) = (0,2): flip the z residue to +1. *) + ABBREV_TAC + `k = &10 - a pow 2 - + &2 * qb pow 2 - &2 * qb * &0 - + &3 * (qc + &1) pow 2 - + &2 * (qc + &1) * (-- &1)` THEN + SUBGOAL_THEN + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&0) (&3) (-- &1) k) A` + ASSUME_TAC THENL + [EXPAND_TAC "k" THEN MATCH_MP_TAC IQ_EMBEDS_CLEAR_123 THEN + MATCH_ACCEPT_TAC + (REWRITE_RULE + [ASSUME `b = &2 * qb + &0`; + ASSUME `c = &3 * qc + &2`; + INT_RING `&3 * qc + &2 = &3 * (qc + &1) + -- &1`] + (ASSUME + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) a + (&2) (&0) b (&3) c (&10)) A`)); + ALL_TAC] THEN + SUBGOAL_THEN + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&0) (&3) (&1) k) A` + ASSUME_TAC THENL + [MATCH_MP_TAC IQ_EMBEDS_FLIP_123 THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `&1 <= k` ASSUME_TAC THENL + [MATCH_MP_TAC(ISPECL [`n:num`; `A:num->num->int`; `k:int`] + IQ_ZC123_CORNER_LOWER) THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `k <= &10` ASSUME_TAC THENL + [EXPAND_TAC "k" THEN + MP_TAC(SPEC `a:int` INT_LE_POW_2) THEN + MP_TAC(SPEC `qb:int` INT_LE_POW_2) THEN + MP_TAC(SPEC `qc + &1:int` INT_3Q2_SUB_2Q_NONNEG) THEN + INT_ARITH_TAC; + ALL_TAC] THEN + DISJ2_TAC THEN DISJ1_TAC THEN + EXISTS_TAC `k:int` THEN ASM_REWRITE_TAC[]; + + (* (rb,rc) = (1,0): y-cross child, retaining its 10 witness. *) + ABBREV_TAC + `k = &10 - a pow 2 - + &2 * qb pow 2 - &2 * qb * &1 - + &3 * qc pow 2 - &2 * qc * &0` THEN + SUBGOAL_THEN + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&3) (&0) k) A` + ASSUME_TAC THENL + [EXPAND_TAC "k" THEN MATCH_MP_TAC IQ_EMBEDS_CLEAR_123 THEN + MATCH_ACCEPT_TAC + (REWRITE_RULE + [ASSUME `b = &2 * qb + &1`; + ASSUME `c = &3 * qc + &0`] + (ASSUME + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) a + (&2) (&0) b (&3) c (&10)) A`)); + ALL_TAC] THEN + SUBGOAL_THEN `&1 <= k` ASSUME_TAC THENL + [MATCH_MP_TAC(ISPECL [`n:num`; `A:num->num->int`; `k:int`] + IQ_YC123_CORNER_LOWER) THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `k <= &10` ASSUME_TAC THENL + [EXPAND_TAC "k" THEN + MP_TAC(SPEC `a:int` INT_LE_POW_2) THEN + MP_TAC(SPEC `qb:int` INT_2Q2_ADD_2Q_NONNEG) THEN + MP_TAC(SPEC `qc:int` INT_LE_POW_2) THEN INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&3) (&0) k) (&10)` + ASSUME_TAC THENL + [MATCH_MP_TAC + (SPECL + [`a:int`; `qb:int`; `qc:int`; + `&1:int`; `&0:int`; `k:int`] + IQ_REPRESENTS_REDUCED_123) THEN + EXPAND_TAC "k" THEN CONV_TAC INT_RING; + ALL_TAC] THEN + DISJ2_TAC THEN DISJ2_TAC THEN DISJ1_TAC THEN + EXISTS_TAC `k:int` THEN ASM_REWRITE_TAC[]; + + (* (rb,rc) = (1,1): double-cross child. *) + ABBREV_TAC + `k = &10 - a pow 2 - + &2 * qb pow 2 - &2 * qb * &1 - + &3 * qc pow 2 - &2 * qc * &1` THEN + SUBGOAL_THEN + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&3) (&1) k) A` + ASSUME_TAC THENL + [EXPAND_TAC "k" THEN MATCH_MP_TAC IQ_EMBEDS_CLEAR_123 THEN + MATCH_ACCEPT_TAC + (REWRITE_RULE + [ASSUME `b = &2 * qb + &1`; + ASSUME `c = &3 * qc + &1`] + (ASSUME + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) a + (&2) (&0) b (&3) c (&10)) A`)); + ALL_TAC] THEN + SUBGOAL_THEN `&1 <= k` ASSUME_TAC THENL + [MATCH_MP_TAC(ISPECL [`n:num`; `A:num->num->int`; `k:int`] + IQ_DC123_CORNER_LOWER) THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `k <= &10` ASSUME_TAC THENL + [EXPAND_TAC "k" THEN + MP_TAC(SPEC `a:int` INT_LE_POW_2) THEN + MP_TAC(SPEC `qb:int` INT_2Q2_ADD_2Q_NONNEG) THEN + MP_TAC(SPEC `qc:int` INT_3Q2_ADD_2Q_NONNEG) THEN + INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&3) (&1) k) (&10)` + ASSUME_TAC THENL + [MATCH_MP_TAC + (SPECL + [`a:int`; `qb:int`; `qc:int`; + `&1:int`; `&1:int`; `k:int`] + IQ_REPRESENTS_REDUCED_123) THEN + EXPAND_TAC "k" THEN CONV_TAC INT_RING; + ALL_TAC] THEN + DISJ2_TAC THEN DISJ2_TAC THEN DISJ2_TAC THEN + EXISTS_TAC `k:int` THEN ASM_REWRITE_TAC[]; + + (* (rb,rc) = (1,2): flip to the double-cross child. *) + ABBREV_TAC + `k = &10 - a pow 2 - + &2 * qb pow 2 - &2 * qb * &1 - + &3 * (qc + &1) pow 2 - + &2 * (qc + &1) * (-- &1)` THEN + SUBGOAL_THEN + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&3) (-- &1) k) A` + ASSUME_TAC THENL + [EXPAND_TAC "k" THEN MATCH_MP_TAC IQ_EMBEDS_CLEAR_123 THEN + MATCH_ACCEPT_TAC + (REWRITE_RULE + [ASSUME `b = &2 * qb + &1`; + ASSUME `c = &3 * qc + &2`; + INT_RING `&3 * qc + &2 = &3 * (qc + &1) + -- &1`] + (ASSUME + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) a + (&2) (&0) b (&3) c (&10)) A`)); + ALL_TAC] THEN + SUBGOAL_THEN + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&3) (&1) k) A` + ASSUME_TAC THENL + [MATCH_MP_TAC IQ_EMBEDS_FLIP_123 THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `&1 <= k` ASSUME_TAC THENL + [MATCH_MP_TAC(ISPECL [`n:num`; `A:num->num->int`; `k:int`] + IQ_DC123_CORNER_LOWER) THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `k <= &10` ASSUME_TAC THENL + [EXPAND_TAC "k" THEN + MP_TAC(SPEC `a:int` INT_LE_POW_2) THEN + MP_TAC(SPEC `qb:int` INT_2Q2_ADD_2Q_NONNEG) THEN + MP_TAC(SPEC `qc + &1:int` INT_3Q2_SUB_2Q_NONNEG) THEN + INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&3) (&1) k) (&10)` + ASSUME_TAC THENL + [MATCH_MP_TAC + (SPECL + [`a:int`; `qb:int`; `--(qc + &1):int`; + `&1:int`; `&1:int`; `k:int`] + IQ_REPRESENTS_REDUCED_123) THEN + EXPAND_TAC "k" THEN CONV_TAC INT_RING; + ALL_TAC] THEN + DISJ2_TAC THEN DISJ2_TAC THEN DISJ2_TAC THEN + EXISTS_TAC `k:int` THEN ASM_REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* The represented-10 certificates eliminate the three nonuniversal cases. *) +(* ------------------------------------------------------------------------- *) + +let INT_SQ_LE_20_CASES = prove + (`!a:int. + a pow 2 <= &20 + ==> a = -- &4 \/ a = -- &3 \/ a = -- &2 \/ a = -- &1 \/ + a = &0 \/ a = &1 \/ a = &2 \/ a = &3 \/ a = &4`, + GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN `abs a < &5` ASSUME_TAC THENL + [MP_TAC(SPECL [`a:int`; `&5:int`] INT_LT_SQUARE_ABS) THEN + REWRITE_TAC[INT_ABS_NUM] THEN + CONV_TAC NUM_REDUCE_CONV THEN ASM_INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `abs a <= &4` ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; ALL_TAC] THEN + MP_TAC(SPECL [`a:int`; `&4:int`] INT_ABS_BOUNDS) THEN + ASM_REWRITE_TAC[] THEN INT_ARITH_TAC);; + +let INT_SQ_LE_30_CASES = prove + (`!a:int. + a pow 2 <= &30 + ==> a = -- &5 \/ a = -- &4 \/ a = -- &3 \/ a = -- &2 \/ + a = -- &1 \/ a = &0 \/ a = &1 \/ a = &2 \/ a = &3 \/ + a = &4 \/ a = &5`, + GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN `abs a < &6` ASSUME_TAC THENL + [MP_TAC(SPECL [`a:int`; `&6:int`] INT_LT_SQUARE_ABS) THEN + REWRITE_TAC[INT_ABS_NUM] THEN + CONV_TAC NUM_REDUCE_CONV THEN ASM_INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `abs a <= &5` ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; ALL_TAC] THEN + MP_TAC(SPECL [`a:int`; `&5:int`] INT_ABS_BOUNDS) THEN + ASM_REWRITE_TAC[] THEN INT_ARITH_TAC);; + +let INT_YC123_NOT_10_4 = prove + (`!x y z w:int. + ~(x pow 2 + &2 * y pow 2 + &3 * z pow 2 + + &2 * y * w + &4 * w pow 2 = &10)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN + `&2 * x pow 2 + &6 * z pow 2 + (&2 * y + w) pow 2 + + &7 * w pow 2 = &20` + (LABEL_TAC "sum") THENL + [FIRST_X_ASSUM(MP_TAC) THEN CONV_TAC INT_RING; + ALL_TAC] THEN + MP_TAC(SPEC `x:int` INT_LE_POW_2) THEN + MP_TAC(SPEC `z:int` INT_LE_POW_2) THEN + MP_TAC(SPEC `&2 * y + w:int` INT_LE_POW_2) THEN + MP_TAC(SPEC `w:int` INT_LE_POW_2) THEN + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `x pow 2 <= &10` ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `z pow 2 <= &3` ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `(&2 * y + w) pow 2 <= &20` ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `w pow 2 <= &2` ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; ALL_TAC] THEN + MP_TAC(MATCH_MP INT_SQ_LE_10_CASES (ASSUME `x pow 2 <= &10`)) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + MP_TAC(MATCH_MP INT_SQ_LE_3_CASES (ASSUME `z pow 2 <= &3`)) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + MP_TAC(MATCH_MP INT_SQ_LE_20_CASES + (ASSUME `(&2 * y + w) pow 2 <= &20`)) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THEN + MP_TAC(MATCH_MP INT_SQ_LE_2_CASES (ASSUME `w pow 2 <= &2`)) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + REMOVE_THEN "sum" MP_TAC THEN + ASM_REWRITE_TAC[] THEN CONV_TAC INT_REDUCE_CONV);; + +let INT_YC123_NOT_10_8 = prove + (`!x y z w:int. + ~(x pow 2 + &2 * y pow 2 + &3 * z pow 2 + + &2 * y * w + &8 * w pow 2 = &10)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN + `&2 * x pow 2 + &6 * z pow 2 + (&2 * y + w) pow 2 + + &15 * w pow 2 = &20` + (LABEL_TAC "sum") THENL + [FIRST_X_ASSUM(MP_TAC) THEN CONV_TAC INT_RING; + ALL_TAC] THEN + MP_TAC(SPEC `x:int` INT_LE_POW_2) THEN + MP_TAC(SPEC `z:int` INT_LE_POW_2) THEN + MP_TAC(SPEC `&2 * y + w:int` INT_LE_POW_2) THEN + MP_TAC(SPEC `w:int` INT_LE_POW_2) THEN + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `x pow 2 <= &10` ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `z pow 2 <= &3` ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `(&2 * y + w) pow 2 <= &20` ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `w pow 2 <= &1` ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; ALL_TAC] THEN + MP_TAC(MATCH_MP INT_SQ_LE_10_CASES (ASSUME `x pow 2 <= &10`)) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + MP_TAC(MATCH_MP INT_SQ_LE_3_CASES (ASSUME `z pow 2 <= &3`)) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + MP_TAC(MATCH_MP INT_SQ_LE_20_CASES + (ASSUME `(&2 * y + w) pow 2 <= &20`)) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THEN + MP_TAC(MATCH_MP INT_SQ_LE_2_CASES + (MATCH_MP (INT_ARITH `w pow 2 <= &1 ==> w pow 2 <= &2`) + (ASSUME `w pow 2 <= &1`))) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + REMOVE_THEN "sum" MP_TAC THEN + ASM_REWRITE_TAC[] THEN CONV_TAC INT_REDUCE_CONV);; + +let INT_DC123_NOT_10_7 = prove + (`!x y z w:int. + ~(x pow 2 + &2 * y pow 2 + &3 * z pow 2 + + &2 * y * w + &2 * z * w + &7 * w pow 2 = &10)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN + `&6 * x pow 2 + &3 * (&2 * y + w) pow 2 + + &2 * (&3 * z + w) pow 2 + &37 * w pow 2 = &60` + (LABEL_TAC "sum") THENL + [FIRST_X_ASSUM(MP_TAC) THEN CONV_TAC INT_RING; + ALL_TAC] THEN + MP_TAC(SPEC `x:int` INT_LE_POW_2) THEN + MP_TAC(SPEC `&2 * y + w:int` INT_LE_POW_2) THEN + MP_TAC(SPEC `&3 * z + w:int` INT_LE_POW_2) THEN + MP_TAC(SPEC `w:int` INT_LE_POW_2) THEN + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `x pow 2 <= &10` ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `(&2 * y + w) pow 2 <= &20` ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `(&3 * z + w) pow 2 <= &30` ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `w pow 2 <= &1` ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; ALL_TAC] THEN + MP_TAC(MATCH_MP INT_SQ_LE_10_CASES (ASSUME `x pow 2 <= &10`)) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + MP_TAC(MATCH_MP INT_SQ_LE_20_CASES + (ASSUME `(&2 * y + w) pow 2 <= &20`)) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THEN + MP_TAC(MATCH_MP INT_SQ_LE_30_CASES + (ASSUME `(&3 * z + w) pow 2 <= &30`)) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THEN + MP_TAC(MATCH_MP INT_SQ_LE_2_CASES + (MATCH_MP (INT_ARITH `w pow 2 <= &1 ==> w pow 2 <= &2`) + (ASSUME `w pow 2 <= &1`))) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + REMOVE_THEN "sum" MP_TAC THEN + ASM_REWRITE_TAC[] THEN CONV_TAC INT_REDUCE_CONV);; + +let IQ_YC123_NOT_REPRESENTS_10_4 = prove + (`~iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&3) (&0) (&4)) (&10)`, + REWRITE_TAC[iq_represents] THEN + DISCH_THEN(X_CHOOSE_TAC `v:num->int`) THEN + SUBGOAL_THEN + `v 0 pow 2 + &2 * v 1 pow 2 + &3 * v 2 pow 2 + + &2 * v 1 * v 3 + &4 * v 3 pow 2 = &10` + ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC) THEN REWRITE_TAC[IQEVAL_MAT4] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC INT_RING; + CONTR_TAC + (MP (NOT_ELIM(SPECL + [`v 0:int`; `v 1:int`; `v 2:int`; `v 3:int`] + INT_YC123_NOT_10_4)) + (ASSUME + `v 0 pow 2 + &2 * v 1 pow 2 + &3 * v 2 pow 2 + + &2 * v 1 * v 3 + &4 * v 3 pow 2 = &10`))]);; + +let IQ_YC123_NOT_REPRESENTS_10_8 = prove + (`~iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&3) (&0) (&8)) (&10)`, + REWRITE_TAC[iq_represents] THEN + DISCH_THEN(X_CHOOSE_TAC `v:num->int`) THEN + SUBGOAL_THEN + `v 0 pow 2 + &2 * v 1 pow 2 + &3 * v 2 pow 2 + + &2 * v 1 * v 3 + &8 * v 3 pow 2 = &10` + ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC) THEN REWRITE_TAC[IQEVAL_MAT4] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC INT_RING; + CONTR_TAC + (MP (NOT_ELIM(SPECL + [`v 0:int`; `v 1:int`; `v 2:int`; `v 3:int`] + INT_YC123_NOT_10_8)) + (ASSUME + `v 0 pow 2 + &2 * v 1 pow 2 + &3 * v 2 pow 2 + + &2 * v 1 * v 3 + &8 * v 3 pow 2 = &10`))]);; + +let IQ_DC123_NOT_REPRESENTS_10_7 = prove + (`~iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&3) (&1) (&7)) (&10)`, + REWRITE_TAC[iq_represents] THEN + DISCH_THEN(X_CHOOSE_TAC `v:num->int`) THEN + SUBGOAL_THEN + `v 0 pow 2 + &2 * v 1 pow 2 + &3 * v 2 pow 2 + + &2 * v 1 * v 3 + &2 * v 2 * v 3 + &7 * v 3 pow 2 = &10` + ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC) THEN REWRITE_TAC[IQEVAL_MAT4] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC INT_RING; + CONTR_TAC + (MP (NOT_ELIM(SPECL + [`v 0:int`; `v 1:int`; `v 2:int`; `v 3:int`] + INT_DC123_NOT_10_7)) + (ASSUME + `v 0 pow 2 + &2 * v 1 pow 2 + &3 * v 2 pow 2 + + &2 * v 1 * v 3 + &2 * v 2 * v 3 + + &7 * v 3 pow 2 = &10`))]);; + +let IQ_YC123_PARAMETER_CASES = prove + (`!k:int. + &1 <= k /\ k <= &10 /\ + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&3) (&0) k) (&10) + ==> k = &1 \/ k = &2 \/ k = &3 \/ k = &5 \/ + k = &6 \/ k = &7 \/ k = &9 \/ k = &10`, + GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN + `k = &1 \/ k = &2 \/ k = &3 \/ k = &4 \/ k = &5 \/ + k = &6 \/ k = &7 \/ k = &8 \/ k = &9 \/ k = &10` + MP_TAC THENL + [ASM_INT_ARITH_TAC; + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + ASM_MESON_TAC + [IQ_YC123_NOT_REPRESENTS_10_4; + IQ_YC123_NOT_REPRESENTS_10_8]]);; + +let IQ_DC123_PARAMETER_CASES = prove + (`!k:int. + &1 <= k /\ k <= &10 /\ + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&3) (&1) k) (&10) + ==> k = &1 \/ k = &2 \/ k = &3 \/ k = &4 \/ k = &5 \/ + k = &6 \/ k = &8 \/ k = &9 \/ k = &10`, + GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN + `k = &1 \/ k = &2 \/ k = &3 \/ k = &4 \/ k = &5 \/ + k = &6 \/ k = &7 \/ k = &8 \/ k = &9 \/ k = &10` + MP_TAC THENL + [ASM_INT_ARITH_TAC; + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + ASM_MESON_TAC[IQ_DC123_NOT_REPRESENTS_10_7]]);; + +(* ------------------------------------------------------------------------- *) +(* A common induction for every child containing <1,2,3>. *) +(* ------------------------------------------------------------------------- *) + +let NUM_123_EXCEPTION_MOD16 = prove + (`!n:num. + (?a b. n = 4 EXP a * (16*b+10)) + ==> n MOD 16 = 0 \/ n MOD 16 = 8 \/ n MOD 16 = 10`, + GEN_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `a:num` + (X_CHOOSE_THEN `b:num` ASSUME_TAC)) THEN + ASM_CASES_TAC `a = 0` THENL + [DISJ2_TAC THEN DISJ2_TAC THEN + ASM_REWRITE_TAC[EXP; MULT_CLAUSES; MOD_MULT_ADD] THEN + CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + MP_TAC(SPEC `a:num` num_CASES) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST_ALL_TAC) THEN + ASM_CASES_TAC `d = 0` THENL + [DISJ2_TAC THEN DISJ1_TAC THEN + ASM_REWRITE_TAC[EXP; MULT_CLAUSES; + ARITH_RULE `4 * (16*b+10) = 16 * (4*b+2) + 8`; + MOD_MULT_ADD] THEN + CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + MP_TAC(SPEC `d:num` num_CASES) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `e:num` SUBST_ALL_TAC) THEN + DISJ1_TAC THEN + ASM_REWRITE_TAC[EXP; + ARITH_RULE `(4 * 4 * q) * r = 16 * (q*r)`; + MOD_MULT]);; + +let NUM_AVOIDS_123_OF_MOD16 = prove + (`!n:num. + ~(n MOD 16 = 0) /\ ~(n MOD 16 = 8) /\ ~(n MOD 16 = 10) + ==> ~(?a b. n = 4 EXP a * (16*b+10))`, + MESON_TAC[NUM_123_EXCEPTION_MOD16]);; + +let NUM_DIV4_OF_MOD16_0_OR_8 = prove + (`!n:num. + n MOD 16 = 0 \/ n MOD 16 = 8 + ==> 4 divides n`, + GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[DIVIDES_MOD] THEN + SUBGOAL_THEN `(n MOD 16) MOD 4 = 0` ASSUME_TAC THENL + [UNDISCH_TAC `n MOD 16 = 0 \/ n MOD 16 = 8` THEN + DISCH_THEN(DISJ_CASES_THEN ASSUME_TAC) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + SUBGOAL_THEN `(n MOD 16) MOD 4 = n MOD 4` MP_TAC THENL + [REWRITE_TAC[ARITH_RULE `16 = 4 * 4`; MOD_MOD]; + ASM_MESON_TAC[]]);; + +let NUM_AVOIDS_123_SUB_SMALL = prove + (`!n c:num. + n MOD 16 = 10 /\ + (c = 1 \/ c = 3 \/ c = 4 \/ c = 5 \/ + c = 6 \/ c = 7 \/ c = 8 \/ c = 9) + ==> ~(?a b. n - c = 4 EXP a * (16*b+10))`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC)) THEN + MP_TAC(MATCH_MP (SPECL [`n:num`; `16`; `10`] NUM_DECOMPOSE_MOD) + (CONJ (ARITH_RULE `~(16 = 0)`) (ASSUME `n MOD 16 = 10`))) THEN + DISCH_THEN(X_CHOOSE_THEN `q:num` SUBST1_TAC) THEN + MATCH_MP_TAC NUM_AVOIDS_123_OF_MOD16 THEN + REWRITE_TAC + [ARITH_RULE `(16*q+10)-1 = 16*q+9`; + ARITH_RULE `(16*q+10)-3 = 16*q+7`; + ARITH_RULE `(16*q+10)-4 = 16*q+6`; + ARITH_RULE `(16*q+10)-5 = 16*q+5`; + ARITH_RULE `(16*q+10)-6 = 16*q+4`; + ARITH_RULE `(16*q+10)-7 = 16*q+3`; + ARITH_RULE `(16*q+10)-8 = 16*q+2`; + ARITH_RULE `(16*q+10)-9 = 16*q+1`; + MOD_MULT_ADD] THEN + CONV_TAC NUM_REDUCE_CONV);; + +let INT_REPRESENTS_123_CHILD_SCALE4 = prove + (`!rb rc k n:num. + (?x y z w:int. + x pow 2 + &2 * y pow 2 + &3 * z pow 2 + + &2 * &rb * y * w + &2 * &rc * z * w + + &k * w pow 2 = &n) + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &3 * z pow 2 + + &2 * &rb * y * w + &2 * &rc * z * w + + &k * w pow 2 = &(4*n)`, + REPEAT GEN_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` + (X_CHOOSE_THEN `z:int` (X_CHOOSE_TAC `w:int`)))) THEN + MAP_EVERY EXISTS_TAC + [`&2*x:int`; `&2*y:int`; `&2*z:int`; `&2*w:int`] THEN + FIRST_X_ASSUM(MP_TAC) THEN + REWRITE_TAC[GSYM INT_OF_NUM_MUL] THEN CONV_TAC INT_RING);; + +let INT_UNIVERSAL_123_CHILD_OF_MOD16 = prove + (`!rb rc k:num. + (!n:num. + 0 < n /\ n MOD 16 = 10 + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &3 * z pow 2 + + &2 * &rb * y * w + &2 * &rc * z * w + + &k * w pow 2 = &n) + ==> !n:num. + 0 < n + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &3 * z pow 2 + + &2 * &rb * y * w + &2 * &rc * z * w + + &k * w pow 2 = &n`, + REPEAT GEN_TAC THEN DISCH_THEN(LABEL_TAC "mod16") THEN + MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN + DISCH_THEN(LABEL_TAC "ind") THEN DISCH_TAC THEN + ASM_CASES_TAC `4 divides n` THENL + [FIRST_X_ASSUM(X_CHOOSE_THEN `q:num` ASSUME_TAC o + REWRITE_RULE[divides]) THEN + SUBGOAL_THEN `q < n /\ 0 < q` STRIP_ASSUME_TAC THENL + [ASM_ARITH_TAC; + ALL_TAC] THEN + ONCE_REWRITE_TAC[ASSUME `n = 4 * q`] THEN + MATCH_MP_TAC + (SPECL [`rb:num`; `rc:num`; `k:num`; `q:num`] + INT_REPRESENTS_123_CHILD_SCALE4) THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + ASM_CASES_TAC `?a b. n = 4 EXP a * (16*b+10)` THENL + [ASM_MESON_TAC + [NUM_123_EXCEPTION_MOD16; NUM_DIV4_OF_MOD16_0_OR_8]; + MP_TAC(MATCH_MP (SPEC `n:num` REGULAR_123_NOT_FORM) + (ASSUME `~(?a b. n = 4 EXP a * (16*b+10))`)) THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` + (X_CHOOSE_THEN `z:int` (LABEL_TAC "tern")))) THEN + MAP_EVERY EXISTS_TAC [`x:int`; `y:int`; `z:int`; `&0:int`] THEN + REMOVE_THEN "tern" MP_TAC THEN CONV_TAC INT_RING]);; + +(* ------------------------------------------------------------------------- *) +(* Diagonal children x^2 + 2y^2 + 3z^2 + k w^2. *) +(* ------------------------------------------------------------------------- *) + +let INT_REPRESENTS_DIAG123_SHIFT = prove + (`!k s n:num. + k * s EXP 2 <= n /\ + ~(?a b. n - k * s EXP 2 = 4 EXP a * (16*b+10)) + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &3 * z pow 2 + + &k * w pow 2 = &n`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(MATCH_MP (SPEC `n - k * s EXP 2` REGULAR_123_NOT_FORM) + (ASSUME `~(?a b. n - k * s EXP 2 = 4 EXP a * (16*b+10))`)) THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` (X_CHOOSE_TAC `z:int`))) THEN + MAP_EVERY EXISTS_TAC [`x:int`; `y:int`; `z:int`; `&s:int`] THEN + SUBGOAL_THEN + `&(n - k * s EXP 2) = (&n:int) - (&k:int) * (&s:int) pow 2` + ASSUME_TAC THENL + [ASM_SIMP_TAC[INT_OF_NUM_SUB; INT_OF_NUM_MUL; INT_OF_NUM_POW]; + MP_TAC(REWRITE_RULE + [ASSUME + `&(n - k * s EXP 2) = (&n:int) - (&k:int) * (&s:int) pow 2`] + (ASSUME + `x pow 2 + &2 * y pow 2 + &3 * z pow 2 = + &(n - k * s EXP 2)`)) THEN + CONV_TAC INT_RING]);; + +let INT_REPRESENTS_DIAG123_SMALL_SHIFT = prove + (`!k s n:num. + 0 < n /\ n MOD 16 = 10 /\ + (k * s EXP 2 = 1 \/ k * s EXP 2 = 3 \/ + k * s EXP 2 = 4 \/ k * s EXP 2 = 5 \/ + k * s EXP 2 = 6 \/ k * s EXP 2 = 7 \/ + k * s EXP 2 = 8 \/ k * s EXP 2 = 9) + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &3 * z pow 2 + + &k * w pow 2 = &n`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC)) THEN + MATCH_MP_TAC(SPECL [`k:num`; `s:num`; `n:num`] + INT_REPRESENTS_DIAG123_SHIFT) THEN + CONJ_TAC THENL + [ASM_ARITH_TAC; + MATCH_MP_TAC(SPECL [`n:num`; `k * s EXP 2`] + NUM_AVOIDS_123_SUB_SMALL) THEN + ASM_REWRITE_TAC[]]);; + +let INT_REPRESENTS_DIAG123_MOD16 = prove + (`!k n:num. + 1 <= k /\ k <= 10 /\ 0 < n /\ n MOD 16 = 10 + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &3 * z pow 2 + + &k * w pow 2 = &n`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN + `k = 1 \/ k = 2 \/ k = 3 \/ k = 4 \/ k = 5 \/ + k = 6 \/ k = 7 \/ k = 8 \/ k = 9 \/ k = 10` + MP_TAC THENL + [ASM_ARITH_TAC; + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THENL + [MATCH_MP_TAC(SPECL [`1`; `1`; `n:num`] + INT_REPRESENTS_DIAG123_SMALL_SHIFT) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV; + MATCH_MP_TAC(SPECL [`2`; `2`; `n:num`] + INT_REPRESENTS_DIAG123_SMALL_SHIFT) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV; + MATCH_MP_TAC(SPECL [`3`; `1`; `n:num`] + INT_REPRESENTS_DIAG123_SMALL_SHIFT) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV; + MATCH_MP_TAC(SPECL [`4`; `1`; `n:num`] + INT_REPRESENTS_DIAG123_SMALL_SHIFT) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV; + MATCH_MP_TAC(SPECL [`5`; `1`; `n:num`] + INT_REPRESENTS_DIAG123_SMALL_SHIFT) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV; + MATCH_MP_TAC(SPECL [`6`; `1`; `n:num`] + INT_REPRESENTS_DIAG123_SMALL_SHIFT) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV; + MATCH_MP_TAC(SPECL [`7`; `1`; `n:num`] + INT_REPRESENTS_DIAG123_SMALL_SHIFT) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV; + MATCH_MP_TAC(SPECL [`8`; `1`; `n:num`] + INT_REPRESENTS_DIAG123_SMALL_SHIFT) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV; + MATCH_MP_TAC(SPECL [`9`; `1`; `n:num`] + INT_REPRESENTS_DIAG123_SMALL_SHIFT) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV; + ASM_CASES_TAC `n < 40` THENL + [SUBGOAL_THEN `n = 10 \/ n = 26` MP_TAC THENL + [MP_TAC(MATCH_MP (SPECL [`n:num`; `16`; `10`] + NUM_DECOMPOSE_MOD) + (CONJ (ARITH_RULE `~(16 = 0)`) + (ASSUME `n MOD 16 = 10`))) THEN + DISCH_THEN(X_CHOOSE_THEN `q:num` ASSUME_TAC) THEN + SUBGOAL_THEN `q < 2` ASSUME_TAC THENL + [ASM_ARITH_TAC; + SUBGOAL_THEN `q = 0 \/ q = 1` MP_TAC THENL + [ASM_ARITH_TAC; + DISCH_THEN(DISJ_CASES_THEN SUBST_ALL_TAC) THEN + ASM_ARITH_TAC]]; + DISCH_THEN(DISJ_CASES_THEN SUBST_ALL_TAC) THENL + [MAP_EVERY EXISTS_TAC + [`&0:int`; `&0:int`; `&0:int`; `&1:int`]; + MAP_EVERY EXISTS_TAC + [`&4:int`; `&0:int`; `&0:int`; `&1:int`]] THEN + CONV_TAC INT_REDUCE_CONV]; + MATCH_MP_TAC(SPECL [`10`; `2`; `n:num`] + INT_REPRESENTS_DIAG123_SHIFT) THEN + CONJ_TAC THENL + [CONV_TAC NUM_REDUCE_CONV THEN ASM_ARITH_TAC; + MATCH_MP_TAC(SPEC `n - 10 * 2 EXP 2` + NUM_AVOIDS_123_OF_MOD16) THEN + MP_TAC(MATCH_MP (SPECL [`n:num`; `16`; `10`] + NUM_DECOMPOSE_MOD) + (CONJ (ARITH_RULE `~(16 = 0)`) + (ASSUME `n MOD 16 = 10`))) THEN + DISCH_THEN(X_CHOOSE_THEN `q:num` ASSUME_TAC) THEN + SUBGOAL_THEN `2 <= q` ASSUME_TAC THENL + [ASM_ARITH_TAC; + MP_TAC(ASSUME `2 <= q`) THEN REWRITE_TAC[LE_EXISTS] THEN + DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST_ALL_TAC) THEN + SUBGOAL_THEN `n - 10 * 2 EXP 2 = 16 * d + 2` + SUBST1_TAC THENL + [ASM_REWRITE_TAC[] THEN ARITH_TAC; + REWRITE_TAC[MOD_MULT_ADD] THEN + CONV_TAC NUM_REDUCE_CONV]]]]]]);; + +let INT_UNIVERSAL_DIAG123_NUM = prove + (`!k:num. + 1 <= k /\ k <= 10 + ==> !n:num. + 0 < n + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &3 * z pow 2 + + &k * w pow 2 = &n`, + GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(SIMP_RULE + [INT_MUL_LZERO; INT_MUL_RZERO; INT_ADD_LID; INT_ADD_RID] + (SPECL [`0`; `0`; `k:num`] + INT_UNIVERSAL_123_CHILD_OF_MOD16)) THEN + X_GEN_TAC `n:num` THEN STRIP_TAC THEN + MATCH_MP_TAC(SPECL [`k:num`; `n:num`] + INT_REPRESENTS_DIAG123_MOD16) THEN + ASM_REWRITE_TAC[]);; + +let IQ_UNIVERSAL_DIAG123_NUM = prove + (`!k:num. + 1 <= k /\ k <= 10 + ==> iq_universal 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&0) (&3) (&0) (&k))`, + GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC + (SPECL [`&1:int`; `&2:int`; `&3:int`; `&k:int`] + IQ_UNIVERSAL_MAT4_DIAG) THEN + MATCH_MP_TAC + (SPECL [`&1:int`; `&2:int`; `&3:int`; `&k:int`] + IQ_UNIVERSAL_DIAG4_OF_NUM) THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN + MP_TAC(MATCH_MP + (MATCH_MP (SPEC `k:num` INT_UNIVERSAL_DIAG123_NUM) + (ASSUME `1 <= k /\ k <= 10`)) + (ASSUME `0 < n`)) THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` + (X_CHOOSE_THEN `z:int` (X_CHOOSE_TAC `w:int`)))) THEN + MAP_EVERY EXISTS_TAC [`x:int`; `y:int`; `z:int`; `w:int`] THEN + FIRST_X_ASSUM(MP_TAC) THEN CONV_TAC INT_RING);; + +let IQ_UNIVERSAL_OF_DIAG123_CHILD = prove + (`!n A k. + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&0) (&3) (&0) k) A /\ + &1 <= k /\ k <= &10 + ==> iq_universal n A`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(EQ_MP (SYM(SPEC `k:int` INT_OF_NUM_EXISTS)) + (MATCH_MP (INT_ARITH `&1 <= k ==> &0 <= k`) + (ASSUME `&1 <= k`))) THEN + DISCH_THEN(X_CHOOSE_THEN `c:num` SUBST_ALL_TAC) THEN + SUBGOAL_THEN `1 <= c /\ c <= 10` ASSUME_TAC THENL + [UNDISCH_TAC `&1 <= &c` THEN + UNDISCH_TAC `&c <= &10` THEN + REWRITE_TAC[INT_OF_NUM_LE] THEN ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(ISPECL + [`n:num`; `4`; + `iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&0) (&3) (&0) (&c)`; + `A:num->num->int`] IQ_UNIVERSAL_OF_EMBEDS) THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + MATCH_MP_TAC(SPEC `c:num` IQ_UNIVERSAL_DIAG123_NUM) THEN + ASM_REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Crossed children. *) +(* ------------------------------------------------------------------------- *) + +(* The bounded checks below are proof-producing searches: the search only + supplies concrete witnesses, which INT_REDUCE_CONV then verifies. *) + +let int123_num_of_int i = + if i < 0 + then minus_num(num_of_string(string_of_int(-i))) + else num_of_string(string_of_int i);; + +let INT123_CERT_TAC rb rc k = + fun (asl,goal) -> + let _,bod = strip_exists goal in + let _,rhs = dest_eq bod in + let n = int_of_string(string_of_num(dest_intconst rhs)) in + let bound = + int_of_float(float_sqrt(float_of_int(6 * n))) + 2 in + let signed i = + if i = 0 then 0 else if i mod 2 = 1 then (i + 1) / 2 else -(i / 2) in + let rec find_w iw = + if iw > 2 * bound then failwith "INT123_CERT_TAC" else + let w = signed iw in + let rec find_z iz = + if iz > 2 * bound then find_w (iw + 1) else + let z = signed iz in + let rec find_y iy = + if iy > 2 * bound then find_z (iz + 1) else + let y = signed iy in + let r = + n - 2*y*y - 3*z*z - 2*rb*y*w - 2*rc*z*w - k*w*w in + if r < 0 then find_y (iy + 1) else + let x = int_of_float(float_sqrt(float_of_int r)) in + if x*x = r then (x,y,z,w) else find_y (iy + 1) in + find_y 0 in + find_z 0 in + let x,y,z,w = find_w 0 in + (MAP_EVERY EXISTS_TAC + (map (mk_intconst o int123_num_of_int) [x;y;z;w]) THEN + CONV_TAC INT_REDUCE_CONV) (asl,goal);; + +(* Close each concrete case before opening the next one. This lets THENL + collapse the finished justification instead of retaining every subgoal. *) +let NUM_RANGE_CASES_THEN tm hi tac = + let rec cases tm i = + let v = genvar `:num` in + MP_TAC(SPEC tm num_CASES) THEN + DISCH_THEN(DISJ_CASES_THEN2 SUBST_ALL_TAC + (X_CHOOSE_THEN v SUBST_ALL_TAC)) THENL + [tac; + if i = hi then ASM_ARITH_TAC else cases v (i + 1)] in + cases tm 0;; + +let NUM_RANGE_CASES_TAC tm hi = + NUM_RANGE_CASES_THEN tm hi ALL_TAC;; + +let NUM_INTERVAL_CASES_THEN tm lo hi tac = + let rec cases lo hi = + if lo > hi then failwith "NUM_INTERVAL_CASES_THEN" else + if lo = hi then + SUBGOAL_THEN (mk_eq(tm,mk_small_numeral lo)) SUBST_ALL_TAC THENL + [ASM_ARITH_TAC; + tac] + else + let mid = (lo + hi) / 2 in + let cond = + mk_comb + (mk_comb(`(<=):num->num->bool`,tm), + mk_small_numeral mid) in + ASM_CASES_TAC cond THENL + [cases lo mid; + cases (mid + 1) hi] in + cases lo hi;; + +let NUM_AVOIDS_123_SUB_OF_RESIDUE = prove + (`!n c:num. + c <= n /\ n MOD 16 = 10 /\ + ~(c MOD 16 = 0) /\ ~(c MOD 16 = 2) /\ ~(c MOD 16 = 10) + ==> ~(?a b. n - c = 4 EXP a * (16*b+10))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + DISCH_THEN(fun th -> + MP_TAC(MATCH_MP (SPEC `n - c:num` NUM_123_EXCEPTION_MOD16) th)) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THEN + (SUBGOAL_THEN + `((n - c) MOD 16 + c MOD 16) MOD 16 = 10` + ASSUME_TAC THENL + [REWRITE_TAC[MOD_ADD_MOD] THEN + ASM_SIMP_TAC[SUB_ADD]; + ALL_TAC]) THEN + MP_TAC(SPECL [`(n - c) MOD 16`; `c MOD 16`; `16`] + MOD_ADD_CASES) THEN + (ANTS_TAC THENL + [CONJ_TAC THEN REWRITE_TAC[MOD_LT_EQ] THEN ARITH_TAC; + ASM_REWRITE_TAC[] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC]));; + +let INT_REPRESENTS_ZC123_SHIFT = prove + (`!k s n:num. + 1 <= k /\ + (9*k - 3) * s EXP 2 <= n /\ + ~(?a b. n - (9*k - 3) * s EXP 2 = + 4 EXP a * (16*b+10)) + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &3 * z pow 2 + + &2 * z * w + &k * w pow 2 = &n`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(MATCH_MP + (SPEC `n - (9*k - 3) * s EXP 2` REGULAR_123_NOT_FORM) + (ASSUME + `~(?a b. n - (9*k - 3) * s EXP 2 = + 4 EXP a * (16*b+10))`)) THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` (X_CHOOSE_TAC `z:int`))) THEN + MAP_EVERY EXISTS_TAC + [`x:int`; `y:int`; `z - &s:int`; `&3 * &s:int`] THEN + SUBGOAL_THEN `3 <= 9*k` ASSUME_TAC THENL + [ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `&(n - (9*k - 3) * s EXP 2) = + (&n:int) - (&9 * &k - &3) * &s pow 2` + ASSUME_TAC THENL + [ASM_SIMP_TAC[INT_OF_NUM_SUB; INT_OF_NUM_MUL; INT_OF_NUM_POW]; + MP_TAC(REWRITE_RULE + [ASSUME + `&(n - (9*k - 3) * s EXP 2) = + (&n:int) - (&9 * &k - &3) * &s pow 2`] + (ASSUME + `x pow 2 + &2 * y pow 2 + &3 * z pow 2 = + &(n - (9*k - 3) * s EXP 2)`)) THEN + CONV_TAC INT_RING]);; + +let INT_REPRESENTS_YC123_SHIFT = prove + (`!k s n:num. + 1 <= k /\ + (4*k - 2) * s EXP 2 <= n /\ + ~(?a b. n - (4*k - 2) * s EXP 2 = + 4 EXP a * (16*b+10)) + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &3 * z pow 2 + + &2 * y * w + &k * w pow 2 = &n`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(MATCH_MP + (SPEC `n - (4*k - 2) * s EXP 2` REGULAR_123_NOT_FORM) + (ASSUME + `~(?a b. n - (4*k - 2) * s EXP 2 = + 4 EXP a * (16*b+10))`)) THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` (X_CHOOSE_TAC `z:int`))) THEN + MAP_EVERY EXISTS_TAC + [`x:int`; `y - &s:int`; `z:int`; `&2 * &s:int`] THEN + SUBGOAL_THEN `2 <= 4*k` ASSUME_TAC THENL + [ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `&(n - (4*k - 2) * s EXP 2) = + (&n:int) - (&4 * &k - &2) * &s pow 2` + ASSUME_TAC THENL + [ASM_SIMP_TAC[INT_OF_NUM_SUB; INT_OF_NUM_MUL; INT_OF_NUM_POW]; + MP_TAC(REWRITE_RULE + [ASSUME + `&(n - (4*k - 2) * s EXP 2) = + (&n:int) - (&4 * &k - &2) * &s pow 2`] + (ASSUME + `x pow 2 + &2 * y pow 2 + &3 * z pow 2 = + &(n - (4*k - 2) * s EXP 2)`)) THEN + CONV_TAC INT_RING]);; + +let INT_REPRESENTS_DC123_SHIFT = prove + (`!k s n:num. + 1 <= k /\ + (36*k - 30) * s EXP 2 <= n /\ + ~(?a b. n - (36*k - 30) * s EXP 2 = + 4 EXP a * (16*b+10)) + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &3 * z pow 2 + + &2 * y * w + &2 * z * w + &k * w pow 2 = &n`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(MATCH_MP + (SPEC `n - (36*k - 30) * s EXP 2` REGULAR_123_NOT_FORM) + (ASSUME + `~(?a b. n - (36*k - 30) * s EXP 2 = + 4 EXP a * (16*b+10))`)) THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` (X_CHOOSE_TAC `z:int`))) THEN + MAP_EVERY EXISTS_TAC + [`x:int`; `y - &3 * &s:int`; `z - &2 * &s:int`; + `&6 * &s:int`] THEN + SUBGOAL_THEN `30 <= 36*k` ASSUME_TAC THENL + [ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `&(n - (36*k - 30) * s EXP 2) = + (&n:int) - (&36 * &k - &30) * &s pow 2` + ASSUME_TAC THENL + [ASM_SIMP_TAC[INT_OF_NUM_SUB; INT_OF_NUM_MUL; INT_OF_NUM_POW]; + MP_TAC(REWRITE_RULE + [ASSUME + `&(n - (36*k - 30) * s EXP 2) = + (&n:int) - (&36 * &k - &30) * &s pow 2`] + (ASSUME + `x pow 2 + &2 * y pow 2 + &3 * z pow 2 = + &(n - (36*k - 30) * s EXP 2)`)) THEN + CONV_TAC INT_RING]);; + +let INT_REPRESENTS_ZC123_SMALL = prove + (`!k q:num. + 1 <= k /\ k <= 10 /\ q < 10 + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &3 * z pow 2 + + &2 * z * w + &k * w pow 2 = &(16*q+10)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN + `k = 1 \/ k = 2 \/ k = 3 \/ k = 4 \/ k = 5 \/ + k = 6 \/ k = 7 \/ k = 8 \/ k = 9 \/ k = 10` + MP_TAC THENL + [ASM_ARITH_TAC; + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THENL + [NUM_RANGE_CASES_TAC `q:num` 9 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT123_CERT_TAC 0 1 1; + NUM_RANGE_CASES_TAC `q:num` 9 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT123_CERT_TAC 0 1 2; + NUM_RANGE_CASES_TAC `q:num` 9 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT123_CERT_TAC 0 1 3; + NUM_RANGE_CASES_TAC `q:num` 9 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT123_CERT_TAC 0 1 4; + NUM_RANGE_CASES_TAC `q:num` 9 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT123_CERT_TAC 0 1 5; + NUM_RANGE_CASES_TAC `q:num` 9 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT123_CERT_TAC 0 1 6; + NUM_RANGE_CASES_TAC `q:num` 9 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT123_CERT_TAC 0 1 7; + NUM_RANGE_CASES_TAC `q:num` 9 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT123_CERT_TAC 0 1 8; + NUM_RANGE_CASES_TAC `q:num` 9 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT123_CERT_TAC 0 1 9; + NUM_RANGE_CASES_TAC `q:num` 9 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT123_CERT_TAC 0 1 10]]);; + +let INT_REPRESENTS_YC123_SMALL = prove + (`!k q:num. + (k = 1 \/ k = 2 \/ k = 3 \/ k = 5 \/ + k = 6 \/ k = 7 \/ k = 9 \/ k = 10) /\ + q < 9 + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &3 * z pow 2 + + &2 * y * w + &k * w pow 2 = &(16*q+10)`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 + (REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) ASSUME_TAC) THENL + [NUM_RANGE_CASES_TAC `q:num` 8 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT123_CERT_TAC 1 0 1; + NUM_RANGE_CASES_TAC `q:num` 8 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT123_CERT_TAC 1 0 2; + NUM_RANGE_CASES_TAC `q:num` 8 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT123_CERT_TAC 1 0 3; + NUM_RANGE_CASES_TAC `q:num` 8 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT123_CERT_TAC 1 0 5; + NUM_RANGE_CASES_TAC `q:num` 8 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT123_CERT_TAC 1 0 6; + NUM_RANGE_CASES_TAC `q:num` 8 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT123_CERT_TAC 1 0 7; + NUM_RANGE_CASES_TAC `q:num` 8 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT123_CERT_TAC 1 0 9; + NUM_RANGE_CASES_TAC `q:num` 8 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT123_CERT_TAC 1 0 10]);; + +let INT_REPRESENTS_DC123_SMALL_2 = prove + (`!q:num. + q < 10 + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &3 * z pow 2 + + &2 * y * w + &2 * z * w + &2 * w pow 2 = &(16*q+10)`, + GEN_TAC THEN DISCH_TAC THEN NUM_RANGE_CASES_TAC `q:num` 9 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT123_CERT_TAC 1 1 2);; + +let INT_REPRESENTS_DC123_SMALL_3 = prove + (`!q:num. + q < 5 + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &3 * z pow 2 + + &2 * y * w + &2 * z * w + &3 * w pow 2 = &(16*q+10)`, + GEN_TAC THEN DISCH_TAC THEN NUM_RANGE_CASES_TAC `q:num` 4 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT123_CERT_TAC 1 1 3);; + +let INT_REPRESENTS_DC123_SMALL_4 = prove + (`!q:num. + q < 28 + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &3 * z pow 2 + + &2 * y * w + &2 * z * w + &4 * w pow 2 = &(16*q+10)`, + GEN_TAC THEN DISCH_TAC THEN NUM_RANGE_CASES_TAC `q:num` 27 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT123_CERT_TAC 1 1 4);; + +let INT_REPRESENTS_DC123_SMALL_5 = prove + (`!q:num. + q < 9 + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &3 * z pow 2 + + &2 * y * w + &2 * z * w + &5 * w pow 2 = &(16*q+10)`, + GEN_TAC THEN DISCH_TAC THEN NUM_RANGE_CASES_TAC `q:num` 8 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT123_CERT_TAC 1 1 5);; + +let INT_REPRESENTS_DC123_SMALL_6 = prove + (`!q:num. + q < 46 + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &3 * z pow 2 + + &2 * y * w + &2 * z * w + &6 * w pow 2 = &(16*q+10)`, + GEN_TAC THEN DISCH_TAC THEN NUM_RANGE_CASES_TAC `q:num` 45 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT123_CERT_TAC 1 1 6);; + +let INT_REPRESENTS_DC123_SMALL_8 = prove + (`!q:num. + q < 64 + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &3 * z pow 2 + + &2 * y * w + &2 * z * w + &8 * w pow 2 = &(16*q+10)`, + GEN_TAC THEN DISCH_TAC THEN NUM_RANGE_CASES_TAC `q:num` 63 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT123_CERT_TAC 1 1 8);; + +let INT_REPRESENTS_DC123_SMALL_9 = prove + (`!q:num. + q < 18 + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &3 * z pow 2 + + &2 * y * w + &2 * z * w + &9 * w pow 2 = &(16*q+10)`, + GEN_TAC THEN DISCH_TAC THEN NUM_RANGE_CASES_TAC `q:num` 17 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT123_CERT_TAC 1 1 9);; + +let INT_REPRESENTS_DC123_SMALL_10 = prove + (`!q:num. + q < 82 + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &3 * z pow 2 + + &2 * y * w + &2 * z * w + &10 * w pow 2 = &(16*q+10)`, + GEN_TAC THEN DISCH_TAC THEN NUM_RANGE_CASES_TAC `q:num` 81 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT123_CERT_TAC 1 1 10);; + +let NUM_ZC123_OFFSET_RESIDUE = prove + (`!k:num. + 1 <= k /\ k <= 10 /\ ~(k = 5) + ==> ~((9*k - 3) MOD 16 = 0) /\ + ~((9*k - 3) MOD 16 = 2) /\ + ~((9*k - 3) MOD 16 = 10)`, + GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN + `k = 1 \/ k = 2 \/ k = 3 \/ k = 4 \/ k = 5 \/ + k = 6 \/ k = 7 \/ k = 8 \/ k = 9 \/ k = 10` + MP_TAC THENL + [ASM_ARITH_TAC; + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN + ASM_MESON_TAC[]]);; + +let INT_REPRESENTS_ZC123_SHIFT_MOD16 = prove + (`!k s n:num. + 1 <= k /\ + (9*k - 3) * s EXP 2 <= n /\ + n MOD 16 = 10 /\ + ~(((9*k - 3) * s EXP 2) MOD 16 = 0) /\ + ~(((9*k - 3) * s EXP 2) MOD 16 = 2) /\ + ~(((9*k - 3) * s EXP 2) MOD 16 = 10) + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &3 * z pow 2 + + &2 * z * w + &k * w pow 2 = &n`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC(SPECL [`k:num`; `s:num`; `n:num`] + INT_REPRESENTS_ZC123_SHIFT) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(SPECL + [`n:num`; `(9*k - 3) * s EXP 2`] NUM_AVOIDS_123_SUB_OF_RESIDUE) THEN + ASM_REWRITE_TAC[]);; + +let INT_REPRESENTS_YC123_SHIFT_MOD16 = prove + (`!k s n:num. + 1 <= k /\ + (4*k - 2) * s EXP 2 <= n /\ + n MOD 16 = 10 /\ + ~(((4*k - 2) * s EXP 2) MOD 16 = 0) /\ + ~(((4*k - 2) * s EXP 2) MOD 16 = 2) /\ + ~(((4*k - 2) * s EXP 2) MOD 16 = 10) + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &3 * z pow 2 + + &2 * y * w + &k * w pow 2 = &n`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC(SPECL [`k:num`; `s:num`; `n:num`] + INT_REPRESENTS_YC123_SHIFT) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(SPECL + [`n:num`; `(4*k - 2) * s EXP 2`] NUM_AVOIDS_123_SUB_OF_RESIDUE) THEN + ASM_REWRITE_TAC[]);; + +let INT_REPRESENTS_DC123_SHIFT_MOD16 = prove + (`!k s n:num. + 1 <= k /\ + (36*k - 30) * s EXP 2 <= n /\ + n MOD 16 = 10 /\ + ~(((36*k - 30) * s EXP 2) MOD 16 = 0) /\ + ~(((36*k - 30) * s EXP 2) MOD 16 = 2) /\ + ~(((36*k - 30) * s EXP 2) MOD 16 = 10) + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &3 * z pow 2 + + &2 * y * w + &2 * z * w + &k * w pow 2 = &n`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC(SPECL [`k:num`; `s:num`; `n:num`] + INT_REPRESENTS_DC123_SHIFT) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(SPECL + [`n:num`; `(36*k - 30) * s EXP 2`] + NUM_AVOIDS_123_SUB_OF_RESIDUE) THEN + ASM_REWRITE_TAC[]);; + +let INT_REPRESENTS_ZC123_MOD16 = prove + (`!k n:num. + 1 <= k /\ k <= 10 /\ 0 < n /\ n MOD 16 = 10 + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &3 * z pow 2 + + &2 * z * w + &k * w pow 2 = &n`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(MATCH_MP (SPECL [`n:num`; `16`; `10`] NUM_DECOMPOSE_MOD) + (CONJ (ARITH_RULE `~(16 = 0)`) (ASSUME `n MOD 16 = 10`))) THEN + DISCH_THEN(X_CHOOSE_THEN `q:num` ASSUME_TAC) THEN + ASM_CASES_TAC `168 <= n` THENL + [ASM_CASES_TAC `k = 5` THENL + [MATCH_MP_TAC(SPECL [`k:num`; `2`; `n:num`] + INT_REPRESENTS_ZC123_SHIFT_MOD16) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN + ASM_ARITH_TAC; + MP_TAC(MATCH_MP (SPEC `k:num` NUM_ZC123_OFFSET_RESIDUE) + (CONJ (ASSUME `1 <= k`) + (CONJ (ASSUME `k <= 10`) (ASSUME `~(k = 5)`)))) THEN + REWRITE_TAC[EXP; MULT_CLAUSES] THEN STRIP_TAC THEN + MATCH_MP_TAC(SPECL [`k:num`; `1`; `n:num`] + INT_REPRESENTS_ZC123_SHIFT_MOD16) THEN + CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[MULT_CLAUSES] THEN + ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC]; + ONCE_REWRITE_TAC[ASSUME `n = 16*q+10`] THEN + MATCH_MP_TAC(SPECL [`k:num`; `q:num`] + INT_REPRESENTS_ZC123_SMALL) THEN + ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC]);; + +let INT_REPRESENTS_YC123_MOD16 = prove + (`!k n:num. + (k = 1 \/ k = 2 \/ k = 3 \/ k = 5 \/ + k = 6 \/ k = 7 \/ k = 9 \/ k = 10) /\ + 0 < n /\ n MOD 16 = 10 + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &3 * z pow 2 + + &2 * y * w + &k * w pow 2 = &n`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC)) THEN + UNDISCH_TAC + `k = 1 \/ k = 2 \/ k = 3 \/ k = 5 \/ + k = 6 \/ k = 7 \/ k = 9 \/ k = 10` THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + MP_TAC(MATCH_MP (SPECL [`n:num`; `16`; `10`] NUM_DECOMPOSE_MOD) + (CONJ (ARITH_RULE `~(16 = 0)`) (ASSUME `n MOD 16 = 10`))) THEN + DISCH_THEN(X_CHOOSE_THEN `q:num` ASSUME_TAC) THEN + (ASM_CASES_TAC `152 <= n` THENL + [MATCH_MP_TAC(SPECL [`k:num`; `2`; `n:num`] + INT_REPRESENTS_YC123_SHIFT_MOD16) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN + ASM_ARITH_TAC; + ONCE_REWRITE_TAC[ASSUME `n = 16*q+10`] THEN + MATCH_MP_TAC(SPECL [`k:num`; `q:num`] + INT_REPRESENTS_YC123_SMALL) THEN + ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC]));; + +let INT_REPRESENTS_DC123_MOD16 = prove + (`!k n:num. + (k = 1 \/ k = 2 \/ k = 3 \/ k = 4 \/ k = 5 \/ + k = 6 \/ k = 8 \/ k = 9 \/ k = 10) /\ + 0 < n /\ n MOD 16 = 10 + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &3 * z pow 2 + + &2 * y * w + &2 * z * w + &k * w pow 2 = &n`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC)) THEN + MP_TAC(MATCH_MP (SPECL [`n:num`; `16`; `10`] NUM_DECOMPOSE_MOD) + (CONJ (ARITH_RULE `~(16 = 0)`) (ASSUME `n MOD 16 = 10`))) THEN + DISCH_THEN(X_CHOOSE_THEN `q:num` ASSUME_TAC) THEN + UNDISCH_TAC + `k = 1 \/ k = 2 \/ k = 3 \/ k = 4 \/ k = 5 \/ + k = 6 \/ k = 8 \/ k = 9 \/ k = 10` THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THENL + [MATCH_MP_TAC(SPECL [`1`; `1`; `n:num`] + INT_REPRESENTS_DC123_SHIFT_MOD16) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN ASM_ARITH_TAC; + ASM_CASES_TAC `168 <= n` THENL + [MATCH_MP_TAC(SPECL [`2`; `2`; `n:num`] + INT_REPRESENTS_DC123_SHIFT_MOD16) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN + ASM_ARITH_TAC; + ONCE_REWRITE_TAC[ASSUME `n = 16*q+10`] THEN + MATCH_MP_TAC(SPEC `q:num` INT_REPRESENTS_DC123_SMALL_2) THEN + ASM_ARITH_TAC]; + ASM_CASES_TAC `78 <= n` THENL + [MATCH_MP_TAC(SPECL [`3`; `1`; `n:num`] + INT_REPRESENTS_DC123_SHIFT_MOD16) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN + ASM_ARITH_TAC; + ONCE_REWRITE_TAC[ASSUME `n = 16*q+10`] THEN + MATCH_MP_TAC(SPEC `q:num` INT_REPRESENTS_DC123_SMALL_3) THEN + ASM_ARITH_TAC]; + ASM_CASES_TAC `456 <= n` THENL + [MATCH_MP_TAC(SPECL [`4`; `2`; `n:num`] + INT_REPRESENTS_DC123_SHIFT_MOD16) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN + ASM_ARITH_TAC; + ONCE_REWRITE_TAC[ASSUME `n = 16*q+10`] THEN + MATCH_MP_TAC(SPEC `q:num` INT_REPRESENTS_DC123_SMALL_4) THEN + ASM_ARITH_TAC]; + ASM_CASES_TAC `150 <= n` THENL + [MATCH_MP_TAC(SPECL [`5`; `1`; `n:num`] + INT_REPRESENTS_DC123_SHIFT_MOD16) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN + ASM_ARITH_TAC; + ONCE_REWRITE_TAC[ASSUME `n = 16*q+10`] THEN + MATCH_MP_TAC(SPEC `q:num` INT_REPRESENTS_DC123_SMALL_5) THEN + ASM_ARITH_TAC]; + ASM_CASES_TAC `744 <= n` THENL + [MATCH_MP_TAC(SPECL [`6`; `2`; `n:num`] + INT_REPRESENTS_DC123_SHIFT_MOD16) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN + ASM_ARITH_TAC; + ONCE_REWRITE_TAC[ASSUME `n = 16*q+10`] THEN + MATCH_MP_TAC(SPEC `q:num` INT_REPRESENTS_DC123_SMALL_6) THEN + ASM_ARITH_TAC]; + ASM_CASES_TAC `1032 <= n` THENL + [MATCH_MP_TAC(SPECL [`8`; `2`; `n:num`] + INT_REPRESENTS_DC123_SHIFT_MOD16) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN + ASM_ARITH_TAC; + ONCE_REWRITE_TAC[ASSUME `n = 16*q+10`] THEN + MATCH_MP_TAC(SPEC `q:num` INT_REPRESENTS_DC123_SMALL_8) THEN + ASM_ARITH_TAC]; + ASM_CASES_TAC `294 <= n` THENL + [MATCH_MP_TAC(SPECL [`9`; `1`; `n:num`] + INT_REPRESENTS_DC123_SHIFT_MOD16) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN + ASM_ARITH_TAC; + ONCE_REWRITE_TAC[ASSUME `n = 16*q+10`] THEN + MATCH_MP_TAC(SPEC `q:num` INT_REPRESENTS_DC123_SMALL_9) THEN + ASM_ARITH_TAC]; + ASM_CASES_TAC `1320 <= n` THENL + [MATCH_MP_TAC(SPECL [`10`; `2`; `n:num`] + INT_REPRESENTS_DC123_SHIFT_MOD16) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN + ASM_ARITH_TAC; + ONCE_REWRITE_TAC[ASSUME `n = 16*q+10`] THEN + MATCH_MP_TAC(SPEC `q:num` INT_REPRESENTS_DC123_SMALL_10) THEN + ASM_ARITH_TAC]]);; + +let INT_UNIVERSAL_ZC123_NUM = prove + (`!k:num. + 1 <= k /\ k <= 10 + ==> !n:num. + 0 < n + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &3 * z pow 2 + + &2 * z * w + &k * w pow 2 = &n`, + GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(SIMP_RULE + [INT_MUL_LZERO; INT_MUL_RZERO; INT_MUL_LID; INT_MUL_RID; + INT_ADD_LID; INT_ADD_RID] + (SPECL [`0`; `1`; `k:num`] + INT_UNIVERSAL_123_CHILD_OF_MOD16)) THEN + X_GEN_TAC `n:num` THEN STRIP_TAC THEN + MATCH_MP_TAC(SPECL [`k:num`; `n:num`] + INT_REPRESENTS_ZC123_MOD16) THEN + ASM_REWRITE_TAC[]);; + +let INT_UNIVERSAL_YC123_NUM = prove + (`!k:num. + (k = 1 \/ k = 2 \/ k = 3 \/ k = 5 \/ + k = 6 \/ k = 7 \/ k = 9 \/ k = 10) + ==> !n:num. + 0 < n + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &3 * z pow 2 + + &2 * y * w + &k * w pow 2 = &n`, + GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(SIMP_RULE + [INT_MUL_LZERO; INT_MUL_RZERO; INT_MUL_LID; INT_MUL_RID; + INT_ADD_LID; INT_ADD_RID] + (SPECL [`1`; `0`; `k:num`] + INT_UNIVERSAL_123_CHILD_OF_MOD16)) THEN + X_GEN_TAC `n:num` THEN STRIP_TAC THEN + MATCH_MP_TAC(SPECL [`k:num`; `n:num`] + INT_REPRESENTS_YC123_MOD16) THEN + ASM_REWRITE_TAC[]);; + +let INT_UNIVERSAL_DC123_NUM = prove + (`!k:num. + (k = 1 \/ k = 2 \/ k = 3 \/ k = 4 \/ k = 5 \/ + k = 6 \/ k = 8 \/ k = 9 \/ k = 10) + ==> !n:num. + 0 < n + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &3 * z pow 2 + + &2 * y * w + &2 * z * w + &k * w pow 2 = &n`, + GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(SIMP_RULE + [INT_MUL_LZERO; INT_MUL_RZERO; INT_MUL_LID; INT_MUL_RID; + INT_ADD_LID; INT_ADD_RID] + (SPECL [`1`; `1`; `k:num`] + INT_UNIVERSAL_123_CHILD_OF_MOD16)) THEN + X_GEN_TAC `n:num` THEN STRIP_TAC THEN + MATCH_MP_TAC(SPECL [`k:num`; `n:num`] + INT_REPRESENTS_DC123_MOD16) THEN + ASM_REWRITE_TAC[]);; + +let IQ_UNIVERSAL_123_CHILD_OF_NUM = prove + (`!rb rc k:num. + (!n:num. + 0 < n + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &3 * z pow 2 + + &2 * &rb * y * w + &2 * &rc * z * w + + &k * w pow 2 = &n) + ==> iq_universal 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&rb) (&3) (&rc) (&k))`, + REPEAT GEN_TAC THEN DISCH_THEN(LABEL_TAC "all") THEN + REWRITE_TAC[iq_universal] THEN + X_GEN_TAC `m:int` THEN DISCH_TAC THEN + MP_TAC(EQ_MP (SYM(SPEC `m:int` INT_OF_NUM_EXISTS)) + (MATCH_MP (SPECL [`&0:int`; `m:int`] INT_LT_IMP_LE) + (ASSUME `&0 < m`))) THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` SUBST_ALL_TAC) THEN + REMOVE_THEN "all" (MP_TAC o SPEC `n:num`) THEN + ANTS_TAC THENL + [UNDISCH_TAC `&0 < &n` THEN REWRITE_TAC[INT_OF_NUM_LT]; + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` + (X_CHOOSE_THEN `z:int` (X_CHOOSE_TAC `w:int`)))) THEN + REWRITE_TAC[iq_represents] THEN + EXISTS_TAC + `\i:num. + if i = 0 then (x:int) else if i = 1 then y else + if i = 2 then z else w` THEN + REWRITE_TAC[IQEVAL_MAT4] THEN + CONV_TAC NUM_REDUCE_CONV THEN + FIRST_X_ASSUM(MP_TAC) THEN CONV_TAC INT_RING]);; + +let IQ_UNIVERSAL_ZC123_NUM = prove + (`!k:num. + 1 <= k /\ k <= 10 + ==> iq_universal 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&0) (&3) (&1) (&k))`, + GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(SIMP_RULE + [INT_MUL_LZERO; INT_MUL_RZERO; INT_MUL_LID; INT_MUL_RID; + INT_ADD_LID; INT_ADD_RID] + (SPECL [`0`; `1`; `k:num`] IQ_UNIVERSAL_123_CHILD_OF_NUM)) THEN + MATCH_MP_TAC(SPEC `k:num` INT_UNIVERSAL_ZC123_NUM) THEN + ASM_REWRITE_TAC[]);; + +let IQ_UNIVERSAL_YC123_NUM = prove + (`!k:num. + (k = 1 \/ k = 2 \/ k = 3 \/ k = 5 \/ + k = 6 \/ k = 7 \/ k = 9 \/ k = 10) + ==> iq_universal 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&3) (&0) (&k))`, + GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(SIMP_RULE + [INT_MUL_LZERO; INT_MUL_RZERO; INT_MUL_LID; INT_MUL_RID; + INT_ADD_LID; INT_ADD_RID] + (SPECL [`1`; `0`; `k:num`] IQ_UNIVERSAL_123_CHILD_OF_NUM)) THEN + MATCH_MP_TAC(SPEC `k:num` INT_UNIVERSAL_YC123_NUM) THEN + ASM_REWRITE_TAC[]);; + +let IQ_UNIVERSAL_DC123_NUM = prove + (`!k:num. + (k = 1 \/ k = 2 \/ k = 3 \/ k = 4 \/ k = 5 \/ + k = 6 \/ k = 8 \/ k = 9 \/ k = 10) + ==> iq_universal 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&3) (&1) (&k))`, + GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(SIMP_RULE + [INT_MUL_LZERO; INT_MUL_RZERO; INT_MUL_LID; INT_MUL_RID; + INT_ADD_LID; INT_ADD_RID] + (SPECL [`1`; `1`; `k:num`] IQ_UNIVERSAL_123_CHILD_OF_NUM)) THEN + MATCH_MP_TAC(SPEC `k:num` INT_UNIVERSAL_DC123_NUM) THEN + ASM_REWRITE_TAC[]);; + +let IQ_UNIVERSAL_OF_ZC123_CHILD = prove + (`!n A k. + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&0) (&3) (&1) k) A /\ + &1 <= k /\ k <= &10 + ==> iq_universal n A`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(EQ_MP (SYM(SPEC `k:int` INT_OF_NUM_EXISTS)) + (MATCH_MP (INT_ARITH `&1 <= k ==> &0 <= k`) + (ASSUME `&1 <= k`))) THEN + DISCH_THEN(X_CHOOSE_THEN `c:num` SUBST_ALL_TAC) THEN + SUBGOAL_THEN `1 <= c /\ c <= 10` ASSUME_TAC THENL + [UNDISCH_TAC `&1 <= &c` THEN + UNDISCH_TAC `&c <= &10` THEN + REWRITE_TAC[INT_OF_NUM_LE] THEN ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(ISPECL + [`n:num`; `4`; + `iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&0) (&3) (&1) (&c)`; + `A:num->num->int`] IQ_UNIVERSAL_OF_EMBEDS) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(SPEC `c:num` IQ_UNIVERSAL_ZC123_NUM) THEN + ASM_REWRITE_TAC[]);; + +let IQ_UNIVERSAL_OF_YC123_CHILD = prove + (`!n A k. + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&3) (&0) k) A /\ + (k = &1 \/ k = &2 \/ k = &3 \/ k = &5 \/ + k = &6 \/ k = &7 \/ k = &9 \/ k = &10) + ==> iq_universal n A`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC) THEN + SUBGOAL_THEN `&0 <= k` ASSUME_TAC THENL + [ASM_MESON_TAC[INT_ARITH + `&0 <= &1 /\ &0 <= &2 /\ &0 <= &3 /\ &0 <= &5 /\ + &0 <= &6 /\ &0 <= &7 /\ &0 <= &9 /\ &0 <= &10`]; + ALL_TAC] THEN + MP_TAC(EQ_MP (SYM(SPEC `k:int` INT_OF_NUM_EXISTS)) + (ASSUME `&0 <= k`)) THEN + DISCH_THEN(X_CHOOSE_THEN `c:num` SUBST_ALL_TAC) THEN + SUBGOAL_THEN + `c = 1 \/ c = 2 \/ c = 3 \/ c = 5 \/ + c = 6 \/ c = 7 \/ c = 9 \/ c = 10` + ASSUME_TAC THENL + [UNDISCH_TAC + `&c = &1 \/ &c = &2 \/ &c = &3 \/ &c = &5 \/ + &c = &6 \/ &c = &7 \/ &c = &9 \/ &c = &10` THEN + REWRITE_TAC[INT_OF_NUM_EQ]; + ALL_TAC] THEN + MATCH_MP_TAC(ISPECL + [`n:num`; `4`; + `iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&3) (&0) (&c)`; + `A:num->num->int`] IQ_UNIVERSAL_OF_EMBEDS) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(SPEC `c:num` IQ_UNIVERSAL_YC123_NUM) THEN + ASM_REWRITE_TAC[]);; + +let IQ_UNIVERSAL_OF_DC123_CHILD = prove + (`!n A k. + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&3) (&1) k) A /\ + (k = &1 \/ k = &2 \/ k = &3 \/ k = &4 \/ k = &5 \/ + k = &6 \/ k = &8 \/ k = &9 \/ k = &10) + ==> iq_universal n A`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC) THEN + SUBGOAL_THEN `&0 <= k` ASSUME_TAC THENL + [ASM_MESON_TAC[INT_ARITH + `&0 <= &1 /\ &0 <= &2 /\ &0 <= &3 /\ &0 <= &4 /\ + &0 <= &5 /\ &0 <= &6 /\ &0 <= &8 /\ &0 <= &9 /\ + &0 <= &10`]; + ALL_TAC] THEN + MP_TAC(EQ_MP (SYM(SPEC `k:int` INT_OF_NUM_EXISTS)) + (ASSUME `&0 <= k`)) THEN + DISCH_THEN(X_CHOOSE_THEN `c:num` SUBST_ALL_TAC) THEN + SUBGOAL_THEN + `c = 1 \/ c = 2 \/ c = 3 \/ c = 4 \/ c = 5 \/ + c = 6 \/ c = 8 \/ c = 9 \/ c = 10` + ASSUME_TAC THENL + [UNDISCH_TAC + `&c = &1 \/ &c = &2 \/ &c = &3 \/ &c = &4 \/ &c = &5 \/ + &c = &6 \/ &c = &8 \/ &c = &9 \/ &c = &10` THEN + REWRITE_TAC[INT_OF_NUM_EQ]; + ALL_TAC] THEN + MATCH_MP_TAC(ISPECL + [`n:num`; `4`; + `iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&3) (&1) (&c)`; + `A:num->num->int`] IQ_UNIVERSAL_OF_EMBEDS) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(SPEC `c:num` IQ_UNIVERSAL_DC123_NUM) THEN + ASM_REWRITE_TAC[]);; + +let IQ_UNIVERSAL_OF_EMBEDS_123 = prove + (`!n A. + iq_symmetric n A /\ iq_positive n A /\ + iq_embeds n 3 + (iqmat3 (&1) (&0) (&0) (&2) (&0) (&3)) A /\ + iq_represents n A (&10) + ==> iq_universal n A`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(SPECL [`n:num`; `A:num->num->int`] + IQ_EMBEDS_QUATERNARY_123) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN + (X_CHOOSE_THEN `k:int` + (REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC))) THENL + [MATCH_MP_TAC(ISPECL [`n:num`; `A:num->num->int`; `k:int`] + IQ_UNIVERSAL_OF_DIAG123_CHILD) THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC(ISPECL [`n:num`; `A:num->num->int`; `k:int`] + IQ_UNIVERSAL_OF_ZC123_CHILD) THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC(ISPECL [`n:num`; `A:num->num->int`; `k:int`] + IQ_UNIVERSAL_OF_YC123_CHILD) THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + MATCH_MP_TAC(SPEC `k:int` IQ_YC123_PARAMETER_CASES) THEN + ASM_REWRITE_TAC[]]; + MATCH_MP_TAC(ISPECL [`n:num`; `A:num->num->int`; `k:int`] + IQ_UNIVERSAL_OF_DC123_CHILD) THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + MATCH_MP_TAC(SPEC `k:int` IQ_DC123_PARAMETER_CASES) THEN + ASM_REWRITE_TAC[]]]);; + +(* ------------------------------------------------------------------------- *) +(* The crossed <1,2,5> form is an index-three subform of three squares. *) +(* Signs and a permutation put two of any three integers in the same class *) +(* modulo 3, which is exactly the condition needed to invert the embedding. *) +(* ------------------------------------------------------------------------- *) + +let INT_SIGN_NORMALIZE_MOD3 = prove + (`!v:int. + ?w. w pow 2 = v pow 2 /\ + (w rem &3 = &0 \/ w rem &3 = &1)`, + GEN_TAC THEN ASM_CASES_TAC `&3 divides v` THENL + [EXISTS_TAC `v:int` THEN ASM_REWRITE_TAC[INT_REM_EQ_0]; + MP_TAC(MATCH_MP (SPEC `v:int` INT_SIGN_MOD3_1) + (ASSUME `~(&3 divides v)`)) THEN + DISCH_THEN(X_CHOOSE_THEN `w:int` + (CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC)) THEN + EXISTS_TAC `w:int` THEN CONJ_TAC THENL + [UNDISCH_TAC `w = v \/ w = --v` THEN + DISCH_THEN(DISJ_CASES_THEN SUBST_ALL_TAC) THEN + CONV_TAC INT_RING; + ASM_REWRITE_TAC[]]]);; + +let INT_SAME_REM_MOD3_DIVIDES_SUB = prove + (`!u v:int. + u rem &3 = v rem &3 + ==> &3 divides (u - v)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[int_divides] THEN + EXISTS_TAC `u div &3 - v div &3:int` THEN + MP_TAC(SPECL [`u:int`; `&3:int`] INT_DIVISION) THEN + MP_TAC(SPECL [`v:int`; `&3:int`] INT_DIVISION) THEN + CONV_TAC NUM_REDUCE_CONV THEN ASM_INT_ARITH_TAC);; + +let INT_THREE_SQUARES_MOD3_PAIR = prove + (`!a b c:int. + ?A B C. + A pow 2 + B pow 2 + C pow 2 = + a pow 2 + b pow 2 + c pow 2 /\ + &3 divides (B - C)`, + REPEAT GEN_TAC THEN + MP_TAC(SPEC `a:int` INT_SIGN_NORMALIZE_MOD3) THEN + MP_TAC(SPEC `b:int` INT_SIGN_NORMALIZE_MOD3) THEN + MP_TAC(SPEC `c:int` INT_SIGN_NORMALIZE_MOD3) THEN + DISCH_THEN(X_CHOOSE_THEN `C:int` + (CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC)) THEN + DISCH_THEN(X_CHOOSE_THEN `B:int` + (CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC)) THEN + DISCH_THEN(X_CHOOSE_THEN `A:int` + (CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC)) THEN + ASM_CASES_TAC `A rem &3 = B rem &3` THENL + [MAP_EVERY EXISTS_TAC [`C:int`; `A:int`; `B:int`] THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[] THEN CONV_TAC INT_RING; + MATCH_MP_TAC INT_SAME_REM_MOD3_DIVIDES_SUB THEN + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + ASM_CASES_TAC `A rem &3 = C rem &3` THENL + [MAP_EVERY EXISTS_TAC [`B:int`; `A:int`; `C:int`] THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[] THEN CONV_TAC INT_RING; + MATCH_MP_TAC INT_SAME_REM_MOD3_DIVIDES_SUB THEN + ASM_REWRITE_TAC[]]; + MAP_EVERY EXISTS_TAC [`A:int`; `B:int`; `C:int`] THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + MATCH_MP_TAC INT_SAME_REM_MOD3_DIVIDES_SUB THEN + ASM_MESON_TAC[]]]);; + +let REPR_CROSS125_OF_THREE_SQUARES = prove + (`!n:int. + (?a b c. a pow 2 + b pow 2 + c pow 2 = n) + ==> ?x y z. + x pow 2 + &2 * y pow 2 + &2 * y * z + + &5 * z pow 2 = n`, + GEN_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `a:int` + (X_CHOOSE_THEN `b:int` + (X_CHOOSE_THEN `c:int` (LABEL_TAC "orig")))) THEN + MP_TAC(SPECL [`a:int`; `b:int`; `c:int`] + INT_THREE_SQUARES_MOD3_PAIR) THEN + DISCH_THEN(X_CHOOSE_THEN `A:int` + (X_CHOOSE_THEN `B:int` + (X_CHOOSE_THEN `C:int` + (CONJUNCTS_THEN2 (LABEL_TAC "sum") ASSUME_TAC)))) THEN + UNDISCH_TAC `&3 divides (B - C)` THEN + REWRITE_TAC[int_divides] THEN + DISCH_THEN(X_CHOOSE_THEN `z:int` (LABEL_TAC "sub")) THEN + MAP_EVERY EXISTS_TAC [`A:int`; `C + z:int`; `z:int`] THEN + REMOVE_THEN "sum" MP_TAC THEN REMOVE_THEN "sub" MP_TAC THEN + REMOVE_THEN "orig" MP_TAC THEN CONV_TAC INT_RING);; + +let INT_REPRESENTS_CROSS125_OF_LEGENDRE = prove + (`!n:num. + ~(?a m. n = 4 EXP a * (8 * m + 7)) + ==> ?x y z:int. + x pow 2 + &2 * y pow 2 + &2 * y * z + + &5 * z pow 2 = &n`, + GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC REPR_CROSS125_OF_THREE_SQUARES THEN + MATCH_MP_TAC INT_THREE_SQUARES_OF_LEGENDRE THEN + ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* The diagonal <1,2,4> form represents exactly the integers not excluded *) +(* by 4^a(16b+14). Odd targets were handled in quaternary_122.ml. For a *) +(* target congruent to 2 modulo 4, halve it and use regularity of <1,2,2>. *) +(* ------------------------------------------------------------------------- *) + +let INT_REPRESENTS_124_SCALE4 = prove + (`!n:num. + (?x y z:int. + x pow 2 + &2 * y pow 2 + &4 * z pow 2 = &n) + ==> ?x y z:int. + x pow 2 + &2 * y pow 2 + &4 * z pow 2 = &(4 * n)`, + GEN_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` (X_CHOOSE_TAC `z:int`))) THEN + MAP_EVERY EXISTS_TAC + [`&2 * x:int`; `&2 * y:int`; `&2 * z:int`] THEN + REWRITE_TAC[GSYM INT_OF_NUM_MUL] THEN + FIRST_X_ASSUM(MP_TAC) THEN CONV_TAC INT_RING);; + +let NUM_DESCENT_NOT_124_FORM = prove + (`!n:num. + 4 divides n /\ ~(?a b. n = 4 EXP a * (16 * b + 14)) + ==> ~(?a b. n DIV 4 = 4 EXP a * (16 * b + 14))`, + GEN_TAC THEN STRIP_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `a:num` + (X_CHOOSE_THEN `b:num` ASSUME_TAC)) THEN + UNDISCH_TAC `~(?a b. n = 4 EXP a * (16 * b + 14))` THEN + REWRITE_TAC[] THEN MAP_EVERY EXISTS_TAC [`SUC a`; `b:num`] THEN + REWRITE_TAC[EXP; GSYM MULT_ASSOC] THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + FIRST_ASSUM(X_CHOOSE_THEN `c:num` SUBST_ALL_TAC o + REWRITE_RULE[divides]) THEN + SIMP_TAC[DIV_MULT; ARITH]);; + +let NUM_124_HALF_AVOIDS_122 = prove + (`!n:num. + ~(n MOD 4 = 0) /\ ~(n MOD 2 = 1) /\ + ~(?a b. n = 4 EXP a * (16 * b + 14)) + ==> ~((n DIV 2) MOD 4 = 0) /\ + ~((n DIV 2) MOD 8 = 7)`, + GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `n MOD 2 = 0` ASSUME_TAC THENL + [MP_TAC(SPEC `n:num` MOD_2_CASES) THEN + ASM_CASES_TAC `EVEN n` THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `n = 2 * (n DIV 2)` ASSUME_TAC THENL + [MP_TAC(SPECL [`n:num`; `2`] DIVISION) THEN + CONV_TAC NUM_REDUCE_CONV THEN ASM_REWRITE_TAC[ADD_CLAUSES] THEN + ARITH_TAC; + ALL_TAC] THEN + CONJ_TAC THENL + [DISCH_TAC THEN + MP_TAC(MATCH_MP (SPECL [`n DIV 2`; `4`; `0`] NUM_DECOMPOSE_MOD) + (CONJ (ARITH_RULE `~(4 = 0)`) + (ASSUME `(n DIV 2) MOD 4 = 0`))) THEN + DISCH_THEN(X_CHOOSE_THEN `q:num` ASSUME_TAC) THEN + UNDISCH_TAC `~(n MOD 4 = 0)` THEN + REWRITE_TAC[] THEN + SUBGOAL_THEN `n = 4 * (2 * q)` SUBST1_TAC THENL + [UNDISCH_TAC `n = 2 * (n DIV 2)` THEN + UNDISCH_TAC `n DIV 2 = 4 * q + 0` THEN ARITH_TAC; + REWRITE_TAC[MOD_MULT]]; + DISCH_TAC THEN + MP_TAC(MATCH_MP (SPECL [`n DIV 2`; `8`; `7`] NUM_DECOMPOSE_MOD) + (CONJ (ARITH_RULE `~(8 = 0)`) + (ASSUME `(n DIV 2) MOD 8 = 7`))) THEN + DISCH_THEN(X_CHOOSE_THEN `q:num` ASSUME_TAC) THEN + UNDISCH_TAC `~(?a b. n = 4 EXP a * (16 * b + 14))` THEN + REWRITE_TAC[] THEN MAP_EVERY EXISTS_TAC [`0`; `q:num`] THEN + REWRITE_TAC[EXP; MULT_CLAUSES] THEN + UNDISCH_TAC `n = 2 * (n DIV 2)` THEN + UNDISCH_TAC `n DIV 2 = 8 * q + 7` THEN ARITH_TAC]);; + +let INT_REPRESENTS_124_OF_LEGENDRE = prove + (`!n:num. + ~(?a b. n = 4 EXP a * (16 * b + 14)) + ==> ?x y z:int. + x pow 2 + &2 * y pow 2 + &4 * z pow 2 = &n`, + MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN + DISCH_THEN(LABEL_TAC "ih") THEN DISCH_THEN(LABEL_TAC "avoid") THEN + ASM_CASES_TAC `n = 0` THENL + [ASM_REWRITE_TAC[] THEN + MAP_EVERY EXISTS_TAC [`&0:int`; `&0:int`; `&0:int`] THEN + CONV_TAC INT_REDUCE_CONV; + ALL_TAC] THEN + ASM_CASES_TAC `n MOD 4 = 0` THENL + [SUBGOAL_THEN `4 divides n` ASSUME_TAC THENL + [ASM_REWRITE_TAC[DIVIDES_MOD]; + ALL_TAC] THEN + SUBGOAL_THEN `n = 4 * (n DIV 4)` ASSUME_TAC THENL + [MP_TAC(SPECL [`n:num`; `4`] DIVISION) THEN + CONV_TAC NUM_REDUCE_CONV THEN + ASM_REWRITE_TAC[ADD_CLAUSES] THEN ARITH_TAC; + ALL_TAC] THEN + ONCE_REWRITE_TAC[ASSUME `n = 4 * (n DIV 4)`] THEN + MATCH_MP_TAC INT_REPRESENTS_124_SCALE4 THEN + REMOVE_THEN "ih" (MP_TAC o SPEC `n DIV 4`) THEN + ANTS_TAC THENL + [MATCH_MP_TAC DIV4_LESS THEN ASM_REWRITE_TAC[]; + DISCH_THEN MATCH_MP_TAC THEN + MATCH_MP_TAC NUM_DESCENT_NOT_124_FORM THEN + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + ASM_CASES_TAC `n MOD 2 = 1` THENL + [MATCH_MP_TAC INT_REPRESENTS_124_ODD THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MP_TAC(MATCH_MP (SPEC `n:num` NUM_124_HALF_AVOIDS_122) + (CONJ (ASSUME `~(n MOD 4 = 0)`) + (CONJ (ASSUME `~(n MOD 2 = 1)`) + (ASSUME `~(?a b. n = 4 EXP a * (16 * b + 14))`)))) THEN + DISCH_TAC THEN + MP_TAC(MATCH_MP INT_REPRESENTS_122_AVOIDS + (ASSUME + `~((n DIV 2) MOD 4 = 0) /\ ~((n DIV 2) MOD 8 = 7)`)) THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` + (X_CHOOSE_THEN `z:int` (LABEL_TAC "rep122")))) THEN + SUBGOAL_THEN `n MOD 2 = 0` ASSUME_TAC THENL + [MP_TAC(SPEC `n:num` MOD_2_CASES) THEN + ASM_CASES_TAC `EVEN n` THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `n = 2 * (n DIV 2)` ASSUME_TAC THENL + [MP_TAC(SPECL [`n:num`; `2`] DIVISION) THEN + CONV_TAC NUM_REDUCE_CONV THEN ASM_REWRITE_TAC[ADD_CLAUSES] THEN + ARITH_TAC; + ALL_TAC] THEN + MAP_EVERY EXISTS_TAC [`&2 * y:int`; `x:int`; `z:int`] THEN + MP_TAC(AP_TERM `\m:num. &m:int` + (ASSUME `n = 2 * (n DIV 2)`)) THEN + REWRITE_TAC[GSYM INT_OF_NUM_MUL] THEN + DISCH_THEN(LABEL_TAC "int_half") THEN + REMOVE_THEN "rep122" MP_TAC THEN + REMOVE_THEN "int_half" MP_TAC THEN CONV_TAC INT_RING);; + +let IQ_124_MOD16_CORE = prove + (`!a b c:int. + (a = &0 \/ a = &1 \/ a = &4 \/ a = &9) /\ + (b = &0 \/ b = &1 \/ b = &4 \/ b = &9) /\ + (c = &0 \/ c = &1 \/ c = &4 \/ c = &9) /\ + (a + &2 * b + &4 * c) rem &16 = &14 + ==> F`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + POP_ASSUM MP_TAC THEN ASM_REWRITE_TAC[] THEN + CONV_TAC INT_REDUCE_CONV);; + +let INT_124_NOT_14 = prove + (`!x y z:int. + ~(x pow 2 + &2 * y pow 2 + &4 * z pow 2 = &14)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(SPECL + [`x pow 2 rem &16`; `y pow 2 rem &16`; `z pow 2 rem &16`] + IQ_124_MOD16_CORE) THEN + REWRITE_TAC[IQ_SQ_MOD_16] THEN + SUBGOAL_THEN + `(x pow 2 rem &16 + &2 * (y pow 2 rem &16) + + &4 * (z pow 2 rem &16)) rem &16 = + (x pow 2 + &2 * y pow 2 + &4 * z pow 2) rem &16` + SUBST1_TAC THENL + [CONV_TAC INT_REM_DOWN_CONV THEN REFL_TAC; + ASM_REWRITE_TAC[] THEN CONV_TAC INT_REDUCE_CONV]);; + +let INT_DIV4_BALANCED = prove + (`!c:int. + ?q r. + c = &4 * q + r /\ + (r = -- &2 \/ r = -- &1 \/ r = &0 \/ r = &1)`, + GEN_TAC THEN + MP_TAC(SPECL [`c:int`; `&4:int`] INT_DIVISION) THEN + CONV_TAC NUM_REDUCE_CONV THEN STRIP_TAC THEN + SUBGOAL_THEN + `c rem &4 = &0 \/ c rem &4 = &1 \/ + c rem &4 = &2 \/ c rem &4 = &3` + MP_TAC THENL + [ASM_INT_ARITH_TAC; + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THENL + [MAP_EVERY EXISTS_TAC [`c div &4:int`; `&0:int`] THEN + ASM_INT_ARITH_TAC; + MAP_EVERY EXISTS_TAC [`c div &4:int`; `&1:int`] THEN + ASM_INT_ARITH_TAC; + MAP_EVERY EXISTS_TAC [`c div &4 + &1:int`; `-- &2:int`] THEN + ASM_INT_ARITH_TAC; + MAP_EVERY EXISTS_TAC [`c div &4 + &1:int`; `-- &1:int`] THEN + ASM_INT_ARITH_TAC]]);; + +let INT_QUAD2_REM_NONNEG = prove + (`!q r:int. + (r = &0 \/ r = &1) + ==> &0 <= &2 * q pow 2 + &2 * q * r`, + REPEAT GEN_TAC THEN + DISCH_THEN(DISJ_CASES_THEN SUBST_ALL_TAC) THENL + [MP_TAC(SPEC `q:int` INT_LE_POW_2) THEN INT_ARITH_TAC; + REWRITE_TAC[INT_MUL_RID] THEN + MATCH_ACCEPT_TAC(SPEC `q:int` INT_2Q2_ADD_2Q_NONNEG)]);; + +let INT_QUAD4_BALANCED_NONNEG = prove + (`!q r:int. + (r = -- &2 \/ r = -- &1 \/ r = &0 \/ r = &1) + ==> &0 <= &4 * q pow 2 + &2 * q * r`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN + `&4 * q pow 2 + &2 * q * r = (&2 * q) * (&2 * q + r)` + SUBST1_TAC THENL + [CONV_TAC INT_RING; + ALL_TAC] THEN + ASM_CASES_TAC `q = &0` THENL + [ASM_REWRITE_TAC[INT_MUL_LZERO; INT_MUL_RZERO] THEN INT_ARITH_TAC; + ALL_TAC] THEN + ASM_CASES_TAC `&0 <= q` THENL + [MATCH_MP_TAC INT_LE_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC INT_LE_MUL THEN ASM_INT_ARITH_TAC; + ASM_INT_ARITH_TAC]; + ONCE_REWRITE_TAC + [INT_RING + `(&2 * q) * (&2 * q + r) = + (&2 * --q) * (--(&2 * q + r))`] THEN + MATCH_MP_TAC INT_LE_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC INT_LE_MUL THEN ASM_INT_ARITH_TAC; + ASM_INT_ARITH_TAC]]);; + +let iqclear124 = new_definition + `iqclear124 a b c = + iqrows4 + (&1) (&0) (&0) (&0) + (&0) (&1) (&0) (&0) + (&0) (&0) (&1) (&0) + (--a) (--b) (--c) (&1)`;; + +let iqflip124 = new_definition + `iqflip124 = + iqrows4 + (&1) (&0) (&0) (&0) + (&0) (&1) (&0) (&0) + (&0) (&0) (-- &1) (&0) + (&0) (&0) (&0) (&1)`;; + +let IQ_EMBEDS_CLEAR_124 = prove + (`!n A a b c rb rc t. + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) a + (&2) (&0) (&2 * b + rb) + (&4) (&4 * c + rc) t) A + ==> iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&4) rc + (t - a pow 2 - + &2 * b pow 2 - &2 * b * rb - + &4 * c pow 2 - &2 * c * rc)) A`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(ISPECL + [`n:num`; `4`; + `iqgram 4 + (iqmat4 (&1) (&0) (&0) a + (&2) (&0) (&2 * b + rb) + (&4) (&4 * c + rc) t) + (iqclear124 a b c)`; + `iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&4) rc + (t - a pow 2 - + &2 * b pow 2 - &2 * b * rb - + &4 * c pow 2 - &2 * c * rc)`; + `A:num->num->int`] IQ_EMBEDS_EQ) THEN + CONJ_TAC THENL + [MATCH_MP_TAC IQ_EMBEDS_CONGRUENCE THEN ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC THEN + (SUBGOAL_THEN `i = 0 \/ i = 1 \/ i = 2 \/ i = 3` MP_TAC THENL + [ASM_ARITH_TAC; ALL_TAC]) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + (SUBGOAL_THEN `j = 0 \/ j = 1 \/ j = 2 \/ j = 3` MP_TAC THENL + [ASM_ARITH_TAC; ALL_TAC]) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + ASM_REWRITE_TAC[iqgram; IQBILIN_MAT4; iqclear124; iqrows4; + iqmat4; iqsym] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC INT_RING]);; + +let IQ_EMBEDS_FLIP_124 = prove + (`!n A rb rc k. + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&4) rc k) A + ==> iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&4) (--rc) k) A`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(ISPECL + [`n:num`; `4`; + `iqgram 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&4) rc k) + iqflip124`; + `iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&4) (--rc) k`; + `A:num->num->int`] IQ_EMBEDS_EQ) THEN + CONJ_TAC THENL + [MATCH_MP_TAC IQ_EMBEDS_CONGRUENCE THEN ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC THEN + (SUBGOAL_THEN `i = 0 \/ i = 1 \/ i = 2 \/ i = 3` MP_TAC THENL + [ASM_ARITH_TAC; ALL_TAC]) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + (SUBGOAL_THEN `j = 0 \/ j = 1 \/ j = 2 \/ j = 3` MP_TAC THENL + [ASM_ARITH_TAC; ALL_TAC]) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + ASM_REWRITE_TAC[iqgram; IQBILIN_MAT4; iqflip124; iqrows4; + iqmat4; iqsym] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC INT_RING]);; + +let IQ_EMBEDS_FLIP_124_NEG1 = prove + (`!n A rb k. + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&4) (-- &1) k) A + ==> iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&4) (&1) k) A`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_ACCEPT_TAC + (CONV_RULE INT_REDUCE_CONV + (MATCH_MP + (SPECL [`n:num`; `A:num->num->int`; `rb:int`; `-- &1`; `k:int`] + IQ_EMBEDS_FLIP_124) + (ASSUME + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&4) (-- &1) k) A`))));; + +let IQ_EMBEDS_FLIP_124_NEG2 = prove + (`!n A rb k. + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&4) (-- &2) k) A + ==> iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&4) (&2) k) A`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_ACCEPT_TAC + (CONV_RULE INT_REDUCE_CONV + (MATCH_MP + (SPECL [`n:num`; `A:num->num->int`; `rb:int`; `-- &2`; `k:int`] + IQ_EMBEDS_FLIP_124) + (ASSUME + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&4) (-- &2) k) A`))));; + +let IQ_REPRESENTS_FLIP_124 = prove + (`!rb rc k t. + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&4) rc k) t + ==> iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&4) (--rc) k) t`, + REPEAT GEN_TAC THEN + REWRITE_TAC[iq_represents] THEN + DISCH_THEN(X_CHOOSE_TAC `v:num->int`) THEN + EXISTS_TAC `\i:num. if i = 2 then --(v i) else v i` THEN + FIRST_X_ASSUM(MP_TAC) THEN + REWRITE_TAC[IQEVAL_MAT4] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC INT_RING);; + +let IQ_REPRESENTS_FLIP_124_NEG1 = prove + (`!rb k t. + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&4) (-- &1) k) t + ==> iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&4) (&1) k) t`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_ACCEPT_TAC + (CONV_RULE INT_REDUCE_CONV + (MATCH_MP + (SPECL [`rb:int`; `-- &1`; `k:int`; `t:int`] + IQ_REPRESENTS_FLIP_124) + (ASSUME + `iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&4) (-- &1) k) t`))));; + +let IQ_REPRESENTS_FLIP_124_NEG2 = prove + (`!rb k t. + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&4) (-- &2) k) t + ==> iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&4) (&2) k) t`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_ACCEPT_TAC + (CONV_RULE INT_REDUCE_CONV + (MATCH_MP + (SPECL [`rb:int`; `-- &2`; `k:int`; `t:int`] + IQ_REPRESENTS_FLIP_124) + (ASSUME + `iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&4) (-- &2) k) t`))));; + +let IQ_124_REDUCED_K_NONNEG = prove + (`!n A rb rc k. + iq_positive n A /\ + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&4) rc k) A + ==> &0 <= k`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC) THEN + MP_TAC(MATCH_MP + (ISPECL + [`n:num`; `4`; + `iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&4) rc k`; + `A:num->num->int`] IQ_EMBEDDED_NONNEG) + (CONJ (ASSUME `iq_positive n A`) (ASSUME + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&4) rc k) A`))) THEN + DISCH_THEN(MP_TAC o SPEC + `\i:num. if i = 3 then &1 else &0`) THEN + REWRITE_TAC[IQEVAL_MAT4] THEN + CONV_TAC NUM_REDUCE_CONV THEN INT_ARITH_TAC);; + +let IQ_124_ZERO_FORCES_RB = prove + (`!n A rb rc. + iq_positive n A /\ + (rb = &0 \/ rb = &1) /\ + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&4) rc (&0)) A + ==> rb = &0`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC)) THEN + UNDISCH_TAC `rb = &0 \/ rb = &1` THEN + DISCH_THEN(DISJ_CASES_THEN ASSUME_TAC) THENL + [ASM_REWRITE_TAC[]; + MP_TAC(MATCH_MP + (ISPECL + [`n:num`; `4`; + `iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&4) rc (&0)`; + `A:num->num->int`] IQ_EMBEDDED_NONNEG) + (CONJ (ASSUME `iq_positive n A`) (ASSUME + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&4) rc (&0)) A`))) THEN + DISCH_THEN(MP_TAC o SPEC + `\i:num. + if i = 1 then &1 else if i = 3 then -- &2 else &0`) THEN + ASM_REWRITE_TAC[IQEVAL_MAT4] THEN + CONV_TAC NUM_REDUCE_CONV THEN INT_ARITH_TAC]);; + +let IQ_124_ZERO_FORCES_RC = prove + (`!n A rb rc. + iq_positive n A /\ + (rc = -- &2 \/ rc = -- &1 \/ rc = &0 \/ rc = &1) /\ + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&4) rc (&0)) A + ==> rc = &0`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC)) THEN + UNDISCH_TAC + `rc = -- &2 \/ rc = -- &1 \/ rc = &0 \/ rc = &1` THEN + DISCH_THEN(DISJ_CASES_THEN2 ASSUME_TAC + (DISJ_CASES_THEN2 ASSUME_TAC + (DISJ_CASES_THEN ASSUME_TAC))) THENL + [MP_TAC(MATCH_MP + (ISPECL + [`n:num`; `4`; + `iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&4) rc (&0)`; + `A:num->num->int`] IQ_EMBEDDED_NONNEG) + (CONJ (ASSUME `iq_positive n A`) (ASSUME + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&4) rc (&0)) A`))) THEN + DISCH_THEN(MP_TAC o SPEC + `\i:num. + if i = 2 then &1 else if i = 3 then &2 else &0`) THEN + ASM_REWRITE_TAC[IQEVAL_MAT4] THEN + CONV_TAC NUM_REDUCE_CONV THEN INT_ARITH_TAC; + MP_TAC(MATCH_MP + (ISPECL + [`n:num`; `4`; + `iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&4) rc (&0)`; + `A:num->num->int`] IQ_EMBEDDED_NONNEG) + (CONJ (ASSUME `iq_positive n A`) (ASSUME + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&4) rc (&0)) A`))) THEN + DISCH_THEN(MP_TAC o SPEC + `\i:num. + if i = 2 then &1 else if i = 3 then &3 else &0`) THEN + ASM_REWRITE_TAC[IQEVAL_MAT4] THEN + CONV_TAC NUM_REDUCE_CONV THEN INT_ARITH_TAC; + ASM_REWRITE_TAC[]; + MP_TAC(MATCH_MP + (ISPECL + [`n:num`; `4`; + `iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&4) rc (&0)`; + `A:num->num->int`] IQ_EMBEDDED_NONNEG) + (CONJ (ASSUME `iq_positive n A`) (ASSUME + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&4) rc (&0)) A`))) THEN + DISCH_THEN(MP_TAC o SPEC + `\i:num. + if i = 2 then &1 else if i = 3 then -- &3 else &0`) THEN + ASM_REWRITE_TAC[IQEVAL_MAT4] THEN + CONV_TAC NUM_REDUCE_CONV THEN INT_ARITH_TAC]);; + +let IQ_124_REDUCED_K_UPPER = prove + (`!a qb rb qc rc k. + (rb = &0 \/ rb = &1) /\ + (rc = -- &2 \/ rc = -- &1 \/ rc = &0 \/ rc = &1) /\ + k = &14 - a pow 2 - + &2 * qb pow 2 - &2 * qb * rb - + &4 * qc pow 2 - &2 * qc * rc + ==> k <= &14`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "rbcase") + (CONJUNCTS_THEN2 (LABEL_TAC "rccase") ASSUME_TAC)) THEN + MP_TAC(MATCH_MP (SPECL [`qb:int`; `rb:int`] + INT_QUAD2_REM_NONNEG) + (ASSUME `rb = &0 \/ rb = &1`)) THEN + MP_TAC(MATCH_MP (SPECL [`qc:int`; `rc:int`] + INT_QUAD4_BALANCED_NONNEG) + (ASSUME + `rc = -- &2 \/ rc = -- &1 \/ rc = &0 \/ rc = &1`)) THEN + MP_TAC(SPEC `a:int` INT_LE_POW_2) THEN + REMOVE_THEN "rbcase" (fun _ -> ALL_TAC) THEN + REMOVE_THEN "rccase" (fun _ -> ALL_TAC) THEN + ASM_INT_ARITH_TAC);; + +let IQ_124_REDUCED_K_NONZERO = prove + (`!n A a qb rb qc rc k. + iq_positive n A /\ + (rb = &0 \/ rb = &1) /\ + (rc = -- &2 \/ rc = -- &1 \/ rc = &0 \/ rc = &1) /\ + k = &14 - a pow 2 - + &2 * qb pow 2 - &2 * qb * rb - + &4 * qc pow 2 - &2 * qc * rc /\ + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&4) rc k) A + ==> ~(k = &0)`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC)))) THEN + DISCH_TAC THEN + let emb0 = REWRITE_RULE [ASSUME `k = &0`] + (ASSUME + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&4) rc k) A`) in + let rb0 = MATCH_MP + (ISPECL [`n:num`; `A:num->num->int`; + `rb:int`; `rc:int`] IQ_124_ZERO_FORCES_RB) + (CONJ (ASSUME `iq_positive n A`) + (CONJ (ASSUME `rb = &0 \/ rb = &1`) emb0)) in + let rc0 = MATCH_MP + (ISPECL [`n:num`; `A:num->num->int`; + `rb:int`; `rc:int`] IQ_124_ZERO_FORCES_RC) + (CONJ (ASSUME `iq_positive n A`) + (CONJ + (ASSUME + `rc = -- &2 \/ rc = -- &1 \/ rc = &0 \/ rc = &1`) + emb0)) in + ACCEPT_TAC + (MP + (NOT_ELIM(SPECL [`a:int`; `qb:int`; `qc:int`] INT_124_NOT_14)) + (MP (MP (MP (MP + (INT_RING + `k = &14 - a pow 2 - + &2 * qb pow 2 - &2 * qb * rb - + &4 * qc pow 2 - &2 * qc * rc + ==> k = &0 ==> rb = &0 ==> rc = &0 + ==> a pow 2 + &2 * qb pow 2 + &4 * qc pow 2 = &14`) + (ASSUME + `k = &14 - a pow 2 - + &2 * qb pow 2 - &2 * qb * rb - + &4 * qc pow 2 - &2 * qc * rc`)) + (ASSUME `k = &0`)) + rb0) + rc0)));; + +let IQ_124_REDUCED_K_BOUNDS = prove + (`!n A a qb rb qc rc k. + iq_positive n A /\ + (rb = &0 \/ rb = &1) /\ + (rc = -- &2 \/ rc = -- &1 \/ rc = &0 \/ rc = &1) /\ + k = &14 - a pow 2 - + &2 * qb pow 2 - &2 * qb * rb - + &4 * qc pow 2 - &2 * qc * rc /\ + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&4) rc k) A + ==> &1 <= k /\ k <= &14`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC)))) THEN + let knonneg = MATCH_MP + (ISPECL [`n:num`; `A:num->num->int`; + `rb:int`; `rc:int`; `k:int`] IQ_124_REDUCED_K_NONNEG) + (CONJ (ASSUME `iq_positive n A`) + (ASSUME + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&4) rc k) A`)) in + let knonzero = MATCH_MP + (ISPECL [`n:num`; `A:num->num->int`; `a:int`; `qb:int`; + `rb:int`; `qc:int`; `rc:int`; `k:int`] + IQ_124_REDUCED_K_NONZERO) + (CONJ (ASSUME `iq_positive n A`) + (CONJ (ASSUME `rb = &0 \/ rb = &1`) + (CONJ + (ASSUME + `rc = -- &2 \/ rc = -- &1 \/ rc = &0 \/ rc = &1`) + (CONJ + (ASSUME + `k = &14 - a pow 2 - + &2 * qb pow 2 - &2 * qb * rb - + &4 * qc pow 2 - &2 * qc * rc`) + (ASSUME + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&4) rc k) A`))))) in + let kupper = MATCH_MP + (SPECL [`a:int`; `qb:int`; `rb:int`; `qc:int`; `rc:int`; `k:int`] + IQ_124_REDUCED_K_UPPER) + (CONJ (ASSUME `rb = &0 \/ rb = &1`) + (CONJ + (ASSUME + `rc = -- &2 \/ rc = -- &1 \/ rc = &0 \/ rc = &1`) + (ASSUME + `k = &14 - a pow 2 - + &2 * qb pow 2 - &2 * qb * rb - + &4 * qc pow 2 - &2 * qc * rc`))) in + ACCEPT_TAC + (CONJ + (MP (MP + (INT_ARITH `&0 <= k ==> ~(k = &0) ==> &1 <= k`) + knonneg) + knonzero) + kupper));; + +let IQ_124_REDUCED_REPRESENTS_14 = prove + (`!a qb rb qc rc k. + k = &14 - a pow 2 - + &2 * qb pow 2 - &2 * qb * rb - + &4 * qc pow 2 - &2 * qc * rc + ==> iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&4) rc k) (&14)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[iq_represents] THEN + EXISTS_TAC + `\i:num. + if i = 0 then (a:int) else if i = 1 then qb else + if i = 2 then qc else &1` THEN + REWRITE_TAC[IQEVAL_MAT4] THEN + CONV_TAC NUM_REDUCE_CONV THEN + FIRST_X_ASSUM(MP_TAC) THEN CONV_TAC INT_RING);; + +let IQ_EMBEDS_QUATERNARY_124_RAW = prove + (`!n A. + iq_symmetric n A /\ iq_positive n A /\ + iq_embeds n 3 + (iqmat3 (&1) (&0) (&0) (&2) (&0) (&4)) A /\ + iq_represents n A (&14) + ==> ?rb rc k. + (rb = &0 \/ rb = &1) /\ + (rc = -- &2 \/ rc = -- &1 \/ rc = &0 \/ rc = &1) /\ + &1 <= k /\ k <= &14 /\ + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&4) rc k) A /\ + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&4) rc k) (&14)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(SPECL + [`n:num`; `A:num->num->int`; + `&1:int`; `&0:int`; `&0:int`; `&2:int`; `&0:int`; `&4:int`; + `&14:int`] IQ_ESCALATE_MAT3) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `a:int` + (X_CHOOSE_THEN `b:int` + (X_CHOOSE_THEN `c:int` STRIP_ASSUME_TAC))) THEN + MP_TAC(SPEC `b:int` INT_DIV2_QR) THEN + DISCH_THEN(X_CHOOSE_THEN `qb:int` + (X_CHOOSE_THEN `rb:int` + (CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC))) THEN + MP_TAC(SPEC `c:int` INT_DIV4_BALANCED) THEN + DISCH_THEN(X_CHOOSE_THEN `qc:int` + (X_CHOOSE_THEN `rc:int` + (CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC))) THEN + let kval = + `&14 - a pow 2 - + &2 * qb pow 2 - &2 * qb * rb - + &4 * qc pow 2 - &2 * qc * rc` in + let source_emb = REWRITE_RULE + [ASSUME `b = &2 * qb + rb`; ASSUME `c = &4 * qc + rc`] + (ASSUME + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) a + (&2) (&0) b (&4) c (&14)) A`) in + let emb = MATCH_MP + (ISPECL [`n:num`; `A:num->num->int`; `a:int`; `qb:int`; + `qc:int`; `rb:int`; `rc:int`; `&14:int`] + IQ_EMBEDS_CLEAR_124) + source_emb in + let bounds = MATCH_MP + (ISPECL [`n:num`; `A:num->num->int`; `a:int`; `qb:int`; + `rb:int`; `qc:int`; `rc:int`; kval] + IQ_124_REDUCED_K_BOUNDS) + (CONJ (ASSUME `iq_positive n A`) + (CONJ (ASSUME `rb = &0 \/ rb = &1`) + (CONJ + (ASSUME + `rc = -- &2 \/ rc = -- &1 \/ rc = &0 \/ rc = &1`) + (CONJ (REFL kval) emb)))) in + let rep14 = MATCH_MP + (SPECL [`a:int`; `qb:int`; `rb:int`; `qc:int`; `rc:int`; kval] + IQ_124_REDUCED_REPRESENTS_14) + (REFL kval) in + MAP_EVERY EXISTS_TAC [`rb:int`; `rc:int`; kval] THEN + ACCEPT_TAC + (CONJ (ASSUME `rb = &0 \/ rb = &1`) + (CONJ + (ASSUME + `rc = -- &2 \/ rc = -- &1 \/ rc = &0 \/ rc = &1`) + (CONJ (CONJUNCT1 bounds) + (CONJ (CONJUNCT2 bounds) (CONJ emb rep14))))));; + +let IQ_EMBEDS_QUATERNARY_124 = prove + (`!n A. + iq_symmetric n A /\ iq_positive n A /\ + iq_embeds n 3 + (iqmat3 (&1) (&0) (&0) (&2) (&0) (&4)) A /\ + iq_represents n A (&14) + ==> (?k. &1 <= k /\ k <= &14 /\ + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&0) (&4) (&0) k) A /\ + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&0) (&4) (&0) k) (&14)) \/ + (?k. &1 <= k /\ k <= &14 /\ + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&0) (&4) (&1) k) A /\ + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&0) (&4) (&1) k) (&14)) \/ + (?k. &1 <= k /\ k <= &14 /\ + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&0) (&4) (&2) k) A /\ + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&0) (&4) (&2) k) (&14)) \/ + (?k. &1 <= k /\ k <= &14 /\ + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&4) (&0) k) A /\ + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&4) (&0) k) (&14)) \/ + (?k. &1 <= k /\ k <= &14 /\ + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&4) (&1) k) A /\ + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&4) (&1) k) (&14)) \/ + (?k. &1 <= k /\ k <= &14 /\ + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&4) (&2) k) A /\ + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&4) (&2) k) (&14))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(SPECL [`n:num`; `A:num->num->int`] + IQ_EMBEDS_QUATERNARY_124_RAW) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `rb:int` + (X_CHOOSE_THEN `rc:int` + (X_CHOOSE_THEN `k:int` + (CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC)))))))) THEN + UNDISCH_TAC `rb = &0 \/ rb = &1` THEN + DISCH_THEN(DISJ_CASES_THEN SUBST_ALL_TAC) THEN + UNDISCH_TAC + `rc = -- &2 \/ rc = -- &1 \/ rc = &0 \/ rc = &1` THEN + DISCH_THEN(DISJ_CASES_THEN2 SUBST_ALL_TAC + (DISJ_CASES_THEN2 SUBST_ALL_TAC + (DISJ_CASES_THEN SUBST_ALL_TAC))) THENL + [DISJ2_TAC THEN DISJ2_TAC THEN DISJ1_TAC THEN + EXISTS_TAC `k:int` THEN REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC IQ_EMBEDS_FLIP_124_NEG2 THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC IQ_REPRESENTS_FLIP_124_NEG2 THEN ASM_REWRITE_TAC[]]; + DISJ2_TAC THEN DISJ1_TAC THEN + EXISTS_TAC `k:int` THEN REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC IQ_EMBEDS_FLIP_124_NEG1 THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC IQ_REPRESENTS_FLIP_124_NEG1 THEN ASM_REWRITE_TAC[]]; + DISJ1_TAC THEN EXISTS_TAC `k:int` THEN ASM_REWRITE_TAC[]; + DISJ2_TAC THEN DISJ1_TAC THEN + EXISTS_TAC `k:int` THEN ASM_REWRITE_TAC[]; + DISJ2_TAC THEN DISJ2_TAC THEN DISJ2_TAC THEN + DISJ2_TAC THEN DISJ2_TAC THEN + EXISTS_TAC `k:int` THEN REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC IQ_EMBEDS_FLIP_124_NEG2 THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC IQ_REPRESENTS_FLIP_124_NEG2 THEN ASM_REWRITE_TAC[]]; + DISJ2_TAC THEN DISJ2_TAC THEN DISJ2_TAC THEN + DISJ2_TAC THEN DISJ1_TAC THEN + EXISTS_TAC `k:int` THEN REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC IQ_EMBEDS_FLIP_124_NEG1 THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC IQ_REPRESENTS_FLIP_124_NEG1 THEN ASM_REWRITE_TAC[]]; + DISJ2_TAC THEN DISJ2_TAC THEN DISJ2_TAC THEN + DISJ1_TAC THEN EXISTS_TAC `k:int` THEN ASM_REWRITE_TAC[]; + DISJ2_TAC THEN DISJ2_TAC THEN DISJ2_TAC THEN + DISJ2_TAC THEN DISJ1_TAC THEN + EXISTS_TAC `k:int` THEN ASM_REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* A common descent for every child containing <1,2,4>. *) +(* ------------------------------------------------------------------------- *) + +let NUM_124_EXCEPTION_MOD16 = prove + (`!n:num. + (?a b. n = 4 EXP a * (16*b+14)) + ==> n MOD 16 = 0 \/ n MOD 16 = 8 \/ n MOD 16 = 14`, + GEN_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `a:num` + (X_CHOOSE_THEN `b:num` ASSUME_TAC)) THEN + ASM_CASES_TAC `a = 0` THENL + [DISJ2_TAC THEN DISJ2_TAC THEN + ASM_REWRITE_TAC[EXP; MULT_CLAUSES; MOD_MULT_ADD] THEN + CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + MP_TAC(SPEC `a:num` num_CASES) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST_ALL_TAC) THEN + ASM_CASES_TAC `d = 0` THENL + [DISJ2_TAC THEN DISJ1_TAC THEN + ASM_REWRITE_TAC[EXP; MULT_CLAUSES; + ARITH_RULE `4 * (16*b+14) = 16 * (4*b+3) + 8`; + MOD_MULT_ADD] THEN + CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + MP_TAC(SPEC `d:num` num_CASES) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `e:num` SUBST_ALL_TAC) THEN + DISJ1_TAC THEN + ASM_REWRITE_TAC[EXP; + ARITH_RULE `(4 * 4 * q) * r = 16 * (q*r)`; + MOD_MULT]);; + +let INT_REPRESENTS_124_CHILD_SCALE4 = prove + (`!rb rc k n:num. + (?x y z w:int. + x pow 2 + &2 * y pow 2 + &4 * z pow 2 + + &2 * &rb * y * w + &2 * &rc * z * w + + &k * w pow 2 = &n) + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &4 * z pow 2 + + &2 * &rb * y * w + &2 * &rc * z * w + + &k * w pow 2 = &(4*n)`, + REPEAT GEN_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` + (X_CHOOSE_THEN `z:int` (X_CHOOSE_TAC `w:int`)))) THEN + MAP_EVERY EXISTS_TAC + [`&2*x:int`; `&2*y:int`; `&2*z:int`; `&2*w:int`] THEN + FIRST_X_ASSUM(MP_TAC) THEN + REWRITE_TAC[GSYM INT_OF_NUM_MUL] THEN CONV_TAC INT_RING);; + +let INT_UNIVERSAL_124_CHILD_OF_MOD16 = prove + (`!rb rc k:num. + (!n:num. + 0 < n /\ n MOD 16 = 14 + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &4 * z pow 2 + + &2 * &rb * y * w + &2 * &rc * z * w + + &k * w pow 2 = &n) + ==> !n:num. + 0 < n + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &4 * z pow 2 + + &2 * &rb * y * w + &2 * &rc * z * w + + &k * w pow 2 = &n`, + REPEAT GEN_TAC THEN DISCH_THEN(LABEL_TAC "mod16") THEN + MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN + DISCH_THEN(LABEL_TAC "ind") THEN DISCH_TAC THEN + ASM_CASES_TAC `4 divides n` THENL + [FIRST_X_ASSUM(X_CHOOSE_THEN `q:num` ASSUME_TAC o + REWRITE_RULE[divides]) THEN + SUBGOAL_THEN `q < n /\ 0 < q` STRIP_ASSUME_TAC THENL + [ASM_ARITH_TAC; + ALL_TAC] THEN + ONCE_REWRITE_TAC[ASSUME `n = 4 * q`] THEN + MATCH_MP_TAC + (SPECL [`rb:num`; `rc:num`; `k:num`; `q:num`] + INT_REPRESENTS_124_CHILD_SCALE4) THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + ASM_CASES_TAC `?a b. n = 4 EXP a * (16*b+14)` THENL + [ASM_MESON_TAC + [NUM_124_EXCEPTION_MOD16; NUM_DIV4_OF_MOD16_0_OR_8]; + MP_TAC(MATCH_MP (SPEC `n:num` INT_REPRESENTS_124_OF_LEGENDRE) + (ASSUME `~(?a b. n = 4 EXP a * (16*b+14))`)) THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` + (X_CHOOSE_THEN `z:int` (LABEL_TAC "tern")))) THEN + MAP_EVERY EXISTS_TAC [`x:int`; `y:int`; `z:int`; `&0:int`] THEN + REMOVE_THEN "tern" MP_TAC THEN CONV_TAC INT_RING]);; + +let NUM_AVOIDS_124_SUB_OF_RESIDUE = prove + (`!n c:num. + c <= n /\ n MOD 16 = 14 /\ + ~(c MOD 16 = 0) /\ ~(c MOD 16 = 6) /\ ~(c MOD 16 = 14) + ==> ~(?a b. n - c = 4 EXP a * (16*b+14))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + DISCH_THEN(fun th -> + MP_TAC(MATCH_MP (SPEC `n - c:num` NUM_124_EXCEPTION_MOD16) th)) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THEN + (SUBGOAL_THEN + `((n - c) MOD 16 + c MOD 16) MOD 16 = 14` + ASSUME_TAC THENL + [REWRITE_TAC[MOD_ADD_MOD] THEN + ASM_SIMP_TAC[SUB_ADD]; + ALL_TAC]) THEN + MP_TAC(SPECL [`(n - c) MOD 16`; `c MOD 16`; `16`] + MOD_ADD_CASES) THEN + (ANTS_TAC THENL + [CONJ_TAC THEN REWRITE_TAC[MOD_LT_EQ] THEN ARITH_TAC; + ASM_REWRITE_TAC[] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC]));; + +(* ------------------------------------------------------------------------- *) +(* Orthogonal shifts into the regular ternary subform. *) +(* ------------------------------------------------------------------------- *) + +let INT_REPRESENTS_DIAG124_SHIFT = prove + (`!k s n:num. + k * s EXP 2 <= n /\ + ~(?a b. n - k * s EXP 2 = 4 EXP a * (16*b+14)) + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &4 * z pow 2 + + &k * w pow 2 = &n`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(MATCH_MP + (SPEC `n - k * s EXP 2` INT_REPRESENTS_124_OF_LEGENDRE) + (ASSUME + `~(?a b. n - k * s EXP 2 = 4 EXP a * (16*b+14))`)) THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` (X_CHOOSE_TAC `z:int`))) THEN + MAP_EVERY EXISTS_TAC [`x:int`; `y:int`; `z:int`; `&s:int`] THEN + SUBGOAL_THEN + `&(n - k * s EXP 2) = + (&n:int) - (&k:int) * (&s:int) pow 2` + ASSUME_TAC THENL + [ASM_SIMP_TAC[INT_OF_NUM_SUB; INT_OF_NUM_MUL; INT_OF_NUM_POW]; + MP_TAC(REWRITE_RULE + [ASSUME + `&(n - k * s EXP 2) = + (&n:int) - (&k:int) * (&s:int) pow 2`] + (ASSUME + `x pow 2 + &2 * y pow 2 + &4 * z pow 2 = + &(n - k * s EXP 2)`)) THEN + CONV_TAC INT_RING]);; + +let INT_REPRESENTS_ZC124_SHIFT = prove + (`!k s n:num. + 1 <= k /\ (16*k-4) * s EXP 2 <= n /\ + ~(?a b. n - (16*k-4) * s EXP 2 = + 4 EXP a * (16*b+14)) + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &4 * z pow 2 + + &2 * z * w + &k * w pow 2 = &n`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(MATCH_MP + (SPEC `n - (16*k-4) * s EXP 2` + INT_REPRESENTS_124_OF_LEGENDRE) + (ASSUME + `~(?a b. n - (16*k-4) * s EXP 2 = + 4 EXP a * (16*b+14))`)) THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` (X_CHOOSE_TAC `z:int`))) THEN + MAP_EVERY EXISTS_TAC + [`x:int`; `y:int`; `z - &s:int`; `&4 * &s:int`] THEN + SUBGOAL_THEN `4 <= 16*k` ASSUME_TAC THENL + [ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `&(n - (16*k-4) * s EXP 2) = + (&n:int) - (&16 * &k - &4) * &s pow 2` + ASSUME_TAC THENL + [ASM_SIMP_TAC[INT_OF_NUM_SUB; INT_OF_NUM_MUL; INT_OF_NUM_POW]; + MP_TAC(REWRITE_RULE + [ASSUME + `&(n - (16*k-4) * s EXP 2) = + (&n:int) - (&16 * &k - &4) * &s pow 2`] + (ASSUME + `x pow 2 + &2 * y pow 2 + &4 * z pow 2 = + &(n - (16*k-4) * s EXP 2)`)) THEN + CONV_TAC INT_RING]);; + +let INT_REPRESENTS_YC124_SHIFT = prove + (`!k s n:num. + 1 <= k /\ (4*k-2) * s EXP 2 <= n /\ + ~(?a b. n - (4*k-2) * s EXP 2 = + 4 EXP a * (16*b+14)) + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &4 * z pow 2 + + &2 * y * w + &k * w pow 2 = &n`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(MATCH_MP + (SPEC `n - (4*k-2) * s EXP 2` + INT_REPRESENTS_124_OF_LEGENDRE) + (ASSUME + `~(?a b. n - (4*k-2) * s EXP 2 = + 4 EXP a * (16*b+14))`)) THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` (X_CHOOSE_TAC `z:int`))) THEN + MAP_EVERY EXISTS_TAC + [`x:int`; `y - &s:int`; `z:int`; `&2 * &s:int`] THEN + SUBGOAL_THEN `2 <= 4*k` ASSUME_TAC THENL + [ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `&(n - (4*k-2) * s EXP 2) = + (&n:int) - (&4 * &k - &2) * &s pow 2` + ASSUME_TAC THENL + [ASM_SIMP_TAC[INT_OF_NUM_SUB; INT_OF_NUM_MUL; INT_OF_NUM_POW]; + MP_TAC(REWRITE_RULE + [ASSUME + `&(n - (4*k-2) * s EXP 2) = + (&n:int) - (&4 * &k - &2) * &s pow 2`] + (ASSUME + `x pow 2 + &2 * y pow 2 + &4 * z pow 2 = + &(n - (4*k-2) * s EXP 2)`)) THEN + CONV_TAC INT_RING]);; + +let INT_REPRESENTS_RC2_124_SHIFT = prove + (`!k s n:num. + 1 <= k /\ (4*k-4) * s EXP 2 <= n /\ + ~(?a b. n - (4*k-4) * s EXP 2 = + 4 EXP a * (16*b+14)) + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &4 * z pow 2 + + &4 * z * w + &k * w pow 2 = &n`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(MATCH_MP + (SPEC `n - (4*k-4) * s EXP 2` + INT_REPRESENTS_124_OF_LEGENDRE) + (ASSUME + `~(?a b. n - (4*k-4) * s EXP 2 = + 4 EXP a * (16*b+14))`)) THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` (X_CHOOSE_TAC `z:int`))) THEN + MAP_EVERY EXISTS_TAC + [`x:int`; `y:int`; `z - &s:int`; `&2 * &s:int`] THEN + SUBGOAL_THEN `4 <= 4*k` ASSUME_TAC THENL + [ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `&(n - (4*k-4) * s EXP 2) = + (&n:int) - (&4 * &k - &4) * &s pow 2` + ASSUME_TAC THENL + [ASM_SIMP_TAC[INT_OF_NUM_SUB; INT_OF_NUM_MUL; INT_OF_NUM_POW]; + MP_TAC(REWRITE_RULE + [ASSUME + `&(n - (4*k-4) * s EXP 2) = + (&n:int) - (&4 * &k - &4) * &s pow 2`] + (ASSUME + `x pow 2 + &2 * y pow 2 + &4 * z pow 2 = + &(n - (4*k-4) * s EXP 2)`)) THEN + CONV_TAC INT_RING]);; + +let INT_REPRESENTS_DC1_124_SHIFT = prove + (`!k s n:num. + 1 <= k /\ (16*k-12) * s EXP 2 <= n /\ + ~(?a b. n - (16*k-12) * s EXP 2 = + 4 EXP a * (16*b+14)) + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &4 * z pow 2 + + &2 * y * w + &2 * z * w + &k * w pow 2 = &n`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(MATCH_MP + (SPEC `n - (16*k-12) * s EXP 2` + INT_REPRESENTS_124_OF_LEGENDRE) + (ASSUME + `~(?a b. n - (16*k-12) * s EXP 2 = + 4 EXP a * (16*b+14))`)) THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` (X_CHOOSE_TAC `z:int`))) THEN + MAP_EVERY EXISTS_TAC + [`x:int`; `y - &2 * &s:int`; `z - &s:int`; `&4 * &s:int`] THEN + SUBGOAL_THEN `12 <= 16*k` ASSUME_TAC THENL + [ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `&(n - (16*k-12) * s EXP 2) = + (&n:int) - (&16 * &k - &12) * &s pow 2` + ASSUME_TAC THENL + [ASM_SIMP_TAC[INT_OF_NUM_SUB; INT_OF_NUM_MUL; INT_OF_NUM_POW]; + MP_TAC(REWRITE_RULE + [ASSUME + `&(n - (16*k-12) * s EXP 2) = + (&n:int) - (&16 * &k - &12) * &s pow 2`] + (ASSUME + `x pow 2 + &2 * y pow 2 + &4 * z pow 2 = + &(n - (16*k-12) * s EXP 2)`)) THEN + CONV_TAC INT_RING]);; + +let INT_REPRESENTS_DC2_124_SHIFT = prove + (`!k s n:num. + 2 <= k /\ (4*k-6) * s EXP 2 <= n /\ + ~(?a b. n - (4*k-6) * s EXP 2 = + 4 EXP a * (16*b+14)) + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &4 * z pow 2 + + &2 * y * w + &4 * z * w + &k * w pow 2 = &n`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(MATCH_MP + (SPEC `n - (4*k-6) * s EXP 2` + INT_REPRESENTS_124_OF_LEGENDRE) + (ASSUME + `~(?a b. n - (4*k-6) * s EXP 2 = + 4 EXP a * (16*b+14))`)) THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` (X_CHOOSE_TAC `z:int`))) THEN + MAP_EVERY EXISTS_TAC + [`x:int`; `y - &s:int`; `z - &s:int`; `&2 * &s:int`] THEN + SUBGOAL_THEN `6 <= 4*k` ASSUME_TAC THENL + [ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `&(n - (4*k-6) * s EXP 2) = + (&n:int) - (&4 * &k - &6) * &s pow 2` + ASSUME_TAC THENL + [ASM_SIMP_TAC[INT_OF_NUM_SUB; INT_OF_NUM_MUL; INT_OF_NUM_POW]; + MP_TAC(REWRITE_RULE + [ASSUME + `&(n - (4*k-6) * s EXP 2) = + (&n:int) - (&4 * &k - &6) * &s pow 2`] + (ASSUME + `x pow 2 + &2 * y pow 2 + &4 * z pow 2 = + &(n - (4*k-6) * s EXP 2)`)) THEN + CONV_TAC INT_RING]);; + +(* The search supplies concrete witnesses only; INT_REDUCE_CONV checks them. *) + +let int124_num_of_int i = + if i < 0 + then minus_num(num_of_string(string_of_int(-i))) + else num_of_string(string_of_int i);; + +let INT124_CERT_TAC rb rc k = + fun (asl,goal) -> + let _,bod = strip_exists goal in + let _,rhs = dest_eq bod in + let n = int_of_string(string_of_num(dest_intconst rhs)) in + let bound = + int_of_float(float_sqrt(float_of_int(8 * n))) + 2 in + let signed i = + if i = 0 then 0 else if i mod 2 = 1 then (i + 1) / 2 else -(i / 2) in + let rec find_w iw = + if iw > 2 * bound then failwith "INT124_CERT_TAC" else + let w = signed iw in + let rec find_z iz = + if iz > 2 * bound then find_w (iw + 1) else + let z = signed iz in + let rec find_y iy = + if iy > 2 * bound then find_z (iz + 1) else + let y = signed iy in + let r = + n - 2*y*y - 4*z*z - 2*rb*y*w - 2*rc*z*w - k*w*w in + if r < 0 then find_y (iy + 1) else + let x = int_of_float(float_sqrt(float_of_int r)) in + if x*x = r then (x,y,z,w) else find_y (iy + 1) in + find_y 0 in + find_z 0 in + let x,y,z,w = find_w 0 in + (MAP_EVERY EXISTS_TAC + (map (mk_intconst o int124_num_of_int) [x;y;z;w]) THEN + CONV_TAC INT_REDUCE_CONV) (asl,goal);; + +let INT_REPRESENTS_DIAG124_SMALL = prove + (`!k q:num. + 1 <= k /\ k <= 14 /\ q < 13 + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &4 * z pow 2 + + &k * w pow 2 = &(16*q+14)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN + `k = 1 \/ k = 2 \/ k = 3 \/ k = 4 \/ k = 5 \/ + k = 6 \/ k = 7 \/ k = 8 \/ k = 9 \/ k = 10 \/ + k = 11 \/ k = 12 \/ k = 13 \/ k = 14` + MP_TAC THENL + [ASM_ARITH_TAC; + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THENL + [NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 0 0 1; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 0 0 2; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 0 0 3; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 0 0 4; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 0 0 5; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 0 0 6; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 0 0 7; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 0 0 8; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 0 0 9; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 0 0 10; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 0 0 11; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 0 0 12; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 0 0 13; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 0 0 14]]);; + +let INT_REPRESENTS_ZC124_SMALL = prove + (`!k q:num. + 1 <= k /\ k <= 14 /\ q < 13 + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &4 * z pow 2 + + &2 * z * w + &k * w pow 2 = &(16*q+14)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN + `k = 1 \/ k = 2 \/ k = 3 \/ k = 4 \/ k = 5 \/ + k = 6 \/ k = 7 \/ k = 8 \/ k = 9 \/ k = 10 \/ + k = 11 \/ k = 12 \/ k = 13 \/ k = 14` + MP_TAC THENL + [ASM_ARITH_TAC; + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THENL + [NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 0 1 1; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 0 1 2; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 0 1 3; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 0 1 4; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 0 1 5; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 0 1 6; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 0 1 7; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 0 1 8; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 0 1 9; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 0 1 10; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 0 1 11; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 0 1 12; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 0 1 13; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 0 1 14]]);; + +let INT_REPRESENTS_YC124_SMALL = prove + (`!k q:num. + (k = 1 \/ k = 2 \/ k = 3 \/ k = 4 \/ k = 5 \/ + k = 6 \/ k = 9 \/ k = 10 \/ k = 13 \/ k = 14) /\ + q < 13 + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &4 * z pow 2 + + &2 * y * w + &k * w pow 2 = &(16*q+14)`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 + (REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) ASSUME_TAC) THENL + [NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 1 0 1; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 1 0 2; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 1 0 3; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 1 0 4; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 1 0 5; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 1 0 6; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 1 0 9; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 1 0 10; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 1 0 13; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 1 0 14]);; + +let INT_REPRESENTS_RC2_124_SMALL = prove + (`!k q:num. + (k = 2 \/ k = 3 \/ k = 4 \/ k = 5 \/ k = 6 \/ + k = 8 \/ k = 10 \/ k = 11 \/ k = 12 \/ k = 13 \/ k = 14) /\ + q < 13 + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &4 * z pow 2 + + &4 * z * w + &k * w pow 2 = &(16*q+14)`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 + (REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) ASSUME_TAC) THENL + [NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 0 2 2; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 0 2 3; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 0 2 4; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 0 2 5; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 0 2 6; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 0 2 8; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 0 2 10; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 0 2 11; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 0 2 12; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 0 2 13; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 0 2 14]);; + +let INT_REPRESENTS_DC1_124_SMALL = prove + (`!k q:num. + 1 <= k /\ k <= 14 /\ q < 13 + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &4 * z pow 2 + + &2 * y * w + &2 * z * w + &k * w pow 2 = &(16*q+14)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN + `k = 1 \/ k = 2 \/ k = 3 \/ k = 4 \/ k = 5 \/ + k = 6 \/ k = 7 \/ k = 8 \/ k = 9 \/ k = 10 \/ + k = 11 \/ k = 12 \/ k = 13 \/ k = 14` + MP_TAC THENL + [ASM_ARITH_TAC; + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THENL + [NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 1 1 1; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 1 1 2; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 1 1 3; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 1 1 4; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 1 1 5; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 1 1 6; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 1 1 7; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 1 1 8; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 1 1 9; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 1 1 10; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 1 1 11; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 1 1 12; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 1 1 13; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 1 1 14]]);; + +let INT_REPRESENTS_DC2_124_SMALL = prove + (`!k q:num. + (k = 2 \/ k = 3 \/ k = 4 \/ k = 5 \/ k = 6 \/ + k = 9 \/ k = 10 \/ k = 13 \/ k = 14) /\ + q < 13 + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &4 * z pow 2 + + &2 * y * w + &4 * z * w + &k * w pow 2 = &(16*q+14)`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 + (REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) ASSUME_TAC) THENL + [NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 1 2 2; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 1 2 3; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 1 2 4; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 1 2 5; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 1 2 6; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 1 2 9; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 1 2 10; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 1 2 13; + NUM_RANGE_CASES_TAC `q:num` 12 THEN + CONV_TAC NUM_REDUCE_CONV THEN INT124_CERT_TAC 1 2 14]);; + +(* ------------------------------------------------------------------------- *) +(* The two families whose orthogonal offsets have a fixed good residue. *) +(* ------------------------------------------------------------------------- *) + +let INT_REPRESENTS_ZC124_MOD16 = prove + (`!k n:num. + 1 <= k /\ k <= 14 /\ 0 < n /\ n MOD 16 = 14 + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &4 * z pow 2 + + &2 * z * w + &k * w pow 2 = &n`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(MATCH_MP (SPECL [`n:num`; `16`; `14`] NUM_DECOMPOSE_MOD) + (CONJ (ARITH_RULE `~(16 = 0)`) (ASSUME `n MOD 16 = 14`))) THEN + DISCH_THEN(X_CHOOSE_THEN `q:num` SUBST_ALL_TAC) THEN + ASM_CASES_TAC `q < 13` THENL + [MATCH_MP_TAC(SPECL [`k:num`; `q:num`] + INT_REPRESENTS_ZC124_SMALL) THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC(SPECL [`k:num`; `1`; `16*q+14`] + INT_REPRESENTS_ZC124_SHIFT) THEN + REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + ASM_ARITH_TAC; + REWRITE_TAC[NUM_REDUCE_CONV `(1:num) EXP 2`; MULT_CLAUSES] THEN + MATCH_MP_TAC(SPECL [`16*q+14`; `16*k-4`] + NUM_AVOIDS_124_SUB_OF_RESIDUE) THEN + SUBGOAL_THEN `16*k-4 = 16*(k-1)+12` SUBST1_TAC THENL + [ASM_ARITH_TAC; + ASM_REWRITE_TAC[MOD_MULT_ADD] THEN + CONV_TAC NUM_REDUCE_CONV THEN ASM_ARITH_TAC]]]);; + +let INT_UNIVERSAL_ZC124_NUM = prove + (`!k:num. + 1 <= k /\ k <= 14 + ==> !n:num. + 0 < n + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &4 * z pow 2 + + &2 * z * w + &k * w pow 2 = &n`, + GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(SIMP_RULE + [INT_MUL_LZERO; INT_MUL_RZERO; INT_MUL_LID; INT_MUL_RID; + INT_ADD_LID; INT_ADD_RID] + (SPECL [`0`; `1`; `k:num`] + INT_UNIVERSAL_124_CHILD_OF_MOD16)) THEN + X_GEN_TAC `n:num` THEN STRIP_TAC THEN + MATCH_MP_TAC(SPECL [`k:num`; `n:num`] + INT_REPRESENTS_ZC124_MOD16) THEN + ASM_REWRITE_TAC[]);; + +let INT_REPRESENTS_DC1_124_MOD16 = prove + (`!k n:num. + 1 <= k /\ k <= 14 /\ 0 < n /\ n MOD 16 = 14 + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &4 * z pow 2 + + &2 * y * w + &2 * z * w + &k * w pow 2 = &n`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(MATCH_MP (SPECL [`n:num`; `16`; `14`] NUM_DECOMPOSE_MOD) + (CONJ (ARITH_RULE `~(16 = 0)`) (ASSUME `n MOD 16 = 14`))) THEN + DISCH_THEN(X_CHOOSE_THEN `q:num` SUBST_ALL_TAC) THEN + ASM_CASES_TAC `q < 13` THENL + [MATCH_MP_TAC(SPECL [`k:num`; `q:num`] + INT_REPRESENTS_DC1_124_SMALL) THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC(SPECL [`k:num`; `1`; `16*q+14`] + INT_REPRESENTS_DC1_124_SHIFT) THEN + REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + ASM_ARITH_TAC; + REWRITE_TAC[NUM_REDUCE_CONV `(1:num) EXP 2`; MULT_CLAUSES] THEN + MATCH_MP_TAC(SPECL [`16*q+14`; `16*k-12`] + NUM_AVOIDS_124_SUB_OF_RESIDUE) THEN + SUBGOAL_THEN `16*k-12 = 16*(k-1)+4` SUBST1_TAC THENL + [ASM_ARITH_TAC; + ASM_REWRITE_TAC[MOD_MULT_ADD] THEN + CONV_TAC NUM_REDUCE_CONV THEN ASM_ARITH_TAC]]]);; + +let INT_UNIVERSAL_DC1_124_NUM = prove + (`!k:num. + 1 <= k /\ k <= 14 + ==> !n:num. + 0 < n + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &4 * z pow 2 + + &2 * y * w + &2 * z * w + &k * w pow 2 = &n`, + GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(SIMP_RULE + [INT_MUL_LZERO; INT_MUL_RZERO; INT_MUL_LID; INT_MUL_RID; + INT_ADD_LID; INT_ADD_RID] + (SPECL [`1`; `1`; `k:num`] + INT_UNIVERSAL_124_CHILD_OF_MOD16)) THEN + X_GEN_TAC `n:num` THEN STRIP_TAC THEN + MATCH_MP_TAC(SPECL [`k:num`; `n:num`] + INT_REPRESENTS_DC1_124_MOD16) THEN + ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Choices between the offsets m and 4m. *) +(* ------------------------------------------------------------------------- *) + +let NUM_DIAG124_OFFSET_CHOICE = prove + (`!k:num. + 1 <= k /\ k <= 14 + ==> ?s. + k * s EXP 2 <= 56 /\ + ~((k * s EXP 2) MOD 16 = 0) /\ + ~((k * s EXP 2) MOD 16 = 6) /\ + ~((k * s EXP 2) MOD 16 = 14)`, + GEN_TAC THEN STRIP_TAC THEN + EXISTS_TAC `if k = 6 \/ k = 14 then 2 else 1` THEN + NUM_RANGE_CASES_TAC `k:num` 14 THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN + ASM_ARITH_TAC);; + +let NUM_YC124_OFFSET_CHOICE = prove + (`!k:num. + (k = 1 \/ k = 2 \/ k = 3 \/ k = 4 \/ k = 5 \/ + k = 6 \/ k = 9 \/ k = 10 \/ k = 13 \/ k = 14) + ==> ?s. + (4*k-2) * s EXP 2 <= 216 /\ + ~(((4*k-2) * s EXP 2) MOD 16 = 0) /\ + ~(((4*k-2) * s EXP 2) MOD 16 = 6) /\ + ~(((4*k-2) * s EXP 2) MOD 16 = 14)`, + GEN_TAC THEN DISCH_TAC THEN + EXISTS_TAC + `if k = 2 \/ k = 4 \/ k = 6 \/ k = 10 \/ k = 14 + then 2 else 1` THEN + UNDISCH_TAC + `k = 1 \/ k = 2 \/ k = 3 \/ k = 4 \/ k = 5 \/ + k = 6 \/ k = 9 \/ k = 10 \/ k = 13 \/ k = 14` THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + CONV_TAC NUM_REDUCE_CONV);; + +let NUM_RC2_124_OFFSET_CHOICE = prove + (`!k:num. + (k = 2 \/ k = 3 \/ k = 4 \/ k = 6 \/ + k = 8 \/ k = 10 \/ k = 11 \/ k = 12 \/ k = 14) + ==> ?s. + (4*k-4) * s EXP 2 <= 52 /\ + ~(((4*k-4) * s EXP 2) MOD 16 = 0) /\ + ~(((4*k-4) * s EXP 2) MOD 16 = 6) /\ + ~(((4*k-4) * s EXP 2) MOD 16 = 14)`, + GEN_TAC THEN DISCH_TAC THEN + EXISTS_TAC `1` THEN + UNDISCH_TAC + `k = 2 \/ k = 3 \/ k = 4 \/ k = 6 \/ + k = 8 \/ k = 10 \/ k = 11 \/ k = 12 \/ k = 14` THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + CONV_TAC NUM_REDUCE_CONV);; + +let NUM_DC2_124_OFFSET_CHOICE = prove + (`!k:num. + (k = 2 \/ k = 3 \/ k = 4 \/ k = 5 \/ k = 6 \/ + k = 9 \/ k = 10 \/ k = 13 \/ k = 14) + ==> ?s. + (4*k-6) * s EXP 2 <= 184 /\ + ~(((4*k-6) * s EXP 2) MOD 16 = 0) /\ + ~(((4*k-6) * s EXP 2) MOD 16 = 6) /\ + ~(((4*k-6) * s EXP 2) MOD 16 = 14)`, + GEN_TAC THEN DISCH_TAC THEN + EXISTS_TAC `if k = 3 \/ k = 5 \/ k = 9 \/ k = 13 then 2 else 1` THEN + UNDISCH_TAC + `k = 2 \/ k = 3 \/ k = 4 \/ k = 5 \/ k = 6 \/ + k = 9 \/ k = 10 \/ k = 13 \/ k = 14` THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + CONV_TAC NUM_REDUCE_CONV);; + +let NUM_LE_16Q14_OF_LE_216 = prove + (`!c q:num. c <= 216 /\ ~(q < 13) ==> c <= 16*q+14`, + ARITH_TAC);; + +let NUM_LE_16Q14_OF_LE_184 = prove + (`!c q:num. c <= 184 /\ ~(q < 13) ==> c <= 16*q+14`, + ARITH_TAC);; + +let NUM_LE_16Q14_OF_LE_52 = prove + (`!c q:num. c <= 52 /\ ~(q < 13) ==> c <= 16*q+14`, + ARITH_TAC);; + +let NUM_YC124_K_POS = prove + (`!k:num. + (k = 1 \/ k = 2 \/ k = 3 \/ k = 4 \/ k = 5 \/ + k = 6 \/ k = 9 \/ k = 10 \/ k = 13 \/ k = 14) + ==> 1 <= k`, + ARITH_TAC);; + +let NUM_DC2_124_K_LOWER = prove + (`!k:num. + (k = 2 \/ k = 3 \/ k = 4 \/ k = 5 \/ k = 6 \/ + k = 9 \/ k = 10 \/ k = 13 \/ k = 14) + ==> 2 <= k`, + ARITH_TAC);; + +let NUM_RC2_124_K_POS = prove + (`!k:num. + (k = 2 \/ k = 3 \/ k = 4 \/ k = 6 \/ + k = 8 \/ k = 10 \/ k = 11 \/ k = 12 \/ k = 14) + ==> 1 <= k`, + ARITH_TAC);; + +let INT_REPRESENTS_DIAG124_MOD16 = prove + (`!k n:num. + 1 <= k /\ k <= 14 /\ 0 < n /\ n MOD 16 = 14 + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &4 * z pow 2 + + &k * w pow 2 = &n`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(MATCH_MP (SPECL [`n:num`; `16`; `14`] NUM_DECOMPOSE_MOD) + (CONJ (ARITH_RULE `~(16 = 0)`) (ASSUME `n MOD 16 = 14`))) THEN + DISCH_THEN(X_CHOOSE_THEN `q:num` SUBST_ALL_TAC) THEN + ASM_CASES_TAC `q < 13` THENL + [MATCH_MP_TAC(SPECL [`k:num`; `q:num`] + INT_REPRESENTS_DIAG124_SMALL) THEN + ASM_REWRITE_TAC[]; + MP_TAC(MATCH_MP (SPEC `k:num` NUM_DIAG124_OFFSET_CHOICE) + (CONJ (ASSUME `1 <= k`) (ASSUME `k <= 14`))) THEN + DISCH_THEN(X_CHOOSE_THEN `s:num` STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC(SPECL [`k:num`; `s:num`; `16*q+14`] + INT_REPRESENTS_DIAG124_SHIFT) THEN + CONJ_TAC THENL + [ASM_ARITH_TAC; + MATCH_MP_TAC(SPECL [`16*q+14`; `k * s EXP 2`] + NUM_AVOIDS_124_SUB_OF_RESIDUE) THEN + ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC]]);; + +let INT_UNIVERSAL_DIAG124_NUM = prove + (`!k:num. + 1 <= k /\ k <= 14 + ==> !n:num. + 0 < n + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &4 * z pow 2 + + &k * w pow 2 = &n`, + GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(SIMP_RULE + [INT_MUL_LZERO; INT_MUL_RZERO; INT_MUL_LID; INT_MUL_RID; + INT_ADD_LID; INT_ADD_RID] + (SPECL [`0`; `0`; `k:num`] + INT_UNIVERSAL_124_CHILD_OF_MOD16)) THEN + X_GEN_TAC `n:num` THEN STRIP_TAC THEN + MATCH_MP_TAC(SPECL [`k:num`; `n:num`] + INT_REPRESENTS_DIAG124_MOD16) THEN + ASM_REWRITE_TAC[]);; + +let INT_REPRESENTS_YC124_LARGE = prove + (`!k q:num. + (k = 1 \/ k = 2 \/ k = 3 \/ k = 4 \/ k = 5 \/ + k = 6 \/ k = 9 \/ k = 10 \/ k = 13 \/ k = 14) /\ + ~(q < 13) + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &4 * z pow 2 + + &2 * y * w + &k * w pow 2 = &(16*q+14)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(MATCH_MP (SPEC `k:num` NUM_YC124_OFFSET_CHOICE) + (ASSUME + `k = 1 \/ k = 2 \/ k = 3 \/ k = 4 \/ k = 5 \/ + k = 6 \/ k = 9 \/ k = 10 \/ k = 13 \/ k = 14`)) THEN + DISCH_THEN(X_CHOOSE_THEN `s:num` STRIP_ASSUME_TAC) THEN + let offle = MATCH_MP + (SPECL [`(4*k-2) * s EXP 2`; `q:num`] + NUM_LE_16Q14_OF_LE_216) + (CONJ (ASSUME `(4*k-2) * s EXP 2 <= 216`) + (ASSUME `~(q < 13)`)) in + let kpos = MATCH_MP (SPEC `k:num` NUM_YC124_K_POS) + (ASSUME + `k = 1 \/ k = 2 \/ k = 3 \/ k = 4 \/ k = 5 \/ + k = 6 \/ k = 9 \/ k = 10 \/ k = 13 \/ k = 14`) in + let nres = EQT_ELIM + ((REWRITE_CONV[MOD_MULT_ADD] THENC NUM_REDUCE_CONV) + `(16*q+14) MOD 16 = 14`) in + let avoids = MATCH_MP + (SPECL [`16*q+14`; `(4*k-2) * s EXP 2`] + NUM_AVOIDS_124_SUB_OF_RESIDUE) + (CONJ offle + (CONJ nres + (CONJ + (ASSUME `~(((4*k-2) * s EXP 2) MOD 16 = 0)`) + (CONJ + (ASSUME `~(((4*k-2) * s EXP 2) MOD 16 = 6)`) + (ASSUME `~(((4*k-2) * s EXP 2) MOD 16 = 14)`))))) in + ACCEPT_TAC(MATCH_MP + (SPECL [`k:num`; `s:num`; `16*q+14`] + INT_REPRESENTS_YC124_SHIFT) + (CONJ kpos (CONJ offle avoids))));; + +let INT_REPRESENTS_YC124_MOD16 = prove + (`!k n:num. + (k = 1 \/ k = 2 \/ k = 3 \/ k = 4 \/ k = 5 \/ + k = 6 \/ k = 9 \/ k = 10 \/ k = 13 \/ k = 14) /\ + 0 < n /\ n MOD 16 = 14 + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &4 * z pow 2 + + &2 * y * w + &k * w pow 2 = &n`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(MATCH_MP (SPECL [`n:num`; `16`; `14`] NUM_DECOMPOSE_MOD) + (CONJ (ARITH_RULE `~(16 = 0)`) (ASSUME `n MOD 16 = 14`))) THEN + DISCH_THEN(X_CHOOSE_THEN `q:num` SUBST_ALL_TAC) THEN + let krange = ASSUME + `k = 1 \/ k = 2 \/ k = 3 \/ k = 4 \/ k = 5 \/ + k = 6 \/ k = 9 \/ k = 10 \/ k = 13 \/ k = 14` in + let small = MATCH_MP + (SPECL [`k:num`; `q:num`] INT_REPRESENTS_YC124_SMALL) + (CONJ krange (ASSUME `q < 13`)) in + let large = MATCH_MP + (SPECL [`k:num`; `q:num`] INT_REPRESENTS_YC124_LARGE) + (CONJ krange (ASSUME `~(q < 13)`)) in + ACCEPT_TAC(DISJ_CASES (SPEC `q < 13` EXCLUDED_MIDDLE) small large));; + +let INT_UNIVERSAL_YC124_NUM = prove + (`!k:num. + (k = 1 \/ k = 2 \/ k = 3 \/ k = 4 \/ k = 5 \/ + k = 6 \/ k = 9 \/ k = 10 \/ k = 13 \/ k = 14) + ==> !n:num. + 0 < n + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &4 * z pow 2 + + &2 * y * w + &k * w pow 2 = &n`, + GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(SIMP_RULE + [INT_MUL_LZERO; INT_MUL_RZERO; INT_MUL_LID; INT_MUL_RID; + INT_ADD_LID; INT_ADD_RID] + (SPECL [`1`; `0`; `k:num`] + INT_UNIVERSAL_124_CHILD_OF_MOD16)) THEN + X_GEN_TAC `n:num` THEN STRIP_TAC THEN + MATCH_MP_TAC(SPECL [`k:num`; `n:num`] + INT_REPRESENTS_YC124_MOD16) THEN + ASM_REWRITE_TAC[]);; + +let INT_REPRESENTS_DC2_124_LARGE = prove + (`!k q:num. + (k = 2 \/ k = 3 \/ k = 4 \/ k = 5 \/ k = 6 \/ + k = 9 \/ k = 10 \/ k = 13 \/ k = 14) /\ + ~(q < 13) + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &4 * z pow 2 + + &2 * y * w + &4 * z * w + &k * w pow 2 = &(16*q+14)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(MATCH_MP (SPEC `k:num` NUM_DC2_124_OFFSET_CHOICE) + (ASSUME + `k = 2 \/ k = 3 \/ k = 4 \/ k = 5 \/ k = 6 \/ + k = 9 \/ k = 10 \/ k = 13 \/ k = 14`)) THEN + DISCH_THEN(X_CHOOSE_THEN `s:num` STRIP_ASSUME_TAC) THEN + let offle = MATCH_MP + (SPECL [`(4*k-6) * s EXP 2`; `q:num`] + NUM_LE_16Q14_OF_LE_184) + (CONJ (ASSUME `(4*k-6) * s EXP 2 <= 184`) + (ASSUME `~(q < 13)`)) in + let klower = MATCH_MP (SPEC `k:num` NUM_DC2_124_K_LOWER) + (ASSUME + `k = 2 \/ k = 3 \/ k = 4 \/ k = 5 \/ k = 6 \/ + k = 9 \/ k = 10 \/ k = 13 \/ k = 14`) in + let nres = EQT_ELIM + ((REWRITE_CONV[MOD_MULT_ADD] THENC NUM_REDUCE_CONV) + `(16*q+14) MOD 16 = 14`) in + let avoids = MATCH_MP + (SPECL [`16*q+14`; `(4*k-6) * s EXP 2`] + NUM_AVOIDS_124_SUB_OF_RESIDUE) + (CONJ offle + (CONJ nres + (CONJ + (ASSUME `~(((4*k-6) * s EXP 2) MOD 16 = 0)`) + (CONJ + (ASSUME `~(((4*k-6) * s EXP 2) MOD 16 = 6)`) + (ASSUME `~(((4*k-6) * s EXP 2) MOD 16 = 14)`))))) in + ACCEPT_TAC(MATCH_MP + (SPECL [`k:num`; `s:num`; `16*q+14`] + INT_REPRESENTS_DC2_124_SHIFT) + (CONJ klower (CONJ offle avoids))));; + +let INT_REPRESENTS_DC2_124_MOD16 = prove + (`!k n:num. + (k = 2 \/ k = 3 \/ k = 4 \/ k = 5 \/ k = 6 \/ + k = 9 \/ k = 10 \/ k = 13 \/ k = 14) /\ + 0 < n /\ n MOD 16 = 14 + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &4 * z pow 2 + + &2 * y * w + &4 * z * w + &k * w pow 2 = &n`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(MATCH_MP (SPECL [`n:num`; `16`; `14`] NUM_DECOMPOSE_MOD) + (CONJ (ARITH_RULE `~(16 = 0)`) (ASSUME `n MOD 16 = 14`))) THEN + DISCH_THEN(X_CHOOSE_THEN `q:num` SUBST_ALL_TAC) THEN + let krange = ASSUME + `k = 2 \/ k = 3 \/ k = 4 \/ k = 5 \/ k = 6 \/ + k = 9 \/ k = 10 \/ k = 13 \/ k = 14` in + let small = MATCH_MP + (SPECL [`k:num`; `q:num`] INT_REPRESENTS_DC2_124_SMALL) + (CONJ krange (ASSUME `q < 13`)) in + let large = MATCH_MP + (SPECL [`k:num`; `q:num`] INT_REPRESENTS_DC2_124_LARGE) + (CONJ krange (ASSUME `~(q < 13)`)) in + ACCEPT_TAC(DISJ_CASES (SPEC `q < 13` EXCLUDED_MIDDLE) small large));; + +let INT_DOUBLE_TWO_MUL = INT_RING + `!z w:int. &2 * &2 * z * w = &4 * z * w`;; + +let INT_UNIVERSAL_DC2_124_NUM = prove + (`!k:num. + (k = 2 \/ k = 3 \/ k = 4 \/ k = 5 \/ k = 6 \/ + k = 9 \/ k = 10 \/ k = 13 \/ k = 14) + ==> !n:num. + 0 < n + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &4 * z pow 2 + + &2 * y * w + &4 * z * w + &k * w pow 2 = &n`, + GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(SIMP_RULE + [INT_DOUBLE_TWO_MUL; + INT_MUL_LZERO; INT_MUL_RZERO; INT_MUL_LID; INT_MUL_RID; + INT_ADD_LID; INT_ADD_RID] + (SPECL [`1`; `2`; `k:num`] + INT_UNIVERSAL_124_CHILD_OF_MOD16)) THEN + X_GEN_TAC `n:num` THEN STRIP_TAC THEN + MATCH_MP_TAC(SPECL [`k:num`; `n:num`] + INT_REPRESENTS_DC2_124_MOD16) THEN + ASM_REWRITE_TAC[]);; + +let INT_112_ALL_EVEN_NE_16Q2 = prove + (`!a b c q:int. + ~((&2*a) pow 2 + (&2*b) pow 2 + &2*(&2*c) pow 2 = + &16*q + &2)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN + `&2 * (a pow 2 + b pow 2 + &2*c pow 2 - &4*q) = &1` + ASSUME_TAC THENL + [MATCH_MP_TAC(INT_RING + `(&2*a) pow 2 + (&2*b) pow 2 + &2*(&2*c) pow 2 = + &16*q + &2 + ==> &2 * (a pow 2 + b pow 2 + &2*c pow 2 - &4*q) = &1`) THEN + ASM_REWRITE_TAC[]; + MP_TAC(SPEC + `a pow 2 + b pow 2 + &2*c pow 2 - &4*q` + INT_TWO_MUL_NE_ONE) THEN + ASM_REWRITE_TAC[]]);; + +let INT_112_ALL_EVEN_NE_16Q10 = prove + (`!a b c q:int. + ~((&2*a) pow 2 + (&2*b) pow 2 + &2*(&2*c) pow 2 = + &16*q + &10)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN + `&2 * (a pow 2 + b pow 2 + &2*c pow 2 - &4*q - &2) = &1` + ASSUME_TAC THENL + [MATCH_MP_TAC(INT_RING + `(&2*a) pow 2 + (&2*b) pow 2 + &2*(&2*c) pow 2 = + &16*q + &10 + ==> &2 * + (a pow 2 + b pow 2 + &2*c pow 2 - &4*q - &2) = &1`) THEN + ASM_REWRITE_TAC[]; + MP_TAC(SPEC + `a pow 2 + b pow 2 + &2*c pow 2 - &4*q - &2` + INT_TWO_MUL_NE_ONE) THEN + ASM_REWRITE_TAC[]]);; + +let INT_112_OPPOSITE_HALVES_NE_16Q2 = prove + (`!a b c q:int. + ~((&4*a) pow 2 + (&4*b + &2) pow 2 + + &2*(&2*c + &1) pow 2 = &16*q + &2)`, + REPEAT GEN_TAC THEN + MP_TAC(SPEC `c:int` INT_PARITY_WITNESS) THEN + DISCH_THEN(DISJ_CASES_THEN (X_CHOOSE_THEN `d:int` SUBST_ALL_TAC)) THEN + DISCH_TAC THENL + [SUBGOAL_THEN + `&2 * (&2*q - &2*a pow 2 - &2*b pow 2 - &2*b - + &4*d pow 2 - &2*d) = &1` + ASSUME_TAC THENL + [MATCH_MP_TAC(INT_RING + `(&4*a) pow 2 + (&4*b + &2) pow 2 + + &2*(&2*(&2*d) + &1) pow 2 = &16*q + &2 + ==> &2 * (&2*q - &2*a pow 2 - &2*b pow 2 - &2*b - + &4*d pow 2 - &2*d) = &1`) THEN + ASM_REWRITE_TAC[]; + MP_TAC(SPEC + `&2*q - &2*a pow 2 - &2*b pow 2 - &2*b - + &4*d pow 2 - &2*d` INT_TWO_MUL_NE_ONE) THEN + ASM_REWRITE_TAC[]]; + SUBGOAL_THEN + `&2 * (&2*q - &2*a pow 2 - &2*b pow 2 - &2*b - + &4*d pow 2 - &6*d - &2) = &1` + ASSUME_TAC THENL + [MATCH_MP_TAC(INT_RING + `(&4*a) pow 2 + (&4*b + &2) pow 2 + + &2*(&2*(&2*d + &1) + &1) pow 2 = &16*q + &2 + ==> &2 * (&2*q - &2*a pow 2 - &2*b pow 2 - &2*b - + &4*d pow 2 - &6*d - &2) = &1`) THEN + ASM_REWRITE_TAC[]; + MP_TAC(SPEC + `&2*q - &2*a pow 2 - &2*b pow 2 - &2*b - + &4*d pow 2 - &6*d - &2` INT_TWO_MUL_NE_ONE) THEN + ASM_REWRITE_TAC[]]]);; + +let INT_112_OPPOSITE_HALVES_NE_16Q10 = prove + (`!a b c q:int. + ~((&4*a) pow 2 + (&4*b + &2) pow 2 + + &2*(&2*c + &1) pow 2 = &16*q + &10)`, + REPEAT GEN_TAC THEN + MP_TAC(SPEC `c:int` INT_PARITY_WITNESS) THEN + DISCH_THEN(DISJ_CASES_THEN (X_CHOOSE_THEN `d:int` SUBST_ALL_TAC)) THEN + DISCH_TAC THENL + [SUBGOAL_THEN + `&2 * (&2*a pow 2 + &2*b pow 2 + &2*b + + &4*d pow 2 + &2*d - &2*q) = &1` + ASSUME_TAC THENL + [MATCH_MP_TAC(INT_RING + `(&4*a) pow 2 + (&4*b + &2) pow 2 + + &2*(&2*(&2*d) + &1) pow 2 = &16*q + &10 + ==> &2 * (&2*a pow 2 + &2*b pow 2 + &2*b + + &4*d pow 2 + &2*d - &2*q) = &1`) THEN + ASM_REWRITE_TAC[]; + MP_TAC(SPEC + `&2*a pow 2 + &2*b pow 2 + &2*b + + &4*d pow 2 + &2*d - &2*q` INT_TWO_MUL_NE_ONE) THEN + ASM_REWRITE_TAC[]]; + SUBGOAL_THEN + `&2 * (&2*a pow 2 + &2*b pow 2 + &2*b + + &4*d pow 2 + &6*d + &2 - &2*q) = &1` + ASSUME_TAC THENL + [MATCH_MP_TAC(INT_RING + `(&4*a) pow 2 + (&4*b + &2) pow 2 + + &2*(&2*(&2*d + &1) + &1) pow 2 = &16*q + &10 + ==> &2 * (&2*a pow 2 + &2*b pow 2 + &2*b + + &4*d pow 2 + &6*d + &2 - &2*q) = &1`) THEN + ASM_REWRITE_TAC[]; + MP_TAC(SPEC + `&2*a pow 2 + &2*b pow 2 + &2*b + + &4*d pow 2 + &6*d + &2 - &2*q` INT_TWO_MUL_NE_ONE) THEN + ASM_REWRITE_TAC[]]]);; + +let INT_112_OPPOSITE_HALVES_SYM_NE_16Q2 = prove + (`!a b c q:int. + ~((&4*a + &2) pow 2 + (&4*b) pow 2 + + &2*(&2*c + &1) pow 2 = &16*q + &2)`, + MESON_TAC[INT_112_OPPOSITE_HALVES_NE_16Q2; + INT_RING + `(&4*a + &2) pow 2 + (&4*b) pow 2 + + &2*(&2*c + &1) pow 2 = &16*q + &2 + ==> (&4*b) pow 2 + (&4*a + &2) pow 2 + + &2*(&2*c + &1) pow 2 = &16*q + &2`]);; + +let INT_112_OPPOSITE_HALVES_SYM_NE_16Q10 = prove + (`!a b c q:int. + ~((&4*a + &2) pow 2 + (&4*b) pow 2 + + &2*(&2*c + &1) pow 2 = &16*q + &10)`, + MESON_TAC[INT_112_OPPOSITE_HALVES_NE_16Q10; + INT_RING + `(&4*a + &2) pow 2 + (&4*b) pow 2 + + &2*(&2*c + &1) pow 2 = &16*q + &10 + ==> (&4*b) pow 2 + (&4*a + &2) pow 2 + + &2*(&2*c + &1) pow 2 = &16*q + &10`]);; + +let INT_REPRESENTS_112_ODD_SECOND_16Q2 = prove + (`!q:num. + ?x y z t:int. + x pow 2 + y pow 2 + &2*z pow 2 = &(16*q+2) /\ + y = &2*t + &1`, + GEN_TAC THEN + MP_TAC(SPEC `16*q+2` INT_REPRESENTS_112_TWO) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [REWRITE_TAC[ARITH_RULE `16*q+2 = 4*(4*q)+2`; MOD_MULT_ADD] THEN + CONV_TAC NUM_REDUCE_CONV; + REWRITE_TAC[MOD_MULT_ADD] THEN CONV_TAC NUM_REDUCE_CONV]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` + (X_CHOOSE_THEN `z:int` (LABEL_TAC "rep")))) THEN + MP_TAC(SPEC `x:int` INT_PARITY_WITNESS) THEN + DISCH_THEN(DISJ_CASES_THEN + (X_CHOOSE_THEN `a:int` SUBST_ALL_TAC)) THEN + MP_TAC(SPEC `y:int` INT_PARITY_WITNESS) THEN + DISCH_THEN(DISJ_CASES_THEN + (X_CHOOSE_THEN `b:int` SUBST_ALL_TAC)) THENL + [MP_TAC(SPEC `z:int` INT_PARITY_WITNESS) THEN + DISCH_THEN(DISJ_CASES_THEN + (X_CHOOSE_THEN `c:int` SUBST_ALL_TAC)) THENL + [CONTR_TAC + (MP + (NOT_ELIM(SPECL [`a:int`; `b:int`; `c:int`; `&q:int`] + INT_112_ALL_EVEN_NE_16Q2)) + (REWRITE_RULE[GSYM INT_OF_NUM_ADD; GSYM INT_OF_NUM_MUL] + (ASSUME + `(&2*a) pow 2 + (&2*b) pow 2 + &2*(&2*c) pow 2 = + &(16*q+2)`))); + MP_TAC(SPEC `a:int` INT_PARITY_WITNESS) THEN + DISCH_THEN(DISJ_CASES_THEN + (X_CHOOSE_THEN `aa:int` SUBST_ALL_TAC)) THEN + MP_TAC(SPEC `b:int` INT_PARITY_WITNESS) THEN + DISCH_THEN(DISJ_CASES_THEN + (X_CHOOSE_THEN `bb:int` SUBST_ALL_TAC)) THENL + [MAP_EVERY EXISTS_TAC + [`(&2*aa) + (&2*bb) + (&2*c + &1):int`; + `(&2*aa) + (&2*bb) - (&2*c + &1):int`; + `(&2*aa) - (&2*bb):int`; + `aa + bb - c - &1:int`] THEN + CONJ_TAC THENL + [REMOVE_THEN "rep" MP_TAC THEN CONV_TAC INT_RING; + CONV_TAC INT_RING]; + CONTR_TAC + (MP + (NOT_ELIM(SPECL [`aa:int`; `bb:int`; `c:int`; `&q:int`] + INT_112_OPPOSITE_HALVES_NE_16Q2)) + (MATCH_MP + (INT_RING + `(&2*(&2*aa)) pow 2 + (&2*(&2*bb + &1)) pow 2 + + &2*(&2*c + &1) pow 2 = &16 * &q + &2 + ==> (&4*aa) pow 2 + (&4*bb + &2) pow 2 + + &2*(&2*c + &1) pow 2 = &16 * &q + &2`) + (REWRITE_RULE[GSYM INT_OF_NUM_ADD; GSYM INT_OF_NUM_MUL] + (ASSUME + `(&2*(&2*aa)) pow 2 + (&2*(&2*bb + &1)) pow 2 + + &2*(&2*c + &1) pow 2 = &(16*q+2)`)))); + CONTR_TAC + (MP + (NOT_ELIM(SPECL [`aa:int`; `bb:int`; `c:int`; `&q:int`] + INT_112_OPPOSITE_HALVES_SYM_NE_16Q2)) + (MATCH_MP + (INT_RING + `(&2*(&2*aa + &1)) pow 2 + (&2*(&2*bb)) pow 2 + + &2*(&2*c + &1) pow 2 = &16 * &q + &2 + ==> (&4*aa + &2) pow 2 + (&4*bb) pow 2 + + &2*(&2*c + &1) pow 2 = &16 * &q + &2`) + (REWRITE_RULE[GSYM INT_OF_NUM_ADD; GSYM INT_OF_NUM_MUL] + (ASSUME + `(&2*(&2*aa + &1)) pow 2 + (&2*(&2*bb)) pow 2 + + &2*(&2*c + &1) pow 2 = &(16*q+2)`)))); + MAP_EVERY EXISTS_TAC + [`(&2*aa + &1) + (&2*bb + &1) + (&2*c + &1):int`; + `(&2*aa + &1) + (&2*bb + &1) - (&2*c + &1):int`; + `(&2*aa + &1) - (&2*bb + &1):int`; + `aa + bb - c:int`] THEN + CONJ_TAC THENL + [REMOVE_THEN "rep" MP_TAC THEN CONV_TAC INT_RING; + CONV_TAC INT_RING]]]; + MAP_EVERY EXISTS_TAC + [`&2*a:int`; `&2*b + &1:int`; `z:int`; `b:int`] THEN + ASM_REWRITE_TAC[]; + MAP_EVERY EXISTS_TAC + [`&2*b:int`; `&2*a + &1:int`; `z:int`; `a:int`] THEN + REMOVE_THEN "rep" MP_TAC THEN CONV_TAC INT_RING; + MAP_EVERY EXISTS_TAC + [`&2*a + &1:int`; `&2*b + &1:int`; `z:int`; `b:int`] THEN + ASM_REWRITE_TAC[]]);; + +let INT_REPRESENTS_112_ODD_SECOND_16Q10 = prove + (`!q:num. + ?x y z t:int. + x pow 2 + y pow 2 + &2*z pow 2 = &(16*q+10) /\ + y = &2*t + &1`, + GEN_TAC THEN + MP_TAC(SPEC `16*q+10` INT_REPRESENTS_112_TWO) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [REWRITE_TAC[ARITH_RULE `16*q+10 = 4*(4*q+2)+2`; + MOD_MULT_ADD] THEN + CONV_TAC NUM_REDUCE_CONV; + REWRITE_TAC[MOD_MULT_ADD] THEN CONV_TAC NUM_REDUCE_CONV]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` + (X_CHOOSE_THEN `z:int` (LABEL_TAC "rep")))) THEN + MP_TAC(SPEC `x:int` INT_PARITY_WITNESS) THEN + DISCH_THEN(DISJ_CASES_THEN + (X_CHOOSE_THEN `a:int` SUBST_ALL_TAC)) THEN + MP_TAC(SPEC `y:int` INT_PARITY_WITNESS) THEN + DISCH_THEN(DISJ_CASES_THEN + (X_CHOOSE_THEN `b:int` SUBST_ALL_TAC)) THENL + [MP_TAC(SPEC `z:int` INT_PARITY_WITNESS) THEN + DISCH_THEN(DISJ_CASES_THEN + (X_CHOOSE_THEN `c:int` SUBST_ALL_TAC)) THENL + [CONTR_TAC + (MP + (NOT_ELIM(SPECL [`a:int`; `b:int`; `c:int`; `&q:int`] + INT_112_ALL_EVEN_NE_16Q10)) + (REWRITE_RULE[GSYM INT_OF_NUM_ADD; GSYM INT_OF_NUM_MUL] + (ASSUME + `(&2*a) pow 2 + (&2*b) pow 2 + &2*(&2*c) pow 2 = + &(16*q+10)`))); + MP_TAC(SPEC `a:int` INT_PARITY_WITNESS) THEN + DISCH_THEN(DISJ_CASES_THEN + (X_CHOOSE_THEN `aa:int` SUBST_ALL_TAC)) THEN + MP_TAC(SPEC `b:int` INT_PARITY_WITNESS) THEN + DISCH_THEN(DISJ_CASES_THEN + (X_CHOOSE_THEN `bb:int` SUBST_ALL_TAC)) THENL + [MAP_EVERY EXISTS_TAC + [`(&2*aa) + (&2*bb) + (&2*c + &1):int`; + `(&2*aa) + (&2*bb) - (&2*c + &1):int`; + `(&2*aa) - (&2*bb):int`; + `aa + bb - c - &1:int`] THEN + CONJ_TAC THENL + [REMOVE_THEN "rep" MP_TAC THEN CONV_TAC INT_RING; + CONV_TAC INT_RING]; + CONTR_TAC + (MP + (NOT_ELIM(SPECL [`aa:int`; `bb:int`; `c:int`; `&q:int`] + INT_112_OPPOSITE_HALVES_NE_16Q10)) + (MATCH_MP + (INT_RING + `(&2*(&2*aa)) pow 2 + (&2*(&2*bb + &1)) pow 2 + + &2*(&2*c + &1) pow 2 = &16 * &q + &10 + ==> (&4*aa) pow 2 + (&4*bb + &2) pow 2 + + &2*(&2*c + &1) pow 2 = &16 * &q + &10`) + (REWRITE_RULE[GSYM INT_OF_NUM_ADD; GSYM INT_OF_NUM_MUL] + (ASSUME + `(&2*(&2*aa)) pow 2 + (&2*(&2*bb + &1)) pow 2 + + &2*(&2*c + &1) pow 2 = &(16*q+10)`)))); + CONTR_TAC + (MP + (NOT_ELIM(SPECL [`aa:int`; `bb:int`; `c:int`; `&q:int`] + INT_112_OPPOSITE_HALVES_SYM_NE_16Q10)) + (MATCH_MP + (INT_RING + `(&2*(&2*aa + &1)) pow 2 + (&2*(&2*bb)) pow 2 + + &2*(&2*c + &1) pow 2 = &16 * &q + &10 + ==> (&4*aa + &2) pow 2 + (&4*bb) pow 2 + + &2*(&2*c + &1) pow 2 = &16 * &q + &10`) + (REWRITE_RULE[GSYM INT_OF_NUM_ADD; GSYM INT_OF_NUM_MUL] + (ASSUME + `(&2*(&2*aa + &1)) pow 2 + (&2*(&2*bb)) pow 2 + + &2*(&2*c + &1) pow 2 = &(16*q+10)`)))); + MAP_EVERY EXISTS_TAC + [`(&2*aa + &1) + (&2*bb + &1) + (&2*c + &1):int`; + `(&2*aa + &1) + (&2*bb + &1) - (&2*c + &1):int`; + `(&2*aa + &1) - (&2*bb + &1):int`; + `aa + bb - c:int`] THEN + CONJ_TAC THENL + [REMOVE_THEN "rep" MP_TAC THEN CONV_TAC INT_RING; + CONV_TAC INT_RING]]]; + MAP_EVERY EXISTS_TAC + [`&2*a:int`; `&2*b + &1:int`; `z:int`; `b:int`] THEN + ASM_REWRITE_TAC[]; + MAP_EVERY EXISTS_TAC + [`&2*b:int`; `&2*a + &1:int`; `z:int`; `a:int`] THEN + REMOVE_THEN "rep" MP_TAC THEN CONV_TAC INT_RING; + MAP_EVERY EXISTS_TAC + [`&2*a + &1:int`; `&2*b + &1:int`; `z:int`; `b:int`] THEN + ASM_REWRITE_TAC[]]);; + +let INT_REPRESENTS_RC2_124_5 = prove + (`!n:num. + n MOD 16 = 14 + ==> ?x y z w:int. + x pow 2 + &2*y pow 2 + &4*z pow 2 + + &4*z*w + &5*w pow 2 = &n`, + GEN_TAC THEN DISCH_TAC THEN + MP_TAC(MATCH_MP (SPECL [`n:num`; `16`; `14`] NUM_DECOMPOSE_MOD) + (CONJ (ARITH_RULE `~(16 = 0)`) (ASSUME `n MOD 16 = 14`))) THEN + DISCH_THEN(X_CHOOSE_THEN `q:num` SUBST_ALL_TAC) THEN + MP_TAC(SPEC `q:num` INT_REPRESENTS_112_ODD_SECOND_16Q10) THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `u:int` + (X_CHOOSE_THEN `y:int` + (X_CHOOSE_THEN `z:int` STRIP_ASSUME_TAC)))) THEN + let rep = REWRITE_RULE[GSYM INT_OF_NUM_ADD; GSYM INT_OF_NUM_MUL] + (ASSUME + `x pow 2 + u pow 2 + &2*y pow 2 = &(16*q+10)`) in + let eq = MP (MP + (INT_RING + `x pow 2 + u pow 2 + &2*y pow 2 = &16 * &q + &10 + ==> u = &2*z + &1 + ==> x pow 2 + &2*y pow 2 + &4*z pow 2 + + &4*z * &1 + &5 * &1 pow 2 = &16 * &q + &14`) + rep) (ASSUME `u = &2*z + &1`) in + MAP_EVERY EXISTS_TAC [`x:int`; `y:int`; `z:int`; `&1:int`] THEN + MATCH_ACCEPT_TAC + (REWRITE_RULE[INT_OF_NUM_ADD; INT_OF_NUM_MUL] eq));; + +let INT_REPRESENTS_RC2_124_13 = prove + (`!n:num. + n MOD 16 = 14 + ==> ?x y z w:int. + x pow 2 + &2*y pow 2 + &4*z pow 2 + + &4*z*w + &13*w pow 2 = &n`, + GEN_TAC THEN DISCH_TAC THEN + MP_TAC(MATCH_MP (SPECL [`n:num`; `16`; `14`] NUM_DECOMPOSE_MOD) + (CONJ (ARITH_RULE `~(16 = 0)`) (ASSUME `n MOD 16 = 14`))) THEN + DISCH_THEN(X_CHOOSE_THEN `q:num` SUBST_ALL_TAC) THEN + MP_TAC(SPEC `q:num` INT_REPRESENTS_112_ODD_SECOND_16Q2) THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `u:int` + (X_CHOOSE_THEN `y:int` + (X_CHOOSE_THEN `z:int` STRIP_ASSUME_TAC)))) THEN + let rep = REWRITE_RULE[GSYM INT_OF_NUM_ADD; GSYM INT_OF_NUM_MUL] + (ASSUME + `x pow 2 + u pow 2 + &2*y pow 2 = &(16*q+2)`) in + let eq = MP (MP + (INT_RING + `x pow 2 + u pow 2 + &2*y pow 2 = &16 * &q + &2 + ==> u = &2*z + &1 + ==> x pow 2 + &2*y pow 2 + &4*z pow 2 + + &4*z * &1 + &13 * &1 pow 2 = &16 * &q + &14`) + rep) (ASSUME `u = &2*z + &1`) in + MAP_EVERY EXISTS_TAC [`x:int`; `y:int`; `z:int`; `&1:int`] THEN + MATCH_ACCEPT_TAC + (REWRITE_RULE[INT_OF_NUM_ADD; INT_OF_NUM_MUL] eq));; + +let INT_REPRESENTS_RC2_124_SPECIAL = prove + (`!k n:num. + (k = 5 \/ k = 13) /\ n MOD 16 = 14 + ==> ?x y z w:int. + x pow 2 + &2*y pow 2 + &4*z pow 2 + + &4*z*w + &k*w pow 2 = &n`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + let case5 = REWRITE_RULE[GSYM(ASSUME `k = 5`)] + (MATCH_MP (SPEC `n:num` INT_REPRESENTS_RC2_124_5) + (ASSUME `n MOD 16 = 14`)) in + let case13 = REWRITE_RULE[GSYM(ASSUME `k = 13`)] + (MATCH_MP (SPEC `n:num` INT_REPRESENTS_RC2_124_13) + (ASSUME `n MOD 16 = 14`)) in + ACCEPT_TAC(DISJ_CASES (ASSUME `k = 5 \/ k = 13`) case5 case13));; + +let NUM_RC2_124_REDUCED_RANGE = prove + (`!k:num. + (k = 2 \/ k = 3 \/ k = 4 \/ k = 5 \/ k = 6 \/ + k = 8 \/ k = 10 \/ k = 11 \/ k = 12 \/ k = 13 \/ k = 14) /\ + ~(k = 5 \/ k = 13) + ==> (k = 2 \/ k = 3 \/ k = 4 \/ k = 6 \/ + k = 8 \/ k = 10 \/ k = 11 \/ k = 12 \/ k = 14)`, + MESON_TAC[]);; + +let INT_REPRESENTS_RC2_124_LARGE = prove + (`!k q:num. + (k = 2 \/ k = 3 \/ k = 4 \/ k = 6 \/ + k = 8 \/ k = 10 \/ k = 11 \/ k = 12 \/ k = 14) /\ + ~(q < 13) + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &4 * z pow 2 + + &4 * z * w + &k * w pow 2 = &(16*q+14)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(MATCH_MP (SPEC `k:num` NUM_RC2_124_OFFSET_CHOICE) + (ASSUME + `k = 2 \/ k = 3 \/ k = 4 \/ k = 6 \/ + k = 8 \/ k = 10 \/ k = 11 \/ k = 12 \/ k = 14`)) THEN + DISCH_THEN(X_CHOOSE_THEN `s:num` STRIP_ASSUME_TAC) THEN + let offle = MATCH_MP + (SPECL [`(4*k-4) * s EXP 2`; `q:num`] + NUM_LE_16Q14_OF_LE_52) + (CONJ (ASSUME `(4*k-4) * s EXP 2 <= 52`) + (ASSUME `~(q < 13)`)) in + let kpos = MATCH_MP (SPEC `k:num` NUM_RC2_124_K_POS) + (ASSUME + `k = 2 \/ k = 3 \/ k = 4 \/ k = 6 \/ + k = 8 \/ k = 10 \/ k = 11 \/ k = 12 \/ k = 14`) in + let nres = EQT_ELIM + ((REWRITE_CONV[MOD_MULT_ADD] THENC NUM_REDUCE_CONV) + `(16*q+14) MOD 16 = 14`) in + let avoids = MATCH_MP + (SPECL [`16*q+14`; `(4*k-4) * s EXP 2`] + NUM_AVOIDS_124_SUB_OF_RESIDUE) + (CONJ offle + (CONJ nres + (CONJ + (ASSUME `~(((4*k-4) * s EXP 2) MOD 16 = 0)`) + (CONJ + (ASSUME `~(((4*k-4) * s EXP 2) MOD 16 = 6)`) + (ASSUME `~(((4*k-4) * s EXP 2) MOD 16 = 14)`))))) in + ACCEPT_TAC(MATCH_MP + (SPECL [`k:num`; `s:num`; `16*q+14`] + INT_REPRESENTS_RC2_124_SHIFT) + (CONJ kpos (CONJ offle avoids))));; + +let INT_REPRESENTS_RC2_124_LARGE_ALL = prove + (`!k q:num. + (k = 2 \/ k = 3 \/ k = 4 \/ k = 5 \/ k = 6 \/ + k = 8 \/ k = 10 \/ k = 11 \/ k = 12 \/ k = 13 \/ k = 14) /\ + ~(q < 13) + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &4 * z pow 2 + + &4 * z * w + &k * w pow 2 = &(16*q+14)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + let krange = ASSUME + `k = 2 \/ k = 3 \/ k = 4 \/ k = 5 \/ k = 6 \/ + k = 8 \/ k = 10 \/ k = 11 \/ k = 12 \/ k = 13 \/ k = 14` in + let nres = EQT_ELIM + ((REWRITE_CONV[MOD_MULT_ADD] THENC NUM_REDUCE_CONV) + `(16*q+14) MOD 16 = 14`) in + let special = MATCH_MP + (SPECL [`k:num`; `16*q+14`] INT_REPRESENTS_RC2_124_SPECIAL) + (CONJ (ASSUME `k = 5 \/ k = 13`) nres) in + let reduced = MATCH_MP (SPEC `k:num` NUM_RC2_124_REDUCED_RANGE) + (CONJ krange (ASSUME `~(k = 5 \/ k = 13)`)) in + let ordinary = MATCH_MP + (SPECL [`k:num`; `q:num`] INT_REPRESENTS_RC2_124_LARGE) + (CONJ reduced (ASSUME `~(q < 13)`)) in + ACCEPT_TAC(DISJ_CASES + (SPEC `k = 5 \/ k = 13` EXCLUDED_MIDDLE) special ordinary));; + +let INT_REPRESENTS_RC2_124_MOD16 = prove + (`!k n:num. + (k = 2 \/ k = 3 \/ k = 4 \/ k = 5 \/ k = 6 \/ + k = 8 \/ k = 10 \/ k = 11 \/ k = 12 \/ k = 13 \/ k = 14) /\ + 0 < n /\ n MOD 16 = 14 + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &4 * z pow 2 + + &4 * z * w + &k * w pow 2 = &n`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(MATCH_MP (SPECL [`n:num`; `16`; `14`] NUM_DECOMPOSE_MOD) + (CONJ (ARITH_RULE `~(16 = 0)`) (ASSUME `n MOD 16 = 14`))) THEN + DISCH_THEN(X_CHOOSE_THEN `q:num` SUBST_ALL_TAC) THEN + let krange = ASSUME + `k = 2 \/ k = 3 \/ k = 4 \/ k = 5 \/ k = 6 \/ + k = 8 \/ k = 10 \/ k = 11 \/ k = 12 \/ k = 13 \/ k = 14` in + let small = MATCH_MP + (SPECL [`k:num`; `q:num`] INT_REPRESENTS_RC2_124_SMALL) + (CONJ krange (ASSUME `q < 13`)) in + let large = MATCH_MP + (SPECL [`k:num`; `q:num`] INT_REPRESENTS_RC2_124_LARGE_ALL) + (CONJ krange (ASSUME `~(q < 13)`)) in + ACCEPT_TAC(DISJ_CASES (SPEC `q < 13` EXCLUDED_MIDDLE) small large));; + +let INT_UNIVERSAL_RC2_124_NUM = prove + (`!k:num. + (k = 2 \/ k = 3 \/ k = 4 \/ k = 5 \/ k = 6 \/ + k = 8 \/ k = 10 \/ k = 11 \/ k = 12 \/ k = 13 \/ k = 14) + ==> !n:num. + 0 < n + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &4 * z pow 2 + + &4 * z * w + &k * w pow 2 = &n`, + GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(SIMP_RULE + [INT_DOUBLE_TWO_MUL; + INT_MUL_LZERO; INT_MUL_RZERO; INT_MUL_LID; INT_MUL_RID; + INT_ADD_LID; INT_ADD_RID] + (SPECL [`0`; `2`; `k:num`] + INT_UNIVERSAL_124_CHILD_OF_MOD16)) THEN + X_GEN_TAC `n:num` THEN STRIP_TAC THEN + MATCH_MP_TAC(SPECL [`k:num`; `n:num`] + INT_REPRESENTS_RC2_124_MOD16) THEN + ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Packaging the explicit representation results as universality theorems. *) +(* ------------------------------------------------------------------------- *) + +let IQ_UNIVERSAL_124_CHILD_OF_NUM = prove + (`!rb rc k:num. + (!n:num. + 0 < n + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &4 * z pow 2 + + &2 * &rb * y * w + &2 * &rc * z * w + + &k * w pow 2 = &n) + ==> iq_universal 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&rb) (&4) (&rc) (&k))`, + REPEAT GEN_TAC THEN DISCH_THEN(LABEL_TAC "all") THEN + REWRITE_TAC[iq_universal] THEN + X_GEN_TAC `m:int` THEN DISCH_TAC THEN + MP_TAC(EQ_MP (SYM(SPEC `m:int` INT_OF_NUM_EXISTS)) + (MATCH_MP (SPECL [`&0:int`; `m:int`] INT_LT_IMP_LE) + (ASSUME `&0 < m`))) THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` SUBST_ALL_TAC) THEN + REMOVE_THEN "all" (MP_TAC o SPEC `n:num`) THEN + ANTS_TAC THENL + [UNDISCH_TAC `&0 < &n` THEN REWRITE_TAC[INT_OF_NUM_LT]; + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` + (X_CHOOSE_THEN `z:int` (X_CHOOSE_TAC `w:int`)))) THEN + REWRITE_TAC[iq_represents] THEN + EXISTS_TAC + `\i:num. + if i = 0 then (x:int) else if i = 1 then y else + if i = 2 then z else w` THEN + REWRITE_TAC[IQEVAL_MAT4] THEN + CONV_TAC NUM_REDUCE_CONV THEN + FIRST_X_ASSUM(MP_TAC) THEN CONV_TAC INT_RING]);; + +let IQ_UNIVERSAL_DIAG124_NUM = prove + (`!k:num. + 1 <= k /\ k <= 14 + ==> iq_universal 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&0) (&4) (&0) (&k))`, + GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(SIMP_RULE + [INT_MUL_LZERO; INT_MUL_RZERO; INT_MUL_LID; INT_MUL_RID; + INT_ADD_LID; INT_ADD_RID] + (SPECL [`0`; `0`; `k:num`] IQ_UNIVERSAL_124_CHILD_OF_NUM)) THEN + MATCH_MP_TAC(SPEC `k:num` INT_UNIVERSAL_DIAG124_NUM) THEN + ASM_REWRITE_TAC[]);; + +let IQ_UNIVERSAL_ZC124_NUM = prove + (`!k:num. + 1 <= k /\ k <= 14 + ==> iq_universal 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&0) (&4) (&1) (&k))`, + GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(SIMP_RULE + [INT_MUL_LZERO; INT_MUL_RZERO; INT_MUL_LID; INT_MUL_RID; + INT_ADD_LID; INT_ADD_RID] + (SPECL [`0`; `1`; `k:num`] IQ_UNIVERSAL_124_CHILD_OF_NUM)) THEN + MATCH_MP_TAC(SPEC `k:num` INT_UNIVERSAL_ZC124_NUM) THEN + ASM_REWRITE_TAC[]);; + +let IQ_UNIVERSAL_YC124_NUM = prove + (`!k:num. + (k = 1 \/ k = 2 \/ k = 3 \/ k = 4 \/ k = 5 \/ + k = 6 \/ k = 9 \/ k = 10 \/ k = 13 \/ k = 14) + ==> iq_universal 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&4) (&0) (&k))`, + GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(SIMP_RULE + [INT_MUL_LZERO; INT_MUL_RZERO; INT_MUL_LID; INT_MUL_RID; + INT_ADD_LID; INT_ADD_RID] + (SPECL [`1`; `0`; `k:num`] IQ_UNIVERSAL_124_CHILD_OF_NUM)) THEN + MATCH_MP_TAC(SPEC `k:num` INT_UNIVERSAL_YC124_NUM) THEN + ASM_REWRITE_TAC[]);; + +let IQ_UNIVERSAL_RC2_124_NUM = prove + (`!k:num. + (k = 2 \/ k = 3 \/ k = 4 \/ k = 5 \/ k = 6 \/ + k = 8 \/ k = 10 \/ k = 11 \/ k = 12 \/ k = 13 \/ k = 14) + ==> iq_universal 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&0) (&4) (&2) (&k))`, + GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(SIMP_RULE + [INT_DOUBLE_TWO_MUL; + INT_MUL_LZERO; INT_MUL_RZERO; INT_MUL_LID; INT_MUL_RID; + INT_ADD_LID; INT_ADD_RID] + (SPECL [`0`; `2`; `k:num`] IQ_UNIVERSAL_124_CHILD_OF_NUM)) THEN + MATCH_MP_TAC(SPEC `k:num` INT_UNIVERSAL_RC2_124_NUM) THEN + ASM_REWRITE_TAC[]);; + +let IQ_UNIVERSAL_DC1_124_NUM = prove + (`!k:num. + 1 <= k /\ k <= 14 + ==> iq_universal 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&4) (&1) (&k))`, + GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(SIMP_RULE + [INT_MUL_LZERO; INT_MUL_RZERO; INT_MUL_LID; INT_MUL_RID; + INT_ADD_LID; INT_ADD_RID] + (SPECL [`1`; `1`; `k:num`] IQ_UNIVERSAL_124_CHILD_OF_NUM)) THEN + MATCH_MP_TAC(SPEC `k:num` INT_UNIVERSAL_DC1_124_NUM) THEN + ASM_REWRITE_TAC[]);; + +let IQ_UNIVERSAL_DC2_124_NUM = prove + (`!k:num. + (k = 2 \/ k = 3 \/ k = 4 \/ k = 5 \/ k = 6 \/ + k = 9 \/ k = 10 \/ k = 13 \/ k = 14) + ==> iq_universal 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&4) (&2) (&k))`, + GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(SIMP_RULE + [INT_DOUBLE_TWO_MUL; + INT_MUL_LZERO; INT_MUL_RZERO; INT_MUL_LID; INT_MUL_RID; + INT_ADD_LID; INT_ADD_RID] + (SPECL [`1`; `2`; `k:num`] IQ_UNIVERSAL_124_CHILD_OF_NUM)) THEN + MATCH_MP_TAC(SPEC `k:num` INT_UNIVERSAL_DC2_124_NUM) THEN + ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* The represented-14 certificate eliminates the nonuniversal parameters. *) +(* ------------------------------------------------------------------------- *) + +let INT_YC124_NOT_14_TAC sum = + REPEAT GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN sum + (LABEL_TAC "sum") THENL + [FIRST_X_ASSUM(MP_TAC) THEN CONV_TAC INT_RING; + ALL_TAC] THEN + MP_TAC(SPEC `x:int` INT_LE_POW_2) THEN + MP_TAC(SPEC `&2 * y + w:int` INT_LE_POW_2) THEN + MP_TAC(SPEC `z:int` INT_LE_POW_2) THEN + MP_TAC(SPEC `w:int` INT_LE_POW_2) THEN + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `x pow 2 <= &14` ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `(&2 * y + w) pow 2 <= &28` ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `z pow 2 <= &3` ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `w pow 2 <= &2` ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; ALL_TAC] THEN + MP_TAC(MATCH_MP INT_SQ_LE_14_CASES + (ASSUME `x pow 2 <= &14`)) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + MP_TAC(MATCH_MP INT_SQ_LE_28_CASES + (ASSUME `(&2 * y + w) pow 2 <= &28`)) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THEN + MP_TAC(MATCH_MP INT_SQ_LE_3_CASES + (ASSUME `z pow 2 <= &3`)) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + MP_TAC(MATCH_MP INT_SQ_LE_2_CASES + (ASSUME `w pow 2 <= &2`)) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + REMOVE_THEN "sum" MP_TAC THEN + ASM_REWRITE_TAC[] THEN CONV_TAC INT_REDUCE_CONV;; + +let INT_YC124_NOT_14_7 = prove + (`!x y z w:int. + ~(x pow 2 + &2 * y pow 2 + &4 * z pow 2 + + &2 * y * w + &7 * w pow 2 = &14)`, + INT_YC124_NOT_14_TAC + `&2 * x pow 2 + (&2 * y + w) pow 2 + &8 * z pow 2 + + &13 * w pow 2 = &28`);; + +let INT_YC124_NOT_14_8 = prove + (`!x y z w:int. + ~(x pow 2 + &2 * y pow 2 + &4 * z pow 2 + + &2 * y * w + &8 * w pow 2 = &14)`, + INT_YC124_NOT_14_TAC + `&2 * x pow 2 + (&2 * y + w) pow 2 + &8 * z pow 2 + + &15 * w pow 2 = &28`);; + +let INT_YC124_NOT_14_11 = prove + (`!x y z w:int. + ~(x pow 2 + &2 * y pow 2 + &4 * z pow 2 + + &2 * y * w + &11 * w pow 2 = &14)`, + INT_YC124_NOT_14_TAC + `&2 * x pow 2 + (&2 * y + w) pow 2 + &8 * z pow 2 + + &21 * w pow 2 = &28`);; + +let INT_YC124_NOT_14_12 = prove + (`!x y z w:int. + ~(x pow 2 + &2 * y pow 2 + &4 * z pow 2 + + &2 * y * w + &12 * w pow 2 = &14)`, + INT_YC124_NOT_14_TAC + `&2 * x pow 2 + (&2 * y + w) pow 2 + &8 * z pow 2 + + &23 * w pow 2 = &28`);; + +let INT_YC124_NOT_14 = prove + (`!k x y z w:int. + (k = &7 \/ k = &8 \/ k = &11 \/ k = &12) + ==> ~(x pow 2 + &2 * y pow 2 + &4 * z pow 2 + + &2 * y * w + k * w pow 2 = &14)`, + MESON_TAC + [INT_YC124_NOT_14_7; INT_YC124_NOT_14_8; + INT_YC124_NOT_14_11; INT_YC124_NOT_14_12]);; + +let INT_RC2_124_NOT_14_1 = prove + (`!x y z w:int. + ~(x pow 2 + &2 * y pow 2 + &4 * z pow 2 + + &4 * z * w + w pow 2 = &14)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + let reduced = MATCH_MP + (INT_RING + `x pow 2 + &2 * y pow 2 + &4 * z pow 2 + + &4 * z * w + w pow 2 = &14 + ==> x pow 2 + (&2 * z + w) pow 2 + + &2 * y pow 2 = &14`) + (ASSUME + `x pow 2 + &2 * y pow 2 + &4 * z pow 2 + + &4 * z * w + w pow 2 = &14`) in + ACCEPT_TAC + (MP + (NOT_ELIM(SPECL [`x:int`; `&2 * z + w:int`; `y:int`] + INT_112_NOT_14)) + reduced));; + +let INT_DOUBLE_SHIFT_SQ_BOUND_14 = prove + (`!z w:int. + (&2 * z + w) pow 2 <= &14 /\ w pow 2 <= &2 + ==> z pow 2 <= &8`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(SPEC `(&2 * z + w) + w:int` INT_LE_POW_2) THEN + MP_TAC(INT_RING + `&2 * (&2 * z + w) pow 2 + &2 * w pow 2 - &4 * z pow 2 = + ((&2 * z + w) + w) pow 2`) THEN + ASM_INT_ARITH_TAC);; + +let INT_DOUBLE_SHIFT_SQ_BOUND_28 = prove + (`!z w:int. + (&2 * z + w) pow 2 <= &28 /\ w pow 2 <= &2 + ==> z pow 2 <= &15`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(SPEC `(&2 * z + w) + w:int` INT_LE_POW_2) THEN + MP_TAC(INT_RING + `&2 * (&2 * z + w) pow 2 + &2 * w pow 2 - &4 * z pow 2 = + ((&2 * z + w) + w) pow 2`) THEN + ASM_INT_ARITH_TAC);; + +let INT_RC2_124_NOT_14_TAC sum = + REPEAT GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN sum + (LABEL_TAC "sum") THENL + [FIRST_X_ASSUM(MP_TAC) THEN CONV_TAC INT_RING; + ALL_TAC] THEN + MP_TAC(SPEC `x:int` INT_LE_POW_2) THEN + MP_TAC(SPEC `y:int` INT_LE_POW_2) THEN + MP_TAC(SPEC `&2 * z + w:int` INT_LE_POW_2) THEN + MP_TAC(SPEC `w:int` INT_LE_POW_2) THEN + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `x pow 2 <= &14` ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `y pow 2 <= &7` ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `(&2 * z + w) pow 2 <= &14` ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `w pow 2 <= &2` ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `z pow 2 <= &8` ASSUME_TAC THENL + [MATCH_MP_TAC(SPECL [`z:int`; `w:int`] + INT_DOUBLE_SHIFT_SQ_BOUND_14) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `z pow 2 <= &14` ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; ALL_TAC] THEN + MP_TAC(MATCH_MP INT_SQ_LE_14_CASES + (ASSUME `x pow 2 <= &14`)) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + MP_TAC(MATCH_MP INT_SQ_LE_7_CASES + (ASSUME `y pow 2 <= &7`)) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + MP_TAC(MATCH_MP INT_SQ_LE_14_CASES + (ASSUME `z pow 2 <= &14`)) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + MP_TAC(MATCH_MP INT_SQ_LE_2_CASES + (ASSUME `w pow 2 <= &2`)) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + REMOVE_THEN "sum" MP_TAC THEN + ASM_REWRITE_TAC[] THEN CONV_TAC INT_REDUCE_CONV THEN + ASM_INT_ARITH_TAC;; + +let INT_RC2_124_NOT_14_7 = prove + (`!x y z w:int. + ~(x pow 2 + &2 * y pow 2 + &4 * z pow 2 + + &4 * z * w + &7 * w pow 2 = &14)`, + INT_RC2_124_NOT_14_TAC + `x pow 2 + &2 * y pow 2 + (&2 * z + w) pow 2 + + &6 * w pow 2 = &14`);; + +let INT_RC2_124_NOT_14_9 = prove + (`!x y z w:int. + ~(x pow 2 + &2 * y pow 2 + &4 * z pow 2 + + &4 * z * w + &9 * w pow 2 = &14)`, + INT_RC2_124_NOT_14_TAC + `x pow 2 + &2 * y pow 2 + (&2 * z + w) pow 2 + + &8 * w pow 2 = &14`);; + +let INT_RC2_124_NOT_14_7_9 = prove + (`!k x y z w:int. + (k = &7 \/ k = &9) + ==> ~(x pow 2 + &2 * y pow 2 + &4 * z pow 2 + + &4 * z * w + k * w pow 2 = &14)`, + MESON_TAC[INT_RC2_124_NOT_14_7; INT_RC2_124_NOT_14_9]);; + +let INT_DC2_124_NOT_14_TAC sum = + REPEAT GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN sum + (LABEL_TAC "sum") THENL + [FIRST_X_ASSUM(MP_TAC) THEN CONV_TAC INT_RING; + ALL_TAC] THEN + MP_TAC(SPEC `x:int` INT_LE_POW_2) THEN + MP_TAC(SPEC `&2 * y + w:int` INT_LE_POW_2) THEN + MP_TAC(SPEC `&2 * z + w:int` INT_LE_POW_2) THEN + MP_TAC(SPEC `w:int` INT_LE_POW_2) THEN + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `x pow 2 <= &14` ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `(&2 * y + w) pow 2 <= &28` ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `(&2 * z + w) pow 2 <= &14` ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `w pow 2 <= &2` ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `y pow 2 <= &15` ASSUME_TAC THENL + [MATCH_MP_TAC(SPECL [`y:int`; `w:int`] + INT_DOUBLE_SHIFT_SQ_BOUND_28) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `y pow 2 <= &28` ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `z pow 2 <= &8` ASSUME_TAC THENL + [MATCH_MP_TAC(SPECL [`z:int`; `w:int`] + INT_DOUBLE_SHIFT_SQ_BOUND_14) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `z pow 2 <= &14` ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; ALL_TAC] THEN + MP_TAC(MATCH_MP INT_SQ_LE_14_CASES + (ASSUME `x pow 2 <= &14`)) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + MP_TAC(MATCH_MP INT_SQ_LE_28_CASES + (ASSUME `y pow 2 <= &28`)) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + MP_TAC(MATCH_MP INT_SQ_LE_14_CASES + (ASSUME `z pow 2 <= &14`)) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + MP_TAC(MATCH_MP INT_SQ_LE_2_CASES + (ASSUME `w pow 2 <= &2`)) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + REMOVE_THEN "sum" MP_TAC THEN + ASM_REWRITE_TAC[] THEN CONV_TAC INT_REDUCE_CONV THEN + ASM_INT_ARITH_TAC;; + +let INT_DC2_124_NOT_14_7 = prove + (`!x y z w:int. + ~(x pow 2 + &2 * y pow 2 + &4 * z pow 2 + + &2 * y * w + &4 * z * w + &7 * w pow 2 = &14)`, + INT_DC2_124_NOT_14_TAC + `&2 * x pow 2 + (&2 * y + w) pow 2 + + &2 * (&2 * z + w) pow 2 + &11 * w pow 2 = &28`);; + +let INT_DC2_124_NOT_14_8 = prove + (`!x y z w:int. + ~(x pow 2 + &2 * y pow 2 + &4 * z pow 2 + + &2 * y * w + &4 * z * w + &8 * w pow 2 = &14)`, + INT_DC2_124_NOT_14_TAC + `&2 * x pow 2 + (&2 * y + w) pow 2 + + &2 * (&2 * z + w) pow 2 + &13 * w pow 2 = &28`);; + +let INT_DC2_124_NOT_14_11 = prove + (`!x y z w:int. + ~(x pow 2 + &2 * y pow 2 + &4 * z pow 2 + + &2 * y * w + &4 * z * w + &11 * w pow 2 = &14)`, + INT_DC2_124_NOT_14_TAC + `&2 * x pow 2 + (&2 * y + w) pow 2 + + &2 * (&2 * z + w) pow 2 + &19 * w pow 2 = &28`);; + +let INT_DC2_124_NOT_14_12 = prove + (`!x y z w:int. + ~(x pow 2 + &2 * y pow 2 + &4 * z pow 2 + + &2 * y * w + &4 * z * w + &12 * w pow 2 = &14)`, + INT_DC2_124_NOT_14_TAC + `&2 * x pow 2 + (&2 * y + w) pow 2 + + &2 * (&2 * z + w) pow 2 + &21 * w pow 2 = &28`);; + +let INT_DC2_124_NOT_14 = prove + (`!k x y z w:int. + (k = &7 \/ k = &8 \/ k = &11 \/ k = &12) + ==> ~(x pow 2 + &2 * y pow 2 + &4 * z pow 2 + + &2 * y * w + &4 * z * w + k * w pow 2 = &14)`, + MESON_TAC + [INT_DC2_124_NOT_14_7; INT_DC2_124_NOT_14_8; + INT_DC2_124_NOT_14_11; INT_DC2_124_NOT_14_12]);; + +let IQ_YC124_NOT_REPRESENTS_14 = prove + (`!k:int. + (k = &7 \/ k = &8 \/ k = &11 \/ k = &12) + ==> ~iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&4) (&0) k) (&14)`, + GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[iq_represents] THEN + DISCH_THEN(X_CHOOSE_TAC `v:num->int`) THEN + SUBGOAL_THEN + `v 0 pow 2 + &2 * v 1 pow 2 + &4 * v 2 pow 2 + + &2 * v 1 * v 3 + k * v 3 pow 2 = &14` + ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC) THEN REWRITE_TAC[IQEVAL_MAT4] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC INT_RING; + CONTR_TAC + (MP + (NOT_ELIM(MATCH_MP + (SPECL + [`k:int`; `v 0:int`; `v 1:int`; `v 2:int`; `v 3:int`] + INT_YC124_NOT_14) + (ASSUME `k = &7 \/ k = &8 \/ k = &11 \/ k = &12`))) + (ASSUME + `v 0 pow 2 + &2 * v 1 pow 2 + &4 * v 2 pow 2 + + &2 * v 1 * v 3 + k * v 3 pow 2 = &14`))]);; + +let IQ_RC2_124_NOT_REPRESENTS_14_1 = prove + (`~iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&0) (&4) (&2) (&1)) (&14)`, + REWRITE_TAC[iq_represents] THEN + DISCH_THEN(X_CHOOSE_TAC `v:num->int`) THEN + SUBGOAL_THEN + `v 0 pow 2 + &2 * v 1 pow 2 + &4 * v 2 pow 2 + + &4 * v 2 * v 3 + v 3 pow 2 = &14` + ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC) THEN REWRITE_TAC[IQEVAL_MAT4] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC INT_RING; + CONTR_TAC + (MP + (NOT_ELIM(SPECL + [`v 0:int`; `v 1:int`; `v 2:int`; `v 3:int`] + INT_RC2_124_NOT_14_1)) + (ASSUME + `v 0 pow 2 + &2 * v 1 pow 2 + &4 * v 2 pow 2 + + &4 * v 2 * v 3 + v 3 pow 2 = &14`))]);; + +let IQ_RC2_124_NOT_REPRESENTS_14_7_9 = prove + (`!k:int. + (k = &7 \/ k = &9) + ==> ~iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&0) (&4) (&2) k) (&14)`, + GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[iq_represents] THEN + DISCH_THEN(X_CHOOSE_TAC `v:num->int`) THEN + SUBGOAL_THEN + `v 0 pow 2 + &2 * v 1 pow 2 + &4 * v 2 pow 2 + + &4 * v 2 * v 3 + k * v 3 pow 2 = &14` + ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC) THEN REWRITE_TAC[IQEVAL_MAT4] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC INT_RING; + CONTR_TAC + (MP + (NOT_ELIM(MATCH_MP + (SPECL + [`k:int`; `v 0:int`; `v 1:int`; `v 2:int`; `v 3:int`] + INT_RC2_124_NOT_14_7_9) + (ASSUME `k = &7 \/ k = &9`))) + (ASSUME + `v 0 pow 2 + &2 * v 1 pow 2 + &4 * v 2 pow 2 + + &4 * v 2 * v 3 + k * v 3 pow 2 = &14`))]);; + +let IQ_DC2_124_NOT_REPRESENTS_14 = prove + (`!k:int. + (k = &7 \/ k = &8 \/ k = &11 \/ k = &12) + ==> ~iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&4) (&2) k) (&14)`, + GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[iq_represents] THEN + DISCH_THEN(X_CHOOSE_TAC `v:num->int`) THEN + SUBGOAL_THEN + `v 0 pow 2 + &2 * v 1 pow 2 + &4 * v 2 pow 2 + + &2 * v 1 * v 3 + &4 * v 2 * v 3 + + k * v 3 pow 2 = &14` + ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC) THEN REWRITE_TAC[IQEVAL_MAT4] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC INT_RING; + CONTR_TAC + (MP + (NOT_ELIM(MATCH_MP + (SPECL + [`k:int`; `v 0:int`; `v 1:int`; `v 2:int`; `v 3:int`] + INT_DC2_124_NOT_14) + (ASSUME `k = &7 \/ k = &8 \/ k = &11 \/ k = &12`))) + (ASSUME + `v 0 pow 2 + &2 * v 1 pow 2 + &4 * v 2 pow 2 + + &2 * v 1 * v 3 + &4 * v 2 * v 3 + + k * v 3 pow 2 = &14`))]);; + +let IQ_DC2_124_NOT_EMBEDS_1 = prove + (`!n A. + iq_positive n A + ==> ~iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&4) (&2) (&1)) A`, + REPEAT GEN_TAC THEN DISCH_TAC THEN DISCH_TAC THEN + MP_TAC(MATCH_MP + (ISPECL + [`n:num`; `4`; + `iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&4) (&2) (&1)`; + `A:num->num->int`] IQ_EMBEDDED_NONNEG) + (CONJ + (ASSUME `iq_positive n A`) + (ASSUME + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&4) (&2) (&1)) A`))) THEN + DISCH_THEN(MP_TAC o SPEC + `\i:num. + if i = 1 then -- &1 else if i = 2 then -- &1 else + if i = 3 then &2 else &0`) THEN + REWRITE_TAC[IQEVAL_MAT4] THEN + CONV_TAC NUM_REDUCE_CONV THEN INT_ARITH_TAC);; + +let IQ_YC124_PARAMETER_CASES = prove + (`!k:int. + &1 <= k /\ k <= &14 /\ + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&4) (&0) k) (&14) + ==> k = &1 \/ k = &2 \/ k = &3 \/ k = &4 \/ k = &5 \/ + k = &6 \/ k = &9 \/ k = &10 \/ k = &13 \/ k = &14`, + GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN + `k = &1 \/ k = &2 \/ k = &3 \/ k = &4 \/ k = &5 \/ + k = &6 \/ k = &7 \/ k = &8 \/ k = &9 \/ k = &10 \/ + k = &11 \/ k = &12 \/ k = &13 \/ k = &14` + MP_TAC THENL + [ASM_INT_ARITH_TAC; + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + ASM_MESON_TAC[IQ_YC124_NOT_REPRESENTS_14]]);; + +let IQ_RC2_124_PARAMETER_CASES = prove + (`!k:int. + &1 <= k /\ k <= &14 /\ + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&0) (&4) (&2) k) (&14) + ==> k = &2 \/ k = &3 \/ k = &4 \/ k = &5 \/ k = &6 \/ + k = &8 \/ k = &10 \/ k = &11 \/ k = &12 \/ + k = &13 \/ k = &14`, + GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN + `k = &1 \/ k = &2 \/ k = &3 \/ k = &4 \/ k = &5 \/ + k = &6 \/ k = &7 \/ k = &8 \/ k = &9 \/ k = &10 \/ + k = &11 \/ k = &12 \/ k = &13 \/ k = &14` + MP_TAC THENL + [ASM_INT_ARITH_TAC; + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + ASM_MESON_TAC + [IQ_RC2_124_NOT_REPRESENTS_14_1; + IQ_RC2_124_NOT_REPRESENTS_14_7_9]]);; + +let IQ_DC2_124_PARAMETER_CASES = prove + (`!n A k. + iq_positive n A /\ + &1 <= k /\ k <= &14 /\ + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&4) (&2) k) A /\ + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&4) (&2) k) (&14) + ==> k = &2 \/ k = &3 \/ k = &4 \/ k = &5 \/ k = &6 \/ + k = &9 \/ k = &10 \/ k = &13 \/ k = &14`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN + `k = &1 \/ k = &2 \/ k = &3 \/ k = &4 \/ k = &5 \/ + k = &6 \/ k = &7 \/ k = &8 \/ k = &9 \/ k = &10 \/ + k = &11 \/ k = &12 \/ k = &13 \/ k = &14` + MP_TAC THENL + [ASM_INT_ARITH_TAC; + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + ASM_MESON_TAC + [IQ_DC2_124_NOT_EMBEDS_1; + IQ_DC2_124_NOT_REPRESENTS_14]]);; + +(* ------------------------------------------------------------------------- *) +(* Transfer each universal quaternary child through its embedding. *) +(* ------------------------------------------------------------------------- *) + +let IQ_UNIVERSAL_OF_DIAG124_CHILD = prove + (`!n A k. + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&0) (&4) (&0) k) A /\ + &1 <= k /\ k <= &14 + ==> iq_universal n A`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(EQ_MP (SYM(SPEC `k:int` INT_OF_NUM_EXISTS)) + (MATCH_MP (INT_ARITH `&1 <= k ==> &0 <= k`) + (ASSUME `&1 <= k`))) THEN + DISCH_THEN(X_CHOOSE_THEN `c:num` SUBST_ALL_TAC) THEN + SUBGOAL_THEN `1 <= c /\ c <= 14` ASSUME_TAC THENL + [UNDISCH_TAC `&1 <= &c` THEN + UNDISCH_TAC `&c <= &14` THEN + REWRITE_TAC[INT_OF_NUM_LE] THEN ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(ISPECL + [`n:num`; `4`; + `iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&0) (&4) (&0) (&c)`; + `A:num->num->int`] IQ_UNIVERSAL_OF_EMBEDS) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(SPEC `c:num` IQ_UNIVERSAL_DIAG124_NUM) THEN + ASM_REWRITE_TAC[]);; + +let IQ_UNIVERSAL_OF_ZC124_CHILD = prove + (`!n A k. + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&0) (&4) (&1) k) A /\ + &1 <= k /\ k <= &14 + ==> iq_universal n A`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(EQ_MP (SYM(SPEC `k:int` INT_OF_NUM_EXISTS)) + (MATCH_MP (INT_ARITH `&1 <= k ==> &0 <= k`) + (ASSUME `&1 <= k`))) THEN + DISCH_THEN(X_CHOOSE_THEN `c:num` SUBST_ALL_TAC) THEN + SUBGOAL_THEN `1 <= c /\ c <= 14` ASSUME_TAC THENL + [UNDISCH_TAC `&1 <= &c` THEN + UNDISCH_TAC `&c <= &14` THEN + REWRITE_TAC[INT_OF_NUM_LE] THEN ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(ISPECL + [`n:num`; `4`; + `iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&0) (&4) (&1) (&c)`; + `A:num->num->int`] IQ_UNIVERSAL_OF_EMBEDS) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(SPEC `c:num` IQ_UNIVERSAL_ZC124_NUM) THEN + ASM_REWRITE_TAC[]);; + +let IQ_UNIVERSAL_OF_YC124_CHILD = prove + (`!n A k. + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&4) (&0) k) A /\ + (k = &1 \/ k = &2 \/ k = &3 \/ k = &4 \/ k = &5 \/ + k = &6 \/ k = &9 \/ k = &10 \/ k = &13 \/ k = &14) + ==> iq_universal n A`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC) THEN + SUBGOAL_THEN `&0 <= k` ASSUME_TAC THENL + [ASM_MESON_TAC[INT_ARITH + `&0 <= &1 /\ &0 <= &2 /\ &0 <= &3 /\ &0 <= &4 /\ + &0 <= &5 /\ &0 <= &6 /\ &0 <= &9 /\ &0 <= &10 /\ + &0 <= &13 /\ &0 <= &14`]; + ALL_TAC] THEN + MP_TAC(EQ_MP (SYM(SPEC `k:int` INT_OF_NUM_EXISTS)) + (ASSUME `&0 <= k`)) THEN + DISCH_THEN(X_CHOOSE_THEN `c:num` SUBST_ALL_TAC) THEN + SUBGOAL_THEN + `c = 1 \/ c = 2 \/ c = 3 \/ c = 4 \/ c = 5 \/ + c = 6 \/ c = 9 \/ c = 10 \/ c = 13 \/ c = 14` + ASSUME_TAC THENL + [UNDISCH_TAC + `&c = &1 \/ &c = &2 \/ &c = &3 \/ &c = &4 \/ &c = &5 \/ + &c = &6 \/ &c = &9 \/ &c = &10 \/ &c = &13 \/ &c = &14` THEN + REWRITE_TAC[INT_OF_NUM_EQ]; + ALL_TAC] THEN + MATCH_MP_TAC(ISPECL + [`n:num`; `4`; + `iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&4) (&0) (&c)`; + `A:num->num->int`] IQ_UNIVERSAL_OF_EMBEDS) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(SPEC `c:num` IQ_UNIVERSAL_YC124_NUM) THEN + ASM_REWRITE_TAC[]);; + +let IQ_UNIVERSAL_OF_RC2_124_CHILD = prove + (`!n A k. + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&0) (&4) (&2) k) A /\ + (k = &2 \/ k = &3 \/ k = &4 \/ k = &5 \/ k = &6 \/ + k = &8 \/ k = &10 \/ k = &11 \/ k = &12 \/ + k = &13 \/ k = &14) + ==> iq_universal n A`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC) THEN + SUBGOAL_THEN `&0 <= k` ASSUME_TAC THENL + [ASM_MESON_TAC[INT_ARITH + `&0 <= &2 /\ &0 <= &3 /\ &0 <= &4 /\ &0 <= &5 /\ + &0 <= &6 /\ &0 <= &8 /\ &0 <= &10 /\ &0 <= &11 /\ + &0 <= &12 /\ &0 <= &13 /\ &0 <= &14`]; + ALL_TAC] THEN + MP_TAC(EQ_MP (SYM(SPEC `k:int` INT_OF_NUM_EXISTS)) + (ASSUME `&0 <= k`)) THEN + DISCH_THEN(X_CHOOSE_THEN `c:num` SUBST_ALL_TAC) THEN + SUBGOAL_THEN + `c = 2 \/ c = 3 \/ c = 4 \/ c = 5 \/ c = 6 \/ + c = 8 \/ c = 10 \/ c = 11 \/ c = 12 \/ c = 13 \/ c = 14` + ASSUME_TAC THENL + [UNDISCH_TAC + `&c = &2 \/ &c = &3 \/ &c = &4 \/ &c = &5 \/ &c = &6 \/ + &c = &8 \/ &c = &10 \/ &c = &11 \/ &c = &12 \/ + &c = &13 \/ &c = &14` THEN + REWRITE_TAC[INT_OF_NUM_EQ]; + ALL_TAC] THEN + MATCH_MP_TAC(ISPECL + [`n:num`; `4`; + `iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&0) (&4) (&2) (&c)`; + `A:num->num->int`] IQ_UNIVERSAL_OF_EMBEDS) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(SPEC `c:num` IQ_UNIVERSAL_RC2_124_NUM) THEN + ASM_REWRITE_TAC[]);; + +let IQ_UNIVERSAL_OF_DC1_124_CHILD = prove + (`!n A k. + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&4) (&1) k) A /\ + &1 <= k /\ k <= &14 + ==> iq_universal n A`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(EQ_MP (SYM(SPEC `k:int` INT_OF_NUM_EXISTS)) + (MATCH_MP (INT_ARITH `&1 <= k ==> &0 <= k`) + (ASSUME `&1 <= k`))) THEN + DISCH_THEN(X_CHOOSE_THEN `c:num` SUBST_ALL_TAC) THEN + SUBGOAL_THEN `1 <= c /\ c <= 14` ASSUME_TAC THENL + [UNDISCH_TAC `&1 <= &c` THEN + UNDISCH_TAC `&c <= &14` THEN + REWRITE_TAC[INT_OF_NUM_LE] THEN ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(ISPECL + [`n:num`; `4`; + `iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&4) (&1) (&c)`; + `A:num->num->int`] IQ_UNIVERSAL_OF_EMBEDS) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(SPEC `c:num` IQ_UNIVERSAL_DC1_124_NUM) THEN + ASM_REWRITE_TAC[]);; + +let IQ_UNIVERSAL_OF_DC2_124_CHILD = prove + (`!n A k. + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&4) (&2) k) A /\ + (k = &2 \/ k = &3 \/ k = &4 \/ k = &5 \/ k = &6 \/ + k = &9 \/ k = &10 \/ k = &13 \/ k = &14) + ==> iq_universal n A`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC) THEN + SUBGOAL_THEN `&0 <= k` ASSUME_TAC THENL + [ASM_MESON_TAC[INT_ARITH + `&0 <= &2 /\ &0 <= &3 /\ &0 <= &4 /\ &0 <= &5 /\ + &0 <= &6 /\ &0 <= &9 /\ &0 <= &10 /\ &0 <= &13 /\ + &0 <= &14`]; + ALL_TAC] THEN + MP_TAC(EQ_MP (SYM(SPEC `k:int` INT_OF_NUM_EXISTS)) + (ASSUME `&0 <= k`)) THEN + DISCH_THEN(X_CHOOSE_THEN `c:num` SUBST_ALL_TAC) THEN + SUBGOAL_THEN + `c = 2 \/ c = 3 \/ c = 4 \/ c = 5 \/ c = 6 \/ + c = 9 \/ c = 10 \/ c = 13 \/ c = 14` + ASSUME_TAC THENL + [UNDISCH_TAC + `&c = &2 \/ &c = &3 \/ &c = &4 \/ &c = &5 \/ &c = &6 \/ + &c = &9 \/ &c = &10 \/ &c = &13 \/ &c = &14` THEN + REWRITE_TAC[INT_OF_NUM_EQ]; + ALL_TAC] THEN + MATCH_MP_TAC(ISPECL + [`n:num`; `4`; + `iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&4) (&2) (&c)`; + `A:num->num->int`] IQ_UNIVERSAL_OF_EMBEDS) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(SPEC `c:num` IQ_UNIVERSAL_DC2_124_NUM) THEN + ASM_REWRITE_TAC[]);; + +let IQ_UNIVERSAL_OF_EMBEDS_124 = prove + (`!n A. + iq_symmetric n A /\ iq_positive n A /\ + iq_embeds n 3 + (iqmat3 (&1) (&0) (&0) (&2) (&0) (&4)) A /\ + iq_represents n A (&14) + ==> iq_universal n A`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(SPECL [`n:num`; `A:num->num->int`] + IQ_EMBEDS_QUATERNARY_124) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN + (X_CHOOSE_THEN `k:int` + (REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC))) THENL + [MATCH_MP_TAC(ISPECL [`n:num`; `A:num->num->int`; `k:int`] + IQ_UNIVERSAL_OF_DIAG124_CHILD) THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC(ISPECL [`n:num`; `A:num->num->int`; `k:int`] + IQ_UNIVERSAL_OF_ZC124_CHILD) THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC(ISPECL [`n:num`; `A:num->num->int`; `k:int`] + IQ_UNIVERSAL_OF_RC2_124_CHILD) THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + MATCH_MP_TAC(SPEC `k:int` IQ_RC2_124_PARAMETER_CASES) THEN + ASM_REWRITE_TAC[]]; + MATCH_MP_TAC(ISPECL [`n:num`; `A:num->num->int`; `k:int`] + IQ_UNIVERSAL_OF_YC124_CHILD) THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + MATCH_MP_TAC(SPEC `k:int` IQ_YC124_PARAMETER_CASES) THEN + ASM_REWRITE_TAC[]]; + MATCH_MP_TAC(ISPECL [`n:num`; `A:num->num->int`; `k:int`] + IQ_UNIVERSAL_OF_DC1_124_CHILD) THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC(ISPECL [`n:num`; `A:num->num->int`; `k:int`] + IQ_UNIVERSAL_OF_DC2_124_CHILD) THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + MATCH_MP_TAC(ISPECL [`n:num`; `A:num->num->int`; `k:int`] + IQ_DC2_124_PARAMETER_CASES) THEN + ASM_REWRITE_TAC[]]]);; + +(* ------------------------------------------------------------------------- *) +(* The truant and balanced remainder estimates. *) +(* ------------------------------------------------------------------------- *) + +let INT_125_NOT_10 = prove + (`!x y z:int. + ~(x pow 2 + &2 * y pow 2 + &5 * z pow 2 = &10)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN `x pow 2 <= &10` ASSUME_TAC THENL + [MP_TAC(SPEC `y:int` INT_LE_POW_2) THEN + MP_TAC(SPEC `z:int` INT_LE_POW_2) THEN ASM_INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `y pow 2 <= &5` ASSUME_TAC THENL + [MP_TAC(SPEC `x:int` INT_LE_POW_2) THEN + MP_TAC(SPEC `z:int` INT_LE_POW_2) THEN ASM_INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `z pow 2 <= &2` ASSUME_TAC THENL + [MP_TAC(SPEC `x:int` INT_LE_POW_2) THEN + MP_TAC(SPEC `y:int` INT_LE_POW_2) THEN ASM_INT_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(MATCH_MP INT_SQ_LE_2_CASES (ASSUME `z pow 2 <= &2`)) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + MP_TAC(MATCH_MP INT_SQ_LE_5_CASES (ASSUME `y pow 2 <= &5`)) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + MP_TAC(MATCH_MP INT_SQ_LE_10_CASES (ASSUME `x pow 2 <= &10`)) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + FIRST_X_ASSUM(MP_TAC o check (is_eq o concl)) THEN + CONV_TAC INT_REDUCE_CONV);; + +let INT_DIV5_BALANCED = prove + (`!c:int. + ?q r. + c = &5 * q + r /\ + (r = -- &2 \/ r = -- &1 \/ r = &0 \/ r = &1 \/ r = &2)`, + GEN_TAC THEN + MP_TAC(SPECL [`c:int`; `&5:int`] INT_DIVISION) THEN + CONV_TAC NUM_REDUCE_CONV THEN STRIP_TAC THEN + SUBGOAL_THEN + `c rem &5 = &0 \/ c rem &5 = &1 \/ c rem &5 = &2 \/ + c rem &5 = &3 \/ c rem &5 = &4` + MP_TAC THENL + [ASM_INT_ARITH_TAC; + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THENL + [MAP_EVERY EXISTS_TAC [`c div &5:int`; `&0:int`] THEN + ASM_INT_ARITH_TAC; + MAP_EVERY EXISTS_TAC [`c div &5:int`; `&1:int`] THEN + ASM_INT_ARITH_TAC; + MAP_EVERY EXISTS_TAC [`c div &5:int`; `&2:int`] THEN + ASM_INT_ARITH_TAC; + MAP_EVERY EXISTS_TAC [`c div &5 + &1:int`; `-- &2:int`] THEN + ASM_INT_ARITH_TAC; + MAP_EVERY EXISTS_TAC [`c div &5 + &1:int`; `-- &1:int`] THEN + ASM_INT_ARITH_TAC]]);; + +let INT_QUAD5_BALANCED_NONNEG = prove + (`!q r:int. + (r = -- &2 \/ r = -- &1 \/ r = &0 \/ r = &1 \/ r = &2) + ==> &0 <= &5 * q pow 2 + &2 * q * r`, + REPEAT GEN_TAC THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THENL + [MP_TAC(SPEC `--q:int` INT_2Q2_ADD_2Q_NONNEG) THEN + MP_TAC(SPEC `q:int` INT_LE_POW_2) THEN INT_ARITH_TAC; + MP_TAC(SPEC `--q:int` INT_2Q2_ADD_2Q_NONNEG) THEN + MP_TAC(SPEC `q:int` INT_LE_POW_2) THEN INT_ARITH_TAC; + MP_TAC(SPEC `q:int` INT_LE_POW_2) THEN INT_ARITH_TAC; + MP_TAC(SPEC `q:int` INT_2Q2_ADD_2Q_NONNEG) THEN + MP_TAC(SPEC `q:int` INT_LE_POW_2) THEN INT_ARITH_TAC; + MP_TAC(SPEC `q:int` INT_2Q2_ADD_2Q_NONNEG) THEN + MP_TAC(SPEC `q:int` INT_LE_POW_2) THEN INT_ARITH_TAC]);; + +let INT_QUAD2_REM_NONNEG_125 = prove + (`!q r:int. + (r = &0 \/ r = &1) + ==> &0 <= &2 * q pow 2 + &2 * q * r`, + REPEAT GEN_TAC THEN + DISCH_THEN(DISJ_CASES_THEN SUBST_ALL_TAC) THENL + [MP_TAC(SPEC `q:int` INT_LE_POW_2) THEN INT_ARITH_TAC; + REWRITE_TAC[INT_MUL_RID] THEN + MATCH_ACCEPT_TAC(SPEC `q:int` INT_2Q2_ADD_2Q_NONNEG)]);; + +let iqclear125 = new_definition + `iqclear125 a b c = + iqrows4 + (&1) (&0) (&0) (&0) + (&0) (&1) (&0) (&0) + (&0) (&0) (&1) (&0) + (--a) (--b) (--c) (&1)`;; + +let iqflip125 = new_definition + `iqflip125 = + iqrows4 + (&1) (&0) (&0) (&0) + (&0) (&1) (&0) (&0) + (&0) (&0) (-- &1) (&0) + (&0) (&0) (&0) (&1)`;; + +let IQ_EMBEDS_CLEAR_125 = prove + (`!n A a b c rb rc t. + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) a + (&2) (&0) (&2 * b + rb) + (&5) (&5 * c + rc) t) A + ==> iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&5) rc + (t - a pow 2 - + &2 * b pow 2 - &2 * b * rb - + &5 * c pow 2 - &2 * c * rc)) A`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(ISPECL + [`n:num`; `4`; + `iqgram 4 + (iqmat4 (&1) (&0) (&0) a + (&2) (&0) (&2 * b + rb) + (&5) (&5 * c + rc) t) + (iqclear125 a b c)`; + `iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&5) rc + (t - a pow 2 - + &2 * b pow 2 - &2 * b * rb - + &5 * c pow 2 - &2 * c * rc)`; + `A:num->num->int`] IQ_EMBEDS_EQ) THEN + CONJ_TAC THENL + [MATCH_MP_TAC IQ_EMBEDS_CONGRUENCE THEN ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC THEN + (SUBGOAL_THEN `i = 0 \/ i = 1 \/ i = 2 \/ i = 3` MP_TAC THENL + [ASM_ARITH_TAC; ALL_TAC]) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + (SUBGOAL_THEN `j = 0 \/ j = 1 \/ j = 2 \/ j = 3` MP_TAC THENL + [ASM_ARITH_TAC; ALL_TAC]) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + ASM_REWRITE_TAC[iqgram; IQBILIN_MAT4; iqclear125; iqrows4; + iqmat4; iqsym] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC INT_RING]);; + +let IQ_EMBEDS_FLIP_125 = prove + (`!n A rb rc k. + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&5) rc k) A + ==> iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&5) (--rc) k) A`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(ISPECL + [`n:num`; `4`; + `iqgram 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&5) rc k) + iqflip125`; + `iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&5) (--rc) k`; + `A:num->num->int`] IQ_EMBEDS_EQ) THEN + CONJ_TAC THENL + [MATCH_MP_TAC IQ_EMBEDS_CONGRUENCE THEN ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC THEN + (SUBGOAL_THEN `i = 0 \/ i = 1 \/ i = 2 \/ i = 3` MP_TAC THENL + [ASM_ARITH_TAC; ALL_TAC]) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + (SUBGOAL_THEN `j = 0 \/ j = 1 \/ j = 2 \/ j = 3` MP_TAC THENL + [ASM_ARITH_TAC; ALL_TAC]) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + ASM_REWRITE_TAC[iqgram; IQBILIN_MAT4; iqflip125; iqrows4; + iqmat4; iqsym] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC INT_RING]);; + +let IQ_REPRESENTS_FLIP_125 = prove + (`!rb rc k t. + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&5) rc k) t + ==> iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&5) (--rc) k) t`, + REPEAT GEN_TAC THEN + REWRITE_TAC[iq_represents] THEN + DISCH_THEN(X_CHOOSE_TAC `v:num->int`) THEN + EXISTS_TAC `\i:num. if i = 2 then --(v i) else v i` THEN + FIRST_X_ASSUM(MP_TAC) THEN + REWRITE_TAC[IQEVAL_MAT4] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC INT_RING);; + +let IQ_125_REDUCED_K_NONNEG = prove + (`!n A rb rc k. + iq_positive n A /\ + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&5) rc k) A + ==> &0 <= k`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(MATCH_MP + (ISPECL + [`n:num`; `4`; + `iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&5) rc k`; + `A:num->num->int`] IQ_EMBEDDED_NONNEG) + (CONJ (ASSUME `iq_positive n A`) (ASSUME + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&5) rc k) A`))) THEN + DISCH_THEN(MP_TAC o SPEC + `\i:num. if i = 3 then &1 else &0`) THEN + REWRITE_TAC[IQEVAL_MAT4] THEN + CONV_TAC NUM_REDUCE_CONV THEN INT_ARITH_TAC);; + +let IQ_125_ZERO_FORCES_RB = prove + (`!n A rb rc. + iq_positive n A /\ + (rb = &0 \/ rb = &1) /\ + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&5) rc (&0)) A + ==> rb = &0`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC)) THEN + UNDISCH_TAC `rb = &0 \/ rb = &1` THEN + DISCH_THEN(DISJ_CASES_THEN ASSUME_TAC) THENL + [ASM_REWRITE_TAC[]; + MP_TAC(MATCH_MP + (ISPECL + [`n:num`; `4`; + `iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&5) rc (&0)`; + `A:num->num->int`] IQ_EMBEDDED_NONNEG) + (CONJ (ASSUME `iq_positive n A`) (ASSUME + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&5) rc (&0)) A`))) THEN + DISCH_THEN(MP_TAC o SPEC + `\i:num. + if i = 1 then &1 else if i = 3 then -- &2 else &0`) THEN + ASM_REWRITE_TAC[IQEVAL_MAT4] THEN + CONV_TAC NUM_REDUCE_CONV THEN INT_ARITH_TAC]);; + +let IQ_125_ZERO_FORCES_RC = prove + (`!n A rb rc. + iq_positive n A /\ + (rc = -- &2 \/ rc = -- &1 \/ rc = &0 \/ rc = &1 \/ rc = &2) /\ + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&5) rc (&0)) A + ==> rc = &0`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC)) THEN + UNDISCH_TAC + `rc = -- &2 \/ rc = -- &1 \/ rc = &0 \/ rc = &1 \/ rc = &2` THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THENL + [MP_TAC(MATCH_MP + (ISPECL + [`n:num`; `4`; + `iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&5) rc (&0)`; + `A:num->num->int`] IQ_EMBEDDED_NONNEG) + (CONJ (ASSUME `iq_positive n A`) (ASSUME + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&5) rc (&0)) A`))) THEN + DISCH_THEN(MP_TAC o SPEC + `\i:num. + if i = 2 then &1 else if i = 3 then &2 else &0`) THEN + ASM_REWRITE_TAC[IQEVAL_MAT4] THEN + CONV_TAC NUM_REDUCE_CONV THEN INT_ARITH_TAC; + MP_TAC(MATCH_MP + (ISPECL + [`n:num`; `4`; + `iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&5) rc (&0)`; + `A:num->num->int`] IQ_EMBEDDED_NONNEG) + (CONJ (ASSUME `iq_positive n A`) (ASSUME + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&5) rc (&0)) A`))) THEN + DISCH_THEN(MP_TAC o SPEC + `\i:num. + if i = 2 then &1 else if i = 3 then &3 else &0`) THEN + ASM_REWRITE_TAC[IQEVAL_MAT4] THEN + CONV_TAC NUM_REDUCE_CONV THEN INT_ARITH_TAC; + ASM_REWRITE_TAC[]; + MP_TAC(MATCH_MP + (ISPECL + [`n:num`; `4`; + `iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&5) rc (&0)`; + `A:num->num->int`] IQ_EMBEDDED_NONNEG) + (CONJ (ASSUME `iq_positive n A`) (ASSUME + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&5) rc (&0)) A`))) THEN + DISCH_THEN(MP_TAC o SPEC + `\i:num. + if i = 2 then &1 else if i = 3 then -- &3 else &0`) THEN + ASM_REWRITE_TAC[IQEVAL_MAT4] THEN + CONV_TAC NUM_REDUCE_CONV THEN INT_ARITH_TAC; + MP_TAC(MATCH_MP + (ISPECL + [`n:num`; `4`; + `iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&5) rc (&0)`; + `A:num->num->int`] IQ_EMBEDDED_NONNEG) + (CONJ (ASSUME `iq_positive n A`) (ASSUME + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&5) rc (&0)) A`))) THEN + DISCH_THEN(MP_TAC o SPEC + `\i:num. + if i = 2 then &1 else if i = 3 then -- &2 else &0`) THEN + ASM_REWRITE_TAC[IQEVAL_MAT4] THEN + CONV_TAC NUM_REDUCE_CONV THEN INT_ARITH_TAC]);; + +let IQ_125_REDUCED_K_UPPER = prove + (`!a qb rb qc rc k. + (rb = &0 \/ rb = &1) /\ + (rc = -- &2 \/ rc = -- &1 \/ rc = &0 \/ rc = &1 \/ rc = &2) /\ + k = &10 - a pow 2 - + &2 * qb pow 2 - &2 * qb * rb - + &5 * qc pow 2 - &2 * qc * rc + ==> k <= &10`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(MATCH_MP (SPECL [`qb:int`; `rb:int`] + INT_QUAD2_REM_NONNEG_125) + (ASSUME `rb = &0 \/ rb = &1`)) THEN + MP_TAC(MATCH_MP (SPECL [`qc:int`; `rc:int`] + INT_QUAD5_BALANCED_NONNEG) + (ASSUME + `rc = -- &2 \/ rc = -- &1 \/ rc = &0 \/ rc = &1 \/ rc = &2`)) THEN + MP_TAC(SPEC `a:int` INT_LE_POW_2) THEN + ASM_INT_ARITH_TAC);; + +let IQ_125_REDUCED_K_NONZERO = prove + (`!n A a qb rb qc rc k. + iq_positive n A /\ + (rb = &0 \/ rb = &1) /\ + (rc = -- &2 \/ rc = -- &1 \/ rc = &0 \/ rc = &1 \/ rc = &2) /\ + k = &10 - a pow 2 - + &2 * qb pow 2 - &2 * qb * rb - + &5 * qc pow 2 - &2 * qc * rc /\ + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&5) rc k) A + ==> ~(k = &0)`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC)))) THEN + DISCH_TAC THEN + let emb0 = REWRITE_RULE [ASSUME `k = &0`] + (ASSUME + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&5) rc k) A`) in + let rb0 = MATCH_MP + (ISPECL [`n:num`; `A:num->num->int`; + `rb:int`; `rc:int`] IQ_125_ZERO_FORCES_RB) + (CONJ (ASSUME `iq_positive n A`) + (CONJ (ASSUME `rb = &0 \/ rb = &1`) emb0)) in + let rc0 = MATCH_MP + (ISPECL [`n:num`; `A:num->num->int`; + `rb:int`; `rc:int`] IQ_125_ZERO_FORCES_RC) + (CONJ (ASSUME `iq_positive n A`) + (CONJ + (ASSUME + `rc = -- &2 \/ rc = -- &1 \/ rc = &0 \/ rc = &1 \/ rc = &2`) + emb0)) in + ACCEPT_TAC + (MP + (NOT_ELIM(SPECL [`a:int`; `qb:int`; `qc:int`] INT_125_NOT_10)) + (MP (MP (MP (MP + (INT_RING + `k = &10 - a pow 2 - + &2 * qb pow 2 - &2 * qb * rb - + &5 * qc pow 2 - &2 * qc * rc + ==> k = &0 ==> rb = &0 ==> rc = &0 + ==> a pow 2 + &2 * qb pow 2 + &5 * qc pow 2 = &10`) + (ASSUME + `k = &10 - a pow 2 - + &2 * qb pow 2 - &2 * qb * rb - + &5 * qc pow 2 - &2 * qc * rc`)) + (ASSUME `k = &0`)) + rb0) + rc0)));; + +let IQ_125_REDUCED_K_BOUNDS = prove + (`!n A a qb rb qc rc k. + iq_positive n A /\ + (rb = &0 \/ rb = &1) /\ + (rc = -- &2 \/ rc = -- &1 \/ rc = &0 \/ rc = &1 \/ rc = &2) /\ + k = &10 - a pow 2 - + &2 * qb pow 2 - &2 * qb * rb - + &5 * qc pow 2 - &2 * qc * rc /\ + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&5) rc k) A + ==> &1 <= k /\ k <= &10`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + let knonneg = MATCH_MP + (ISPECL [`n:num`; `A:num->num->int`; + `rb:int`; `rc:int`; `k:int`] IQ_125_REDUCED_K_NONNEG) + (CONJ (ASSUME `iq_positive n A`) + (ASSUME + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&5) rc k) A`)) in + let knonzero = MATCH_MP + (ISPECL [`n:num`; `A:num->num->int`; `a:int`; `qb:int`; + `rb:int`; `qc:int`; `rc:int`; `k:int`] + IQ_125_REDUCED_K_NONZERO) + (CONJ (ASSUME `iq_positive n A`) + (CONJ (ASSUME `rb = &0 \/ rb = &1`) + (CONJ + (ASSUME + `rc = -- &2 \/ rc = -- &1 \/ rc = &0 \/ rc = &1 \/ rc = &2`) + (CONJ + (ASSUME + `k = &10 - a pow 2 - + &2 * qb pow 2 - &2 * qb * rb - + &5 * qc pow 2 - &2 * qc * rc`) + (ASSUME + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&5) rc k) A`))))) in + let kupper = MATCH_MP + (SPECL [`a:int`; `qb:int`; `rb:int`; `qc:int`; `rc:int`; `k:int`] + IQ_125_REDUCED_K_UPPER) + (CONJ (ASSUME `rb = &0 \/ rb = &1`) + (CONJ + (ASSUME + `rc = -- &2 \/ rc = -- &1 \/ rc = &0 \/ rc = &1 \/ rc = &2`) + (ASSUME + `k = &10 - a pow 2 - + &2 * qb pow 2 - &2 * qb * rb - + &5 * qc pow 2 - &2 * qc * rc`))) in + ACCEPT_TAC + (CONJ + (MP (MP + (INT_ARITH `&0 <= k ==> ~(k = &0) ==> &1 <= k`) + knonneg) + knonzero) + kupper));; + +let IQ_125_REDUCED_REPRESENTS_10 = prove + (`!a qb rb qc rc k. + k = &10 - a pow 2 - + &2 * qb pow 2 - &2 * qb * rb - + &5 * qc pow 2 - &2 * qc * rc + ==> iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&5) rc k) (&10)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[iq_represents] THEN + EXISTS_TAC + `\i:num. + if i = 0 then (a:int) else if i = 1 then qb else + if i = 2 then qc else &1` THEN + REWRITE_TAC[IQEVAL_MAT4] THEN + CONV_TAC NUM_REDUCE_CONV THEN + FIRST_X_ASSUM(MP_TAC) THEN CONV_TAC INT_RING);; + +let IQ_EMBEDS_FLIP_125_NEG1 = prove + (`!n A rb k. + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&5) (-- &1) k) A + ==> iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&5) (&1) k) A`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_ACCEPT_TAC + (CONV_RULE INT_REDUCE_CONV + (MATCH_MP + (SPECL [`n:num`; `A:num->num->int`; `rb:int`; `-- &1`; `k:int`] + IQ_EMBEDS_FLIP_125) + (ASSUME + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&5) (-- &1) k) A`))));; + +let IQ_EMBEDS_FLIP_125_NEG2 = prove + (`!n A rb k. + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&5) (-- &2) k) A + ==> iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&5) (&2) k) A`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_ACCEPT_TAC + (CONV_RULE INT_REDUCE_CONV + (MATCH_MP + (SPECL [`n:num`; `A:num->num->int`; `rb:int`; `-- &2`; `k:int`] + IQ_EMBEDS_FLIP_125) + (ASSUME + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&5) (-- &2) k) A`))));; + +let IQ_REPRESENTS_FLIP_125_NEG1 = prove + (`!rb k t. + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&5) (-- &1) k) t + ==> iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&5) (&1) k) t`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_ACCEPT_TAC + (CONV_RULE INT_REDUCE_CONV + (MATCH_MP + (SPECL [`rb:int`; `-- &1`; `k:int`; `t:int`] + IQ_REPRESENTS_FLIP_125) + (ASSUME + `iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&5) (-- &1) k) t`))));; + +let IQ_REPRESENTS_FLIP_125_NEG2 = prove + (`!rb k t. + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&5) (-- &2) k) t + ==> iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&5) (&2) k) t`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_ACCEPT_TAC + (CONV_RULE INT_REDUCE_CONV + (MATCH_MP + (SPECL [`rb:int`; `-- &2`; `k:int`; `t:int`] + IQ_REPRESENTS_FLIP_125) + (ASSUME + `iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&5) (-- &2) k) t`))));; + +let IQ_EMBEDS_QUATERNARY_125_RAW = prove + (`!n A. + iq_symmetric n A /\ iq_positive n A /\ + iq_embeds n 3 + (iqmat3 (&1) (&0) (&0) (&2) (&0) (&5)) A /\ + iq_represents n A (&10) + ==> ?rb rc k. + (rb = &0 \/ rb = &1) /\ + (rc = -- &2 \/ rc = -- &1 \/ rc = &0 \/ rc = &1 \/ rc = &2) /\ + &1 <= k /\ k <= &10 /\ + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&5) rc k) A /\ + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) rb (&5) rc k) (&10)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(SPECL + [`n:num`; `A:num->num->int`; + `&1:int`; `&0:int`; `&0:int`; `&2:int`; `&0:int`; `&5:int`; + `&10:int`] IQ_ESCALATE_MAT3) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `a:int` + (X_CHOOSE_THEN `b:int` + (X_CHOOSE_THEN `c:int` STRIP_ASSUME_TAC))) THEN + MP_TAC(SPEC `b:int` INT_DIV2_QR) THEN + DISCH_THEN(X_CHOOSE_THEN `qb:int` + (X_CHOOSE_THEN `rb:int` + (CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC))) THEN + MP_TAC(SPEC `c:int` INT_DIV5_BALANCED) THEN + DISCH_THEN(X_CHOOSE_THEN `qc:int` + (X_CHOOSE_THEN `rc:int` + (CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC))) THEN + let kval = + `&10 - a pow 2 - + &2 * qb pow 2 - &2 * qb * rb - + &5 * qc pow 2 - &2 * qc * rc` in + let source_emb = REWRITE_RULE + [ASSUME `b = &2 * qb + rb`; ASSUME `c = &5 * qc + rc`] + (ASSUME + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) a + (&2) (&0) b (&5) c (&10)) A`) in + let emb = MATCH_MP + (ISPECL [`n:num`; `A:num->num->int`; `a:int`; `qb:int`; + `qc:int`; `rb:int`; `rc:int`; `&10:int`] + IQ_EMBEDS_CLEAR_125) + source_emb in + let bounds = MATCH_MP + (ISPECL [`n:num`; `A:num->num->int`; `a:int`; `qb:int`; + `rb:int`; `qc:int`; `rc:int`; kval] + IQ_125_REDUCED_K_BOUNDS) + (CONJ (ASSUME `iq_positive n A`) + (CONJ (ASSUME `rb = &0 \/ rb = &1`) + (CONJ + (ASSUME + `rc = -- &2 \/ rc = -- &1 \/ rc = &0 \/ rc = &1 \/ rc = &2`) + (CONJ (REFL kval) emb)))) in + let rep10 = MATCH_MP + (SPECL [`a:int`; `qb:int`; `rb:int`; `qc:int`; `rc:int`; kval] + IQ_125_REDUCED_REPRESENTS_10) + (REFL kval) in + MAP_EVERY EXISTS_TAC [`rb:int`; `rc:int`; kval] THEN + ACCEPT_TAC + (CONJ (ASSUME `rb = &0 \/ rb = &1`) + (CONJ + (ASSUME + `rc = -- &2 \/ rc = -- &1 \/ rc = &0 \/ rc = &1 \/ rc = &2`) + (CONJ (CONJUNCT1 bounds) + (CONJ (CONJUNCT2 bounds) (CONJ emb rep10))))));; + +let IQ_EMBEDS_QUATERNARY_125 = prove + (`!n A. + iq_symmetric n A /\ iq_positive n A /\ + iq_embeds n 3 + (iqmat3 (&1) (&0) (&0) (&2) (&0) (&5)) A /\ + iq_represents n A (&10) + ==> (?k. &1 <= k /\ k <= &10 /\ + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&0) (&5) (&0) k) A /\ + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&0) (&5) (&0) k) (&10)) \/ + (?k. &1 <= k /\ k <= &10 /\ + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&0) (&5) (&1) k) A /\ + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&0) (&5) (&1) k) (&10)) \/ + (?k. &1 <= k /\ k <= &10 /\ + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&0) (&5) (&2) k) A /\ + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&0) (&5) (&2) k) (&10)) \/ + (?k. &1 <= k /\ k <= &10 /\ + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&5) (&0) k) A /\ + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&5) (&0) k) (&10)) \/ + (?k. &1 <= k /\ k <= &10 /\ + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&5) (&1) k) A /\ + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&5) (&1) k) (&10)) \/ + (?k. &1 <= k /\ k <= &10 /\ + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&5) (&2) k) A /\ + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&5) (&2) k) (&10))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(SPECL [`n:num`; `A:num->num->int`] + IQ_EMBEDS_QUATERNARY_125_RAW) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `rb:int` + (X_CHOOSE_THEN `rc:int` + (X_CHOOSE_THEN `k:int` + (CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC)))))))) THEN + UNDISCH_TAC `rb = &0 \/ rb = &1` THEN + DISCH_THEN(DISJ_CASES_THEN SUBST_ALL_TAC) THEN + UNDISCH_TAC + `rc = -- &2 \/ rc = -- &1 \/ rc = &0 \/ rc = &1 \/ rc = &2` THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THENL + [DISJ2_TAC THEN DISJ2_TAC THEN DISJ1_TAC THEN + EXISTS_TAC `k:int` THEN REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC IQ_EMBEDS_FLIP_125_NEG2 THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC IQ_REPRESENTS_FLIP_125_NEG2 THEN ASM_REWRITE_TAC[]]; + DISJ2_TAC THEN DISJ1_TAC THEN + EXISTS_TAC `k:int` THEN REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC IQ_EMBEDS_FLIP_125_NEG1 THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC IQ_REPRESENTS_FLIP_125_NEG1 THEN ASM_REWRITE_TAC[]]; + DISJ1_TAC THEN EXISTS_TAC `k:int` THEN ASM_REWRITE_TAC[]; + DISJ2_TAC THEN DISJ1_TAC THEN + EXISTS_TAC `k:int` THEN ASM_REWRITE_TAC[]; + DISJ2_TAC THEN DISJ2_TAC THEN DISJ1_TAC THEN + EXISTS_TAC `k:int` THEN ASM_REWRITE_TAC[]; + DISJ2_TAC THEN DISJ2_TAC THEN DISJ2_TAC THEN + DISJ2_TAC THEN DISJ2_TAC THEN + EXISTS_TAC `k:int` THEN REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC IQ_EMBEDS_FLIP_125_NEG2 THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC IQ_REPRESENTS_FLIP_125_NEG2 THEN ASM_REWRITE_TAC[]]; + DISJ2_TAC THEN DISJ2_TAC THEN DISJ2_TAC THEN + DISJ2_TAC THEN DISJ1_TAC THEN + EXISTS_TAC `k:int` THEN REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC IQ_EMBEDS_FLIP_125_NEG1 THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC IQ_REPRESENTS_FLIP_125_NEG1 THEN ASM_REWRITE_TAC[]]; + DISJ2_TAC THEN DISJ2_TAC THEN DISJ2_TAC THEN + DISJ1_TAC THEN EXISTS_TAC `k:int` THEN ASM_REWRITE_TAC[]; + DISJ2_TAC THEN DISJ2_TAC THEN DISJ2_TAC THEN + DISJ2_TAC THEN DISJ1_TAC THEN + EXISTS_TAC `k:int` THEN ASM_REWRITE_TAC[]; + DISJ2_TAC THEN DISJ2_TAC THEN DISJ2_TAC THEN + DISJ2_TAC THEN DISJ2_TAC THEN + EXISTS_TAC `k:int` THEN ASM_REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* The represented-10 certificate eliminates five reduced parameters. *) +(* ------------------------------------------------------------------------- *) + +let INT_SQ_LE_50_CASES = prove + (`!a:int. + a pow 2 <= &50 + ==> a = -- &7 \/ a = -- &6 \/ a = -- &5 \/ a = -- &4 \/ + a = -- &3 \/ a = -- &2 \/ a = -- &1 \/ a = &0 \/ + a = &1 \/ a = &2 \/ a = &3 \/ a = &4 \/ + a = &5 \/ a = &6 \/ a = &7`, + GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN `abs a < &8` ASSUME_TAC THENL + [MP_TAC(SPECL [`a:int`; `&8:int`] INT_LT_SQUARE_ABS) THEN + REWRITE_TAC[INT_ABS_NUM] THEN + CONV_TAC NUM_REDUCE_CONV THEN ASM_INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `abs a <= &7` ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; + MP_TAC(SPECL [`a:int`; `&7:int`] INT_ABS_BOUNDS) THEN + ASM_REWRITE_TAC[] THEN INT_ARITH_TAC]);; + +let INT_125_CHILD_NOT_10_TAC zw sum = + let zw_bound = vsubst [zw,`q:int`] `q pow 2 <= &50` in + REPEAT GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN sum (LABEL_TAC "sum") THENL + [FIRST_X_ASSUM(MP_TAC) THEN CONV_TAC INT_RING; + ALL_TAC] THEN + MP_TAC(SPEC `x:int` INT_LE_POW_2) THEN + MP_TAC(SPEC `&2 * y + w:int` INT_LE_POW_2) THEN + MP_TAC(SPEC zw INT_LE_POW_2) THEN + MP_TAC(SPEC `w:int` INT_LE_POW_2) THEN + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `x pow 2 <= &10` ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `(&2 * y + w) pow 2 <= &20` ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN zw_bound ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `w pow 2 <= &3` ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(MATCH_MP INT_SQ_LE_10_CASES + (ASSUME `x pow 2 <= &10`)) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + MP_TAC(MATCH_MP INT_SQ_LE_20_CASES + (ASSUME `(&2 * y + w) pow 2 <= &20`)) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THEN + MP_TAC(MATCH_MP INT_SQ_LE_50_CASES + (ASSUME zw_bound)) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THEN + MP_TAC(MATCH_MP INT_SQ_LE_3_CASES + (ASSUME `w pow 2 <= &3`)) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + REMOVE_THEN "sum" MP_TAC THEN + ASM_REWRITE_TAC[] THEN CONV_TAC INT_REDUCE_CONV;; + +let INT_RB1_RC0_K7_125_NOT_10 = prove + (`!x y z w:int. + ~(x pow 2 + &2 * y pow 2 + &5 * z pow 2 + + &2 * y * w + &7 * w pow 2 = &10)`, + INT_125_CHILD_NOT_10_TAC + `&5 * z + &0 * w:int` + `&10 * x pow 2 + &5 * (&2 * y + w) pow 2 + + &2 * (&5 * z + &0 * w) pow 2 + &65 * w pow 2 = &100`);; + +let INT_RB1_RC0_K8_125_NOT_10 = prove + (`!x y z w:int. + ~(x pow 2 + &2 * y pow 2 + &5 * z pow 2 + + &2 * y * w + &8 * w pow 2 = &10)`, + INT_125_CHILD_NOT_10_TAC + `&5 * z + &0 * w:int` + `&10 * x pow 2 + &5 * (&2 * y + w) pow 2 + + &2 * (&5 * z + &0 * w) pow 2 + &75 * w pow 2 = &100`);; + +let INT_RB1_RC1_K4_125_NOT_10 = prove + (`!x y z w:int. + ~(x pow 2 + &2 * y pow 2 + &5 * z pow 2 + + &2 * y * w + &2 * z * w + &4 * w pow 2 = &10)`, + INT_125_CHILD_NOT_10_TAC + `&5 * z + &1 * w:int` + `&10 * x pow 2 + &5 * (&2 * y + w) pow 2 + + &2 * (&5 * z + &1 * w) pow 2 + &33 * w pow 2 = &100`);; + +let INT_RB1_RC1_K8_125_NOT_10 = prove + (`!x y z w:int. + ~(x pow 2 + &2 * y pow 2 + &5 * z pow 2 + + &2 * y * w + &2 * z * w + &8 * w pow 2 = &10)`, + INT_125_CHILD_NOT_10_TAC + `&5 * z + &1 * w:int` + `&10 * x pow 2 + &5 * (&2 * y + w) pow 2 + + &2 * (&5 * z + &1 * w) pow 2 + &73 * w pow 2 = &100`);; + +let INT_RB1_RC2_K7_125_NOT_10 = prove + (`!x y z w:int. + ~(x pow 2 + &2 * y pow 2 + &5 * z pow 2 + + &2 * y * w + &4 * z * w + &7 * w pow 2 = &10)`, + INT_125_CHILD_NOT_10_TAC + `&5 * z + &2 * w:int` + `&10 * x pow 2 + &5 * (&2 * y + w) pow 2 + + &2 * (&5 * z + &2 * w) pow 2 + &57 * w pow 2 = &100`);; + +let IQ_RB1_RC0_125_NOT_REPRESENTS_10 = prove + (`!k:int. + (k = &7 \/ k = &8) + ==> ~iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&5) (&0) k) (&10)`, + GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[iq_represents] THEN + DISCH_THEN(X_CHOOSE_TAC `v:num->int`) THEN + SUBGOAL_THEN + `v 0 pow 2 + &2 * v 1 pow 2 + &5 * v 2 pow 2 + + &2 * v 1 * v 3 + k * v 3 pow 2 = &10` + ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC) THEN REWRITE_TAC[IQEVAL_MAT4] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC INT_RING; + UNDISCH_TAC `k = &7 \/ k = &8` THEN + DISCH_THEN(DISJ_CASES_THEN SUBST_ALL_TAC) THEN + ASM_MESON_TAC + [INT_RB1_RC0_K7_125_NOT_10; INT_RB1_RC0_K8_125_NOT_10]]);; + +let IQ_RB1_RC1_125_NOT_REPRESENTS_10 = prove + (`!k:int. + (k = &4 \/ k = &8) + ==> ~iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&5) (&1) k) (&10)`, + GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[iq_represents] THEN + DISCH_THEN(X_CHOOSE_TAC `v:num->int`) THEN + SUBGOAL_THEN + `v 0 pow 2 + &2 * v 1 pow 2 + &5 * v 2 pow 2 + + &2 * v 1 * v 3 + &2 * v 2 * v 3 + + k * v 3 pow 2 = &10` + ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC) THEN REWRITE_TAC[IQEVAL_MAT4] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC INT_RING; + UNDISCH_TAC `k = &4 \/ k = &8` THEN + DISCH_THEN(DISJ_CASES_THEN SUBST_ALL_TAC) THEN + ASM_MESON_TAC + [INT_RB1_RC1_K4_125_NOT_10; INT_RB1_RC1_K8_125_NOT_10]]);; + +let IQ_RB1_RC2_K7_125_NOT_REPRESENTS_10 = prove + (`~iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&5) (&2) (&7)) (&10)`, + REWRITE_TAC[iq_represents] THEN + DISCH_THEN(X_CHOOSE_TAC `v:num->int`) THEN + MP_TAC(SPECL + [`v 0:int`; `v 1:int`; `v 2:int`; `v 3:int`] + INT_RB1_RC2_K7_125_NOT_10) THEN + FIRST_X_ASSUM(MP_TAC) THEN REWRITE_TAC[IQEVAL_MAT4] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC INT_RING);; + +let IQ_RB1_RC2_K1_125_NOT_EMBEDS = prove + (`!n A. + iq_positive n A + ==> ~iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&5) (&2) (&1)) A`, + REPEAT GEN_TAC THEN DISCH_TAC THEN DISCH_TAC THEN + MP_TAC(MATCH_MP + (ISPECL + [`n:num`; `4`; + `iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&5) (&2) (&1)`; + `A:num->num->int`] IQ_EMBEDDED_NONNEG) + (CONJ + (ASSUME `iq_positive n A`) + (ASSUME + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&5) (&2) (&1)) A`))) THEN + DISCH_THEN(MP_TAC o SPEC + `\i:num. + if i = 1 then -- &5 else if i = 2 then -- &4 else + if i = 3 then &10 else &0`) THEN + REWRITE_TAC[IQEVAL_MAT4] THEN + CONV_TAC NUM_REDUCE_CONV THEN INT_ARITH_TAC);; + +let IQ_RB1_RC0_125_PARAMETER_CASES = prove + (`!k:int. + &1 <= k /\ k <= &10 /\ + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&5) (&0) k) (&10) + ==> k = &1 \/ k = &2 \/ k = &3 \/ k = &4 \/ + k = &5 \/ k = &6 \/ k = &9 \/ k = &10`, + GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN + `k = &1 \/ k = &2 \/ k = &3 \/ k = &4 \/ k = &5 \/ + k = &6 \/ k = &7 \/ k = &8 \/ k = &9 \/ k = &10` + MP_TAC THENL + [ASM_INT_ARITH_TAC; + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + ASM_MESON_TAC[IQ_RB1_RC0_125_NOT_REPRESENTS_10]]);; + +let IQ_RB1_RC1_125_PARAMETER_CASES = prove + (`!k:int. + &1 <= k /\ k <= &10 /\ + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&5) (&1) k) (&10) + ==> k = &1 \/ k = &2 \/ k = &3 \/ k = &5 \/ + k = &6 \/ k = &7 \/ k = &9 \/ k = &10`, + GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN + `k = &1 \/ k = &2 \/ k = &3 \/ k = &4 \/ k = &5 \/ + k = &6 \/ k = &7 \/ k = &8 \/ k = &9 \/ k = &10` + MP_TAC THENL + [ASM_INT_ARITH_TAC; + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + ASM_MESON_TAC[IQ_RB1_RC1_125_NOT_REPRESENTS_10]]);; + +let IQ_RB1_RC2_125_PARAMETER_CASES = prove + (`!n A k. + iq_positive n A /\ + &1 <= k /\ k <= &10 /\ + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&5) (&2) k) A /\ + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&5) (&2) k) (&10) + ==> k = &2 \/ k = &3 \/ k = &4 \/ k = &5 \/ + k = &6 \/ k = &8 \/ k = &9 \/ k = &10`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC)) THEN + SUBGOAL_THEN + `k = &1 \/ k = &2 \/ k = &3 \/ k = &4 \/ k = &5 \/ + k = &6 \/ k = &7 \/ k = &8 \/ k = &9 \/ k = &10` + MP_TAC THENL + [ASM_INT_ARITH_TAC; + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + ASM_MESON_TAC + [IQ_RB1_RC2_K1_125_NOT_EMBEDS; + IQ_RB1_RC2_K7_125_NOT_REPRESENTS_10]]);; + +(* ------------------------------------------------------------------------- *) +(* Integral orthogonal shifts into the diagonal ternary subform. *) +(* ------------------------------------------------------------------------- *) + +let INT_REPRESENTS_DIAG125_SHIFT = prove + (`!k s n:num. + k * s EXP 2 <= n /\ + (?x y z:int. + x pow 2 + &2 * y pow 2 + &5 * z pow 2 = + &(n - k * s EXP 2)) + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &5 * z pow 2 + + &k * w pow 2 = &n`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` + (X_CHOOSE_THEN `z:int` (LABEL_TAC "rep"))))) THEN + MAP_EVERY EXISTS_TAC [`x:int`; `y:int`; `z:int`; `&s:int`] THEN + SUBGOAL_THEN + `&(n - k * s EXP 2) = + (&n:int) - (&k:int) * (&s:int) pow 2` + ASSUME_TAC THENL + [ASM_SIMP_TAC[INT_OF_NUM_SUB; INT_OF_NUM_MUL; INT_OF_NUM_POW]; + REMOVE_THEN "rep" MP_TAC THEN + ASM_REWRITE_TAC[] THEN CONV_TAC INT_RING]);; + +let INT_REPRESENTS_RC1_125_SHIFT = prove + (`!k s n:num. + 1 <= k /\ (25*k-5) * s EXP 2 <= n /\ + (?x y z:int. + x pow 2 + &2 * y pow 2 + &5 * z pow 2 = + &(n - (25*k-5) * s EXP 2)) + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &5 * z pow 2 + + &2 * z * w + &k * w pow 2 = &n`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC + (X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` + (X_CHOOSE_THEN `z:int` (LABEL_TAC "rep")))))) THEN + MAP_EVERY EXISTS_TAC + [`x:int`; `y:int`; `z - &s:int`; `&5 * &s:int`] THEN + SUBGOAL_THEN `5 <= 25*k` ASSUME_TAC THENL + [ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `&(n - (25*k-5) * s EXP 2) = + (&n:int) - (&25 * &k - &5) * (&s:int) pow 2` + ASSUME_TAC THENL + [ASM_SIMP_TAC[INT_OF_NUM_SUB; INT_OF_NUM_MUL; INT_OF_NUM_POW]; + REMOVE_THEN "rep" MP_TAC THEN + ASM_REWRITE_TAC[] THEN CONV_TAC INT_RING]);; + +let INT_REPRESENTS_RC2_125_SHIFT = prove + (`!k s n:num. + 1 <= k /\ (25*k-20) * s EXP 2 <= n /\ + (?x y z:int. + x pow 2 + &2 * y pow 2 + &5 * z pow 2 = + &(n - (25*k-20) * s EXP 2)) + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &5 * z pow 2 + + &4 * z * w + &k * w pow 2 = &n`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC + (X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` + (X_CHOOSE_THEN `z:int` (LABEL_TAC "rep")))))) THEN + MAP_EVERY EXISTS_TAC + [`x:int`; `y:int`; `z - &2 * &s:int`; `&5 * &s:int`] THEN + SUBGOAL_THEN `20 <= 25*k` ASSUME_TAC THENL + [ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `&(n - (25*k-20) * s EXP 2) = + (&n:int) - (&25 * &k - &20) * (&s:int) pow 2` + ASSUME_TAC THENL + [ASM_SIMP_TAC[INT_OF_NUM_SUB; INT_OF_NUM_MUL; INT_OF_NUM_POW]; + REMOVE_THEN "rep" MP_TAC THEN + ASM_REWRITE_TAC[] THEN CONV_TAC INT_RING]);; + +let INT_REPRESENTS_RB1_125_SHIFT = prove + (`!k s n:num. + 1 <= k /\ (4*k-2) * s EXP 2 <= n /\ + (?x y z:int. + x pow 2 + &2 * y pow 2 + &5 * z pow 2 = + &(n - (4*k-2) * s EXP 2)) + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &5 * z pow 2 + + &2 * y * w + &k * w pow 2 = &n`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC + (X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` + (X_CHOOSE_THEN `z:int` (LABEL_TAC "rep")))))) THEN + MAP_EVERY EXISTS_TAC + [`x:int`; `y - &s:int`; `z:int`; `&2 * &s:int`] THEN + SUBGOAL_THEN `2 <= 4*k` ASSUME_TAC THENL + [ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `&(n - (4*k-2) * s EXP 2) = + (&n:int) - (&4 * &k - &2) * (&s:int) pow 2` + ASSUME_TAC THENL + [ASM_SIMP_TAC[INT_OF_NUM_SUB; INT_OF_NUM_MUL; INT_OF_NUM_POW]; + REMOVE_THEN "rep" MP_TAC THEN + ASM_REWRITE_TAC[] THEN CONV_TAC INT_RING]);; + +let INT_REPRESENTS_RB1_RC1_125_SHIFT = prove + (`!k s n:num. + 1 <= k /\ (100*k-70) * s EXP 2 <= n /\ + (?x y z:int. + x pow 2 + &2 * y pow 2 + &5 * z pow 2 = + &(n - (100*k-70) * s EXP 2)) + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &5 * z pow 2 + + &2 * y * w + &2 * z * w + &k * w pow 2 = &n`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC + (X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` + (X_CHOOSE_THEN `z:int` (LABEL_TAC "rep")))))) THEN + MAP_EVERY EXISTS_TAC + [`x:int`; `y - &5 * &s:int`; `z - &2 * &s:int`; + `&10 * &s:int`] THEN + SUBGOAL_THEN `70 <= 100*k` ASSUME_TAC THENL + [ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `&(n - (100*k-70) * s EXP 2) = + (&n:int) - (&100 * &k - &70) * (&s:int) pow 2` + ASSUME_TAC THENL + [ASM_SIMP_TAC[INT_OF_NUM_SUB; INT_OF_NUM_MUL; INT_OF_NUM_POW]; + REMOVE_THEN "rep" MP_TAC THEN + ASM_REWRITE_TAC[] THEN CONV_TAC INT_RING]);; + +let INT_REPRESENTS_RB1_RC2_125_SHIFT = prove + (`!k s n:num. + 2 <= k /\ (100*k-130) * s EXP 2 <= n /\ + (?x y z:int. + x pow 2 + &2 * y pow 2 + &5 * z pow 2 = + &(n - (100*k-130) * s EXP 2)) + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &5 * z pow 2 + + &2 * y * w + &4 * z * w + &k * w pow 2 = &n`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC + (X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` + (X_CHOOSE_THEN `z:int` (LABEL_TAC "rep")))))) THEN + MAP_EVERY EXISTS_TAC + [`x:int`; `y - &5 * &s:int`; `z - &4 * &s:int`; + `&10 * &s:int`] THEN + SUBGOAL_THEN `130 <= 100*k` ASSUME_TAC THENL + [ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `&(n - (100*k-130) * s EXP 2) = + (&n:int) - (&100 * &k - &130) * (&s:int) pow 2` + ASSUME_TAC THENL + [ASM_SIMP_TAC[INT_OF_NUM_SUB; INT_OF_NUM_MUL; INT_OF_NUM_POW]; + REMOVE_THEN "rep" MP_TAC THEN + ASM_REWRITE_TAC[] THEN CONV_TAC INT_RING]);; + +(* ------------------------------------------------------------------------- *) +(* The local obstruction and the modulus-25 subtraction step. *) +(* ------------------------------------------------------------------------- *) + +let num_125_exception = new_definition + `num_125_exception n <=> + ?a u. n = 5 EXP (2*a+1) * u /\ + (u MOD 5 = 2 \/ u MOD 5 = 3)`;; + +let NUM_MUL5_MOD25_2 = prove + (`!u:num. u MOD 5 = 2 ==> (5*u) MOD 25 = 10`, + GEN_TAC THEN DISCH_TAC THEN + MP_TAC(MATCH_MP (SPECL [`u:num`; `5`; `2`] NUM_DECOMPOSE_MOD) + (CONJ (ARITH_RULE `~(5 = 0)`) (ASSUME `u MOD 5 = 2`))) THEN + DISCH_THEN(X_CHOOSE_THEN `q:num` SUBST_ALL_TAC) THEN + REWRITE_TAC[ARITH_RULE `5 * (5*(q:num)+2) = 25*q+10`; + MOD_MULT_ADD] THEN + CONV_TAC NUM_REDUCE_CONV);; + +let NUM_MUL5_MOD25_3 = prove + (`!u:num. u MOD 5 = 3 ==> (5*u) MOD 25 = 15`, + GEN_TAC THEN DISCH_TAC THEN + MP_TAC(MATCH_MP (SPECL [`u:num`; `5`; `3`] NUM_DECOMPOSE_MOD) + (CONJ (ARITH_RULE `~(5 = 0)`) (ASSUME `u MOD 5 = 3`))) THEN + DISCH_THEN(X_CHOOSE_THEN `q:num` SUBST_ALL_TAC) THEN + REWRITE_TAC[ARITH_RULE `5 * (5*(q:num)+3) = 25*q+15`; + MOD_MULT_ADD] THEN + CONV_TAC NUM_REDUCE_CONV);; + +let NUM_125_HIGH_POWER_MOD25 = prove + (`!b u:num. (5 EXP (2 * SUC b + 1) * u) MOD 25 = 0`, + REPEAT GEN_TAC THEN + REWRITE_TAC + [ARITH_RULE `2 * SUC b + 1 = SUC(SUC(2*b+1))`; EXP; + ARITH_RULE `(5 * 5 * (q:num)) * u = 25 * (q*u)`; + MOD_MULT]);; + +let NUM_125_EXCEPTION_MOD25 = prove + (`!n:num. + num_125_exception n + ==> n MOD 25 = 0 \/ n MOD 25 = 10 \/ n MOD 25 = 15`, + GEN_TAC THEN REWRITE_TAC[num_125_exception] THEN + DISCH_THEN(X_CHOOSE_THEN `a:num` + (X_CHOOSE_THEN `u:num` + (CONJUNCTS_THEN2 (LABEL_TAC "eq") ASSUME_TAC))) THEN + ASM_CASES_TAC `a = 0` THENL + [UNDISCH_TAC `a = 0` THEN DISCH_THEN SUBST_ALL_TAC THEN + REMOVE_THEN "eq" SUBST1_TAC THEN + CONV_TAC NUM_REDUCE_CONV THEN + ASM_MESON_TAC[NUM_MUL5_MOD25_2; NUM_MUL5_MOD25_3]; + MP_TAC(SPEC `a:num` num_CASES) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `b:num` SUBST_ALL_TAC) THEN + DISJ1_TAC THEN REMOVE_THEN "eq" SUBST1_TAC THEN + REWRITE_TAC[NUM_125_HIGH_POWER_MOD25]]);; + +let NUM_125_EXCEPTION_NOT_DIV25 = prove + (`!n:num. + num_125_exception n /\ ~(25 divides n) + ==> n MOD 25 = 10 \/ n MOD 25 = 15`, + GEN_TAC THEN STRIP_TAC THEN + MP_TAC(MATCH_MP (SPEC `n:num` NUM_125_EXCEPTION_MOD25) + (ASSUME `num_125_exception n`)) THEN + UNDISCH_TAC `~(25 divides n)` THEN + REWRITE_TAC[DIVIDES_MOD] THEN CONV_TAC NUM_REDUCE_CONV THEN + MESON_TAC[]);; + +let NUM_AVOIDS_125_SUB_OF_RESIDUES = prove + (`!n c:num. + c <= n /\ + (n MOD 25 = 10 \/ n MOD 25 = 15) /\ + ~(((0 + c MOD 25) MOD 25 = n MOD 25) \/ + ((10 + c MOD 25) MOD 25 = n MOD 25) \/ + ((15 + c MOD 25) MOD 25 = n MOD 25)) + ==> ~num_125_exception (n - c)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + DISCH_THEN(fun th -> + MP_TAC(MATCH_MP (SPEC `n - c:num` NUM_125_EXCEPTION_MOD25) th)) THEN + DISCH_TAC THEN + (SUBGOAL_THEN + `((n - c) MOD 25 + c MOD 25) MOD 25 = n MOD 25` + ASSUME_TAC THENL + [REWRITE_TAC[MOD_ADD_MOD] THEN ASM_SIMP_TAC[SUB_ADD]; + ALL_TAC]) THEN + ASM_MESON_TAC[]);; + +let num_125_shift_good = new_definition + `num_125_shift_good a r <=> + ~(((0 + r) MOD 25 = a) \/ + ((10 + r) MOD 25 = a) \/ + ((15 + r) MOD 25 = a))`;; + +let NUM_125_SHIFT_GOOD_ONE_OR_FOUR = prove + (`!a r:num. + (a = 10 \/ a = 15) /\ r < 25 /\ ~(r = 0) + ==> num_125_shift_good a r \/ + num_125_shift_good a ((4*r) MOD 25)`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC)) THEN + SUBGOAL_THEN `(r:num) <= 24` ASSUME_TAC THENL + [ASM_ARITH_TAC; + ALL_TAC] THEN + UNDISCH_TAC `a = 10 \/ a = 15` THEN + DISCH_THEN(DISJ_CASES_THEN SUBST_ALL_TAC) THEN + NUM_RANGE_CASES_TAC `r:num` 24 THEN + ASM_REWRITE_TAC[num_125_shift_good] THEN + CONV_TAC NUM_REDUCE_CONV THEN ASM_ARITH_TAC);; + +let NUM_AVOIDS_125_SUB_ONE_OR_FOUR = prove + (`!n c:num. + 4*c <= n /\ + (n MOD 25 = 10 \/ n MOD 25 = 15) /\ + ~(c MOD 25 = 0) + ==> ~num_125_exception (n - c) \/ + ~num_125_exception (n - 4*c)`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC)) THEN + SUBGOAL_THEN `(c:num) <= n` ASSUME_TAC THENL + [ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `(4*c) MOD 25 = (4 * (c MOD 25)) MOD 25` + ASSUME_TAC THENL + [CONV_TAC SYM_CONV THEN REWRITE_TAC[MOD_MULT_RMOD]; + ALL_TAC] THEN + MP_TAC(SPECL [`n MOD 25`; `c MOD 25`] + NUM_125_SHIFT_GOOD_ONE_OR_FOUR) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN + REWRITE_TAC[MOD_LT_EQ_LT] THEN CONV_TAC NUM_REDUCE_CONV; + DISCH_THEN(DISJ_CASES_THEN ASSUME_TAC) THENL + [DISJ1_TAC THEN + MATCH_MP_TAC(SPECL [`n:num`; `c:num`] + NUM_AVOIDS_125_SUB_OF_RESIDUES) THEN + ASM_REWRITE_TAC[GSYM num_125_shift_good]; + DISJ2_TAC THEN + MATCH_MP_TAC(SPECL [`n:num`; `4*c:num`] + NUM_AVOIDS_125_SUB_OF_RESIDUES) THEN + ASM_REWRITE_TAC[GSYM num_125_shift_good]]]);; + +(* All six completed-square coefficients are positive, at most 1000, and + nonzero modulo 25 in the reduced parameter ranges. *) + +let NUM_DIAG125_SHIFT_COEFF = prove + (`!k:num. + 1 <= k /\ k <= 10 + ==> 0 < k /\ k <= 1000 /\ ~(k MOD 25 = 0)`, + GEN_TAC THEN STRIP_TAC THEN + NUM_RANGE_CASES_TAC `k:num` 10 THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN ASM_ARITH_TAC);; + +let NUM_RC1_125_SHIFT_COEFF = prove + (`!k:num. + 1 <= k /\ k <= 10 + ==> 0 < 25*k-5 /\ 25*k-5 <= 1000 /\ + ~((25*k-5) MOD 25 = 0)`, + GEN_TAC THEN STRIP_TAC THEN + NUM_RANGE_CASES_TAC `k:num` 10 THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN ASM_ARITH_TAC);; + +let NUM_RC2_125_SHIFT_COEFF = prove + (`!k:num. + 1 <= k /\ k <= 10 + ==> 0 < 25*k-20 /\ 25*k-20 <= 1000 /\ + ~((25*k-20) MOD 25 = 0)`, + GEN_TAC THEN STRIP_TAC THEN + NUM_RANGE_CASES_TAC `k:num` 10 THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN ASM_ARITH_TAC);; + +let NUM_RB1_125_SHIFT_COEFF = prove + (`!k:num. + 1 <= k /\ k <= 10 + ==> 0 < 4*k-2 /\ 4*k-2 <= 1000 /\ + ~((4*k-2) MOD 25 = 0)`, + GEN_TAC THEN STRIP_TAC THEN + NUM_RANGE_CASES_TAC `k:num` 10 THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN ASM_ARITH_TAC);; + +let NUM_RB1_RC1_125_SHIFT_COEFF = prove + (`!k:num. + 1 <= k /\ k <= 10 + ==> 0 < 100*k-70 /\ 100*k-70 <= 1000 /\ + ~((100*k-70) MOD 25 = 0)`, + GEN_TAC THEN STRIP_TAC THEN + NUM_RANGE_CASES_TAC `k:num` 10 THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN ASM_ARITH_TAC);; + +let NUM_RB1_RC2_125_SHIFT_COEFF = prove + (`!k:num. + 2 <= k /\ k <= 10 + ==> 0 < 100*k-130 /\ 100*k-130 <= 1000 /\ + ~((100*k-130) MOD 25 = 0)`, + GEN_TAC THEN STRIP_TAC THEN + NUM_RANGE_CASES_TAC `k:num` 10 THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN ASM_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* A generic minimal-counterexample descent for all six child families. *) +(* ------------------------------------------------------------------------- *) + +let INT_REPRESENTS_125_CHILD_SCALE25 = prove + (`!rb rc k n:num. + (?x y z w:int. + x pow 2 + &2 * y pow 2 + &5 * z pow 2 + + &2 * &rb * y * w + &2 * &rc * z * w + + &k * w pow 2 = &n) + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &5 * z pow 2 + + &2 * &rb * y * w + &2 * &rc * z * w + + &k * w pow 2 = &(25*n)`, + REPEAT GEN_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` + (X_CHOOSE_THEN `z:int` (X_CHOOSE_TAC `w:int`)))) THEN + MAP_EVERY EXISTS_TAC + [`&5*x:int`; `&5*y:int`; `&5*z:int`; `&5*w:int`] THEN + FIRST_X_ASSUM(MP_TAC) THEN + REWRITE_TAC[GSYM INT_OF_NUM_MUL] THEN CONV_TAC INT_RING);; + +let NUM_125_CHILD_DESCENT = prove + (`!R c. + 0 < c /\ ~(c MOD 25 = 0) /\ + (!m:num. R m ==> R (25*m)) /\ + (!m:num. ~num_125_exception m ==> R m) /\ + (!m s:num. + c * s EXP 2 <= m /\ + ~num_125_exception (m - c * s EXP 2) + ==> R m) /\ + (!m:num. + 0 < m /\ ~(m = 15) /\ + (m = 375 \/ + (m < 4*c /\ (m MOD 25 = 10 \/ m MOD 25 = 15))) + ==> R m) + ==> !m:num. 0 < m /\ ~(m = 15) ==> R m`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC num_WF THEN X_GEN_TAC `m:num` THEN + DISCH_THEN(LABEL_TAC "ind") THEN STRIP_TAC THEN + ASM_CASES_TAC `25 divides m` THENL + [FIRST_X_ASSUM(X_CHOOSE_THEN `q:num` ASSUME_TAC o + REWRITE_RULE[divides]) THEN + ASM_CASES_TAC `q = 15` THENL + [MATCH_MP_TAC(SPEC `m:num` (ASSUME + `!m:num. + 0 < m /\ ~(m = 15) /\ + (m = 375 \/ + m < 4*c /\ (m MOD 25 = 10 \/ m MOD 25 = 15)) + ==> R m`)) THEN + ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; + SUBGOAL_THEN `q < m /\ 0 < q` STRIP_ASSUME_TAC THENL + [ASM_ARITH_TAC; + ALL_TAC] THEN + ONCE_REWRITE_TAC[ASSUME `m = 25 * q`] THEN + MATCH_MP_TAC(SPEC `q:num` (ASSUME + `!m:num. R m ==> R (25*m)`)) THEN + REMOVE_THEN "ind" (MP_TAC o SPEC `q:num`) THEN + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + ASM_CASES_TAC `num_125_exception m` THENL + [MP_TAC(MATCH_MP (SPEC `m:num` NUM_125_EXCEPTION_NOT_DIV25) + (CONJ (ASSUME `num_125_exception m`) + (ASSUME `~(25 divides m)`))) THEN + DISCH_THEN(LABEL_TAC "residue") THEN + ASM_CASES_TAC `m < 4*c` THENL + [MATCH_MP_TAC(SPEC `m:num` (ASSUME + `!m:num. + 0 < m /\ ~(m = 15) /\ + (m = 375 \/ + m < 4*c /\ (m MOD 25 = 10 \/ m MOD 25 = 15)) + ==> R m`)) THEN + ASM_REWRITE_TAC[]; + SUBGOAL_THEN `4*c <= m` ASSUME_TAC THENL + [ASM_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(MATCH_MP (SPECL [`m:num`; `c:num`] + NUM_AVOIDS_125_SUB_ONE_OR_FOUR) + (CONJ (ASSUME `4*c <= m`) + (CONJ + (ASSUME `m MOD 25 = 10 \/ m MOD 25 = 15`) + (ASSUME `~(c MOD 25 = 0)`)))) THEN + DISCH_THEN(DISJ_CASES_THEN ASSUME_TAC) THENL + [MATCH_MP_TAC(SPECL [`m:num`; `1`] (ASSUME + `!m s:num. + c * s EXP 2 <= m /\ + ~num_125_exception (m - c * s EXP 2) + ==> R m`)) THEN + REWRITE_TAC[EXP_2; MULT_CLAUSES] THEN ASM_REWRITE_TAC[] THEN + ASM_ARITH_TAC; + MATCH_MP_TAC(SPECL [`m:num`; `2`] (ASSUME + `!m s:num. + c * s EXP 2 <= m /\ + ~num_125_exception (m - c * s EXP 2) + ==> R m`)) THEN + CONV_TAC NUM_REDUCE_CONV THEN + ONCE_REWRITE_TAC[MULT_SYM] THEN ASM_REWRITE_TAC[]]]; + MATCH_MP_TAC(SPEC `m:num` (ASSUME + `!m:num. ~num_125_exception m ==> R m`)) THEN + ASM_REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Kernel-checked finite certificates for the exceptional small targets. *) +(* ------------------------------------------------------------------------- *) + +let int125_num_of_int i = + if i < 0 + then minus_num(num_of_string(string_of_int(-i))) + else num_of_string(string_of_int i);; + +let INT125_CERT_TAC rb rc k = + fun (asl,goal) -> + let _,bod = strip_exists goal in + let _,rhs = dest_eq bod in + let n = int_of_string(string_of_num(dest_intconst rhs)) in + let bound = + int_of_float(float_sqrt(float_of_int(8 * n))) + 2 in + let signed i = + if i = 0 then 0 else if i mod 2 = 1 then (i + 1) / 2 else -(i / 2) in + let rec find_w iw = + if iw > 2 * bound then failwith "INT125_CERT_TAC" else + let w = signed iw in + let rec find_z iz = + if iz > 2 * bound then find_w (iw + 1) else + let z = signed iz in + let rec find_y iy = + if iy > 2 * bound then find_z (iz + 1) else + let y = signed iy in + let r = + n - 2*y*y - 5*z*z - + 2*rb*y*w - 2*rc*z*w - k*w*w in + if r < 0 then find_y (iy + 1) else + let x = int_of_float(float_sqrt(float_of_int r)) in + if x*x = r then (x,y,z,w) else find_y (iy + 1) in + find_y 0 in + find_z 0 in + let x,y,z,w = find_w 0 in + (MAP_EVERY EXISTS_TAC + (map (mk_intconst o int125_num_of_int) [x;y;z;w]) THEN + CONV_TAC INT_REDUCE_CONV) (asl,goal);; + +let INT125_BASE_TAC rb rc k hi10 hi15 = + REMOVE_THEN "base" + (DISJ_CASES_THEN2 + SUBST_ALL_TAC + (CONJUNCTS_THEN2 ASSUME_TAC + (DISJ_CASES_THEN ASSUME_TAC))) THENL + [CONV_TAC NUM_REDUCE_CONV THEN INT125_CERT_TAC rb rc k; + MP_TAC(MATCH_MP + (SPECL [`m:num`; `25`; `10`] NUM_DECOMPOSE_MOD) + (CONJ (ARITH_RULE `~(25 = 0)`) + (ASSUME `m MOD 25 = 10`))) THEN + DISCH_THEN(X_CHOOSE_THEN `q:num` SUBST_ALL_TAC) THEN + NUM_RANGE_CASES_THEN `q:num` hi10 + (TRY ASM_ARITH_TAC THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN + INT125_CERT_TAC rb rc k); + MP_TAC(MATCH_MP + (SPECL [`m:num`; `25`; `15`] NUM_DECOMPOSE_MOD) + (CONJ (ARITH_RULE `~(25 = 0)`) + (ASSUME `m MOD 25 = 15`))) THEN + DISCH_THEN(X_CHOOSE_THEN `q:num` SUBST_ALL_TAC) THEN + NUM_RANGE_CASES_THEN `q:num` hi15 + (TRY ASM_ARITH_TAC THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN + INT125_CERT_TAC rb rc k)];; + +let INT_REPRESENTS_DIAG125_BASE = prove + (`!k m:num. + 1 <= k /\ k <= 10 /\ 0 < m /\ ~(m = 15) /\ + (m = 375 \/ + (m < 4*k /\ (m MOD 25 = 10 \/ m MOD 25 = 15))) + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &5 * z pow 2 + + &k * w pow 2 = &m`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "base"))))) THEN + SUBGOAL_THEN + `k = 1 \/ k = 2 \/ k = 3 \/ k = 4 \/ k = 5 \/ + k = 6 \/ k = 7 \/ k = 8 \/ k = 9 \/ k = 10` + MP_TAC THENL + [ASM_ARITH_TAC; + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THENL + [INT125_BASE_TAC 0 0 1 0 0; + INT125_BASE_TAC 0 0 2 0 0; + INT125_BASE_TAC 0 0 3 0 0; + INT125_BASE_TAC 0 0 4 0 0; + INT125_BASE_TAC 0 0 5 0 0; + INT125_BASE_TAC 0 0 6 0 0; + INT125_BASE_TAC 0 0 7 0 0; + INT125_BASE_TAC 0 0 8 0 0; + INT125_BASE_TAC 0 0 9 1 0; + INT125_BASE_TAC 0 0 10 1 0]]);; + +let INT_REPRESENTS_RC1_125_BASE = prove + (`!k m:num. + 1 <= k /\ k <= 10 /\ 0 < m /\ ~(m = 15) /\ + (m = 375 \/ + (m < 4*(25*k-5) /\ (m MOD 25 = 10 \/ m MOD 25 = 15))) + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &5 * z pow 2 + + &2 * z * w + &k * w pow 2 = &m`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "base"))))) THEN + SUBGOAL_THEN + `k = 1 \/ k = 2 \/ k = 3 \/ k = 4 \/ k = 5 \/ + k = 6 \/ k = 7 \/ k = 8 \/ k = 9 \/ k = 10` + MP_TAC THENL + [ASM_ARITH_TAC; + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THENL + [INT125_BASE_TAC 0 1 1 2 2; + INT125_BASE_TAC 0 1 2 6 6; + INT125_BASE_TAC 0 1 3 10 10; + INT125_BASE_TAC 0 1 4 14 14; + INT125_BASE_TAC 0 1 5 18 18; + INT125_BASE_TAC 0 1 6 22 22; + INT125_BASE_TAC 0 1 7 26 26; + INT125_BASE_TAC 0 1 8 30 30; + INT125_BASE_TAC 0 1 9 34 34; + INT125_BASE_TAC 0 1 10 38 38]]);; + +let INT_REPRESENTS_RC2_125_BASE = prove + (`!k m:num. + 1 <= k /\ k <= 10 /\ 0 < m /\ ~(m = 15) /\ + (m = 375 \/ + (m < 4*(25*k-20) /\ (m MOD 25 = 10 \/ m MOD 25 = 15))) + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &5 * z pow 2 + + &4 * z * w + &k * w pow 2 = &m`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "base"))))) THEN + SUBGOAL_THEN + `k = 1 \/ k = 2 \/ k = 3 \/ k = 4 \/ k = 5 \/ + k = 6 \/ k = 7 \/ k = 8 \/ k = 9 \/ k = 10` + MP_TAC THENL + [ASM_ARITH_TAC; + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THENL + [INT125_BASE_TAC 0 2 1 0 0; + INT125_BASE_TAC 0 2 2 4 4; + INT125_BASE_TAC 0 2 3 8 8; + INT125_BASE_TAC 0 2 4 12 12; + INT125_BASE_TAC 0 2 5 16 16; + INT125_BASE_TAC 0 2 6 20 20; + INT125_BASE_TAC 0 2 7 24 24; + INT125_BASE_TAC 0 2 8 28 28; + INT125_BASE_TAC 0 2 9 32 32; + INT125_BASE_TAC 0 2 10 36 36]]);; + +let INT_REPRESENTS_RB1_125_BASE = prove + (`!k m:num. + (k = 1 \/ k = 2 \/ k = 3 \/ k = 4 \/ + k = 5 \/ k = 6 \/ k = 9 \/ k = 10) /\ + 0 < m /\ ~(m = 15) /\ + (m = 375 \/ + (m < 4*(4*k-2) /\ (m MOD 25 = 10 \/ m MOD 25 = 15))) + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &5 * z pow 2 + + &2 * y * w + &k * w pow 2 = &m`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 + (LABEL_TAC "krange") + (CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "base")))) THEN + REMOVE_THEN "krange" MP_TAC THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THENL + [INT125_BASE_TAC 1 0 1 0 0; + INT125_BASE_TAC 1 0 2 0 0; + INT125_BASE_TAC 1 0 3 1 0; + INT125_BASE_TAC 1 0 4 1 1; + INT125_BASE_TAC 1 0 5 2 2; + INT125_BASE_TAC 1 0 6 3 2; + INT125_BASE_TAC 1 0 9 5 4; + INT125_BASE_TAC 1 0 10 5 5]);; + +let INT_REPRESENTS_RB1_RC1_125_BASE = prove + (`!k m:num. + (k = 1 \/ k = 2 \/ k = 3 \/ k = 5 \/ + k = 6 \/ k = 7 \/ k = 9 \/ k = 10) /\ + 0 < m /\ ~(m = 15) /\ + (m = 375 \/ + (m < 4*(100*k-70) /\ (m MOD 25 = 10 \/ m MOD 25 = 15))) + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &5 * z pow 2 + + &2 * y * w + &2 * z * w + &k * w pow 2 = &m`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 + (LABEL_TAC "krange") + (CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "base")))) THEN + REMOVE_THEN "krange" MP_TAC THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THENL + [INT125_BASE_TAC 1 1 1 4 4; + INT125_BASE_TAC 1 1 2 20 20; + INT125_BASE_TAC 1 1 3 36 36; + INT125_BASE_TAC 1 1 5 68 68; + INT125_BASE_TAC 1 1 6 84 84; + INT125_BASE_TAC 1 1 7 100 100; + INT125_BASE_TAC 1 1 9 132 132; + INT125_BASE_TAC 1 1 10 148 148]);; + +let INT_REPRESENTS_RB1_RC2_125_BASE = prove + (`!k m:num. + (k = 2 \/ k = 3 \/ k = 4 \/ k = 5 \/ + k = 6 \/ k = 8 \/ k = 9 \/ k = 10) /\ + 0 < m /\ ~(m = 15) /\ + (m = 375 \/ + (m < 4*(100*k-130) /\ (m MOD 25 = 10 \/ m MOD 25 = 15))) + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &5 * z pow 2 + + &2 * y * w + &4 * z * w + &k * w pow 2 = &m`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 + (LABEL_TAC "krange") + (CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "base")))) THEN + REMOVE_THEN "krange" MP_TAC THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THENL + [INT125_BASE_TAC 1 2 2 10 10; + INT125_BASE_TAC 1 2 3 26 26; + INT125_BASE_TAC 1 2 4 42 42; + INT125_BASE_TAC 1 2 5 58 58; + INT125_BASE_TAC 1 2 6 74 74; + INT125_BASE_TAC 1 2 8 106 106; + INT125_BASE_TAC 1 2 9 122 122; + INT125_BASE_TAC 1 2 10 138 138]);; + +(* ------------------------------------------------------------------------- *) +(* Composition of regularity, descent, shifts, and the finite certificates. *) +(* ------------------------------------------------------------------------- *) + +let int125_child_rep = new_definition + `int125_child_rep rb rc k n <=> + ?x y z w:int. + x pow 2 + &2 * y pow 2 + &5 * z pow 2 + + &2 * &rb * y * w + &2 * &rc * z * w + + &k * w pow 2 = &n`;; + +let INT125_CHILD_REP_SCALE25 = prove + (`!rb rc k n:num. + int125_child_rep rb rc k n + ==> int125_child_rep rb rc k (25*n)`, + REWRITE_TAC[int125_child_rep] THEN + MESON_TAC[INT_REPRESENTS_125_CHILD_SCALE25]);; + +let INT125_CHILD_REP_OF_TERNARY = prove + (`!rb rc k n:num. + (?x y z:int. + x pow 2 + &2 * y pow 2 + &5 * z pow 2 = &n) + ==> int125_child_rep rb rc k n`, + REPEAT GEN_TAC THEN REWRITE_TAC[int125_child_rep] THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` (X_CHOOSE_TAC `z:int`))) THEN + MAP_EVERY EXISTS_TAC [`x:int`; `y:int`; `z:int`; `&0:int`] THEN + FIRST_X_ASSUM(MP_TAC) THEN CONV_TAC INT_RING);; + +let INT125_CHILD_REP_DIAG = prove + (`!k n:num. + int125_child_rep 0 0 k n <=> + ?x y z w:int. + x pow 2 + &2 * y pow 2 + &5 * z pow 2 + + &k * w pow 2 = &n`, + REWRITE_TAC[int125_child_rep] THEN + SIMP_TAC[INT_MUL_LZERO; INT_MUL_RZERO; + INT_ADD_LID; INT_ADD_RID]);; + +let INT_125_DOUBLE_TWO_MUL = INT_RING + `!z w:int. &2 * &2 * z * w = &4 * z * w`;; + +let INT125_CHILD_REP_RC1 = prove + (`!k n:num. + int125_child_rep 0 1 k n <=> + ?x y z w:int. + x pow 2 + &2 * y pow 2 + &5 * z pow 2 + + &2 * z * w + &k * w pow 2 = &n`, + REWRITE_TAC[int125_child_rep] THEN + SIMP_TAC[INT_MUL_LZERO; INT_MUL_RZERO; + INT_MUL_LID; INT_MUL_RID; INT_ADD_LID; INT_ADD_RID]);; + +let INT125_CHILD_REP_RC2 = prove + (`!k n:num. + int125_child_rep 0 2 k n <=> + ?x y z w:int. + x pow 2 + &2 * y pow 2 + &5 * z pow 2 + + &4 * z * w + &k * w pow 2 = &n`, + REWRITE_TAC[int125_child_rep] THEN + SIMP_TAC[INT_MUL_LZERO; INT_MUL_RZERO; + INT_MUL_LID; INT_MUL_RID; INT_ADD_LID; INT_ADD_RID; + INT_125_DOUBLE_TWO_MUL]);; + +let INT125_CHILD_REP_RB1 = prove + (`!k n:num. + int125_child_rep 1 0 k n <=> + ?x y z w:int. + x pow 2 + &2 * y pow 2 + &5 * z pow 2 + + &2 * y * w + &k * w pow 2 = &n`, + REWRITE_TAC[int125_child_rep] THEN + SIMP_TAC[INT_MUL_LZERO; INT_MUL_RZERO; + INT_MUL_LID; INT_MUL_RID; INT_ADD_LID; INT_ADD_RID]);; + +let INT125_CHILD_REP_RB1_RC1 = prove + (`!k n:num. + int125_child_rep 1 1 k n <=> + ?x y z w:int. + x pow 2 + &2 * y pow 2 + &5 * z pow 2 + + &2 * y * w + &2 * z * w + &k * w pow 2 = &n`, + REWRITE_TAC[int125_child_rep] THEN + SIMP_TAC[INT_MUL_LZERO; INT_MUL_RZERO; + INT_MUL_LID; INT_MUL_RID; INT_ADD_LID; INT_ADD_RID]);; + +let INT125_CHILD_REP_RB1_RC2 = prove + (`!k n:num. + int125_child_rep 1 2 k n <=> + ?x y z w:int. + x pow 2 + &2 * y pow 2 + &5 * z pow 2 + + &2 * y * w + &4 * z * w + &k * w pow 2 = &n`, + REWRITE_TAC[int125_child_rep] THEN + SIMP_TAC[INT_MUL_LZERO; INT_MUL_RZERO; + INT_MUL_LID; INT_MUL_RID; INT_ADD_LID; INT_ADD_RID; + INT_125_DOUBLE_TWO_MUL]);; + +let INT_ALMOST_UNIVERSAL_125_CHILD_OF_REGULAR = prove + (`!rb rc k c:num. + (!n:num. + ~num_125_exception n + ==> ?x y z:int. + x pow 2 + &2 * y pow 2 + &5 * z pow 2 = &n) /\ + 0 < c /\ ~(c MOD 25 = 0) /\ + (!m s:num. + c * s EXP 2 <= m /\ + (?x y z:int. + x pow 2 + &2 * y pow 2 + &5 * z pow 2 = + &(m - c * s EXP 2)) + ==> int125_child_rep rb rc k m) /\ + (!m:num. + 0 < m /\ ~(m = 15) /\ + (m = 375 \/ + (m < 4*c /\ (m MOD 25 = 10 \/ m MOD 25 = 15))) + ==> int125_child_rep rb rc k m) + ==> !m:num. + 0 < m /\ ~(m = 15) + ==> int125_child_rep rb rc k m`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "regular") + (CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 (LABEL_TAC "shift") (LABEL_TAC "base"))))) THEN + MATCH_MP_TAC(ISPECL + [`int125_child_rep rb rc k`; `c:num`] NUM_125_CHILD_DESCENT) THEN + REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + MESON_TAC[INT125_CHILD_REP_SCALE25]; + X_GEN_TAC `m:num` THEN DISCH_TAC THEN + MATCH_MP_TAC(SPECL [`rb:num`; `rc:num`; `k:num`; `m:num`] + INT125_CHILD_REP_OF_TERNARY) THEN + REMOVE_THEN "regular" (MP_TAC o SPEC `m:num`) THEN + ASM_REWRITE_TAC[]; + MAP_EVERY X_GEN_TAC [`m:num`; `s:num`] THEN STRIP_TAC THEN + REMOVE_THEN "shift" (MATCH_MP_TAC o SPECL [`m:num`; `s:num`]) THEN + ASM_REWRITE_TAC[] THEN + REMOVE_THEN "regular" + (MP_TAC o SPEC `m - c * s EXP 2:num`) THEN + ASM_REWRITE_TAC[]; + REMOVE_THEN "base" MATCH_ACCEPT_TAC]);; + +let INT_ALMOST_UNIVERSAL_DIAG125_REP = prove + (`(!n:num. + ~num_125_exception n + ==> ?x y z:int. + x pow 2 + &2 * y pow 2 + &5 * z pow 2 = &n) + ==> !k:num. + 1 <= k /\ k <= 10 + ==> !m:num. + 0 < m /\ ~(m = 15) + ==> int125_child_rep 0 0 k m`, + DISCH_THEN(LABEL_TAC "regular") THEN + X_GEN_TAC `k:num` THEN DISCH_THEN(LABEL_TAC "krange") THEN + MATCH_MP_TAC(SPECL [`0`; `0`; `k:num`; `k:num`] + INT_ALMOST_UNIVERSAL_125_CHILD_OF_REGULAR) THEN + REPEAT CONJ_TAC THENL + [REMOVE_THEN "regular" MATCH_ACCEPT_TAC; + ASM_MESON_TAC[NUM_DIAG125_SHIFT_COEFF]; + ASM_MESON_TAC[NUM_DIAG125_SHIFT_COEFF]; + MAP_EVERY X_GEN_TAC [`m:num`; `s:num`] THEN + REWRITE_TAC[INT125_CHILD_REP_DIAG] THEN STRIP_TAC THEN + MATCH_MP_TAC(SPECL [`k:num`; `s:num`; `m:num`] + INT_REPRESENTS_DIAG125_SHIFT) THEN + ASM_MESON_TAC[]; + X_GEN_TAC `m:num` THEN REWRITE_TAC[INT125_CHILD_REP_DIAG] THEN + DISCH_TAC THEN + MATCH_MP_TAC(SPECL [`k:num`; `m:num`] + INT_REPRESENTS_DIAG125_BASE) THEN + ASM_REWRITE_TAC[]]);; + +let INT_ALMOST_UNIVERSAL_RC1_125_REP = prove + (`(!n:num. + ~num_125_exception n + ==> ?x y z:int. + x pow 2 + &2 * y pow 2 + &5 * z pow 2 = &n) + ==> !k:num. + 1 <= k /\ k <= 10 + ==> !m:num. + 0 < m /\ ~(m = 15) + ==> int125_child_rep 0 1 k m`, + DISCH_THEN(LABEL_TAC "regular") THEN + X_GEN_TAC `k:num` THEN DISCH_THEN(LABEL_TAC "krange") THEN + MATCH_MP_TAC(SPECL [`0`; `1`; `k:num`; `25*k-5`] + INT_ALMOST_UNIVERSAL_125_CHILD_OF_REGULAR) THEN + REPEAT CONJ_TAC THENL + [REMOVE_THEN "regular" MATCH_ACCEPT_TAC; + ASM_MESON_TAC[NUM_RC1_125_SHIFT_COEFF]; + ASM_MESON_TAC[NUM_RC1_125_SHIFT_COEFF]; + MAP_EVERY X_GEN_TAC [`m:num`; `s:num`] THEN + REWRITE_TAC[INT125_CHILD_REP_RC1] THEN STRIP_TAC THEN + MATCH_MP_TAC(SPECL [`k:num`; `s:num`; `m:num`] + INT_REPRESENTS_RC1_125_SHIFT) THEN + ASM_MESON_TAC[]; + X_GEN_TAC `m:num` THEN REWRITE_TAC[INT125_CHILD_REP_RC1] THEN + DISCH_TAC THEN + MATCH_MP_TAC(SPECL [`k:num`; `m:num`] + INT_REPRESENTS_RC1_125_BASE) THEN + ASM_REWRITE_TAC[]]);; + +let INT_ALMOST_UNIVERSAL_RC2_125_REP = prove + (`(!n:num. + ~num_125_exception n + ==> ?x y z:int. + x pow 2 + &2 * y pow 2 + &5 * z pow 2 = &n) + ==> !k:num. + 1 <= k /\ k <= 10 + ==> !m:num. + 0 < m /\ ~(m = 15) + ==> int125_child_rep 0 2 k m`, + DISCH_THEN(LABEL_TAC "regular") THEN + X_GEN_TAC `k:num` THEN DISCH_THEN(LABEL_TAC "krange") THEN + MATCH_MP_TAC(SPECL [`0`; `2`; `k:num`; `25*k-20`] + INT_ALMOST_UNIVERSAL_125_CHILD_OF_REGULAR) THEN + REPEAT CONJ_TAC THENL + [REMOVE_THEN "regular" MATCH_ACCEPT_TAC; + ASM_MESON_TAC[NUM_RC2_125_SHIFT_COEFF]; + ASM_MESON_TAC[NUM_RC2_125_SHIFT_COEFF]; + MAP_EVERY X_GEN_TAC [`m:num`; `s:num`] THEN + REWRITE_TAC[INT125_CHILD_REP_RC2] THEN STRIP_TAC THEN + MATCH_MP_TAC(SPECL [`k:num`; `s:num`; `m:num`] + INT_REPRESENTS_RC2_125_SHIFT) THEN + ASM_MESON_TAC[]; + X_GEN_TAC `m:num` THEN REWRITE_TAC[INT125_CHILD_REP_RC2] THEN + DISCH_TAC THEN + MATCH_MP_TAC(SPECL [`k:num`; `m:num`] + INT_REPRESENTS_RC2_125_BASE) THEN + ASM_REWRITE_TAC[]]);; + +let INT_ALMOST_UNIVERSAL_RB1_125_REP = prove + (`(!n:num. + ~num_125_exception n + ==> ?x y z:int. + x pow 2 + &2 * y pow 2 + &5 * z pow 2 = &n) + ==> !k:num. + (k = 1 \/ k = 2 \/ k = 3 \/ k = 4 \/ + k = 5 \/ k = 6 \/ k = 9 \/ k = 10) + ==> !m:num. + 0 < m /\ ~(m = 15) + ==> int125_child_rep 1 0 k m`, + DISCH_THEN(LABEL_TAC "regular") THEN + X_GEN_TAC `k:num` THEN DISCH_THEN(LABEL_TAC "krange") THEN + SUBGOAL_THEN `1 <= k /\ k <= 10` (LABEL_TAC "bounds") THENL + [REMOVE_THEN "krange" MP_TAC THEN ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(SPECL [`1`; `0`; `k:num`; `4*k-2`] + INT_ALMOST_UNIVERSAL_125_CHILD_OF_REGULAR) THEN + REPEAT CONJ_TAC THENL + [REMOVE_THEN "regular" MATCH_ACCEPT_TAC; + MP_TAC(MATCH_MP (SPEC `k:num` NUM_RB1_125_SHIFT_COEFF) + (ASSUME `1 <= k /\ k <= 10`)) THEN MESON_TAC[]; + MP_TAC(MATCH_MP (SPEC `k:num` NUM_RB1_125_SHIFT_COEFF) + (ASSUME `1 <= k /\ k <= 10`)) THEN MESON_TAC[]; + MAP_EVERY X_GEN_TAC [`m:num`; `s:num`] THEN + REWRITE_TAC[INT125_CHILD_REP_RB1] THEN STRIP_TAC THEN + MATCH_MP_TAC(SPECL [`k:num`; `s:num`; `m:num`] + INT_REPRESENTS_RB1_125_SHIFT) THEN + REPEAT CONJ_TAC THENL + [MP_TAC(ASSUME `1 <= k /\ k <= 10`) THEN ARITH_TAC; + ASM_REWRITE_TAC[]; + MAP_EVERY EXISTS_TAC [`x:int`; `y:int`; `z:int`] THEN + ASM_REWRITE_TAC[]]; + X_GEN_TAC `m:num` THEN REWRITE_TAC[INT125_CHILD_REP_RB1] THEN + DISCH_TAC THEN + MATCH_MP_TAC(SPECL [`k:num`; `m:num`] + INT_REPRESENTS_RB1_125_BASE) THEN + ASM_REWRITE_TAC[]]);; + +let INT_ALMOST_UNIVERSAL_RB1_RC1_125_REP = prove + (`(!n:num. + ~num_125_exception n + ==> ?x y z:int. + x pow 2 + &2 * y pow 2 + &5 * z pow 2 = &n) + ==> !k:num. + (k = 1 \/ k = 2 \/ k = 3 \/ k = 5 \/ + k = 6 \/ k = 7 \/ k = 9 \/ k = 10) + ==> !m:num. + 0 < m /\ ~(m = 15) + ==> int125_child_rep 1 1 k m`, + DISCH_THEN(LABEL_TAC "regular") THEN + X_GEN_TAC `k:num` THEN DISCH_THEN(LABEL_TAC "krange") THEN + SUBGOAL_THEN `1 <= k /\ k <= 10` (LABEL_TAC "bounds") THENL + [REMOVE_THEN "krange" MP_TAC THEN ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(SPECL [`1`; `1`; `k:num`; `100*k-70`] + INT_ALMOST_UNIVERSAL_125_CHILD_OF_REGULAR) THEN + REPEAT CONJ_TAC THENL + [REMOVE_THEN "regular" MATCH_ACCEPT_TAC; + MP_TAC(MATCH_MP (SPEC `k:num` NUM_RB1_RC1_125_SHIFT_COEFF) + (ASSUME `1 <= k /\ k <= 10`)) THEN MESON_TAC[]; + MP_TAC(MATCH_MP (SPEC `k:num` NUM_RB1_RC1_125_SHIFT_COEFF) + (ASSUME `1 <= k /\ k <= 10`)) THEN MESON_TAC[]; + MAP_EVERY X_GEN_TAC [`m:num`; `s:num`] THEN + REWRITE_TAC[INT125_CHILD_REP_RB1_RC1] THEN STRIP_TAC THEN + MATCH_MP_TAC(SPECL [`k:num`; `s:num`; `m:num`] + INT_REPRESENTS_RB1_RC1_125_SHIFT) THEN + REPEAT CONJ_TAC THENL + [MP_TAC(ASSUME `1 <= k /\ k <= 10`) THEN ARITH_TAC; + ASM_REWRITE_TAC[]; + MAP_EVERY EXISTS_TAC [`x:int`; `y:int`; `z:int`] THEN + ASM_REWRITE_TAC[]]; + X_GEN_TAC `m:num` THEN REWRITE_TAC[INT125_CHILD_REP_RB1_RC1] THEN + DISCH_TAC THEN + MATCH_MP_TAC(SPECL [`k:num`; `m:num`] + INT_REPRESENTS_RB1_RC1_125_BASE) THEN + ASM_REWRITE_TAC[]]);; + +let INT_ALMOST_UNIVERSAL_RB1_RC2_125_REP = prove + (`(!n:num. + ~num_125_exception n + ==> ?x y z:int. + x pow 2 + &2 * y pow 2 + &5 * z pow 2 = &n) + ==> !k:num. + (k = 2 \/ k = 3 \/ k = 4 \/ k = 5 \/ + k = 6 \/ k = 8 \/ k = 9 \/ k = 10) + ==> !m:num. + 0 < m /\ ~(m = 15) + ==> int125_child_rep 1 2 k m`, + DISCH_THEN(LABEL_TAC "regular") THEN + X_GEN_TAC `k:num` THEN DISCH_THEN(LABEL_TAC "krange") THEN + SUBGOAL_THEN `2 <= k /\ k <= 10` (LABEL_TAC "bounds") THENL + [REMOVE_THEN "krange" MP_TAC THEN ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(SPECL [`1`; `2`; `k:num`; `100*k-130`] + INT_ALMOST_UNIVERSAL_125_CHILD_OF_REGULAR) THEN + REPEAT CONJ_TAC THENL + [REMOVE_THEN "regular" MATCH_ACCEPT_TAC; + MP_TAC(MATCH_MP (SPEC `k:num` NUM_RB1_RC2_125_SHIFT_COEFF) + (ASSUME `2 <= k /\ k <= 10`)) THEN MESON_TAC[]; + MP_TAC(MATCH_MP (SPEC `k:num` NUM_RB1_RC2_125_SHIFT_COEFF) + (ASSUME `2 <= k /\ k <= 10`)) THEN MESON_TAC[]; + MAP_EVERY X_GEN_TAC [`m:num`; `s:num`] THEN + REWRITE_TAC[INT125_CHILD_REP_RB1_RC2] THEN STRIP_TAC THEN + MATCH_MP_TAC(SPECL [`k:num`; `s:num`; `m:num`] + INT_REPRESENTS_RB1_RC2_125_SHIFT) THEN + REPEAT CONJ_TAC THENL + [MP_TAC(ASSUME `2 <= k /\ k <= 10`) THEN ARITH_TAC; + ASM_REWRITE_TAC[]; + MAP_EVERY EXISTS_TAC [`x:int`; `y:int`; `z:int`] THEN + ASM_REWRITE_TAC[]]; + X_GEN_TAC `m:num` THEN REWRITE_TAC[INT125_CHILD_REP_RB1_RC2] THEN + DISCH_TAC THEN + MATCH_MP_TAC(SPECL [`k:num`; `m:num`] + INT_REPRESENTS_RB1_RC2_125_BASE) THEN + ASM_REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Positive binary forms of determinant 10 have two classes. *) +(* ------------------------------------------------------------------------- *) + +let INT_DISC10_NOT_FIRST3 = prove + (`!a b:int. ~(&3 * a - b pow 2 = &10)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MP_TAC(SPECL [`b:int`; `&3:int`] INT_DIVISION) THEN + ANTS_TAC THENL [INT_ARITH_TAC; STRIP_TAC] THEN + MP_TAC(SPEC `b:int` INT_REM_3_CASES) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THENL + [SUBGOAL_THEN `&3 divides &10` MP_TAC THENL + [REWRITE_TAC[int_divides] THEN + EXISTS_TAC `a - &3 * (b div &3) pow 2` THEN + MAP_EVERY UNDISCH_TAC + [`&3 * a - b pow 2 = &10`; + `b = b div &3 * &3 + b rem &3`; + `b rem &3 = &0`] THEN + CONV_TAC INT_RING; + REWRITE_TAC[GSYM INT_REM_EQ_0] THEN CONV_TAC INT_REDUCE_CONV]; + SUBGOAL_THEN `&3 divides &11` MP_TAC THENL + [REWRITE_TAC[int_divides] THEN + EXISTS_TAC + `a - &3 * (b div &3) pow 2 - &2 * (b div &3)` THEN + MAP_EVERY UNDISCH_TAC + [`&3 * a - b pow 2 = &10`; + `b = b div &3 * &3 + b rem &3`; + `b rem &3 = &1`] THEN + CONV_TAC INT_RING; + REWRITE_TAC[GSYM INT_REM_EQ_0] THEN CONV_TAC INT_REDUCE_CONV]; + SUBGOAL_THEN `&3 divides &14` MP_TAC THENL + [REWRITE_TAC[int_divides] THEN + EXISTS_TAC + `a - &3 * (b div &3) pow 2 - &4 * (b div &3)` THEN + MAP_EVERY UNDISCH_TAC + [`&3 * a - b pow 2 = &10`; + `b = b div &3 * &3 + b rem &3`; + `b rem &3 = &2`] THEN + CONV_TAC INT_RING; + REWRITE_TAC[GSYM INT_REM_EQ_0] THEN CONV_TAC INT_REDUCE_CONV]]);; + +let BINARY_DISC10 = prove + (`!A11. &0 < A11 + ==> !A12 A22. + A11 * A22 - A12 pow 2 = &10 + ==> ((!n. + (?x y. + A11 * x pow 2 + &2 * A12 * x * y + + A22 * y pow 2 = n) + ==> ?u v:int. u pow 2 + &10 * v pow 2 = n) \/ + (!n. + (?x y. + A11 * x pow 2 + &2 * A12 * x * y + + A22 * y pow 2 = n) + ==> ?u v:int. &2 * u pow 2 + &5 * v pow 2 = n))`, + ONCE_REWRITE_TAC[MESON[] + `(!A11. &0 < A11 ==> P A11) <=> + (!m A11. num_of_int A11 = m /\ &0 < A11 ==> P A11)`] THEN + MATCH_MP_TAC num_WF THEN GEN_TAC THEN STRIP_TAC THEN + GEN_TAC THEN STRIP_TAC THEN REPEAT GEN_TAC THEN DISCH_TAC THEN + ASM_CASES_TAC `A11 = &1` THENL + [DISJ1_TAC THEN GEN_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` (X_CHOOSE_TAC `y:int`)) THEN + MAP_EVERY EXISTS_TAC [`x + A12 * y:int`; `y:int`] THEN + MP_TAC(ASSUME `A11 * A22 - A12 pow 2 = &10`) THEN + MP_TAC(ASSUME + `A11 * x pow 2 + &2 * A12 * x * y + A22 * y pow 2 = n`) THEN + REWRITE_TAC[ASSUME `A11 = &1`] THEN CONV_TAC INT_RING; + ALL_TAC] THEN + ASM_CASES_TAC `A11 = &2` THENL + [DISJ2_TAC THEN GEN_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` (X_CHOOSE_TAC `y:int`)) THEN + SUBGOAL_THEN + `&2 divides (A11 * A22 - A12 pow 2)` ASSUME_TAC THENL + [REWRITE_TAC[int_divides] THEN EXISTS_TAC `&5:int` THEN + MP_TAC(ASSUME `A11 * A22 - A12 pow 2 = &10`) THEN + CONV_TAC INT_RING; + ALL_TAC] THEN + SUBGOAL_THEN `&2 divides A12` ASSUME_TAC THENL + [UNDISCH_TAC `&2 divides (A11 * A22 - A12 pow 2)` THEN + ASM_REWRITE_TAC + [INT_2_DIVIDES_SUB; INT_2_DIVIDES_MUL; INT_2_DIVIDES_POW; + INT_DIVIDES_REFL] THEN + CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + X_CHOOSE_TAC `q:int` + (REWRITE_RULE[int_divides] (ASSUME `&2 divides A12`)) THEN + SUBGOAL_THEN `A22 = &2 * q pow 2 + &5` ASSUME_TAC THENL + [MP_TAC(ASSUME `A11 * A22 - A12 pow 2 = &10`) THEN + REWRITE_TAC[ASSUME `A11 = &2`; ASSUME `A12 = &2 * q`] THEN + CONV_TAC INT_RING; + ALL_TAC] THEN + MAP_EVERY EXISTS_TAC [`x + q * y:int`; `y:int`] THEN + MP_TAC(ASSUME + `A11 * x pow 2 + &2 * A12 * x * y + A22 * y pow 2 = n`) THEN + REWRITE_TAC + [ASSUME `A11 = &2`; ASSUME `A12 = &2 * q`; + ASSUME `A22 = &2 * q pow 2 + &5`] THEN + CONV_TAC INT_RING; + ALL_TAC] THEN + ASM_CASES_TAC `A11 = &3` THENL + [MP_TAC(ASSUME `A11 * A22 - A12 pow 2 = &10`) THEN + REWRITE_TAC[ASSUME `A11 = &3`] THEN + MESON_TAC[INT_DISC10_NOT_FIRST3]; + ALL_TAC] THEN + MP_TAC(SPECL [`A12:int`; `A11:int`] INT_BALANCED_REM) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `b:int` (LABEL_TAC "balanced")) THEN + ABBREV_TAC `r = --b:int` THEN + ABBREV_TAC `A12' = A12 + A11 * r` THEN + ABBREV_TAC `A22' = A11 * r pow 2 + &2 * A12 * r + A22` THEN + SUBGOAL_THEN `abs A12' * &2 <= A11` ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["A12'"; "r"] THEN + REMOVE_THEN "balanced" MP_TAC THEN + REWRITE_TAC[INT_ARITH + `A12 + A11 * --b = A12 - A11 * b`]; + ALL_TAC] THEN + SUBGOAL_THEN `A11 * A22' - A12' pow 2 = &10` ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["A12'"; "A22'"] THEN + UNDISCH_TAC `A11 * A22 - A12 pow 2 = &10` THEN + CONV_TAC INT_RING; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < A22'` ASSUME_TAC THENL + [SUBGOAL_THEN `&0 < A11 * A22'` MP_TAC THENL + [SUBGOAL_THEN `A11 * A22' = &10 + A12' pow 2` SUBST1_TAC THENL + [ASM_INT_ARITH_TAC; + MP_TAC(SPEC `A12':int` INT_LE_POW_2) THEN INT_ARITH_TAC]; + ASM_SIMP_TAC[INT_LT_MUL_EQ]]; + ALL_TAC] THEN + SUBGOAL_THEN `&4 <= A11` ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `&40 < &3 * A11 pow 2` ASSUME_TAC THENL + [SUBGOAL_THEN `&16 <= A11 pow 2` MP_TAC THENL + [MP_TAC(SPECL [`2`; `&4:int`; `A11:int`] INT_POW_LE2) THEN + ANTS_TAC THENL [ASM_INT_ARITH_TAC; CONV_TAC INT_REDUCE_CONV]; + INT_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN `A22' < A11` ASSUME_TAC THENL + [SUBGOAL_THEN `&4 * (A11 * A22') <= &40 + A11 pow 2` + ASSUME_TAC THENL + [SUBGOAL_THEN `A11 * A22' = &10 + A12' pow 2` + (fun th -> REWRITE_TAC[th]) THENL + [ASM_INT_ARITH_TAC; + MP_TAC(MATCH_MP SQ_BOUND + (ASSUME `abs A12' * &2 <= A11`)) THEN INT_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN `A11 * (&4 * A22') < A11 * (&4 * A11)` MP_TAC THENL + [MATCH_MP_TAC INT_LET_TRANS THEN + EXISTS_TAC `&40 + A11 pow 2` THEN + CONJ_TAC THENL + [ONCE_REWRITE_TAC[INT_RING + `A11 * (&4 * A22') = &4 * (A11 * A22')`] THEN + ASM_REWRITE_TAC[]; + ONCE_REWRITE_TAC[INT_RING + `A11 * (&4 * A11) = &4 * A11 pow 2`] THEN + ASM_INT_ARITH_TAC]; + ASM_SIMP_TAC[INT_LT_LMUL_EQ] THEN INT_ARITH_TAC]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `num_of_int A22'`) THEN + SUBGOAL_THEN `num_of_int A22' < m` ASSUME_TAC THENL + [FIRST_X_ASSUM(SUBST1_TAC o SYM o + check (fun th -> rand(concl th) = `m:num`)) THEN + REWRITE_TAC[GSYM INT_OF_NUM_LT] THEN + SUBGOAL_THEN + `&(num_of_int A22') = A22' /\ &(num_of_int A11) = A11` + (CONJUNCTS_THEN SUBST1_TAC) THENL + [CONJ_TAC THEN MATCH_MP_TAC INT_OF_NUM_OF_INT THEN ASM_INT_ARITH_TAC; + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `A22':int`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPECL [`A12':int`; `A11:int`]) THEN + ANTS_TAC THENL + [MP_TAC(ASSUME `A11 * A22' - A12' pow 2 = &10`) THEN + CONV_TAC INT_RING; + DISCH_THEN(DISJ_CASES_THEN (LABEL_TAC "class")) THENL + [DISJ1_TAC; DISJ2_TAC] THEN + X_GEN_TAC `n:int` THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` (X_CHOOSE_TAC `y:int`)) THEN + REMOVE_THEN "class" (MATCH_MP_TAC o SPEC `n:int`) THEN + MAP_EVERY EXISTS_TAC [`y:int`; `x - r * y:int`] THEN + MAP_EVERY EXPAND_TAC ["A12'"; "A22'"] THEN + UNDISCH_TAC + `A11 * x pow 2 + &2 * A12 * x * y + A22 * y pow 2 = n` THEN + CONV_TAC INT_RING]);; + +(* ------------------------------------------------------------------------- *) +(* The 2-adic type of <1,2,5>, expressed by a characteristic vector. *) +(* ------------------------------------------------------------------------- *) + +let ternary_type6 = new_definition + `ternary_type6 a11 a12 a13 a22 a23 a33 <=> + ?w1 w2 w3 q:int. + (!x1 x2 x3. + &2 divides + (tqeval a11 a12 a13 a22 a23 a33 x1 x2 x3 - + tqbilin a11 a12 a13 a22 a23 a33 x1 x2 x3 w1 w2 w3)) /\ + tqeval a11 a12 a13 a22 a23 a33 w1 w2 w3 = &8 * q + &6`;; + +let CONJ_TYPE6 = prove + (`!a11 a12 a13 a22 a23 a33 v1 v2 v3 c12 c13 c22 c23 c32 c33 + b11 b12 b13 b22 b23 b33:int. + v1 * (c22 * c33 - c23 * c32) - + c12 * (v2 * c33 - c23 * v3) + + c13 * (v2 * c32 - c22 * v3) = &1 /\ + b11 = a11 * v1 pow 2 + &2 * a12 * v1 * v2 + + &2 * a13 * v1 * v3 + a22 * v2 pow 2 + + &2 * a23 * v2 * v3 + a33 * v3 pow 2 /\ + b22 = a11 * c12 pow 2 + &2 * a12 * c12 * c22 + + &2 * a13 * c12 * c32 + a22 * c22 pow 2 + + &2 * a23 * c22 * c32 + a33 * c32 pow 2 /\ + b33 = a11 * c13 pow 2 + &2 * a12 * c13 * c23 + + &2 * a13 * c13 * c33 + a22 * c23 pow 2 + + &2 * a23 * c23 * c33 + a33 * c33 pow 2 /\ + b12 = a11 * v1 * c12 + a12 * (v1 * c22 + v2 * c12) + + a13 * (v1 * c32 + v3 * c12) + + a22 * v2 * c22 + a23 * (v2 * c32 + v3 * c22) + + a33 * v3 * c32 /\ + b13 = a11 * v1 * c13 + a12 * (v1 * c23 + v2 * c13) + + a13 * (v1 * c33 + v3 * c13) + + a22 * v2 * c23 + a23 * (v2 * c33 + v3 * c23) + + a33 * v3 * c33 /\ + b23 = a11 * c12 * c13 + a12 * (c12 * c23 + c22 * c13) + + a13 * (c12 * c33 + c32 * c13) + + a22 * c22 * c23 + a23 * (c22 * c33 + c32 * c23) + + a33 * c32 * c33 /\ + ternary_type6 a11 a12 a13 a22 a23 a33 + ==> ternary_type6 b11 b12 b13 b22 b23 b33`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o REWRITE_RULE[ternary_type6]) THEN + DISCH_THEN(X_CHOOSE_THEN `w1:int` (X_CHOOSE_THEN `w2:int` + (X_CHOOSE_THEN `w3:int` (X_CHOOSE_THEN `q:int` STRIP_ASSUME_TAC)))) THEN + MP_TAC(SPECL + [`v1:int`; `v2:int`; `v3:int`; `c12:int`; `c22:int`; `c32:int`; + `c13:int`; `c23:int`; `c33:int`; `w1:int`; `w2:int`; `w3:int`] + ADJ_PREIMAGE) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `y1:int` (X_CHOOSE_THEN `y2:int` + (X_CHOOSE_THEN `y3:int` STRIP_ASSUME_TAC))) THEN + REWRITE_TAC[ternary_type6] THEN + MAP_EVERY EXISTS_TAC [`y1:int`; `y2:int`; `y3:int`; `q:int`] THEN + CONJ_TAC THENL + [MAP_EVERY X_GEN_TAC [`z1:int`; `z2:int`; `z3:int`] THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`z1 * v1 + z2 * c12 + z3 * c13:int`; + `z1 * v2 + z2 * c22 + z3 * c23:int`; + `z1 * v3 + z2 * c32 + z3 * c33:int`] o + check (fun th -> is_forall(concl th))) THEN + REWRITE_TAC[int_divides] THEN + DISCH_THEN(X_CHOOSE_TAC `d:int`) THEN EXISTS_TAC `d:int` THEN + POP_ASSUM_LIST + (fun ths -> MAP_EVERY MP_TAC (filter (is_eq o concl) ths)) THEN + REWRITE_TAC[tqeval; tqbilin] THEN CONV_TAC INT_RING; + POP_ASSUM_LIST + (fun ths -> MAP_EVERY MP_TAC (filter (is_eq o concl) ths)) THEN + REWRITE_TAC[tqeval; tqbilin] THEN CONV_TAC INT_RING]);; + +let TERNARY_TYPE6_OF_CHARACTERISTIC = prove + (`!a11 a12 a13 a22 a23 a33 w1 w2 w3 q:int. + &2 divides (a11 - (a11 * w1 + a12 * w2 + a13 * w3)) /\ + &2 divides (a22 - (a12 * w1 + a22 * w2 + a23 * w3)) /\ + &2 divides (a33 - (a13 * w1 + a23 * w2 + a33 * w3)) /\ + tqeval a11 a12 a13 a22 a23 a33 w1 w2 w3 = &8 * q + &6 + ==> ternary_type6 a11 a12 a13 a22 a23 a33`, + REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[ternary_type6] THEN + MAP_EVERY EXISTS_TAC [`w1:int`; `w2:int`; `w3:int`; `q:int`] THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC TERNARY_CHARACTERISTIC THEN + ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Type 6 selects the <2,5> binary class after splitting off a norm 1. *) +(* ------------------------------------------------------------------------- *) + +let INT_REM_8MUL_ADD6 = prove + (`!x q:int. x = &8 * q + &6 ==> x rem &8 = &6`, + REPEAT GEN_TAC THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[CONJUNCT1(CONJUNCT2 INT_REM_MUL_ADD)] THEN + CONV_TAC INT_REDUCE_CONV);; + +let INT_ODD_SQ_SQ_10_NOT_6MOD8 = prove + (`!l u v q:int. + ~(&2 divides l) + ==> ~(l pow 2 + u pow 2 + &10 * v pow 2 = &8 * q + &6)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN `l pow 2 rem &8 = &1` ASSUME_TAC THENL + [ASM_REWRITE_TAC[ODD_SQ_MOD_8]; + ALL_TAC] THEN + MP_TAC(SPEC `u:int` SQ_MOD_8) THEN + MP_TAC(SPEC `v:int` SQ_MOD_8) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THEN + (SUBGOAL_THEN + `(l pow 2 + u pow 2 + &10 * v pow 2) rem &8 = &6` + ASSUME_TAC THENL + [MATCH_MP_TAC(SPECL + [`l pow 2 + u pow 2 + &10 * v pow 2`; `q:int`] + INT_REM_8MUL_ADD6) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `(l pow 2 + u pow 2 + &10 * v pow 2) rem &8 = + (((l pow 2 rem &8 + u pow 2 rem &8) rem &8 + + ((&10 rem &8) * (v pow 2 rem &8)) rem &8) rem &8)` + ASSUME_TAC THENL + [CONV_TAC INT_REM_DOWN_CONV THEN REWRITE_TAC[INT_ADD_ASSOC]; + ALL_TAC] THEN + MP_TAC(ASSUME + `(l pow 2 + u pow 2 + &10 * v pow 2) rem &8 = &6`) THEN + MP_TAC(ASSUME + `(l pow 2 + u pow 2 + &10 * v pow 2) rem &8 = + (((l pow 2 rem &8 + u pow 2 rem &8) rem &8 + + ((&10 rem &8) * (v pow 2 rem &8)) rem &8) rem &8)`) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC INT_REDUCE_CONV));; + +let TYPE6_DISC10_BINARY_SECOND = prove + (`!b12 b13 b22 b23 b33:int. + &0 < b22 - b12 pow 2 /\ + &1 * (b22 * b33 - b23 pow 2) - + b12 * (b12 * b33 - b23 * b13) + + b13 * (b12 * b23 - b22 * b13) = &10 /\ + ternary_type6 (&1) b12 b13 b22 b23 b33 + ==> !n. + (?x y. + (b22 - b12 pow 2) * x pow 2 + + &2 * (b23 - b12 * b13) * x * y + + (b33 - b13 pow 2) * y pow 2 = n) + ==> ?u v:int. &2 * u pow 2 + &5 * v pow 2 = n`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + ABBREV_TAC `G11 = b22 - b12 pow 2` THEN + ABBREV_TAC `G12 = b23 - b12 * b13` THEN + ABBREV_TAC `G22 = b33 - b13 pow 2` THEN + SUBGOAL_THEN `G11 * G22 - G12 pow 2 = &10` ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["G11"; "G12"; "G22"] THEN + UNDISCH_TAC + `&1 * (b22 * b33 - b23 pow 2) - + b12 * (b12 * b33 - b23 * b13) + + b13 * (b12 * b23 - b22 * b13) = &10` THEN + CONV_TAC INT_RING; + ALL_TAC] THEN + MP_TAC(SPEC `G11:int` BINARY_DISC10) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPECL [`G12:int`; `G22:int`]) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(DISJ_CASES_THEN2 + (LABEL_TAC "first") (LABEL_TAC "second")) THENL + [ALL_TAC; + REMOVE_THEN "second" MP_TAC THEN + MAP_EVERY EXPAND_TAC ["G11"; "G12"; "G22"] THEN + MESON_TAC[]] THEN + MP_TAC(REWRITE_RULE[ternary_type6] + (ASSUME `ternary_type6 (&1) b12 b13 b22 b23 b33`)) THEN + DISCH_THEN(X_CHOOSE_THEN `w1:int` (X_CHOOSE_THEN `w2:int` + (X_CHOOSE_THEN `w3:int` (X_CHOOSE_THEN `q:int` + (CONJUNCTS_THEN2 + (LABEL_TAC "characteristic") (LABEL_TAC "norm6")))))) THEN + ABBREV_TAC `l = w1 + b12 * w2 + b13 * w3` THEN + SUBGOAL_THEN `~(&2 divides l)` ASSUME_TAC THENL + [USE_THEN "characteristic" (fun th -> + MP_TAC(SPECL [`&1:int`; `&0:int`; `&0:int`] th)) THEN + SUBGOAL_THEN + `tqeval (&1) b12 b13 b22 b23 b33 (&1) (&0) (&0) - + tqbilin (&1) b12 b13 b22 b23 b33 + (&1) (&0) (&0) w1 w2 w3 = &1 - l` + (fun th -> REWRITE_TAC[th]) THENL + [EXPAND_TAC "l" THEN REWRITE_TAC[tqeval; tqbilin] THEN + CONV_TAC INT_RING; + REWRITE_TAC[INT_2_DIVIDES_SUB] THEN + SUBGOAL_THEN `~(&2 divides (&1:int))` MP_TAC THENL + [REWRITE_TAC[GSYM(CONJUNCT1 INT_REM_2_DIVIDES)] THEN + CONV_TAC INT_REDUCE_CONV; + MESON_TAC[]]]; + ALL_TAC] THEN + REMOVE_THEN "first" (MP_TAC o SPEC + `G11 * w2 pow 2 + &2 * G12 * w2 * w3 + G22 * w3 pow 2`) THEN + ANTS_TAC THENL + [MAP_EVERY EXISTS_TAC [`w2:int`; `w3:int`] THEN REFL_TAC; + DISCH_THEN(X_CHOOSE_THEN `u:int` + (X_CHOOSE_THEN `v:int` (LABEL_TAC "binary")))] THEN + SUBGOAL_THEN + `l pow 2 + u pow 2 + &10 * v pow 2 = &8 * q + &6` + ASSUME_TAC THENL + [REMOVE_THEN "norm6" MP_TAC THEN + REMOVE_THEN "binary" MP_TAC THEN + MAP_EVERY EXPAND_TAC ["l"; "G11"; "G12"; "G22"] THEN + REWRITE_TAC[tqeval] THEN CONV_TAC INT_RING; + MP_TAC(SPECL [`l:int`; `u:int`; `v:int`; `q:int`] + INT_ODD_SQ_SQ_10_NOT_6MOD8) THEN + ASM_REWRITE_TAC[]]);; + +let TERNARY_DISC10_TYPE6_A11_1 = prove + (`!a12 a13 a22 a23 a33 n:int. + &0 < &1 * a22 - a12 pow 2 /\ + &1 * (a22 * a33 - a23 pow 2) - + a12 * (a12 * a33 - a23 * a13) + + a13 * (a12 * a23 - a22 * a13) = &10 /\ + ternary_type6 (&1) a12 a13 a22 a23 a33 /\ + (?x1 x2 x3. + &1 * x1 pow 2 + a22 * x2 pow 2 + a33 * x3 pow 2 + + &2 * a12 * x1 * x2 + &2 * a13 * x1 * x3 + + &2 * a23 * x2 * x3 = n) + ==> ?u v w:int. u pow 2 + &2 * v pow 2 + &5 * w pow 2 = n`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + ABBREV_TAC `G11 = a22 - a12 pow 2` THEN + ABBREV_TAC `G12 = a23 - a12 * a13` THEN + ABBREV_TAC `G22 = a33 - a13 pow 2` THEN + SUBGOAL_THEN `&0 < G11` ASSUME_TAC THENL + [EXPAND_TAC "G11" THEN + UNDISCH_TAC `&0 < &1 * a22 - a12 pow 2` THEN + REWRITE_TAC[INT_MUL_LID]; + ALL_TAC] THEN + ABBREV_TAC `L = x1 + a12 * x2 + a13 * x3` THEN + MP_TAC(SPECL + [`a12:int`; `a13:int`; `a22:int`; `a23:int`; `a33:int`] + TYPE6_DISC10_BINARY_SECOND) THEN + ASM_REWRITE_TAC[INT_MUL_LID] THEN + DISCH_THEN(MP_TAC o SPEC `n - L pow 2`) THEN + ANTS_TAC THENL + [MAP_EVERY EXISTS_TAC [`x2:int`; `x3:int`] THEN + MP_TAC(SPECL + [`&1:int`; `a12:int`; `a13:int`; `a22:int`; `a23:int`; `a33:int`; + `x1:int`; `x2:int`; `x3:int`] TERNARY_COMPLETE) THEN + ASM_REWRITE_TAC[INT_MUL_LID] THEN + MAP_EVERY EXPAND_TAC ["G11"; "G12"; "G22"; "L"] THEN + INT_ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `v:int` (X_CHOOSE_TAC `w:int`)) THEN + MAP_EVERY EXISTS_TAC [`L:int`; `v:int`; `w:int`] THEN + UNDISCH_TAC `&2 * v pow 2 + &5 * w pow 2 = n - L pow 2` THEN + INT_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Hermite reduction at determinant 10. A minimal value is 1 or 2. *) +(* ------------------------------------------------------------------------- *) + +let CUBE_GE_27 = prove + (`!a:int. &3 <= a ==> &27 <= a pow 3`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC INT_LE_TRANS THEN EXISTS_TAC `&3 pow 3` THEN + CONJ_TAC THENL + [CONV_TAC INT_REDUCE_CONV; + MATCH_MP_TAC INT_POW_LE2 THEN ASM_INT_ARITH_TAC]);; + +let HERMITE_CUBE_DISC10 = prove + (`!a G:int. + &0 < a /\ &0 < G /\ + &3 * a pow 2 <= &4 * G /\ &3 * G pow 2 <= &4 * (&10 * a) + ==> &27 * a pow 3 <= &640`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(&3 * a pow 2) pow 2 <= (&4 * G) pow 2` MP_TAC THENL + [MATCH_MP_TAC INT_POW_LE2 THEN CONJ_TAC THENL + [MATCH_MP_TAC INT_LE_MUL THEN REWRITE_TAC[INT_LE_POW_2] THEN + INT_ARITH_TAC; + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + REWRITE_TAC[INT_POW_MUL] THEN DISCH_TAC THEN + MATCH_MP_TAC INT_LE_RCANCEL_IMP THEN EXISTS_TAC `a:int` THEN + CONJ_TAC THENL [FIRST_ASSUM ACCEPT_TAC; ALL_TAC] THEN + MATCH_MP_TAC INT_LE_TRANS THEN + EXISTS_TAC `&16 * (&3 * G pow 2)` THEN + CONJ_TAC THENL + [MP_TAC + (ASSUME `&3 pow 2 * a pow 2 pow 2 <= &4 pow 2 * G pow 2`) THEN + REWRITE_TAC[INT_ARITH `a pow 2 pow 2 = a pow 3 * a`; INT_POW_2] THEN + INT_ARITH_TAC; + MP_TAC(ASSUME `&3 * G pow 2 <= &4 * (&10 * a)`) THEN + INT_ARITH_TAC]);; + +let HERMITE_DISC10_LE2 = prove + (`!b11 b12 b13 b22 b23 b33:int. + &0 < b11 /\ + b11 * (b22 * b33 - b23 pow 2) - + b12 * (b12 * b33 - b13 * b23) + + b13 * (b12 * b23 - b13 * b22) = &10 /\ + &0 < b11 * b22 - b12 pow 2 /\ + (!x y z. ~(x = &0 /\ y = &0 /\ z = &0) + ==> b11 <= b11 * x pow 2 + b22 * y pow 2 + + b33 * z pow 2 + &2 * b12 * x * y + + &2 * b13 * x * z + &2 * b23 * y * z) + ==> b11 = &1 \/ b11 = &2`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + ABBREV_TAC `G11 = b11 * b22 - b12 pow 2` THEN + ABBREV_TAC `G12 = b11 * b23 - b12 * b13` THEN + ABBREV_TAC `G22 = b11 * b33 - b13 pow 2` THEN + SUBGOAL_THEN `G11 * G22 - G12 pow 2 = &10 * b11` ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["G11"; "G12"; "G22"] THEN + REWRITE_TAC[DISC_G] THEN + MP_TAC + (ASSUME + `b11 * (b22 * b33 - b23 pow 2) - + b12 * (b12 * b33 - b13 * b23) + + b13 * (b12 * b23 - b13 * b22) = &10`) THEN + CONV_TAC INT_RING; + ALL_TAC] THEN + MP_TAC(SPEC `&10 * b11:int` BINARY_HERMITE) THEN + ANTS_TAC THENL [ASM_INT_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `G11:int`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPECL [`G12:int`; `G22:int`]) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `s:int` + (X_CHOOSE_THEN `t:int` STRIP_ASSUME_TAC)) THEN + ABBREV_TAC + `Gst = G11 * s pow 2 + &2 * G12 * s * t + G22 * t pow 2` THEN + MP_TAC(SPECL [`b12 * s + b13 * t:int`; `b11:int`] + INT_BALANCED_REM) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `bb:int`) THEN + ABBREV_TAC `x1 = --bb:int` THEN + SUBGOAL_THEN + `&4 * (b11 * x1 + b12 * s + b13 * t) pow 2 <= b11 pow 2` + ASSUME_TAC THENL + [MP_TAC(MATCH_MP SQ_BOUND + (ASSUME + `abs ((b12 * s + b13 * t) - b11 * bb) * &2 <= b11`)) THEN + EXPAND_TAC "x1" THEN + REWRITE_TAC + [INT_ARITH + `b11 * --bb + b12 * s + b13 * t = + (b12 * s + b13 * t) - b11 * bb`] THEN + INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `&3 * b11 pow 2 <= &4 * Gst` ASSUME_TAC THENL + [MATCH_MP_TAC HERMITE_LOWER THEN + MAP_EVERY EXISTS_TAC + [`b12:int`; `b13:int`; `b22:int`; `b23:int`; `b33:int`; + `x1:int`; `s:int`; `t:int`] THEN + ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [FIRST_X_ASSUM + (fun th -> + MP_TAC(SPECL [`x1:int`; `s:int`; `t:int`] th) THEN + ANTS_TAC THENL + [UNDISCH_TAC `~(s = &0 /\ t = &0)` THEN MESON_TAC[]; + ALL_TAC] THEN + DISCH_THEN(fun th2 -> ACCEPT_TAC th2 ORELSE MP_TAC th2)); + EXPAND_TAC "Gst" THEN + MP_TAC(SPECL + [`b11:int`; `b12:int`; `b13:int`; `b22:int`; `b23:int`; + `b33:int`; `x1:int`; `s:int`; `t:int`] TERNARY_COMPLETE) THEN + MAP_EVERY (fun e -> UNDISCH_TAC e) + [`b11 * b22 - b12 pow 2 = G11`; + `b11 * b23 - b12 * b13 = G12`; + `b11 * b33 - b13 pow 2 = G22`] THEN + CONV_TAC INT_RING]; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < Gst` ASSUME_TAC THENL + [EXPAND_TAC "Gst" THEN + MP_TAC(SPECL [`G11:int`; `G12:int`; `G22:int`] + POSDEF_BINARY_CRITERION) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN ASM_INT_ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPECL [`s:int`; `t:int`]) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; REWRITE_TAC[]]; + ALL_TAC] THEN + MP_TAC(SPECL [`b11:int`; `Gst:int`] HERMITE_CUBE_DISC10) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + SUBGOAL_THEN `~(&3 <= b11)` ASSUME_TAC THENL + [DISCH_TAC THEN MP_TAC(SPEC `b11:int` CUBE_GE_27) THEN + ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `&27 * b11 pow 3 <= &640` THEN INT_ARITH_TAC; + ALL_TAC] THEN + ASM_INT_ARITH_TAC);; + +(* The binary short vector can be chosen primitive. This is the same + reduce-and-swap descent as BINARY_HERMITE, with a Bezout certificate + carried through each unimodular step. *) + +let BINARY_HERMITE_PRIMITIVE = prove + (`!D. &0 < D ==> + !A11. &0 < A11 + ==> !A12 A22. + A11 * A22 - A12 pow 2 = D + ==> ?x y. + (?p q. x * p + y * q = &1) /\ + &3 * (A11 * x pow 2 + &2 * A12 * x * y + + A22 * y pow 2) pow 2 <= &4 * D`, + GEN_TAC THEN DISCH_TAC THEN + ONCE_REWRITE_TAC[MESON[] + `(!A11. &0 < A11 ==> P A11) <=> + (!m A11. num_of_int A11 = m /\ &0 < A11 ==> P A11)`] THEN + MATCH_MP_TAC num_WF THEN GEN_TAC THEN STRIP_TAC THEN + GEN_TAC THEN STRIP_TAC THEN REPEAT GEN_TAC THEN DISCH_TAC THEN + MP_TAC(SPECL [`A12:int`; `A11:int`] INT_BALANCED_REM) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `b:int`) THEN + ABBREV_TAC `r = --b:int` THEN + ABBREV_TAC `A12' = A12 + A11 * r` THEN + ABBREV_TAC `A22' = A11 * r pow 2 + &2 * A12 * r + A22` THEN + SUBGOAL_THEN `abs A12' * &2 <= A11` ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["A12'"; "r"] THEN + UNDISCH_TAC `abs (A12 - A11 * b) * &2 <= A11` THEN + REWRITE_TAC[INT_ARITH + `A12 + A11 * --b = A12 - A11 * b`]; + ALL_TAC] THEN + SUBGOAL_THEN `A11 * A22' - A12' pow 2 = D` ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["A12'"; "A22'"] THEN + UNDISCH_TAC `A11 * A22 - A12 pow 2 = D` THEN + CONV_TAC INT_RING; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < A22'` ASSUME_TAC THENL + [SUBGOAL_THEN `&0 < A11 * A22'` MP_TAC THENL + [SUBGOAL_THEN `A11 * A22' = D + A12' pow 2` SUBST1_TAC THENL + [ASM_INT_ARITH_TAC; + MP_TAC(SPEC `A12':int` INT_LE_POW_2) THEN ASM_INT_ARITH_TAC]; + ASM_SIMP_TAC[INT_LT_MUL_EQ]]; + ALL_TAC] THEN + ASM_CASES_TAC `&3 * A11 pow 2 <= &4 * D` THENL + [MAP_EVERY EXISTS_TAC [`&1:int`; `&0:int`] THEN CONJ_TAC THENL + [MAP_EVERY EXISTS_TAC [`&1:int`; `&0:int`] THEN + CONV_TAC INT_RING; + SUBGOAL_THEN + `A11 * (&1:int) pow 2 + &2 * A12 * (&1) * (&0) + + A22 * (&0) pow 2 = A11` + SUBST1_TAC THENL + [CONV_TAC INT_RING; + FIRST_ASSUM ACCEPT_TAC]]; + ALL_TAC] THEN + SUBGOAL_THEN `A22' < A11` ASSUME_TAC THENL + [SUBGOAL_THEN `&4 * (A11 * A22') <= &4 * D + A11 pow 2` + ASSUME_TAC THENL + [SUBGOAL_THEN `A11 * A22' = D + A12' pow 2` + (fun th -> REWRITE_TAC[th]) THENL + [ASM_INT_ARITH_TAC; + MP_TAC(MATCH_MP SQ_BOUND + (ASSUME `abs A12' * &2 <= A11`)) THEN INT_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN `&4 * D < &3 * A11 pow 2` ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `A11 * (&4 * A22') < A11 * (&4 * A11)` MP_TAC THENL + [MATCH_MP_TAC INT_LET_TRANS THEN + EXISTS_TAC `&4 * D + A11 pow 2` THEN CONJ_TAC THENL + [UNDISCH_TAC `&4 * (A11 * A22') <= &4 * D + A11 pow 2` THEN + INT_ARITH_TAC; + REWRITE_TAC[INT_POW_2] THEN + UNDISCH_TAC `&4 * D < &3 * A11 pow 2` THEN + REWRITE_TAC[INT_POW_2] THEN INT_ARITH_TAC]; + ASM_SIMP_TAC[INT_LT_LMUL_EQ] THEN INT_ARITH_TAC]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `num_of_int A22'`) THEN + SUBGOAL_THEN `num_of_int A22' < m` ASSUME_TAC THENL + [FIRST_X_ASSUM(SUBST1_TAC o SYM o + check (fun th -> rand(concl th) = `m:num`)) THEN + REWRITE_TAC[GSYM INT_OF_NUM_LT] THEN + SUBGOAL_THEN + `&(num_of_int A22') = A22' /\ &(num_of_int A11) = A11` + (CONJUNCTS_THEN SUBST1_TAC) THENL + [CONJ_TAC THEN MATCH_MP_TAC INT_OF_NUM_OF_INT THEN ASM_INT_ARITH_TAC; + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `A22':int`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPECL [`A12':int`; `A11:int`]) THEN + ANTS_TAC THENL + [MP_TAC(ASSUME `A11 * A22' - A12' pow 2 = D`) THEN + CONV_TAC INT_RING; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `x':int` + (X_CHOOSE_THEN `y':int` + (CONJUNCTS_THEN2 + (X_CHOOSE_THEN `p:int` (X_CHOOSE_TAC `q:int`)) + ASSUME_TAC))) THEN + MAP_EVERY EXISTS_TAC [`y' + r * x':int`; `x':int`] THEN + CONJ_TAC THENL + [MAP_EVERY EXISTS_TAC [`q:int`; `p - r * q:int`] THEN + UNDISCH_TAC `x' * p + y' * q = &1` THEN CONV_TAC INT_RING; + SUBGOAL_THEN + `A11 * (y' + r * x') pow 2 + + &2 * A12 * (y' + r * x') * x' + A22 * x' pow 2 = + A22' * x' pow 2 + &2 * A12' * x' * y' + A11 * y' pow 2` + SUBST1_TAC THENL + [MAP_EVERY EXPAND_TAC ["A22'"; "A12'"] THEN CONV_TAC INT_RING; + ASM_REWRITE_TAC[]]]);; + +let INT_SQ_SQ_5_NOT_3MOD8 = prove + (`!x y z q:int. + ~(x pow 2 + y pow 2 + &5 * z pow 2 = &8 * q + &3)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MP_TAC(SPEC `x:int` SQ_MOD_8) THEN + MP_TAC(SPEC `y:int` SQ_MOD_8) THEN + MP_TAC(SPEC `z:int` SQ_MOD_8) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THEN + (SUBGOAL_THEN + `(x pow 2 + y pow 2 + &5 * z pow 2) rem &8 = &3` + ASSUME_TAC THENL + [MATCH_MP_TAC(SPECL + [`x pow 2 + y pow 2 + &5 * z pow 2`; `q:int`] + (prove + (`!a q:int. a = &8 * q + &3 ==> a rem &8 = &3`, + REPEAT GEN_TAC THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[CONJUNCT1(CONJUNCT2 INT_REM_MUL_ADD)] THEN + CONV_TAC INT_REDUCE_CONV))) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `(x pow 2 + y pow 2 + &5 * z pow 2) rem &8 = + (((x pow 2 rem &8 + y pow 2 rem &8) rem &8 + + ((&5 rem &8) * (z pow 2 rem &8)) rem &8) rem &8)` + ASSUME_TAC THENL + [CONV_TAC INT_REM_DOWN_CONV THEN REWRITE_TAC[INT_ADD_ASSOC]; + ALL_TAC] THEN + MP_TAC(ASSUME + `(x pow 2 + y pow 2 + &5 * z pow 2) rem &8 = &3`) THEN + MP_TAC(ASSUME + `(x pow 2 + y pow 2 + &5 * z pow 2) rem &8 = + (((x pow 2 rem &8 + y pow 2 rem &8) rem &8 + + ((&5 rem &8) * (z pow 2 rem &8)) rem &8) rem &8)`) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC INT_REDUCE_CONV));; + +(* With minimal value 2, primitive Hermite reduction produces a rank-two + Gram block of determinant 3, 4, or 5. *) + +let HERMITE_DISC10_MIN2_PAIR = prove + (`!b12 b13 b22 b23 b33:int. + &2 * (b22 * b33 - b23 pow 2) - + b12 * (b12 * b33 - b13 * b23) + + b13 * (b12 * b23 - b13 * b22) = &10 /\ + &0 < &2 * b22 - b12 pow 2 /\ + (!x y z. ~(x = &0 /\ y = &0 /\ z = &0) + ==> &2 <= &2 * x pow 2 + b22 * y pow 2 + + b33 * z pow 2 + &2 * b12 * x * y + + &2 * b13 * x * z + &2 * b23 * y * z) + ==> ?x y z. + (?p q. y * p + z * q = &1) /\ + ((&2 * x pow 2 + b22 * y pow 2 + b33 * z pow 2 + + &2 * b12 * x * y + &2 * b13 * x * z + + &2 * b23 * y * z = &2 /\ + (&2 * x + b12 * y + b13 * z) pow 2 = &1 /\ + (&2 * b22 - b12 pow 2) * y pow 2 + + &2 * (&2 * b23 - b12 * b13) * y * z + + (&2 * b33 - b13 pow 2) * z pow 2 = &3) \/ + (&2 * x pow 2 + b22 * y pow 2 + b33 * z pow 2 + + &2 * b12 * x * y + &2 * b13 * x * z + + &2 * b23 * y * z = &2 /\ + &2 * x + b12 * y + b13 * z = &0 /\ + (&2 * b22 - b12 pow 2) * y pow 2 + + &2 * (&2 * b23 - b12 * b13) * y * z + + (&2 * b33 - b13 pow 2) * z pow 2 = &4) \/ + (&2 * x pow 2 + b22 * y pow 2 + b33 * z pow 2 + + &2 * b12 * x * y + &2 * b13 * x * z + + &2 * b23 * y * z = &3 /\ + (&2 * x + b12 * y + b13 * z) pow 2 = &1 /\ + (&2 * b22 - b12 pow 2) * y pow 2 + + &2 * (&2 * b23 - b12 * b13) * y * z + + (&2 * b33 - b13 pow 2) * z pow 2 = &5))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + ABBREV_TAC `G11 = &2 * b22 - b12 pow 2` THEN + ABBREV_TAC `G12 = &2 * b23 - b12 * b13` THEN + ABBREV_TAC `G22 = &2 * b33 - b13 pow 2` THEN + SUBGOAL_THEN `G11 * G22 - G12 pow 2 = &20` ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["G11"; "G12"; "G22"] THEN + REWRITE_TAC[DISC_G] THEN + MP_TAC(ASSUME + `&2 * (b22 * b33 - b23 pow 2) - + b12 * (b12 * b33 - b13 * b23) + + b13 * (b12 * b23 - b13 * b22) = &10`) THEN + CONV_TAC INT_RING; + ALL_TAC] THEN + MP_TAC(SPEC `&20:int` BINARY_HERMITE_PRIMITIVE) THEN + CONV_TAC INT_REDUCE_CONV THEN + DISCH_THEN(MP_TAC o SPEC `G11:int`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPECL [`G12:int`; `G22:int`]) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `s:int` + (X_CHOOSE_THEN `t:int` + (CONJUNCTS_THEN2 + (X_CHOOSE_THEN `p:int` (X_CHOOSE_TAC `q:int`)) + ASSUME_TAC))) THEN + ABBREV_TAC + `Gst = G11 * s pow 2 + &2 * G12 * s * t + G22 * t pow 2` THEN + SUBGOAL_THEN `&3 * Gst pow 2 <= &4 * &20` ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(SPECL [`b12 * s + b13 * t:int`; `&2:int`] + INT_BALANCED_REM) THEN + CONV_TAC INT_REDUCE_CONV THEN + DISCH_THEN(X_CHOOSE_TAC `bb:int`) THEN + ABBREV_TAC `x1 = --bb:int` THEN + ABBREV_TAC + `Fst = &2 * x1 pow 2 + b22 * s pow 2 + b33 * t pow 2 + + &2 * b12 * x1 * s + &2 * b13 * x1 * t + + &2 * b23 * s * t` THEN + ABBREV_TAC `l = &2 * x1 + b12 * s + b13 * t` THEN + SUBGOAL_THEN `&4 * l pow 2 <= &4` ASSUME_TAC THENL + [MP_TAC(MATCH_MP SQ_BOUND + (ASSUME `abs ((b12 * s + b13 * t) - &2 * bb) * &2 <= &2`)) THEN + MAP_EVERY EXPAND_TAC ["l"; "x1"] THEN + REWRITE_TAC[INT_ARITH + `&2 * --bb + b12 * s + b13 * t = + (b12 * s + b13 * t) - &2 * bb`] THEN + INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `&2 <= Fst` ASSUME_TAC THENL + [EXPAND_TAC "Fst" THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + DISCH_TAC THEN UNDISCH_TAC `s * p + t * q = &1` THEN + ASM_REWRITE_TAC[] THEN INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `&2 * Fst = l pow 2 + Gst` ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["Fst"; "l"; "Gst"; "G11"; "G12"; "G22"] THEN + CONV_TAC INT_RING; + ALL_TAC] THEN + SUBGOAL_THEN `&3 <= Gst` ASSUME_TAC THENL + [UNDISCH_TAC `&2 <= Fst` THEN + UNDISCH_TAC `&4 * l pow 2 <= &4` THEN + UNDISCH_TAC `&2 * Fst = l pow 2 + Gst` THEN + MP_TAC(SPEC `l:int` INT_LE_POW_2) THEN INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `Gst <= &5` ASSUME_TAC THENL + [ASM_CASES_TAC `Gst <= &5` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `&36 <= Gst pow 2` ASSUME_TAC THENL + [MP_TAC(SPECL [`2`; `&6:int`; `Gst:int`] INT_POW_LE2) THEN + ANTS_TAC THENL [ASM_INT_ARITH_TAC; CONV_TAC INT_REDUCE_CONV]; + UNDISCH_TAC `&3 * Gst pow 2 <= &4 * &20` THEN + ASM_INT_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN `l pow 2 = &0 \/ l pow 2 = &1` + (LABEL_TAC "lsqcases") THENL + [UNDISCH_TAC `&4 * l pow 2 <= &4` THEN + MP_TAC(SPEC `l:int` INT_LE_POW_2) THEN INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `l = &0 \/ l pow 2 = &1` + (LABEL_TAC "lcases") THENL + [REMOVE_THEN "lsqcases" MP_TAC THEN + REWRITE_TAC[INT_POW_EQ_0] THEN CONV_TAC NUM_REDUCE_CONV THEN + MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `Fst <= &3` ASSUME_TAC THENL + [UNDISCH_TAC `Gst <= &5` THEN + UNDISCH_TAC `&4 * l pow 2 <= &4` THEN + UNDISCH_TAC `&2 * Fst = l pow 2 + Gst` THEN + INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `Fst = &2 \/ Fst = &3` + (LABEL_TAC "Fcases") THENL + [ASM_CASES_TAC `Fst = &2` THENL + [ASM_REWRITE_TAC[]; + DISJ2_TAC THEN + SUBGOAL_THEN `&2 < Fst` ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; + UNDISCH_TAC `&2 < Fst` THEN + REWRITE_TAC[INT_LT_DISCRETE] THEN ASM_INT_ARITH_TAC]]; + ALL_TAC] THEN + SUBGOAL_THEN + `(Fst = &2 /\ l pow 2 = &1 /\ Gst = &3) \/ + (Fst = &2 /\ l = &0 /\ Gst = &4) \/ + (Fst = &3 /\ l pow 2 = &1 /\ Gst = &5)` + (LABEL_TAC "shortcases") THENL + [REMOVE_THEN "lcases" (DISJ_CASES_THEN ASSUME_TAC) THEN + REMOVE_THEN "Fcases" (DISJ_CASES_THEN ASSUME_TAC) THEN + UNDISCH_TAC `&3 <= Gst` THEN UNDISCH_TAC `Gst <= &5` THEN + UNDISCH_TAC `&4 * l pow 2 <= &4` THEN + UNDISCH_TAC `&2 <= Fst` THEN + UNDISCH_TAC `&2 * Fst = l pow 2 + Gst` THEN + ASM_REWRITE_TAC[] THEN CONV_TAC INT_REDUCE_CONV THEN INT_ARITH_TAC; + ALL_TAC] THEN + MAP_EVERY EXISTS_TAC [`x1:int`; `s:int`; `t:int`] THEN + CONJ_TAC THENL + [MAP_EVERY EXISTS_TAC [`p:int`; `q:int`] THEN ASM_REWRITE_TAC[]; + REMOVE_THEN "shortcases" MP_TAC THEN + MAP_EVERY EXPAND_TAC ["Fst"; "l"; "Gst"; "G11"; "G12"; "G22"] THEN + REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* The three possible minimum-2 blocks and Dickson's congruence exclusions. *) +(* ------------------------------------------------------------------------- *) + +let DISC10_BLOCK3_EVEN_VALUE = prove + (`!l c e f n:int. + l pow 2 = &1 /\ + &2 * (&2 * f - e pow 2) - + l * (l * f - c * e) + c * (l * e - &2 * c) = &10 /\ + (?x y z. + &2 * x pow 2 + &2 * y pow 2 + f * z pow 2 + + &2 * l * x * y + &2 * c * x * z + &2 * e * y * z = n) + ==> &2 divides n`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `?h:int. f = &2 * h` STRIP_ASSUME_TAC THENL + [MP_TAC(SPEC `f:int` INT_PARITY_WITNESS) THEN + DISCH_THEN(DISJ_CASES_THEN + (X_CHOOSE_THEN `h:int` ASSUME_TAC)) THENL + [EXISTS_TAC `h:int` THEN ASM_REWRITE_TAC[]; + SUBGOAL_THEN `&2 divides (&7:int)` MP_TAC THENL + [REWRITE_TAC[int_divides] THEN + EXISTS_TAC + `&3 * h - e pow 2 + l * c * e - c pow 2` THEN + MAP_EVERY UNDISCH_TAC + [`l pow 2 = &1`; + `f = &2 * h + &1`; + `&2 * (&2 * f - e pow 2) - + l * (l * f - c * e) + c * (l * e - &2 * c) = &10`] THEN + CONV_TAC INT_RING; + REWRITE_TAC[GSYM INT_REM_EQ_0] THEN + CONV_TAC INT_REDUCE_CONV]]; + ALL_TAC] THEN + REWRITE_TAC[int_divides] THEN + EXISTS_TAC + `x pow 2 + y pow 2 + h * z pow 2 + + l * x * y + c * x * z + e * y * z:int` THEN + MAP_EVERY UNDISCH_TAC + [`f = &2 * h`; + `&2 * x pow 2 + &2 * y pow 2 + f * z pow 2 + + &2 * l * x * y + &2 * c * x * z + &2 * e * y * z = n`] THEN + CONV_TAC INT_RING);; + +let INT_BLOCK5_CANONICAL_NOT6MOD16 = prove + (`!l x y z q:int. + l pow 2 = &1 + ==> ~(&2 * x pow 2 + &3 * y pow 2 + &2 * z pow 2 + + &2 * l * x * y = &16 * q + &6)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN DISCH_TAC THEN + MP_TAC(SPEC `y:int` INT_PARITY_WITNESS) THEN + DISCH_THEN(DISJ_CASES_THEN + (X_CHOOSE_THEN `t:int` ASSUME_TAC)) THENL + [MP_TAC(SPECL [`x + l * t:int`; `z:int`; `t:int`; `q:int`] + INT_SQ_SQ_5_NOT_3MOD8) THEN + MAP_EVERY UNDISCH_TAC + [`l pow 2 = &1`; `y = &2 * t`; + `&2 * x pow 2 + &3 * y pow 2 + &2 * z pow 2 + + &2 * l * x * y = &16 * q + &6`] THEN + CONV_TAC INT_RING; + SUBGOAL_THEN `&2 divides (&3:int)` MP_TAC THENL + [REWRITE_TAC[int_divides] THEN + EXISTS_TAC + `&8 * q + &3 - x pow 2 - z pow 2 - + &3 * (&2 * t pow 2 + &2 * t) - + l * x * (&2 * t + &1):int` THEN + MAP_EVERY UNDISCH_TAC + [`y = &2 * t + &1`; + `&2 * x pow 2 + &3 * y pow 2 + &2 * z pow 2 + + &2 * l * x * y = &16 * q + &6`] THEN + CONV_TAC INT_RING; + REWRITE_TAC[GSYM INT_REM_EQ_0] THEN CONV_TAC INT_REDUCE_CONV]]);; + +let DISC10_BLOCK4_NOT6MOD16 = prove + (`!c e f q:int. + &2 * (&2 * f - e pow 2) + c * (--(&2 * c)) = &10 + ==> ~(?x y z. + &2 * x pow 2 + &2 * y pow 2 + f * z pow 2 + + &2 * c * x * z + &2 * e * y * z = &16 * q + &6)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN `&2 * f - c pow 2 - e pow 2 = &5` ASSUME_TAC THENL + [UNDISCH_TAC + `&2 * (&2 * f - e pow 2) + c * --(&2 * c) = &10` THEN + CONV_TAC INT_RING; + ALL_TAC] THEN + SUBGOAL_THEN `?h:int. f = &2 * h + &1` STRIP_ASSUME_TAC THENL + [MP_TAC(SPEC `e:int` INT_PARITY_WITNESS) THEN + MP_TAC(SPEC `c:int` INT_PARITY_WITNESS) THEN + DISCH_THEN(DISJ_CASES_THEN + (X_CHOOSE_THEN `C:int` ASSUME_TAC)) THEN + DISCH_THEN(DISJ_CASES_THEN + (X_CHOOSE_THEN `E:int` ASSUME_TAC)) THENL + [SUBGOAL_THEN `&2 divides (&5:int)` MP_TAC THENL + [REWRITE_TAC[int_divides] THEN + EXISTS_TAC + `f - &2 * C pow 2 - &2 * E pow 2` THEN + MAP_EVERY UNDISCH_TAC + [`c = &2 * C`; `e = &2 * E`; + `&2 * f - c pow 2 - e pow 2 = &5`] THEN + CONV_TAC INT_RING; + REWRITE_TAC[GSYM INT_REM_EQ_0] THEN + CONV_TAC INT_REDUCE_CONV]; + EXISTS_TAC `C pow 2 + E pow 2 + E + &1:int` THEN + MAP_EVERY UNDISCH_TAC + [`c = &2 * C`; `e = &2 * E + &1`; + `&2 * f - c pow 2 - e pow 2 = &5`] THEN + CONV_TAC INT_RING; + EXISTS_TAC `C pow 2 + C + E pow 2 + &1:int` THEN + MAP_EVERY UNDISCH_TAC + [`c = &2 * C + &1`; `e = &2 * E`; + `&2 * f - c pow 2 - e pow 2 = &5`] THEN + CONV_TAC INT_RING; + SUBGOAL_THEN `&2 divides (&5:int)` MP_TAC THENL + [REWRITE_TAC[int_divides] THEN + EXISTS_TAC + `f - (&2 * C pow 2 + &2 * C) - + (&2 * E pow 2 + &2 * E) - &1:int` THEN + MAP_EVERY UNDISCH_TAC + [`c = &2 * C + &1`; `e = &2 * E + &1`; + `&2 * f - c pow 2 - e pow 2 = &5`] THEN + CONV_TAC INT_RING; + REWRITE_TAC[GSYM INT_REM_EQ_0] THEN + CONV_TAC INT_REDUCE_CONV]]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` (X_CHOOSE_THEN `z:int` ASSUME_TAC))) THEN + MP_TAC(SPEC `z:int` INT_PARITY_WITNESS) THEN + DISCH_THEN(DISJ_CASES_THEN + (X_CHOOSE_THEN `Z:int` ASSUME_TAC)) THENL + [MP_TAC(SPECL + [`x + c * Z:int`; `y + e * Z:int`; `Z:int`; `q:int`] + INT_SQ_SQ_5_NOT_3MOD8) THEN + MAP_EVERY UNDISCH_TAC + [`&2 * f - c pow 2 - e pow 2 = &5`; + `z = &2 * Z`; + `&2 * x pow 2 + &2 * y pow 2 + f * z pow 2 + + &2 * c * x * z + &2 * e * y * z = &16 * q + &6`] THEN + CONV_TAC INT_RING; + SUBGOAL_THEN `&2 divides (&1:int)` MP_TAC THENL + [REWRITE_TAC[int_divides] THEN + EXISTS_TAC + `&8 * q + &3 - x pow 2 - y pow 2 - + h * z pow 2 - c * x * z - e * y * z - + (&2 * Z pow 2 + &2 * Z):int` THEN + MAP_EVERY UNDISCH_TAC + [`f = &2 * h + &1`; `z = &2 * Z + &1`; + `&2 * x pow 2 + &2 * y pow 2 + f * z pow 2 + + &2 * c * x * z + &2 * e * y * z = &16 * q + &6`] THEN + CONV_TAC INT_RING; + REWRITE_TAC[INT_DIVIDES_ONE] THEN INT_ARITH_TAC]]);; + +let DISC10_BLOCK5_NOT6MOD16 = prove + (`!l c e f q:int. + l pow 2 = &1 /\ + &2 * (&3 * f - e pow 2) - + l * (l * f - c * e) + c * (l * e - &3 * c) = &10 + ==> ~(?x y z. + &2 * x pow 2 + &3 * y pow 2 + f * z pow 2 + + &2 * l * x * y + &2 * c * x * z + + &2 * e * y * z = &16 * q + &6)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + ABBREV_TAC `r = l * c - &2 * e` THEN + ABBREV_TAC `A = &3 * c pow 2 - &2 * l * c * e + &2 * e pow 2` THEN + SUBGOAL_THEN `A = &5 * (f - &2)` ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["A"] THEN + MAP_EVERY UNDISCH_TAC + [`l pow 2 = &1`; + `&2 * (&3 * f - e pow 2) - + l * (l * f - c * e) + c * (l * e - &3 * c) = &10`] THEN + CONV_TAC INT_RING; + ALL_TAC] THEN + SUBGOAL_THEN `&5 divides (&3 * r pow 2)` ASSUME_TAC THENL + [REWRITE_TAC[int_divides] THEN + EXISTS_TAC `(f - &2) + &2 * e * (e - l * c):int` THEN + EXPAND_TAC "r" THEN + MAP_EVERY UNDISCH_TAC + [`l pow 2 = &1`; `A = &5 * (f - &2)`] THEN + EXPAND_TAC "A" THEN + CONV_TAC INT_RING; + ALL_TAC] THEN + SUBGOAL_THEN `int_prime(&5)` ASSUME_TAC THENL + [REWRITE_TAC[INT_PRIME] THEN + ACCEPT_TAC(EQT_ELIM(PRIME_CONV `prime 5`)); + ALL_TAC] THEN + SUBGOAL_THEN `&5 divides r` ASSUME_TAC THENL + [MP_TAC(MATCH_MP (SPECL [`&5:int`; `&3:int`; `r pow 2`] + INT_PRIME_DIVPROD) + (CONJ (ASSUME `int_prime(&5)`) + (ASSUME `&5 divides (&3 * r pow 2)`))) THEN + DISCH_THEN(DISJ_CASES_THEN ASSUME_TAC) THENL + [UNDISCH_TAC `&5 divides (&3:int)` THEN + REWRITE_TAC[GSYM INT_REM_EQ_0] THEN CONV_TAC INT_REDUCE_CONV; + MATCH_MP_TAC(SPECL [`2`; `&5:int`; `r:int`] INT_PRIME_DIVPOW) THEN + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN `&5 divides (--(&3 * c) + l * e)` ASSUME_TAC THENL + [REWRITE_TAC[int_divides] THEN + X_CHOOSE_TAC `R:int` + (REWRITE_RULE[int_divides] (ASSUME `&5 divides r`)) THEN + EXISTS_TAC `--(&3 * l * R) - l * e:int` THEN + MAP_EVERY UNDISCH_TAC + [`l pow 2 = &1`; `l * c - &2 * e = r`; `r = &5 * R`] THEN + CONV_TAC INT_RING; + ALL_TAC] THEN + X_CHOOSE_TAC `P:int` + (REWRITE_RULE[int_divides] + (ASSUME `&5 divides (--(&3 * c) + l * e)`)) THEN + X_CHOOSE_TAC `Q:int` + (REWRITE_RULE[int_divides] (ASSUME `&5 divides r`)) THEN + SUBGOAL_THEN + `&2 * P + l * Q = --c /\ l * P + &3 * Q = --e` + STRIP_ASSUME_TAC THENL + [MAP_EVERY UNDISCH_TAC + [`l pow 2 = &1`; + `--(&3 * c) + l * e = &5 * P`; + `l * c - &2 * e = r`; `r = &5 * Q`] THEN + CONV_TAC INT_RING; + ALL_TAC] THEN + ABBREV_TAC + `f' = &2 * P pow 2 + &3 * Q pow 2 + f + + &2 * l * P * Q + &2 * c * P + &2 * e * Q` THEN + SUBGOAL_THEN `f' = &2` ASSUME_TAC THENL + [SUBGOAL_THEN `&5 * f' = &10` MP_TAC THENL + [MAP_EVERY EXPAND_TAC ["f'"] THEN + MAP_EVERY UNDISCH_TAC + [`l pow 2 = &1`; + `&2 * (&3 * f - e pow 2) - + l * (l * f - c * e) + c * (l * e - &3 * c) = &10`; + `&2 * P + l * Q = --c`; + `l * P + &3 * Q = --e`] THEN + CONV_TAC INT_RING; + INT_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN + `&2 * P pow 2 + &3 * Q pow 2 + &2 * l * P * Q + &2 = f` + (LABEL_TAC "fcoeff") THENL + [UNDISCH_TAC `f' = &2` THEN EXPAND_TAC "f'" THEN + MAP_EVERY UNDISCH_TAC + [`&2 * P + l * Q = --c`; `l * P + &3 * Q = --e`] THEN + CONV_TAC INT_RING; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` (X_CHOOSE_THEN `z:int` ASSUME_TAC))) THEN + SUBGOAL_THEN + `&2 * (x - P * z) pow 2 + &3 * (y - Q * z) pow 2 + + &2 * z pow 2 + &2 * l * (x - P * z) * (y - Q * z) = + &2 * x pow 2 + &3 * y pow 2 + f * z pow 2 + + &2 * l * x * y + &2 * c * x * z + &2 * e * y * z` + ASSUME_TAC THENL + [TRANS_TAC EQ_TRANS + `&2 * x pow 2 + &3 * y pow 2 + &2 * l * x * y + + &2 * --(&2 * P + l * Q) * x * z + + &2 * --(l * P + &3 * Q) * y * z + + (&2 * P pow 2 + &3 * Q pow 2 + &2 * l * P * Q + &2) * + z pow 2` THEN + CONJ_TAC THENL + [CONV_TAC INT_RING; + REWRITE_TAC + [ASSUME `&2 * P + l * Q = --c`; + ASSUME `l * P + &3 * Q = --e`; + ASSUME + `&2 * P pow 2 + &3 * Q pow 2 + &2 * l * P * Q + &2 = f`] THEN + CONV_TAC INT_RING]; + ALL_TAC] THEN + MP_TAC(SPECL + [`l:int`; `x - P * z:int`; `y - Q * z:int`; `z:int`; `q:int`] + INT_BLOCK5_CANONICAL_NOT6MOD16) THEN + ASM_REWRITE_TAC[]);; + +let DISC10_MIN2_EXCLUDED = prove + (`!b12 b13 b22 b23 b33 a m:int. + &2 * (b22 * b33 - b23 pow 2) - + b12 * (b12 * b33 - b13 * b23) + + b13 * (b12 * b23 - b13 * b22) = &10 /\ + &0 < &2 * b22 - b12 pow 2 /\ + (!x y z. ~(x = &0 /\ y = &0 /\ z = &0) + ==> &2 <= &2 * x pow 2 + b22 * y pow 2 + + b33 * z pow 2 + &2 * b12 * x * y + + &2 * b13 * x * z + &2 * b23 * y * z) /\ + ~(&2 divides a) /\ + (?x y z. + &2 * x pow 2 + b22 * y pow 2 + b33 * z pow 2 + + &2 * b12 * x * y + &2 * b13 * x * z + + &2 * b23 * y * z = a) /\ + (?x y z. + &2 * x pow 2 + b22 * y pow 2 + b33 * z pow 2 + + &2 * b12 * x * y + &2 * b13 * x * z + + &2 * b23 * y * z = &16 * m + &6) + ==> F`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(SPECL + [`b12:int`; `b13:int`; `b22:int`; `b23:int`; `b33:int`] + HERMITE_DISC10_MIN2_PAIR) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `r:int` + (X_CHOOSE_THEN `s:int` + (X_CHOOSE_THEN `t:int` + (CONJUNCTS_THEN2 + (X_CHOOSE_THEN `p:int` (X_CHOOSE_TAC `q:int`)) + (LABEL_TAC "cases"))))) THEN + ABBREV_TAC `l = &2 * r + b12 * s + b13 * t` THEN + ABBREV_TAC + `d = &2 * r pow 2 + b22 * s pow 2 + b33 * t pow 2 + + &2 * b12 * r * s + &2 * b13 * r * t + + &2 * b23 * s * t` THEN + ABBREV_TAC `c = --(b12 * q) + b13 * p` THEN + ABBREV_TAC + `e = --(b12 * r * q) + b13 * r * p - b22 * s * q + + b23 * s * p - b23 * t * q + b33 * t * p` THEN + ABBREV_TAC + `f = b22 * q pow 2 + b33 * p pow 2 - &2 * b23 * p * q` THEN + SUBGOAL_THEN + `&2 * (d * f - e pow 2) - + l * (l * f - c * e) + c * (l * e - d * c) = &10` + ASSUME_TAC THENL + [TRANS_TAC EQ_TRANS + `(&2 * (b22 * b33 - b23 pow 2) - + b12 * (b12 * b33 - b13 * b23) + + b13 * (b12 * b23 - b13 * b22)) * + (s * p + t * q) pow 2` THEN + CONJ_TAC THENL + [REWRITE_TAC + [GSYM(ASSUME `&2 * r + b12 * s + b13 * t = l`); + GSYM(ASSUME + `&2 * r pow 2 + b22 * s pow 2 + b33 * t pow 2 + + &2 * b12 * r * s + &2 * b13 * r * t + + &2 * b23 * s * t = d`); + GSYM(ASSUME `--(b12 * q) + b13 * p = c`); + GSYM(ASSUME + `--(b12 * r * q) + b13 * r * p - b22 * s * q + + b23 * s * p - b23 * t * q + b33 * t * p = e`); + GSYM(ASSUME + `b22 * q pow 2 + b33 * p pow 2 - &2 * b23 * p * q = f`)] THEN + CONV_TAC INT_RING; + REWRITE_TAC + [ASSUME + `&2 * (b22 * b33 - b23 pow 2) - + b12 * (b12 * b33 - b13 * b23) + + b13 * (b12 * b23 - b13 * b22) = &10`; + ASSUME `s * p + t * q = &1`] THEN + CONV_TAC INT_REDUCE_CONV]; + ALL_TAC] THEN + SUBGOAL_THEN + `!n:int. + (?x y z. + &2 * x pow 2 + b22 * y pow 2 + b33 * z pow 2 + + &2 * b12 * x * y + &2 * b13 * x * z + + &2 * b23 * y * z = n) + ==> ?x y z. + &2 * x pow 2 + d * y pow 2 + f * z pow 2 + + &2 * l * x * y + &2 * c * x * z + + &2 * e * y * z = n` + ASSUME_TAC THENL + [X_GEN_TAC `n:int` THEN DISCH_TAC THEN + MATCH_MP_TAC CONJ_REPS THEN + MAP_EVERY EXISTS_TAC + [`&2:int`; `b12:int`; `b13:int`; `b22:int`; `b23:int`; `b33:int`; + `&1:int`; `&0:int`; `&0:int`; + `r:int`; `&0:int`; `s:int`; `--q:int`; `t:int`; `p:int`] THEN + REPEAT CONJ_TAC THENL + [UNDISCH_TAC `s * p + t * q = &1` THEN CONV_TAC INT_RING; + CONV_TAC INT_RING; + EXPAND_TAC "d" THEN CONV_TAC INT_RING; + EXPAND_TAC "f" THEN CONV_TAC INT_RING; + EXPAND_TAC "l" THEN CONV_TAC INT_RING; + EXPAND_TAC "c" THEN CONV_TAC INT_RING; + EXPAND_TAC "e" THEN CONV_TAC INT_RING; + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + MP_TAC(MATCH_MP + (SPEC `a:int` + (ASSUME + `!n:int. + (?x y z. + &2 * x pow 2 + b22 * y pow 2 + b33 * z pow 2 + + &2 * b12 * x * y + &2 * b13 * x * z + + &2 * b23 * y * z = n) + ==> ?x y z. + &2 * x pow 2 + d * y pow 2 + f * z pow 2 + + &2 * l * x * y + &2 * c * x * z + + &2 * e * y * z = n`)) + (ASSUME + `?x y z. + &2 * x pow 2 + b22 * y pow 2 + b33 * z pow 2 + + &2 * b12 * x * y + &2 * b13 * x * z + + &2 * b23 * y * z = a`)) THEN + DISCH_THEN(LABEL_TAC "oddrep") THEN + MP_TAC(MATCH_MP + (SPEC `&16 * m + &6` + (ASSUME + `!n:int. + (?x y z. + &2 * x pow 2 + b22 * y pow 2 + b33 * z pow 2 + + &2 * b12 * x * y + &2 * b13 * x * z + + &2 * b23 * y * z = n) + ==> ?x y z. + &2 * x pow 2 + d * y pow 2 + f * z pow 2 + + &2 * l * x * y + &2 * c * x * z + + &2 * e * y * z = n`)) + (ASSUME + `?x y z. + &2 * x pow 2 + b22 * y pow 2 + b33 * z pow 2 + + &2 * b12 * x * y + &2 * b13 * x * z + + &2 * b23 * y * z = &16 * m + &6`)) THEN + DISCH_THEN(LABEL_TAC "sixrep") THEN + REMOVE_THEN "cases" + (REPEAT_TCL DISJ_CASES_THEN STRIP_ASSUME_TAC) THENL + [SUBGOAL_THEN `d = &2 /\ l pow 2 = &1` STRIP_ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["d"; "l"] THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `&2 divides a` MP_TAC THENL + [MATCH_MP_TAC(SPECL [`l:int`; `c:int`; `e:int`; `f:int`; `a:int`] + DISC10_BLOCK3_EVEN_VALUE) THEN + REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + UNDISCH_TAC + `&2 * (d * f - e pow 2) - + l * (l * f - c * e) + c * (l * e - d * c) = &10` THEN + ASM_REWRITE_TAC[]; + REMOVE_THEN "oddrep" + (fun th -> MP_TAC th THEN ASM_REWRITE_TAC[])]; + ASM_REWRITE_TAC[]]; + SUBGOAL_THEN `d = &2 /\ l = &0` STRIP_ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["d"; "l"] THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `&2 * (&2 * f - e pow 2) + c * --(&2 * c) = &10` + ASSUME_TAC THENL + [UNDISCH_TAC + `&2 * (d * f - e pow 2) - + l * (l * f - c * e) + c * (l * e - d * c) = &10` THEN + ASM_REWRITE_TAC[] THEN CONV_TAC INT_RING; + MP_TAC(MATCH_MP + (SPECL [`c:int`; `e:int`; `f:int`; `m:int`] + DISC10_BLOCK4_NOT6MOD16) + (ASSUME `&2 * (&2 * f - e pow 2) + c * --(&2 * c) = &10`)) THEN + REMOVE_THEN "sixrep" + (fun th -> + MP_TAC th THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[INT_MUL_RZERO; INT_MUL_LZERO; INT_ADD_LID])]; + SUBGOAL_THEN `d = &3 /\ l pow 2 = &1` STRIP_ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["d"; "l"] THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `&2 * (&3 * f - e pow 2) - + l * (l * f - c * e) + c * (l * e - &3 * c) = &10` + ASSUME_TAC THENL + [UNDISCH_TAC + `&2 * (d * f - e pow 2) - + l * (l * f - c * e) + c * (l * e - d * c) = &10` THEN + ASM_REWRITE_TAC[]; + MP_TAC(MATCH_MP + (SPECL [`l:int`; `c:int`; `e:int`; `f:int`; `m:int`] + DISC10_BLOCK5_NOT6MOD16) + (CONJ (ASSUME `l pow 2 = &1`) + (ASSUME + `&2 * (&3 * f - e pow 2) - + l * (l * f - c * e) + c * (l * e - &3 * c) = &10`))) THEN + REMOVE_THEN "sixrep" + (fun th -> MP_TAC th THEN ASM_REWRITE_TAC[])]]);; + +let TERNARY_DISC10_TYPE6_SPECIAL = prove + (`!a11 a12 a13 a22 a23 a33 a m n:int. + &0 < a11 /\ + &0 < a11 * a22 - a12 pow 2 /\ + a11 * (a22 * a33 - a23 pow 2) - + a12 * (a12 * a33 - a13 * a23) + + a13 * (a12 * a23 - a13 * a22) = &10 /\ + ternary_type6 a11 a12 a13 a22 a23 a33 /\ + ~(&2 divides a) /\ + (?x y z. + a11 * x pow 2 + a22 * y pow 2 + a33 * z pow 2 + + &2 * a12 * x * y + &2 * a13 * x * z + + &2 * a23 * y * z = a) /\ + (?x y z. + a11 * x pow 2 + a22 * y pow 2 + a33 * z pow 2 + + &2 * a12 * x * y + &2 * a13 * x * z + + &2 * a23 * y * z = &16 * m + &6) /\ + (?x y z. + a11 * x pow 2 + a22 * y pow 2 + a33 * z pow 2 + + &2 * a12 * x * y + &2 * a13 * x * z + + &2 * a23 * y * z = n) + ==> ?u v w:int. u pow 2 + &2 * v pow 2 + &5 * w pow 2 = n`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN + `!x y z. ~(x = &0 /\ y = &0 /\ z = &0) + ==> &0 < a11 * x pow 2 + a22 * y pow 2 + a33 * z pow 2 + + &2 * a12 * x * y + &2 * a13 * x * z + + &2 * a23 * y * z` + (LABEL_TAC "posdef") THENL + [MATCH_MP_TAC TERNARY_POSDEF THEN ASM_REWRITE_TAC[] THEN + ASM_INT_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(SPECL + [`a11:int`; `a12:int`; `a13:int`; `a22:int`; `a23:int`; `a33:int`] + TERNARY_MIN) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `v1:int` + (X_CHOOSE_THEN `v2:int` + (X_CHOOSE_THEN `v3:int` + (CONJUNCTS_THEN2 (LABEL_TAC "vnonzero") + (LABEL_TAC "amin"))))) THEN + SUBGOAL_THEN `?p q r. v1 * p + v2 * q + v3 * r = &1` + STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC MIN_PRIMITIVE THEN + MAP_EVERY EXISTS_TAC + [`a11:int`; `a12:int`; `a13:int`; `a22:int`; `a23:int`; `a33:int`] THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MP_TAC(SPECL [`v1:int`; `v2:int`; `v3:int`] SL3_EXTEND) THEN + ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `c12:int` + (X_CHOOSE_THEN `c13:int` + (X_CHOOSE_THEN `c22:int` + (X_CHOOSE_THEN `c23:int` + (X_CHOOSE_THEN `c32:int` + (X_CHOOSE_THEN `c33:int` (LABEL_TAC "detU"))))))) THEN + ABBREV_TAC + `b11 = a11 * v1 pow 2 + &2 * a12 * v1 * v2 + + &2 * a13 * v1 * v3 + a22 * v2 pow 2 + + &2 * a23 * v2 * v3 + a33 * v3 pow 2` THEN + ABBREV_TAC + `b22 = a11 * c12 pow 2 + &2 * a12 * c12 * c22 + + &2 * a13 * c12 * c32 + a22 * c22 pow 2 + + &2 * a23 * c22 * c32 + a33 * c32 pow 2` THEN + ABBREV_TAC + `b33 = a11 * c13 pow 2 + &2 * a12 * c13 * c23 + + &2 * a13 * c13 * c33 + a22 * c23 pow 2 + + &2 * a23 * c23 * c33 + a33 * c33 pow 2` THEN + ABBREV_TAC + `b12 = a11 * v1 * c12 + a12 * (v1 * c22 + v2 * c12) + + a13 * (v1 * c32 + v3 * c12) + a22 * v2 * c22 + + a23 * (v2 * c32 + v3 * c22) + a33 * v3 * c32` THEN + ABBREV_TAC + `b13 = a11 * v1 * c13 + a12 * (v1 * c23 + v2 * c13) + + a13 * (v1 * c33 + v3 * c13) + a22 * v2 * c23 + + a23 * (v2 * c33 + v3 * c23) + a33 * v3 * c33` THEN + ABBREV_TAC + `b23 = a11 * c12 * c13 + a12 * (c12 * c23 + c22 * c13) + + a13 * (c12 * c33 + c32 * c13) + a22 * c22 * c23 + + a23 * (c22 * c33 + c32 * c23) + a33 * c32 * c33` THEN + SUBGOAL_THEN + `!x y z. ~(x = &0 /\ y = &0 /\ z = &0) + ==> b11 <= b11 * x pow 2 + b22 * y pow 2 + + b33 * z pow 2 + &2 * b12 * x * y + + &2 * b13 * x * z + &2 * b23 * y * z` + (LABEL_TAC "bmin") THENL + [MATCH_MP_TAC CONJ_MIN THEN + MAP_EVERY EXISTS_TAC + [`a11:int`; `a12:int`; `a13:int`; `a22:int`; `a23:int`; `a33:int`; + `v1:int`; `v2:int`; `v3:int`; `c12:int`; `c13:int`; + `c22:int`; `c23:int`; `c32:int`; `c33:int`] THEN + ASM_REWRITE_TAC[] THEN + MAP_EVERY EXPAND_TAC ["b11"; "b12"; "b13"; "b22"; "b23"; "b33"]; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < b11` ASSUME_TAC THENL + [MP_TAC(MATCH_MP + (SPECL [`v1:int`; `v2:int`; `v3:int`] + (ASSUME + `!x y z. ~(x = &0 /\ y = &0 /\ z = &0) + ==> &0 < a11 * x pow 2 + a22 * y pow 2 + + a33 * z pow 2 + &2 * a12 * x * y + + &2 * a13 * x * z + &2 * a23 * y * z`)) + (ASSUME `~(v1 = &0 /\ v2 = &0 /\ v3 = &0)`)) THEN + EXPAND_TAC "b11" THEN INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `b11 * (b22 * b33 - b23 pow 2) - + b12 * (b12 * b33 - b13 * b23) + + b13 * (b12 * b23 - b13 * b22) = &10` + (LABEL_TAC "bdet") THENL + [TRANS_TAC EQ_TRANS + `(a11 * (a22 * a33 - a23 pow 2) - + a12 * (a12 * a33 - a13 * a23) + + a13 * (a12 * a23 - a13 * a22)) * + (v1 * (c22 * c33 - c23 * c32) - + c12 * (v2 * c33 - c23 * v3) + + c13 * (v2 * c32 - c22 * v3)) pow 2` THEN + CONJ_TAC THENL + [MAP_EVERY EXPAND_TAC + ["b11"; "b12"; "b13"; "b22"; "b23"; "b33"] THEN + CONV_TAC INT_RING; + USE_THEN "detU" (fun th -> REWRITE_TAC[th]) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC INT_REDUCE_CONV]; + ALL_TAC] THEN + SUBGOAL_THEN + `!x y z. ~(x = &0 /\ y = &0 /\ z = &0) + ==> &0 < b11 * x pow 2 + b22 * y pow 2 + + b33 * z pow 2 + &2 * b12 * x * y + + &2 * b13 * x * z + &2 * b23 * y * z` + (LABEL_TAC "bposdef") THENL + [REPEAT STRIP_TAC THEN + MATCH_MP_TAC INT_LTE_TRANS THEN EXISTS_TAC `b11:int` THEN + ASM_REWRITE_TAC[] THEN USE_THEN "bmin" MATCH_MP_TAC THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < b11 * b22 - b12 pow 2` + (LABEL_TAC "bminor") THENL + [MATCH_MP_TAC POSDEF_MINOR2 THEN + MAP_EVERY EXISTS_TAC [`b13:int`; `b23:int`; `b33:int`] THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `ternary_type6 b11 b12 b13 b22 b23 b33` + (LABEL_TAC "btype6") THENL + [MATCH_MP_TAC CONJ_TYPE6 THEN + MAP_EVERY EXISTS_TAC + [`a11:int`; `a12:int`; `a13:int`; `a22:int`; `a23:int`; `a33:int`; + `v1:int`; `v2:int`; `v3:int`; `c12:int`; `c13:int`; + `c22:int`; `c23:int`; `c32:int`; `c33:int`] THEN + ASM_REWRITE_TAC[] THEN + MAP_EVERY EXPAND_TAC ["b11"; "b12"; "b13"; "b22"; "b23"; "b33"]; + ALL_TAC] THEN + SUBGOAL_THEN + `!r:int. + (?x y z. + a11 * x pow 2 + a22 * y pow 2 + a33 * z pow 2 + + &2 * a12 * x * y + &2 * a13 * x * z + + &2 * a23 * y * z = r) + ==> ?x y z. + b11 * x pow 2 + b22 * y pow 2 + b33 * z pow 2 + + &2 * b12 * x * y + &2 * b13 * x * z + + &2 * b23 * y * z = r` + (LABEL_TAC "transfer") THENL + [X_GEN_TAC `r0:int` THEN DISCH_TAC THEN + MATCH_MP_TAC CONJ_REPS THEN + MAP_EVERY EXISTS_TAC + [`a11:int`; `a12:int`; `a13:int`; `a22:int`; `a23:int`; `a33:int`; + `v1:int`; `v2:int`; `v3:int`; `c12:int`; `c13:int`; + `c22:int`; `c23:int`; `c32:int`; `c33:int`] THEN + ASM_REWRITE_TAC[] THEN + MAP_EVERY EXPAND_TAC ["b11"; "b12"; "b13"; "b22"; "b23"; "b33"]; + ALL_TAC] THEN + SUBGOAL_THEN + `?x y z. + a11 * x pow 2 + a22 * y pow 2 + a33 * z pow 2 + + &2 * a12 * x * y + &2 * a13 * x * z + + &2 * a23 * y * z = a` + (LABEL_TAC "arep") THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `?x y z. + a11 * x pow 2 + a22 * y pow 2 + a33 * z pow 2 + + &2 * a12 * x * y + &2 * a13 * x * z + + &2 * a23 * y * z = &16 * m + &6` + (LABEL_TAC "a6rep") THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `?x y z. + a11 * x pow 2 + a22 * y pow 2 + a33 * z pow 2 + + &2 * a12 * x * y + &2 * a13 * x * z + + &2 * a23 * y * z = n` + (LABEL_TAC "anrep") THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + USE_THEN "transfer" (fun tr -> + USE_THEN "arep" (fun th -> MP_TAC(MATCH_MP (SPEC `a:int` tr) th))) THEN + DISCH_THEN(LABEL_TAC "barep") THEN + USE_THEN "transfer" (fun tr -> + USE_THEN "a6rep" + (fun th -> MP_TAC(MATCH_MP (SPEC `&16 * m + &6` tr) th))) THEN + DISCH_THEN(LABEL_TAC "b6rep") THEN + USE_THEN "transfer" (fun tr -> + USE_THEN "anrep" (fun th -> MP_TAC(MATCH_MP (SPEC `n:int` tr) th))) THEN + DISCH_THEN(LABEL_TAC "bnrep") THEN + MP_TAC(SPECL + [`b11:int`; `b12:int`; `b13:int`; `b22:int`; `b23:int`; `b33:int`] + HERMITE_DISC10_LE2) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(DISJ_CASES_THEN ASSUME_TAC) THENL + [MATCH_MP_TAC TERNARY_DISC10_TYPE6_A11_1 THEN + MAP_EVERY EXISTS_TAC + [`b12:int`; `b13:int`; `b22:int`; `b23:int`; `b33:int`] THEN + REPEAT CONJ_TAC THENL + [REMOVE_THEN "bminor" + (fun th -> MP_TAC th THEN ASM_REWRITE_TAC[INT_MUL_LID]); + REMOVE_THEN "bdet" + (fun th -> + MP_TAC th THEN ASM_REWRITE_TAC[INT_MUL_LID] THEN + CONV_TAC INT_RING); + REMOVE_THEN "btype6" (fun th -> MP_TAC th THEN ASM_REWRITE_TAC[]); + REMOVE_THEN "bnrep" + (fun th -> MP_TAC th THEN ASM_REWRITE_TAC[INT_MUL_LID])]; + SUBGOAL_THEN `F` MP_TAC THENL + [MATCH_MP_TAC(SPECL + [`b12:int`; `b13:int`; `b22:int`; `b23:int`; `b33:int`; + `a:int`; `m:int`] DISC10_MIN2_EXCLUDED) THEN + REPEAT CONJ_TAC THENL + [REMOVE_THEN "bdet" + (fun th -> MP_TAC th THEN ASM_REWRITE_TAC[] THEN + CONV_TAC INT_RING); + REMOVE_THEN "bminor" + (fun th -> MP_TAC th THEN ASM_REWRITE_TAC[]); + REMOVE_THEN "bmin" + (fun th -> MP_TAC th THEN ASM_REWRITE_TAC[]); + ASM_REWRITE_TAC[]; + REMOVE_THEN "barep" + (fun th -> MP_TAC th THEN ASM_REWRITE_TAC[]); + REMOVE_THEN "b6rep" + (fun th -> MP_TAC th THEN ASM_REWRITE_TAC[])]; + MESON_TAC[]]]);; + +(* Dickson's constructed form has coefficients + [a,0,1; 2 beta,4t; 8h]. + The characteristic vector (0,1,1) gives its type at 2. *) + +let TERNARY_TYPE6_DICKSON = prove + (`!a beta t h b:int. + ~(&2 divides a) /\ beta = &8 * b + &3 + ==> ternary_type6 a (&0) (&1) (&2 * beta) (&4 * t) (&8 * h)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(MATCH_MP (SPEC `a:int` INT_ODD_FORM) + (ASSUME `~(&2 divides a)`)) THEN + DISCH_THEN(X_CHOOSE_TAC `r:int`) THEN + MATCH_MP_TAC(SPECL + [`a:int`; `&0:int`; `&1:int`; `&2 * beta:int`; `&4 * t:int`; + `&8 * h:int`; `&0:int`; `&1:int`; `&1:int`; + `&2 * b + h + t:int`] TERNARY_TYPE6_OF_CHARACTERISTIC) THEN + REWRITE_TAC[tqeval; INT_MUL_LZERO; INT_MUL_RZERO; INT_ADD_LID; + INT_ADD_RID; INT_MUL_LID; INT_MUL_RID] THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[int_divides] THEN EXISTS_TAC `r:int` THEN + UNDISCH_TAC `a = &2 * r + &1` THEN CONV_TAC INT_RING; + REWRITE_TAC[int_divides] THEN EXISTS_TAC `--(&2 * t):int` THEN + CONV_TAC INT_RING; + REWRITE_TAC[int_divides] THEN EXISTS_TAC `--(&2 * t):int` THEN + CONV_TAC INT_RING; + UNDISCH_TAC `beta = &8 * b + &3` THEN CONV_TAC INT_RING]);; + +let LEMMA_125 = prove + (`!a k beta t h n:int. + &0 < a /\ &0 < beta /\ ~(&2 divides a) /\ + beta = &8 * a * k - &5 /\ + beta * h = t pow 2 + k /\ + (?x y z. + a * x pow 2 + (&2 * beta) * y pow 2 + (&8 * h) * z pow 2 + + &2 * x * z + &2 * (&4 * t) * y * z = n) + ==> ?u v w:int. u pow 2 + &2 * v pow 2 + &5 * w pow 2 = n`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC TERNARY_DISC10_TYPE6_SPECIAL THEN + MAP_EVERY EXISTS_TAC + [`a:int`; `&0:int`; `&1:int`; `&2 * beta:int`; `&4 * t:int`; + `&8 * h:int`; `a:int`; `a * k - &1:int`] THEN + REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + REWRITE_TAC[INT_POW_2; INT_MUL_LZERO; INT_SUB_RZERO] THEN + MATCH_MP_TAC INT_LT_MUL THEN ASM_REWRITE_TAC[] THEN + ASM_INT_ARITH_TAC; + MAP_EVERY UNDISCH_TAC + [`beta = &8 * a * k - &5`; `beta * h = t pow 2 + k`] THEN + CONV_TAC INT_RING; + MATCH_MP_TAC(SPECL + [`a:int`; `beta:int`; `t:int`; `h:int`; `a * k - &1:int`] + TERNARY_TYPE6_DICKSON) THEN + ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `beta = &8 * a * k - &5` THEN + CONV_TAC INT_RING; + ASM_REWRITE_TAC[]; + MAP_EVERY EXISTS_TAC [`&1:int`; `&0:int`; `&0:int`] THEN + CONV_TAC INT_RING; + MAP_EVERY EXISTS_TAC [`&0:int`; `&1:int`; `&0:int`] THEN + UNDISCH_TAC `beta = &8 * a * k - &5` THEN + CONV_TAC INT_RING; + MAP_EVERY EXISTS_TAC [`x:int`; `y:int`; `z:int`] THEN + UNDISCH_TAC + `a * x pow 2 + (&2 * beta) * y pow 2 + (&8 * h) * z pow 2 + + &2 * x * z + &2 * (&4 * t) * y * z = n` THEN + CONV_TAC INT_RING]);; + +(* ------------------------------------------------------------------------- *) +(* Dickson's Dirichlet progression beta = 8 a (10j+3) - 5. *) +(* ------------------------------------------------------------------------- *) + +let COPRIME_5_OF_10 = prove + (`!a:num. coprime(10,a) ==> coprime(5,a)`, + GEN_TAC THEN + REWRITE_TAC[ARITH_RULE `10 = 2 * 5`; COPRIME_LMUL] THEN + MESON_TAC[]);; + +let COPRIME_125_OFFSET_A = prove + (`!a:num. + 1 <= a /\ coprime(10,a) + ==> coprime(24*a-5,a)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `coprime(5,a)` ASSUME_TAC THENL + [MATCH_MP_TAC COPRIME_5_OF_10 THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[COPRIME] THEN X_GEN_TAC `d:num` THEN EQ_TAC THENL + [STRIP_TAC THEN + SUBGOAL_THEN `d divides 24*a` ASSUME_TAC THENL + [MATCH_MP_TAC(SPECL [`d:num`; `a:num`; `24`] DIVIDES_LMUL) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `d divides 5` ASSUME_TAC THENL + [SUBGOAL_THEN `5 = 24*a - (24*a-5)` SUBST1_TAC THENL + [ASM_ARITH_TAC; + MATCH_MP_TAC(SPECL [`d:num`; `24*a`; `24*a-5`] DIVIDES_SUB) THEN + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + MP_TAC(SPEC `d:num` + (REWRITE_RULE[COPRIME] (ASSUME `coprime(5,a)`))) THEN + ASM_REWRITE_TAC[]; + DISCH_TAC THEN ASM_REWRITE_TAC[DIVIDES_1]]);; + +let COPRIME_125_OFFSET_80 = prove + (`!a:num. + 1 <= a /\ coprime(10,a) + ==> coprime(24*a-5,80)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `ODD(24*a-5)` ASSUME_TAC THENL + [REWRITE_TAC[ODD_EXISTS] THEN EXISTS_TAC `12*a-3` THEN + ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `~(5 divides a)` ASSUME_TAC THENL + [MATCH_MP_TAC(fst(EQ_IMP_RULE + (MATCH_MP (SPECL [`5`; `a:num`] PRIME_COPRIME_EQ) + (EQT_ELIM(PRIME_CONV `prime 5`))))) THEN + MATCH_MP_TAC COPRIME_5_OF_10 THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `~(5 divides (24*a-5))` ASSUME_TAC THENL + [DISCH_TAC THEN + SUBGOAL_THEN `5 divides 24*a` ASSUME_TAC THENL + [SUBGOAL_THEN `24*a = (24*a-5)+5` SUBST1_TAC THENL + [ASM_ARITH_TAC; + MATCH_MP_TAC DIVIDES_ADD THEN ASM_REWRITE_TAC[DIVIDES_REFL]]; + ALL_TAC] THEN + MP_TAC(ASSUME `5 divides 24*a`) THEN + REWRITE_TAC[MATCH_MP (SPEC `5` PRIME_DIVPROD_EQ) + (EQT_ELIM(PRIME_CONV `prime 5`))] THEN + ASM_REWRITE_TAC[] THEN + CONV_TAC(RAND_CONV DIVIDES_CONV) THEN REWRITE_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[ARITH_RULE `80 = 2*2*2*2*5`; COPRIME_RMUL] THEN + ASM_REWRITE_TAC[CONJUNCT2 COPRIME_2] THEN + ONCE_REWRITE_TAC[COPRIME_SYM] THEN + ASM_REWRITE_TAC[MATCH_MP (SPEC `5` PRIME_COPRIME_EQ) + (EQT_ELIM(PRIME_CONV `prime 5`))]);; + +let COPRIME_DIRICHLET_125 = prove + (`!a:num. + 1 <= a /\ coprime(10,a) + ==> coprime(24*a-5,80*a)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[COPRIME_RMUL] THEN + CONJ_TAC THENL + [MATCH_MP_TAC COPRIME_125_OFFSET_80 THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC COPRIME_125_OFFSET_A THEN ASM_REWRITE_TAC[]]);; + +let DIRICHLET_PRIME_125 = prove + (`!a:num. + 1 <= a /\ coprime(10,a) + ==> ?p. prime p /\ (p == 24*a-5) (mod (80*a))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC DIRICHLET_PRIME_CONG THEN + ASM_SIMP_TAC[COPRIME_DIRICHLET_125] THEN ASM_ARITH_TAC);; + +let COPRIME_5_10J3 = prove + (`!j:num. coprime(5,10*j+3)`, + GEN_TAC THEN REWRITE_TAC[COPRIME_BEZOUT] THEN + MAP_EVERY EXISTS_TAC [`2`; `4*j+1`] THEN + DISJ2_TAC THEN ARITH_TAC);; + +let SQUARE_MOD_5 = prove + (`!n. (n EXP 2 == 0) (mod 5) \/ + (n EXP 2 == 1) (mod 5) \/ + (n EXP 2 == 4) (mod 5)`, + GEN_TAC THEN SIMP_TAC[CONG; ARITH_EQ] THEN + ONCE_REWRITE_TAC[GSYM MOD_EXP_MOD] THEN + MP_TAC(SPECL [`n:num`; `5`] DIVISION) THEN REWRITE_TAC[ARITH] THEN + DISCH_THEN(MP_TAC o CONJUNCT2) THEN + SIMP_TAC[LT; ARITH; ARITH_RULE + `~(m = 0) ==> (n < m <=> n = m - 1 \/ n < m - 1)`] THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST1_TAC) THEN + CONV_TAC NUM_REDUCE_CONV);; + +let NO_SQUARE_3_MOD_5 = prove + (`~(?x:num. (x EXP 2 == 3) (mod 5))`, + REWRITE_TAC[NOT_EXISTS_THM] THEN X_GEN_TAC `x:num` THEN DISCH_TAC THEN + MP_TAC(SPEC `x:num` SQUARE_MOD_5) THEN + MP_TAC(ASSUME `(x EXP 2 == 3) (mod 5)`) THEN + REWRITE_TAC[CONG] THEN CONV_TAC NUM_REDUCE_CONV THEN ARITH_TAC);; + +let JACOBI_3_5 = prove + (`jacobi(3,5) = -- &1`, + MP_TAC(MATCH_MP (SPECL [`3`; `5`] JACOBI_PRIME) + (EQT_ELIM(PRIME_CONV `prime 5`))) THEN + REWRITE_TAC[NO_SQUARE_3_MOD_5] THEN + CONV_TAC(DEPTH_CONV DIVIDES_CONV) THEN REWRITE_TAC[]);; + +let JACOBI_5_10J3 = prove + (`!j:num. jacobi(5,10*j+3) = -- &1`, + GEN_TAC THEN + SUBGOAL_THEN `ODD(10*j+3)` ASSUME_TAC THENL + [REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH]; + ALL_TAC] THEN + SUBGOAL_THEN `jacobi(10*j+3,5) = -- &1` ASSUME_TAC THENL + [TRANS_TAC EQ_TRANS `jacobi(3,5)` THEN CONJ_TAC THENL + [MATCH_MP_TAC JACOBI_CONG THEN NUMBER_TAC; + REWRITE_TAC[JACOBI_3_5]]; + ALL_TAC] THEN + MP_TAC(SPECL [`5`; `10*j+3`] JACOBI_RECIPROCITY) THEN + ASM_REWRITE_TAC[COPRIME_5_10J3; NUM_REDUCE_CONV `ODD 5`] THEN + REWRITE_TAC[ARITH_RULE `(5-1) DIV 2 = 2`; EVEN_MULT; + INT_POW_NEG; INT_POW_ONE; NUM_REDUCE_CONV `EVEN 2`] THEN + INT_ARITH_TAC);; + +let CONG_BETA_NEG5_125 = prove + (`!a j beta:num. + 1 <= a /\ beta = 8*a*(10*j+3)-5 + ==> (beta == 5*((10*j+3)-1)) (mod (10*j+3))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `5*((10*j+3)-1) = 5*(10*j+3)-5` + SUBST1_TAC THENL + [ARITH_TAC; + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONG_SUB THEN + REPEAT CONJ_TAC THENL + [NUMBER_TAC; + REWRITE_TAC[CONG_REFL]; + ASM_ARITH_TAC; + ARITH_TAC]]);; + +let JACOBI_BETA_10J3 = prove + (`!a j beta:num. + 1 <= a /\ beta = 8*a*(10*j+3)-5 + ==> jacobi(beta,10*j+3) = + --(-- &1 pow (((10*j+3)-1) DIV 2))`, + REPEAT STRIP_TAC THEN + TRANS_TAC EQ_TRANS `jacobi(5*((10*j+3)-1),10*j+3)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC JACOBI_CONG THEN + MATCH_MP_TAC(SPECL [`a:num`; `j:num`; `beta:num`] + CONG_BETA_NEG5_125) THEN + ASM_REWRITE_TAC[]; + REWRITE_TAC[JACOBI_LMUL; JACOBI_5_10J3] THEN + SUBGOAL_THEN `ODD(10*j+3)` ASSUME_TAC THENL + [REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH]; + ASM_SIMP_TAC[JACOBI_MINUS1] THEN INT_ARITH_TAC]]);; + +let CONG_BETA_3MOD4_125 = prove + (`!a j beta:num. + 1 <= a /\ beta = 8*a*(10*j+3)-5 + ==> (beta == 3) (mod 4)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `beta = (2*a*(10*j+3)-2)*4+3` + SUBST1_TAC THENL + [ASM_ARITH_TAC; + REWRITE_TAC[CONG] THEN SIMP_TAC[MOD_MULT_ADD] THEN + CONV_TAC NUM_REDUCE_CONV]);; + +let COPRIME_BETA_10J3 = prove + (`!a j beta:num. + 1 <= a /\ beta = 8*a*(10*j+3)-5 + ==> coprime(beta,10*j+3)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `jacobi(beta,10*j+3) = --(-- &1 pow (((10*j+3)-1) DIV 2))` + ASSUME_TAC THENL + [MATCH_MP_TAC(SPECL [`a:num`; `j:num`; `beta:num`] + JACOBI_BETA_10J3) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MP_TAC(SPECL [`beta:num`; `10*j+3`] JACOBI_EQ_0) THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[INT_NEG_EQ_0; INT_POW_EQ_0] THEN + CONV_TAC INT_REDUCE_CONV);; + +let JACOBI_NEGK_BETA_125 = prove + (`!a j beta:num. + 1 <= a /\ beta = 8*a*(10*j+3)-5 + ==> jacobi((10*j+3)*(beta-1),beta) = &1`, + REPEAT STRIP_TAC THEN + ABBREV_TAC `k:num = 10*j+3` THEN + SUBGOAL_THEN `ODD k` ASSUME_TAC THENL + [EXPAND_TAC "k" THEN REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH]; + ALL_TAC] THEN + SUBGOAL_THEN `(beta == 3) (mod 4)` ASSUME_TAC THENL + [MATCH_MP_TAC(SPECL [`a:num`; `j:num`; `beta:num`] + CONG_BETA_3MOD4_125) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `ODD beta` ASSUME_TAC THENL + [MATCH_MP_TAC ODD_OF_3MOD4 THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `coprime(beta:num,k)` ASSUME_TAC THENL + [ACCEPT_TAC(MATCH_MP + (REWRITE_RULE[ASSUME `10*j+3 = (k:num)`] + (SPECL [`a:num`; `j:num`; `beta:num`] COPRIME_BETA_10J3)) + (CONJ (ASSUME `1 <= a`) + (ASSUME `beta:num = 8*a*k-5`))); + ALL_TAC] THEN + SUBGOAL_THEN + `jacobi(beta,k) = --(-- &1 pow ((k-1) DIV 2))` + ASSUME_TAC THENL + [ACCEPT_TAC(MATCH_MP + (REWRITE_RULE[ASSUME `10*j+3 = (k:num)`] + (SPECL [`a:num`; `j:num`; `beta:num`] JACOBI_BETA_10J3)) + (CONJ (ASSUME `1 <= a`) + (ASSUME `beta:num = 8*a*k-5`))); + ALL_TAC] THEN + FIRST_ASSUM(X_CHOOSE_TAC `q:num` o MATCH_MP CONG_3_MOD_4 o + check (fun th -> concl th = `(beta == 3) (mod 4)`)) THEN + SUBGOAL_THEN `(beta-1) DIV 2 = 2*q+1` ASSUME_TAC THENL + [ONCE_REWRITE_TAC[ASSUME `beta:num = 4*q+3`] THEN + REWRITE_TAC[ARITH_RULE `((4*q+3)-1) DIV 2 = 2*q+1`]; + ALL_TAC] THEN + SUBGOAL_THEN + `-- &1 pow (((beta-1) DIV 2) * ((k-1) DIV 2)) = + -- &1 pow ((k-1) DIV 2)` + ASSUME_TAC THENL + [ASM_REWRITE_TAC[] THEN + REWRITE_TAC[INT_POW_NEG; INT_POW_ONE; EVEN_MULT; EVEN_ADD; ARITH]; + ALL_TAC] THEN + SUBGOAL_THEN `jacobi(k,beta) = -- &1` ASSUME_TAC THENL + [MP_TAC(SPECL [`beta:num`; `k:num`] JACOBI_RECIPROCITY) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + ONCE_REWRITE_TAC[ASSUME `beta:num = 8*a*k-5`] THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[INT_POW_NEG; INT_POW_ONE] THEN + COND_CASES_TAC THEN CONV_TAC INT_REDUCE_CONV; + ALL_TAC] THEN + REWRITE_TAC[JACOBI_LMUL] THEN + ONCE_REWRITE_TAC[ASSUME `jacobi(k,beta) = -- &1`] THEN + MP_TAC(MATCH_MP (SPEC `beta:num` JACOBI_M1_3MOD4) + (ASSUME `(beta == 3) (mod 4)`)) THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN + CONV_TAC INT_REDUCE_CONV);; + +let QR_125 = prove + (`!a j beta:num. + 1 <= a /\ prime beta /\ beta = 8*a*(10*j+3)-5 + ==> ?t. (t EXP 2 + (10*j+3) == 0) (mod beta)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC JACOBI_NEGATIVE_SQUARE THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(SPECL [`a:num`; `j:num`; `beta:num`] + JACOBI_NEGK_BETA_125) THEN + ASM_REWRITE_TAC[]);; + +let RESIDUE_125 = prove + (`!a:num. + 1 <= a /\ coprime(10,a) + ==> ?j t. + (8*a*(10*j+3)-5) divides (t EXP 2 + (10*j+3))`, + REPEAT STRIP_TAC THEN + MP_TAC(SPEC `a:num` DIRICHLET_PRIME_125) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `beta:num` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `?j. beta = 80*a*j + (24*a-5)` + (X_CHOOSE_TAC `j:num`) THENL + [MP_TAC(SPECL [`80*a`; `24*a-5`; `beta:num`] CONG_CASE) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `beta = 8*a*(10*j+3)-5` + ASSUME_TAC THENL + [UNDISCH_TAC `beta = 80*a*j + (24*a-5)` THEN ASM_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(MATCH_MP + (SPECL [`a:num`; `j:num`; `beta:num`] QR_125) + (CONJ (ASSUME `1 <= a`) + (CONJ (ASSUME `prime beta`) + (ASSUME `beta = 8*a*(10*j+3)-5`)))) THEN + DISCH_THEN(X_CHOOSE_TAC `t:num`) THEN + MAP_EVERY EXISTS_TAC [`j:num`; `t:num`] THEN + ONCE_REWRITE_TAC[GSYM + (ASSUME `beta = 8*a*(10*j+3)-5`)] THEN + MP_TAC(ASSUME `(t EXP 2 + (10*j+3) == 0) (mod beta)`) THEN + REWRITE_TAC[CONG_0_DIVIDES]);; + +let REGULAR_125_COPRIME10 = prove + (`!a:num. + 1 <= a /\ coprime(10,a) + ==> ?u v w:int. u pow 2 + &2*v pow 2 + &5*w pow 2 = &a`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `ODD a` ASSUME_TAC THENL + [MP_TAC(ASSUME `coprime(10,a)`) THEN + REWRITE_TAC[ARITH_RULE `10 = 2*5`; COPRIME_LMUL; + CONJUNCT1 COPRIME_2] THEN MESON_TAC[]; + ALL_TAC] THEN + MP_TAC(SPEC `a:num` RESIDUE_125) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `j:num` (X_CHOOSE_TAC `t:num`)) THEN + FIRST_X_ASSUM(X_CHOOSE_TAC `h:num` o REWRITE_RULE[divides]) THEN + MATCH_MP_TAC(SPECL + [`&a:int`; `&(10*j+3):int`; `&(8*a*(10*j+3)-5):int`; + `&t:int`; `&h:int`; `&a:int`] LEMMA_125) THEN + REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[INT_OF_NUM_LT] THEN ASM_ARITH_TAC; + REWRITE_TAC[INT_OF_NUM_LT] THEN ASM_ARITH_TAC; + REWRITE_TAC[GSYM num_divides; DIVIDES_2; GSYM NOT_ODD] THEN + ASM_REWRITE_TAC[]; + SUBGOAL_THEN `5 <= 8*a*(10*j+3)` ASSUME_TAC THENL + [ASM_ARITH_TAC; + ASM_SIMP_TAC[INT_OF_NUM_SUB; INT_OF_NUM_MUL; INT_OF_NUM_ADD] THEN + CONV_TAC INT_RING]; + FIRST_X_ASSUM(MP_TAC o AP_TERM `int_of_num`) THEN + REWRITE_TAC[INT_OF_NUM_ADD; INT_OF_NUM_MUL; INT_OF_NUM_POW] THEN + DISCH_TAC THEN ASM_REWRITE_TAC[]; + MAP_EVERY EXISTS_TAC [`&1:int`; `&0:int`; `&0:int`] THEN + CONV_TAC INT_RING]);; + +let BINARY_DISC5 = prove + (`!A11. &0 < A11 + ==> !A12 A22. + A11 * A22 - A12 pow 2 = &5 + ==> ((!n. + (?x y. + A11 * x pow 2 + &2 * A12 * x * y + + A22 * y pow 2 = n) + ==> ?u v:int. u pow 2 + &5 * v pow 2 = n) \/ + (!n. + (?x y. + A11 * x pow 2 + &2 * A12 * x * y + + A22 * y pow 2 = n) + ==> ?u v:int. + &2 * u pow 2 + &2 * u * v + &3 * v pow 2 = n))`, + ONCE_REWRITE_TAC[MESON[] + `(!A11. &0 < A11 ==> P A11) <=> + (!m A11. num_of_int A11 = m /\ &0 < A11 ==> P A11)`] THEN + MATCH_MP_TAC num_WF THEN GEN_TAC THEN STRIP_TAC THEN + GEN_TAC THEN STRIP_TAC THEN REPEAT GEN_TAC THEN DISCH_TAC THEN + ASM_CASES_TAC `A11 = &1` THENL + [DISJ1_TAC THEN GEN_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` (X_CHOOSE_TAC `y:int`)) THEN + MAP_EVERY EXISTS_TAC [`x + A12 * y:int`; `y:int`] THEN + MP_TAC(ASSUME `A11 * A22 - A12 pow 2 = &5`) THEN + MP_TAC(ASSUME + `A11 * x pow 2 + &2 * A12 * x * y + A22 * y pow 2 = n`) THEN + REWRITE_TAC[ASSUME `A11 = &1`] THEN CONV_TAC INT_RING; + ALL_TAC] THEN + ASM_CASES_TAC `A11 = &2` THENL + [DISJ2_TAC THEN GEN_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` (X_CHOOSE_TAC `y:int`)) THEN + SUBGOAL_THEN `~(&2 divides A12)` ASSUME_TAC THENL + [DISCH_THEN(X_CHOOSE_TAC `q:int` o REWRITE_RULE[int_divides]) THEN + SUBGOAL_THEN `&2 divides &5` MP_TAC THENL + [REWRITE_TAC[int_divides] THEN + EXISTS_TAC `A22 - &2 * (q:int) pow 2` THEN + MP_TAC(ASSUME `A11 * A22 - A12 pow 2 = &5`) THEN + REWRITE_TAC[ASSUME `A11 = &2`; ASSUME `A12 = &2 * q`] THEN + CONV_TAC INT_RING; + REWRITE_TAC[GSYM INT_REM_EQ_0] THEN CONV_TAC INT_REDUCE_CONV]; + ALL_TAC] THEN + MP_TAC(MATCH_MP (SPEC `A12:int` INT_ODD_FORM) + (ASSUME `~(&2 divides A12)`)) THEN + DISCH_THEN(X_CHOOSE_TAC `q:int`) THEN + SUBGOAL_THEN `A22 = &2 * q pow 2 + &2 * q + &3` + ASSUME_TAC THENL + [MP_TAC(ASSUME `A11 * A22 - A12 pow 2 = &5`) THEN + REWRITE_TAC + [ASSUME `A11 = &2`; ASSUME `A12 = &2 * q + &1`] THEN + CONV_TAC INT_RING; + ALL_TAC] THEN + MAP_EVERY EXISTS_TAC [`x + q * y:int`; `y:int`] THEN + MP_TAC(ASSUME + `A11 * x pow 2 + &2 * A12 * x * y + A22 * y pow 2 = n`) THEN + REWRITE_TAC + [ASSUME `A11 = &2`; ASSUME `A12 = &2 * q + &1`; + ASSUME `A22 = &2 * q pow 2 + &2 * q + &3`] THEN + CONV_TAC INT_RING; + ALL_TAC] THEN + MP_TAC(SPECL [`A12:int`; `A11:int`] INT_BALANCED_REM) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `b:int` (LABEL_TAC "balanced")) THEN + ABBREV_TAC `r = --b:int` THEN + ABBREV_TAC `A12' = A12 + A11 * r` THEN + ABBREV_TAC `A22' = A11 * r pow 2 + &2 * A12 * r + A22` THEN + SUBGOAL_THEN `abs A12' * &2 <= A11` ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["A12'"; "r"] THEN + REMOVE_THEN "balanced" MP_TAC THEN + REWRITE_TAC[INT_ARITH + `A12 + A11 * --b = A12 - A11 * b`]; + ALL_TAC] THEN + SUBGOAL_THEN `A11 * A22' - A12' pow 2 = &5` ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["A12'"; "A22'"] THEN + UNDISCH_TAC `A11 * A22 - A12 pow 2 = &5` THEN + CONV_TAC INT_RING; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < A22'` ASSUME_TAC THENL + [SUBGOAL_THEN `&0 < A11 * A22'` MP_TAC THENL + [SUBGOAL_THEN `A11 * A22' = &5 + A12' pow 2` SUBST1_TAC THENL + [ASM_INT_ARITH_TAC; + MP_TAC(SPEC `A12':int` INT_LE_POW_2) THEN INT_ARITH_TAC]; + ASM_SIMP_TAC[INT_LT_MUL_EQ]]; + ALL_TAC] THEN + SUBGOAL_THEN `&3 <= A11` ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `&20 < &3 * A11 pow 2` ASSUME_TAC THENL + [SUBGOAL_THEN `&9 <= A11 pow 2` MP_TAC THENL + [MP_TAC(SPECL [`2`; `&3:int`; `A11:int`] INT_POW_LE2) THEN + ANTS_TAC THENL [ASM_INT_ARITH_TAC; CONV_TAC INT_REDUCE_CONV]; + INT_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN `A22' < A11` ASSUME_TAC THENL + [SUBGOAL_THEN `&4 * (A11 * A22') <= &20 + A11 pow 2` + ASSUME_TAC THENL + [SUBGOAL_THEN `A11 * A22' = &5 + A12' pow 2` + (fun th -> REWRITE_TAC[th]) THENL + [ASM_INT_ARITH_TAC; + MP_TAC(MATCH_MP SQ_BOUND + (ASSUME `abs A12' * &2 <= A11`)) THEN INT_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN `A11 * (&4 * A22') < A11 * (&4 * A11)` MP_TAC THENL + [MATCH_MP_TAC INT_LET_TRANS THEN + EXISTS_TAC `&20 + A11 pow 2` THEN + CONJ_TAC THENL + [ONCE_REWRITE_TAC[INT_RING + `A11 * (&4 * A22') = &4 * (A11 * A22')`] THEN + ASM_REWRITE_TAC[]; + ONCE_REWRITE_TAC[INT_RING + `A11 * (&4 * A11) = &4 * A11 pow 2`] THEN + ASM_INT_ARITH_TAC]; + ASM_SIMP_TAC[INT_LT_LMUL_EQ] THEN INT_ARITH_TAC]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `num_of_int A22'`) THEN + SUBGOAL_THEN `num_of_int A22' < m` ASSUME_TAC THENL + [FIRST_X_ASSUM(SUBST1_TAC o SYM o + check (fun th -> rand(concl th) = `m:num`)) THEN + REWRITE_TAC[GSYM INT_OF_NUM_LT] THEN + SUBGOAL_THEN `&(num_of_int A22') = A22' /\ &(num_of_int A11) = A11` + (CONJUNCTS_THEN SUBST1_TAC) THENL + [CONJ_TAC THEN MATCH_MP_TAC INT_OF_NUM_OF_INT THEN ASM_INT_ARITH_TAC; + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `A22':int`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPECL [`A12':int`; `A11:int`]) THEN + ANTS_TAC THENL + [MP_TAC(ASSUME `A11 * A22' - A12' pow 2 = &5`) THEN + CONV_TAC INT_RING; + DISCH_THEN(DISJ_CASES_THEN (LABEL_TAC "class")) THENL + [DISJ1_TAC; DISJ2_TAC] THEN + X_GEN_TAC `n:int` THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` (X_CHOOSE_TAC `y:int`)) THEN + REMOVE_THEN "class" (MATCH_MP_TAC o SPEC `n:int`) THEN + MAP_EVERY EXISTS_TAC [`y:int`; `x - r * y:int`] THEN + MAP_EVERY EXPAND_TAC ["A12'"; "A22'"] THEN + UNDISCH_TAC + `A11 * x pow 2 + &2 * A12 * x * y + A22 * y pow 2 = n` THEN + CONV_TAC INT_RING]);; + +let TERNARY_DISC5_A11_1_GLOBAL = prove + (`!a12 a13 a22 a23 a33:int. + &0 < &1 * a22 - a12 pow 2 /\ + &1 * (a22 * a33 - a23 pow 2) - + a12 * (a12 * a33 - a23 * a13) + + a13 * (a12 * a23 - a22 * a13) = &5 + ==> ((!n. + (?x1 x2 x3. + &1 * x1 pow 2 + a22 * x2 pow 2 + a33 * x3 pow 2 + + &2 * a12 * x1 * x2 + &2 * a13 * x1 * x3 + + &2 * a23 * x2 * x3 = n) + ==> ?u v w:int. u pow 2 + v pow 2 + &5 * w pow 2 = n) \/ + (!n. + (?x1 x2 x3. + &1 * x1 pow 2 + a22 * x2 pow 2 + a33 * x3 pow 2 + + &2 * a12 * x1 * x2 + &2 * a13 * x1 * x3 + + &2 * a23 * x2 * x3 = n) + ==> ?u v w:int. + u pow 2 + &2 * v pow 2 + &2 * v * w + + &3 * w pow 2 = n))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + ABBREV_TAC `G11 = a22 - a12 pow 2` THEN + ABBREV_TAC `G12 = a23 - a12 * a13` THEN + ABBREV_TAC `G22 = a33 - a13 pow 2` THEN + SUBGOAL_THEN `&0 < G11` ASSUME_TAC THENL + [EXPAND_TAC "G11" THEN + UNDISCH_TAC `&0 < &1 * a22 - a12 pow 2` THEN + REWRITE_TAC[INT_MUL_LID]; + ALL_TAC] THEN + SUBGOAL_THEN `G11 * G22 - G12 pow 2 = &5` ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["G11"; "G12"; "G22"] THEN + UNDISCH_TAC + `&1 * (a22 * a33 - a23 pow 2) - + a12 * (a12 * a33 - a23 * a13) + + a13 * (a12 * a23 - a22 * a13) = &5` THEN + CONV_TAC INT_RING; + ALL_TAC] THEN + MP_TAC(SPEC `G11:int` BINARY_DISC5) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPECL [`G12:int`; `G22:int`]) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(DISJ_CASES_THEN (LABEL_TAC "class")) THENL + [DISJ1_TAC; DISJ2_TAC] THEN + (X_GEN_TAC `n:int` THEN + DISCH_THEN(X_CHOOSE_THEN `x1:int` + (X_CHOOSE_THEN `x2:int` (X_CHOOSE_TAC `x3:int`))) THEN + ABBREV_TAC `L = x1 + a12 * x2 + a13 * x3` THEN + (REMOVE_THEN "class" (MP_TAC o SPEC `n - L pow 2`) THEN + ANTS_TAC THENL + [MAP_EVERY EXISTS_TAC [`x2:int`; `x3:int`] THEN + MP_TAC(SPECL + [`&1:int`; `a12:int`; `a13:int`; `a22:int`; `a23:int`; `a33:int`; + `x1:int`; `x2:int`; `x3:int`] TERNARY_COMPLETE) THEN + ASM_REWRITE_TAC[INT_MUL_LID] THEN INT_ARITH_TAC; + ALL_TAC]) THEN + DISCH_THEN(X_CHOOSE_THEN `v:int` + (X_CHOOSE_THEN `w:int` (LABEL_TAC "binaryrep"))) THEN + MAP_EVERY EXISTS_TAC [`L:int`; `v:int`; `w:int`] THEN + REMOVE_THEN "binaryrep" MP_TAC THEN INT_ARITH_TAC));; + +let TERNARY_DISC5_A11_1_SECOND = prove + (`!a12 a13 a22 a23 a33 q n:int. + &0 < &1 * a22 - a12 pow 2 /\ + &1 * (a22 * a33 - a23 pow 2) - + a12 * (a12 * a33 - a23 * a13) + + a13 * (a12 * a23 - a22 * a13) = &5 /\ + (?x1 x2 x3. + &1 * x1 pow 2 + a22 * x2 pow 2 + a33 * x3 pow 2 + + &2 * a12 * x1 * x2 + &2 * a13 * x1 * x3 + + &2 * a23 * x2 * x3 = &8 * q + &3) /\ + (?x1 x2 x3. + &1 * x1 pow 2 + a22 * x2 pow 2 + a33 * x3 pow 2 + + &2 * a12 * x1 * x2 + &2 * a13 * x1 * x3 + + &2 * a23 * x2 * x3 = n) + ==> ?u v w:int. + u pow 2 + &2 * v pow 2 + &2 * v * w + &3 * w pow 2 = n`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(SPECL + [`a12:int`; `a13:int`; `a22:int`; `a23:int`; `a33:int`] + TERNARY_DISC5_A11_1_GLOBAL) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(DISJ_CASES_THEN (LABEL_TAC "class")) THENL + [REMOVE_THEN "class" (fun th -> + MP_TAC(MATCH_MP (SPEC `&8 * q + &3` th) + (ASSUME + `?x1 x2 x3. + &1 * x1 pow 2 + a22 * x2 pow 2 + a33 * x3 pow 2 + + &2 * a12 * x1 * x2 + &2 * a13 * x1 * x3 + + &2 * a23 * x2 * x3 = &8 * q + &3`))) THEN + DISCH_THEN(X_CHOOSE_THEN `u:int` + (X_CHOOSE_THEN `v:int` (X_CHOOSE_TAC `w:int`))) THEN + MP_TAC(SPECL [`u:int`; `v:int`; `w:int`; `q:int`] + INT_SQ_SQ_5_NOT_3MOD8) THEN + ASM_REWRITE_TAC[]; + REMOVE_THEN "class" (fun th -> + MATCH_ACCEPT_TAC(MATCH_MP (SPEC `n:int` th) + (ASSUME + `?x1 x2 x3. + &1 * x1 pow 2 + a22 * x2 pow 2 + a33 * x3 pow 2 + + &2 * a12 * x1 * x2 + &2 * a13 * x1 * x3 + + &2 * a23 * x2 * x3 = n`)))]);; + +let REP_125_DOUBLE_OF_T = prove + (`!n:int. + (?u v w:int. + u pow 2 + &2 * v pow 2 + &2 * v * w + &3 * w pow 2 = n) + ==> ?x y z:int. x pow 2 + &2 * y pow 2 + &5 * z pow 2 = &2 * n`, + REPEAT STRIP_TAC THEN + MAP_EVERY EXISTS_TAC [`w + &2 * v:int`; `u:int`; `w:int`] THEN + FIRST_X_ASSUM MP_TAC THEN CONV_TAC INT_RING);; + +let INT_SQ_EQ_ONE = prove + (`!x:int. x pow 2 = &1 <=> x = &1 \/ x = -- &1`, + GEN_TAC THEN REWRITE_TAC[INT_POW_2] THEN EQ_TAC THENL + [DISCH_TAC THEN MP_TAC(ASSUME `x * x = &1`) THEN + ONCE_REWRITE_TAC + [INT_RING `x * x = &1 <=> (x - &1) * (x + &1) = &0`] THEN + REWRITE_TAC[INT_ENTIRE] THEN INT_ARITH_TAC; + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONV_TAC INT_RING]);; + +let DISC5_BLOCK2_FALSE = prove + (`!l c e f:int. + l pow 2 = &1 /\ + &2 * (&2 * f - e pow 2) - + l * (l * f - c * e) + c * (l * e - &2 * c) = &5 + ==> F`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(SPEC `l:int` INT_SQ_EQ_ONE) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(DISJ_CASES_THEN ASSUME_TAC) THENL + [MP_TAC(SPECL + [`&2 * f - c pow 2`; `&2 * e - c`] INT_DISC10_NOT_FIRST3) THEN + MP_TAC(ASSUME + `&2 * (&2 * f - e pow 2) - + l * (l * f - c * e) + c * (l * e - &2 * c) = &5`) THEN + REWRITE_TAC[ASSUME `l = &1`] THEN CONV_TAC INT_RING; + MP_TAC(SPECL + [`&2 * f - c pow 2`; `&2 * e + c`] INT_DISC10_NOT_FIRST3) THEN + MP_TAC(ASSUME + `&2 * (&2 * f - e pow 2) - + l * (l * f - c * e) + c * (l * e - &2 * c) = &5`) THEN + REWRITE_TAC[ASSUME `l = -- &1`] THEN CONV_TAC INT_RING]);; + +let HERMITE_CUBE_DISC5 = prove + (`!a G:int. + &0 < a /\ &0 < G /\ + &3 * a pow 2 <= &4 * G /\ &3 * G pow 2 <= &4 * (&5 * a) + ==> &27 * a pow 3 <= &320`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(&3 * a pow 2) pow 2 <= (&4 * G) pow 2` MP_TAC THENL + [MATCH_MP_TAC INT_POW_LE2 THEN CONJ_TAC THENL + [MATCH_MP_TAC INT_LE_MUL THEN REWRITE_TAC[INT_LE_POW_2] THEN + INT_ARITH_TAC; + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + REWRITE_TAC[INT_POW_MUL] THEN DISCH_TAC THEN + MATCH_MP_TAC INT_LE_RCANCEL_IMP THEN EXISTS_TAC `a:int` THEN + CONJ_TAC THENL [FIRST_ASSUM ACCEPT_TAC; ALL_TAC] THEN + MATCH_MP_TAC INT_LE_TRANS THEN + EXISTS_TAC `&16 * (&3 * G pow 2)` THEN + CONJ_TAC THENL + [MP_TAC + (ASSUME `&3 pow 2 * a pow 2 pow 2 <= &4 pow 2 * G pow 2`) THEN + REWRITE_TAC[INT_ARITH `a pow 2 pow 2 = a pow 3 * a`; INT_POW_2] THEN + INT_ARITH_TAC; + MP_TAC(ASSUME `&3 * G pow 2 <= &4 * (&5 * a)`) THEN + INT_ARITH_TAC]);; + +let HERMITE_DISC5_LE2 = prove + (`!b11 b12 b13 b22 b23 b33:int. + &0 < b11 /\ + b11 * (b22 * b33 - b23 pow 2) - + b12 * (b12 * b33 - b13 * b23) + + b13 * (b12 * b23 - b13 * b22) = &5 /\ + &0 < b11 * b22 - b12 pow 2 /\ + (!x y z. ~(x = &0 /\ y = &0 /\ z = &0) + ==> b11 <= b11 * x pow 2 + b22 * y pow 2 + + b33 * z pow 2 + &2 * b12 * x * y + + &2 * b13 * x * z + &2 * b23 * y * z) + ==> b11 = &1 \/ b11 = &2`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + ABBREV_TAC `G11 = b11 * b22 - b12 pow 2` THEN + ABBREV_TAC `G12 = b11 * b23 - b12 * b13` THEN + ABBREV_TAC `G22 = b11 * b33 - b13 pow 2` THEN + SUBGOAL_THEN `G11 * G22 - G12 pow 2 = &5 * b11` ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["G11"; "G12"; "G22"] THEN + REWRITE_TAC[DISC_G] THEN + MP_TAC + (ASSUME + `b11 * (b22 * b33 - b23 pow 2) - + b12 * (b12 * b33 - b13 * b23) + + b13 * (b12 * b23 - b13 * b22) = &5`) THEN + CONV_TAC INT_RING; + ALL_TAC] THEN + MP_TAC(SPEC `&5 * b11:int` BINARY_HERMITE) THEN + ANTS_TAC THENL [ASM_INT_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `G11:int`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPECL [`G12:int`; `G22:int`]) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `s:int` + (X_CHOOSE_THEN `t:int` STRIP_ASSUME_TAC)) THEN + ABBREV_TAC + `Gst = G11 * s pow 2 + &2 * G12 * s * t + G22 * t pow 2` THEN + MP_TAC(SPECL [`b12 * s + b13 * t:int`; `b11:int`] + INT_BALANCED_REM) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `bb:int`) THEN + ABBREV_TAC `x1 = --bb:int` THEN + SUBGOAL_THEN + `&4 * (b11 * x1 + b12 * s + b13 * t) pow 2 <= b11 pow 2` + ASSUME_TAC THENL + [MP_TAC(MATCH_MP SQ_BOUND + (ASSUME + `abs ((b12 * s + b13 * t) - b11 * bb) * &2 <= b11`)) THEN + EXPAND_TAC "x1" THEN + REWRITE_TAC + [INT_ARITH + `b11 * --bb + b12 * s + b13 * t = + (b12 * s + b13 * t) - b11 * bb`] THEN + INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `&3 * b11 pow 2 <= &4 * Gst` ASSUME_TAC THENL + [MATCH_MP_TAC HERMITE_LOWER THEN + MAP_EVERY EXISTS_TAC + [`b12:int`; `b13:int`; `b22:int`; `b23:int`; `b33:int`; + `x1:int`; `s:int`; `t:int`] THEN + ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [FIRST_X_ASSUM + (fun th -> + MP_TAC(SPECL [`x1:int`; `s:int`; `t:int`] th) THEN + ANTS_TAC THENL + [UNDISCH_TAC `~(s = &0 /\ t = &0)` THEN MESON_TAC[]; + ALL_TAC] THEN + DISCH_THEN(fun th2 -> ACCEPT_TAC th2 ORELSE MP_TAC th2)); + EXPAND_TAC "Gst" THEN + MP_TAC(SPECL + [`b11:int`; `b12:int`; `b13:int`; `b22:int`; `b23:int`; + `b33:int`; `x1:int`; `s:int`; `t:int`] TERNARY_COMPLETE) THEN + MAP_EVERY (fun e -> UNDISCH_TAC e) + [`b11 * b22 - b12 pow 2 = G11`; + `b11 * b23 - b12 * b13 = G12`; + `b11 * b33 - b13 pow 2 = G22`] THEN + CONV_TAC INT_RING]; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < Gst` ASSUME_TAC THENL + [EXPAND_TAC "Gst" THEN + MP_TAC(SPECL [`G11:int`; `G12:int`; `G22:int`] + POSDEF_BINARY_CRITERION) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN ASM_INT_ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPECL [`s:int`; `t:int`]) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; REWRITE_TAC[]]; + ALL_TAC] THEN + MP_TAC(SPECL [`b11:int`; `Gst:int`] HERMITE_CUBE_DISC5) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + SUBGOAL_THEN `~(&3 <= b11)` ASSUME_TAC THENL + [DISCH_TAC THEN MP_TAC(SPEC `b11:int` CUBE_GE_27) THEN + ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `&27 * b11 pow 3 <= &320` THEN INT_ARITH_TAC; + ALL_TAC] THEN + ASM_INT_ARITH_TAC);; + +let HERMITE_DISC5_MIN2_PAIR = prove + (`!b12 b13 b22 b23 b33:int. + &2 * (b22 * b33 - b23 pow 2) - + b12 * (b12 * b33 - b13 * b23) + + b13 * (b12 * b23 - b13 * b22) = &5 /\ + &0 < &2 * b22 - b12 pow 2 /\ + (!x y z. ~(x = &0 /\ y = &0 /\ z = &0) + ==> &2 <= &2 * x pow 2 + b22 * y pow 2 + + b33 * z pow 2 + &2 * b12 * x * y + + &2 * b13 * x * z + &2 * b23 * y * z) + ==> ?x y z. + (?p q. y * p + z * q = &1) /\ + &2 * x pow 2 + b22 * y pow 2 + b33 * z pow 2 + + &2 * b12 * x * y + &2 * b13 * x * z + + &2 * b23 * y * z = &2 /\ + (&2 * x + b12 * y + b13 * z) pow 2 = &1 /\ + (&2 * b22 - b12 pow 2) * y pow 2 + + &2 * (&2 * b23 - b12 * b13) * y * z + + (&2 * b33 - b13 pow 2) * z pow 2 = &3`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + ABBREV_TAC `G11 = &2 * b22 - b12 pow 2` THEN + ABBREV_TAC `G12 = &2 * b23 - b12 * b13` THEN + ABBREV_TAC `G22 = &2 * b33 - b13 pow 2` THEN + SUBGOAL_THEN `G11 * G22 - G12 pow 2 = &10` ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["G11"; "G12"; "G22"] THEN + REWRITE_TAC[DISC_G] THEN + MP_TAC(ASSUME + `&2 * (b22 * b33 - b23 pow 2) - + b12 * (b12 * b33 - b13 * b23) + + b13 * (b12 * b23 - b13 * b22) = &5`) THEN + CONV_TAC INT_RING; + ALL_TAC] THEN + MP_TAC(SPEC `&10:int` BINARY_HERMITE_PRIMITIVE) THEN + CONV_TAC INT_REDUCE_CONV THEN + DISCH_THEN(MP_TAC o SPEC `G11:int`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPECL [`G12:int`; `G22:int`]) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `s:int` + (X_CHOOSE_THEN `t:int` + (CONJUNCTS_THEN2 + (X_CHOOSE_THEN `p:int` (X_CHOOSE_TAC `q:int`)) + ASSUME_TAC))) THEN + ABBREV_TAC + `Gst = G11 * s pow 2 + &2 * G12 * s * t + G22 * t pow 2` THEN + SUBGOAL_THEN `&3 * Gst pow 2 <= &4 * &10` ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(SPECL [`b12 * s + b13 * t:int`; `&2:int`] + INT_BALANCED_REM) THEN + CONV_TAC INT_REDUCE_CONV THEN + DISCH_THEN(X_CHOOSE_TAC `bb:int`) THEN + ABBREV_TAC `x1 = --bb:int` THEN + ABBREV_TAC + `Fst = &2 * x1 pow 2 + b22 * s pow 2 + b33 * t pow 2 + + &2 * b12 * x1 * s + &2 * b13 * x1 * t + + &2 * b23 * s * t` THEN + ABBREV_TAC `l = &2 * x1 + b12 * s + b13 * t` THEN + SUBGOAL_THEN `&4 * l pow 2 <= &4` ASSUME_TAC THENL + [MP_TAC(MATCH_MP SQ_BOUND + (ASSUME `abs ((b12 * s + b13 * t) - &2 * bb) * &2 <= &2`)) THEN + MAP_EVERY EXPAND_TAC ["l"; "x1"] THEN + REWRITE_TAC[INT_ARITH + `&2 * --bb + b12 * s + b13 * t = + (b12 * s + b13 * t) - &2 * bb`] THEN + INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `&2 <= Fst` ASSUME_TAC THENL + [EXPAND_TAC "Fst" THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + DISCH_TAC THEN UNDISCH_TAC `s * p + t * q = &1` THEN + ASM_REWRITE_TAC[] THEN INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `&2 * Fst = l pow 2 + Gst` ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["Fst"; "l"; "Gst"; "G11"; "G12"; "G22"] THEN + CONV_TAC INT_RING; + ALL_TAC] THEN + SUBGOAL_THEN `&3 <= Gst` ASSUME_TAC THENL + [UNDISCH_TAC `&2 <= Fst` THEN + UNDISCH_TAC `&4 * l pow 2 <= &4` THEN + UNDISCH_TAC `&2 * Fst = l pow 2 + Gst` THEN + MP_TAC(SPEC `l:int` INT_LE_POW_2) THEN INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `Gst <= &3` ASSUME_TAC THENL + [ASM_CASES_TAC `Gst <= &3` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `&16 <= Gst pow 2` ASSUME_TAC THENL + [MP_TAC(SPECL [`2`; `&4:int`; `Gst:int`] INT_POW_LE2) THEN + ANTS_TAC THENL [ASM_INT_ARITH_TAC; CONV_TAC INT_REDUCE_CONV]; + UNDISCH_TAC `&3 * Gst pow 2 <= &4 * &10` THEN + ASM_INT_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN `Gst = &3` ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `l pow 2 = &0 \/ l pow 2 = &1` + (LABEL_TAC "lsqcases") THENL + [UNDISCH_TAC `&4 * l pow 2 <= &4` THEN + MP_TAC(SPEC `l:int` INT_LE_POW_2) THEN INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `Fst = &2 /\ l pow 2 = &1` STRIP_ASSUME_TAC THENL + [REMOVE_THEN "lsqcases" (DISJ_CASES_THEN ASSUME_TAC) THEN + UNDISCH_TAC `&2 <= Fst` THEN + UNDISCH_TAC `&2 * Fst = l pow 2 + Gst` THEN + ASM_REWRITE_TAC[] THEN INT_ARITH_TAC; + ALL_TAC] THEN + MAP_EVERY EXISTS_TAC [`x1:int`; `s:int`; `t:int`] THEN + REPEAT CONJ_TAC THENL + [MAP_EVERY EXISTS_TAC [`p:int`; `q:int`] THEN ASM_REWRITE_TAC[]; + EXPAND_TAC "Fst" THEN ASM_REWRITE_TAC[]; + EXPAND_TAC "l" THEN ASM_REWRITE_TAC[]; + EXPAND_TAC "Gst" THEN + MAP_EVERY EXPAND_TAC ["G11"; "G12"; "G22"] THEN + ASM_REWRITE_TAC[]]);; + +let DISC5_MIN2_EXCLUDED = prove + (`!b12 b13 b22 b23 b33:int. + &2 * (b22 * b33 - b23 pow 2) - + b12 * (b12 * b33 - b13 * b23) + + b13 * (b12 * b23 - b13 * b22) = &5 /\ + &0 < &2 * b22 - b12 pow 2 /\ + (!x y z. ~(x = &0 /\ y = &0 /\ z = &0) + ==> &2 <= &2 * x pow 2 + b22 * y pow 2 + + b33 * z pow 2 + &2 * b12 * x * y + + &2 * b13 * x * z + &2 * b23 * y * z) + ==> F`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(SPECL + [`b12:int`; `b13:int`; `b22:int`; `b23:int`; `b33:int`] + HERMITE_DISC5_MIN2_PAIR) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `r:int` + (X_CHOOSE_THEN `s:int` + (X_CHOOSE_THEN `t:int` + (CONJUNCTS_THEN2 + (X_CHOOSE_THEN `p:int` (X_CHOOSE_TAC `q:int`)) + STRIP_ASSUME_TAC)))) THEN + ABBREV_TAC `l = &2 * r + b12 * s + b13 * t` THEN + ABBREV_TAC + `d = &2 * r pow 2 + b22 * s pow 2 + b33 * t pow 2 + + &2 * b12 * r * s + &2 * b13 * r * t + + &2 * b23 * s * t` THEN + ABBREV_TAC `c = --(b12 * q) + b13 * p` THEN + ABBREV_TAC + `e = --(b12 * r * q) + b13 * r * p - b22 * s * q + + b23 * s * p - b23 * t * q + b33 * t * p` THEN + ABBREV_TAC + `f = b22 * q pow 2 + b33 * p pow 2 - &2 * b23 * p * q` THEN + SUBGOAL_THEN `d = &2 /\ l pow 2 = &1` STRIP_ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["d"; "l"] THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `&2 * (d * f - e pow 2) - + l * (l * f - c * e) + c * (l * e - d * c) = &5` + ASSUME_TAC THENL + [TRANS_TAC EQ_TRANS + `(&2 * (b22 * b33 - b23 pow 2) - + b12 * (b12 * b33 - b13 * b23) + + b13 * (b12 * b23 - b13 * b22)) * + (s * p + t * q) pow 2` THEN + CONJ_TAC THENL + [REWRITE_TAC + [GSYM(ASSUME `&2 * r + b12 * s + b13 * t = l`); + GSYM(ASSUME + `&2 * r pow 2 + b22 * s pow 2 + b33 * t pow 2 + + &2 * b12 * r * s + &2 * b13 * r * t + + &2 * b23 * s * t = d`); + GSYM(ASSUME `--(b12 * q) + b13 * p = c`); + GSYM(ASSUME + `--(b12 * r * q) + b13 * r * p - b22 * s * q + + b23 * s * p - b23 * t * q + b33 * t * p = e`); + GSYM(ASSUME + `b22 * q pow 2 + b33 * p pow 2 - &2 * b23 * p * q = f`)] THEN + CONV_TAC INT_RING; + ASM_REWRITE_TAC[] THEN CONV_TAC INT_REDUCE_CONV]; + ALL_TAC] THEN + MATCH_MP_TAC(SPECL [`l:int`; `c:int`; `e:int`; `f:int`] + DISC5_BLOCK2_FALSE) THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + UNDISCH_TAC + `&2 * (d * f - e pow 2) - + l * (l * f - c * e) + c * (l * e - d * c) = &5` THEN + REWRITE_TAC[ASSUME `d = &2`]]);; + +let HERMITE_DISC5_A1 = prove + (`!b11 b12 b13 b22 b23 b33:int. + &0 < b11 /\ + b11 * (b22 * b33 - b23 pow 2) - + b12 * (b12 * b33 - b13 * b23) + + b13 * (b12 * b23 - b13 * b22) = &5 /\ + &0 < b11 * b22 - b12 pow 2 /\ + (!x y z. ~(x = &0 /\ y = &0 /\ z = &0) + ==> b11 <= b11 * x pow 2 + b22 * y pow 2 + + b33 * z pow 2 + &2 * b12 * x * y + + &2 * b13 * x * z + &2 * b23 * y * z) + ==> b11 = &1`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(SPECL + [`b11:int`; `b12:int`; `b13:int`; `b22:int`; `b23:int`; `b33:int`] + HERMITE_DISC5_LE2) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(DISJ_CASES_THEN ASSUME_TAC) THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `F` MP_TAC THENL + [MATCH_MP_TAC(SPECL + [`b12:int`; `b13:int`; `b22:int`; `b23:int`; `b33:int`] + DISC5_MIN2_EXCLUDED) THEN + REPEAT CONJ_TAC THENL + [UNDISCH_TAC + `b11 * (b22 * b33 - b23 pow 2) - + b12 * (b12 * b33 - b13 * b23) + + b13 * (b12 * b23 - b13 * b22) = &5` THEN + ASM_REWRITE_TAC[]; + UNDISCH_TAC `&0 < b11 * b22 - b12 pow 2` THEN + ASM_REWRITE_TAC[]; + UNDISCH_TAC + `!x y z. ~(x = &0 /\ y = &0 /\ z = &0) + ==> b11 <= b11 * x pow 2 + b22 * y pow 2 + + b33 * z pow 2 + &2 * b12 * x * y + + &2 * b13 * x * z + &2 * b23 * y * z` THEN + ASM_REWRITE_TAC[]]; + MESON_TAC[]]);; + +let TERNARY_DISC5_SECOND = prove + (`!a11 a12 a13 a22 a23 a33 q n:int. + &0 < a11 /\ + &0 < a11 * a22 - a12 pow 2 /\ + a11 * (a22 * a33 - a23 pow 2) - + a12 * (a12 * a33 - a13 * a23) + + a13 * (a12 * a23 - a13 * a22) = &5 /\ + (?x y z. + a11 * x pow 2 + a22 * y pow 2 + a33 * z pow 2 + + &2 * a12 * x * y + &2 * a13 * x * z + + &2 * a23 * y * z = &8 * q + &3) /\ + (?x y z. + a11 * x pow 2 + a22 * y pow 2 + a33 * z pow 2 + + &2 * a12 * x * y + &2 * a13 * x * z + + &2 * a23 * y * z = n) + ==> ?u v w:int. + u pow 2 + &2 * v pow 2 + &2 * v * w + &3 * w pow 2 = n`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN + `!x y z. ~(x = &0 /\ y = &0 /\ z = &0) + ==> &0 < a11 * x pow 2 + a22 * y pow 2 + a33 * z pow 2 + + &2 * a12 * x * y + &2 * a13 * x * z + + &2 * a23 * y * z` + (LABEL_TAC "posdef") THENL + [MATCH_MP_TAC TERNARY_POSDEF THEN ASM_REWRITE_TAC[] THEN + ASM_INT_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(SPECL + [`a11:int`; `a12:int`; `a13:int`; `a22:int`; `a23:int`; `a33:int`] + TERNARY_MIN) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `v1:int` + (X_CHOOSE_THEN `v2:int` + (X_CHOOSE_THEN `v3:int` + (CONJUNCTS_THEN2 (LABEL_TAC "vnonzero") + (LABEL_TAC "amin"))))) THEN + SUBGOAL_THEN `?p q r. v1 * p + v2 * q + v3 * r = &1` + STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC MIN_PRIMITIVE THEN + MAP_EVERY EXISTS_TAC + [`a11:int`; `a12:int`; `a13:int`; `a22:int`; `a23:int`; `a33:int`] THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MP_TAC(SPECL [`v1:int`; `v2:int`; `v3:int`] SL3_EXTEND) THEN + ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `c12:int` + (X_CHOOSE_THEN `c13:int` + (X_CHOOSE_THEN `c22:int` + (X_CHOOSE_THEN `c23:int` + (X_CHOOSE_THEN `c32:int` + (X_CHOOSE_THEN `c33:int` (LABEL_TAC "detU"))))))) THEN + ABBREV_TAC + `b11 = a11 * v1 pow 2 + &2 * a12 * v1 * v2 + + &2 * a13 * v1 * v3 + a22 * v2 pow 2 + + &2 * a23 * v2 * v3 + a33 * v3 pow 2` THEN + ABBREV_TAC + `b22 = a11 * c12 pow 2 + &2 * a12 * c12 * c22 + + &2 * a13 * c12 * c32 + a22 * c22 pow 2 + + &2 * a23 * c22 * c32 + a33 * c32 pow 2` THEN + ABBREV_TAC + `b33 = a11 * c13 pow 2 + &2 * a12 * c13 * c23 + + &2 * a13 * c13 * c33 + a22 * c23 pow 2 + + &2 * a23 * c23 * c33 + a33 * c33 pow 2` THEN + ABBREV_TAC + `b12 = a11 * v1 * c12 + a12 * (v1 * c22 + v2 * c12) + + a13 * (v1 * c32 + v3 * c12) + a22 * v2 * c22 + + a23 * (v2 * c32 + v3 * c22) + a33 * v3 * c32` THEN + ABBREV_TAC + `b13 = a11 * v1 * c13 + a12 * (v1 * c23 + v2 * c13) + + a13 * (v1 * c33 + v3 * c13) + a22 * v2 * c23 + + a23 * (v2 * c33 + v3 * c23) + a33 * v3 * c33` THEN + ABBREV_TAC + `b23 = a11 * c12 * c13 + a12 * (c12 * c23 + c22 * c13) + + a13 * (c12 * c33 + c32 * c13) + a22 * c22 * c23 + + a23 * (c22 * c33 + c32 * c23) + a33 * c32 * c33` THEN + SUBGOAL_THEN + `!x y z. ~(x = &0 /\ y = &0 /\ z = &0) + ==> b11 <= b11 * x pow 2 + b22 * y pow 2 + + b33 * z pow 2 + &2 * b12 * x * y + + &2 * b13 * x * z + &2 * b23 * y * z` + (LABEL_TAC "bmin") THENL + [MATCH_MP_TAC CONJ_MIN THEN + MAP_EVERY EXISTS_TAC + [`a11:int`; `a12:int`; `a13:int`; `a22:int`; `a23:int`; `a33:int`; + `v1:int`; `v2:int`; `v3:int`; `c12:int`; `c13:int`; + `c22:int`; `c23:int`; `c32:int`; `c33:int`] THEN + ASM_REWRITE_TAC[] THEN + MAP_EVERY EXPAND_TAC ["b11"; "b12"; "b13"; "b22"; "b23"; "b33"]; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < b11` ASSUME_TAC THENL + [MP_TAC(MATCH_MP + (SPECL [`v1:int`; `v2:int`; `v3:int`] + (ASSUME + `!x y z. ~(x = &0 /\ y = &0 /\ z = &0) + ==> &0 < a11 * x pow 2 + a22 * y pow 2 + + a33 * z pow 2 + &2 * a12 * x * y + + &2 * a13 * x * z + &2 * a23 * y * z`)) + (ASSUME `~(v1 = &0 /\ v2 = &0 /\ v3 = &0)`)) THEN + EXPAND_TAC "b11" THEN INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `b11 * (b22 * b33 - b23 pow 2) - + b12 * (b12 * b33 - b13 * b23) + + b13 * (b12 * b23 - b13 * b22) = &5` + (LABEL_TAC "bdet") THENL + [TRANS_TAC EQ_TRANS + `(a11 * (a22 * a33 - a23 pow 2) - + a12 * (a12 * a33 - a13 * a23) + + a13 * (a12 * a23 - a13 * a22)) * + (v1 * (c22 * c33 - c23 * c32) - + c12 * (v2 * c33 - c23 * v3) + + c13 * (v2 * c32 - c22 * v3)) pow 2` THEN + CONJ_TAC THENL + [MAP_EVERY EXPAND_TAC + ["b11"; "b12"; "b13"; "b22"; "b23"; "b33"] THEN + CONV_TAC INT_RING; + USE_THEN "detU" (fun th -> REWRITE_TAC[th]) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC INT_REDUCE_CONV]; + ALL_TAC] THEN + SUBGOAL_THEN + `!x y z. ~(x = &0 /\ y = &0 /\ z = &0) + ==> &0 < b11 * x pow 2 + b22 * y pow 2 + + b33 * z pow 2 + &2 * b12 * x * y + + &2 * b13 * x * z + &2 * b23 * y * z` + (LABEL_TAC "bposdef") THENL + [REPEAT STRIP_TAC THEN + MATCH_MP_TAC INT_LTE_TRANS THEN EXISTS_TAC `b11:int` THEN + ASM_REWRITE_TAC[] THEN USE_THEN "bmin" MATCH_MP_TAC THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < b11 * b22 - b12 pow 2` + (LABEL_TAC "bminor") THENL + [MATCH_MP_TAC POSDEF_MINOR2 THEN + MAP_EVERY EXISTS_TAC [`b13:int`; `b23:int`; `b33:int`] THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `b11 = &1` ASSUME_TAC THENL + [MATCH_MP_TAC HERMITE_DISC5_A1 THEN + MAP_EVERY EXISTS_TAC + [`b12:int`; `b13:int`; `b22:int`; `b23:int`; `b33:int`] THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `!r:int. + (?x y z. + a11 * x pow 2 + a22 * y pow 2 + a33 * z pow 2 + + &2 * a12 * x * y + &2 * a13 * x * z + + &2 * a23 * y * z = r) + ==> ?x y z. + b11 * x pow 2 + b22 * y pow 2 + b33 * z pow 2 + + &2 * b12 * x * y + &2 * b13 * x * z + + &2 * b23 * y * z = r` + (LABEL_TAC "transfer") THENL + [X_GEN_TAC `r0:int` THEN DISCH_TAC THEN + MATCH_MP_TAC CONJ_REPS THEN + MAP_EVERY EXISTS_TAC + [`a11:int`; `a12:int`; `a13:int`; `a22:int`; `a23:int`; `a33:int`; + `v1:int`; `v2:int`; `v3:int`; `c12:int`; `c13:int`; + `c22:int`; `c23:int`; `c32:int`; `c33:int`] THEN + ASM_REWRITE_TAC[] THEN + MAP_EVERY EXPAND_TAC ["b11"; "b12"; "b13"; "b22"; "b23"; "b33"]; + ALL_TAC] THEN + USE_THEN "transfer" + (fun tr -> + MP_TAC(MATCH_MP (SPEC `&8 * q + &3:int` tr) + (ASSUME + `?x y z. + a11 * x pow 2 + a22 * y pow 2 + a33 * z pow 2 + + &2 * a12 * x * y + &2 * a13 * x * z + + &2 * a23 * y * z = &8 * q + &3`))) THEN + DISCH_THEN(LABEL_TAC "b3rep") THEN + USE_THEN "transfer" + (fun tr -> + MP_TAC(MATCH_MP (SPEC `n:int` tr) + (ASSUME + `?x y z. + a11 * x pow 2 + a22 * y pow 2 + a33 * z pow 2 + + &2 * a12 * x * y + &2 * a13 * x * z + + &2 * a23 * y * z = n`))) THEN + DISCH_THEN(LABEL_TAC "bnrep") THEN + MATCH_MP_TAC TERNARY_DISC5_A11_1_SECOND THEN + MAP_EVERY EXISTS_TAC + [`b12:int`; `b13:int`; `b22:int`; `b23:int`; `b33:int`; `q:int`] THEN + SUBST1_TAC(ASSUME `b11 = &1`) THEN + REPEAT CONJ_TAC THENL + [REMOVE_THEN "bminor" + (fun th -> + MP_TAC th THEN REWRITE_TAC[ASSUME `b11 = &1`; INT_MUL_LID]); + REMOVE_THEN "bdet" + (fun th -> + MP_TAC th THEN REWRITE_TAC[ASSUME `b11 = &1`; INT_MUL_LID] THEN + CONV_TAC INT_RING); + REMOVE_THEN "b3rep" + (fun th -> + MP_TAC th THEN REWRITE_TAC[ASSUME `b11 = &1`; INT_MUL_LID]); + REMOVE_THEN "bnrep" + (fun th -> + MP_TAC th THEN REWRITE_TAC[ASSUME `b11 = &1`; INT_MUL_LID])]);; + +let TERNARY_DISC5_DOUBLE = prove + (`!a11 a12 a13 a22 a23 a33 q n:int. + &0 < a11 /\ + &0 < a11 * a22 - a12 pow 2 /\ + a11 * (a22 * a33 - a23 pow 2) - + a12 * (a12 * a33 - a13 * a23) + + a13 * (a12 * a23 - a13 * a22) = &5 /\ + (?x y z. + a11 * x pow 2 + a22 * y pow 2 + a33 * z pow 2 + + &2 * a12 * x * y + &2 * a13 * x * z + + &2 * a23 * y * z = &8 * q + &3) /\ + (?x y z. + a11 * x pow 2 + a22 * y pow 2 + a33 * z pow 2 + + &2 * a12 * x * y + &2 * a13 * x * z + + &2 * a23 * y * z = n) + ==> ?u v w:int. + u pow 2 + &2 * v pow 2 + &5 * w pow 2 = &2 * n`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC REP_125_DOUBLE_OF_T THEN + MATCH_MP_TAC(SPECL + [`a11:int`; `a12:int`; `a13:int`; `a22:int`; `a23:int`; `a33:int`; + `q:int`; `n:int`] TERNARY_DISC5_SECOND) THEN + ASM_REWRITE_TAC[]);; + +let LEMMA_125_DOUBLE = prove + (`!a k beta t h:int. + &0 < a /\ &0 < beta /\ + beta = &8 * a * k - &5 /\ + beta * h = t pow 2 + &8 * k + ==> ?u v w:int. + u pow 2 + &2 * v pow 2 + &5 * w pow 2 = &2 * a`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC TERNARY_DISC5_DOUBLE THEN + MAP_EVERY EXISTS_TAC + [`a:int`; `&0:int`; `&1:int`; `beta:int`; `t:int`; `h:int`; + `a * k - &1:int`] THEN + REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + REWRITE_TAC[INT_POW_2; INT_MUL_LZERO; INT_SUB_RZERO] THEN + MATCH_MP_TAC INT_LT_MUL THEN ASM_REWRITE_TAC[]; + MAP_EVERY UNDISCH_TAC + [`beta = &8 * a * k - &5`; + `beta * h = t pow 2 + &8 * k`] THEN + CONV_TAC INT_RING; + MAP_EVERY EXISTS_TAC [`&0:int`; `&1:int`; `&0:int`] THEN + UNDISCH_TAC `beta = &8 * a * k - &5` THEN + CONV_TAC INT_RING; + MAP_EVERY EXISTS_TAC [`&1:int`; `&0:int`; `&0:int`] THEN + CONV_TAC INT_RING]);; + +let COPRIME_5_20J1 = prove + (`!j:num. coprime(5,20*j+1)`, + GEN_TAC THEN REWRITE_TAC[COPRIME_BEZOUT] THEN + MAP_EVERY EXISTS_TAC [`1`; `4*j`] THEN + DISJ2_TAC THEN ARITH_TAC);; + +let JACOBI_5_20J1 = prove + (`!j:num. jacobi(5,20*j+1) = &1`, + GEN_TAC THEN + SUBGOAL_THEN `ODD(20*j+1)` ASSUME_TAC THENL + [REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH]; + ALL_TAC] THEN + SUBGOAL_THEN `jacobi(20*j+1,5) = &1` ASSUME_TAC THENL + [TRANS_TAC EQ_TRANS `jacobi(1,5)` THEN CONJ_TAC THENL + [MATCH_MP_TAC JACOBI_CONG THEN NUMBER_TAC; + REWRITE_TAC[JACOBI_1]]; + ALL_TAC] THEN + MP_TAC(SPECL [`5`; `20*j+1`] JACOBI_RECIPROCITY) THEN + ASM_REWRITE_TAC[COPRIME_5_20J1; NUM_REDUCE_CONV `ODD 5`] THEN + REWRITE_TAC[ARITH_RULE `(5-1) DIV 2 = 2`; EVEN_MULT; + INT_POW_NEG; INT_POW_ONE; NUM_REDUCE_CONV `EVEN 2`] THEN + INT_ARITH_TAC);; + +let CONG_BETA_NEG5_125_DOUBLE = prove + (`!a j beta:num. + 1 <= a /\ beta = 8*a*(20*j+1)-5 + ==> (beta == 5*((20*j+1)-1)) (mod (20*j+1))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `5*((20*j+1)-1) = 5*(20*j+1)-5` + SUBST1_TAC THENL + [ARITH_TAC; + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONG_SUB THEN + REPEAT CONJ_TAC THENL + [NUMBER_TAC; + REWRITE_TAC[CONG_REFL]; + ASM_ARITH_TAC; + ARITH_TAC]]);; + +let JACOBI_BETA_20J1 = prove + (`!a j beta:num. + 1 <= a /\ beta = 8*a*(20*j+1)-5 + ==> jacobi(beta,20*j+1) = &1`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(20*j+1 == 1) (mod 4)` ASSUME_TAC THENL + [NUMBER_TAC; + ALL_TAC] THEN + TRANS_TAC EQ_TRANS `jacobi(5*((20*j+1)-1),20*j+1)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC JACOBI_CONG THEN + MATCH_MP_TAC(SPECL [`a:num`; `j:num`; `beta:num`] + CONG_BETA_NEG5_125_DOUBLE) THEN + ASM_REWRITE_TAC[]; + REWRITE_TAC[JACOBI_LMUL; JACOBI_5_20J1] THEN + ASM_SIMP_TAC[JACOBI_M1_1MOD4] THEN CONV_TAC INT_REDUCE_CONV]);; + +let COPRIME_BETA_20J1 = prove + (`!a j beta:num. + 1 <= a /\ beta = 8*a*(20*j+1)-5 + ==> coprime(beta,20*j+1)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `jacobi(beta,20*j+1) = &1` ASSUME_TAC THENL + [MATCH_MP_TAC(SPECL [`a:num`; `j:num`; `beta:num`] + JACOBI_BETA_20J1) THEN + ASM_REWRITE_TAC[]; + MP_TAC(SPECL [`beta:num`; `20*j+1`] JACOBI_EQ_0) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC INT_REDUCE_CONV]);; + +let CONG_BETA_3MOD8_125_DOUBLE = prove + (`!a j beta:num. + 1 <= a /\ beta = 8*a*(20*j+1)-5 + ==> (beta == 3) (mod 8)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `beta = (a*(20*j+1)-1)*8+3` + SUBST1_TAC THENL + [ASM_ARITH_TAC; + REWRITE_TAC[CONG] THEN SIMP_TAC[MOD_MULT_ADD] THEN + CONV_TAC NUM_REDUCE_CONV]);; + +let JACOBI_K_BETA_125_DOUBLE = prove + (`!a j beta:num. + 1 <= a /\ beta = 8*a*(20*j+1)-5 + ==> jacobi(20*j+1,beta) = &1`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(beta == 3) (mod 8)` ASSUME_TAC THENL + [MATCH_MP_TAC(SPECL [`a:num`; `j:num`; `beta:num`] + CONG_BETA_3MOD8_125_DOUBLE) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `(beta == 3) (mod 4)` ASSUME_TAC THENL + [MATCH_MP_TAC CONG_MOD_8_IMP_MOD_4 THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `ODD beta` ASSUME_TAC THENL + [MATCH_MP_TAC ODD_OF_3MOD4 THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `jacobi(beta,20*j+1) = &1` ASSUME_TAC THENL + [MATCH_MP_TAC(SPECL [`a:num`; `j:num`; `beta:num`] + JACOBI_BETA_20J1) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `coprime(beta,20*j+1)` ASSUME_TAC THENL + [MATCH_MP_TAC(SPECL [`a:num`; `j:num`; `beta:num`] + COPRIME_BETA_20J1) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `coprime(20*j+1,beta)` ASSUME_TAC THENL + [ONCE_REWRITE_TAC[COPRIME_SYM] THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MP_TAC(SPECL [`20*j+1`; `beta:num`] JACOBI_FLIP_1MOD4) THEN + ASM_REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH] THEN + ANTS_TAC THENL [NUMBER_TAC; INT_ARITH_TAC]);; + +let JACOBI_NEG8K_BETA_125_DOUBLE = prove + (`!a j beta:num. + 1 <= a /\ beta = 8*a*(20*j+1)-5 + ==> jacobi((8*(20*j+1))*(beta-1),beta) = &1`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(beta == 3) (mod 8)` ASSUME_TAC THENL + [MATCH_MP_TAC(SPECL [`a:num`; `j:num`; `beta:num`] + CONG_BETA_3MOD8_125_DOUBLE) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `(beta == 3) (mod 4)` ASSUME_TAC THENL + [MATCH_MP_TAC CONG_MOD_8_IMP_MOD_4 THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `jacobi(20*j+1,beta) = &1` ASSUME_TAC THENL + [MATCH_MP_TAC(SPECL [`a:num`; `j:num`; `beta:num`] + JACOBI_K_BETA_125_DOUBLE) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `jacobi(8,beta) = -- &1` ASSUME_TAC THENL + [REWRITE_TAC[ARITH_RULE `8 = 2 EXP 3`; JACOBI_LEXP] THEN + ASM_SIMP_TAC[JACOBI_2_3MOD8] THEN CONV_TAC INT_REDUCE_CONV; + ALL_TAC] THEN + REWRITE_TAC[ARITH_RULE + `(8*k)*(beta-1) = 2*2*2*k*(beta-1)`; JACOBI_LMUL] THEN + ASM_SIMP_TAC[JACOBI_2_3MOD8; JACOBI_M1_3MOD4] THEN + CONV_TAC INT_REDUCE_CONV);; + +let QR_125_DOUBLE = prove + (`!a j beta:num. + 1 <= a /\ prime beta /\ beta = 8*a*(20*j+1)-5 + ==> ?t. (t EXP 2 + 8*(20*j+1) == 0) (mod beta)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC JACOBI_NEGATIVE_SQUARE THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(SPECL [`a:num`; `j:num`; `beta:num`] + JACOBI_NEG8K_BETA_125_DOUBLE) THEN + ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Dirichlet progression beta = 8 a (20j+1) - 5. *) +(* ------------------------------------------------------------------------- *) + +let COPRIME_125_DOUBLE_OFFSET_A = prove + (`!a:num. + 1 <= a /\ ~(5 divides a) + ==> coprime(8*a-5,a)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `coprime(5,a)` ASSUME_TAC THENL + [MP_TAC(MATCH_MP (SPECL [`5`; `a:num`] PRIME_COPRIME_EQ) + (EQT_ELIM(PRIME_CONV `prime 5`))) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[COPRIME] THEN X_GEN_TAC `d:num` THEN EQ_TAC THENL + [STRIP_TAC THEN + SUBGOAL_THEN `d divides 8*a` ASSUME_TAC THENL + [MATCH_MP_TAC(SPECL [`d:num`; `a:num`; `8`] DIVIDES_LMUL) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `d divides 5` ASSUME_TAC THENL + [SUBGOAL_THEN `5 = 8*a - (8*a-5)` SUBST1_TAC THENL + [ASM_ARITH_TAC; + MATCH_MP_TAC(SPECL [`d:num`; `8*a`; `8*a-5`] DIVIDES_SUB) THEN + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + MP_TAC(SPEC `d:num` + (REWRITE_RULE[COPRIME] (ASSUME `coprime(5,a)`))) THEN + ASM_REWRITE_TAC[]; + DISCH_TAC THEN ASM_REWRITE_TAC[DIVIDES_1]]);; + +let COPRIME_125_DOUBLE_OFFSET_160 = prove + (`!a:num. + 1 <= a /\ ~(5 divides a) + ==> coprime(8*a-5,160)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `ODD(8*a-5)` ASSUME_TAC THENL + [REWRITE_TAC[ODD_EXISTS] THEN EXISTS_TAC `4*a-3` THEN + ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `~(5 divides (8*a-5))` ASSUME_TAC THENL + [DISCH_TAC THEN + SUBGOAL_THEN `5 divides 8*a` ASSUME_TAC THENL + [SUBGOAL_THEN `8*a = (8*a-5)+5` SUBST1_TAC THENL + [ASM_ARITH_TAC; + MATCH_MP_TAC DIVIDES_ADD THEN ASM_REWRITE_TAC[DIVIDES_REFL]]; + ALL_TAC] THEN + MP_TAC(ASSUME `5 divides 8*a`) THEN + REWRITE_TAC[MATCH_MP (SPEC `5` PRIME_DIVPROD_EQ) + (EQT_ELIM(PRIME_CONV `prime 5`))] THEN + ASM_REWRITE_TAC[] THEN + CONV_TAC(RAND_CONV DIVIDES_CONV) THEN REWRITE_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[ARITH_RULE `160 = 2*2*2*2*2*5`; COPRIME_RMUL] THEN + ASM_REWRITE_TAC[CONJUNCT2 COPRIME_2] THEN + ONCE_REWRITE_TAC[COPRIME_SYM] THEN + ASM_REWRITE_TAC[MATCH_MP (SPEC `5` PRIME_COPRIME_EQ) + (EQT_ELIM(PRIME_CONV `prime 5`))]);; + +let COPRIME_DIRICHLET_125_DOUBLE = prove + (`!a:num. + 1 <= a /\ ~(5 divides a) + ==> coprime(8*a-5,160*a)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[COPRIME_RMUL] THEN + CONJ_TAC THENL + [MATCH_MP_TAC COPRIME_125_DOUBLE_OFFSET_160 THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC COPRIME_125_DOUBLE_OFFSET_A THEN ASM_REWRITE_TAC[]]);; + +let DIRICHLET_PRIME_125_DOUBLE = prove + (`!a:num. + 1 <= a /\ ~(5 divides a) + ==> ?p. prime p /\ (p == 8*a-5) (mod (160*a))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC DIRICHLET_PRIME_CONG THEN + ASM_SIMP_TAC[COPRIME_DIRICHLET_125_DOUBLE] THEN ASM_ARITH_TAC);; + +let RESIDUE_125_DOUBLE = prove + (`!a:num. + 1 <= a /\ ~(5 divides a) + ==> ?j t. + (8*a*(20*j+1)-5) divides + (t EXP 2 + 8*(20*j+1))`, + REPEAT STRIP_TAC THEN + MP_TAC(SPEC `a:num` DIRICHLET_PRIME_125_DOUBLE) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `beta:num` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `?j. beta = 160*a*j + (8*a-5)` + (X_CHOOSE_TAC `j:num`) THENL + [MP_TAC(SPECL [`160*a`; `8*a-5`; `beta:num`] CONG_CASE) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `beta = 8*a*(20*j+1)-5` + ASSUME_TAC THENL + [UNDISCH_TAC `beta = 160*a*j + (8*a-5)` THEN ASM_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(MATCH_MP + (SPECL [`a:num`; `j:num`; `beta:num`] QR_125_DOUBLE) + (CONJ (ASSUME `1 <= a`) + (CONJ (ASSUME `prime beta`) + (ASSUME `beta = 8*a*(20*j+1)-5`)))) THEN + DISCH_THEN(X_CHOOSE_TAC `t:num`) THEN + MAP_EVERY EXISTS_TAC [`j:num`; `t:num`] THEN + ONCE_REWRITE_TAC[GSYM + (ASSUME `beta = 8*a*(20*j+1)-5`)] THEN + MP_TAC(ASSUME + `(t EXP 2 + 8*(20*j+1) == 0) (mod beta)`) THEN + REWRITE_TAC[CONG_0_DIVIDES]);; + +let REGULAR_125_DOUBLE_COPRIME5 = prove + (`!a:num. + 1 <= a /\ ~(5 divides a) + ==> ?u v w:int. + u pow 2 + &2*v pow 2 + &5*w pow 2 = &2 * &a`, + REPEAT STRIP_TAC THEN + MP_TAC(SPEC `a:num` RESIDUE_125_DOUBLE) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `j:num` (X_CHOOSE_TAC `t:num`)) THEN + FIRST_X_ASSUM(X_CHOOSE_TAC `h:num` o REWRITE_RULE[divides]) THEN + SUBGOAL_THEN `5 <= 8*a*(20*j+1)` ASSUME_TAC THENL + [ASM_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(SPECL + [`&a:int`; `&(20*j+1):int`; `&(8*a*(20*j+1)-5):int`; + `&t:int`; `&h:int`] LEMMA_125_DOUBLE) THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[INT_OF_NUM_LT] THEN ASM_ARITH_TAC; + REWRITE_TAC[INT_OF_NUM_LT] THEN ASM_ARITH_TAC; + ASM_SIMP_TAC[INT_OF_NUM_SUB; INT_OF_NUM_MUL; INT_OF_NUM_ADD] THEN + CONV_TAC INT_RING; + FIRST_X_ASSUM(MP_TAC o AP_TERM `int_of_num`) THEN + ASM_SIMP_TAC + [INT_OF_NUM_SUB; INT_OF_NUM_ADD; INT_OF_NUM_MUL; + INT_OF_NUM_POW]]);; + +let LEMMA_125_T_FIVE = prove + (`!a t beta r c s:int. + &0 < a /\ &0 < beta /\ + beta = &8 * t * a - &5 /\ + (&5 * a) * (beta * c - r pow 2) - beta * s pow 2 = &5 + ==> ?u v w:int. + u pow 2 + &2 * v pow 2 + &2 * v * w + &3 * w pow 2 = + &5 * a`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC TERNARY_DISC5_SECOND THEN + MAP_EVERY EXISTS_TAC + [`&5 * a:int`; `&0:int`; `s:int`; `beta:int`; `r:int`; `c:int`; + `t * a - &1:int`] THEN + REPEAT CONJ_TAC THENL + [ASM_INT_ARITH_TAC; + REWRITE_TAC[INT_POW_2; INT_MUL_LZERO; INT_SUB_RZERO] THEN + MATCH_MP_TAC INT_LT_MUL THEN ASM_INT_ARITH_TAC; + UNDISCH_TAC + `(&5 * a) * (beta * c - r pow 2) - beta * s pow 2 = &5` THEN + CONV_TAC INT_RING; + MAP_EVERY EXISTS_TAC [`&0:int`; `&1:int`; `&0:int`] THEN + UNDISCH_TAC `beta = &8 * t * a - &5` THEN CONV_TAC INT_RING; + MAP_EVERY EXISTS_TAC [`&1:int`; `&0:int`; `&0:int`] THEN + CONV_TAC INT_RING]);; + +let LEMMA_125_T_FIVE_PLUS = prove + (`!a t beta r p c:int. + &0 < a /\ &0 < beta /\ + beta = &8 * t * a - &5 /\ + beta * p = &8 * t + &5 * r pow 2 /\ + &5 * c = p + &4 * a + &4 + ==> ?u v w:int. + u pow 2 + &2 * v pow 2 + &2 * v * w + &3 * w pow 2 = + &5 * a`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC(SPECL + [`a:int`; `t:int`; `beta:int`; `r:int`; `c:int`; + `&1 + &2 * a:int`] LEMMA_125_T_FIVE) THEN + ASM_REWRITE_TAC[] THEN + MAP_EVERY UNDISCH_TAC + [`beta = &8 * t * a - &5`; + `beta * p = &8 * t + &5 * r pow 2`; + `&5 * c = p + &4 * a + &4`] THEN + CONV_TAC INT_RING);; + +let LEMMA_125_T_FIVE_MINUS = prove + (`!a t beta r p c:int. + &0 < a /\ &0 < beta /\ + beta = &8 * t * a - &5 /\ + beta * p = &8 * t + &5 * r pow 2 /\ + &5 * c = p + &4 * a - &4 + ==> ?u v w:int. + u pow 2 + &2 * v pow 2 + &2 * v * w + &3 * w pow 2 = + &5 * a`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC(SPECL + [`a:int`; `t:int`; `beta:int`; `r:int`; `c:int`; + `&1 - &2 * a:int`] LEMMA_125_T_FIVE) THEN + ASM_REWRITE_TAC[] THEN + MAP_EVERY UNDISCH_TAC + [`beta = &8 * t * a - &5`; + `beta * p = &8 * t + &5 * r pow 2`; + `&5 * c = p + &4 * a - &4`] THEN + CONV_TAC INT_RING);; + +let JACOBI_4_5 = prove + (`jacobi(4,5) = &1`, + REWRITE_TAC[ARITH_RULE `4 = 2 EXP 2`; CONJUNCT1 JACOBI_SQUARED] THEN + SUBGOAL_THEN `coprime(2,5)` ASSUME_TAC THENL + [REWRITE_TAC[COPRIME_BEZOUT] THEN + MAP_EVERY EXISTS_TAC [`3`; `1`] THEN DISJ1_TAC THEN ARITH_TAC; + ASM_REWRITE_TAC[]]);; + +let CONG_2_MOD_5_CASE = prove + (`!a:num. (a == 2) (mod 5) ==> ?q. a = 5*q+2`, + MESON_TAC[CONG_CASE; MULT_SYM; ARITH_RULE `2 < 5`]);; + +let CONG_3_MOD_5_CASE = prove + (`!a:num. (a == 3) (mod 5) ==> ?q. a = 5*q+3`, + MESON_TAC[CONG_CASE; MULT_SYM; ARITH_RULE `3 < 5`]);; + +let CONG_BETA_1MOD5_125_FIVE = prove + (`!a j beta:num. + (a == 2) (mod 5) /\ beta = 8*a*(20*j+1)-5 + ==> (beta == 1) (mod 5)`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(X_CHOOSE_TAC `q:num` o MATCH_MP CONG_2_MOD_5_CASE) THEN + SUBGOAL_THEN + `beta = 5*(160*q*j+8*q+64*j+2)+1` + SUBST1_TAC THENL + [ASM_REWRITE_TAC[] THEN ARITH_TAC; + REWRITE_TAC[CONG] THEN SIMP_TAC[MOD_MULT_ADD] THEN + CONV_TAC NUM_REDUCE_CONV]);; + +let CONG_BETA_4MOD5_125_FIVE = prove + (`!a j beta:num. + (a == 3) (mod 5) /\ beta = 8*a*(20*j+1)-5 + ==> (beta == 4) (mod 5)`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(X_CHOOSE_TAC `q:num` o MATCH_MP CONG_3_MOD_5_CASE) THEN + SUBGOAL_THEN + `beta = 5*(160*q*j+8*q+96*j+3)+4` + SUBST1_TAC THENL + [ASM_REWRITE_TAC[] THEN ARITH_TAC; + REWRITE_TAC[CONG] THEN SIMP_TAC[MOD_MULT_ADD] THEN + CONV_TAC NUM_REDUCE_CONV]);; + +let JACOBI_BETA_5_125_FIVE_PLUS = prove + (`!a j beta:num. + (a == 2) (mod 5) /\ + beta = 8*a*(20*j+1)-5 + ==> jacobi(beta,5) = &1`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(beta == 1) (mod 5)` ASSUME_TAC THENL + [MATCH_MP_TAC(SPECL [`a:num`; `j:num`; `beta:num`] + CONG_BETA_1MOD5_125_FIVE) THEN + ASM_REWRITE_TAC[]; + MP_TAC(SPECL [`beta:num`; `1`; `5`] JACOBI_CONG) THEN + ASM_REWRITE_TAC[JACOBI_1]]);; + +let JACOBI_BETA_5_125_FIVE_MINUS = prove + (`!a j beta:num. + (a == 3) (mod 5) /\ + beta = 8*a*(20*j+1)-5 + ==> jacobi(beta,5) = &1`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(beta == 4) (mod 5)` ASSUME_TAC THENL + [MATCH_MP_TAC(SPECL [`a:num`; `j:num`; `beta:num`] + CONG_BETA_4MOD5_125_FIVE) THEN + ASM_REWRITE_TAC[]; + MP_TAC(SPECL [`beta:num`; `4`; `5`] JACOBI_CONG) THEN + ASM_REWRITE_TAC[JACOBI_4_5]]);; + +let JACOBI_BETA_5_125_FIVE = prove + (`!a j beta:num. + 1 <= a /\ + ((a == 2) (mod 5) \/ (a == 3) (mod 5)) /\ + beta = 8*a*(20*j+1)-5 + ==> jacobi(beta,5) = &1`, + MESON_TAC + [JACOBI_BETA_5_125_FIVE_PLUS; JACOBI_BETA_5_125_FIVE_MINUS]);; + +let JACOBI_5_BETA_OF_3MOD8 = prove + (`!beta:num. + (beta == 3) (mod 8) /\ jacobi(beta,5) = &1 + ==> jacobi(5,beta) = &1`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(beta == 3) (mod 4)` ASSUME_TAC THENL + [MATCH_MP_TAC CONG_MOD_8_IMP_MOD_4 THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `ODD beta` ASSUME_TAC THENL + [MATCH_MP_TAC ODD_OF_3MOD4 THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `coprime(beta,5)` ASSUME_TAC THENL + [ASM_CASES_TAC `coprime(beta,5)` THEN ASM_REWRITE_TAC[] THEN + MP_TAC(SPECL [`beta:num`; `5`] JACOBI_EQ_0) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC INT_REDUCE_CONV; + ALL_TAC] THEN + SUBGOAL_THEN `coprime(5,beta)` ASSUME_TAC THENL + [ONCE_REWRITE_TAC[COPRIME_SYM] THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MP_TAC(SPECL [`5`; `beta:num`] JACOBI_FLIP_1MOD4) THEN + ASM_REWRITE_TAC[NUM_REDUCE_CONV `ODD 5`] THEN + ANTS_TAC THENL [NUMBER_TAC; INT_ARITH_TAC]);; + +let JACOBI_5_BETA_125_FIVE = prove + (`!a j beta:num. + 1 <= a /\ + ((a == 2) (mod 5) \/ (a == 3) (mod 5)) /\ + beta = 8*a*(20*j+1)-5 + ==> jacobi(5,beta) = &1`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC JACOBI_5_BETA_OF_3MOD8 THEN CONJ_TAC THENL + [MATCH_MP_TAC(SPECL [`a:num`; `j:num`; `beta:num`] + CONG_BETA_3MOD8_125_DOUBLE) THEN + ASM_MESON_TAC[]; + MATCH_MP_TAC(SPECL [`a:num`; `j:num`; `beta:num`] + JACOBI_BETA_5_125_FIVE) THEN + ASM_MESON_TAC[]]);; + +let JACOBI_NEG40_OF_3MOD8 = prove + (`!t beta:num. + (beta == 3) (mod 8) /\ + jacobi(t,beta) = &1 /\ + jacobi(5,beta) = &1 + ==> jacobi((40*t)*(beta-1),beta) = &1`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(beta == 3) (mod 4)` ASSUME_TAC THENL + [MATCH_MP_TAC CONG_MOD_8_IMP_MOD_4 THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `jacobi(8,beta) = -- &1` ASSUME_TAC THENL + [REWRITE_TAC[ARITH_RULE `8 = 2 EXP 3`; JACOBI_LEXP] THEN + ASM_SIMP_TAC[JACOBI_2_3MOD8] THEN CONV_TAC INT_REDUCE_CONV; + ALL_TAC] THEN + SUBGOAL_THEN `jacobi(40,beta) = -- &1` ASSUME_TAC THENL + [MP_TAC(CONV_RULE + (LAND_CONV (RAND_CONV (LAND_CONV NUM_REDUCE_CONV))) + (SPECL [`5`; `8`; `beta:num`] JACOBI_LMUL)) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC INT_REDUCE_CONV; + ALL_TAC] THEN + REWRITE_TAC[JACOBI_LMUL] THEN + ASM_SIMP_TAC[JACOBI_M1_3MOD4] THEN CONV_TAC INT_REDUCE_CONV);; + +let JACOBI_NEG40T_BETA_125_FIVE = prove + (`!a j beta:num. + 1 <= a /\ + ((a == 2) (mod 5) \/ (a == 3) (mod 5)) /\ + beta = 8*a*(20*j+1)-5 + ==> jacobi((40*(20*j+1))*(beta-1),beta) = &1`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC JACOBI_NEG40_OF_3MOD8 THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC(SPECL [`a:num`; `j:num`; `beta:num`] + CONG_BETA_3MOD8_125_DOUBLE) THEN + ASM_MESON_TAC[]; + MATCH_MP_TAC(SPECL [`a:num`; `j:num`; `beta:num`] + JACOBI_K_BETA_125_DOUBLE) THEN + ASM_MESON_TAC[]; + MATCH_MP_TAC(SPECL [`a:num`; `j:num`; `beta:num`] + JACOBI_5_BETA_125_FIVE) THEN + ASM_MESON_TAC[]]);; + +let QR_125_T_FIVE = prove + (`!a j beta:num. + 1 <= a /\ prime beta /\ + ((a == 2) (mod 5) \/ (a == 3) (mod 5)) /\ + beta = 8*a*(20*j+1)-5 + ==> ?x. (x EXP 2 + 40*(20*j+1) == 0) (mod beta)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC JACOBI_NEGATIVE_SQUARE THEN CONJ_TAC THENL + [ASM_MESON_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC(SPECL [`a:num`; `j:num`; `beta:num`] + JACOBI_NEG40T_BETA_125_FIVE) THEN + ASM_MESON_TAC[]);; + +let COPRIME_5_2 = prove + (`coprime(5,2)`, + REWRITE_TAC[COPRIME_BEZOUT] THEN + MAP_EVERY EXISTS_TAC [`1`; `2`] THEN DISJ1_TAC THEN ARITH_TAC);; + +let COPRIME_5_3 = prove + (`coprime(5,3)`, + REWRITE_TAC[COPRIME_BEZOUT] THEN + MAP_EVERY EXISTS_TAC [`2`; `3`] THEN DISJ1_TAC THEN ARITH_TAC);; + +let COPRIME_5_OF_CONG_2_OR_3 = prove + (`!a:num. + (a == 2) (mod 5) \/ (a == 3) (mod 5) + ==> coprime(5,a)`, + MESON_TAC[CONG_COPRIME; COPRIME_5_2; COPRIME_5_3]);; + +let NOT_DIVIDES_5_OF_CONG_2_OR_3 = prove + (`!a:num. + (a == 2) (mod 5) \/ (a == 3) (mod 5) + ==> ~(5 divides a)`, + GEN_TAC THEN DISCH_TAC THEN + MP_TAC(MATCH_MP (SPECL [`5`; `a:num`] PRIME_COPRIME_EQ) + (EQT_ELIM(PRIME_CONV `prime 5`))) THEN + ASM_SIMP_TAC[COPRIME_5_OF_CONG_2_OR_3]);; + +let COPRIME_5_BETA_125_FIVE = prove + (`!a j beta:num. + 1 <= a /\ + ((a == 2) (mod 5) \/ (a == 3) (mod 5)) /\ + beta = 8*a*(20*j+1)-5 + ==> coprime(5,beta)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN `jacobi(beta,5) = &1` ASSUME_TAC THENL + [MATCH_MP_TAC(SPECL [`a:num`; `j:num`; `beta:num`] + JACOBI_BETA_5_125_FIVE) THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `coprime(beta,5)` ASSUME_TAC THENL + [ASM_CASES_TAC `coprime(beta,5)` THEN ASM_REWRITE_TAC[] THEN + MP_TAC(SPECL [`beta:num`; `5`] JACOBI_EQ_0) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC INT_REDUCE_CONV; + ALL_TAC] THEN + ONCE_REWRITE_TAC[COPRIME_SYM] THEN ASM_REWRITE_TAC[]);; + +let DICKSON_RESIDUE_LIFT_125_FIVE = prove + (`!t beta:num. + coprime(5,beta) /\ + (?x. (x EXP 2 + 40*t == 0) (mod beta)) + ==> ?r p. beta*p = 8*t + 5*r EXP 2`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_TAC `x:num`)) THEN + MP_TAC(SPECL [`5`; `x:num`; `beta:num`] CONG_SOLVE) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `r:num`) THEN + SUBGOAL_THEN + `((5*r) EXP 2 + 40*t == 0) (mod beta)` + ASSUME_TAC THENL + [MATCH_MP_TAC CONG_TRANS THEN EXISTS_TAC `x EXP 2 + 40*t` THEN + CONJ_TAC THENL + [MATCH_MP_TAC CONG_ADD THEN CONJ_TAC THENL + [MATCH_MP_TAC CONG_EXP THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[CONG_REFL]]; + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN + `(5*(8*t+5*r EXP 2) == 5*0) (mod beta)` + ASSUME_TAC THENL + [REWRITE_TAC + [ARITH_RULE `5*(8*t+5*r EXP 2) = (5*r) EXP 2 + 40*t`; + MULT_CLAUSES] THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `(8*t+5*r EXP 2 == 0) (mod beta)` ASSUME_TAC THENL + [MP_TAC(MATCH_MP + (SPECL [`5`; `beta:num`; `8*t+5*r EXP 2`; `0`] + CONG_MULT_LCANCEL_EQ) + (ASSUME `coprime(5,beta)`)) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MP_TAC(ASSUME `(8*t+5*r EXP 2 == 0) (mod beta)`) THEN + REWRITE_TAC[CONG_0_DIVIDES; divides] THEN + DISCH_THEN(X_CHOOSE_TAC `p:num`) THEN + MAP_EVERY EXISTS_TAC [`r:num`; `p:num`] THEN ASM_ARITH_TAC);; + +let CONG_DICKSON_RHS_3 = prove + (`!j r:num. + (8*(20*j+1) + 5*r EXP 2 == 3) (mod 5)`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN + `8*(20*j+1) + 5*r EXP 2 = 5*(32*j+r EXP 2+1)+3` + SUBST1_TAC THENL + [ARITH_TAC; + REWRITE_TAC[CONG] THEN SIMP_TAC[MOD_MULT_ADD] THEN + CONV_TAC NUM_REDUCE_CONV]);; + +let CONG_DICKSON_P_3 = prove + (`!a j beta r p:num. + (a == 2) (mod 5) /\ + beta = 8*a*(20*j+1)-5 /\ + beta*p = 8*(20*j+1) + 5*r EXP 2 + ==> (p == 3) (mod 5)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(beta == 1) (mod 5)` ASSUME_TAC THENL + [MATCH_MP_TAC(SPECL [`a:num`; `j:num`; `beta:num`] + CONG_BETA_1MOD5_125_FIVE) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `(beta*p == 1*p) (mod 5)` MP_TAC THENL + [MATCH_MP_TAC CONG_MULT THEN + CONJ_TAC THENL + [ACCEPT_TAC(ASSUME `(beta == 1) (mod 5)`); + REWRITE_TAC[CONG_REFL]]; + REWRITE_TAC[MULT_CLAUSES] THEN DISCH_TAC] THEN + SUBGOAL_THEN `(beta*p == 3) (mod 5)` ASSUME_TAC THENL + [ONCE_REWRITE_TAC + [ASSUME `beta*p = 8*(20*j+1) + 5*r EXP 2`] THEN + REWRITE_TAC[CONG_DICKSON_RHS_3]; + ALL_TAC] THEN + MATCH_MP_TAC CONG_TRANS THEN EXISTS_TAC `(beta:num)*p` THEN + CONJ_TAC THENL + [ONCE_REWRITE_TAC[CONG_SYM] THEN + ACCEPT_TAC(ASSUME `(beta*p == p) (mod 5)`); + ACCEPT_TAC(ASSUME `(beta*p == 3) (mod 5)`)]);; + +let CONG_DICKSON_P_2 = prove + (`!a j beta r p:num. + (a == 3) (mod 5) /\ + beta = 8*a*(20*j+1)-5 /\ + beta*p = 8*(20*j+1) + 5*r EXP 2 + ==> (p == 2) (mod 5)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(beta == 4) (mod 5)` ASSUME_TAC THENL + [MATCH_MP_TAC(SPECL [`a:num`; `j:num`; `beta:num`] + CONG_BETA_4MOD5_125_FIVE) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `(beta*p == 4*p) (mod 5)` ASSUME_TAC THENL + [MATCH_MP_TAC CONG_MULT THEN CONJ_TAC THENL + [ACCEPT_TAC(ASSUME `(beta == 4) (mod 5)`); + REWRITE_TAC[CONG_REFL]]; + ALL_TAC] THEN + SUBGOAL_THEN `(beta*p == 3) (mod 5)` ASSUME_TAC THENL + [ONCE_REWRITE_TAC + [ASSUME `beta*p = 8*(20*j+1) + 5*r EXP 2`] THEN + REWRITE_TAC[CONG_DICKSON_RHS_3]; + ALL_TAC] THEN + SUBGOAL_THEN `(4*p == 3) (mod 5)` ASSUME_TAC THENL + [MATCH_MP_TAC CONG_TRANS THEN EXISTS_TAC `(beta:num)*p` THEN + CONJ_TAC THENL + [ONCE_REWRITE_TAC[CONG_SYM] THEN + ACCEPT_TAC(ASSUME `(beta*p == 4*p) (mod 5)`); + ACCEPT_TAC(ASSUME `(beta*p == 3) (mod 5)`)]; + ALL_TAC] THEN + SUBGOAL_THEN `(4*(4*p) == 4*3) (mod 5)` ASSUME_TAC THENL + [MATCH_MP_TAC CONG_MULT THEN CONJ_TAC THENL + [REWRITE_TAC[CONG_REFL]; + ACCEPT_TAC(ASSUME `(4*p == 3) (mod 5)`)]; + ALL_TAC] THEN + MATCH_MP_TAC CONG_TRANS THEN EXISTS_TAC `4*(4*(p:num))` THEN + CONJ_TAC THENL + [SUBGOAL_THEN `4*(4*p) = 5*(3*p)+p` SUBST1_TAC THENL + [ARITH_TAC; + REWRITE_TAC[CONG] THEN SIMP_TAC[MOD_MULT_ADD]]; + MATCH_MP_TAC CONG_TRANS THEN EXISTS_TAC `4*3:num` THEN + CONJ_TAC THENL + [ACCEPT_TAC(ASSUME `(4*(4*p) == 4*3) (mod 5)`); + REWRITE_TAC[CONG] THEN CONV_TAC NUM_REDUCE_CONV]]);; + +let DICKSON_DATA_125_T_FIVE = prove + (`!a:num. + 1 <= a /\ ((a == 2) (mod 5) \/ (a == 3) (mod 5)) + ==> ?j beta r p. + prime beta /\ + beta = 8*a*(20*j+1)-5 /\ + beta*p = 8*(20*j+1) + 5*r EXP 2`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN `~(5 divides a)` ASSUME_TAC THENL + [MATCH_MP_TAC NOT_DIVIDES_5_OF_CONG_2_OR_3 THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + MP_TAC(SPEC `a:num` DIRICHLET_PRIME_125_DOUBLE) THEN + ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `beta:num` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `?j. beta = 160*a*j + (8*a-5)` + (X_CHOOSE_TAC `j:num`) THENL + [MP_TAC(SPECL [`160*a`; `8*a-5`; `beta:num`] CONG_CASE) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `beta = 8*a*(20*j+1)-5` ASSUME_TAC THENL + [UNDISCH_TAC `beta = 160*a*j + (8*a-5)` THEN ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `?x. (x EXP 2 + 40*(20*j+1) == 0) (mod beta)` + STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC(SPECL [`a:num`; `j:num`; `beta:num`] QR_125_T_FIVE) THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `coprime(5,beta)` ASSUME_TAC THENL + [MATCH_MP_TAC(SPECL [`a:num`; `j:num`; `beta:num`] + COPRIME_5_BETA_125_FIVE) THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + MP_TAC(SPECL [`20*j+1`; `beta:num`] DICKSON_RESIDUE_LIFT_125_FIVE) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + EXISTS_TAC `x:num` THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `r:num` (X_CHOOSE_TAC `p:num`)) THEN + MAP_EVERY EXISTS_TAC [`j:num`; `beta:num`; `r:num`; `p:num`] THEN + REPEAT CONJ_TAC THENL + [ACCEPT_TAC(ASSUME `prime beta`); + ACCEPT_TAC(ASSUME `beta = 8*a*(20*j+1)-5`); + ACCEPT_TAC + (ASSUME `beta*p = 8*(20*j+1) + 5*r EXP 2`)]);; + +let DICKSON_C_125_T_FIVE_PLUS = prove + (`!a p:num. + (a == 2) (mod 5) /\ (p == 3) (mod 5) + ==> ?c. 5*c = p + 4*a + 4`, + REPEAT STRIP_TAC THEN + MP_TAC(MATCH_MP (SPEC `a:num` CONG_2_MOD_5_CASE) + (ASSUME `(a == 2) (mod 5)`)) THEN + DISCH_THEN(X_CHOOSE_TAC `qa:num`) THEN + MP_TAC(MATCH_MP (SPEC `p:num` CONG_3_MOD_5_CASE) + (ASSUME `(p == 3) (mod 5)`)) THEN + DISCH_THEN(X_CHOOSE_TAC `qp:num`) THEN + EXISTS_TAC `qp + 4*qa + 3` THEN ASM_ARITH_TAC);; + +let DICKSON_C_125_T_FIVE_MINUS = prove + (`!a p:num. + (a == 3) (mod 5) /\ (p == 2) (mod 5) + ==> ?c. 5*c = p + 4*a - 4`, + REPEAT STRIP_TAC THEN + MP_TAC(MATCH_MP (SPEC `a:num` CONG_3_MOD_5_CASE) + (ASSUME `(a == 3) (mod 5)`)) THEN + DISCH_THEN(X_CHOOSE_TAC `qa:num`) THEN + MP_TAC(MATCH_MP (SPEC `p:num` CONG_2_MOD_5_CASE) + (ASSUME `(p == 2) (mod 5)`)) THEN + DISCH_THEN(X_CHOOSE_TAC `qp:num`) THEN + EXISTS_TAC `qp + 4*qa + 2` THEN ASM_ARITH_TAC);; + +let REGULAR_T_125_FIVE_PLUS = prove + (`!a:num. + 1 <= a /\ (a == 2) (mod 5) + ==> ?u v w:int. + u pow 2 + &2 * v pow 2 + &2 * v * w + &3 * w pow 2 = + &5 * &a`, + REPEAT STRIP_TAC THEN + MP_TAC(SPEC `a:num` DICKSON_DATA_125_T_FIVE) THEN + ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `j:num` + (X_CHOOSE_THEN `beta:num` + (X_CHOOSE_THEN `r:num` + (X_CHOOSE_THEN `p:num` STRIP_ASSUME_TAC)))) THEN + SUBGOAL_THEN `(p == 3) (mod 5)` ASSUME_TAC THENL + [MATCH_MP_TAC(SPECL + [`a:num`; `j:num`; `beta:num`; `r:num`; `p:num`] + CONG_DICKSON_P_3) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MP_TAC(SPECL [`a:num`; `p:num`] DICKSON_C_125_T_FIVE_PLUS) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `c:num`) THEN + SUBGOAL_THEN `5 <= 8*a*(20*j+1)` ASSUME_TAC THENL + [ASM_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(SPECL + [`&a:int`; `&(20*j+1):int`; `&beta:int`; `&r:int`; `&p:int`; + `&c:int`] LEMMA_125_T_FIVE_PLUS) THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[INT_OF_NUM_LT] THEN ASM_ARITH_TAC; + REWRITE_TAC[INT_OF_NUM_LT] THEN + MP_TAC(MATCH_MP PRIME_GE_2 (ASSUME `prime beta`)) THEN ARITH_TAC; + MP_TAC(AP_TERM `int_of_num` + (ASSUME `beta = 8*a*(20*j+1)-5`)) THEN + REWRITE_TAC + [GSYM(MATCH_MP + (SPECL [`5`; `8*a*(20*j+1)`] INT_OF_NUM_SUB) + (ASSUME `5 <= 8*a*(20*j+1)`)); + GSYM INT_OF_NUM_MUL; GSYM INT_OF_NUM_ADD] THEN + CONV_TAC INT_RING; + MP_TAC(AP_TERM `int_of_num` + (ASSUME `beta*p = 8*(20*j+1) + 5*r EXP 2`)) THEN + REWRITE_TAC + [GSYM INT_OF_NUM_ADD; GSYM INT_OF_NUM_MUL; + GSYM INT_OF_NUM_POW] THEN + CONV_TAC INT_RING; + MP_TAC(AP_TERM `int_of_num` + (ASSUME `5*c = p + 4*a + 4`)) THEN + REWRITE_TAC[GSYM INT_OF_NUM_ADD; GSYM INT_OF_NUM_MUL] THEN + CONV_TAC INT_RING]);; + +let REGULAR_T_125_FIVE_MINUS = prove + (`!a:num. + 1 <= a /\ (a == 3) (mod 5) + ==> ?u v w:int. + u pow 2 + &2 * v pow 2 + &2 * v * w + &3 * w pow 2 = + &5 * &a`, + REPEAT STRIP_TAC THEN + MP_TAC(SPEC `a:num` DICKSON_DATA_125_T_FIVE) THEN + ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `j:num` + (X_CHOOSE_THEN `beta:num` + (X_CHOOSE_THEN `r:num` + (X_CHOOSE_THEN `p:num` STRIP_ASSUME_TAC)))) THEN + SUBGOAL_THEN `(p == 2) (mod 5)` ASSUME_TAC THENL + [MATCH_MP_TAC(SPECL + [`a:num`; `j:num`; `beta:num`; `r:num`; `p:num`] + CONG_DICKSON_P_2) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MP_TAC(SPECL [`a:num`; `p:num`] DICKSON_C_125_T_FIVE_MINUS) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `c:num`) THEN + SUBGOAL_THEN `5 <= 8*a*(20*j+1)` ASSUME_TAC THENL + [ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `4 <= 4*a` ASSUME_TAC THENL + [ASM_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(SPECL + [`&a:int`; `&(20*j+1):int`; `&beta:int`; `&r:int`; `&p:int`; + `&c:int`] LEMMA_125_T_FIVE_MINUS) THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[INT_OF_NUM_LT] THEN ASM_ARITH_TAC; + REWRITE_TAC[INT_OF_NUM_LT] THEN + MP_TAC(MATCH_MP PRIME_GE_2 (ASSUME `prime beta`)) THEN ARITH_TAC; + MP_TAC(AP_TERM `int_of_num` + (ASSUME `beta = 8*a*(20*j+1)-5`)) THEN + REWRITE_TAC + [GSYM(MATCH_MP + (SPECL [`5`; `8*a*(20*j+1)`] INT_OF_NUM_SUB) + (ASSUME `5 <= 8*a*(20*j+1)`)); + GSYM INT_OF_NUM_MUL; GSYM INT_OF_NUM_ADD] THEN + CONV_TAC INT_RING; + MP_TAC(AP_TERM `int_of_num` + (ASSUME `beta*p = 8*(20*j+1) + 5*r EXP 2`)) THEN + REWRITE_TAC + [GSYM INT_OF_NUM_ADD; GSYM INT_OF_NUM_MUL; + GSYM INT_OF_NUM_POW] THEN + CONV_TAC INT_RING; + MP_TAC(AP_TERM `int_of_num` + (ASSUME `5*c = p + 4*a - 4`)) THEN + REWRITE_TAC + [GSYM(MATCH_MP + (SPECL [`4`; `4*a`] INT_OF_NUM_SUB) + (ASSUME `4 <= 4*a`)); + GSYM INT_OF_NUM_ADD; GSYM INT_OF_NUM_MUL] THEN + CONV_TAC INT_RING]);; + +let REGULAR_T_125_FIVE = prove + (`!a:num. + 1 <= a /\ ((a == 2) (mod 5) \/ (a == 3) (mod 5)) + ==> ?u v w:int. + u pow 2 + &2 * v pow 2 + &2 * v * w + &3 * w pow 2 = + &5 * &a`, + MESON_TAC[REGULAR_T_125_FIVE_PLUS; REGULAR_T_125_FIVE_MINUS]);; + +let CONG_1_MOD_5_CASE_125 = prove + (`!a:num. (a == 1) (mod 5) ==> ?q. a = 5*q+1`, + MESON_TAC[CONG_CASE; MULT_SYM; ARITH_RULE `1 < 5`]);; + +let CONG_4_MOD_5_CASE_125 = prove + (`!a:num. (a == 4) (mod 5) ==> ?q. a = 5*q+4`, + MESON_TAC[CONG_CASE; MULT_SYM; ARITH_RULE `4 < 5`]);; + +let CONG_BETA_3MOD5_125_G_FIVE = prove + (`!a j beta:num. + (a == 1) (mod 5) /\ beta = 8*a*(20*j+1)-5 + ==> (beta == 3) (mod 5)`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(X_CHOOSE_TAC `q:num` o + MATCH_MP CONG_1_MOD_5_CASE_125) THEN + SUBGOAL_THEN + `beta = 5*(160*q*j+8*q+32*j)+3` + SUBST1_TAC THENL + [ASM_REWRITE_TAC[] THEN ARITH_TAC; + REWRITE_TAC[CONG] THEN SIMP_TAC[MOD_MULT_ADD] THEN + CONV_TAC NUM_REDUCE_CONV]);; + +let CONG_BETA_2MOD5_125_G_FIVE = prove + (`!a j beta:num. + (a == 4) (mod 5) /\ beta = 8*a*(20*j+1)-5 + ==> (beta == 2) (mod 5)`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(X_CHOOSE_TAC `q:num` o + MATCH_MP CONG_4_MOD_5_CASE_125) THEN + SUBGOAL_THEN + `beta = 5*(160*q*j+8*q+128*j+5)+2` + SUBST1_TAC THENL + [ASM_REWRITE_TAC[] THEN ARITH_TAC; + REWRITE_TAC[CONG] THEN SIMP_TAC[MOD_MULT_ADD] THEN + CONV_TAC NUM_REDUCE_CONV]);; + +let JACOBI_2_5 = prove + (`jacobi(2,5) = -- &1`, + REWRITE_TAC[JACOBI_OF_2] THEN CONV_TAC NUM_REDUCE_CONV THEN + CONV_TAC INT_REDUCE_CONV);; + +let JACOBI_BETA_5_125_G_FIVE_PLUS = prove + (`!a j beta:num. + (a == 1) (mod 5) /\ + beta = 8*a*(20*j+1)-5 + ==> jacobi(beta,5) = -- &1`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(beta == 3) (mod 5)` ASSUME_TAC THENL + [MATCH_MP_TAC(SPECL [`a:num`; `j:num`; `beta:num`] + CONG_BETA_3MOD5_125_G_FIVE) THEN + ASM_REWRITE_TAC[]; + MP_TAC(SPECL [`beta:num`; `3`; `5`] JACOBI_CONG) THEN + ASM_REWRITE_TAC[JACOBI_3_5]]);; + +let JACOBI_BETA_5_125_G_FIVE_MINUS = prove + (`!a j beta:num. + (a == 4) (mod 5) /\ + beta = 8*a*(20*j+1)-5 + ==> jacobi(beta,5) = -- &1`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(beta == 2) (mod 5)` ASSUME_TAC THENL + [MATCH_MP_TAC(SPECL [`a:num`; `j:num`; `beta:num`] + CONG_BETA_2MOD5_125_G_FIVE) THEN + ASM_REWRITE_TAC[]; + MP_TAC(SPECL [`beta:num`; `2`; `5`] JACOBI_CONG) THEN + ASM_REWRITE_TAC[JACOBI_2_5]]);; + +let JACOBI_BETA_5_125_G_FIVE = prove + (`!a j beta:num. + ((a == 1) (mod 5) \/ (a == 4) (mod 5)) /\ + beta = 8*a*(20*j+1)-5 + ==> jacobi(beta,5) = -- &1`, + MESON_TAC + [JACOBI_BETA_5_125_G_FIVE_PLUS; + JACOBI_BETA_5_125_G_FIVE_MINUS]);; + +let JACOBI_5_BETA_OF_3MOD8_NEG = prove + (`!beta:num. + (beta == 3) (mod 8) /\ jacobi(beta,5) = -- &1 + ==> jacobi(5,beta) = -- &1`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(beta == 3) (mod 4)` ASSUME_TAC THENL + [MATCH_MP_TAC CONG_MOD_8_IMP_MOD_4 THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `ODD beta` ASSUME_TAC THENL + [MATCH_MP_TAC ODD_OF_3MOD4 THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `coprime(beta,5)` ASSUME_TAC THENL + [ASM_CASES_TAC `coprime(beta,5)` THEN ASM_REWRITE_TAC[] THEN + MP_TAC(SPECL [`beta:num`; `5`] JACOBI_EQ_0) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC INT_REDUCE_CONV; + ALL_TAC] THEN + SUBGOAL_THEN `coprime(5,beta)` ASSUME_TAC THENL + [ONCE_REWRITE_TAC[COPRIME_SYM] THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MP_TAC(SPECL [`5`; `beta:num`] JACOBI_FLIP_1MOD4) THEN + ASM_REWRITE_TAC[NUM_REDUCE_CONV `ODD 5`] THEN + ANTS_TAC THENL [NUMBER_TAC; INT_ARITH_TAC]);; + +let JACOBI_5_BETA_125_G_FIVE = prove + (`!a j beta:num. + 1 <= a /\ + ((a == 1) (mod 5) \/ (a == 4) (mod 5)) /\ + beta = 8*a*(20*j+1)-5 + ==> jacobi(5,beta) = -- &1`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC JACOBI_5_BETA_OF_3MOD8_NEG THEN CONJ_TAC THENL + [MATCH_MP_TAC(SPECL [`a:num`; `j:num`; `beta:num`] + CONG_BETA_3MOD8_125_DOUBLE) THEN + ASM_MESON_TAC[]; + MATCH_MP_TAC(SPECL [`a:num`; `j:num`; `beta:num`] + JACOBI_BETA_5_125_G_FIVE) THEN + ASM_MESON_TAC[]]);; + +let JACOBI_NEG80_OF_3MOD8 = prove + (`!t beta:num. + (beta == 3) (mod 8) /\ + jacobi(t,beta) = &1 /\ + jacobi(5,beta) = -- &1 + ==> jacobi((80*t)*(beta-1),beta) = &1`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(beta == 3) (mod 4)` ASSUME_TAC THENL + [MATCH_MP_TAC CONG_MOD_8_IMP_MOD_4 THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[JACOBI_LMUL] THEN + ASM_SIMP_TAC[JACOBI_M1_3MOD4] THEN + SUBGOAL_THEN `jacobi(80,beta) = -- &1` + (fun th -> REWRITE_TAC[th]) THENL + [REWRITE_TAC[ARITH_RULE `80 = 2*2*2*2*5`; JACOBI_LMUL] THEN + ASM_SIMP_TAC[JACOBI_2_3MOD8] THEN CONV_TAC INT_REDUCE_CONV; + CONV_TAC INT_REDUCE_CONV]);; + +let JACOBI_NEG80T_BETA_125_G_FIVE = prove + (`!a j beta:num. + 1 <= a /\ + ((a == 1) (mod 5) \/ (a == 4) (mod 5)) /\ + beta = 8*a*(20*j+1)-5 + ==> jacobi((80*(20*j+1))*(beta-1),beta) = &1`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC JACOBI_NEG80_OF_3MOD8 THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC(SPECL [`a:num`; `j:num`; `beta:num`] + CONG_BETA_3MOD8_125_DOUBLE) THEN + ASM_MESON_TAC[]; + MATCH_MP_TAC(SPECL [`a:num`; `j:num`; `beta:num`] + JACOBI_K_BETA_125_DOUBLE) THEN + ASM_MESON_TAC[]; + MATCH_MP_TAC(SPECL [`a:num`; `j:num`; `beta:num`] + JACOBI_5_BETA_125_G_FIVE) THEN + ASM_MESON_TAC[]]);; + +let QR_125_G_FIVE = prove + (`!a j beta:num. + 1 <= a /\ prime beta /\ + ((a == 1) (mod 5) \/ (a == 4) (mod 5)) /\ + beta = 8*a*(20*j+1)-5 + ==> ?x. (x EXP 2 + 80*(20*j+1) == 0) (mod beta)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC JACOBI_NEGATIVE_SQUARE THEN CONJ_TAC THENL + [ASM_MESON_TAC[]; + MATCH_MP_TAC(SPECL [`a:num`; `j:num`; `beta:num`] + JACOBI_NEG80T_BETA_125_G_FIVE) THEN + ASM_MESON_TAC[]]);; + +let COPRIME_10_BETA_125_G_FIVE = prove + (`!a j beta:num. + 1 <= a /\ + ((a == 1) (mod 5) \/ (a == 4) (mod 5)) /\ + beta = 8*a*(20*j+1)-5 + ==> coprime(10,beta)`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC)) THEN + SUBGOAL_THEN `(beta == 3) (mod 8)` ASSUME_TAC THENL + [MATCH_MP_TAC(SPECL [`a:num`; `j:num`; `beta:num`] + CONG_BETA_3MOD8_125_DOUBLE) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `ODD beta` ASSUME_TAC THENL + [MATCH_MP_TAC ODD_OF_3MOD4 THEN + MATCH_MP_TAC CONG_MOD_8_IMP_MOD_4 THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `coprime(beta,5)` ASSUME_TAC THENL + [SUBGOAL_THEN `jacobi(beta,5) = -- &1` ASSUME_TAC THENL + [MATCH_MP_TAC(SPECL [`a:num`; `j:num`; `beta:num`] + JACOBI_BETA_5_125_G_FIVE) THEN + ASM_MESON_TAC[]; + ASM_CASES_TAC `coprime(beta,5)` THEN ASM_REWRITE_TAC[] THEN + MP_TAC(SPECL [`beta:num`; `5`] JACOBI_EQ_0) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC INT_REDUCE_CONV]; + ALL_TAC] THEN + REWRITE_TAC[ARITH_RULE `10 = 2*5`; COPRIME_LMUL] THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[CONJUNCT1 COPRIME_2]; + ONCE_REWRITE_TAC[COPRIME_SYM] THEN ASM_REWRITE_TAC[]]);; + +let ODD_NUM_SQ_CONG_1_MOD8 = prove + (`!r:num. ODD r ==> (r EXP 2 == 1) (mod 8)`, + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[CONG] THEN + ONCE_REWRITE_TAC[GSYM MOD_EXP_MOD] THEN + SUBGOAL_THEN `ODD(r MOD 8)` MP_TAC THENL + [ASM_SIMP_TAC[ODD_MOD_EVEN; ARITH]; + ALL_TAC] THEN + MP_TAC(ARITH_RULE `r MOD 8 < 8`) THEN + SPEC_TAC(`r MOD 8`,`s:num`) THEN + CONV_TAC EXPAND_CASES_CONV THEN CONV_TAC NUM_REDUCE_CONV);; + +let DICKSON_ODD_RESIDUE_LIFT_125_G_FIVE = prove + (`!t beta:num. + ODD beta /\ coprime(10,beta) /\ + (?x. (x EXP 2 + 80*t == 0) (mod beta)) + ==> ?r p. ODD r /\ beta*p = 8*t + 10*r EXP 2`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_TAC `x:num`))) THEN + MP_TAC(SPECL [`10`; `x:num`; `beta:num`] CONG_SOLVE) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `r0:num`) THEN + SUBGOAL_THEN + `?r:num. ODD r /\ (10*r == x) (mod beta)` + (X_CHOOSE_THEN `r:num` STRIP_ASSUME_TAC) THENL + [ASM_CASES_TAC `ODD r0` THENL + [EXISTS_TAC `r0:num` THEN ASM_REWRITE_TAC[]; + EXISTS_TAC `r0+beta:num` THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[ODD_ADD]; + MATCH_MP_TAC CONG_TRANS THEN EXISTS_TAC `10*r0:num` THEN + CONJ_TAC THENL + [NUMBER_TAC; + ASM_REWRITE_TAC[]]]]; + ALL_TAC] THEN + SUBGOAL_THEN + `((10*r) EXP 2 + 80*t == 0) (mod beta)` + ASSUME_TAC THENL + [MATCH_MP_TAC CONG_TRANS THEN EXISTS_TAC `x EXP 2 + 80*t` THEN + CONJ_TAC THENL + [MATCH_MP_TAC CONG_ADD THEN CONJ_TAC THENL + [MATCH_MP_TAC CONG_EXP THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[CONG_REFL]]; + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN + `(10*(8*t+10*r EXP 2) == 10*0) (mod beta)` + ASSUME_TAC THENL + [REWRITE_TAC + [ARITH_RULE + `10*(8*t+10*r EXP 2) = (10*r) EXP 2 + 80*t`; + MULT_CLAUSES] THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `(8*t+10*r EXP 2 == 0) (mod beta)` ASSUME_TAC THENL + [MP_TAC(MATCH_MP + (SPECL [`10`; `beta:num`; `8*t+10*r EXP 2`; `0`] + CONG_MULT_LCANCEL_EQ) + (ASSUME `coprime(10,beta)`)) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MP_TAC(ASSUME `(8*t+10*r EXP 2 == 0) (mod beta)`) THEN + REWRITE_TAC[CONG_0_DIVIDES; divides] THEN + DISCH_THEN(X_CHOOSE_TAC `p:num`) THEN + MAP_EVERY EXISTS_TAC [`r:num`; `p:num`] THEN + ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC);; + +let CONG_DICKSON_P_MOD8_125_G_FIVE = prove + (`!beta p r t:num. + (beta == 3) (mod 8) /\ ODD r /\ + beta*p = 8*t + 10*r EXP 2 + ==> (p == 6) (mod 8)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(r EXP 2 == 1) (mod 8)` ASSUME_TAC THENL + [MATCH_MP_TAC ODD_NUM_SQ_CONG_1_MOD8 THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `(beta*p == 3*p) (mod 8)` ASSUME_TAC THENL + [MATCH_MP_TAC CONG_MULT THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + REWRITE_TAC[CONG_REFL]]; + ALL_TAC] THEN + SUBGOAL_THEN + `(8*t + 10*r EXP 2 == 0 + 10*1) (mod 8)` + ASSUME_TAC THENL + [MATCH_MP_TAC CONG_ADD THEN CONJ_TAC THENL + [REWRITE_TAC[CONG] THEN SIMP_TAC[MOD_MULT] THEN + CONV_TAC NUM_REDUCE_CONV; + MATCH_MP_TAC CONG_MULT THEN CONJ_TAC THENL + [REWRITE_TAC[CONG_REFL]; + ASM_REWRITE_TAC[]]]; + ALL_TAC] THEN + SUBGOAL_THEN `(beta*p == 2) (mod 8)` ASSUME_TAC THENL + [ONCE_REWRITE_TAC[ASSUME `beta*p = 8*t + 10*r EXP 2`] THEN + MATCH_MP_TAC CONG_TRANS THEN EXISTS_TAC `0+10*1:num` THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + REWRITE_TAC[CONG] THEN CONV_TAC NUM_REDUCE_CONV]; + ALL_TAC] THEN + SUBGOAL_THEN `(3*p == 2) (mod 8)` ASSUME_TAC THENL + [MATCH_MP_TAC CONG_TRANS THEN EXISTS_TAC `beta*p:num` THEN + CONJ_TAC THENL + [ONCE_REWRITE_TAC[CONG_SYM] THEN ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN `(3*(3*p) == 3*2) (mod 8)` ASSUME_TAC THENL + [MATCH_MP_TAC CONG_MULT THEN CONJ_TAC THENL + [REWRITE_TAC[CONG_REFL]; + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + MATCH_MP_TAC CONG_TRANS THEN EXISTS_TAC `3*(3*p):num` THEN + CONJ_TAC THENL + [REWRITE_TAC[CONG] THEN + REWRITE_TAC[ARITH_RULE `3*(3*p) = 8*p+p`; MOD_MULT_ADD]; + MATCH_MP_TAC CONG_TRANS THEN EXISTS_TAC `3*2:num` THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + REWRITE_TAC[CONG] THEN CONV_TAC NUM_REDUCE_CONV]]);; + +let CONG_DICKSON_G_RHS_3 = prove + (`!j r:num. + (8*(20*j+1) + 10*r EXP 2 == 3) (mod 5)`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN + `8*(20*j+1) + 10*r EXP 2 = + 5*(32*j+2*r EXP 2+1)+3` + SUBST1_TAC THENL + [ARITH_TAC; + REWRITE_TAC[CONG] THEN SIMP_TAC[MOD_MULT_ADD] THEN + CONV_TAC NUM_REDUCE_CONV]);; + +let CONG_DICKSON_P_1_125_G_FIVE = prove + (`!a j beta r p:num. + (a == 1) (mod 5) /\ + beta = 8*a*(20*j+1)-5 /\ + beta*p = 8*(20*j+1) + 10*r EXP 2 + ==> (p == 1) (mod 5)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(beta == 3) (mod 5)` ASSUME_TAC THENL + [MATCH_MP_TAC(SPECL [`a:num`; `j:num`; `beta:num`] + CONG_BETA_3MOD5_125_G_FIVE) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `(beta*p == 3*p) (mod 5)` ASSUME_TAC THENL + [MATCH_MP_TAC CONG_MULT THEN ASM_REWRITE_TAC[CONG_REFL]; + ALL_TAC] THEN + SUBGOAL_THEN `(beta*p == 3) (mod 5)` ASSUME_TAC THENL + [ONCE_REWRITE_TAC + [ASSUME `beta*p = 8*(20*j+1) + 10*r EXP 2`] THEN + MATCH_ACCEPT_TAC(SPECL [`j:num`; `r:num`] + CONG_DICKSON_G_RHS_3); + ALL_TAC] THEN + SUBGOAL_THEN `(3*p == 3*1) (mod 5)` ASSUME_TAC THENL + [MATCH_MP_TAC CONG_TRANS THEN EXISTS_TAC `beta*p:num` THEN + CONJ_TAC THENL + [ONCE_REWRITE_TAC[CONG_SYM] THEN + ACCEPT_TAC(ASSUME `(beta*p == 3*p) (mod 5)`); + REWRITE_TAC[MULT_CLAUSES] THEN + ACCEPT_TAC(ASSUME `(beta*p == 3) (mod 5)`)]; + ALL_TAC] THEN + MP_TAC(MATCH_MP + (SPECL [`3`; `5`; `p:num`; `1`] CONG_MULT_LCANCEL_EQ) + (EQT_ELIM(COPRIME_CONV `coprime(3,5)`))) THEN + ASM_REWRITE_TAC[]);; + +let CONG_DICKSON_P_4_125_G_FIVE = prove + (`!a j beta r p:num. + (a == 4) (mod 5) /\ + beta = 8*a*(20*j+1)-5 /\ + beta*p = 8*(20*j+1) + 10*r EXP 2 + ==> (p == 4) (mod 5)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(beta == 2) (mod 5)` ASSUME_TAC THENL + [MATCH_MP_TAC(SPECL [`a:num`; `j:num`; `beta:num`] + CONG_BETA_2MOD5_125_G_FIVE) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `(beta*p == 2*p) (mod 5)` ASSUME_TAC THENL + [MATCH_MP_TAC CONG_MULT THEN ASM_REWRITE_TAC[CONG_REFL]; + ALL_TAC] THEN + SUBGOAL_THEN `(beta*p == 3) (mod 5)` ASSUME_TAC THENL + [ONCE_REWRITE_TAC + [ASSUME `beta*p = 8*(20*j+1) + 10*r EXP 2`] THEN + MATCH_ACCEPT_TAC(SPECL [`j:num`; `r:num`] + CONG_DICKSON_G_RHS_3); + ALL_TAC] THEN + SUBGOAL_THEN `(2*p == 2*4) (mod 5)` ASSUME_TAC THENL + [MATCH_MP_TAC CONG_TRANS THEN EXISTS_TAC `beta*p:num` THEN + CONJ_TAC THENL + [ONCE_REWRITE_TAC[CONG_SYM] THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC CONG_TRANS THEN EXISTS_TAC `3` THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + REWRITE_TAC[CONG] THEN CONV_TAC NUM_REDUCE_CONV]]; + ALL_TAC] THEN + MP_TAC(MATCH_MP + (SPECL [`2`; `5`; `p:num`; `4`] CONG_MULT_LCANCEL_EQ) + (EQT_ELIM(COPRIME_CONV `coprime(2,5)`))) THEN + ASM_REWRITE_TAC[]);; + +let DICKSON_C_125_G_FIVE_PLUS = prove + (`!a p:num. + (a == 1) (mod 5) /\ (p == 1) (mod 5) + ==> ?c. 5*c+2 = p+a`, + REPEAT STRIP_TAC THEN + MP_TAC(MATCH_MP (SPEC `a:num` CONG_1_MOD_5_CASE_125) + (ASSUME `(a == 1) (mod 5)`)) THEN + DISCH_THEN(X_CHOOSE_TAC `qa:num`) THEN + MP_TAC(MATCH_MP (SPEC `p:num` CONG_1_MOD_5_CASE_125) + (ASSUME `(p == 1) (mod 5)`)) THEN + DISCH_THEN(X_CHOOSE_TAC `qp:num`) THEN + EXISTS_TAC `qp+qa:num` THEN ASM_ARITH_TAC);; + +let DICKSON_C_125_G_FIVE_MINUS = prove + (`!a p:num. + (a == 4) (mod 5) /\ (p == 4) (mod 5) + ==> ?c. 5*c = p+a+2`, + REPEAT STRIP_TAC THEN + MP_TAC(MATCH_MP (SPEC `a:num` CONG_4_MOD_5_CASE_125) + (ASSUME `(a == 4) (mod 5)`)) THEN + DISCH_THEN(X_CHOOSE_TAC `qa:num`) THEN + MP_TAC(MATCH_MP (SPEC `p:num` CONG_4_MOD_5_CASE_125) + (ASSUME `(p == 4) (mod 5)`)) THEN + DISCH_THEN(X_CHOOSE_TAC `qp:num`) THEN + EXISTS_TAC `qp+qa+2:num` THEN ASM_ARITH_TAC);; + +let DICKSON_NORM_125_G_FIVE_PLUS = prove + (`!a beta t r p c:num. + (beta == 3) (mod 8) /\ ODD r /\ + beta*p = 8*t + 10*r EXP 2 /\ + 5*c+2 = p+a + ==> ?q. 3*a+c+2 = 8*q+6`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(p == 6) (mod 8)` ASSUME_TAC THENL + [MATCH_MP_TAC(SPECL [`beta:num`; `p:num`; `r:num`; `t:num`] + CONG_DICKSON_P_MOD8_125_G_FIVE) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `(5*(3*a+c+2) == 5*6) (mod 8)` ASSUME_TAC THENL + [MATCH_MP_TAC CONG_TRANS THEN EXISTS_TAC `p:num` THEN + CONJ_TAC THENL + [SUBGOAL_THEN `5*(3*a+c+2) = 16*a+p+8` SUBST1_TAC THENL + [ASM_ARITH_TAC; + NUMBER_TAC]; + MATCH_MP_TAC CONG_TRANS THEN EXISTS_TAC `6` THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + NUMBER_TAC]]; + ALL_TAC] THEN + SUBGOAL_THEN `(3*a+c+2 == 6) (mod 8)` ASSUME_TAC THENL + [MP_TAC(MATCH_MP + (SPECL [`5`; `8`; `3*a+c+2`; `6`] + CONG_MULT_LCANCEL_EQ) + (EQT_ELIM(COPRIME_CONV `coprime(5,8)`))) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `(3*a+c+2) MOD 8 = 6` ASSUME_TAC THENL + [MP_TAC(ASSUME `(3*a+c+2 == 6) (mod 8)`) THEN + REWRITE_TAC[CONG] THEN CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + MP_TAC(MATCH_MP + (SPECL [`3*a+c+2`; `8`; `6`] NUM_DECOMPOSE_MOD) + (CONJ (ARITH_RULE `~(8 = 0)`) + (ASSUME `(3*a+c+2) MOD 8 = 6`))) THEN + MATCH_MP_TAC MONO_EXISTS THEN ARITH_TAC);; + +let DICKSON_NORM_125_G_FIVE_MINUS = prove + (`!a beta t r p c:num. + ODD a /\ (beta == 3) (mod 8) /\ ODD r /\ + beta*p = 8*t + 10*r EXP 2 /\ + 5*c = p+a+2 + ==> ?q. 7*a+c+2 = 8*q+6`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(p == 6) (mod 8)` ASSUME_TAC THENL + [MATCH_MP_TAC(SPECL [`beta:num`; `p:num`; `r:num`; `t:num`] + CONG_DICKSON_P_MOD8_125_G_FIVE) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + FIRST_X_ASSUM(X_CHOOSE_TAC `d:num` o + REWRITE_RULE[ODD_EXISTS] o check (fun th -> concl th = `ODD a`)) THEN + SUBGOAL_THEN `(5*(7*a+c+2) == 5*6) (mod 8)` ASSUME_TAC THENL + [MATCH_MP_TAC CONG_TRANS THEN EXISTS_TAC `p:num` THEN + CONJ_TAC THENL + [SUBGOAL_THEN + `5*(7*a+c+2) = 8*(9*d+6)+p` + SUBST1_TAC THENL + [ASM_ARITH_TAC; + NUMBER_TAC]; + MATCH_MP_TAC CONG_TRANS THEN EXISTS_TAC `6` THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + NUMBER_TAC]]; + ALL_TAC] THEN + SUBGOAL_THEN `(7*a+c+2 == 6) (mod 8)` ASSUME_TAC THENL + [MP_TAC(MATCH_MP + (SPECL [`5`; `8`; `7*a+c+2`; `6`] + CONG_MULT_LCANCEL_EQ) + (EQT_ELIM(COPRIME_CONV `coprime(5,8)`))) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `(7*a+c+2) MOD 8 = 6` ASSUME_TAC THENL + [MP_TAC(ASSUME `(7*a+c+2 == 6) (mod 8)`) THEN + REWRITE_TAC[CONG] THEN CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + MP_TAC(MATCH_MP + (SPECL [`7*a+c+2`; `8`; `6`] NUM_DECOMPOSE_MOD) + (CONJ (ARITH_RULE `~(8 = 0)`) + (ASSUME `(7*a+c+2) MOD 8 = 6`))) THEN + MATCH_MP_TAC MONO_EXISTS THEN ARITH_TAC);; + +let TERNARY_TYPE6_DICKSON_G_FIVE = prove + (`!a beta r c s q:int. + &2 divides s /\ + &5 * a + c + &2 * s = &8 * q + &6 + ==> ternary_type6 + (&5 * a) (&0) s (&2 * beta) (&2 * r) c`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC(SPECL + [`&5 * a:int`; `&0:int`; `s:int`; `&2 * beta:int`; `&2 * r:int`; + `c:int`; `&1:int`; `&0:int`; `&1:int`; `q:int`] + TERNARY_TYPE6_OF_CHARACTERISTIC) THEN + REWRITE_TAC[tqeval; INT_MUL_LZERO; INT_MUL_RZERO; + INT_ADD_LID; INT_ADD_RID; INT_MUL_LID; INT_MUL_RID] THEN + REPEAT CONJ_TAC THENL + [UNDISCH_TAC `&2 divides s` THEN REWRITE_TAC[int_divides] THEN + DISCH_THEN(X_CHOOSE_TAC `d:int`) THEN EXISTS_TAC `--d:int` THEN + ASM_REWRITE_TAC[] THEN CONV_TAC INT_RING; + REWRITE_TAC[int_divides] THEN EXISTS_TAC `beta-r:int` THEN + CONV_TAC INT_RING; + UNDISCH_TAC `&2 divides s` THEN REWRITE_TAC[int_divides] THEN + DISCH_THEN(X_CHOOSE_TAC `d:int`) THEN EXISTS_TAC `--d:int` THEN + ASM_REWRITE_TAC[] THEN CONV_TAC INT_RING; + MP_TAC(ASSUME `&5 * a + c + &2 * s = &8 * q + &6`) THEN + CONV_TAC INT_RING]);; + +let INT_NOT_2_DIVIDES_5_125 = prove + (`~(&2 divides &5)`, + REWRITE_TAC[GSYM INT_REM_EQ_0] THEN CONV_TAC INT_REDUCE_CONV);; + +let LEMMA_125_G_FIVE_PLUS = prove + (`!a t beta r p c q:int. + &0 < a /\ &0 < beta /\ ~(&2 divides a) /\ + beta = &8 * t * a - &5 /\ + beta * p = &8 * t + &10 * r pow 2 /\ + &5 * c + &2 = p + a /\ + &3 * a + c + &2 = &8 * q + &6 + ==> ?u v w:int. + u pow 2 + &2 * v pow 2 + &5 * w pow 2 = &5 * a`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `&2 divides (&1-a)` ASSUME_TAC THENL + [MP_TAC(MATCH_MP (SPEC `a:int` INT_ODD_FORM) + (ASSUME `~(&2 divides a)`)) THEN + DISCH_THEN(X_CHOOSE_TAC `d:int`) THEN + REWRITE_TAC[int_divides] THEN EXISTS_TAC `--d:int` THEN + MP_TAC(ASSUME `a = &2 * d + &1`) THEN CONV_TAC INT_RING; + ALL_TAC] THEN + MATCH_MP_TAC TERNARY_DISC10_TYPE6_SPECIAL THEN + MAP_EVERY EXISTS_TAC + [`&5 * a:int`; `&0:int`; `&1 - a:int`; `&2 * beta:int`; + `&2 * r:int`; `c:int`; `&5 * a:int`; `t * a - &1:int`] THEN + REPEAT CONJ_TAC THENL + [ASM_INT_ARITH_TAC; + REWRITE_TAC[INT_POW_2; INT_MUL_LZERO; INT_SUB_RZERO] THEN + MATCH_MP_TAC INT_LT_MUL THEN ASM_INT_ARITH_TAC; + MAP_EVERY UNDISCH_TAC + [`beta = &8 * t * a - &5`; + `beta * p = &8 * t + &10 * r pow 2`; + `&5 * c + &2 = p + a`] THEN + CONV_TAC INT_RING; + MATCH_MP_TAC(SPECL + [`a:int`; `beta:int`; `r:int`; `c:int`; `&1-a:int`; `q:int`] + TERNARY_TYPE6_DICKSON_G_FIVE) THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + MP_TAC(ASSUME `&3 * a + c + &2 = &8 * q + &6`) THEN + CONV_TAC INT_RING]; + ASM_REWRITE_TAC[INT_2_DIVIDES_MUL; INT_NOT_2_DIVIDES_5_125]; + MAP_EVERY EXISTS_TAC [`&1:int`; `&0:int`; `&0:int`] THEN + CONV_TAC INT_RING; + MAP_EVERY EXISTS_TAC [`&0:int`; `&1:int`; `&0:int`] THEN + UNDISCH_TAC `beta = &8 * t * a - &5` THEN CONV_TAC INT_RING; + MAP_EVERY EXISTS_TAC [`&1:int`; `&0:int`; `&0:int`] THEN + CONV_TAC INT_RING]);; + +let LEMMA_125_G_FIVE_MINUS = prove + (`!a t beta r p c q:int. + &0 < a /\ &0 < beta /\ ~(&2 divides a) /\ + beta = &8 * t * a - &5 /\ + beta * p = &8 * t + &10 * r pow 2 /\ + &5 * c = p + a + &2 /\ + &7 * a + c + &2 = &8 * q + &6 + ==> ?u v w:int. + u pow 2 + &2 * v pow 2 + &5 * w pow 2 = &5 * a`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `&2 divides (&1+a)` ASSUME_TAC THENL + [MP_TAC(MATCH_MP (SPEC `a:int` INT_ODD_FORM) + (ASSUME `~(&2 divides a)`)) THEN + DISCH_THEN(X_CHOOSE_TAC `d:int`) THEN + REWRITE_TAC[int_divides] THEN EXISTS_TAC `d + &1:int` THEN + MP_TAC(ASSUME `a = &2 * d + &1`) THEN CONV_TAC INT_RING; + ALL_TAC] THEN + MATCH_MP_TAC TERNARY_DISC10_TYPE6_SPECIAL THEN + MAP_EVERY EXISTS_TAC + [`&5 * a:int`; `&0:int`; `&1 + a:int`; `&2 * beta:int`; + `&2 * r:int`; `c:int`; `&5 * a:int`; `t * a - &1:int`] THEN + REPEAT CONJ_TAC THENL + [ASM_INT_ARITH_TAC; + REWRITE_TAC[INT_POW_2; INT_MUL_LZERO; INT_SUB_RZERO] THEN + MATCH_MP_TAC INT_LT_MUL THEN ASM_INT_ARITH_TAC; + MAP_EVERY UNDISCH_TAC + [`beta = &8 * t * a - &5`; + `beta * p = &8 * t + &10 * r pow 2`; + `&5 * c = p + a + &2`] THEN + CONV_TAC INT_RING; + MATCH_MP_TAC(SPECL + [`a:int`; `beta:int`; `r:int`; `c:int`; `&1+a:int`; `q:int`] + TERNARY_TYPE6_DICKSON_G_FIVE) THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + MP_TAC(ASSUME `&7 * a + c + &2 = &8 * q + &6`) THEN + CONV_TAC INT_RING]; + ASM_REWRITE_TAC[INT_2_DIVIDES_MUL; INT_NOT_2_DIVIDES_5_125]; + MAP_EVERY EXISTS_TAC [`&1:int`; `&0:int`; `&0:int`] THEN + CONV_TAC INT_RING; + MAP_EVERY EXISTS_TAC [`&0:int`; `&1:int`; `&0:int`] THEN + UNDISCH_TAC `beta = &8 * t * a - &5` THEN CONV_TAC INT_RING; + MAP_EVERY EXISTS_TAC [`&1:int`; `&0:int`; `&0:int`] THEN + CONV_TAC INT_RING]);; + +let DICKSON_DATA_125_G_FIVE = prove + (`!a:num. + 1 <= a /\ ODD a /\ + ((a == 1) (mod 5) \/ (a == 4) (mod 5)) + ==> ?j beta r p. + prime beta /\ ODD r /\ + beta = 8*a*(20*j+1)-5 /\ + beta*p = 8*(20*j+1) + 10*r EXP 2`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC)) THEN + SUBGOAL_THEN `~(5 divides a)` ASSUME_TAC THENL + [UNDISCH_TAC `(a == 1) (mod 5) \/ (a == 4) (mod 5)` THEN + REWRITE_TAC[CONG; DIVIDES_MOD] THEN + CONV_TAC NUM_REDUCE_CONV THEN ARITH_TAC; + ALL_TAC] THEN + MP_TAC(SPEC `a:num` DIRICHLET_PRIME_125_DOUBLE) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `beta:num` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `?j. beta = 160*a*j + (8*a-5)` + (X_CHOOSE_TAC `j:num`) THENL + [MP_TAC(SPECL [`160*a`; `8*a-5`; `beta:num`] CONG_CASE) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `beta = 8*a*(20*j+1)-5` ASSUME_TAC THENL + [UNDISCH_TAC `beta = 160*a*j + (8*a-5)` THEN ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `?x. (x EXP 2 + 80*(20*j+1) == 0) (mod beta)` + STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC(SPECL [`a:num`; `j:num`; `beta:num`] + QR_125_G_FIVE) THEN + REPEAT CONJ_TAC THENL + [ACCEPT_TAC(ASSUME `1 <= a`); + ACCEPT_TAC(ASSUME `prime beta`); + ACCEPT_TAC + (ASSUME `(a == 1) (mod 5) \/ (a == 4) (mod 5)`); + ACCEPT_TAC(ASSUME `beta = 8*a*(20*j+1)-5`)]; + ALL_TAC] THEN + SUBGOAL_THEN `coprime(10,beta)` ASSUME_TAC THENL + [MATCH_MP_TAC(SPECL [`a:num`; `j:num`; `beta:num`] + COPRIME_10_BETA_125_G_FIVE) THEN + REPEAT CONJ_TAC THENL + [ACCEPT_TAC(ASSUME `1 <= a`); + ACCEPT_TAC + (ASSUME `(a == 1) (mod 5) \/ (a == 4) (mod 5)`); + ACCEPT_TAC(ASSUME `beta = 8*a*(20*j+1)-5`)]; + ALL_TAC] THEN + SUBGOAL_THEN `ODD beta` ASSUME_TAC THENL + [MATCH_MP_TAC ODD_OF_3MOD4 THEN + MATCH_MP_TAC CONG_MOD_8_IMP_MOD_4 THEN + MATCH_MP_TAC(SPECL [`a:num`; `j:num`; `beta:num`] + CONG_BETA_3MOD8_125_DOUBLE) THEN + CONJ_TAC THENL + [ACCEPT_TAC(ASSUME `1 <= a`); + ACCEPT_TAC(ASSUME `beta = 8*a*(20*j+1)-5`)]; + ALL_TAC] THEN + MP_TAC(SPECL [`20*j+1`; `beta:num`] + DICKSON_ODD_RESIDUE_LIFT_125_G_FIVE) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [ACCEPT_TAC(ASSUME `ODD beta`); + ACCEPT_TAC(ASSUME `coprime(10,beta)`); + MAP_EVERY EXISTS_TAC [`x:num`] THEN + ACCEPT_TAC + (ASSUME `(x EXP 2 + 80*(20*j+1) == 0) (mod beta)`)]; + DISCH_THEN(X_CHOOSE_THEN `r:num` + (X_CHOOSE_THEN `p:num` STRIP_ASSUME_TAC))] THEN + MAP_EVERY EXISTS_TAC [`j:num`; `beta:num`; `r:num`; `p:num`] THEN + REPEAT CONJ_TAC THENL + [ACCEPT_TAC(ASSUME `prime beta`); + ACCEPT_TAC(ASSUME `ODD r`); + ACCEPT_TAC(ASSUME `beta = 8*a*(20*j+1)-5`); + ACCEPT_TAC(ASSUME + `beta*p = 8*(20*j+1) + 10*r EXP 2`)]);; + +let REGULAR_125_ODD_FIVE_PLUS = prove + (`!a:num. + 1 <= a /\ ODD a /\ (a == 1) (mod 5) + ==> ?u v w:int. + u pow 2 + &2*v pow 2 + &5*w pow 2 = &5 * &a`, + REPEAT STRIP_TAC THEN + MP_TAC(SPEC `a:num` DICKSON_DATA_125_G_FIVE) THEN + ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `j:num` + (X_CHOOSE_THEN `beta:num` + (X_CHOOSE_THEN `r:num` + (X_CHOOSE_THEN `p:num` STRIP_ASSUME_TAC)))) THEN + SUBGOAL_THEN `(p == 1) (mod 5)` ASSUME_TAC THENL + [MATCH_MP_TAC(SPECL + [`a:num`; `j:num`; `beta:num`; `r:num`; `p:num`] + CONG_DICKSON_P_1_125_G_FIVE) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MP_TAC(SPECL [`a:num`; `p:num`] DICKSON_C_125_G_FIVE_PLUS) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `c:num`) THEN + SUBGOAL_THEN `(beta == 3) (mod 8)` ASSUME_TAC THENL + [MATCH_MP_TAC(SPECL [`a:num`; `j:num`; `beta:num`] + CONG_BETA_3MOD8_125_DOUBLE) THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MP_TAC(SPECL + [`a:num`; `beta:num`; `20*j+1`; `r:num`; `p:num`; `c:num`] + DICKSON_NORM_125_G_FIVE_PLUS) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `q:num`) THEN + SUBGOAL_THEN `5 <= 8*a*(20*j+1)` ASSUME_TAC THENL + [ASM_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(SPECL + [`&a:int`; `&(20*j+1):int`; `&beta:int`; `&r:int`; `&p:int`; + `&c:int`; `&q:int`] LEMMA_125_G_FIVE_PLUS) THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[INT_OF_NUM_LT] THEN ASM_ARITH_TAC; + REWRITE_TAC[INT_OF_NUM_LT] THEN + MP_TAC(MATCH_MP PRIME_GE_2 (ASSUME `prime beta`)) THEN ARITH_TAC; + REWRITE_TAC[GSYM num_divides; DIVIDES_2; GSYM NOT_ODD] THEN + ASM_REWRITE_TAC[]; + MP_TAC(AP_TERM `int_of_num` + (ASSUME `beta = 8*a*(20*j+1)-5`)) THEN + REWRITE_TAC + [GSYM(MATCH_MP + (SPECL [`5`; `8*a*(20*j+1)`] INT_OF_NUM_SUB) + (ASSUME `5 <= 8*a*(20*j+1)`)); + GSYM INT_OF_NUM_MUL; GSYM INT_OF_NUM_ADD] THEN + CONV_TAC INT_RING; + MP_TAC(AP_TERM `int_of_num` + (ASSUME `beta*p = 8*(20*j+1) + 10*r EXP 2`)) THEN + REWRITE_TAC + [GSYM INT_OF_NUM_ADD; GSYM INT_OF_NUM_MUL; + GSYM INT_OF_NUM_POW] THEN + CONV_TAC INT_RING; + MP_TAC(AP_TERM `int_of_num` (ASSUME `5*c+2 = p+a`)) THEN + REWRITE_TAC[GSYM INT_OF_NUM_ADD; GSYM INT_OF_NUM_MUL] THEN + CONV_TAC INT_RING; + MP_TAC(AP_TERM `int_of_num` + (ASSUME `3*a+c+2 = 8*q+6`)) THEN + REWRITE_TAC[GSYM INT_OF_NUM_ADD; GSYM INT_OF_NUM_MUL]]);; + +let REGULAR_125_ODD_FIVE_MINUS = prove + (`!a:num. + 1 <= a /\ ODD a /\ (a == 4) (mod 5) + ==> ?u v w:int. + u pow 2 + &2*v pow 2 + &5*w pow 2 = &5 * &a`, + REPEAT STRIP_TAC THEN + MP_TAC(SPEC `a:num` DICKSON_DATA_125_G_FIVE) THEN + ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `j:num` + (X_CHOOSE_THEN `beta:num` + (X_CHOOSE_THEN `r:num` + (X_CHOOSE_THEN `p:num` STRIP_ASSUME_TAC)))) THEN + SUBGOAL_THEN `(p == 4) (mod 5)` ASSUME_TAC THENL + [MATCH_MP_TAC(SPECL + [`a:num`; `j:num`; `beta:num`; `r:num`; `p:num`] + CONG_DICKSON_P_4_125_G_FIVE) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MP_TAC(SPECL [`a:num`; `p:num`] DICKSON_C_125_G_FIVE_MINUS) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `c:num`) THEN + SUBGOAL_THEN `(beta == 3) (mod 8)` ASSUME_TAC THENL + [MATCH_MP_TAC(SPECL [`a:num`; `j:num`; `beta:num`] + CONG_BETA_3MOD8_125_DOUBLE) THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MP_TAC(SPECL + [`a:num`; `beta:num`; `20*j+1`; `r:num`; `p:num`; `c:num`] + DICKSON_NORM_125_G_FIVE_MINUS) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `q:num`) THEN + SUBGOAL_THEN `5 <= 8*a*(20*j+1)` ASSUME_TAC THENL + [ASM_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(SPECL + [`&a:int`; `&(20*j+1):int`; `&beta:int`; `&r:int`; `&p:int`; + `&c:int`; `&q:int`] LEMMA_125_G_FIVE_MINUS) THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[INT_OF_NUM_LT] THEN ASM_ARITH_TAC; + REWRITE_TAC[INT_OF_NUM_LT] THEN + MP_TAC(MATCH_MP PRIME_GE_2 (ASSUME `prime beta`)) THEN ARITH_TAC; + REWRITE_TAC[GSYM num_divides; DIVIDES_2; GSYM NOT_ODD] THEN + ASM_REWRITE_TAC[]; + MP_TAC(AP_TERM `int_of_num` + (ASSUME `beta = 8*a*(20*j+1)-5`)) THEN + REWRITE_TAC + [GSYM(MATCH_MP + (SPECL [`5`; `8*a*(20*j+1)`] INT_OF_NUM_SUB) + (ASSUME `5 <= 8*a*(20*j+1)`)); + GSYM INT_OF_NUM_MUL; GSYM INT_OF_NUM_ADD] THEN + CONV_TAC INT_RING; + MP_TAC(AP_TERM `int_of_num` + (ASSUME `beta*p = 8*(20*j+1) + 10*r EXP 2`)) THEN + REWRITE_TAC + [GSYM INT_OF_NUM_ADD; GSYM INT_OF_NUM_MUL; + GSYM INT_OF_NUM_POW] THEN + CONV_TAC INT_RING; + MP_TAC(AP_TERM `int_of_num` (ASSUME `5*c = p+a+2`)) THEN + REWRITE_TAC[GSYM INT_OF_NUM_ADD; GSYM INT_OF_NUM_MUL] THEN + CONV_TAC INT_RING; + MP_TAC(AP_TERM `int_of_num` + (ASSUME `7*a+c+2 = 8*q+6`)) THEN + REWRITE_TAC[GSYM INT_OF_NUM_ADD; GSYM INT_OF_NUM_MUL]]);; + +let REGULAR_125_ODD_FIVE = prove + (`!a:num. + 1 <= a /\ ODD a /\ + ((a == 1) (mod 5) \/ (a == 4) (mod 5)) + ==> ?u v w:int. + u pow 2 + &2*v pow 2 + &5*w pow 2 = &5 * &a`, + MESON_TAC + [REGULAR_125_ODD_FIVE_PLUS; REGULAR_125_ODD_FIVE_MINUS]);; + +let INT_REPRESENTS_125_SCALE25 = prove + (`!n:num. + (?x y z:int. + x pow 2 + &2 * y pow 2 + &5 * z pow 2 = &n) + ==> ?x y z:int. + x pow 2 + &2 * y pow 2 + &5 * z pow 2 = &(25*n)`, + GEN_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` (X_CHOOSE_TAC `z:int`))) THEN + MAP_EVERY EXISTS_TAC [`&5*x:int`; `&5*y:int`; `&5*z:int`] THEN + FIRST_X_ASSUM(MP_TAC) THEN + REWRITE_TAC[GSYM INT_OF_NUM_MUL] THEN CONV_TAC INT_RING);; + +let EXP_125_SCALE25 = prove + (`!a:num. 5 EXP (2*SUC a+1) = 25 * 5 EXP (2*a+1)`, + GEN_TAC THEN + ONCE_REWRITE_TAC[ARITH_RULE `2*SUC a+1 = 2+(2*a+1)`] THEN + REWRITE_TAC[EXP_ADD] THEN CONV_TAC NUM_REDUCE_CONV THEN ARITH_TAC);; + +let NUM_125_EXCEPTION_SCALE25 = prove + (`!n:num. + num_125_exception n + ==> num_125_exception (25*n)`, + GEN_TAC THEN REWRITE_TAC[num_125_exception] THEN + DISCH_THEN(X_CHOOSE_THEN `a:num` + (X_CHOOSE_THEN `u:num` STRIP_ASSUME_TAC)) THEN + MAP_EVERY EXISTS_TAC [`SUC a`; `u:num`] THEN + ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[EXP_125_SCALE25] THEN + ARITH_TAC);; + +let COPRIME_10_OF_ODD_NOT5 = prove + (`!n:num. + ODD n /\ ~(5 divides n) + ==> coprime(10,n)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[ARITH_RULE `10 = 2*5`; COPRIME_LMUL] THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[CONJUNCT1 COPRIME_2]; + MATCH_MP_TAC(snd(EQ_IMP_RULE + (MATCH_MP (SPECL [`5`; `n:num`] PRIME_COPRIME_EQ) + (EQT_ELIM(PRIME_CONV `prime 5`))))) THEN + ASM_REWRITE_TAC[]]);; + +let CONG_HALF_1_MOD5 = prove + (`!a b:num. + a = 2*b /\ (a == 1) (mod 5) + ==> (b == 3) (mod 5)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(2*b == 2*3) (mod 5)` ASSUME_TAC THENL + [MATCH_MP_TAC CONG_TRANS THEN EXISTS_TAC `1` THEN CONJ_TAC THENL + [ONCE_REWRITE_TAC[GSYM(ASSUME `a = 2*b`)] THEN + ASM_REWRITE_TAC[]; + REWRITE_TAC[CONG] THEN CONV_TAC NUM_REDUCE_CONV]; + ALL_TAC] THEN + MP_TAC(MATCH_MP + (SPECL [`2`; `5`; `b:num`; `3`] CONG_MULT_LCANCEL_EQ) + (EQT_ELIM(COPRIME_CONV `coprime(2,5)`))) THEN + ASM_REWRITE_TAC[]);; + +let CONG_HALF_4_MOD5 = prove + (`!a b:num. + a = 2*b /\ (a == 4) (mod 5) + ==> (b == 2) (mod 5)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(2*b == 2*2) (mod 5)` ASSUME_TAC THENL + [MATCH_MP_TAC CONG_TRANS THEN EXISTS_TAC `4` THEN CONJ_TAC THENL + [ONCE_REWRITE_TAC[GSYM(ASSUME `a = 2*b`)] THEN + ASM_REWRITE_TAC[]; + REWRITE_TAC[CONG] THEN CONV_TAC NUM_REDUCE_CONV]; + ALL_TAC] THEN + MP_TAC(MATCH_MP + (SPECL [`2`; `5`; `b:num`; `2`] CONG_MULT_LCANCEL_EQ) + (EQT_ELIM(COPRIME_CONV `coprime(2,5)`))) THEN + ASM_REWRITE_TAC[]);; + +let CONG_HALF_1_OR_4_MOD5 = prove + (`!a b:num. + a = 2*b /\ + ((a == 1) (mod 5) \/ (a == 4) (mod 5)) + ==> (b == 2) (mod 5) \/ (b == 3) (mod 5)`, + MESON_TAC[CONG_HALF_1_MOD5; CONG_HALF_4_MOD5]);; + +let NUM_125_UNIT_ALLOWED = prove + (`!a:num. + ~(5 divides a) /\ + ~num_125_exception (5*a) + ==> (a == 1) (mod 5) \/ (a == 4) (mod 5)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `~(a MOD 5 = 0)` ASSUME_TAC THENL + [UNDISCH_TAC `~(5 divides a)` THEN + REWRITE_TAC[DIVIDES_MOD] THEN CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + SUBGOAL_THEN `~(a MOD 5 = 2 \/ a MOD 5 = 3)` ASSUME_TAC THENL + [DISCH_TAC THEN + UNDISCH_TAC `~num_125_exception (5*a)` THEN + REWRITE_TAC[num_125_exception] THEN + MAP_EVERY EXISTS_TAC [`0`; `a:num`] THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + REWRITE_TAC[CONG] THEN CONV_TAC NUM_REDUCE_CONV THEN + MP_TAC(SPEC `a MOD 5` + (ARITH_RULE + `!r:num. r < 5 + ==> r = 0 \/ r = 1 \/ r = 2 \/ r = 3 \/ r = 4`)) THEN + ANTS_TAC THENL + [REWRITE_TAC[MOD_LT_EQ] THEN ARITH_TAC; + ASM_MESON_TAC[]]);; + +let REGULAR_125_NOT_EXCEPTION_NOT25 = prove + (`!n:num. + ~num_125_exception n /\ ~(25 divides n) + ==> ?x y z:int. + x pow 2 + &2 * y pow 2 + &5 * z pow 2 = &n`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + ASM_CASES_TAC `n = 0` THENL + [MAP_EVERY EXISTS_TAC [`&0:int`; `&0:int`; `&0:int`] THEN + ASM_REWRITE_TAC[] THEN CONV_TAC INT_RING; + ALL_TAC] THEN + ASM_CASES_TAC `5 divides n` THENL + [FIRST_X_ASSUM(X_CHOOSE_THEN `a:num` ASSUME_TAC o + REWRITE_RULE[divides]) THEN + SUBGOAL_THEN `1 <= a` ASSUME_TAC THENL + [ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `~(5 divides a)` ASSUME_TAC THENL + [DISCH_THEN(X_CHOOSE_THEN `b:num` ASSUME_TAC o + REWRITE_RULE[divides]) THEN + UNDISCH_TAC `~(25 divides n)` THEN REWRITE_TAC[divides] THEN + EXISTS_TAC `b:num` THEN ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `(a == 1) (mod 5) \/ (a == 4) (mod 5)` + ASSUME_TAC THENL + [MATCH_MP_TAC NUM_125_UNIT_ALLOWED THEN + ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[GSYM(ASSUME `n = 5*a`)] THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + ASM_CASES_TAC `ODD a` THENL + [MP_TAC(SPEC `a:num` REGULAR_125_ODD_FIVE) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + ONCE_REWRITE_TAC[ASSUME `n = 5*a`] THEN + REWRITE_TAC[INT_OF_NUM_MUL]; + SUBGOAL_THEN `EVEN a` ASSUME_TAC THENL + [ASM_REWRITE_TAC[GSYM NOT_ODD]; + ALL_TAC] THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `b:num` ASSUME_TAC o + REWRITE_RULE[EVEN_EXISTS]) THEN + SUBGOAL_THEN `1 <= b` ASSUME_TAC THENL + [ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `(b == 2) (mod 5) \/ (b == 3) (mod 5)` + ASSUME_TAC THENL + [MATCH_MP_TAC(SPECL [`a:num`; `b:num`] + CONG_HALF_1_OR_4_MOD5) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MP_TAC(SPEC `b:num` REGULAR_T_125_FIVE) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + DISCH_THEN(fun th -> + MP_TAC(MATCH_MP (SPEC `&5 * &b:int` REP_125_DOUBLE_OF_T) th)) THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` + (X_CHOOSE_THEN `z:int` (LABEL_TAC "rep")))) THEN + MAP_EVERY EXISTS_TAC [`x:int`; `y:int`; `z:int`] THEN + SUBGOAL_THEN `n = 2 * (5*b)` ASSUME_TAC THENL + [ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `&n:int = &2 * (&5 * &b)` ASSUME_TAC THENL + [MP_TAC(AP_TERM `\r:num. &r:int` + (ASSUME `n = 2 * (5*b)`)) THEN + REWRITE_TAC[INT_OF_NUM_MUL]; + REMOVE_THEN "rep" MP_TAC THEN ASM_REWRITE_TAC[]]]; + ASM_CASES_TAC `ODD n` THENL + [MATCH_MP_TAC REGULAR_125_COPRIME10 THEN + CONJ_TAC THENL + [ASM_ARITH_TAC; + MATCH_MP_TAC COPRIME_10_OF_ODD_NOT5 THEN ASM_REWRITE_TAC[]]; + SUBGOAL_THEN `EVEN n` ASSUME_TAC THENL + [ASM_REWRITE_TAC[GSYM NOT_ODD]; + ALL_TAC] THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `a:num` ASSUME_TAC o + REWRITE_RULE[EVEN_EXISTS]) THEN + SUBGOAL_THEN `1 <= a` ASSUME_TAC THENL + [ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `~(5 divides a)` ASSUME_TAC THENL + [DISCH_THEN(X_CHOOSE_THEN `b:num` ASSUME_TAC o + REWRITE_RULE[divides]) THEN + UNDISCH_TAC `~(5 divides n)` THEN REWRITE_TAC[divides] THEN + EXISTS_TAC `2*b:num` THEN ASM_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(SPEC `a:num` REGULAR_125_DOUBLE_COPRIME5) THEN + ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[ASSUME `n = 2*a`] THEN + REWRITE_TAC[INT_OF_NUM_MUL]]]);; + +let REGULAR_125_NOT_EXCEPTION = prove + (`!n:num. + ~num_125_exception n + ==> ?x y z:int. + x pow 2 + &2 * y pow 2 + &5 * z pow 2 = &n`, + MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN + DISCH_THEN(LABEL_TAC "ih") THEN DISCH_THEN(LABEL_TAC "avoid") THEN + ASM_CASES_TAC `25 divides n` THENL + [FIRST_X_ASSUM(X_CHOOSE_THEN `q:num` ASSUME_TAC o + REWRITE_RULE[divides]) THEN + ASM_CASES_TAC `n = 0` THENL + [MAP_EVERY EXISTS_TAC [`&0:int`; `&0:int`; `&0:int`] THEN + REWRITE_TAC[ASSUME `n = 0`] THEN CONV_TAC INT_REDUCE_CONV; + ALL_TAC] THEN + SUBGOAL_THEN `(q:num) < n` ASSUME_TAC THENL + [ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `~num_125_exception q` ASSUME_TAC THENL + [REMOVE_THEN "avoid" MP_TAC THEN + ONCE_REWRITE_TAC[ASSUME `n = 25*q`] THEN + MESON_TAC[NUM_125_EXCEPTION_SCALE25]; + ALL_TAC] THEN + ONCE_REWRITE_TAC[ASSUME `n = 25*q`] THEN + MATCH_MP_TAC INT_REPRESENTS_125_SCALE25 THEN + REMOVE_THEN "ih" (MP_TAC o SPEC `q:num`) THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC REGULAR_125_NOT_EXCEPTION_NOT25 THEN + ASM_REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Positive binary forms of determinant 7 have two classes. *) +(* ------------------------------------------------------------------------- *) + +let INT_DISC7_NOT_FIRST3 = prove + (`!a b:int. ~(&3 * a - b pow 2 = &7)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MP_TAC(SPECL [`b:int`; `&3:int`] INT_DIVISION) THEN + ANTS_TAC THENL [INT_ARITH_TAC; STRIP_TAC] THEN + MP_TAC(SPEC `b:int` INT_REM_3_CASES) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THENL + [SUBGOAL_THEN `&3 divides (&7:int)` MP_TAC THENL + [REWRITE_TAC[int_divides] THEN + EXISTS_TAC `a - &3 * (b div &3) pow 2` THEN + MAP_EVERY UNDISCH_TAC + [`&3 * a - b pow 2 = &7`; + `b = b div &3 * &3 + b rem &3`; + `b rem &3 = &0`] THEN + CONV_TAC INT_RING; + REWRITE_TAC[GSYM INT_REM_EQ_0] THEN CONV_TAC INT_REDUCE_CONV]; + SUBGOAL_THEN `&3 divides (&8:int)` MP_TAC THENL + [REWRITE_TAC[int_divides] THEN + EXISTS_TAC + `a - &3 * (b div &3) pow 2 - &2 * (b div &3)` THEN + MAP_EVERY UNDISCH_TAC + [`&3 * a - b pow 2 = &7`; + `b = b div &3 * &3 + b rem &3`; + `b rem &3 = &1`] THEN + CONV_TAC INT_RING; + REWRITE_TAC[GSYM INT_REM_EQ_0] THEN CONV_TAC INT_REDUCE_CONV]; + SUBGOAL_THEN `&3 divides (&11:int)` MP_TAC THENL + [REWRITE_TAC[int_divides] THEN + EXISTS_TAC + `a - &3 * (b div &3) pow 2 - &4 * (b div &3)` THEN + MAP_EVERY UNDISCH_TAC + [`&3 * a - b pow 2 = &7`; + `b = b div &3 * &3 + b rem &3`; + `b rem &3 = &2`] THEN + CONV_TAC INT_RING; + REWRITE_TAC[GSYM INT_REM_EQ_0] THEN CONV_TAC INT_REDUCE_CONV]]);; + +let BINARY_DISC7 = prove + (`!A11. &0 < A11 + ==> !A12 A22. + A11 * A22 - A12 pow 2 = &7 + ==> ((!n. + (?x y. + A11 * x pow 2 + &2 * A12 * x * y + + A22 * y pow 2 = n) + ==> ?u v:int. u pow 2 + &7 * v pow 2 = n) \/ + (!n. + (?x y. + A11 * x pow 2 + &2 * A12 * x * y + + A22 * y pow 2 = n) + ==> ?u v:int. + &2 * u pow 2 + &2 * u * v + &4 * v pow 2 = n))`, + ONCE_REWRITE_TAC[MESON[] + `(!A11. &0 < A11 ==> P A11) <=> + (!m A11. num_of_int A11 = m /\ &0 < A11 ==> P A11)`] THEN + MATCH_MP_TAC num_WF THEN GEN_TAC THEN STRIP_TAC THEN + GEN_TAC THEN STRIP_TAC THEN REPEAT GEN_TAC THEN DISCH_TAC THEN + ASM_CASES_TAC `A11 = &1` THENL + [DISJ1_TAC THEN GEN_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` (X_CHOOSE_TAC `y:int`)) THEN + MAP_EVERY EXISTS_TAC [`x + A12 * y:int`; `y:int`] THEN + MP_TAC(ASSUME `A11 * A22 - A12 pow 2 = &7`) THEN + MP_TAC(ASSUME + `A11 * x pow 2 + &2 * A12 * x * y + A22 * y pow 2 = n`) THEN + REWRITE_TAC[ASSUME `A11 = &1`] THEN CONV_TAC INT_RING; + ALL_TAC] THEN + ASM_CASES_TAC `A11 = &2` THENL + [DISJ2_TAC THEN GEN_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` (X_CHOOSE_TAC `y:int`)) THEN + SUBGOAL_THEN `~(&2 divides A12)` ASSUME_TAC THENL + [DISCH_THEN(X_CHOOSE_TAC `q:int` o REWRITE_RULE[int_divides]) THEN + SUBGOAL_THEN `&2 divides (&7:int)` MP_TAC THENL + [REWRITE_TAC[int_divides] THEN + EXISTS_TAC `A22 - &2 * (q:int) pow 2` THEN + MP_TAC(ASSUME `A11 * A22 - A12 pow 2 = &7`) THEN + REWRITE_TAC[ASSUME `A11 = &2`; ASSUME `A12 = &2 * q`] THEN + CONV_TAC INT_RING; + REWRITE_TAC[GSYM INT_REM_EQ_0] THEN CONV_TAC INT_REDUCE_CONV]; + ALL_TAC] THEN + MP_TAC(MATCH_MP (SPEC `A12:int` INT_ODD_FORM) + (ASSUME `~(&2 divides A12)`)) THEN + DISCH_THEN(X_CHOOSE_TAC `q:int`) THEN + SUBGOAL_THEN `A22 = &2 * q pow 2 + &2 * q + &4` + ASSUME_TAC THENL + [MP_TAC(ASSUME `A11 * A22 - A12 pow 2 = &7`) THEN + REWRITE_TAC + [ASSUME `A11 = &2`; ASSUME `A12 = &2 * q + &1`] THEN + CONV_TAC INT_RING; + ALL_TAC] THEN + MAP_EVERY EXISTS_TAC [`x + q * y:int`; `y:int`] THEN + MP_TAC(ASSUME + `A11 * x pow 2 + &2 * A12 * x * y + A22 * y pow 2 = n`) THEN + REWRITE_TAC + [ASSUME `A11 = &2`; ASSUME `A12 = &2 * q + &1`; + ASSUME `A22 = &2 * q pow 2 + &2 * q + &4`] THEN + CONV_TAC INT_RING; + ALL_TAC] THEN + ASM_CASES_TAC `A11 = &3` THENL + [MP_TAC(ASSUME `A11 * A22 - A12 pow 2 = &7`) THEN + REWRITE_TAC[ASSUME `A11 = &3`] THEN + MESON_TAC[INT_DISC7_NOT_FIRST3]; + ALL_TAC] THEN + MP_TAC(SPECL [`A12:int`; `A11:int`] INT_BALANCED_REM) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `b:int` (LABEL_TAC "balanced")) THEN + ABBREV_TAC `r = --b:int` THEN + ABBREV_TAC `A12' = A12 + A11 * r` THEN + ABBREV_TAC `A22' = A11 * r pow 2 + &2 * A12 * r + A22` THEN + SUBGOAL_THEN `abs A12' * &2 <= A11` ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["A12'"; "r"] THEN + REMOVE_THEN "balanced" MP_TAC THEN + REWRITE_TAC[INT_ARITH + `A12 + A11 * --b = A12 - A11 * b`]; + ALL_TAC] THEN + SUBGOAL_THEN `A11 * A22' - A12' pow 2 = &7` ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["A12'"; "A22'"] THEN + UNDISCH_TAC `A11 * A22 - A12 pow 2 = &7` THEN + CONV_TAC INT_RING; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < A22'` ASSUME_TAC THENL + [SUBGOAL_THEN `&0 < A11 * A22'` MP_TAC THENL + [SUBGOAL_THEN `A11 * A22' = &7 + A12' pow 2` SUBST1_TAC THENL + [ASM_INT_ARITH_TAC; + MP_TAC(SPEC `A12':int` INT_LE_POW_2) THEN INT_ARITH_TAC]; + ASM_SIMP_TAC[INT_LT_MUL_EQ]]; + ALL_TAC] THEN + SUBGOAL_THEN `&4 <= A11` ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `&28 < &3 * A11 pow 2` ASSUME_TAC THENL + [SUBGOAL_THEN `&16 <= A11 pow 2` MP_TAC THENL + [MP_TAC(SPECL [`2`; `&4:int`; `A11:int`] INT_POW_LE2) THEN + ANTS_TAC THENL [ASM_INT_ARITH_TAC; CONV_TAC INT_REDUCE_CONV]; + INT_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN `A22' < A11` ASSUME_TAC THENL + [SUBGOAL_THEN `&4 * (A11 * A22') <= &28 + A11 pow 2` + ASSUME_TAC THENL + [SUBGOAL_THEN `A11 * A22' = &7 + A12' pow 2` + (fun th -> REWRITE_TAC[th]) THENL + [ASM_INT_ARITH_TAC; + MP_TAC(MATCH_MP SQ_BOUND + (ASSUME `abs A12' * &2 <= A11`)) THEN INT_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN `A11 * (&4 * A22') < A11 * (&4 * A11)` MP_TAC THENL + [MATCH_MP_TAC INT_LET_TRANS THEN + EXISTS_TAC `&28 + A11 pow 2` THEN + CONJ_TAC THENL + [UNDISCH_TAC `&4 * (A11 * A22') <= &28 + A11 pow 2` THEN + INT_ARITH_TAC; + REWRITE_TAC[INT_POW_2] THEN + UNDISCH_TAC `&28 < &3 * A11 pow 2` THEN + REWRITE_TAC[INT_POW_2] THEN INT_ARITH_TAC]; + ASM_SIMP_TAC[INT_LT_LMUL_EQ] THEN INT_ARITH_TAC]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `num_of_int A22'`) THEN + SUBGOAL_THEN `num_of_int A22' < m` ASSUME_TAC THENL + [FIRST_X_ASSUM(SUBST1_TAC o SYM o + check (fun th -> rand(concl th) = `m:num`)) THEN + REWRITE_TAC[GSYM INT_OF_NUM_LT] THEN + SUBGOAL_THEN `&(num_of_int A22') = A22' /\ &(num_of_int A11) = A11` + (CONJUNCTS_THEN SUBST1_TAC) THENL + [CONJ_TAC THEN MATCH_MP_TAC INT_OF_NUM_OF_INT THEN ASM_INT_ARITH_TAC; + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `A22':int`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPECL [`A12':int`; `A11:int`]) THEN + ANTS_TAC THENL + [MP_TAC(ASSUME `A11 * A22' - A12' pow 2 = &7`) THEN + CONV_TAC INT_RING; + DISCH_THEN(DISJ_CASES_THEN (LABEL_TAC "class")) THENL + [DISJ1_TAC; DISJ2_TAC] THEN + X_GEN_TAC `n:int` THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` (X_CHOOSE_TAC `y:int`)) THEN + REMOVE_THEN "class" (MATCH_MP_TAC o SPEC `n:int`) THEN + MAP_EVERY EXISTS_TAC [`y:int`; `x - r * y:int`] THEN + MAP_EVERY EXPAND_TAC ["A12'"; "A22'"] THEN + UNDISCH_TAC + `A11 * x pow 2 + &2 * A12 * x * y + A22 * y pow 2 = n` THEN + CONV_TAC INT_RING]);; + +(* ------------------------------------------------------------------------- *) +(* The discriminant-seven genus has 2-adic oddity 1. *) +(* ------------------------------------------------------------------------- *) + +let ternary_type1 = new_definition + `ternary_type1 a11 a12 a13 a22 a23 a33 <=> + ?w1 w2 w3 q:int. + (!x1 x2 x3. + &2 divides + (tqeval a11 a12 a13 a22 a23 a33 x1 x2 x3 - + tqbilin a11 a12 a13 a22 a23 a33 x1 x2 x3 w1 w2 w3)) /\ + tqeval a11 a12 a13 a22 a23 a33 w1 w2 w3 = &8 * q + &1`;; + +let CONJ_TYPE1 = prove + (`!a11 a12 a13 a22 a23 a33 v1 v2 v3 c12 c13 c22 c23 c32 c33 + b11 b12 b13 b22 b23 b33:int. + v1 * (c22 * c33 - c23 * c32) - + c12 * (v2 * c33 - c23 * v3) + + c13 * (v2 * c32 - c22 * v3) = &1 /\ + b11 = a11 * v1 pow 2 + &2 * a12 * v1 * v2 + + &2 * a13 * v1 * v3 + a22 * v2 pow 2 + + &2 * a23 * v2 * v3 + a33 * v3 pow 2 /\ + b22 = a11 * c12 pow 2 + &2 * a12 * c12 * c22 + + &2 * a13 * c12 * c32 + a22 * c22 pow 2 + + &2 * a23 * c22 * c32 + a33 * c32 pow 2 /\ + b33 = a11 * c13 pow 2 + &2 * a12 * c13 * c23 + + &2 * a13 * c13 * c33 + a22 * c23 pow 2 + + &2 * a23 * c23 * c33 + a33 * c33 pow 2 /\ + b12 = a11 * v1 * c12 + a12 * (v1 * c22 + v2 * c12) + + a13 * (v1 * c32 + v3 * c12) + + a22 * v2 * c22 + a23 * (v2 * c32 + v3 * c22) + + a33 * v3 * c32 /\ + b13 = a11 * v1 * c13 + a12 * (v1 * c23 + v2 * c13) + + a13 * (v1 * c33 + v3 * c13) + + a22 * v2 * c23 + a23 * (v2 * c33 + v3 * c23) + + a33 * v3 * c33 /\ + b23 = a11 * c12 * c13 + a12 * (c12 * c23 + c22 * c13) + + a13 * (c12 * c33 + c32 * c13) + + a22 * c22 * c23 + a23 * (c22 * c33 + c32 * c23) + + a33 * c32 * c33 /\ + ternary_type1 a11 a12 a13 a22 a23 a33 + ==> ternary_type1 b11 b12 b13 b22 b23 b33`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o REWRITE_RULE[ternary_type1]) THEN + DISCH_THEN(X_CHOOSE_THEN `w1:int` (X_CHOOSE_THEN `w2:int` + (X_CHOOSE_THEN `w3:int` (X_CHOOSE_THEN `q:int` STRIP_ASSUME_TAC)))) THEN + MP_TAC(SPECL + [`v1:int`; `v2:int`; `v3:int`; `c12:int`; `c22:int`; `c32:int`; + `c13:int`; `c23:int`; `c33:int`; `w1:int`; `w2:int`; `w3:int`] + ADJ_PREIMAGE) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `y1:int` (X_CHOOSE_THEN `y2:int` + (X_CHOOSE_THEN `y3:int` STRIP_ASSUME_TAC))) THEN + REWRITE_TAC[ternary_type1] THEN + MAP_EVERY EXISTS_TAC [`y1:int`; `y2:int`; `y3:int`; `q:int`] THEN + CONJ_TAC THENL + [MAP_EVERY X_GEN_TAC [`z1:int`; `z2:int`; `z3:int`] THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`z1 * v1 + z2 * c12 + z3 * c13:int`; + `z1 * v2 + z2 * c22 + z3 * c23:int`; + `z1 * v3 + z2 * c32 + z3 * c33:int`] o + check (fun th -> is_forall(concl th))) THEN + REWRITE_TAC[int_divides] THEN + DISCH_THEN(X_CHOOSE_TAC `d:int`) THEN EXISTS_TAC `d:int` THEN + POP_ASSUM_LIST + (fun ths -> MAP_EVERY MP_TAC (filter (is_eq o concl) ths)) THEN + REWRITE_TAC[tqeval; tqbilin] THEN CONV_TAC INT_RING; + POP_ASSUM_LIST + (fun ths -> MAP_EVERY MP_TAC (filter (is_eq o concl) ths)) THEN + REWRITE_TAC[tqeval; tqbilin] THEN CONV_TAC INT_RING]);; + +let TERNARY_TYPE1_OF_CHARACTERISTIC = prove + (`!a11 a12 a13 a22 a23 a33 w1 w2 w3 q:int. + &2 divides (a11 - (a11 * w1 + a12 * w2 + a13 * w3)) /\ + &2 divides (a22 - (a12 * w1 + a22 * w2 + a23 * w3)) /\ + &2 divides (a33 - (a13 * w1 + a23 * w2 + a33 * w3)) /\ + tqeval a11 a12 a13 a22 a23 a33 w1 w2 w3 = &8 * q + &1 + ==> ternary_type1 a11 a12 a13 a22 a23 a33`, + REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[ternary_type1] THEN + MAP_EVERY EXISTS_TAC [`w1:int`; `w2:int`; `w3:int`; `q:int`] THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC TERNARY_CHARACTERISTIC THEN + ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Hermite reduction leaves only minima 1 and 2. *) +(* ------------------------------------------------------------------------- *) + +let HERMITE_CUBE_DISC7 = prove + (`!a G:int. + &0 < a /\ &0 < G /\ + &3 * a pow 2 <= &4 * G /\ &3 * G pow 2 <= &4 * (&7 * a) + ==> &27 * a pow 3 <= &448`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(&3 * a pow 2) pow 2 <= (&4 * G) pow 2` MP_TAC THENL + [MATCH_MP_TAC INT_POW_LE2 THEN CONJ_TAC THENL + [MATCH_MP_TAC INT_LE_MUL THEN REWRITE_TAC[INT_LE_POW_2] THEN + INT_ARITH_TAC; + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + REWRITE_TAC[INT_POW_MUL] THEN DISCH_TAC THEN + MATCH_MP_TAC INT_LE_RCANCEL_IMP THEN EXISTS_TAC `a:int` THEN + CONJ_TAC THENL [FIRST_ASSUM ACCEPT_TAC; ALL_TAC] THEN + MATCH_MP_TAC INT_LE_TRANS THEN + EXISTS_TAC `&16 * (&3 * G pow 2)` THEN + CONJ_TAC THENL + [MP_TAC + (ASSUME `&3 pow 2 * a pow 2 pow 2 <= &4 pow 2 * G pow 2`) THEN + REWRITE_TAC[INT_ARITH `a pow 2 pow 2 = a pow 3 * a`; INT_POW_2] THEN + INT_ARITH_TAC; + MP_TAC(ASSUME `&3 * G pow 2 <= &4 * (&7 * a)`) THEN + INT_ARITH_TAC]);; + +let HERMITE_DISC7_LE2 = prove + (`!b11 b12 b13 b22 b23 b33:int. + &0 < b11 /\ + b11 * (b22 * b33 - b23 pow 2) - + b12 * (b12 * b33 - b13 * b23) + + b13 * (b12 * b23 - b13 * b22) = &7 /\ + &0 < b11 * b22 - b12 pow 2 /\ + (!x y z. ~(x = &0 /\ y = &0 /\ z = &0) + ==> b11 <= b11 * x pow 2 + b22 * y pow 2 + + b33 * z pow 2 + &2 * b12 * x * y + + &2 * b13 * x * z + &2 * b23 * y * z) + ==> b11 = &1 \/ b11 = &2`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + ABBREV_TAC `G11 = b11 * b22 - b12 pow 2` THEN + ABBREV_TAC `G12 = b11 * b23 - b12 * b13` THEN + ABBREV_TAC `G22 = b11 * b33 - b13 pow 2` THEN + SUBGOAL_THEN `G11 * G22 - G12 pow 2 = &7 * b11` ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["G11"; "G12"; "G22"] THEN + REWRITE_TAC[DISC_G] THEN + MP_TAC + (ASSUME + `b11 * (b22 * b33 - b23 pow 2) - + b12 * (b12 * b33 - b13 * b23) + + b13 * (b12 * b23 - b13 * b22) = &7`) THEN + CONV_TAC INT_RING; + ALL_TAC] THEN + MP_TAC(SPEC `&7 * b11:int` BINARY_HERMITE) THEN + ANTS_TAC THENL [ASM_INT_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `G11:int`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPECL [`G12:int`; `G22:int`]) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `s:int` + (X_CHOOSE_THEN `t:int` STRIP_ASSUME_TAC)) THEN + ABBREV_TAC + `Gst = G11 * s pow 2 + &2 * G12 * s * t + G22 * t pow 2` THEN + MP_TAC(SPECL [`b12 * s + b13 * t:int`; `b11:int`] + INT_BALANCED_REM) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `bb:int`) THEN + ABBREV_TAC `x1 = --bb:int` THEN + SUBGOAL_THEN + `&4 * (b11 * x1 + b12 * s + b13 * t) pow 2 <= b11 pow 2` + ASSUME_TAC THENL + [MP_TAC(MATCH_MP SQ_BOUND + (ASSUME + `abs ((b12 * s + b13 * t) - b11 * bb) * &2 <= b11`)) THEN + EXPAND_TAC "x1" THEN + REWRITE_TAC + [INT_ARITH + `b11 * --bb + b12 * s + b13 * t = + (b12 * s + b13 * t) - b11 * bb`] THEN + INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `&3 * b11 pow 2 <= &4 * Gst` ASSUME_TAC THENL + [MATCH_MP_TAC HERMITE_LOWER THEN + MAP_EVERY EXISTS_TAC + [`b12:int`; `b13:int`; `b22:int`; `b23:int`; `b33:int`; + `x1:int`; `s:int`; `t:int`] THEN + ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [FIRST_X_ASSUM + (fun th -> + MP_TAC(SPECL [`x1:int`; `s:int`; `t:int`] th) THEN + ANTS_TAC THENL + [UNDISCH_TAC `~(s = &0 /\ t = &0)` THEN MESON_TAC[]; + ALL_TAC] THEN + DISCH_THEN(fun th2 -> ACCEPT_TAC th2 ORELSE MP_TAC th2)); + EXPAND_TAC "Gst" THEN + MP_TAC(SPECL + [`b11:int`; `b12:int`; `b13:int`; `b22:int`; `b23:int`; + `b33:int`; `x1:int`; `s:int`; `t:int`] TERNARY_COMPLETE) THEN + MAP_EVERY (fun e -> UNDISCH_TAC e) + [`b11 * b22 - b12 pow 2 = G11`; + `b11 * b23 - b12 * b13 = G12`; + `b11 * b33 - b13 pow 2 = G22`] THEN + CONV_TAC INT_RING]; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < Gst` ASSUME_TAC THENL + [EXPAND_TAC "Gst" THEN + MP_TAC(SPECL [`G11:int`; `G12:int`; `G22:int`] + POSDEF_BINARY_CRITERION) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN ASM_INT_ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPECL [`s:int`; `t:int`]) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; REWRITE_TAC[]]; + ALL_TAC] THEN + MP_TAC(SPECL [`b11:int`; `Gst:int`] HERMITE_CUBE_DISC7) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + SUBGOAL_THEN `~(&3 <= b11)` ASSUME_TAC THENL + [DISCH_TAC THEN MP_TAC(SPEC `b11:int` CUBE_GE_27) THEN + ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `&27 * b11 pow 3 <= &448` THEN INT_ARITH_TAC; + ALL_TAC] THEN + ASM_INT_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* A norm-one vector splits off either binary determinant-seven class. *) +(* ------------------------------------------------------------------------- *) + +let TERNARY_DISC7_A11_1 = prove + (`!a12 a13 a22 a23 a33 n:int. + &0 < &1 * a22 - a12 pow 2 /\ + &1 * (a22 * a33 - a23 pow 2) - + a12 * (a12 * a33 - a23 * a13) + + a13 * (a12 * a23 - a22 * a13) = &7 /\ + (?x1 x2 x3. + &1 * x1 pow 2 + a22 * x2 pow 2 + a33 * x3 pow 2 + + &2 * a12 * x1 * x2 + &2 * a13 * x1 * x3 + + &2 * a23 * x2 * x3 = n) + ==> ((?u v w:int. u pow 2 + v pow 2 + &7 * w pow 2 = n) \/ + (?u v w:int. + u pow 2 + &2 * v pow 2 + &2 * v * w + + &4 * w pow 2 = n))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + ABBREV_TAC `G11 = a22 - a12 pow 2` THEN + ABBREV_TAC `G12 = a23 - a12 * a13` THEN + ABBREV_TAC `G22 = a33 - a13 pow 2` THEN + SUBGOAL_THEN `&0 < G11` ASSUME_TAC THENL + [EXPAND_TAC "G11" THEN + UNDISCH_TAC `&0 < &1 * a22 - a12 pow 2` THEN + REWRITE_TAC[INT_MUL_LID]; + ALL_TAC] THEN + SUBGOAL_THEN `G11 * G22 - G12 pow 2 = &7` ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["G11"; "G12"; "G22"] THEN + UNDISCH_TAC + `&1 * (a22 * a33 - a23 pow 2) - + a12 * (a12 * a33 - a23 * a13) + + a13 * (a12 * a23 - a22 * a13) = &7` THEN + CONV_TAC INT_RING; + ALL_TAC] THEN + ABBREV_TAC `L = x1 + a12 * x2 + a13 * x3` THEN + MP_TAC(SPEC `G11:int` BINARY_DISC7) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPECL [`G12:int`; `G22:int`]) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(DISJ_CASES_THEN (LABEL_TAC "class")) THENL + [DISJ1_TAC; DISJ2_TAC] THEN + (REMOVE_THEN "class" (MP_TAC o SPEC `n - L pow 2`) THEN + ANTS_TAC THENL + [MAP_EVERY EXISTS_TAC [`x2:int`; `x3:int`] THEN + MP_TAC(SPECL + [`&1:int`; `a12:int`; `a13:int`; `a22:int`; `a23:int`; `a33:int`; + `x1:int`; `x2:int`; `x3:int`] TERNARY_COMPLETE) THEN + ASM_REWRITE_TAC[INT_MUL_LID] THEN INT_ARITH_TAC; + ALL_TAC]) THEN + DISCH_THEN(X_CHOOSE_THEN `v:int` (X_CHOOSE_TAC `w:int`)) THEN + MAP_EVERY EXISTS_TAC [`L:int`; `v:int`; `w:int`] THEN + FIRST_X_ASSUM MP_TAC THEN INT_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* If the minimum is two, primitive binary reduction leaves two cases. *) +(* ------------------------------------------------------------------------- *) + +let HERMITE_DISC7_MIN2_PAIR = prove + (`!b12 b13 b22 b23 b33:int. + &2 * (b22 * b33 - b23 pow 2) - + b12 * (b12 * b33 - b13 * b23) + + b13 * (b12 * b23 - b13 * b22) = &7 /\ + &0 < &2 * b22 - b12 pow 2 /\ + (!x y z. ~(x = &0 /\ y = &0 /\ z = &0) + ==> &2 <= &2 * x pow 2 + b22 * y pow 2 + + b33 * z pow 2 + &2 * b12 * x * y + + &2 * b13 * x * z + &2 * b23 * y * z) + ==> ?x y z. + (?p q. y * p + z * q = &1) /\ + ((&2 * x pow 2 + b22 * y pow 2 + b33 * z pow 2 + + &2 * b12 * x * y + &2 * b13 * x * z + + &2 * b23 * y * z = &2 /\ + (&2 * x + b12 * y + b13 * z) pow 2 = &1 /\ + (&2 * b22 - b12 pow 2) * y pow 2 + + &2 * (&2 * b23 - b12 * b13) * y * z + + (&2 * b33 - b13 pow 2) * z pow 2 = &3) \/ + (&2 * x pow 2 + b22 * y pow 2 + b33 * z pow 2 + + &2 * b12 * x * y + &2 * b13 * x * z + + &2 * b23 * y * z = &2 /\ + &2 * x + b12 * y + b13 * z = &0 /\ + (&2 * b22 - b12 pow 2) * y pow 2 + + &2 * (&2 * b23 - b12 * b13) * y * z + + (&2 * b33 - b13 pow 2) * z pow 2 = &4))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + ABBREV_TAC `G11 = &2 * b22 - b12 pow 2` THEN + ABBREV_TAC `G12 = &2 * b23 - b12 * b13` THEN + ABBREV_TAC `G22 = &2 * b33 - b13 pow 2` THEN + SUBGOAL_THEN `G11 * G22 - G12 pow 2 = &14` ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["G11"; "G12"; "G22"] THEN + REWRITE_TAC[DISC_G] THEN + MP_TAC(ASSUME + `&2 * (b22 * b33 - b23 pow 2) - + b12 * (b12 * b33 - b13 * b23) + + b13 * (b12 * b23 - b13 * b22) = &7`) THEN + CONV_TAC INT_RING; + ALL_TAC] THEN + MP_TAC(SPEC `&14:int` BINARY_HERMITE_PRIMITIVE) THEN + CONV_TAC INT_REDUCE_CONV THEN + DISCH_THEN(MP_TAC o SPEC `G11:int`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPECL [`G12:int`; `G22:int`]) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `s:int` + (X_CHOOSE_THEN `t:int` + (CONJUNCTS_THEN2 + (X_CHOOSE_THEN `p:int` (X_CHOOSE_TAC `q:int`)) + ASSUME_TAC))) THEN + ABBREV_TAC + `Gst = G11 * s pow 2 + &2 * G12 * s * t + G22 * t pow 2` THEN + SUBGOAL_THEN `&3 * Gst pow 2 <= &4 * &14` ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(SPECL [`b12 * s + b13 * t:int`; `&2:int`] + INT_BALANCED_REM) THEN + CONV_TAC INT_REDUCE_CONV THEN + DISCH_THEN(X_CHOOSE_TAC `bb:int`) THEN + ABBREV_TAC `x1 = --bb:int` THEN + ABBREV_TAC + `Fst = &2 * x1 pow 2 + b22 * s pow 2 + b33 * t pow 2 + + &2 * b12 * x1 * s + &2 * b13 * x1 * t + + &2 * b23 * s * t` THEN + ABBREV_TAC `l = &2 * x1 + b12 * s + b13 * t` THEN + SUBGOAL_THEN `&4 * l pow 2 <= &4` ASSUME_TAC THENL + [MP_TAC(MATCH_MP SQ_BOUND + (ASSUME `abs ((b12 * s + b13 * t) - &2 * bb) * &2 <= &2`)) THEN + MAP_EVERY EXPAND_TAC ["l"; "x1"] THEN + REWRITE_TAC[INT_ARITH + `&2 * --bb + b12 * s + b13 * t = + (b12 * s + b13 * t) - &2 * bb`] THEN + INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `&2 <= Fst` ASSUME_TAC THENL + [EXPAND_TAC "Fst" THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + DISCH_TAC THEN UNDISCH_TAC `s * p + t * q = &1` THEN + ASM_REWRITE_TAC[] THEN INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `&2 * Fst = l pow 2 + Gst` ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["Fst"; "l"; "Gst"; "G11"; "G12"; "G22"] THEN + CONV_TAC INT_RING; + ALL_TAC] THEN + SUBGOAL_THEN `&3 <= Gst` ASSUME_TAC THENL + [UNDISCH_TAC `&2 <= Fst` THEN + UNDISCH_TAC `&4 * l pow 2 <= &4` THEN + UNDISCH_TAC `&2 * Fst = l pow 2 + Gst` THEN + MP_TAC(SPEC `l:int` INT_LE_POW_2) THEN INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `Gst <= &4` ASSUME_TAC THENL + [ASM_CASES_TAC `Gst <= &4` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `&25 <= Gst pow 2` ASSUME_TAC THENL + [MP_TAC(SPECL [`2`; `&5:int`; `Gst:int`] INT_POW_LE2) THEN + ANTS_TAC THENL [ASM_INT_ARITH_TAC; CONV_TAC INT_REDUCE_CONV]; + UNDISCH_TAC `&3 * Gst pow 2 <= &4 * &14` THEN + ASM_INT_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN `l pow 2 = &0 \/ l pow 2 = &1` + (LABEL_TAC "lsqcases") THENL + [UNDISCH_TAC `&4 * l pow 2 <= &4` THEN + MP_TAC(SPEC `l:int` INT_LE_POW_2) THEN INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `l = &0 \/ l pow 2 = &1` + (LABEL_TAC "lcases") THENL + [REMOVE_THEN "lsqcases" MP_TAC THEN + REWRITE_TAC[INT_POW_EQ_0] THEN CONV_TAC NUM_REDUCE_CONV THEN + MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `Fst = &2` ASSUME_TAC THENL + [UNDISCH_TAC `Gst <= &4` THEN + UNDISCH_TAC `&4 * l pow 2 <= &4` THEN + UNDISCH_TAC `&2 <= Fst` THEN + UNDISCH_TAC `&2 * Fst = l pow 2 + Gst` THEN + MP_TAC(SPEC `Gst:int` INT_LE_POW_2) THEN INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `(Fst = &2 /\ l pow 2 = &1 /\ Gst = &3) \/ + (Fst = &2 /\ l = &0 /\ Gst = &4)` + (LABEL_TAC "shortcases") THENL + [REMOVE_THEN "lcases" (DISJ_CASES_THEN ASSUME_TAC) THEN + UNDISCH_TAC `&3 <= Gst` THEN UNDISCH_TAC `Gst <= &4` THEN + UNDISCH_TAC `&2 * Fst = l pow 2 + Gst` THEN + ASM_REWRITE_TAC[] THEN INT_ARITH_TAC; + ALL_TAC] THEN + MAP_EVERY EXISTS_TAC [`x1:int`; `s:int`; `t:int`] THEN + CONJ_TAC THENL + [MAP_EVERY EXISTS_TAC [`p:int`; `q:int`] THEN ASM_REWRITE_TAC[]; + REMOVE_THEN "shortcases" MP_TAC THEN + MAP_EVERY EXPAND_TAC ["Fst"; "l"; "Gst"; "G11"; "G12"; "G22"] THEN + REWRITE_TAC[]]);; + +let INT_ODD_DET_KERNEL_MOD2 = prove + (`!a11 a12 a13 a22 a23 a33 d x y z:int. + d = + a11 * (a22 * a33 - a23 pow 2) - + a12 * (a12 * a33 - a13 * a23) + + a13 * (a12 * a23 - a13 * a22) /\ + ~(&2 divides d) /\ + &2 divides (a11 * x + a12 * y + a13 * z) /\ + &2 divides (a12 * x + a22 * y + a23 * z) /\ + &2 divides (a13 * x + a23 * y + a33 * z) + ==> &2 divides x /\ &2 divides y /\ &2 divides z`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + FIRST_X_ASSUM(X_CHOOSE_TAC `r1:int` o REWRITE_RULE[int_divides] o + check (fun th -> rand(concl th) = + `a11 * x + a12 * y + a13 * z:int`)) THEN + FIRST_X_ASSUM(X_CHOOSE_TAC `r2:int` o REWRITE_RULE[int_divides] o + check (fun th -> rand(concl th) = + `a12 * x + a22 * y + a23 * z:int`)) THEN + FIRST_X_ASSUM(X_CHOOSE_TAC `r3:int` o REWRITE_RULE[int_divides] o + check (fun th -> rand(concl th) = + `a13 * x + a23 * y + a33 * z:int`)) THEN + SUBGOAL_THEN `&2 divides d * x` ASSUME_TAC THENL + [REWRITE_TAC[int_divides] THEN + EXISTS_TAC + `(a22 * a33 - a23 pow 2) * r1 + + (a13 * a23 - a12 * a33) * r2 + + (a12 * a23 - a13 * a22) * r3:int` THEN + POP_ASSUM_LIST + (fun ths -> MAP_EVERY MP_TAC (filter (is_eq o concl) ths)) THEN + CONV_TAC INT_RING; + ALL_TAC] THEN + SUBGOAL_THEN `&2 divides d * y` ASSUME_TAC THENL + [REWRITE_TAC[int_divides] THEN + EXISTS_TAC + `(a13 * a23 - a12 * a33) * r1 + + (a11 * a33 - a13 pow 2) * r2 + + (a12 * a13 - a11 * a23) * r3:int` THEN + POP_ASSUM_LIST + (fun ths -> MAP_EVERY MP_TAC (filter (is_eq o concl) ths)) THEN + CONV_TAC INT_RING; + ALL_TAC] THEN + SUBGOAL_THEN `&2 divides d * z` ASSUME_TAC THENL + [REWRITE_TAC[int_divides] THEN + EXISTS_TAC + `(a12 * a23 - a13 * a22) * r1 + + (a12 * a13 - a11 * a23) * r2 + + (a11 * a22 - a12 pow 2) * r3:int` THEN + POP_ASSUM_LIST + (fun ths -> MAP_EVERY MP_TAC (filter (is_eq o concl) ths)) THEN + CONV_TAC INT_RING; + ALL_TAC] THEN + REPEAT CONJ_TAC THENL + [UNDISCH_TAC `&2 divides d * x`; + UNDISCH_TAC `&2 divides d * y`; + UNDISCH_TAC `&2 divides d * z`] THEN + REWRITE_TAC[INT_2_DIVIDES_MUL] THEN ASM_MESON_TAC[]);; + +let INT_CHARACTERISTIC_VALUES_CONG8 = prove + (`!a11 a12 a13 a22 a23 a33 v1 v2 v3 w1 w2 w3:int. + &2 divides (a11 - (a11 * v1 + a12 * v2 + a13 * v3)) /\ + &2 divides (a22 - (a12 * v1 + a22 * v2 + a23 * v3)) /\ + &2 divides (a33 - (a13 * v1 + a23 * v2 + a33 * v3)) /\ + &2 divides (w1 - v1) /\ + &2 divides (w2 - v2) /\ + &2 divides (w3 - v3) + ==> &8 divides + (tqeval a11 a12 a13 a22 a23 a33 w1 w2 w3 - + tqeval a11 a12 a13 a22 a23 a33 v1 v2 v3)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + FIRST_X_ASSUM(X_CHOOSE_TAC `u1:int` o REWRITE_RULE[int_divides] o + check (fun th -> rand(concl th) = `w1 - v1:int`)) THEN + FIRST_X_ASSUM(X_CHOOSE_TAC `u2:int` o REWRITE_RULE[int_divides] o + check (fun th -> rand(concl th) = `w2 - v2:int`)) THEN + FIRST_X_ASSUM(X_CHOOSE_TAC `u3:int` o REWRITE_RULE[int_divides] o + check (fun th -> rand(concl th) = `w3 - v3:int`)) THEN + SUBGOAL_THEN + `&2 divides + (tqeval a11 a12 a13 a22 a23 a33 u1 u2 u3 - + tqbilin a11 a12 a13 a22 a23 a33 u1 u2 u3 v1 v2 v3)` + ASSUME_TAC THENL + [MP_TAC(SPECL + [`a11:int`; `a12:int`; `a13:int`; `a22:int`; `a23:int`; `a33:int`; + `v1:int`; `v2:int`; `v3:int`] TERNARY_CHARACTERISTIC) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPECL [`u1:int`; `u2:int`; `u3:int`]) THEN + REWRITE_TAC[]; + ALL_TAC] THEN + FIRST_X_ASSUM(X_CHOOSE_TAC `r:int` o REWRITE_RULE[int_divides] o + check (fun th -> rand(concl th) = + `tqeval a11 a12 a13 a22 a23 a33 u1 u2 u3 - + tqbilin a11 a12 a13 a22 a23 a33 u1 u2 u3 v1 v2 v3:int`)) THEN + REWRITE_TAC[int_divides] THEN + EXISTS_TAC + `r + tqbilin a11 a12 a13 a22 a23 a33 + u1 u2 u3 v1 v2 v3:int` THEN + POP_ASSUM_LIST + (fun ths -> MAP_EVERY MP_TAC (filter (is_eq o concl) ths)) THEN + REWRITE_TAC[tqeval; tqbilin] THEN CONV_TAC INT_RING);; + +let INT_DISC7_BLOCK_CHARACTERISTIC = prove + (`!l c e f:int. + l pow 2 = &1 + ==> &2 divides (&2 - (&2 * e + l * c + c)) /\ + &2 divides (&2 - (l * e + &2 * c + e)) /\ + &2 divides (f - (c * e + e * c + f))`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MP_TAC(SPEC `l:int` INT_SQ_EQ_ONE) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(DISJ_CASES_THEN SUBST_ALL_TAC) THEN + REWRITE_TAC[int_divides] THEN REPEAT CONJ_TAC THENL + [EXISTS_TAC `&1 - e - c:int`; + EXISTS_TAC `&1 - c - e:int`; + EXISTS_TAC `--(c * e):int`; + EXISTS_TAC `&1 - e:int`; + EXISTS_TAC `&1 - c:int`; + EXISTS_TAC `--(c * e):int`] THEN + CONV_TAC INT_RING);; + +let INT_DISC7_BLOCK_ODDITY5 = prove + (`!l c e f:int. + l pow 2 = &1 /\ + &2 * (&2 * f - e pow 2) - + l * (l * f - c * e) + c * (l * e - &2 * c) = &7 + ==> ?q. + tqeval (&2) l c (&2) e f e c (&1) = &8 * q + &5`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + FIRST_X_ASSUM(LABEL_TAC "det" o check + (fun th -> is_eq(concl th) && rand(concl th) = `(&7:int)`)) THEN + MP_TAC(SPEC `l:int` INT_SQ_EQ_ONE) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(DISJ_CASES_THEN SUBST_ALL_TAC) THENL + [EXISTS_TAC `e pow 2 + c pow 2 - f + &2:int`; + EXISTS_TAC `e pow 2 + c pow 2 + e * c - f + &2:int`] THEN + REMOVE_THEN "det" MP_TAC THEN + REWRITE_TAC[tqeval] THEN CONV_TAC INT_RING);; + +let DISC7_BLOCK2_TYPE1_FALSE = prove + (`!l c e f:int. + l pow 2 = &1 /\ + &2 * (&2 * f - e pow 2) - + l * (l * f - c * e) + c * (l * e - &2 * c) = &7 /\ + ternary_type1 (&2) l c (&2) e f + ==> F`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o REWRITE_RULE[ternary_type1]) THEN + DISCH_THEN(X_CHOOSE_THEN `w1:int` (X_CHOOSE_THEN `w2:int` + (X_CHOOSE_THEN `w3:int` (X_CHOOSE_THEN `q:int` + (CONJUNCTS_THEN2 (LABEL_TAC "char") (LABEL_TAC "oddity1")))))) THEN + MP_TAC(MATCH_MP (SPECL [`l:int`; `c:int`; `e:int`; `f:int`] + INT_DISC7_BLOCK_CHARACTERISTIC) (ASSUME `l pow 2 = &1`)) THEN + DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "vchar1") + (CONJUNCTS_THEN2 (LABEL_TAC "vchar2") (LABEL_TAC "vchar3"))) THEN + SUBGOAL_THEN + `&2 divides + (&2 * (w1 - e) + l * (w2 - c) + c * (w3 - &1)) /\ + &2 divides + (l * (w1 - e) + &2 * (w2 - c) + e * (w3 - &1)) /\ + &2 divides + (c * (w1 - e) + e * (w2 - c) + f * (w3 - &1))` + (LABEL_TAC "diffs") THENL + [REMOVE_THEN "char" (fun th -> + MP_TAC(SPECL [`&1:int`; `&0:int`; `&0:int`] th) THEN + MP_TAC(SPECL [`&0:int`; `&1:int`; `&0:int`] th) THEN + MP_TAC(SPECL [`&0:int`; `&0:int`; `&1:int`] th)) THEN + REWRITE_TAC[tqeval; tqbilin] THEN + DISCH_THEN(LABEL_TAC "wchar3") THEN + DISCH_THEN(LABEL_TAC "wchar2") THEN + DISCH_THEN(LABEL_TAC "wchar1") THEN + REMOVE_THEN "wchar1" + (X_CHOOSE_TAC `s1:int` o REWRITE_RULE[int_divides]) THEN + REMOVE_THEN "wchar2" + (X_CHOOSE_TAC `s2:int` o REWRITE_RULE[int_divides]) THEN + REMOVE_THEN "wchar3" + (X_CHOOSE_TAC `s3:int` o REWRITE_RULE[int_divides]) THEN + REMOVE_THEN "vchar1" + (X_CHOOSE_TAC `t1:int` o REWRITE_RULE[int_divides]) THEN + REMOVE_THEN "vchar2" + (X_CHOOSE_TAC `t2:int` o REWRITE_RULE[int_divides]) THEN + REMOVE_THEN "vchar3" + (X_CHOOSE_TAC `t3:int` o REWRITE_RULE[int_divides]) THEN + REWRITE_TAC[int_divides] THEN CONJ_TAC THENL + [EXISTS_TAC `t1 - s1:int` THEN + POP_ASSUM_LIST + (fun ths -> MAP_EVERY MP_TAC (filter (is_eq o concl) ths)) THEN + CONV_TAC INT_RING; + CONJ_TAC THENL + [EXISTS_TAC `t2 - s2:int` THEN + POP_ASSUM_LIST + (fun ths -> MAP_EVERY MP_TAC (filter (is_eq o concl) ths)) THEN + CONV_TAC INT_RING; + EXISTS_TAC `t3 - s3:int` THEN + POP_ASSUM_LIST + (fun ths -> MAP_EVERY MP_TAC (filter (is_eq o concl) ths)) THEN + CONV_TAC INT_RING]]; + ALL_TAC] THEN + REMOVE_THEN "diffs" STRIP_ASSUME_TAC THEN + SUBGOAL_THEN + `&2 divides (w1 - e) /\ + &2 divides (w2 - c) /\ + &2 divides (w3 - &1)` + STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC(SPECL + [`&2:int`; `l:int`; `c:int`; `&2:int`; `e:int`; `f:int`; + `&7:int`; `w1 - e:int`; `w2 - c:int`; `w3 - &1:int`] + INT_ODD_DET_KERNEL_MOD2) THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [UNDISCH_TAC + `&2 * (&2 * f - e pow 2) - + l * (l * f - c * e) + c * (l * e - &2 * c) = &7` THEN + CONV_TAC INT_RING; + REWRITE_TAC[GSYM INT_REM_EQ_0] THEN CONV_TAC INT_REDUCE_CONV]; + ALL_TAC] THEN + MP_TAC(MATCH_MP (SPECL [`l:int`; `c:int`; `e:int`; `f:int`] + INT_DISC7_BLOCK_ODDITY5) + (CONJ + (ASSUME `l pow 2 = &1`) + (ASSUME + `&2 * (&2 * f - e pow 2) - + l * (l * f - c * e) + c * (l * e - &2 * c) = &7`))) THEN + DISCH_THEN(X_CHOOSE_THEN `r:int` (LABEL_TAC "oddity5")) THEN + SUBGOAL_THEN `&8 divides (&4:int)` MP_TAC THENL + [SUBGOAL_THEN + `&8 divides + (tqeval (&2) l c (&2) e f w1 w2 w3 - + tqeval (&2) l c (&2) e f e c (&1))` + MP_TAC THENL + [MATCH_MP_TAC(SPECL + [`&2:int`; `l:int`; `c:int`; `&2:int`; `e:int`; `f:int`; + `e:int`; `c:int`; `&1:int`; `w1:int`; `w2:int`; `w3:int`] + INT_CHARACTERISTIC_VALUES_CONG8) THEN + ASM_REWRITE_TAC[INT_MUL_RID]; + DISCH_THEN(X_CHOOSE_THEN `d:int` (fun dth -> + REWRITE_TAC[int_divides] THEN + EXISTS_TAC `q - r - d:int` THEN + MP_TAC dth THEN + MAP_EVERY UNDISCH_TAC + [`tqeval (&2) l c (&2) e f w1 w2 w3 = &8 * q + &1`; + `tqeval (&2) l c (&2) e f e c (&1) = &8 * r + &5`] THEN + CONV_TAC INT_RING) o REWRITE_RULE[int_divides])]; + REWRITE_TAC[GSYM INT_REM_EQ_0] THEN CONV_TAC INT_REDUCE_CONV]);; + +(* ------------------------------------------------------------------------- *) +(* Hence a determinant-seven type-1 lattice cannot have minimum two. *) +(* ------------------------------------------------------------------------- *) + +let DISC7_MIN2_EXCLUDED = prove + (`!b12 b13 b22 b23 b33:int. + &2 * (b22 * b33 - b23 pow 2) - + b12 * (b12 * b33 - b13 * b23) + + b13 * (b12 * b23 - b13 * b22) = &7 /\ + &0 < &2 * b22 - b12 pow 2 /\ + (!x y z. ~(x = &0 /\ y = &0 /\ z = &0) + ==> &2 <= &2 * x pow 2 + b22 * y pow 2 + + b33 * z pow 2 + &2 * b12 * x * y + + &2 * b13 * x * z + &2 * b23 * y * z) /\ + ternary_type1 (&2) b12 b13 b22 b23 b33 + ==> F`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(SPECL + [`b12:int`; `b13:int`; `b22:int`; `b23:int`; `b33:int`] + HERMITE_DISC7_MIN2_PAIR) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `r:int` + (X_CHOOSE_THEN `s:int` + (X_CHOOSE_THEN `t:int` + (CONJUNCTS_THEN2 + (X_CHOOSE_THEN `p:int` (X_CHOOSE_TAC `q:int`)) + (LABEL_TAC "cases"))))) THEN + ABBREV_TAC `l = &2 * r + b12 * s + b13 * t` THEN + ABBREV_TAC + `d = &2 * r pow 2 + b22 * s pow 2 + b33 * t pow 2 + + &2 * b12 * r * s + &2 * b13 * r * t + + &2 * b23 * s * t` THEN + ABBREV_TAC `c = --(b12 * q) + b13 * p` THEN + ABBREV_TAC + `e = --(b12 * r * q) + b13 * r * p - b22 * s * q + + b23 * s * p - b23 * t * q + b33 * t * p` THEN + ABBREV_TAC + `f = b22 * q pow 2 + b33 * p pow 2 - &2 * b23 * p * q` THEN + SUBGOAL_THEN + `&2 * (d * f - e pow 2) - + l * (l * f - c * e) + c * (l * e - d * c) = &7` + (LABEL_TAC "det") THENL + [TRANS_TAC EQ_TRANS + `(&2 * (b22 * b33 - b23 pow 2) - + b12 * (b12 * b33 - b13 * b23) + + b13 * (b12 * b23 - b13 * b22)) * + (s * p + t * q) pow 2` THEN + CONJ_TAC THENL + [MAP_EVERY EXPAND_TAC ["l"; "d"; "c"; "e"; "f"] THEN + CONV_TAC INT_RING; + ASM_REWRITE_TAC[] THEN CONV_TAC INT_REDUCE_CONV]; + ALL_TAC] THEN + SUBGOAL_THEN `ternary_type1 (&2) l c d e f` + (LABEL_TAC "type1") THENL + [MATCH_MP_TAC CONJ_TYPE1 THEN + MAP_EVERY EXISTS_TAC + [`&2:int`; `b12:int`; `b13:int`; `b22:int`; `b23:int`; `b33:int`; + `&1:int`; `&0:int`; `&0:int`; + `r:int`; `&0:int`; `s:int`; `--q:int`; `t:int`; `p:int`] THEN + REPEAT CONJ_TAC THENL + [UNDISCH_TAC `s * p + t * q = &1` THEN CONV_TAC INT_RING; + CONV_TAC INT_RING; + EXPAND_TAC "d" THEN CONV_TAC INT_RING; + EXPAND_TAC "f" THEN CONV_TAC INT_RING; + EXPAND_TAC "l" THEN CONV_TAC INT_RING; + EXPAND_TAC "c" THEN CONV_TAC INT_RING; + EXPAND_TAC "e" THEN CONV_TAC INT_RING; + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + REMOVE_THEN "cases" + (REPEAT_TCL DISJ_CASES_THEN STRIP_ASSUME_TAC) THENL + [SUBGOAL_THEN `d = &2 /\ l pow 2 = &1` STRIP_ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["d"; "l"] THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC(SPECL [`l:int`; `c:int`; `e:int`; `f:int`] + DISC7_BLOCK2_TYPE1_FALSE) THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [REMOVE_THEN "det" (fun th -> MP_TAC th THEN ASM_REWRITE_TAC[]); + REMOVE_THEN "type1" (fun th -> MP_TAC th THEN ASM_REWRITE_TAC[])]]; + SUBGOAL_THEN `d = &2 /\ l = &0` STRIP_ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["d"; "l"] THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `&2 divides (&7:int)` MP_TAC THENL + [REWRITE_TAC[int_divides] THEN + EXISTS_TAC `(&2 * f - e pow 2 - c pow 2):int` THEN + REMOVE_THEN "det" MP_TAC THEN ASM_REWRITE_TAC[] THEN + CONV_TAC INT_RING; + REWRITE_TAC[GSYM INT_REM_EQ_0] THEN CONV_TAC INT_REDUCE_CONV]]);; + +(* ------------------------------------------------------------------------- *) +(* The determinant-seven type-1 genus consists of the two advertised forms. *) +(* ------------------------------------------------------------------------- *) + +let TERNARY_DISC7_TYPE1 = prove + (`!a11 a12 a13 a22 a23 a33 n:int. + &0 < a11 /\ + &0 < a11 * a22 - a12 pow 2 /\ + a11 * (a22 * a33 - a23 pow 2) - + a12 * (a12 * a33 - a13 * a23) + + a13 * (a12 * a23 - a13 * a22) = &7 /\ + ternary_type1 a11 a12 a13 a22 a23 a33 /\ + (?x y z. + a11 * x pow 2 + a22 * y pow 2 + a33 * z pow 2 + + &2 * a12 * x * y + &2 * a13 * x * z + + &2 * a23 * y * z = n) + ==> ((?u v w:int. u pow 2 + v pow 2 + &7 * w pow 2 = n) \/ + (?u v w:int. + u pow 2 + &2 * v pow 2 + &2 * v * w + + &4 * w pow 2 = n))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN + `!x y z. ~(x = &0 /\ y = &0 /\ z = &0) + ==> &0 < a11 * x pow 2 + a22 * y pow 2 + a33 * z pow 2 + + &2 * a12 * x * y + &2 * a13 * x * z + + &2 * a23 * y * z` + (LABEL_TAC "posdef") THENL + [MATCH_MP_TAC TERNARY_POSDEF THEN ASM_REWRITE_TAC[] THEN + ASM_INT_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(SPECL + [`a11:int`; `a12:int`; `a13:int`; `a22:int`; `a23:int`; `a33:int`] + TERNARY_MIN) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `v1:int` + (X_CHOOSE_THEN `v2:int` + (X_CHOOSE_THEN `v3:int` + (CONJUNCTS_THEN2 (LABEL_TAC "vnonzero") + (LABEL_TAC "amin"))))) THEN + SUBGOAL_THEN `?p q r. v1 * p + v2 * q + v3 * r = &1` + STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC MIN_PRIMITIVE THEN + MAP_EVERY EXISTS_TAC + [`a11:int`; `a12:int`; `a13:int`; `a22:int`; `a23:int`; `a33:int`] THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MP_TAC(SPECL [`v1:int`; `v2:int`; `v3:int`] SL3_EXTEND) THEN + ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `c12:int` + (X_CHOOSE_THEN `c13:int` + (X_CHOOSE_THEN `c22:int` + (X_CHOOSE_THEN `c23:int` + (X_CHOOSE_THEN `c32:int` + (X_CHOOSE_THEN `c33:int` (LABEL_TAC "detU"))))))) THEN + ABBREV_TAC + `b11 = a11 * v1 pow 2 + &2 * a12 * v1 * v2 + + &2 * a13 * v1 * v3 + a22 * v2 pow 2 + + &2 * a23 * v2 * v3 + a33 * v3 pow 2` THEN + ABBREV_TAC + `b22 = a11 * c12 pow 2 + &2 * a12 * c12 * c22 + + &2 * a13 * c12 * c32 + a22 * c22 pow 2 + + &2 * a23 * c22 * c32 + a33 * c32 pow 2` THEN + ABBREV_TAC + `b33 = a11 * c13 pow 2 + &2 * a12 * c13 * c23 + + &2 * a13 * c13 * c33 + a22 * c23 pow 2 + + &2 * a23 * c23 * c33 + a33 * c33 pow 2` THEN + ABBREV_TAC + `b12 = a11 * v1 * c12 + a12 * (v1 * c22 + v2 * c12) + + a13 * (v1 * c32 + v3 * c12) + a22 * v2 * c22 + + a23 * (v2 * c32 + v3 * c22) + a33 * v3 * c32` THEN + ABBREV_TAC + `b13 = a11 * v1 * c13 + a12 * (v1 * c23 + v2 * c13) + + a13 * (v1 * c33 + v3 * c13) + a22 * v2 * c23 + + a23 * (v2 * c33 + v3 * c23) + a33 * v3 * c33` THEN + ABBREV_TAC + `b23 = a11 * c12 * c13 + a12 * (c12 * c23 + c22 * c13) + + a13 * (c12 * c33 + c32 * c13) + a22 * c22 * c23 + + a23 * (c22 * c33 + c32 * c23) + a33 * c32 * c33` THEN + SUBGOAL_THEN + `!x y z. ~(x = &0 /\ y = &0 /\ z = &0) + ==> b11 <= b11 * x pow 2 + b22 * y pow 2 + + b33 * z pow 2 + &2 * b12 * x * y + + &2 * b13 * x * z + &2 * b23 * y * z` + (LABEL_TAC "bmin") THENL + [MATCH_MP_TAC CONJ_MIN THEN + MAP_EVERY EXISTS_TAC + [`a11:int`; `a12:int`; `a13:int`; `a22:int`; `a23:int`; `a33:int`; + `v1:int`; `v2:int`; `v3:int`; `c12:int`; `c13:int`; + `c22:int`; `c23:int`; `c32:int`; `c33:int`] THEN + ASM_REWRITE_TAC[] THEN + MAP_EVERY EXPAND_TAC ["b11"; "b12"; "b13"; "b22"; "b23"; "b33"]; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < b11` ASSUME_TAC THENL + [MP_TAC(MATCH_MP + (SPECL [`v1:int`; `v2:int`; `v3:int`] + (ASSUME + `!x y z. ~(x = &0 /\ y = &0 /\ z = &0) + ==> &0 < a11 * x pow 2 + a22 * y pow 2 + + a33 * z pow 2 + &2 * a12 * x * y + + &2 * a13 * x * z + &2 * a23 * y * z`)) + (ASSUME `~(v1 = &0 /\ v2 = &0 /\ v3 = &0)`)) THEN + EXPAND_TAC "b11" THEN INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `b11 * (b22 * b33 - b23 pow 2) - + b12 * (b12 * b33 - b13 * b23) + + b13 * (b12 * b23 - b13 * b22) = &7` + (LABEL_TAC "bdet") THENL + [TRANS_TAC EQ_TRANS + `(a11 * (a22 * a33 - a23 pow 2) - + a12 * (a12 * a33 - a13 * a23) + + a13 * (a12 * a23 - a13 * a22)) * + (v1 * (c22 * c33 - c23 * c32) - + c12 * (v2 * c33 - c23 * v3) + + c13 * (v2 * c32 - c22 * v3)) pow 2` THEN + CONJ_TAC THENL + [MAP_EVERY EXPAND_TAC + ["b11"; "b12"; "b13"; "b22"; "b23"; "b33"] THEN + CONV_TAC INT_RING; + USE_THEN "detU" (fun th -> REWRITE_TAC[th]) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC INT_REDUCE_CONV]; + ALL_TAC] THEN + SUBGOAL_THEN + `!x y z. ~(x = &0 /\ y = &0 /\ z = &0) + ==> &0 < b11 * x pow 2 + b22 * y pow 2 + + b33 * z pow 2 + &2 * b12 * x * y + + &2 * b13 * x * z + &2 * b23 * y * z` + (LABEL_TAC "bposdef") THENL + [REPEAT STRIP_TAC THEN + MATCH_MP_TAC INT_LTE_TRANS THEN EXISTS_TAC `b11:int` THEN + ASM_REWRITE_TAC[] THEN USE_THEN "bmin" MATCH_MP_TAC THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < b11 * b22 - b12 pow 2` + (LABEL_TAC "bminor") THENL + [MATCH_MP_TAC POSDEF_MINOR2 THEN + MAP_EVERY EXISTS_TAC [`b13:int`; `b23:int`; `b33:int`] THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `ternary_type1 b11 b12 b13 b22 b23 b33` + (LABEL_TAC "btype1") THENL + [MATCH_MP_TAC CONJ_TYPE1 THEN + MAP_EVERY EXISTS_TAC + [`a11:int`; `a12:int`; `a13:int`; `a22:int`; `a23:int`; `a33:int`; + `v1:int`; `v2:int`; `v3:int`; `c12:int`; `c13:int`; + `c22:int`; `c23:int`; `c32:int`; `c33:int`] THEN + ASM_REWRITE_TAC[] THEN + MAP_EVERY EXPAND_TAC ["b11"; "b12"; "b13"; "b22"; "b23"; "b33"]; + ALL_TAC] THEN + SUBGOAL_THEN + `!r:int. + (?x y z. + a11 * x pow 2 + a22 * y pow 2 + a33 * z pow 2 + + &2 * a12 * x * y + &2 * a13 * x * z + + &2 * a23 * y * z = r) + ==> ?x y z. + b11 * x pow 2 + b22 * y pow 2 + b33 * z pow 2 + + &2 * b12 * x * y + &2 * b13 * x * z + + &2 * b23 * y * z = r` + (LABEL_TAC "transfer") THENL + [X_GEN_TAC `r0:int` THEN DISCH_TAC THEN + MATCH_MP_TAC CONJ_REPS THEN + MAP_EVERY EXISTS_TAC + [`a11:int`; `a12:int`; `a13:int`; `a22:int`; `a23:int`; `a33:int`; + `v1:int`; `v2:int`; `v3:int`; `c12:int`; `c13:int`; + `c22:int`; `c23:int`; `c32:int`; `c33:int`] THEN + ASM_REWRITE_TAC[] THEN + MAP_EVERY EXPAND_TAC ["b11"; "b12"; "b13"; "b22"; "b23"; "b33"]; + ALL_TAC] THEN + SUBGOAL_THEN + `?x y z. + a11 * x pow 2 + a22 * y pow 2 + a33 * z pow 2 + + &2 * a12 * x * y + &2 * a13 * x * z + + &2 * a23 * y * z = n` + (LABEL_TAC "anrep") THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + USE_THEN "transfer" (fun tr -> + USE_THEN "anrep" (fun th -> MP_TAC(MATCH_MP (SPEC `n:int` tr) th))) THEN + DISCH_THEN(LABEL_TAC "bnrep") THEN + MP_TAC(SPECL + [`b11:int`; `b12:int`; `b13:int`; `b22:int`; `b23:int`; `b33:int`] + HERMITE_DISC7_LE2) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(DISJ_CASES_THEN ASSUME_TAC) THENL + [MATCH_MP_TAC TERNARY_DISC7_A11_1 THEN + MAP_EVERY EXISTS_TAC + [`b12:int`; `b13:int`; `b22:int`; `b23:int`; `b33:int`] THEN + REPEAT CONJ_TAC THENL + [REMOVE_THEN "bminor" + (fun th -> MP_TAC th THEN ASM_REWRITE_TAC[INT_MUL_LID]); + REMOVE_THEN "bdet" + (fun th -> + MP_TAC th THEN ASM_REWRITE_TAC[INT_MUL_LID] THEN + CONV_TAC INT_RING); + REMOVE_THEN "bnrep" + (fun th -> MP_TAC th THEN ASM_REWRITE_TAC[INT_MUL_LID])]; + SUBGOAL_THEN `F` MP_TAC THENL + [MATCH_MP_TAC(SPECL + [`b12:int`; `b13:int`; `b22:int`; `b23:int`; `b33:int`] + DISC7_MIN2_EXCLUDED) THEN + REPEAT CONJ_TAC THENL + [REMOVE_THEN "bdet" + (fun th -> MP_TAC th THEN ASM_REWRITE_TAC[] THEN + CONV_TAC INT_RING); + REMOVE_THEN "bminor" + (fun th -> MP_TAC th THEN ASM_REWRITE_TAC[]); + REMOVE_THEN "bmin" + (fun th -> MP_TAC th THEN ASM_REWRITE_TAC[]); + REMOVE_THEN "btype1" + (fun th -> MP_TAC th THEN ASM_REWRITE_TAC[])]; + MESON_TAC[]]]);; + +let DIAG7_TO_CROSS124_YZ = prove + (`!n x y z e:int. + x pow 2 + y pow 2 + &7 * z pow 2 = n /\ y + z = &2 * e + ==> ?u v w. + u pow 2 + &2 * v pow 2 + &2 * v * w + &4 * w pow 2 = n`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MAP_EVERY EXISTS_TAC [`x:int`; `z + e:int`; `z - e:int`] THEN + MAP_EVERY UNDISCH_TAC + [`x pow 2 + y pow 2 + &7 * z pow 2 = n`; `y + z = &2 * e`] THEN + CONV_TAC INT_RING);; + +let DIAG7_TO_CROSS124_XZ = prove + (`!n x y z e:int. + x pow 2 + y pow 2 + &7 * z pow 2 = n /\ x + z = &2 * e + ==> ?u v w. + u pow 2 + &2 * v pow 2 + &2 * v * w + &4 * w pow 2 = n`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MAP_EVERY EXISTS_TAC [`y:int`; `z + e:int`; `z - e:int`] THEN + MAP_EVERY UNDISCH_TAC + [`x pow 2 + y pow 2 + &7 * z pow 2 = n`; `x + z = &2 * e`] THEN + CONV_TAC INT_RING);; + +let DIAG7_EEO_NOT_MOD4_01 = prove + (`!a b c q:int. + ~(((&2 * a) pow 2 + (&2 * b) pow 2 + + &7 * (&2 * c + &1) pow 2 = &4 * q) \/ + ((&2 * a) pow 2 + (&2 * b) pow 2 + + &7 * (&2 * c + &1) pow 2 = &4 * q + &1))`, + REPEAT GEN_TAC THEN DISCH_THEN(DISJ_CASES_THEN ASSUME_TAC) THENL + [SUBGOAL_THEN `&4 divides (&7:int)` MP_TAC THENL + [REWRITE_TAC[int_divides] THEN + EXISTS_TAC + `q - a pow 2 - b pow 2 - &7 * c pow 2 - &7 * c:int` THEN + FIRST_X_ASSUM MP_TAC THEN CONV_TAC INT_RING; + REWRITE_TAC[GSYM INT_REM_EQ_0] THEN CONV_TAC INT_REDUCE_CONV]; + SUBGOAL_THEN `&4 divides (&6:int)` MP_TAC THENL + [REWRITE_TAC[int_divides] THEN + EXISTS_TAC + `q - a pow 2 - b pow 2 - &7 * c pow 2 - &7 * c:int` THEN + FIRST_X_ASSUM MP_TAC THEN CONV_TAC INT_RING; + REWRITE_TAC[GSYM INT_REM_EQ_0] THEN CONV_TAC INT_REDUCE_CONV]]);; + +let DIAG7_OOE_NOT_MOD4_01 = prove + (`!a b c q:int. + ~(((&2 * a + &1) pow 2 + (&2 * b + &1) pow 2 + + &7 * (&2 * c) pow 2 = &4 * q) \/ + ((&2 * a + &1) pow 2 + (&2 * b + &1) pow 2 + + &7 * (&2 * c) pow 2 = &4 * q + &1))`, + REPEAT GEN_TAC THEN DISCH_THEN(DISJ_CASES_THEN ASSUME_TAC) THENL + [SUBGOAL_THEN `&4 divides (&2:int)` MP_TAC THENL + [REWRITE_TAC[int_divides] THEN + EXISTS_TAC + `(q - a pow 2 - a - b pow 2 - b - &7 * c pow 2):int` THEN + FIRST_X_ASSUM MP_TAC THEN CONV_TAC INT_RING; + REWRITE_TAC[GSYM INT_REM_EQ_0] THEN CONV_TAC INT_REDUCE_CONV]; + SUBGOAL_THEN `&4 divides (&1:int)` MP_TAC THENL + [REWRITE_TAC[int_divides] THEN + EXISTS_TAC + `(q - a pow 2 - a - b pow 2 - b - &7 * c pow 2):int` THEN + FIRST_X_ASSUM MP_TAC THEN CONV_TAC INT_RING; + REWRITE_TAC[GSYM INT_REM_EQ_0] THEN CONV_TAC INT_REDUCE_CONV]]);; + +let DIAG7_MOD4_PARITY = prove + (`!x y z:int. + (?q. x pow 2 + y pow 2 + &7 * z pow 2 = &4 * q \/ + x pow 2 + y pow 2 + &7 * z pow 2 = &4 * q + &1) + ==> (?e. y + z = &2 * e) \/ (?e. x + z = &2 * e)`, + REPEAT GEN_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `q:int` ASSUME_TAC) THEN + MP_TAC(SPEC `z:int` INT_PARITY_WITNESS) THEN + MP_TAC(SPEC `y:int` INT_PARITY_WITNESS) THEN + MP_TAC(SPEC `x:int` INT_PARITY_WITNESS) THEN + DISCH_THEN(DISJ_CASES_THEN (X_CHOOSE_THEN `a:int` ASSUME_TAC)) THEN + DISCH_THEN(DISJ_CASES_THEN (X_CHOOSE_THEN `b:int` ASSUME_TAC)) THEN + DISCH_THEN(DISJ_CASES_THEN (X_CHOOSE_THEN `c:int` ASSUME_TAC)) THENL + [DISJ1_TAC THEN EXISTS_TAC `b + c:int` THEN ASM_REWRITE_TAC[] THEN + CONV_TAC INT_RING; + SUBGOAL_THEN `F` MP_TAC THENL + [MP_TAC(SPECL [`a:int`; `b:int`; `c:int`; `q:int`] + DIAG7_EEO_NOT_MOD4_01) THEN ASM_MESON_TAC[]; + MESON_TAC[]]; + DISJ2_TAC THEN EXISTS_TAC `a + c:int` THEN ASM_REWRITE_TAC[] THEN + CONV_TAC INT_RING; + DISJ1_TAC THEN EXISTS_TAC `b + c + &1:int` THEN ASM_REWRITE_TAC[] THEN + CONV_TAC INT_RING; + DISJ1_TAC THEN EXISTS_TAC `b + c:int` THEN ASM_REWRITE_TAC[] THEN + CONV_TAC INT_RING; + DISJ2_TAC THEN EXISTS_TAC `a + c + &1:int` THEN ASM_REWRITE_TAC[] THEN + CONV_TAC INT_RING; + SUBGOAL_THEN `F` MP_TAC THENL + [MP_TAC(SPECL [`a:int`; `b:int`; `c:int`; `q:int`] + DIAG7_OOE_NOT_MOD4_01) THEN ASM_MESON_TAC[]; + MESON_TAC[]]; + DISJ1_TAC THEN EXISTS_TAC `b + c + &1:int` THEN ASM_REWRITE_TAC[] THEN + CONV_TAC INT_RING]);; + +let REPR_CROSS124_OF_DIAG7_MOD4 = prove + (`!n:int. + (?x y z. x pow 2 + y pow 2 + &7 * z pow 2 = n) /\ + (?q. n = &4 * q \/ n = &4 * q + &1) + ==> ?x y z. + x pow 2 + &2 * y pow 2 + &2 * y * z + + &4 * z pow 2 = n`, + GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` + (X_CHOOSE_THEN `z:int` (LABEL_TAC "repr")))) + (X_CHOOSE_THEN `q:int` (LABEL_TAC "mod4"))) THEN + MP_TAC(SPECL [`x:int`; `y:int`; `z:int`] DIAG7_MOD4_PARITY) THEN + ANTS_TAC THENL + [EXISTS_TAC `q:int` THEN + USE_THEN "repr" MP_TAC THEN USE_THEN "mod4" MP_TAC THEN + MESON_TAC[]; + DISCH_THEN(DISJ_CASES_THEN + (X_CHOOSE_THEN `e:int` ASSUME_TAC)) THENL + [MATCH_MP_TAC(SPECL [`n:int`; `x:int`; `y:int`; `z:int`; `e:int`] + DIAG7_TO_CROSS124_YZ) THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC(SPECL [`n:int`; `x:int`; `y:int`; `z:int`; `e:int`] + DIAG7_TO_CROSS124_XZ) THEN + ASM_REWRITE_TAC[]]]);; + +let CROSS124_TO_DIAG7_YZ = prove + (`!n x y z e:int. + x pow 2 + &2 * y pow 2 + &2 * y * z + &4 * z pow 2 = n /\ + y + z = &2 * e + ==> ?u v w. u pow 2 + v pow 2 + &7 * w pow 2 = n`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MAP_EVERY EXISTS_TAC [`x:int`; `e - &2 * z:int`; `e:int`] THEN + MAP_EVERY UNDISCH_TAC + [`x pow 2 + &2 * y pow 2 + &2 * y * z + &4 * z pow 2 = n`; + `y + z = &2 * e`] THEN + CONV_TAC INT_RING);; + +let CROSS124_TO_DIAG7_Y_EVEN = prove + (`!n x y z e:int. + x pow 2 + &2 * y pow 2 + &2 * y * z + &4 * z pow 2 = n /\ + y = &2 * e + ==> ?u v w. u pow 2 + v pow 2 + &7 * w pow 2 = n`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MAP_EVERY EXISTS_TAC [`x:int`; `--e - &2 * z:int`; `--e:int`] THEN + MAP_EVERY UNDISCH_TAC + [`x pow 2 + &2 * y pow 2 + &2 * y * z + &4 * z pow 2 = n`; + `y = &2 * e`] THEN + CONV_TAC INT_RING);; + +let CROSS124_EOE_NOT_MOD4_01 = prove + (`!a b c q:int. + ~(((&2 * a) pow 2 + &2 * (&2 * b + &1) pow 2 + + &2 * (&2 * b + &1) * (&2 * c) + &4 * (&2 * c) pow 2 = &4 * q) \/ + ((&2 * a) pow 2 + &2 * (&2 * b + &1) pow 2 + + &2 * (&2 * b + &1) * (&2 * c) + &4 * (&2 * c) pow 2 = + &4 * q + &1))`, + REPEAT GEN_TAC THEN DISCH_THEN(DISJ_CASES_THEN ASSUME_TAC) THENL + [SUBGOAL_THEN `&4 divides (&2:int)` MP_TAC THENL + [REWRITE_TAC[int_divides] THEN + EXISTS_TAC + `(q - a pow 2 - &2 * b pow 2 - &2 * b - + &2 * b * c - c - &4 * c pow 2):int` THEN + FIRST_X_ASSUM MP_TAC THEN CONV_TAC INT_RING; + REWRITE_TAC[GSYM INT_REM_EQ_0] THEN CONV_TAC INT_REDUCE_CONV]; + SUBGOAL_THEN `&4 divides (&1:int)` MP_TAC THENL + [REWRITE_TAC[int_divides] THEN + EXISTS_TAC + `(q - a pow 2 - &2 * b pow 2 - &2 * b - + &2 * b * c - c - &4 * c pow 2):int` THEN + FIRST_X_ASSUM MP_TAC THEN CONV_TAC INT_RING; + REWRITE_TAC[GSYM INT_REM_EQ_0] THEN CONV_TAC INT_REDUCE_CONV]]);; + +let CROSS124_OOE_NOT_MOD4_01 = prove + (`!a b c q:int. + ~(((&2 * a + &1) pow 2 + &2 * (&2 * b + &1) pow 2 + + &2 * (&2 * b + &1) * (&2 * c) + &4 * (&2 * c) pow 2 = &4 * q) \/ + ((&2 * a + &1) pow 2 + &2 * (&2 * b + &1) pow 2 + + &2 * (&2 * b + &1) * (&2 * c) + &4 * (&2 * c) pow 2 = + &4 * q + &1))`, + REPEAT GEN_TAC THEN DISCH_THEN(DISJ_CASES_THEN ASSUME_TAC) THENL + [SUBGOAL_THEN `&4 divides (&3:int)` MP_TAC THENL + [REWRITE_TAC[int_divides] THEN + EXISTS_TAC + `(q - a pow 2 - a - &2 * b pow 2 - &2 * b - + &2 * b * c - c - &4 * c pow 2):int` THEN + FIRST_X_ASSUM MP_TAC THEN CONV_TAC INT_RING; + REWRITE_TAC[GSYM INT_REM_EQ_0] THEN CONV_TAC INT_REDUCE_CONV]; + SUBGOAL_THEN `&4 divides (&2:int)` MP_TAC THENL + [REWRITE_TAC[int_divides] THEN + EXISTS_TAC + `(q - a pow 2 - a - &2 * b pow 2 - &2 * b - + &2 * b * c - c - &4 * c pow 2):int` THEN + FIRST_X_ASSUM MP_TAC THEN CONV_TAC INT_RING; + REWRITE_TAC[GSYM INT_REM_EQ_0] THEN CONV_TAC INT_REDUCE_CONV]]);; + +let REPR_DIAG7_OF_CROSS124_MOD4 = prove + (`!n:int. + (?x y z. + x pow 2 + &2 * y pow 2 + &2 * y * z + &4 * z pow 2 = n) /\ + (?q. n = &4 * q \/ n = &4 * q + &1) + ==> ?x y z. x pow 2 + y pow 2 + &7 * z pow 2 = n`, + GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` + (X_CHOOSE_THEN `z:int` (LABEL_TAC "repr")))) + (X_CHOOSE_THEN `q:int` (LABEL_TAC "mod4"))) THEN + MP_TAC(SPEC `z:int` INT_PARITY_WITNESS) THEN + MP_TAC(SPEC `y:int` INT_PARITY_WITNESS) THEN + MP_TAC(SPEC `x:int` INT_PARITY_WITNESS) THEN + DISCH_THEN(DISJ_CASES_THEN (X_CHOOSE_THEN `a:int` ASSUME_TAC)) THEN + DISCH_THEN(DISJ_CASES_THEN (X_CHOOSE_THEN `b:int` ASSUME_TAC)) THEN + DISCH_THEN(DISJ_CASES_THEN (X_CHOOSE_THEN `c:int` ASSUME_TAC)) THENL + [MATCH_MP_TAC(SPECL [`n:int`; `x:int`; `y:int`; `z:int`; `b:int`] + CROSS124_TO_DIAG7_Y_EVEN) THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC(SPECL [`n:int`; `x:int`; `y:int`; `z:int`; `b:int`] + CROSS124_TO_DIAG7_Y_EVEN) THEN ASM_REWRITE_TAC[]; + SUBGOAL_THEN `F` MP_TAC THENL + [MP_TAC(SPECL [`a:int`; `b:int`; `c:int`; `q:int`] + CROSS124_EOE_NOT_MOD4_01) THEN + USE_THEN "repr" MP_TAC THEN USE_THEN "mod4" MP_TAC THEN + ASM_MESON_TAC[]; + MESON_TAC[]]; + MATCH_MP_TAC(SPECL + [`n:int`; `x:int`; `y:int`; `z:int`; `b + c + &1:int`] + CROSS124_TO_DIAG7_YZ) THEN ASM_REWRITE_TAC[] THEN + CONV_TAC INT_RING; + MATCH_MP_TAC(SPECL [`n:int`; `x:int`; `y:int`; `z:int`; `b:int`] + CROSS124_TO_DIAG7_Y_EVEN) THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC(SPECL [`n:int`; `x:int`; `y:int`; `z:int`; `b:int`] + CROSS124_TO_DIAG7_Y_EVEN) THEN ASM_REWRITE_TAC[]; + SUBGOAL_THEN `F` MP_TAC THENL + [MP_TAC(SPECL [`a:int`; `b:int`; `c:int`; `q:int`] + CROSS124_OOE_NOT_MOD4_01) THEN + USE_THEN "repr" MP_TAC THEN USE_THEN "mod4" MP_TAC THEN + ASM_MESON_TAC[]; + MESON_TAC[]]; + MATCH_MP_TAC(SPECL + [`n:int`; `x:int`; `y:int`; `z:int`; `b + c + &1:int`] + CROSS124_TO_DIAG7_YZ) THEN ASM_REWRITE_TAC[] THEN + CONV_TAC INT_RING]);; + +(* ------------------------------------------------------------------------- *) +(* Parity and odd-square facts used to identify the 2-adic genus. *) +(* ------------------------------------------------------------------------- *) + +let INT_ODD_SQUARE_8_WITNESS = prove + (`!x:int. ~(&2 divides x) ==> ?q:int. x pow 2 = &8 * q + &1`, + GEN_TAC THEN DISCH_TAC THEN + MP_TAC(SPECL [`(x pow 2):int`; `&8:int`] INT_DIVISION) THEN + ANTS_TAC THENL [CONV_TAC INT_REDUCE_CONV; STRIP_TAC] THEN + EXISTS_TAC `x pow 2 div &8` THEN + UNDISCH_TAC + `x pow 2 = x pow 2 div &8 * &8 + x pow 2 rem &8` THEN + MP_TAC(MATCH_MP + (snd(EQ_IMP_RULE(SPEC `x:int` ODD_SQ_MOD_8))) + (ASSUME `~(&2 divides x)`)) THEN + CONV_TAC INT_RING);; + +let INT_DISC7_DIRICHLET_A11_PARITY = prove + (`!a11 t D n:int. + a11 * (&8 * D * n - &7) - t pow 2 = &8 * D + ==> &2 divides (a11 - t)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MP_TAC(SPEC `t:int` INT_SQ_SUB_SELF_EVEN) THEN + REWRITE_TAC[int_divides] THEN + DISCH_THEN(X_CHOOSE_THEN `q:int` ASSUME_TAC) THEN + REWRITE_TAC[int_divides] THEN + EXISTS_TAC `(&4 * D - a11 * (&4 * D * n - &4) + q):int` THEN + MAP_EVERY UNDISCH_TAC + [`a11 * (&8 * D * n - &7) - t pow 2 = &8 * D`; + `t pow 2 - t = &2 * q`] THEN + CONV_TAC INT_RING);; + +let DISC7_DIRICHLET_TYPE1 = prove + (`!a11 t D n:int. + a11 * (&8 * D * n - &7) - t pow 2 = &8 * D + ==> ternary_type1 + a11 t (&1) (&8 * D * n - &7) (&0) n`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MP_TAC(SPEC `n:int` INT_PARITY_WITNESS) THEN + DISCH_THEN(DISJ_CASES_THEN (X_CHOOSE_THEN `r:int` ASSUME_TAC)) THENL + [MATCH_MP_TAC(SPECL + [`a11:int`; `t:int`; `&1:int`; `&8 * D * n - &7:int`; + `&0:int`; `n:int`; `&0:int`; `&1:int`; `&0:int`; + `D * n - &1:int`] TERNARY_TYPE1_OF_CHARACTERISTIC) THEN + REPEAT CONJ_TAC THENL + [MP_TAC(SPECL [`a11:int`; `t:int`; `D:int`; `n:int`] + INT_DISC7_DIRICHLET_A11_PARITY) THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC + [INT_MUL_RZERO; INT_MUL_RID; INT_ADD_LID; INT_ADD_RID]; + REWRITE_TAC[int_divides] THEN EXISTS_TAC `&0:int` THEN + CONV_TAC INT_RING; + REWRITE_TAC[int_divides] THEN EXISTS_TAC `r:int` THEN + ASM_REWRITE_TAC[] THEN CONV_TAC INT_RING; + REWRITE_TAC[tqeval] THEN CONV_TAC INT_RING]; + ALL_TAC] THEN + MP_TAC(SPEC `t:int` INT_PARITY_WITNESS) THEN + DISCH_THEN(DISJ_CASES_THEN (X_CHOOSE_THEN `s:int` ASSUME_TAC)) THENL + [MP_TAC(SPEC `t + &1:int` INT_ODD_SQUARE_8_WITNESS) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[INT_2_DIVIDES_ADD] THEN + REWRITE_TAC[INT_DIVIDES_ONE] THEN CONV_TAC INT_REDUCE_CONV THEN + REWRITE_TAC[int_divides] THEN EXISTS_TAC `s:int` THEN + CONV_TAC INT_RING; + DISCH_THEN(X_CHOOSE_THEN `q:int` ASSUME_TAC)] THEN + MATCH_MP_TAC(SPECL + [`a11:int`; `t:int`; `&1:int`; `&8 * D * n - &7:int`; + `&0:int`; `n:int`; `&1:int`; `&1:int`; `&0:int`; + `q + D + (D * n - &1) * (&1 - a11):int`] + TERNARY_TYPE1_OF_CHARACTERISTIC) THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[int_divides] THEN EXISTS_TAC `--s:int` THEN + ASM_REWRITE_TAC[] THEN CONV_TAC INT_RING; + REWRITE_TAC[int_divides] THEN EXISTS_TAC `--s:int` THEN + ASM_REWRITE_TAC[] THEN CONV_TAC INT_RING; + REWRITE_TAC[int_divides] THEN EXISTS_TAC `r:int` THEN + ASM_REWRITE_TAC[] THEN CONV_TAC INT_RING; + MAP_EVERY UNDISCH_TAC + [`a11 * (&8 * D * n - &7) - t pow 2 = &8 * D`; + `(t + &1) pow 2 = &8 * q + &1`] THEN + REWRITE_TAC[tqeval] THEN CONV_TAC INT_RING]; + MP_TAC(SPEC `t:int` INT_ODD_SQUARE_8_WITNESS) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[INT_2_DIVIDES_ADD] THEN + REWRITE_TAC[INT_DIVIDES_ONE] THEN CONV_TAC INT_REDUCE_CONV THEN + REWRITE_TAC[int_divides] THEN EXISTS_TAC `s:int` THEN + CONV_TAC INT_RING; + DISCH_THEN(X_CHOOSE_THEN `q:int` ASSUME_TAC)] THEN + MATCH_MP_TAC(SPECL + [`a11:int`; `t:int`; `&1:int`; `&8 * D * n - &7:int`; + `&0:int`; `n:int`; `&1:int`; `&0:int`; `&0:int`; + `q + D - (D * n - &1) * a11:int`] + TERNARY_TYPE1_OF_CHARACTERISTIC) THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[int_divides] THEN EXISTS_TAC `&0:int` THEN + CONV_TAC INT_RING; + REWRITE_TAC[int_divides] THEN + EXISTS_TAC `(&4 * D * n - s - &4):int` THEN + ASM_REWRITE_TAC[] THEN CONV_TAC INT_RING; + REWRITE_TAC[int_divides] THEN EXISTS_TAC `r:int` THEN + ASM_REWRITE_TAC[] THEN CONV_TAC INT_RING; + MAP_EVERY UNDISCH_TAC + [`a11 * (&8 * D * n - &7) - t pow 2 = &8 * D`; + `t pow 2 = &8 * q + &1`] THEN + REWRITE_TAC[tqeval] THEN CONV_TAC INT_RING]]);; + +(* ------------------------------------------------------------------------- *) +(* Determinant-7 analogue of the matrix construction in LEMMA_1_7. *) +(* *) +(* The matrix *) +(* *) +(* [ a11 t 1 ] *) +(* [ t 8Dn-7 0 ] *) +(* [ 1 0 n ] *) +(* *) +(* has determinant 7 when a11(8Dn-7)-t^2=8D, and represents n on its last *) +(* coordinate. The preceding theorem places it in the required 2-adic genus. *) +(* ------------------------------------------------------------------------- *) + +let DISC7_DIRICHLET_GENUS_REPRESENTS = prove + (`!n D t:int. + &1 < n /\ &0 < D /\ + (&8 * D * n - &7) divides (t pow 2 + &8 * D) + ==> (?x y z:int. x pow 2 + y pow 2 + &7 * z pow 2 = n) \/ + (?x y z:int. + x pow 2 + &2 * y pow 2 + &2 * y * z + &4 * z pow 2 = n)`, + REPEAT STRIP_TAC THEN + UNDISCH_TAC `(&8 * D * n - &7) divides (t pow 2 + &8 * D)` THEN + REWRITE_TAC[int_divides] THEN + DISCH_THEN(X_CHOOSE_THEN `a11:int` (LABEL_TAC "quotient")) THEN + SUBGOAL_THEN `&0 < &8 * D * n - &7` ASSUME_TAC THENL + [SUBGOAL_THEN `&1 * &2 <= D * n` MP_TAC THENL + [MATCH_MP_TAC INT_LE_MUL2 THEN ASM_INT_ARITH_TAC; + INT_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN + `a11 * (&8 * D * n - &7) - t pow 2 = &8 * D` + ASSUME_TAC THENL + [USE_THEN "quotient" MP_TAC THEN CONV_TAC INT_RING; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < a11` ASSUME_TAC THENL + [SUBGOAL_THEN `&0 < a11 * (&8 * D * n - &7)` MP_TAC THENL + [SUBGOAL_THEN + `a11 * (&8 * D * n - &7) = t pow 2 + &8 * D` + SUBST1_TAC THENL + [ASM_INT_ARITH_TAC; + MP_TAC(SPEC `t:int` INT_LE_POW_2) THEN ASM_INT_ARITH_TAC]; + ASM_SIMP_TAC[INT_LT_MUL_EQ]]; + ALL_TAC] THEN + MATCH_MP_TAC(SPECL + [`a11:int`; `t:int`; `&1:int`; `&8 * D * n - &7:int`; + `&0:int`; `n:int`; `n:int`] TERNARY_DISC7_TYPE1) THEN + REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + ASM_INT_ARITH_TAC; + UNDISCH_TAC + `a11 * (&8 * D * n - &7) - t pow 2 = &8 * D` THEN + CONV_TAC INT_RING; + MATCH_MP_TAC DISC7_DIRICHLET_TYPE1 THEN ASM_REWRITE_TAC[]; + MAP_EVERY EXISTS_TAC [`&0:int`; `&0:int`; `&1:int`] THEN + CONV_TAC INT_RING]);; + +(* ------------------------------------------------------------------------- *) +(* The Dirichlet progression p = 8n - 7 (mod 112n). *) +(* ------------------------------------------------------------------------- *) + +let CONG_DISC7_OFFSET_7 = prove + (`!n:num. 1 <= n ==> (8*n-7 == n) (mod 7)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `8*n-7 = (n-1)*7+n` SUBST1_TAC THENL + [ASM_ARITH_TAC; + REWRITE_TAC[CONG] THEN SIMP_TAC[MOD_MULT_ADD]]);; + +let COPRIME_DISC7_OFFSET_N = prove + (`!n:num. + 1 <= n /\ ~(7 divides n) + ==> coprime(8*n-7,n)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[COPRIME] THEN X_GEN_TAC `d:num` THEN EQ_TAC THENL + [STRIP_TAC THEN + SUBGOAL_THEN `d divides 8*n` ASSUME_TAC THENL + [MATCH_MP_TAC(SPECL [`d:num`; `n:num`; `8`] DIVIDES_LMUL) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `d divides 7` ASSUME_TAC THENL + [SUBGOAL_THEN `7 = 8*n - (8*n-7)` SUBST1_TAC THENL + [ASM_ARITH_TAC; + MATCH_MP_TAC(SPECL [`d:num`; `8*n`; `8*n-7`] DIVIDES_SUB) THEN + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN `coprime(7,n)` ASSUME_TAC THENL + [ASM_REWRITE_TAC[MATCH_MP (SPEC `7` PRIME_COPRIME_EQ) + (EQT_ELIM(PRIME_CONV `prime 7`))]; + MP_TAC(SPEC `d:num` + (REWRITE_RULE[COPRIME] (ASSUME `coprime(7,n)`))) THEN + ASM_REWRITE_TAC[]]; + DISCH_TAC THEN ASM_REWRITE_TAC[DIVIDES_1]]);; + +let COPRIME_DISC7_OFFSET_112 = prove + (`!n:num. + 1 <= n /\ ~(7 divides n) + ==> coprime(8*n-7,112)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `ODD(8*n-7)` ASSUME_TAC THENL + [REWRITE_TAC[ODD_EXISTS] THEN EXISTS_TAC `4*n-4` THEN ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `~(7 divides (8*n-7))` ASSUME_TAC THENL + [MP_TAC(MATCH_MP (SPECL [`8*n-7`; `n:num`; `7`] CONG_DIVIDES) + (MATCH_MP (SPEC `n:num` CONG_DISC7_OFFSET_7) + (ASSUME `1 <= n`))) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[ARITH_RULE `112 = 2*2*2*2*7`; COPRIME_RMUL] THEN + ASM_REWRITE_TAC[CONJUNCT2 COPRIME_2] THEN + ONCE_REWRITE_TAC[COPRIME_SYM] THEN + ASM_REWRITE_TAC[MATCH_MP (SPEC `7` PRIME_COPRIME_EQ) + (EQT_ELIM(PRIME_CONV `prime 7`))]);; + +let COPRIME_DIRICHLET_DISC7 = prove + (`!n:num. + 1 <= n /\ ~(7 divides n) + ==> coprime(8*n-7,112*n)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[COPRIME_RMUL] THEN CONJ_TAC THENL + [MATCH_MP_TAC COPRIME_DISC7_OFFSET_112 THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC COPRIME_DISC7_OFFSET_N THEN ASM_REWRITE_TAC[]]);; + +let DIRICHLET_PRIME_DISC7 = prove + (`!n:num. + 1 <= n /\ ~(7 divides n) + ==> ?p. prime p /\ (p == 8*n-7) (mod (112*n))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC DIRICHLET_PRIME_CONG THEN + ASM_SIMP_TAC[COPRIME_DIRICHLET_DISC7] THEN ASM_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* The reciprocity calculation for D = 14j+1. *) +(* ------------------------------------------------------------------------- *) + +let COPRIME_7_14J1 = prove + (`!j:num. coprime(7,14*j+1)`, + GEN_TAC THEN REWRITE_TAC[COPRIME_BEZOUT] THEN + MAP_EVERY EXISTS_TAC [`1`; `2*j`] THEN DISJ2_TAC THEN ARITH_TAC);; + +let CONG_14J1_7 = NUMBER_RULE + `!j:num. (14*j+1 == 1) (mod 7)`;; + +let CONG_NEG7_14J1 = prove + (`!n j:num. + 1 <= n + ==> (8*n*(14*j+1)-7 == 7*(14*j+1)-7) (mod (14*j+1))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONG_SUB THEN + REPEAT CONJ_TAC THENL + [CONV_TAC NUMBER_RULE; + REWRITE_TAC[CONG_REFL]; + ASM_ARITH_TAC; + ARITH_TAC]);; + +let JACOBI_7_14J1 = prove + (`!j:num. + jacobi(7,14*j+1) = --(&1) pow (((14*j+1)-1) DIV 2)`, + GEN_TAC THEN + SUBGOAL_THEN `ODD(14*j+1)` ASSUME_TAC THENL + [REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH]; + ALL_TAC] THEN + SUBGOAL_THEN `coprime(7,14*j+1)` ASSUME_TAC THENL + [REWRITE_TAC[COPRIME_7_14J1]; + ALL_TAC] THEN + SUBGOAL_THEN `jacobi(14*j+1,7) = &1` ASSUME_TAC THENL + [TRANS_TAC EQ_TRANS `jacobi(1,7)` THEN CONJ_TAC THENL + [MATCH_MP_TAC JACOBI_CONG THEN REWRITE_TAC[CONG_14J1_7]; + REWRITE_TAC[JACOBI_1]]; + ALL_TAC] THEN + MP_TAC(SPECL [`7`; `14*j+1`] JACOBI_RECIPROCITY) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC + [ARITH_RULE `3*k = k + 2*k`; INT_POW_ADD; + INT_POW_NEG; EVEN_MULT; INT_POW_ONE; ARITH; INT_MUL_RID] THEN + DISCH_TAC THEN + MATCH_MP_TAC(INT_RING `s * s = &1 /\ &1 = s * x ==> x = s`) THEN + CONJ_TAC THENL + [COND_CASES_TAC THEN CONV_TAC INT_REDUCE_CONV; + ASM_MESON_TAC[]]);; + +let JACOBI_NEG7_14J1 = prove + (`!n j:num. + 1 <= n ==> jacobi(8*n*(14*j+1)-7,14*j+1) = &1`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `ODD(14*j+1)` ASSUME_TAC THENL + [REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH]; + ALL_TAC] THEN + TRANS_TAC EQ_TRANS `jacobi(7*(14*j+1)-7,14*j+1)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC JACOBI_CONG THEN + MATCH_MP_TAC CONG_NEG7_14J1 THEN ASM_REWRITE_TAC[]; + REWRITE_TAC + [ARITH_RULE `7*h-7 = 7*(h-1)`; JACOBI_LMUL; + JACOBI_7_14J1] THEN + ASM_SIMP_TAC[JACOBI_MINUS1] THEN + REWRITE_TAC + [GSYM INT_POW_ADD; ARITH_RULE `k+k = 2*k`; + INT_POW_NEG; EVEN_MULT; INT_POW_ONE; ARITH]]);; + +let CONG_P_1MOD8_DISC7 = prove + (`!n j p:num. + 1 <= n /\ p = 8*n*(14*j+1)-7 + ==> (p == 1) (mod 8)`, + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[CONG] THEN + SUBGOAL_THEN + `8*n*(14*j+1)-7 = (n*(14*j+1)-1)*8+1` + SUBST1_TAC THENL + [ASM_ARITH_TAC; + SIMP_TAC[MOD_MULT_ADD] THEN CONV_TAC NUM_REDUCE_CONV]);; + +let JACOBI_ONE_IMP_COPRIME = prove + (`!a n:num. jacobi(a,n) = &1 ==> coprime(a,n)`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`a:num`; `n:num`] JACOBI_EQ_0) THEN + ASM_CASES_TAC `coprime(a,n)` THEN ASM_REWRITE_TAC[] THEN + CONV_TAC INT_REDUCE_CONV);; + +let QR_DISC7 = prove + (`!n j p:num. + 1 <= n /\ prime p /\ p = 8*n*(14*j+1)-7 + ==> ?t. (t EXP 2 + 8*(14*j+1) == 0) (mod p)`, + REPEAT STRIP_TAC THEN + ABBREV_TAC `D:num = 14*j+1` THEN + SUBGOAL_THEN `ODD D` ASSUME_TAC THENL + [EXPAND_TAC "D" THEN REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH]; + ALL_TAC] THEN + SUBGOAL_THEN `(p == 1) (mod 8)` ASSUME_TAC THENL + [MATCH_MP_TAC(SPECL [`n:num`; `j:num`; `p:num`] + CONG_P_1MOD8_DISC7) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `(p == 1) (mod 4)` ASSUME_TAC THENL + [MATCH_MP_TAC CONG_MOD_8_IMP_MOD_4 THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `ODD p` ASSUME_TAC THENL + [MATCH_MP_TAC ODD_OF_1MOD4 THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `jacobi(p,D) = &1` ASSUME_TAC THENL + [EXPAND_TAC "D" THEN ONCE_REWRITE_TAC[ASSUME + `p = 8*n*(14*j+1)-7`] THEN + MATCH_MP_TAC(SPECL [`n:num`; `j:num`] JACOBI_NEG7_14J1) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + ASSUME_TAC(MATCH_MP + (SPECL [`p:num`; `D:num`] JACOBI_ONE_IMP_COPRIME) + (ASSUME `jacobi(p,D) = &1`)) THEN + SUBGOAL_THEN `jacobi(D,p) = &1` ASSUME_TAC THENL + [TRANS_TAC EQ_TRANS `jacobi(p,D)` THEN CONJ_TAC THENL + [MATCH_MP_TAC JACOBI_FLIP_1MOD4 THEN ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN `jacobi(8,p) = &1` ASSUME_TAC THENL + [REWRITE_TAC[ARITH_RULE `8 = 2 EXP 3`; JACOBI_LEXP] THEN + ASM_SIMP_TAC[JACOBI_2_1MOD8] THEN CONV_TAC INT_REDUCE_CONV; + ALL_TAC] THEN + MATCH_MP_TAC(SPECL [`p:num`; `8*D`] JACOBI_NEGATIVE_SQUARE) THEN + CONJ_TAC THENL + [MATCH_ACCEPT_TAC(ASSUME `prime p`); + REWRITE_TAC[JACOBI_LMUL] THEN + ONCE_REWRITE_TAC[ASSUME `jacobi(8,p) = &1`] THEN + ONCE_REWRITE_TAC[ASSUME `jacobi(D,p) = &1`] THEN + MP_TAC(MATCH_MP (SPEC `p:num` JACOBI_M1_1MOD4) + (ASSUME `(p == 1) (mod 4)`)) THEN + DISCH_THEN SUBST1_TAC THEN CONV_TAC INT_REDUCE_CONV]);; + +let RESIDUE_DISC7 = prove + (`!n:num. + 1 <= n /\ ~(7 divides n) + ==> ?j t. + (8*(14*j+1)*n-7) divides + (t EXP 2 + 8*(14*j+1))`, + REPEAT STRIP_TAC THEN + MP_TAC(SPEC `n:num` DIRICHLET_PRIME_DISC7) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `p:num` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `?j. p = 112*n*j + (8*n-7)` + (X_CHOOSE_TAC `j:num`) THENL + [MP_TAC(SPECL [`112*n`; `8*n-7`; `p:num`] CONG_CASE) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `p = 8*n*(14*j+1)-7` ASSUME_TAC THENL + [UNDISCH_TAC `p = 112*n*j + (8*n-7)` THEN ASM_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(MATCH_MP + (SPECL [`n:num`; `j:num`; `p:num`] QR_DISC7) + (CONJ (ASSUME `1 <= n`) + (CONJ (ASSUME `prime p`) + (ASSUME `p = 8*n*(14*j+1)-7`)))) THEN + DISCH_THEN(X_CHOOSE_TAC `t:num`) THEN + MAP_EVERY EXISTS_TAC [`j:num`; `t:num`] THEN + SUBGOAL_THEN `p = 8*(14*j+1)*n-7` + (fun th -> REWRITE_TAC[GSYM th]) THENL + [UNDISCH_TAC `p = 8*n*(14*j+1)-7` THEN ARITH_TAC; + MP_TAC(ASSUME + `(t EXP 2 + 8*(14*j+1) == 0) (mod p)`) THEN + REWRITE_TAC[CONG_0_DIVIDES]]);; + +(* ------------------------------------------------------------------------- *) +(* Transfer the natural-number residue to the integer ternary construction. *) +(* ------------------------------------------------------------------------- *) + +let DISC7_GENUS_COPRIME7 = prove + (`!n:num. + 1 < n /\ ~(7 divides n) + ==> (?x y z:int. x pow 2 + y pow 2 + &7 * z pow 2 = &n) \/ + (?x y z:int. + x pow 2 + &2 * y pow 2 + &2 * y * z + &4 * z pow 2 = &n)`, + REPEAT STRIP_TAC THEN + MP_TAC(SPEC `n:num` RESIDUE_DISC7) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `j:num` (X_CHOOSE_TAC `t:num`)) THEN + FIRST_X_ASSUM(X_CHOOSE_TAC `h:num` o REWRITE_RULE[divides]) THEN + MATCH_MP_TAC DISC7_DIRICHLET_GENUS_REPRESENTS THEN + MAP_EVERY EXISTS_TAC [`&(14*j+1):int`; `&t:int`] THEN + REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[INT_OF_NUM_LT]; + REWRITE_TAC[INT_OF_NUM_LT] THEN ARITH_TAC; + REWRITE_TAC[int_divides] THEN EXISTS_TAC `&h:int` THEN + FIRST_X_ASSUM(MP_TAC o AP_TERM `int_of_num`) THEN + SUBGOAL_THEN `7 <= 8*(14*j+1)*n` ASSUME_TAC THENL + [ASM_ARITH_TAC; + ASM_SIMP_TAC + [INT_OF_NUM_SUB; INT_OF_NUM_ADD; INT_OF_NUM_MUL; + INT_OF_NUM_POW] THEN + CONV_TAC INT_RING]]);; + +(* ------------------------------------------------------------------------- *) +(* A second determinant-seven matrix. For an odd m, the matrix *) +(* *) +(* [ a t 7 ] *) +(* [ t p 0 ] *) +(* [ 7 0 7m ] *) +(* *) +(* has oddity 1 when p = 1 (mod 8) and ap-t^2 is divisible by 8. *) +(* ------------------------------------------------------------------------- *) + +let DISC7_ODD_TYPE1 = prove + (`!a t p E m u r:int. + a * p - t pow 2 = &8 * E /\ + p = &8 * r + &1 /\ + m = &2 * u + &1 + ==> ternary_type1 a t (&7) p (&0) (&7 * m)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(SPEC `t:int` INT_PARITY_WITNESS) THEN + DISCH_THEN(DISJ_CASES_THEN + (X_CHOOSE_THEN `s:int` ASSUME_TAC)) THENL + [MP_TAC(SPEC `t + &1:int` INT_ODD_SQUARE_8_WITNESS) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[INT_2_DIVIDES_ADD] THEN + REWRITE_TAC[INT_DIVIDES_ONE] THEN CONV_TAC INT_REDUCE_CONV THEN + REWRITE_TAC[int_divides] THEN EXISTS_TAC `s:int` THEN + CONV_TAC INT_RING; + DISCH_THEN(X_CHOOSE_THEN `h:int` ASSUME_TAC)] THEN + MATCH_MP_TAC(SPECL + [`a:int`; `t:int`; `&7:int`; `p:int`; `&0:int`; `&7 * m:int`; + `&1:int`; `&1:int`; `&0:int`; + `h + E - a * r + r:int`] + TERNARY_TYPE1_OF_CHARACTERISTIC) THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[int_divides] THEN EXISTS_TAC `--s:int` THEN + ASM_REWRITE_TAC[] THEN CONV_TAC INT_RING; + REWRITE_TAC[int_divides] THEN EXISTS_TAC `--s:int` THEN + ASM_REWRITE_TAC[] THEN CONV_TAC INT_RING; + REWRITE_TAC[int_divides] THEN EXISTS_TAC `&7 * u:int` THEN + ASM_REWRITE_TAC[] THEN CONV_TAC INT_RING; + MAP_EVERY UNDISCH_TAC + [`a * p - t pow 2 = &8 * E`; + `p = &8 * r + &1`; + `(t + &1) pow 2 = &8 * h + &1`] THEN + REWRITE_TAC[tqeval] THEN CONV_TAC INT_RING]; + MP_TAC(SPEC `t:int` INT_ODD_SQUARE_8_WITNESS) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[INT_2_DIVIDES_ADD] THEN + REWRITE_TAC[INT_DIVIDES_ONE] THEN CONV_TAC INT_REDUCE_CONV THEN + REWRITE_TAC[int_divides] THEN EXISTS_TAC `s:int` THEN + CONV_TAC INT_RING; + DISCH_THEN(X_CHOOSE_THEN `h:int` ASSUME_TAC)] THEN + MATCH_MP_TAC(SPECL + [`a:int`; `t:int`; `&7:int`; `p:int`; `&0:int`; `&7 * m:int`; + `&1:int`; `&0:int`; `&0:int`; + `E - a * r + h:int`] + TERNARY_TYPE1_OF_CHARACTERISTIC) THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[int_divides] THEN EXISTS_TAC `&0:int` THEN + CONV_TAC INT_RING; + REWRITE_TAC[int_divides] THEN EXISTS_TAC `&4 * r - s:int` THEN + ASM_REWRITE_TAC[] THEN CONV_TAC INT_RING; + REWRITE_TAC[int_divides] THEN EXISTS_TAC `&7 * u:int` THEN + ASM_REWRITE_TAC[] THEN CONV_TAC INT_RING; + MAP_EVERY UNDISCH_TAC + [`a * p - t pow 2 = &8 * E`; + `p = &8 * r + &1`; + `t pow 2 = &8 * h + &1`] THEN + REWRITE_TAC[tqeval] THEN CONV_TAC INT_RING]]);; + +let DISC7_EVEN_TYPE1 = prove + (`!a t p E m u r:int. + a * p - t pow 2 = &8 * E /\ + p = &8 * r + &1 /\ + m = &2 * u + ==> ternary_type1 a t (&7) p (&0) (&7 * m)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `&2 divides (a - t)` ASSUME_TAC THENL + [MP_TAC(SPEC `t:int` INT_SQ_SUB_SELF_EVEN) THEN + REWRITE_TAC[int_divides] THEN + DISCH_THEN(X_CHOOSE_THEN `s:int` ASSUME_TAC) THEN + REWRITE_TAC[int_divides] THEN + EXISTS_TAC `&4 * E - &4 * a * r + s:int` THEN + MAP_EVERY UNDISCH_TAC + [`a * p - t pow 2 = &8 * E`; + `p = &8 * r + &1`; + `t pow 2 - t = &2 * s`] THEN + CONV_TAC INT_RING; + ALL_TAC] THEN + MATCH_MP_TAC(SPECL + [`a:int`; `t:int`; `&7:int`; `p:int`; `&0:int`; `&7 * m:int`; + `&0:int`; `&1:int`; `&0:int`; `r:int`] + TERNARY_TYPE1_OF_CHARACTERISTIC) THEN + REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[INT_MUL_RZERO; INT_MUL_RID; INT_ADD_LID; + INT_ADD_RID]; + REWRITE_TAC[int_divides] THEN EXISTS_TAC `&0:int` THEN + CONV_TAC INT_RING; + REWRITE_TAC[int_divides] THEN EXISTS_TAC `&7 * u:int` THEN + ASM_REWRITE_TAC[] THEN CONV_TAC INT_RING; + ASM_REWRITE_TAC[tqeval] THEN CONV_TAC INT_RING]);; + +let DISC7_MATRIX_GENUS_REPRESENTS = prove + (`!m E p t r:int. + &0 < m /\ &0 < E /\ &0 < p /\ + p = &8 * r + &1 /\ + &8 * m * E - &7 * p = &1 /\ + p divides (t pow 2 + &8 * E) + ==> (?x y z:int. + x pow 2 + y pow 2 + &7 * z pow 2 = &7 * m) \/ + (?x y z:int. + x pow 2 + &2 * y pow 2 + &2 * y * z + &4 * z pow 2 = + &7 * m)`, + REPEAT STRIP_TAC THEN + UNDISCH_TAC `p divides (t pow 2 + &8 * E)` THEN + REWRITE_TAC[int_divides] THEN + DISCH_THEN(X_CHOOSE_THEN `a:int` (LABEL_TAC "quotient")) THEN + SUBGOAL_THEN `a * p - t pow 2 = &8 * E` ASSUME_TAC THENL + [USE_THEN "quotient" MP_TAC THEN CONV_TAC INT_RING; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < a` ASSUME_TAC THENL + [SUBGOAL_THEN `&0 < a * p` MP_TAC THENL + [SUBGOAL_THEN `a * p = t pow 2 + &8 * E` SUBST1_TAC THENL + [ASM_INT_ARITH_TAC; + MP_TAC(SPEC `t:int` INT_LE_POW_2) THEN ASM_INT_ARITH_TAC]; + ASM_SIMP_TAC[INT_LT_MUL_EQ]]; + ALL_TAC] THEN + SUBGOAL_THEN `ternary_type1 a t (&7) p (&0) (&7 * m)` + ASSUME_TAC THENL + [MP_TAC(SPEC `m:int` INT_PARITY_WITNESS) THEN + DISCH_THEN(DISJ_CASES_THEN + (X_CHOOSE_THEN `u:int` ASSUME_TAC)) THENL + [MATCH_MP_TAC DISC7_EVEN_TYPE1 THEN + MAP_EVERY EXISTS_TAC [`E:int`; `u:int`; `r:int`] THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC DISC7_ODD_TYPE1 THEN + MAP_EVERY EXISTS_TAC [`E:int`; `u:int`; `r:int`] THEN + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + MATCH_MP_TAC(SPECL + [`a:int`; `t:int`; `&7:int`; `p:int`; `&0:int`; `&7 * m:int`; + `&7 * m:int`] TERNARY_DISC7_TYPE1) THEN + REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + SUBGOAL_THEN `&0 < a * p` MP_TAC THENL + [MATCH_MP_TAC INT_LT_MUL THEN ASM_REWRITE_TAC[]; + ASM_INT_ARITH_TAC]; + MAP_EVERY UNDISCH_TAC + [`a * p - t pow 2 = &8 * E`; + `&8 * m * E - &7 * p = &1`] THEN + CONV_TAC INT_RING; + ASM_REWRITE_TAC[]; + MAP_EVERY EXISTS_TAC [`&0:int`; `&0:int`; `&1:int`] THEN + CONV_TAC INT_RING]);; + +(* ------------------------------------------------------------------------- *) +(* Dirichlet offsets for the three nonzero square classes modulo 7. *) +(* ------------------------------------------------------------------------- *) + +let CONG_1_MOD_7_CASE_DISC7 = prove + (`!m:num. (m == 1) (mod 7) ==> ?q. m = 7*q+1`, + MESON_TAC[CONG_CASE; MULT_SYM; ARITH_RULE `1 < 7`]);; + +let CONG_2_MOD_7_CASE_DISC7 = prove + (`!m:num. (m == 2) (mod 7) ==> ?q. m = 7*q+2`, + MESON_TAC[CONG_CASE; MULT_SYM; ARITH_RULE `2 < 7`]);; + +let CONG_4_MOD_7_CASE_DISC7 = prove + (`!m:num. (m == 4) (mod 7) ==> ?q. m = 7*q+4`, + MESON_TAC[CONG_CASE; MULT_SYM; ARITH_RULE `4 < 7`]);; + +let DISC7_SQUARECLASS_OFFSET = prove + (`!m:num. + 1 <= m /\ + ((m == 1) (mod 7) \/ (m == 2) (mod 7) \/ (m == 4) (mod 7)) + ==> ?e a. + 1 <= e /\ a < 8*m /\ (a == 1) (mod 8) /\ + 7*a+1 = 8*m*e /\ coprime(a,8*m)`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THENL + [FIRST_X_ASSUM(X_CHOOSE_THEN `q:num` SUBST_ALL_TAC o + MATCH_MP CONG_1_MOD_7_CASE_DISC7) THEN + MAP_EVERY EXISTS_TAC [`1`; `8*q+1`] THEN + REPEAT CONJ_TAC THENL + [ARITH_TAC; + ARITH_TAC; + REWRITE_TAC[CONG; ARITH_RULE `8*q+1 = q*8+1`] THEN + SIMP_TAC[MOD_MULT_ADD] THEN CONV_TAC NUM_REDUCE_CONV; + ARITH_TAC; + REWRITE_TAC[COPRIME_BEZOUT] THEN + MAP_EVERY EXISTS_TAC [`1`; `7`] THEN DISJ2_TAC THEN ARITH_TAC]; + FIRST_X_ASSUM(X_CHOOSE_THEN `q:num` SUBST_ALL_TAC o + MATCH_MP CONG_2_MOD_7_CASE_DISC7) THEN + MAP_EVERY EXISTS_TAC [`4`; `32*q+9`] THEN + REPEAT CONJ_TAC THENL + [ARITH_TAC; + ARITH_TAC; + REWRITE_TAC + [CONG; ARITH_RULE `32*q+9 = (4*q+1)*8+1`] THEN + SIMP_TAC[MOD_MULT_ADD] THEN CONV_TAC NUM_REDUCE_CONV; + ARITH_TAC; + REWRITE_TAC[COPRIME_BEZOUT] THEN + MAP_EVERY EXISTS_TAC [`4`; `7`] THEN DISJ2_TAC THEN ARITH_TAC]; + FIRST_X_ASSUM(X_CHOOSE_THEN `q:num` SUBST_ALL_TAC o + MATCH_MP CONG_4_MOD_7_CASE_DISC7) THEN + MAP_EVERY EXISTS_TAC [`2`; `16*q+9`] THEN + REPEAT CONJ_TAC THENL + [ARITH_TAC; + ARITH_TAC; + REWRITE_TAC + [CONG; ARITH_RULE `16*q+9 = (2*q+1)*8+1`] THEN + SIMP_TAC[MOD_MULT_ADD] THEN CONV_TAC NUM_REDUCE_CONV; + ARITH_TAC; + REWRITE_TAC[COPRIME_BEZOUT] THEN + MAP_EVERY EXISTS_TAC [`2`; `7`] THEN DISJ2_TAC THEN ARITH_TAC]]);; + +let DIRICHLET_PRIME_DISC7_MULTIPLE = prove + (`!m:num. + 1 <= m /\ + ((m == 1) (mod 7) \/ (m == 2) (mod 7) \/ (m == 4) (mod 7)) + ==> ?e j p. + 1 <= e /\ prime p /\ + p = 8*m*j + ((8*m*e-1) DIV 7) /\ + (p == 1) (mod 8) /\ + 7*p+1 = 8*m*(7*j+e)`, + GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "class")) THEN + MP_TAC(SPEC `m:num` DISC7_SQUARECLASS_OFFSET) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + USE_THEN "class" ACCEPT_TAC]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `e:num` + (X_CHOOSE_THEN `a:num` STRIP_ASSUME_TAC)) THEN + MP_TAC(SPECL [`8*m`; `a:num`] DIRICHLET_PRIME_CONG) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `p:num` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `?j. p = 8*m*j+a` (X_CHOOSE_TAC `j:num`) THENL + [MP_TAC(SPECL [`8*m`; `a:num`; `p:num`] CONG_CASE) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `a = (8*m*e-1) DIV 7` ASSUME_TAC THENL + [SUBGOAL_THEN `8*m*e-1 = 7*a` ASSUME_TAC THENL + [ASM_ARITH_TAC; + ASM_REWRITE_TAC[] THEN SIMP_TAC[DIV_MULT; ARITH]]; + ALL_TAC] THEN + SUBGOAL_THEN `(p == 1) (mod 8)` ASSUME_TAC THENL + [FIRST_X_ASSUM(X_CHOOSE_TAC `s:num` o MATCH_MP CONG_1_MOD_8 o + check (fun th -> concl th = `(a == 1) (mod 8)`)) THEN + SUBGOAL_THEN `p = (m*j+s)*8+1` SUBST1_TAC THENL + [ASM_ARITH_TAC; + REWRITE_TAC[CONG] THEN SIMP_TAC[MOD_MULT_ADD] THEN + CONV_TAC NUM_REDUCE_CONV]; + ALL_TAC] THEN + MAP_EVERY EXISTS_TAC [`e:num`; `j:num`; `p:num`] THEN + ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* The nonzero square classes modulo 7 have Jacobi symbol 1. *) +(* ------------------------------------------------------------------------- *) + +let JACOBI_2_7 = prove + (`jacobi(2,7) = &1`, + REWRITE_TAC[JACOBI_OF_2] THEN CONV_TAC NUM_REDUCE_CONV THEN + CONV_TAC INT_REDUCE_CONV);; + +let JACOBI_4_7 = prove + (`jacobi(4,7) = &1`, + REWRITE_TAC[ARITH_RULE `4 = 2 EXP 2`; CONJUNCT1 JACOBI_SQUARED] THEN + SUBGOAL_THEN `coprime(2,7)` ASSUME_TAC THENL + [REWRITE_TAC[COPRIME_BEZOUT] THEN + MAP_EVERY EXISTS_TAC [`4`; `1`] THEN DISJ1_TAC THEN ARITH_TAC; + ASM_REWRITE_TAC[]]);; + +let JACOBI_DISC7_SQUARECLASS = prove + (`!m:num. + (m == 1) (mod 7) \/ (m == 2) (mod 7) \/ (m == 4) (mod 7) + ==> jacobi(m,7) = &1`, + GEN_TAC THEN DISCH_THEN(LABEL_TAC "class") THEN + REMOVE_THEN "class" (REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THENL + [MP_TAC(SPECL [`m:num`; `1`; `7`] JACOBI_CONG) THEN + ASM_REWRITE_TAC[JACOBI_1]; + MP_TAC(SPECL [`m:num`; `2`; `7`] JACOBI_CONG) THEN + ASM_REWRITE_TAC[JACOBI_2_7]; + MP_TAC(SPECL [`m:num`; `4`; `7`] JACOBI_CONG) THEN + ASM_REWRITE_TAC[JACOBI_4_7]]);; + +let CONG_HALF_1_MOD7 = prove + (`!u:num. (2*u == 1) (mod 7) ==> (u == 4) (mod 7)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONG_TRANS THEN + EXISTS_TAC `8*u` THEN CONJ_TAC THENL + [MATCH_ACCEPT_TAC(NUMBER_RULE `!u:num. (u == 8*u) (mod 7)`); + MP_TAC(MATCH_MP (SPECL [`4`; `2*u`; `1`; `7`] CONG_LMUL) + (ASSUME `(2*u == 1) (mod 7)`)) THEN + REWRITE_TAC[ARITH_RULE `4 * (2*u) = 8*u`; MULT_CLAUSES]]);; + +let CONG_HALF_2_MOD7 = prove + (`!u:num. (2*u == 2) (mod 7) ==> (u == 1) (mod 7)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONG_TRANS THEN + EXISTS_TAC `8*u` THEN CONJ_TAC THENL + [MATCH_ACCEPT_TAC(NUMBER_RULE `!u:num. (u == 8*u) (mod 7)`); + MATCH_MP_TAC CONG_TRANS THEN EXISTS_TAC `8` THEN CONJ_TAC THENL + [MP_TAC(MATCH_MP (SPECL [`4`; `2*u`; `2`; `7`] CONG_LMUL) + (ASSUME `(2*u == 2) (mod 7)`)) THEN + REWRITE_TAC[ARITH_RULE `4 * (2*u) = 8*u`] THEN + CONV_TAC NUM_REDUCE_CONV THEN MESON_TAC[]; + CONV_TAC NUMBER_RULE]]);; + +let CONG_HALF_4_MOD7 = prove + (`!u:num. (2*u == 4) (mod 7) ==> (u == 2) (mod 7)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONG_TRANS THEN + EXISTS_TAC `8*u` THEN CONJ_TAC THENL + [MATCH_ACCEPT_TAC(NUMBER_RULE `!u:num. (u == 8*u) (mod 7)`); + MATCH_MP_TAC CONG_TRANS THEN EXISTS_TAC `16` THEN CONJ_TAC THENL + [MP_TAC(MATCH_MP (SPECL [`4`; `2*u`; `4`; `7`] CONG_LMUL) + (ASSUME `(2*u == 4) (mod 7)`)) THEN + REWRITE_TAC[ARITH_RULE `4 * (2*u) = 8*u`] THEN + CONV_TAC NUM_REDUCE_CONV THEN MESON_TAC[]; + CONV_TAC NUMBER_RULE]]);; + +let DISC7_ODDPART_SQUARECLASS = prove + (`!m u:num. + (m = u \/ m = 2*u) /\ + ((m == 1) (mod 7) \/ (m == 2) (mod 7) \/ (m == 4) (mod 7)) + ==> (u == 1) (mod 7) \/ (u == 2) (mod 7) \/ (u == 4) (mod 7)`, + MESON_TAC[CONG_HALF_1_MOD7; CONG_HALF_2_MOD7; CONG_HALF_4_MOD7]);; + +let JACOBI_7_ODD_SQUARECLASS = prove + (`!u:num. + ODD u /\ + ((u == 1) (mod 7) \/ (u == 2) (mod 7) \/ (u == 4) (mod 7)) + ==> jacobi(7,u) = --(&1) pow ((u-1) DIV 2)`, + GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "class")) THEN + SUBGOAL_THEN `jacobi(u,7) = &1` ASSUME_TAC THENL + [MATCH_MP_TAC JACOBI_DISC7_SQUARECLASS THEN + USE_THEN "class" ACCEPT_TAC; + ALL_TAC] THEN + ASSUME_TAC(MATCH_MP + (SPECL [`u:num`; `7`] JACOBI_ONE_IMP_COPRIME) + (ASSUME `jacobi(u,7) = &1`)) THEN + SUBGOAL_THEN `coprime(7,u)` ASSUME_TAC THENL + [ONCE_REWRITE_TAC[COPRIME_SYM] THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MP_TAC(SPECL [`7`; `u:num`] JACOBI_RECIPROCITY) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC + [ARITH_RULE `3*k = k + 2*k`; INT_POW_ADD; + INT_POW_NEG; EVEN_MULT; INT_POW_ONE; ARITH; INT_MUL_RID] THEN + DISCH_TAC THEN + MATCH_MP_TAC(INT_RING `s * s = &1 /\ &1 = s * x ==> x = s`) THEN + CONJ_TAC THENL + [COND_CASES_TAC THEN CONV_TAC INT_REDUCE_CONV; + ASM_MESON_TAC[]]);; + +let JACOBI_P_ODDPART_DISC7 = prove + (`!m u E p:num. + 1 <= u /\ ODD u /\ (m = u \/ m = 2*u) /\ + ((m == 1) (mod 7) \/ (m == 2) (mod 7) \/ (m == 4) (mod 7)) /\ + 7*p+1 = 8*m*E + ==> jacobi(p,u) = &1`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 (LABEL_TAC "part") + (CONJUNCTS_THEN2 (LABEL_TAC "class") ASSUME_TAC)))) THEN + SUBGOAL_THEN + `(u == 1) (mod 7) \/ (u == 2) (mod 7) \/ (u == 4) (mod 7)` + ASSUME_TAC THENL + [MATCH_MP_TAC(SPECL [`m:num`; `u:num`] DISC7_ODDPART_SQUARECLASS) THEN + CONJ_TAC THENL + [USE_THEN "part" ACCEPT_TAC; + USE_THEN "class" ACCEPT_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN `(7*p == u-1) (mod u)` ASSUME_TAC THENL + [REWRITE_TAC[CONG_MINUS1] THEN DISJ2_TAC THEN + ASM_REWRITE_TAC[] THEN + REMOVE_THEN "part" (DISJ_CASES_THEN SUBST1_TAC) THEN + REWRITE_TAC[divides] THENL + [EXISTS_TAC `8*E` THEN CONV_TAC NUM_RING; + EXISTS_TAC `16*E` THEN CONV_TAC NUM_RING]; + ALL_TAC] THEN + SUBGOAL_THEN + `jacobi(7*p,u) = jacobi(u-1,u)` + ASSUME_TAC THENL + [MATCH_MP_TAC JACOBI_CONG THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `jacobi(7,u) = -- &1 pow ((u-1) DIV 2)` + ASSUME_TAC THENL + [MATCH_MP_TAC JACOBI_7_ODD_SQUARECLASS THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MP_TAC(ASSUME `jacobi(7*p,u) = jacobi(u-1,u)`) THEN + REWRITE_TAC[JACOBI_LMUL] THEN + ONCE_REWRITE_TAC + [ASSUME `jacobi(7,u) = -- &1 pow ((u-1) DIV 2)`] THEN + ASM_SIMP_TAC[JACOBI_MINUS1] THEN DISCH_TAC THEN + MATCH_MP_TAC(SPECL + [`-- &1 pow ((u-1) DIV 2)`; `jacobi(p,u)`] + (INT_RING `!s x:int. s*s = &1 /\ s*x = s ==> x = &1`)) THEN + CONJ_TAC THENL + [REWRITE_TAC + [GSYM INT_POW_ADD; ARITH_RULE `k+k = 2*k`; + INT_POW_NEG; EVEN_MULT; INT_POW_ONE; ARITH]; + ASM_REWRITE_TAC[]]);; + +let QR_DISC7_MULTIPLE_CORE = prove + (`!m u E p:num. + 1 <= u /\ ODD u /\ (m = u \/ m = 2*u) /\ + ((m == 1) (mod 7) \/ (m == 2) (mod 7) \/ (m == 4) (mod 7)) /\ + prime p /\ (p == 1) (mod 8) /\ 7*p+1 = 8*m*E + ==> ?t. (t EXP 2 + 8*E == 0) (mod p)`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 (LABEL_TAC "part") + (CONJUNCTS_THEN2 (LABEL_TAC "class") + (CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC)))))) THEN + SUBGOAL_THEN `(p == 1) (mod 4)` ASSUME_TAC THENL + [MATCH_MP_TAC CONG_MOD_8_IMP_MOD_4 THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `ODD p` ASSUME_TAC THENL + [MATCH_MP_TAC ODD_OF_1MOD4 THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `jacobi(p,u) = &1` ASSUME_TAC THENL + [MATCH_MP_TAC(SPECL [`m:num`; `u:num`; `E:num`; `p:num`] + JACOBI_P_ODDPART_DISC7) THEN + REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + USE_THEN "part" ACCEPT_TAC; + USE_THEN "class" ACCEPT_TAC; + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + ASSUME_TAC(MATCH_MP + (SPECL [`p:num`; `u:num`] JACOBI_ONE_IMP_COPRIME) + (ASSUME `jacobi(p,u) = &1`)) THEN + SUBGOAL_THEN `jacobi(u,p) = &1` ASSUME_TAC THENL + [TRANS_TAC EQ_TRANS `jacobi(p,u)` THEN CONJ_TAC THENL + [MATCH_MP_TAC JACOBI_FLIP_1MOD4 THEN ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN `jacobi(m,p) = &1` ASSUME_TAC THENL + [USE_THEN "part" DISJ_CASES_TAC THENL + [ASM_REWRITE_TAC[]; + SUBST1_TAC(ASSUME `m = 2*u`) THEN + REWRITE_TAC[JACOBI_LMUL] THEN + ASM_SIMP_TAC[JACOBI_2_1MOD8] THEN CONV_TAC INT_REDUCE_CONV]; + ALL_TAC] THEN + SUBGOAL_THEN `(8*m*E == 1) (mod p)` ASSUME_TAC THENL + [REWRITE_TAC[CONG] THEN + ONCE_REWRITE_TAC[GSYM(ASSUME `7*p+1 = 8*m*E`)] THEN + SUBGOAL_THEN `7*p+1 = p*7+1` SUBST1_TAC THENL + [ARITH_TAC; + SIMP_TAC[MOD_MULT_ADD] THEN CONV_TAC NUM_REDUCE_CONV]; + ALL_TAC] THEN + SUBGOAL_THEN `jacobi(8*m*E,p) = &1` ASSUME_TAC THENL + [TRANS_TAC EQ_TRANS `jacobi(1,p)` THEN CONJ_TAC THENL + [MATCH_MP_TAC JACOBI_CONG THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[JACOBI_1]]; + ALL_TAC] THEN + SUBGOAL_THEN `jacobi(8*E,p) = &1` ASSUME_TAC THENL + [MP_TAC(ASSUME `jacobi(8*m*E,p) = &1`) THEN + REWRITE_TAC[ARITH_RULE `8*m*E = (8*E)*m`; JACOBI_LMUL] THEN + ASM_REWRITE_TAC[] THEN INT_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(SPECL [`p:num`; `8*E`] JACOBI_NEGATIVE_SQUARE) THEN + CONJ_TAC THENL + [MATCH_ACCEPT_TAC(ASSUME `prime p`); + ONCE_REWRITE_TAC[JACOBI_LMUL] THEN + ONCE_REWRITE_TAC[ASSUME `jacobi(8*E,p) = &1`] THEN + MP_TAC(MATCH_MP (SPEC `p:num` JACOBI_M1_1MOD4) + (ASSUME `(p == 1) (mod 4)`)) THEN + DISCH_THEN SUBST1_TAC THEN CONV_TAC INT_REDUCE_CONV]);; + +(* ------------------------------------------------------------------------- *) +(* Package the Dirichlet prime and transfer it to the determinant-7 matrix. *) +(* ------------------------------------------------------------------------- *) + +let RESIDUE_DISC7_MULTIPLE_CORE = prove + (`!m u:num. + 1 <= u /\ ODD u /\ (m = u \/ m = 2*u) /\ + ((m == 1) (mod 7) \/ (m == 2) (mod 7) \/ (m == 4) (mod 7)) + ==> ?E p t r. + 1 <= E /\ prime p /\ p = 8*r+1 /\ + 7*p+1 = 8*m*E /\ p divides (t EXP 2 + 8*E)`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 (LABEL_TAC "part") (LABEL_TAC "class")))) THEN + SUBGOAL_THEN `1 <= m` ASSUME_TAC THENL + [USE_THEN "part" DISJ_CASES_TAC THEN ASM_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(SPEC `m:num` DIRICHLET_PRIME_DISC7_MULTIPLE) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + USE_THEN "class" ACCEPT_TAC]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `e:num` + (X_CHOOSE_THEN `j:num` + (X_CHOOSE_THEN `p:num` STRIP_ASSUME_TAC))) THEN + MP_TAC(SPECL [`m:num`; `u:num`; `7*j+e`; `p:num`] + QR_DISC7_MULTIPLE_CORE) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + USE_THEN "part" ACCEPT_TAC; + USE_THEN "class" ACCEPT_TAC; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_TAC `t:num`) THEN + MP_TAC(MATCH_MP CONG_1_MOD_8 (ASSUME `(p == 1) (mod 8)`)) THEN + DISCH_THEN(X_CHOOSE_TAC `r:num`) THEN + MAP_EVERY EXISTS_TAC [`7*j+e`; `p:num`; `t:num`; `r:num`] THEN + REPEAT CONJ_TAC THENL + [ASM_ARITH_TAC; + ASM_REWRITE_TAC[]; + MATCH_ACCEPT_TAC(ASSUME `p = 8*r+1`); + ASM_REWRITE_TAC[]; + MP_TAC(ASSUME `(t EXP 2 + 8 * (7*j+e) == 0) (mod p)`) THEN + REWRITE_TAC[CONG_0_DIVIDES]]);; + +let DISC7_GENUS_REPRESENTS_7_CORE = prove + (`!m u:num. + 1 <= u /\ ODD u /\ (m = u \/ m = 2*u) /\ + ((m == 1) (mod 7) \/ (m == 2) (mod 7) \/ (m == 4) (mod 7)) + ==> (?x y z:int. + x pow 2 + y pow 2 + &7 * z pow 2 = &(7*m)) \/ + (?x y z:int. + x pow 2 + &2 * y pow 2 + &2 * y * z + &4 * z pow 2 = + &(7*m))`, + REPEAT GEN_TAC THEN DISCH_THEN(LABEL_TAC "core") THEN + MP_TAC(SPECL [`m:num`; `u:num`] RESIDUE_DISC7_MULTIPLE_CORE) THEN + ANTS_TAC THENL + [USE_THEN "core" ACCEPT_TAC; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `E:num` + (X_CHOOSE_THEN `p:num` + (X_CHOOSE_THEN `t:num` + (X_CHOOSE_THEN `r:num` STRIP_ASSUME_TAC)))) THEN + ONCE_REWRITE_TAC[GSYM INT_OF_NUM_MUL] THEN + MATCH_MP_TAC(SPECL + [`&m:int`; `&E:int`; `&p:int`; `&t:int`; `&r:int`] + DISC7_MATRIX_GENUS_REPRESENTS) THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[INT_OF_NUM_LT] THEN + USE_THEN "core" MP_TAC THEN STRIP_TAC THEN + ASM_ARITH_TAC; + REWRITE_TAC[INT_OF_NUM_LT] THEN ASM_ARITH_TAC; + REWRITE_TAC[INT_OF_NUM_LT] THEN + MP_TAC(MATCH_MP PRIME_GE_2 (ASSUME `prime p`)) THEN ARITH_TAC; + ASM_REWRITE_TAC[INT_OF_NUM_ADD; INT_OF_NUM_MUL]; + SUBGOAL_THEN `7*p <= 8*m*E` ASSUME_TAC THENL + [ASM_ARITH_TAC; + REWRITE_TAC[INT_OF_NUM_MUL] THEN + ONCE_REWRITE_TAC[MATCH_MP + (SPECL [`7*p`; `8*m*E`] INT_OF_NUM_SUB) + (ASSUME `7*p <= 8*m*E`)] THEN + REWRITE_TAC[INT_OF_NUM_EQ] THEN ASM_ARITH_TAC]; + MP_TAC(ASSUME `p divides (t EXP 2 + 8*E)`) THEN + REWRITE_TAC + [num_divides; INT_OF_NUM_ADD; INT_OF_NUM_MUL; INT_OF_NUM_POW]]);; + +(* ------------------------------------------------------------------------- *) +(* Remove powers of four from the quotient m. *) +(* ------------------------------------------------------------------------- *) + +let DISC7_GENUS_REP_MUL4 = prove + (`!n:num. + ((?x y z:int. x pow 2 + y pow 2 + &7 * z pow 2 = &n) \/ + (?x y z:int. + x pow 2 + &2 * y pow 2 + &2 * y * z + &4 * z pow 2 = &n)) + ==> (?x y z:int. + x pow 2 + y pow 2 + &7 * z pow 2 = &(4*n)) \/ + (?x y z:int. + x pow 2 + &2 * y pow 2 + &2 * y * z + &4 * z pow 2 = + &(4*n))`, + GEN_TAC THEN + DISCH_THEN(DISJ_CASES_THEN + (X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` (X_CHOOSE_TAC `z:int`)))) THENL + [DISJ1_TAC THEN + MAP_EVERY EXISTS_TAC [`&2*x:int`; `&2*y:int`; `&2*z:int`] THEN + FIRST_X_ASSUM MP_TAC THEN + REWRITE_TAC[GSYM INT_OF_NUM_MUL] THEN CONV_TAC INT_RING; + DISJ2_TAC THEN + MAP_EVERY EXISTS_TAC [`&2*x:int`; `&2*y:int`; `&2*z:int`] THEN + FIRST_X_ASSUM MP_TAC THEN + REWRITE_TAC[GSYM INT_OF_NUM_MUL] THEN CONV_TAC INT_RING]);; + +let CONG_QUARTER_1_MOD7 = prove + (`!q:num. (4*q == 1) (mod 7) ==> (q == 2) (mod 7)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONG_TRANS THEN + EXISTS_TAC `8*q` THEN CONJ_TAC THENL + [MATCH_ACCEPT_TAC(NUMBER_RULE `!q:num. (q == 8*q) (mod 7)`); + MP_TAC(MATCH_MP (SPECL [`2`; `4*q`; `1`; `7`] CONG_LMUL) + (ASSUME `(4*q == 1) (mod 7)`)) THEN + REWRITE_TAC[ARITH_RULE `2 * (4*q) = 8*q`; MULT_CLAUSES]]);; + +let CONG_QUARTER_2_MOD7 = prove + (`!q:num. (4*q == 2) (mod 7) ==> (q == 4) (mod 7)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONG_TRANS THEN + EXISTS_TAC `8*q` THEN CONJ_TAC THENL + [MATCH_ACCEPT_TAC(NUMBER_RULE `!q:num. (q == 8*q) (mod 7)`); + MP_TAC(MATCH_MP (SPECL [`2`; `4*q`; `2`; `7`] CONG_LMUL) + (ASSUME `(4*q == 2) (mod 7)`)) THEN + REWRITE_TAC[ARITH_RULE `2 * (4*q) = 8*q`] THEN + CONV_TAC NUM_REDUCE_CONV THEN MESON_TAC[]]);; + +let CONG_QUARTER_4_MOD7 = prove + (`!q:num. (4*q == 4) (mod 7) ==> (q == 1) (mod 7)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONG_TRANS THEN + EXISTS_TAC `8*q` THEN CONJ_TAC THENL + [MATCH_ACCEPT_TAC(NUMBER_RULE `!q:num. (q == 8*q) (mod 7)`); + MATCH_MP_TAC CONG_TRANS THEN EXISTS_TAC `8` THEN CONJ_TAC THENL + [MP_TAC(MATCH_MP (SPECL [`2`; `4*q`; `4`; `7`] CONG_LMUL) + (ASSUME `(4*q == 4) (mod 7)`)) THEN + REWRITE_TAC[ARITH_RULE `2 * (4*q) = 8*q`] THEN + CONV_TAC NUM_REDUCE_CONV THEN MESON_TAC[]; + CONV_TAC NUMBER_RULE]]);; + +let DISC7_QUARTER_SQUARECLASS = prove + (`!q:num. + (4*q == 1) (mod 7) \/ (4*q == 2) (mod 7) \/ (4*q == 4) (mod 7) + ==> (q == 1) (mod 7) \/ (q == 2) (mod 7) \/ (q == 4) (mod 7)`, + MESON_TAC + [CONG_QUARTER_1_MOD7; CONG_QUARTER_2_MOD7; + CONG_QUARTER_4_MOD7]);; + +let DISC7_ODDPART_NOT_DIV4 = prove + (`!m:num. + 1 <= m /\ ~(4 divides m) + ==> ?u. 1 <= u /\ ODD u /\ (m = u \/ m = 2*u)`, + GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "not4")) THEN + MP_TAC(SPEC `m:num` EVEN_OR_ODD) THEN + DISCH_THEN(DISJ_CASES_THEN2 (LABEL_TAC "even") (LABEL_TAC "odd")) THENL + [REMOVE_THEN "even" + (X_CHOOSE_THEN `u:num` (LABEL_TAC "part") o + REWRITE_RULE[EVEN_EXISTS]) THEN + SUBGOAL_THEN `ODD u` ASSUME_TAC THENL + [REWRITE_TAC[GSYM NOT_EVEN] THEN + DISCH_THEN(LABEL_TAC "ueven") THEN + REMOVE_THEN "ueven" + (X_CHOOSE_THEN `k:num` (LABEL_TAC "upart") o + REWRITE_RULE[EVEN_EXISTS]) THEN + SUBGOAL_THEN `4 divides m` MP_TAC THENL + [REWRITE_TAC[divides] THEN EXISTS_TAC `k:num` THEN + MAP_EVERY UNDISCH_TAC [`m = 2*u`; `u = 2*k`] THEN ARITH_TAC; + USE_THEN "not4" MP_TAC THEN MESON_TAC[]]; + ALL_TAC] THEN + EXISTS_TAC `u:num` THEN + REPEAT CONJ_TAC THENL + [USE_THEN "part" MP_TAC THEN ASM_ARITH_TAC; + ASM_REWRITE_TAC[]; + DISJ2_TAC THEN USE_THEN "part" ACCEPT_TAC]; + EXISTS_TAC `m:num` THEN ASM_REWRITE_TAC[]]);; + +let DISC7_GENUS_REPRESENTS_7_SQUARECLASS = prove + (`!m:num. + 1 <= m /\ + ((m == 1) (mod 7) \/ (m == 2) (mod 7) \/ (m == 4) (mod 7)) + ==> (?x y z:int. + x pow 2 + y pow 2 + &7 * z pow 2 = &(7*m)) \/ + (?x y z:int. + x pow 2 + &2 * y pow 2 + &2 * y * z + &4 * z pow 2 = + &(7*m))`, + MATCH_MP_TAC num_WF THEN + X_GEN_TAC `m:num` THEN DISCH_THEN(LABEL_TAC "ih") THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "class")) THEN + ASM_CASES_TAC `4 divides m` THENL + [FIRST_X_ASSUM(X_CHOOSE_THEN `q:num` SUBST_ALL_TAC o + REWRITE_RULE[divides]) THEN + SUBGOAL_THEN `1 <= q` ASSUME_TAC THENL + [ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `(q == 1) (mod 7) \/ (q == 2) (mod 7) \/ (q == 4) (mod 7)` + ASSUME_TAC THENL + [MATCH_MP_TAC DISC7_QUARTER_SQUARECLASS THEN + USE_THEN "class" ACCEPT_TAC; + ALL_TAC] THEN + ONCE_REWRITE_TAC[ARITH_RULE `7 * (4*q) = 4 * (7*q)`] THEN + MATCH_MP_TAC DISC7_GENUS_REP_MUL4 THEN + USE_THEN "ih" (MP_TAC o SPEC `q:num`) THEN + ANTS_TAC THENL + [ASM_ARITH_TAC; + DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]; + MP_TAC(SPEC `m:num` DISC7_ODDPART_NOT_DIV4) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[]; + DISCH_THEN(X_CHOOSE_THEN `u:num` STRIP_ASSUME_TAC)] THEN + MATCH_MP_TAC(SPECL [`m:num`; `u:num`] + DISC7_GENUS_REPRESENTS_7_CORE) THEN + ASM_REWRITE_TAC[] THEN USE_THEN "class" ACCEPT_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Descent by 49 and the full genus-regularity statement. *) +(* ------------------------------------------------------------------------- *) + +let disc7_exception = new_definition + `disc7_exception n <=> + ?a b r:num. + (r = 3 \/ r = 5 \/ r = 6) /\ + n = 49 EXP a * (49*b + 7*r)`;; + +let DISC7_EXCEPTION_BASE = prove + (`!m:num. + m MOD 7 = 3 \/ m MOD 7 = 5 \/ m MOD 7 = 6 + ==> disc7_exception (7*m)`, + GEN_TAC THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THEN + REWRITE_TAC[disc7_exception] THENL + [MAP_EVERY EXISTS_TAC [`0`; `m DIV 7`; `3`]; + MAP_EVERY EXISTS_TAC [`0`; `m DIV 7`; `5`]; + MAP_EVERY EXISTS_TAC [`0`; `m DIV 7`; `6`]] THEN + (CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + REWRITE_TAC[EXP; MULT_CLAUSES] THEN + MP_TAC(SPECL [`m:num`; `7`] (CONJUNCT1 DIVISION_SIMP)) THEN + ASM_REWRITE_TAC[] THEN ARITH_TAC]));; + +let DISC7_EXCEPTION_MUL49 = prove + (`!n:num. disc7_exception n ==> disc7_exception (49*n)`, + GEN_TAC THEN REWRITE_TAC[disc7_exception] THEN + DISCH_THEN(X_CHOOSE_THEN `a:num` + (X_CHOOSE_THEN `b:num` + (X_CHOOSE_THEN `r:num` STRIP_ASSUME_TAC))) THEN + MAP_EVERY EXISTS_TAC [`SUC a`; `b:num`; `r:num`] THEN + ASM_REWRITE_TAC[EXP] THEN CONV_TAC NUM_RING);; + +let DISC7_DESCENT_NOT_EXCEPTION = prove + (`!n:num. + 49 divides n /\ ~disc7_exception n + ==> ~disc7_exception (n DIV 49)`, + GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 + (LABEL_TAC "div49") (LABEL_TAC "avoid")) THEN + REMOVE_THEN "div49" + (X_CHOOSE_THEN `c:num` SUBST_ALL_TAC o REWRITE_RULE[divides]) THEN + SIMP_TAC[DIV_MULT; ARITH] THEN DISCH_TAC THEN + USE_THEN "avoid" MP_TAC THEN + ASM_MESON_TAC[DISC7_EXCEPTION_MUL49]);; + +let DISC7_GENUS_REP_MUL49 = prove + (`!n:num. + ((?x y z:int. x pow 2 + y pow 2 + &7 * z pow 2 = &n) \/ + (?x y z:int. + x pow 2 + &2 * y pow 2 + &2 * y * z + &4 * z pow 2 = &n)) + ==> (?x y z:int. + x pow 2 + y pow 2 + &7 * z pow 2 = &(49*n)) \/ + (?x y z:int. + x pow 2 + &2 * y pow 2 + &2 * y * z + &4 * z pow 2 = + &(49*n))`, + GEN_TAC THEN + DISCH_THEN(DISJ_CASES_THEN + (X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` (X_CHOOSE_TAC `z:int`)))) THENL + [DISJ1_TAC THEN + MAP_EVERY EXISTS_TAC [`&7*x:int`; `&7*y:int`; `&7*z:int`] THEN + FIRST_X_ASSUM MP_TAC THEN + REWRITE_TAC[GSYM INT_OF_NUM_MUL] THEN CONV_TAC INT_RING; + DISJ2_TAC THEN + MAP_EVERY EXISTS_TAC [`&7*x:int`; `&7*y:int`; `&7*z:int`] THEN + FIRST_X_ASSUM MP_TAC THEN + REWRITE_TAC[GSYM INT_OF_NUM_MUL] THEN CONV_TAC INT_RING]);; + +let DIV49_LESS = prove + (`!n:num. ~(n = 0) /\ 49 divides n ==> n DIV 49 < n`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `c:num` SUBST_ALL_TAC o + REWRITE_RULE[divides]) THEN + SUBGOAL_THEN `(49*c) DIV 49 = c` SUBST1_TAC THENL + [SIMP_TAC[DIV_MULT; ARITH]; + ASM_ARITH_TAC]);; + +let DIV49_POS = prove + (`!n:num. 0 < n /\ 49 divides n ==> 0 < n DIV 49`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `c:num` SUBST_ALL_TAC o + REWRITE_RULE[divides]) THEN + SIMP_TAC[DIV_MULT; ARITH] THEN ASM_ARITH_TAC);; + +let DISC7_GENUS_REP_DESCEND49 = prove + (`!n:num. + 49 divides n /\ + ((?x y z:int. + x pow 2 + y pow 2 + &7 * z pow 2 = &(n DIV 49)) \/ + (?x y z:int. + x pow 2 + &2 * y pow 2 + &2 * y * z + &4 * z pow 2 = + &(n DIV 49))) + ==> (?x y z:int. + x pow 2 + y pow 2 + &7 * z pow 2 = &n) \/ + (?x y z:int. + x pow 2 + &2 * y pow 2 + &2 * y * z + &4 * z pow 2 = &n)`, + REPEAT STRIP_TAC THEN + MP_TAC(MATCH_MP + (SPEC `n DIV 49` DISC7_GENUS_REP_MUL49) + (ASSUME + `(?x y z:int. + x pow 2 + y pow 2 + &7 * z pow 2 = &(n DIV 49)) \/ + (?x y z:int. + x pow 2 + &2 * y pow 2 + &2 * y * z + &4 * z pow 2 = + &(n DIV 49))`)) THEN + SUBGOAL_THEN `49 * (n DIV 49) = n` + (fun th -> ASM_REWRITE_TAC[th]) THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `c:num` SUBST1_TAC o + REWRITE_RULE[divides]) THEN + SIMP_TAC[DIV_MULT; ARITH]);; + +let MOD7_SQUARECLASS_DISC7 = prove + (`!m:num. + m MOD 7 = 1 \/ m MOD 7 = 2 \/ m MOD 7 = 4 + ==> (m == 1) (mod 7) \/ (m == 2) (mod 7) \/ (m == 4) (mod 7)`, + GEN_TAC THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THEN + REWRITE_TAC[CONG] THEN ASM_REWRITE_TAC[] THEN + CONV_TAC NUM_REDUCE_CONV);; + +let MOD7_ZERO_DISC7_DIV49 = prove + (`!m:num. m MOD 7 = 0 ==> 49 divides (7*m)`, + GEN_TAC THEN REWRITE_TAC[GSYM DIVIDES_MOD] THEN DISCH_TAC THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `q:num` SUBST1_TAC o + REWRITE_RULE[divides]) THEN + REWRITE_TAC[divides] THEN EXISTS_TAC `q:num` THEN ARITH_TAC);; + +let DISC7_GENUS_REGULAR = prove + (`!n:num. + 0 < n /\ ~disc7_exception n + ==> (?x y z:int. x pow 2 + y pow 2 + &7 * z pow 2 = &n) \/ + (?x y z:int. + x pow 2 + &2 * y pow 2 + &2 * y * z + &4 * z pow 2 = &n)`, + MATCH_MP_TAC num_WF THEN + X_GEN_TAC `n:num` THEN DISCH_THEN(LABEL_TAC "ih") THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "avoid")) THEN + ASM_CASES_TAC `n = 1` THENL + [DISJ1_TAC THEN + MAP_EVERY EXISTS_TAC [`&1:int`; `&0:int`; `&0:int`] THEN + ASM_REWRITE_TAC[] THEN CONV_TAC INT_RING; + ALL_TAC] THEN + ASM_CASES_TAC `7 divides n` THENL + [MP_TAC(REWRITE_RULE[divides] (ASSUME `7 divides n`)) THEN + DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST_ALL_TAC) THEN + SUBGOAL_THEN `1 <= m` ASSUME_TAC THENL + [ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `m MOD 7 = 0 \/ m MOD 7 = 1 \/ m MOD 7 = 2 \/ + m MOD 7 = 3 \/ m MOD 7 = 4 \/ m MOD 7 = 5 \/ m MOD 7 = 6` + MP_TAC THENL + [MP_TAC(SPECL [`m:num`; `7`] MOD_LT) THEN ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THENL + [SUBGOAL_THEN `49 divides (7*m)` ASSUME_TAC THENL + [MATCH_MP_TAC MOD7_ZERO_DISC7_DIV49 THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC DISC7_GENUS_REP_DESCEND49 THEN + ASM_REWRITE_TAC[] THEN + USE_THEN "ih" (MP_TAC o SPEC `(7*m) DIV 49`) THEN + ANTS_TAC THENL + [MATCH_MP_TAC DIV49_LESS THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; + DISCH_THEN MATCH_MP_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC DIV49_POS THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; + MATCH_MP_TAC DISC7_DESCENT_NOT_EXCEPTION THEN + ASM_REWRITE_TAC[]]; + MATCH_MP_TAC DISC7_GENUS_REPRESENTS_7_SQUARECLASS THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MOD7_SQUARECLASS_DISC7 THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC DISC7_GENUS_REPRESENTS_7_SQUARECLASS THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MOD7_SQUARECLASS_DISC7 THEN + ASM_REWRITE_TAC[]; + SUBGOAL_THEN `disc7_exception (7*m)` MP_TAC THENL + [MATCH_MP_TAC DISC7_EXCEPTION_BASE THEN ASM_REWRITE_TAC[]; + USE_THEN "avoid" MP_TAC THEN MESON_TAC[]]; + MATCH_MP_TAC DISC7_GENUS_REPRESENTS_7_SQUARECLASS THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MOD7_SQUARECLASS_DISC7 THEN + ASM_REWRITE_TAC[]; + SUBGOAL_THEN `disc7_exception (7*m)` MP_TAC THENL + [MATCH_MP_TAC DISC7_EXCEPTION_BASE THEN ASM_REWRITE_TAC[]; + USE_THEN "avoid" MP_TAC THEN MESON_TAC[]]; + SUBGOAL_THEN `disc7_exception (7*m)` MP_TAC THENL + [MATCH_MP_TAC DISC7_EXCEPTION_BASE THEN ASM_REWRITE_TAC[]; + USE_THEN "avoid" MP_TAC THEN MESON_TAC[]]]; + MATCH_MP_TAC DISC7_GENUS_COPRIME7 THEN + ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC]);; + +let DISC7_MOD4_WITNESS = prove + (`!n:num. + n MOD 4 = 0 \/ n MOD 4 = 1 + ==> ?q:int. &n = &4*q \/ &n = &4*q + &1`, + GEN_TAC THEN DISCH_THEN(DISJ_CASES_THEN ASSUME_TAC) THENL + [EXISTS_TAC `&(n DIV 4):int` THEN DISJ1_TAC THEN + SUBGOAL_THEN `n = 4 * (n DIV 4)` ASSUME_TAC THENL + [MP_TAC(SPECL [`n:num`; `4`] (CONJUNCT1 DIVISION_SIMP)) THEN + ASM_REWRITE_TAC[] THEN ARITH_TAC; + REWRITE_TAC[INT_OF_NUM_MUL; INT_OF_NUM_EQ] THEN + MATCH_ACCEPT_TAC(ASSUME `n = 4 * (n DIV 4)`)]; + EXISTS_TAC `&(n DIV 4):int` THEN DISJ2_TAC THEN + SUBGOAL_THEN `n = 4 * (n DIV 4) + 1` ASSUME_TAC THENL + [MP_TAC(SPECL [`n:num`; `4`] (CONJUNCT1 DIVISION_SIMP)) THEN + ASM_REWRITE_TAC[] THEN ARITH_TAC; + REWRITE_TAC + [INT_OF_NUM_ADD; INT_OF_NUM_MUL; INT_OF_NUM_EQ] THEN + MATCH_ACCEPT_TAC(ASSUME `n = 4 * (n DIV 4) + 1`)]]);; + +let DISC7_BOTH_REGULAR_MOD4 = prove + (`!n:num. + 0 < n /\ ~disc7_exception n /\ + (n MOD 4 = 0 \/ n MOD 4 = 1) + ==> (?x y z:int. x pow 2 + y pow 2 + &7 * z pow 2 = &n) /\ + (?x y z:int. + x pow 2 + &2 * y pow 2 + &2 * y * z + &4 * z pow 2 = &n)`, + GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 (LABEL_TAC "avoid") (LABEL_TAC "mod4"))) THEN + MP_TAC(SPEC `n:num` DISC7_MOD4_WITNESS) THEN + ANTS_TAC THENL + [USE_THEN "mod4" ACCEPT_TAC; + DISCH_THEN(X_CHOOSE_THEN `q:int` (LABEL_TAC "mod4int"))] THEN + MP_TAC(SPEC `n:num` DISC7_GENUS_REGULAR) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN USE_THEN "avoid" ACCEPT_TAC; + DISCH_THEN(DISJ_CASES_THEN (LABEL_TAC "repr"))] THENL + [CONJ_TAC THENL + [USE_THEN "repr" ACCEPT_TAC; + MATCH_MP_TAC(SPEC `&n:int` REPR_CROSS124_OF_DIAG7_MOD4) THEN + CONJ_TAC THENL + [USE_THEN "repr" ACCEPT_TAC; + EXISTS_TAC `q:int` THEN USE_THEN "mod4int" ACCEPT_TAC]]; + CONJ_TAC THENL + [MATCH_MP_TAC(SPEC `&n:int` REPR_DIAG7_OF_CROSS124_MOD4) THEN + CONJ_TAC THENL + [USE_THEN "repr" ACCEPT_TAC; + EXISTS_TAC `q:int` THEN USE_THEN "mod4int" ACCEPT_TAC]; + USE_THEN "repr" ACCEPT_TAC]]);; + +(* The determinant-7 diagonal form gives the determinant-14 form + x^2 + y^2 + 14z^2 after doubling. *) +let DIAG7_TO_117_DOUBLE = prove + (`!n x y z:int. + x pow 2 + y pow 2 + &7 * z pow 2 = n + ==> ?a b c. + a pow 2 + b pow 2 + &14 * c pow 2 = &2 * n`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MAP_EVERY EXISTS_TAC [`x + y:int`; `x - y:int`; `z:int`] THEN + FIRST_X_ASSUM(MP_TAC) THEN CONV_TAC INT_RING);; + +let INT_117_PAIR_TO_127 = prove + (`!n a b c t:int. + a pow 2 + b pow 2 + &14 * c pow 2 = n /\ + b - c = &3 * t + ==> ?x y z. + x pow 2 + &2 * y pow 2 + &7 * z pow 2 = n`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MAP_EVERY EXISTS_TAC [`a:int`; `t - &2 * c:int`; `t + c:int`] THEN + MAP_EVERY UNDISCH_TAC + [`a pow 2 + b pow 2 + &14 * c pow 2 = n`; + `b - c = &3 * t`] THEN + CONV_TAC INT_RING);; + +let INT_117_BAD_REM3 = prove + (`!n a b c q:int. + (a rem &3 = &0 /\ b rem &3 = &0 /\ c rem &3 = &1 \/ + a rem &3 = &1 /\ b rem &3 = &1 /\ c rem &3 = &0) /\ + (n = &3 * q \/ n = &3 * q + &1) + ==> ~(a pow 2 + b pow 2 + &14 * c pow 2 = n)`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 + (DISJ_CASES_THEN STRIP_ASSUME_TAC) + (DISJ_CASES_THEN ASSUME_TAC)) THEN + DISCH_THEN(MP_TAC o AP_TERM `\u:int. u rem &3`) THEN + ASM_REWRITE_TAC[] THEN + (SUBGOAL_THEN + `(a pow 2 + b pow 2 + &14 * c pow 2) rem &3 = + ((a rem &3) pow 2 + (b rem &3) pow 2 + + &14 * (c rem &3) pow 2) rem &3` + SUBST1_TAC THENL + [CONV_TAC INT_REM_DOWN_CONV THEN REFL_TAC; + ASM_REWRITE_TAC[] THEN CONV_TAC INT_REDUCE_CONV THEN + REWRITE_TAC + [INT_RING `&3 * q + &1 = q * &3 + &1`; + INT_RING `&3 * q = q * &3`; + INT_REM_MUL; INT_REM_MUL_ADD] THEN + CONV_TAC INT_REDUCE_CONV]));; + +(* Pall's identity transfers x^2+y^2+14z^2 to x^2+2y^2+7z^2 + whenever the represented integer is 0 or 1 modulo 3. *) +let REPR_127_OF_117_MOD3 = prove + (`!n:int. + (?a b c. a pow 2 + b pow 2 + &14 * c pow 2 = n) /\ + (?q. n = &3 * q \/ n = &3 * q + &1) + ==> ?x y z. + x pow 2 + &2 * y pow 2 + &7 * z pow 2 = n`, + GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `a:int` + (X_CHOOSE_THEN `b:int` + (X_CHOOSE_THEN `c:int` (LABEL_TAC "repr")))) + (X_CHOOSE_THEN `q:int` (LABEL_TAC "mod3"))) THEN + MP_TAC(SPEC `a:int` INT_SIGN_NORMALIZE_MOD3) THEN + MP_TAC(SPEC `b:int` INT_SIGN_NORMALIZE_MOD3) THEN + MP_TAC(SPEC `c:int` INT_SIGN_NORMALIZE_MOD3) THEN + DISCH_THEN(X_CHOOSE_THEN `C:int` + (CONJUNCTS_THEN2 (LABEL_TAC "Csq") (LABEL_TAC "Crem"))) THEN + DISCH_THEN(X_CHOOSE_THEN `B:int` + (CONJUNCTS_THEN2 (LABEL_TAC "Bsq") (LABEL_TAC "Brem"))) THEN + DISCH_THEN(X_CHOOSE_THEN `A:int` + (CONJUNCTS_THEN2 (LABEL_TAC "Asq") (LABEL_TAC "Arem"))) THEN + SUBGOAL_THEN + `A pow 2 + B pow 2 + &14 * C pow 2 = n` + (LABEL_TAC "normalized") THENL + [ASM_REWRITE_TAC[]; + ALL_TAC] THEN + ASM_CASES_TAC `B rem &3 = C rem &3` THENL + [MP_TAC(MATCH_MP + (SPECL [`B:int`; `C:int`] INT_SAME_REM_MOD3_DIVIDES_SUB) + (ASSUME `B rem &3 = C rem &3`)) THEN + REWRITE_TAC[int_divides] THEN + DISCH_THEN(X_CHOOSE_THEN `t:int` (LABEL_TAC "pair")) THEN + MATCH_MP_TAC(SPECL + [`n:int`; `A:int`; `B:int`; `C:int`; `t:int`] + INT_117_PAIR_TO_127) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + ASM_CASES_TAC `A rem &3 = C rem &3` THENL + [MP_TAC(MATCH_MP + (SPECL [`A:int`; `C:int`] INT_SAME_REM_MOD3_DIVIDES_SUB) + (ASSUME `A rem &3 = C rem &3`)) THEN + REWRITE_TAC[int_divides] THEN + DISCH_THEN(X_CHOOSE_THEN `t:int` (LABEL_TAC "pair")) THEN + MATCH_MP_TAC(SPECL + [`n:int`; `B:int`; `A:int`; `C:int`; `t:int`] + INT_117_PAIR_TO_127) THEN + CONJ_TAC THENL + [REMOVE_THEN "normalized" MP_TAC THEN INT_ARITH_TAC; + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN + `(A rem &3 = &0 /\ B rem &3 = &0 /\ C rem &3 = &1) \/ + (A rem &3 = &1 /\ B rem &3 = &1 /\ C rem &3 = &0)` + ASSUME_TAC THENL + [REMOVE_THEN "Arem" (DISJ_CASES_THEN ASSUME_TAC) THEN + REMOVE_THEN "Brem" (DISJ_CASES_THEN ASSUME_TAC) THEN + REMOVE_THEN "Crem" (DISJ_CASES_THEN ASSUME_TAC) THEN + ASM_MESON_TAC[]; + MP_TAC(SPECL [`n:int`; `A:int`; `B:int`; `C:int`; `q:int`] + INT_117_BAD_REM3) THEN + ASM_REWRITE_TAC[]]);; + +let INT_127_DOUBLE_PARITY = prove + (`!n a b c:int. + a pow 2 + &2 * b pow 2 + &7 * c pow 2 = &2 * n + ==> ?t. a - c = &2 * t`, + REPEAT GEN_TAC THEN DISCH_THEN(LABEL_TAC "repr") THEN + MP_TAC(SPEC `c:int` INT_PARITY_WITNESS) THEN + MP_TAC(SPEC `a:int` INT_PARITY_WITNESS) THEN + DISCH_THEN(DISJ_CASES_THEN + (X_CHOOSE_THEN `u:int` ASSUME_TAC)) THEN + DISCH_THEN(DISJ_CASES_THEN + (X_CHOOSE_THEN `v:int` ASSUME_TAC)) THENL + [EXISTS_TAC `u - v:int` THEN ASM_REWRITE_TAC[] THEN CONV_TAC INT_RING; + SUBGOAL_THEN `&2 divides &1` MP_TAC THENL + [REWRITE_TAC[int_divides] THEN + EXISTS_TAC + `n - &2 * (u pow 2) - b pow 2 - + &14 * (v pow 2) - &14 * v - &3:int` THEN + REMOVE_THEN "repr" MP_TAC THEN + ASM_REWRITE_TAC[] THEN CONV_TAC INT_RING; + REWRITE_TAC[INT_DIVIDES_ONE] THEN CONV_TAC INT_REDUCE_CONV]; + SUBGOAL_THEN `&2 divides &1` MP_TAC THENL + [REWRITE_TAC[int_divides] THEN + EXISTS_TAC + `n - &2 * (u pow 2) - &2 * u - b pow 2 - + &14 * (v pow 2):int` THEN + REMOVE_THEN "repr" MP_TAC THEN + ASM_REWRITE_TAC[] THEN CONV_TAC INT_RING; + REWRITE_TAC[INT_DIVIDES_ONE] THEN CONV_TAC INT_REDUCE_CONV]; + EXISTS_TAC `u - v:int` THEN ASM_REWRITE_TAC[] THEN CONV_TAC INT_RING]);; + +(* This is Kaplansky's second doubling identity. *) +let REPR_CROSS124_OF_127_DOUBLE = prove + (`!n:int. + (?a b c. + a pow 2 + &2 * b pow 2 + &7 * c pow 2 = &2 * n) + ==> ?x y z. + x pow 2 + &2 * y pow 2 + &2 * y * z + + &4 * z pow 2 = n`, + GEN_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `a:int` + (X_CHOOSE_THEN `b:int` + (X_CHOOSE_THEN `c:int` (LABEL_TAC "repr")))) THEN + MP_TAC(MATCH_MP + (SPECL [`n:int`; `a:int`; `b:int`; `c:int`] + INT_127_DOUBLE_PARITY) + (ASSUME + `a pow 2 + &2 * b pow 2 + &7 * c pow 2 = &2 * n`)) THEN + DISCH_THEN(X_CHOOSE_THEN `t:int` (LABEL_TAC "parity")) THEN + MAP_EVERY EXISTS_TAC [`b:int`; `t:int`; `c:int`] THEN + MATCH_MP_TAC(INT_ARITH `&2 * q = &2 * n ==> q = n`) THEN + REMOVE_THEN "repr" MP_TAC THEN REMOVE_THEN "parity" MP_TAC THEN + CONV_TAC INT_RING);; + +let DISC7_DOUBLE_MOD3_WITNESS = prove + (`!n:num. + n MOD 3 = 0 \/ n MOD 3 = 2 + ==> ?q:int. &2 * &n = &3 * q \/ &2 * &n = &3 * q + &1`, + GEN_TAC THEN DISCH_THEN(DISJ_CASES_THEN ASSUME_TAC) THENL + [MP_TAC(MATCH_MP (SPECL [`n:num`; `3`; `0`] NUM_DECOMPOSE_MOD) + (CONJ (ARITH_RULE `~(3 = 0)`) (ASSUME `n MOD 3 = 0`))) THEN + DISCH_THEN(X_CHOOSE_THEN `q:num` SUBST_ALL_TAC) THEN + EXISTS_TAC `&(2 * q):int` THEN DISJ1_TAC THEN + REWRITE_TAC[GSYM INT_OF_NUM_ADD; GSYM INT_OF_NUM_MUL; + INT_OF_NUM_EQ] THEN ARITH_TAC; + MP_TAC(MATCH_MP (SPECL [`n:num`; `3`; `2`] NUM_DECOMPOSE_MOD) + (CONJ (ARITH_RULE `~(3 = 0)`) (ASSUME `n MOD 3 = 2`))) THEN + DISCH_THEN(X_CHOOSE_THEN `q:num` SUBST_ALL_TAC) THEN + EXISTS_TAC `&(2 * q + 1):int` THEN DISJ2_TAC THEN + REWRITE_TAC[GSYM INT_OF_NUM_ADD; GSYM INT_OF_NUM_MUL; + INT_OF_NUM_EQ] THEN ARITH_TAC]);; + +let DISC7_CROSS124_REGULAR_MOD3 = prove + (`!n:num. + 0 < n /\ ~disc7_exception n /\ + (n MOD 3 = 0 \/ n MOD 3 = 2) + ==> ?x y z:int. + x pow 2 + &2 * y pow 2 + &2 * y * z + + &4 * z pow 2 = &n`, + GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 (LABEL_TAC "avoid") (LABEL_TAC "mod3"))) THEN + MP_TAC(MATCH_MP (SPEC `n:num` DISC7_GENUS_REGULAR) + (CONJ (ASSUME `0 < n`) (ASSUME `~disc7_exception n`))) THEN + DISCH_THEN(DISJ_CASES_THEN + (X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` + (X_CHOOSE_THEN `z:int` (LABEL_TAC "genus"))))) THENL + [MP_TAC(MATCH_MP + (SPECL [`&n:int`; `x:int`; `y:int`; `z:int`] + DIAG7_TO_117_DOUBLE) + (ASSUME + `x pow 2 + y pow 2 + &7 * z pow 2 = &n`)) THEN + DISCH_THEN(LABEL_TAC "double117") THEN + MP_TAC(MATCH_MP (SPEC `n:num` DISC7_DOUBLE_MOD3_WITNESS) + (ASSUME `n MOD 3 = 0 \/ n MOD 3 = 2`)) THEN + DISCH_THEN(X_CHOOSE_THEN `q:int` (LABEL_TAC "doublemod3")) THEN + MATCH_MP_TAC REPR_CROSS124_OF_127_DOUBLE THEN + MATCH_MP_TAC(SPEC `&2 * &n:int` REPR_127_OF_117_MOD3) THEN + CONJ_TAC THENL + [REMOVE_THEN "double117" MATCH_ACCEPT_TAC; + EXISTS_TAC `q:int` THEN + REMOVE_THEN "doublemod3" MATCH_ACCEPT_TAC]; + MAP_EVERY EXISTS_TAC [`x:int`; `y:int`; `z:int`] THEN + REMOVE_THEN "genus" MATCH_ACCEPT_TAC]);; + +let NUM_CROSS124_GOOD_RESIDUES = prove + (`!n:num. + ~(n MOD 12 = 7) /\ ~(n MOD 12 = 10) + ==> n MOD 3 = 0 \/ n MOD 3 = 2 \/ + n MOD 4 = 0 \/ n MOD 4 = 1`, + GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `n MOD 3 = (n MOD 12) MOD 3` ASSUME_TAC THENL + [REWRITE_TAC[ARITH_RULE `12 = 3 * 4`; MOD_MOD]; + ALL_TAC] THEN + SUBGOAL_THEN `n MOD 4 = (n MOD 12) MOD 4` ASSUME_TAC THENL + [REWRITE_TAC[ARITH_RULE `12 = 4 * 3`; MOD_MOD]; + ALL_TAC] THEN + SUBGOAL_THEN `n MOD 12 < 12` ASSUME_TAC THENL + [REWRITE_TAC[MOD_LT_EQ] THEN CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + NUM_RANGE_CASES_TAC `n MOD 12` 11 THEN + RULE_ASSUM_TAC(CONV_RULE NUM_REDUCE_CONV) THEN + ASM_MESON_TAC[]);; + +let DISC7_CROSS124_REGULAR = prove + (`!n:num. + 0 < n /\ ~disc7_exception n /\ + ~(n MOD 12 = 7) /\ ~(n MOD 12 = 10) + ==> ?x y z:int. + x pow 2 + &2 * y pow 2 + &2 * y * z + + &4 * z pow 2 = &n`, + GEN_TAC THEN STRIP_TAC THEN + MP_TAC(MATCH_MP (SPEC `n:num` NUM_CROSS124_GOOD_RESIDUES) + (CONJ (ASSUME `~(n MOD 12 = 7)`) + (ASSUME `~(n MOD 12 = 10)`))) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THENL + [MATCH_MP_TAC(SPEC `n:num` DISC7_CROSS124_REGULAR_MOD3) THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC(SPEC `n:num` DISC7_CROSS124_REGULAR_MOD3) THEN + ASM_REWRITE_TAC[]; + MP_TAC(SPEC `n:num` DISC7_BOTH_REGULAR_MOD4) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[]; + MESON_TAC[]]; + MP_TAC(SPEC `n:num` DISC7_BOTH_REGULAR_MOD4) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[]; + MESON_TAC[]]]);; + +let IQ_125_CHILD_REP_OF_NUM = prove + (`!rb rc k m:num. + int125_child_rep rb rc k m + ==> iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&rb) (&5) (&rc) (&k)) (&m)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[int125_child_rep; iq_represents] THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` + (X_CHOOSE_THEN `z:int` (X_CHOOSE_TAC `w:int`)))) THEN + EXISTS_TAC + `\i:num. + if i = 0 then (x:int) else if i = 1 then y else + if i = 2 then z else w` THEN + REWRITE_TAC[IQEVAL_MAT4] THEN + CONV_TAC NUM_REDUCE_CONV THEN + FIRST_X_ASSUM(MP_TAC) THEN CONV_TAC INT_RING);; + +let IQ_UNIVERSAL_OF_125_CHILD_ALMOST15 = prove + (`!n A rb rc k. + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&rb) (&5) (&rc) (&k)) A /\ + (!m:num. 0 < m /\ ~(m = 15) ==> int125_child_rep rb rc k m) /\ + iq_represents n A (&15) + ==> iq_universal n A`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "emb") + (CONJUNCTS_THEN2 (LABEL_TAC "almost") (LABEL_TAC "fifteen"))) THEN + REWRITE_TAC[iq_universal] THEN + X_GEN_TAC `m:int` THEN DISCH_TAC THEN + ASM_CASES_TAC `m = &15` THENL + [REMOVE_THEN "fifteen" MP_TAC THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MP_TAC(EQ_MP (SYM(SPEC `m:int` INT_OF_NUM_EXISTS)) + (MATCH_MP (SPECL [`&0:int`; `m:int`] INT_LT_IMP_LE) + (ASSUME `&0 < m`))) THEN + DISCH_THEN(X_CHOOSE_THEN `u:num` SUBST_ALL_TAC) THEN + MATCH_MP_TAC(ISPECL + [`n:num`; `4`; + `iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&rb) (&5) (&rc) (&k)`; + `A:num->num->int`; `&u:int`] IQ_REPRESENTS_OF_EMBEDS) THEN + CONJ_TAC THENL + [REMOVE_THEN "emb" MATCH_ACCEPT_TAC; + MATCH_MP_TAC IQ_125_CHILD_REP_OF_NUM THEN + REMOVE_THEN "almost" (MATCH_MP_TAC o SPEC `u:num`) THEN + CONJ_TAC THENL + [UNDISCH_TAC `&0 < &u` THEN REWRITE_TAC[INT_OF_NUM_LT]; + UNDISCH_TAC `~(&u = &15)` THEN REWRITE_TAC[INT_OF_NUM_EQ]]]);; + +let INT_ALMOST_UNIVERSAL_DIAG125 = + MATCH_MP INT_ALMOST_UNIVERSAL_DIAG125_REP + REGULAR_125_NOT_EXCEPTION;; + +let INT_ALMOST_UNIVERSAL_RC1_125 = + MATCH_MP INT_ALMOST_UNIVERSAL_RC1_125_REP + REGULAR_125_NOT_EXCEPTION;; + +let INT_ALMOST_UNIVERSAL_RC2_125 = + MATCH_MP INT_ALMOST_UNIVERSAL_RC2_125_REP + REGULAR_125_NOT_EXCEPTION;; + +let INT_ALMOST_UNIVERSAL_RB1_125 = + MATCH_MP INT_ALMOST_UNIVERSAL_RB1_125_REP + REGULAR_125_NOT_EXCEPTION;; + +let INT_ALMOST_UNIVERSAL_RB1_RC1_125 = + MATCH_MP INT_ALMOST_UNIVERSAL_RB1_RC1_125_REP + REGULAR_125_NOT_EXCEPTION;; + +let INT_ALMOST_UNIVERSAL_RB1_RC2_125 = + MATCH_MP INT_ALMOST_UNIVERSAL_RB1_RC2_125_REP + REGULAR_125_NOT_EXCEPTION;; + +let IQ_UNIVERSAL_OF_DIAG125_CHILD = prove + (`!n A k. + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&0) (&5) (&0) k) A /\ + &1 <= k /\ k <= &10 /\ + iq_represents n A (&15) + ==> iq_universal n A`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(EQ_MP (SYM(SPEC `k:int` INT_OF_NUM_EXISTS)) + (MATCH_MP (INT_ARITH `&1 <= k ==> &0 <= k`) + (ASSUME `&1 <= k`))) THEN + DISCH_THEN(X_CHOOSE_THEN `c:num` SUBST_ALL_TAC) THEN + SUBGOAL_THEN `1 <= c /\ c <= 10` ASSUME_TAC THENL + [UNDISCH_TAC `&1 <= &c` THEN + UNDISCH_TAC `&c <= &10` THEN + REWRITE_TAC[INT_OF_NUM_LE] THEN ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(ISPECL + [`n:num`; `A:num->num->int`; `0`; `0`; `c:num`] + IQ_UNIVERSAL_OF_125_CHILD_ALMOST15) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(SPEC `c:num` INT_ALMOST_UNIVERSAL_DIAG125) THEN + ASM_REWRITE_TAC[]);; + +let IQ_UNIVERSAL_OF_RC1_125_CHILD = prove + (`!n A k. + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&0) (&5) (&1) k) A /\ + &1 <= k /\ k <= &10 /\ + iq_represents n A (&15) + ==> iq_universal n A`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(EQ_MP (SYM(SPEC `k:int` INT_OF_NUM_EXISTS)) + (MATCH_MP (INT_ARITH `&1 <= k ==> &0 <= k`) + (ASSUME `&1 <= k`))) THEN + DISCH_THEN(X_CHOOSE_THEN `c:num` SUBST_ALL_TAC) THEN + SUBGOAL_THEN `1 <= c /\ c <= 10` ASSUME_TAC THENL + [UNDISCH_TAC `&1 <= &c` THEN + UNDISCH_TAC `&c <= &10` THEN + REWRITE_TAC[INT_OF_NUM_LE] THEN ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(ISPECL + [`n:num`; `A:num->num->int`; `0`; `1`; `c:num`] + IQ_UNIVERSAL_OF_125_CHILD_ALMOST15) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(SPEC `c:num` INT_ALMOST_UNIVERSAL_RC1_125) THEN + ASM_REWRITE_TAC[]);; + +let IQ_UNIVERSAL_OF_RC2_125_CHILD = prove + (`!n A k. + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&0) (&5) (&2) k) A /\ + &1 <= k /\ k <= &10 /\ + iq_represents n A (&15) + ==> iq_universal n A`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(EQ_MP (SYM(SPEC `k:int` INT_OF_NUM_EXISTS)) + (MATCH_MP (INT_ARITH `&1 <= k ==> &0 <= k`) + (ASSUME `&1 <= k`))) THEN + DISCH_THEN(X_CHOOSE_THEN `c:num` SUBST_ALL_TAC) THEN + SUBGOAL_THEN `1 <= c /\ c <= 10` ASSUME_TAC THENL + [UNDISCH_TAC `&1 <= &c` THEN + UNDISCH_TAC `&c <= &10` THEN + REWRITE_TAC[INT_OF_NUM_LE] THEN ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(ISPECL + [`n:num`; `A:num->num->int`; `0`; `2`; `c:num`] + IQ_UNIVERSAL_OF_125_CHILD_ALMOST15) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(SPEC `c:num` INT_ALMOST_UNIVERSAL_RC2_125) THEN + ASM_REWRITE_TAC[]);; + +let IQ_UNIVERSAL_OF_RB1_125_CHILD = prove + (`!n A k. + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&5) (&0) k) A /\ + (k = &1 \/ k = &2 \/ k = &3 \/ k = &4 \/ + k = &5 \/ k = &6 \/ k = &9 \/ k = &10) /\ + iq_represents n A (&15) + ==> iq_universal n A`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC)) THEN + SUBGOAL_THEN `&0 <= k` ASSUME_TAC THENL + [ASM_MESON_TAC[INT_ARITH + `&0 <= &1 /\ &0 <= &2 /\ &0 <= &3 /\ &0 <= &4 /\ + &0 <= &5 /\ &0 <= &6 /\ &0 <= &9 /\ &0 <= &10`]; + ALL_TAC] THEN + MP_TAC(EQ_MP (SYM(SPEC `k:int` INT_OF_NUM_EXISTS)) + (ASSUME `&0 <= k`)) THEN + DISCH_THEN(X_CHOOSE_THEN `c:num` SUBST_ALL_TAC) THEN + SUBGOAL_THEN + `c = 1 \/ c = 2 \/ c = 3 \/ c = 4 \/ + c = 5 \/ c = 6 \/ c = 9 \/ c = 10` + ASSUME_TAC THENL + [UNDISCH_TAC + `&c = &1 \/ &c = &2 \/ &c = &3 \/ &c = &4 \/ + &c = &5 \/ &c = &6 \/ &c = &9 \/ &c = &10` THEN + REWRITE_TAC[INT_OF_NUM_EQ]; + ALL_TAC] THEN + MATCH_MP_TAC(ISPECL + [`n:num`; `A:num->num->int`; `1`; `0`; `c:num`] + IQ_UNIVERSAL_OF_125_CHILD_ALMOST15) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(SPEC `c:num` INT_ALMOST_UNIVERSAL_RB1_125) THEN + ASM_REWRITE_TAC[]);; + +let IQ_UNIVERSAL_OF_RB1_RC1_125_CHILD = prove + (`!n A k. + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&5) (&1) k) A /\ + (k = &1 \/ k = &2 \/ k = &3 \/ k = &5 \/ + k = &6 \/ k = &7 \/ k = &9 \/ k = &10) /\ + iq_represents n A (&15) + ==> iq_universal n A`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC)) THEN + SUBGOAL_THEN `&0 <= k` ASSUME_TAC THENL + [ASM_MESON_TAC[INT_ARITH + `&0 <= &1 /\ &0 <= &2 /\ &0 <= &3 /\ &0 <= &5 /\ + &0 <= &6 /\ &0 <= &7 /\ &0 <= &9 /\ &0 <= &10`]; + ALL_TAC] THEN + MP_TAC(EQ_MP (SYM(SPEC `k:int` INT_OF_NUM_EXISTS)) + (ASSUME `&0 <= k`)) THEN + DISCH_THEN(X_CHOOSE_THEN `c:num` SUBST_ALL_TAC) THEN + SUBGOAL_THEN + `c = 1 \/ c = 2 \/ c = 3 \/ c = 5 \/ + c = 6 \/ c = 7 \/ c = 9 \/ c = 10` + ASSUME_TAC THENL + [UNDISCH_TAC + `&c = &1 \/ &c = &2 \/ &c = &3 \/ &c = &5 \/ + &c = &6 \/ &c = &7 \/ &c = &9 \/ &c = &10` THEN + REWRITE_TAC[INT_OF_NUM_EQ]; + ALL_TAC] THEN + MATCH_MP_TAC(ISPECL + [`n:num`; `A:num->num->int`; `1`; `1`; `c:num`] + IQ_UNIVERSAL_OF_125_CHILD_ALMOST15) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(SPEC `c:num` INT_ALMOST_UNIVERSAL_RB1_RC1_125) THEN + ASM_REWRITE_TAC[]);; + +let IQ_UNIVERSAL_OF_RB1_RC2_125_CHILD = prove + (`!n A k. + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&0) (&1) (&5) (&2) k) A /\ + (k = &2 \/ k = &3 \/ k = &4 \/ k = &5 \/ + k = &6 \/ k = &8 \/ k = &9 \/ k = &10) /\ + iq_represents n A (&15) + ==> iq_universal n A`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC)) THEN + SUBGOAL_THEN `&0 <= k` ASSUME_TAC THENL + [ASM_MESON_TAC[INT_ARITH + `&0 <= &2 /\ &0 <= &3 /\ &0 <= &4 /\ &0 <= &5 /\ + &0 <= &6 /\ &0 <= &8 /\ &0 <= &9 /\ &0 <= &10`]; + ALL_TAC] THEN + MP_TAC(EQ_MP (SYM(SPEC `k:int` INT_OF_NUM_EXISTS)) + (ASSUME `&0 <= k`)) THEN + DISCH_THEN(X_CHOOSE_THEN `c:num` SUBST_ALL_TAC) THEN + SUBGOAL_THEN + `c = 2 \/ c = 3 \/ c = 4 \/ c = 5 \/ + c = 6 \/ c = 8 \/ c = 9 \/ c = 10` + ASSUME_TAC THENL + [UNDISCH_TAC + `&c = &2 \/ &c = &3 \/ &c = &4 \/ &c = &5 \/ + &c = &6 \/ &c = &8 \/ &c = &9 \/ &c = &10` THEN + REWRITE_TAC[INT_OF_NUM_EQ]; + ALL_TAC] THEN + MATCH_MP_TAC(ISPECL + [`n:num`; `A:num->num->int`; `1`; `2`; `c:num`] + IQ_UNIVERSAL_OF_125_CHILD_ALMOST15) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(SPEC `c:num` INT_ALMOST_UNIVERSAL_RB1_RC2_125) THEN + ASM_REWRITE_TAC[]);; + +let IQ_UNIVERSAL_OF_EMBEDS_125 = prove + (`!n A. + iq_symmetric n A /\ iq_positive n A /\ + iq_embeds n 3 + (iqmat3 (&1) (&0) (&0) (&2) (&0) (&5)) A /\ + iq_represents n A (&10) /\ + iq_represents n A (&15) + ==> iq_universal n A`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(SPECL [`n:num`; `A:num->num->int`] + IQ_EMBEDS_QUATERNARY_125) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN + (X_CHOOSE_THEN `k:int` + (REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC))) THENL + [MATCH_MP_TAC(ISPECL [`n:num`; `A:num->num->int`; `k:int`] + IQ_UNIVERSAL_OF_DIAG125_CHILD) THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC(ISPECL [`n:num`; `A:num->num->int`; `k:int`] + IQ_UNIVERSAL_OF_RC1_125_CHILD) THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC(ISPECL [`n:num`; `A:num->num->int`; `k:int`] + IQ_UNIVERSAL_OF_RC2_125_CHILD) THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC(ISPECL [`n:num`; `A:num->num->int`; `k:int`] + IQ_UNIVERSAL_OF_RB1_125_CHILD) THEN + REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + MATCH_MP_TAC(SPEC `k:int` IQ_RB1_RC0_125_PARAMETER_CASES) THEN + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]]; + MATCH_MP_TAC(ISPECL [`n:num`; `A:num->num->int`; `k:int`] + IQ_UNIVERSAL_OF_RB1_RC1_125_CHILD) THEN + REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + MATCH_MP_TAC(SPEC `k:int` IQ_RB1_RC1_125_PARAMETER_CASES) THEN + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]]; + MATCH_MP_TAC(ISPECL [`n:num`; `A:num->num->int`; `k:int`] + IQ_UNIVERSAL_OF_RB1_RC2_125_CHILD) THEN + REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + MATCH_MP_TAC(ISPECL [`n:num`; `A:num->num->int`; `k:int`] + IQ_RB1_RC2_125_PARAMETER_CASES) THEN + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]]]);; + +let cross125_det = new_definition + `cross125_det (b:int) c k = + &9 * k - (b + c) pow 2 - (&2 * b - c) pow 2`;; + +(* Representatives for Z^2 modulo the Gram matrix [[2,1],[1,5]]. *) +let INT_CROSS125_REMAINDER = prove + (`!b c:int. + ?q r rb rc. + b = &2 * q + r + rb /\ + c = q + &5 * r + rc /\ + ((rb = &0 /\ rc = &0) \/ + (rb = &1 /\ rc = &0) \/ + (rb = &0 /\ rc = -- &1) \/ + (rb = &1 /\ rc = -- &1) \/ + (rb = &0 /\ rc = -- &2) \/ + (rb = &0 /\ rc = &2) \/ + (rb = -- &1 /\ rc = &1) \/ + (rb = &0 /\ rc = &1) \/ + (rb = -- &1 /\ rc = &0))`, + REPEAT GEN_TAC THEN + MP_TAC(SPECL [`b - &2 * c:int`; `&9:int`] INT_DIVISION) THEN + ANTS_TAC THENL [INT_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC)) THEN + ABBREV_TAC `d = (b - &2 * c) div &9` THEN + ABBREV_TAC `e = (b - &2 * c) rem &9` THEN + SUBGOAL_THEN + `b - &2 * c = d * &9 + e /\ &0 <= e /\ e < &9` + STRIP_ASSUME_TAC THENL + [EXPAND_TAC "d" THEN EXPAND_TAC "e" THEN ASM_INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `e = &0 \/ e = &1 \/ e = &2 \/ e = &3 \/ e = &4 \/ + e = &5 \/ e = &6 \/ e = &7 \/ e = &8` + MP_TAC THENL + [ASM_INT_ARITH_TAC; + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THENL + [MAP_EVERY EXISTS_TAC + [`c + &5 * d:int`; `--d:int`; `&0:int`; `&0:int`] THEN + ASM_REWRITE_TAC[] THEN ASM_INT_ARITH_TAC; + MAP_EVERY EXISTS_TAC + [`c + &5 * d:int`; `--d:int`; `&1:int`; `&0:int`] THEN + ASM_REWRITE_TAC[] THEN ASM_INT_ARITH_TAC; + MAP_EVERY EXISTS_TAC + [`c + &1 + &5 * d:int`; `--d:int`; `&0:int`; `-- &1:int`] THEN + ASM_REWRITE_TAC[] THEN ASM_INT_ARITH_TAC; + MAP_EVERY EXISTS_TAC + [`c + &1 + &5 * d:int`; `--d:int`; `&1:int`; `-- &1:int`] THEN + ASM_REWRITE_TAC[] THEN ASM_INT_ARITH_TAC; + MAP_EVERY EXISTS_TAC + [`c + &2 + &5 * d:int`; `--d:int`; `&0:int`; `-- &2:int`] THEN + ASM_REWRITE_TAC[] THEN ASM_INT_ARITH_TAC; + MAP_EVERY EXISTS_TAC + [`c + &3 + &5 * d:int`; `--d - &1:int`; `&0:int`; `&2:int`] THEN + ASM_REWRITE_TAC[] THEN ASM_INT_ARITH_TAC; + MAP_EVERY EXISTS_TAC + [`c + &4 + &5 * d:int`; `--d - &1:int`; `-- &1:int`; `&1:int`] THEN + ASM_REWRITE_TAC[] THEN ASM_INT_ARITH_TAC; + MAP_EVERY EXISTS_TAC + [`c + &4 + &5 * d:int`; `--d - &1:int`; `&0:int`; `&1:int`] THEN + ASM_REWRITE_TAC[] THEN ASM_INT_ARITH_TAC; + MAP_EVERY EXISTS_TAC + [`c + &5 + &5 * d:int`; `--d - &1:int`; `-- &1:int`; `&0:int`] THEN + ASM_REWRITE_TAC[] THEN ASM_INT_ARITH_TAC]]);; + +let iqclear_cross125 = new_definition + `iqclear_cross125 a q r = + iqrows4 + (&1) (&0) (&0) (&0) + (&0) (&1) (&0) (&0) + (&0) (&0) (&1) (&0) + (--a) (--q) (--r) (&1)`;; + +let IQ_EMBEDS_CLEAR_CROSS125 = prove + (`!n A a q r rb rc t. + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) a + (&2) (&1) (&2 * q + r + rb) + (&5) (q + &5 * r + rc) t) A + ==> iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) rb (&5) rc + (t - a pow 2 - + &2 * q pow 2 - &2 * q * r - &5 * r pow 2 - + &2 * q * rb - &2 * r * rc)) A`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(ISPECL + [`n:num`; `4`; + `iqgram 4 + (iqmat4 (&1) (&0) (&0) a + (&2) (&1) (&2 * q + r + rb) + (&5) (q + &5 * r + rc) t) + (iqclear_cross125 a q r)`; + `iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) rb (&5) rc + (t - a pow 2 - + &2 * q pow 2 - &2 * q * r - &5 * r pow 2 - + &2 * q * rb - &2 * r * rc)`; + `A:num->num->int`] IQ_EMBEDS_EQ) THEN + CONJ_TAC THENL + [MATCH_MP_TAC IQ_EMBEDS_CONGRUENCE THEN ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC THEN + (SUBGOAL_THEN `i = 0 \/ i = 1 \/ i = 2 \/ i = 3` MP_TAC THENL + [ASM_ARITH_TAC; ALL_TAC]) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + (SUBGOAL_THEN `j = 0 \/ j = 1 \/ j = 2 \/ j = 3` MP_TAC THENL + [ASM_ARITH_TAC; ALL_TAC]) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + ASM_REWRITE_TAC[iqgram; IQBILIN_MAT4; iqclear_cross125; iqrows4; + iqmat4; iqsym] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC INT_RING]);; + +let IQ_CROSS125_REDUCED_REPRESENTS_7 = prove + (`!a q r rb rc k. + k = &7 - a pow 2 - + &2 * q pow 2 - &2 * q * r - &5 * r pow 2 - + &2 * q * rb - &2 * r * rc + ==> iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) rb (&5) rc k) (&7)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[iq_represents] THEN + EXISTS_TAC + `\i:num. + if i = 0 then (a:int) else if i = 1 then q else + if i = 2 then r else &1` THEN + REWRITE_TAC[IQEVAL_MAT4] THEN + CONV_TAC NUM_REDUCE_CONV THEN + FIRST_X_ASSUM(MP_TAC) THEN CONV_TAC INT_RING);; + +let iqflip_cross125 = new_definition + `iqflip_cross125 = + iqrows4 + (&1) (&0) (&0) (&0) + (&0) (&1) (&0) (&0) + (&0) (&0) (&1) (&0) + (&0) (&0) (&0) (-- &1)`;; + +let IQ_EMBEDS_FLIP_CROSS125 = prove + (`!n A b c k. + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) b (&5) c k) A + ==> iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (--b) (&5) (--c) k) A`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(ISPECL + [`n:num`; `4`; + `iqgram 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) b (&5) c k) + iqflip_cross125`; + `iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (--b) (&5) (--c) k`; + `A:num->num->int`] IQ_EMBEDS_EQ) THEN + CONJ_TAC THENL + [MATCH_MP_TAC IQ_EMBEDS_CONGRUENCE THEN ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC THEN + (SUBGOAL_THEN `i = 0 \/ i = 1 \/ i = 2 \/ i = 3` MP_TAC THENL + [ASM_ARITH_TAC; ALL_TAC]) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + (SUBGOAL_THEN `j = 0 \/ j = 1 \/ j = 2 \/ j = 3` MP_TAC THENL + [ASM_ARITH_TAC; ALL_TAC]) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + ASM_REWRITE_TAC[iqgram; IQBILIN_MAT4; iqflip_cross125; iqrows4; + iqmat4; iqsym] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC INT_RING]);; + +let IQ_REPRESENTS_FLIP_CROSS125 = prove + (`!b c k t. + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) b (&5) c k) t + ==> iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (--b) (&5) (--c) k) t`, + REPEAT GEN_TAC THEN + REWRITE_TAC[iq_represents] THEN + DISCH_THEN(X_CHOOSE_TAC `v:num->int`) THEN + EXISTS_TAC `\i:num. if i = 3 then --(v i) else v i` THEN + FIRST_X_ASSUM(MP_TAC) THEN + REWRITE_TAC[IQEVAL_MAT4] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC INT_RING);; + +let IQ_EMBEDS_REPRESENTS_FLIP_CROSS125 = prove + (`!n A b c k t. + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) b (&5) c k) A /\ + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) b (&5) c k) t + ==> iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (--b) (&5) (--c) k) A /\ + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (--b) (&5) (--c) k) t`, + MESON_TAC[IQ_EMBEDS_FLIP_CROSS125; IQ_REPRESENTS_FLIP_CROSS125]);; + +let IQ_FLIP_CROSS125_02 = prove + (`!n A k t. + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (&0) (&5) (&2) k) A /\ + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (&0) (&5) (&2) k) t + ==> iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (&0) (&5) (-- &2) k) A /\ + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (&0) (&5) (-- &2) k) t`, + REPEAT GEN_TAC THEN + MATCH_ACCEPT_TAC(CONV_RULE INT_REDUCE_CONV + (ISPECL + [`n:num`; `A:num->num->int`; `&0`; `&2`; `k:int`; `t:int`] + IQ_EMBEDS_REPRESENTS_FLIP_CROSS125)));; + +let IQ_FLIP_CROSS125_NEG11 = prove + (`!n A k t. + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (-- &1) (&5) (&1) k) A /\ + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (-- &1) (&5) (&1) k) t + ==> iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (&1) (&5) (-- &1) k) A /\ + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (&1) (&5) (-- &1) k) t`, + REPEAT GEN_TAC THEN + MATCH_ACCEPT_TAC(CONV_RULE INT_REDUCE_CONV + (ISPECL + [`n:num`; `A:num->num->int`; `-- &1`; `&1`; `k:int`; `t:int`] + IQ_EMBEDS_REPRESENTS_FLIP_CROSS125)));; + +let IQ_FLIP_CROSS125_01 = prove + (`!n A k t. + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (&0) (&5) (&1) k) A /\ + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (&0) (&5) (&1) k) t + ==> iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (&0) (&5) (-- &1) k) A /\ + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (&0) (&5) (-- &1) k) t`, + REPEAT GEN_TAC THEN + MATCH_ACCEPT_TAC(CONV_RULE INT_REDUCE_CONV + (ISPECL + [`n:num`; `A:num->num->int`; `&0`; `&1`; `k:int`; `t:int`] + IQ_EMBEDS_REPRESENTS_FLIP_CROSS125)));; + +let IQ_FLIP_CROSS125_NEG10 = prove + (`!n A k t. + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (-- &1) (&5) (&0) k) A /\ + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (-- &1) (&5) (&0) k) t + ==> iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (&1) (&5) (&0) k) A /\ + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (&1) (&5) (&0) k) t`, + REPEAT GEN_TAC THEN + MATCH_ACCEPT_TAC(CONV_RULE INT_REDUCE_CONV + (ISPECL + [`n:num`; `A:num->num->int`; `-- &1`; `&0`; `k:int`; `t:int`] + IQ_EMBEDS_REPRESENTS_FLIP_CROSS125)));; + +let IQ_EMBEDS_QUATERNARY_CROSS125_RAW = prove + (`!n A. + iq_symmetric n A /\ iq_positive n A /\ + iq_embeds n 3 + (iqmat3 (&1) (&0) (&0) (&2) (&1) (&5)) A /\ + iq_represents n A (&7) + ==> ?rb rc k. + ((rb = &0 /\ rc = &0) \/ + (rb = &1 /\ rc = &0) \/ + (rb = &0 /\ rc = -- &1) \/ + (rb = &1 /\ rc = -- &1) \/ + (rb = &0 /\ rc = -- &2) \/ + (rb = &0 /\ rc = &2) \/ + (rb = -- &1 /\ rc = &1) \/ + (rb = &0 /\ rc = &1) \/ + (rb = -- &1 /\ rc = &0)) /\ + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) rb (&5) rc k) A /\ + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) rb (&5) rc k) (&7)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(SPECL + [`n:num`; `A:num->num->int`; + `&1:int`; `&0:int`; `&0:int`; `&2:int`; `&1:int`; `&5:int`; + `&7:int`] IQ_ESCALATE_MAT3) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `a:int` + (X_CHOOSE_THEN `b:int` + (X_CHOOSE_THEN `c:int` STRIP_ASSUME_TAC))) THEN + MP_TAC(SPECL [`b:int`; `c:int`] INT_CROSS125_REMAINDER) THEN + DISCH_THEN(X_CHOOSE_THEN `q:int` + (X_CHOOSE_THEN `r:int` + (X_CHOOSE_THEN `rb:int` + (X_CHOOSE_THEN `rc:int` + (CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC)))))) THEN + let kval = + `&7 - a pow 2 - + &2 * q pow 2 - &2 * q * r - &5 * r pow 2 - + &2 * q * rb - &2 * r * rc` in + let source_emb = REWRITE_RULE + [ASSUME `b = &2 * q + r + rb`; + ASSUME `c = q + &5 * r + rc`] + (ASSUME + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) a + (&2) (&1) b (&5) c (&7)) A`) in + let emb = MATCH_MP + (ISPECL + [`n:num`; `A:num->num->int`; `a:int`; `q:int`; `r:int`; + `rb:int`; `rc:int`; `&7:int`] IQ_EMBEDS_CLEAR_CROSS125) + source_emb in + let rep7 = MATCH_MP + (SPECL + [`a:int`; `q:int`; `r:int`; `rb:int`; `rc:int`; kval] + IQ_CROSS125_REDUCED_REPRESENTS_7) + (REFL kval) in + MAP_EVERY EXISTS_TAC [`rb:int`; `rc:int`; kval] THEN + ACCEPT_TAC + (CONJ + (ASSUME + `(rb = &0 /\ rc = &0) \/ + (rb = &1 /\ rc = &0) \/ + (rb = &0 /\ rc = -- &1) \/ + (rb = &1 /\ rc = -- &1) \/ + (rb = &0 /\ rc = -- &2) \/ + (rb = &0 /\ rc = &2) \/ + (rb = -- &1 /\ rc = &1) \/ + (rb = &0 /\ rc = &1) \/ + (rb = -- &1 /\ rc = &0)`) + (CONJ emb rep7)));; + +let IQ_EMBEDS_QUATERNARY_CROSS125 = prove + (`!n A. + iq_symmetric n A /\ iq_positive n A /\ + iq_embeds n 3 + (iqmat3 (&1) (&0) (&0) (&2) (&1) (&5)) A /\ + iq_represents n A (&7) + ==> (?k. + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (&0) (&5) (&0) k) A /\ + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (&0) (&5) (&0) k) (&7)) \/ + (?k. + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (&1) (&5) (&0) k) A /\ + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (&1) (&5) (&0) k) (&7)) \/ + (?k. + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (&0) (&5) (-- &1) k) A /\ + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (&0) (&5) (-- &1) k) (&7)) \/ + (?k. + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (&1) (&5) (-- &1) k) A /\ + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (&1) (&5) (-- &1) k) (&7)) \/ + (?k. + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (&0) (&5) (-- &2) k) A /\ + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (&0) (&5) (-- &2) k) (&7))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(SPECL [`n:num`; `A:num->num->int`] + IQ_EMBEDS_QUATERNARY_CROSS125_RAW) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `rb:int` + (X_CHOOSE_THEN `rc:int` + (X_CHOOSE_THEN `k:int` + (CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC))))) THEN + UNDISCH_TAC + `(rb = &0 /\ rc = &0) \/ + (rb = &1 /\ rc = &0) \/ + (rb = &0 /\ rc = -- &1) \/ + (rb = &1 /\ rc = -- &1) \/ + (rb = &0 /\ rc = -- &2) \/ + (rb = &0 /\ rc = &2) \/ + (rb = -- &1 /\ rc = &1) \/ + (rb = &0 /\ rc = &1) \/ + (rb = -- &1 /\ rc = &0)` THEN + ASM_MESON_TAC + [IQ_FLIP_CROSS125_02; IQ_FLIP_CROSS125_NEG11; + IQ_FLIP_CROSS125_01; IQ_FLIP_CROSS125_NEG10]);; + +(* The crossed ternary form is the index-three subform + + x^2 + (y + 2z)^2 + (y - z)^2. + + Completing the two displayed squares gives the determinant identity used + in Bhargava's subtraction argument. *) +let INT_CROSS125_CHILD_DET_IDENTITY = prove + (`!b c k x y z w:int. + &9 * + (x pow 2 + &2 * y pow 2 + &2 * y * z + &5 * z pow 2 + + &2 * b * y * w + &2 * c * z * w + k * w pow 2) = + (&3 * x) pow 2 + + (&3 * (y + &2 * z) + (b + c) * w) pow 2 + + (&3 * (y - z) + (&2 * b - c) * w) pow 2 + + cross125_det b c k * w pow 2`, + REPEAT GEN_TAC THEN REWRITE_TAC[cross125_det] THEN CONV_TAC INT_RING);; + +let INT_THREE_SQUARES_7MOD8_CORE = prove + (`!a b c:int. + (a = &0 \/ a = &1 \/ a = &4) /\ + (b = &0 \/ b = &1 \/ b = &4) /\ + (c = &0 \/ c = &1 \/ c = &4) /\ + (a + b + c) rem &8 = &7 + ==> F`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + POP_ASSUM MP_TAC THEN ASM_REWRITE_TAC[] THEN + CONV_TAC INT_REDUCE_CONV);; + +let INT_THREE_SQUARES_NOT_7MOD8 = prove + (`!x y z q:int. + ~(x pow 2 + y pow 2 + z pow 2 = &8 * q + &7)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(SPECL + [`x pow 2 rem &8`; `y pow 2 rem &8`; `z pow 2 rem &8`] + INT_THREE_SQUARES_7MOD8_CORE) THEN + REWRITE_TAC[SQ_MOD_8] THEN + SUBGOAL_THEN + `(x pow 2 rem &8 + y pow 2 rem &8 + z pow 2 rem &8) rem &8 = + (x pow 2 + y pow 2 + z pow 2) rem &8` + SUBST1_TAC THENL + [CONV_TAC INT_REM_DOWN_CONV THEN REFL_TAC; + ASM_REWRITE_TAC[INT_REM_MUL_ADD] THEN CONV_TAC INT_REDUCE_CONV]);; + +let INT_CROSS125_NOT_7 = prove + (`!x y z:int. + ~(x pow 2 + &2 * y pow 2 + &2 * y * z + &5 * z pow 2 = &7)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MP_TAC(SPECL [`x:int`; `y + &2 * z:int`; `y - z:int`; `&0:int`] + INT_THREE_SQUARES_NOT_7MOD8) THEN + FIRST_X_ASSUM(MP_TAC) THEN CONV_TAC INT_RING);; + +let IQ_CROSS125_DET_NONZERO_OF_REPRESENTS_7 = prove + (`!b c k:int. + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) b (&5) c k) (&7) + ==> ~(cross125_det b c k = &0)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[iq_represents] THEN + DISCH_THEN(X_CHOOSE_THEN `v:num->int` (LABEL_TAC "rep")) THEN + DISCH_THEN(LABEL_TAC "det0") THEN + SUBGOAL_THEN + `(&3 * v 0) pow 2 + + (&3 * (v 1 + &2 * v 2) + (b + c) * v 3) pow 2 + + (&3 * (v 1 - v 2) + (&2 * b - c) * v 3) pow 2 = + &8 * &7 + &7` + ASSUME_TAC THENL + [MP_TAC(SPECL + [`b:int`; `c:int`; `k:int`; `v 0:int`; `v 1:int`; + `v 2:int`; `v 3:int`] INT_CROSS125_CHILD_DET_IDENTITY) THEN + REMOVE_THEN "rep" MP_TAC THEN + REWRITE_TAC[IQEVAL_MAT4] THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC INT_RING; + MP_TAC(SPECL + [`&3 * v 0:int`; + `&3 * (v 1 + &2 * v 2) + (b + c) * v 3:int`; + `&3 * (v 1 - v 2) + (&2 * b - c) * v 3:int`; + `&7:int`] INT_THREE_SQUARES_NOT_7MOD8) THEN + ASM_REWRITE_TAC[]]);; + +let IQ_CROSS125_DET_NOT_DIV8_OF_REPRESENTS_7 = prove + (`!b c k:int. + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) b (&5) c k) (&7) + ==> ~(&8 divides cross125_det b c k)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[iq_represents] THEN + DISCH_THEN(X_CHOOSE_THEN `v:num->int` (LABEL_TAC "rep")) THEN + REWRITE_TAC[int_divides] THEN + DISCH_THEN(X_CHOOSE_THEN `d:int` (LABEL_TAC "detdiv")) THEN + SUBGOAL_THEN + `(&3 * v 0) pow 2 + + (&3 * (v 1 + &2 * v 2) + (b + c) * v 3) pow 2 + + (&3 * (v 1 - v 2) + (&2 * b - c) * v 3) pow 2 = + &8 * (&7 - d * v 3 pow 2) + &7` + ASSUME_TAC THENL + [MP_TAC(SPECL + [`b:int`; `c:int`; `k:int`; `v 0:int`; `v 1:int`; + `v 2:int`; `v 3:int`] INT_CROSS125_CHILD_DET_IDENTITY) THEN + REMOVE_THEN "rep" MP_TAC THEN + REWRITE_TAC[IQEVAL_MAT4] THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC INT_RING; + MP_TAC(SPECL + [`&3 * v 0:int`; + `&3 * (v 1 + &2 * v 2) + (b + c) * v 3:int`; + `&3 * (v 1 - v 2) + (&2 * b - c) * v 3:int`; + `(&7:int) - d * v 3 pow 2`] INT_THREE_SQUARES_NOT_7MOD8) THEN + ASM_REWRITE_TAC[]]);; + +let INT_CROSS125_ORTHOGONAL_VALUE = prove + (`!b c k:int. + &2 * (--(&5 * b - c)) pow 2 + + &2 * (--(&5 * b - c)) * (b - &2 * c) + + &2 * b * (--(&5 * b - c)) * &9 + + &5 * (b - &2 * c) pow 2 + + &2 * c * (b - &2 * c) * &9 + + k * &81 = + &9 * cross125_det b c k`, + REPEAT GEN_TAC THEN REWRITE_TAC[cross125_det] THEN CONV_TAC INT_RING);; + +let IQ_CROSS125_DET_NONNEG = prove + (`!n A b c k. + iq_positive n A /\ + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) b (&5) c k) A + ==> &0 <= cross125_det b c k`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(MATCH_MP + (ISPECL + [`n:num`; `4`; + `iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) b (&5) c k`; + `A:num->num->int`] IQ_EMBEDDED_NONNEG) + (CONJ + (ASSUME `iq_positive n A`) + (ASSUME + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) b (&5) c k) A`))) THEN + DISCH_THEN(MP_TAC o SPEC + `\i:num. + if i = 1 then --(&5 * b - c) else + if i = 2 then b - &2 * c else + if i = 3 then &9 else &0`) THEN + REWRITE_TAC[IQEVAL_MAT4] THEN + CONV_TAC NUM_REDUCE_CONV THEN + SIMP_TAC[INT_MUL_LZERO; INT_MUL_RZERO; INT_ADD_LID; INT_ADD_RID; + INT_MUL_LID; INT_MUL_RID] THEN + CONV_TAC INT_REDUCE_CONV THEN + DISCH_TAC THEN + MP_TAC(SPECL [`b:int`; `c:int`; `k:int`] + INT_CROSS125_ORTHOGONAL_VALUE) THEN + ASM_INT_ARITH_TAC);; + +let IQ_CROSS125_DET_POSITIVE = prove + (`!n A b c k. + iq_positive n A /\ + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) b (&5) c k) A /\ + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) b (&5) c k) (&7) + ==> &0 < cross125_det b c k`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(MATCH_MP + (ISPECL [`n:num`; `A:num->num->int`; `b:int`; `c:int`; `k:int`] + IQ_CROSS125_DET_NONNEG) + (CONJ + (ASSUME `iq_positive n A`) + (ASSUME + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) b (&5) c k) A`))) THEN + MP_TAC(MATCH_MP + (SPECL [`b:int`; `c:int`; `k:int`] + IQ_CROSS125_DET_NONZERO_OF_REPRESENTS_7) + (ASSUME + `iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) b (&5) c k) (&7)`)) THEN + INT_ARITH_TAC);; + +let IQ_CROSS125_DET_LE_63 = prove + (`!n A b c k. + iq_positive n A /\ + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) b (&5) c k) A /\ + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) b (&5) c k) (&7) + ==> cross125_det b c k <= &63`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "pos") + (CONJUNCTS_THEN2 (LABEL_TAC "emb") (LABEL_TAC "rep7"))) THEN + SUBGOAL_THEN `&0 < cross125_det b c k` ASSUME_TAC THENL + [MATCH_MP_TAC(ISPECL + [`n:num`; `A:num->num->int`; `b:int`; `c:int`; `k:int`] + IQ_CROSS125_DET_POSITIVE) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MP_TAC(ASSUME + `iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) b (&5) c k) (&7)`) THEN + REWRITE_TAC[iq_represents] THEN + DISCH_THEN(X_CHOOSE_THEN `v:num->int` (LABEL_TAC "rep")) THEN + SUBGOAL_THEN `~(v 3 = &0)` ASSUME_TAC THENL + [DISCH_TAC THEN + MP_TAC(SPECL [`v 0:int`; `v 1:int`; `v 2:int`] + INT_CROSS125_NOT_7) THEN + REMOVE_THEN "rep" MP_TAC THEN + REWRITE_TAC[IQEVAL_MAT4] THEN ASM_REWRITE_TAC[] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC INT_RING; + ALL_TAC] THEN + SUBGOAL_THEN + `cross125_det b c k <= cross125_det b c k * v 3 pow 2` + ASSUME_TAC THENL + [GEN_REWRITE_TAC (LAND_CONV) [GSYM INT_MUL_RID] THEN + MATCH_MP_TAC INT_LE_LMUL THEN + CONJ_TAC THENL [ASM_INT_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[INT_ARITH `&1 <= x <=> &0 < x`] THEN + ASM_SIMP_TAC[INT_LT_POW_2]; + ALL_TAC] THEN + SUBGOAL_THEN `cross125_det b c k * v 3 pow 2 <= &63` + ASSUME_TAC THENL + [MP_TAC(SPECL + [`b:int`; `c:int`; `k:int`; `v 0:int`; `v 1:int`; + `v 2:int`; `v 3:int`] INT_CROSS125_CHILD_DET_IDENTITY) THEN + MP_TAC(ASSUME + `iqeval 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) b (&5) c k) v = &7`) THEN + REWRITE_TAC[IQEVAL_MAT4] THEN CONV_TAC NUM_REDUCE_CONV THEN + MP_TAC(ISPEC `&3 * v 0:int` INT_LE_POW_2) THEN + MP_TAC(ISPEC + `&3 * (v 1 + &2 * v 2) + (b + c) * v 3:int` + INT_LE_POW_2) THEN + MP_TAC(ISPEC + `&3 * (v 1 - v 2) + (&2 * b - c) * v 3:int` + INT_LE_POW_2) THEN + INT_ARITH_TAC; + ASM_INT_ARITH_TAC]);; + +let INT_CROSS125_1_NEG1_8_NOT_7 = prove + (`!x y z w:int. + ~(x pow 2 + &2 * y pow 2 + &2 * y * z + &5 * z pow 2 + + &2 * y * w - &2 * z * w + &8 * w pow 2 = &7)`, + REPEAT GEN_TAC THEN DISCH_THEN(LABEL_TAC "rep") THEN + ASM_CASES_TAC `w = &0` THENL + [MP_TAC(SPECL [`x:int`; `y:int`; `z:int`] INT_CROSS125_NOT_7) THEN + REMOVE_THEN "rep" MP_TAC THEN ASM_REWRITE_TAC[] THEN + CONV_TAC INT_RING; + ALL_TAC] THEN + SUBGOAL_THEN `&1 <= w pow 2` ASSUME_TAC THENL + [REWRITE_TAC[INT_ARITH `&1 <= q <=> &0 < q`] THEN + ASM_SIMP_TAC[INT_LT_POW_2]; + ALL_TAC] THEN + SUBGOAL_THEN + `(&3 * x) pow 2 + (&3 * (y + &2 * z)) pow 2 + + (&3 * (y - z) + &3 * w) pow 2 + &63 * w pow 2 = &63` + ASSUME_TAC THENL + [MP_TAC(SPECL + [`&1:int`; `-- &1:int`; `&8:int`; `x:int`; `y:int`; `z:int`; + `w:int`] INT_CROSS125_CHILD_DET_IDENTITY) THEN + REMOVE_THEN "rep" MP_TAC THEN + REWRITE_TAC[cross125_det] THEN CONV_TAC INT_REDUCE_CONV THEN + CONV_TAC INT_RING; + ALL_TAC] THEN + SUBGOAL_THEN + `&0 <= (&3 * x) pow 2 /\ + &0 <= (&3 * (y + &2 * z)) pow 2 /\ + &0 <= (&3 * (y - z) + &3 * w) pow 2` + STRIP_ASSUME_TAC THENL + [REWRITE_TAC[INT_LE_POW_2]; + ALL_TAC] THEN + SUBGOAL_THEN `(&3 * (y + &2 * z)) pow 2 = &0` ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `(&3 * (y - z) + &3 * w) pow 2 = &0` ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `w pow 2 = &1` ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `y + &2 * z = &0` ASSUME_TAC THENL + [MP_TAC(ASSUME `(&3 * (y + &2 * z)) pow 2 = &0`) THEN + REWRITE_TAC[INT_POW_EQ_0] THEN CONV_TAC NUM_REDUCE_CONV THEN + INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `y - z + w = &0` ASSUME_TAC THENL + [MP_TAC(ASSUME `(&3 * (y - z) + &3 * w) pow 2 = &0`) THEN + REWRITE_TAC[INT_POW_EQ_0] THEN CONV_TAC NUM_REDUCE_CONV THEN + INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `w = &3 * z` ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; + MP_TAC(MATCH_MP INT_SQ_LE_2_CASES + (MATCH_MP (INT_ARITH `w pow 2 = &1 ==> w pow 2 <= &2`) + (ASSUME `w pow 2 = &1`))) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + (ASM_CASES_TAC `z = &0` THENL + [ASM_INT_ARITH_TAC; + SUBGOAL_THEN `z < &0 \/ &0 < z` MP_TAC THENL + [ASM_INT_ARITH_TAC; + DISCH_THEN(DISJ_CASES_THEN ASSUME_TAC) THEN + ASM_INT_ARITH_TAC]])]);; + +let IQ_CROSS125_1_NEG1_8_NOT_REPRESENTS_7 = prove + (`~iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (&1) (&5) (-- &1) (&8)) (&7)`, + REWRITE_TAC[iq_represents] THEN + DISCH_THEN(X_CHOOSE_THEN `v:num->int` (LABEL_TAC "rep")) THEN + MP_TAC(SPECL [`v 0:int`; `v 1:int`; `v 2:int`; `v 3:int`] + INT_CROSS125_1_NEG1_8_NOT_7) THEN + REMOVE_THEN "rep" MP_TAC THEN + REWRITE_TAC[IQEVAL_MAT4] THEN CONV_TAC NUM_REDUCE_CONV THEN + CONV_TAC INT_RING);; + +let IQ_CROSS125_DET_CONSTRAINTS = prove + (`!n A b c k. + iq_positive n A /\ + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) b (&5) c k) A /\ + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) b (&5) c k) (&7) + ==> &0 < cross125_det b c k /\ + cross125_det b c k <= &63 /\ + ~(&8 divides cross125_det b c k)`, + MESON_TAC[IQ_CROSS125_DET_POSITIVE; IQ_CROSS125_DET_LE_63; + IQ_CROSS125_DET_NOT_DIV8_OF_REPRESENTS_7]);; + +let IQ_CROSS125_00_PARAMETER_CASES = prove + (`!n A k. + iq_positive n A /\ + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (&0) (&5) (&0) k) A /\ + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (&0) (&5) (&0) k) (&7) + ==> k = &1 \/ k = &2 \/ k = &3 \/ k = &4 \/ + k = &5 \/ k = &6 \/ k = &7`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(ISPECL [`n:num`; `A:num->num->int`; `&0`; `&0`; `k:int`] + IQ_CROSS125_DET_CONSTRAINTS) THEN + ASM_REWRITE_TAC[cross125_det] THEN CONV_TAC INT_REDUCE_CONV THEN + STRIP_TAC THEN ASM_INT_ARITH_TAC);; + +let IQ_CROSS125_10_PARAMETER_CASES = prove + (`!n A k. + iq_positive n A /\ + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (&1) (&5) (&0) k) A /\ + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (&1) (&5) (&0) k) (&7) + ==> k = &1 \/ k = &2 \/ k = &3 \/ k = &4 \/ + k = &6 \/ k = &7`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(ISPECL [`n:num`; `A:num->num->int`; `&1`; `&0`; `k:int`] + IQ_CROSS125_DET_CONSTRAINTS) THEN + ASM_REWRITE_TAC[cross125_det] THEN CONV_TAC INT_REDUCE_CONV THEN + STRIP_TAC THEN + SUBGOAL_THEN + `k = &1 \/ k = &2 \/ k = &3 \/ k = &4 \/ + k = &5 \/ k = &6 \/ k = &7` + MP_TAC THENL + [ASM_INT_ARITH_TAC; + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(prove + (`(&8:int) divides &9 * &5 - &1 - &4`, + REWRITE_TAC[int_divides] THEN EXISTS_TAC `&5:int` THEN + INT_ARITH_TAC)) THEN + ASM_REWRITE_TAC[]]);; + +let IQ_CROSS125_0_NEG1_PARAMETER_CASES = prove + (`!n A k. + iq_positive n A /\ + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (&0) (&5) (-- &1) k) A /\ + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (&0) (&5) (-- &1) k) (&7) + ==> k = &1 \/ k = &3 \/ k = &4 \/ k = &5 \/ + k = &6 \/ k = &7`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(ISPECL [`n:num`; `A:num->num->int`; `&0`; `-- &1`; `k:int`] + IQ_CROSS125_DET_CONSTRAINTS) THEN + ASM_REWRITE_TAC[cross125_det] THEN CONV_TAC INT_REDUCE_CONV THEN + STRIP_TAC THEN + SUBGOAL_THEN + `k = &1 \/ k = &2 \/ k = &3 \/ k = &4 \/ + k = &5 \/ k = &6 \/ k = &7` + MP_TAC THENL + [ASM_INT_ARITH_TAC; + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(prove + (`(&8:int) divides &9 * &2 - &1 - &1`, + REWRITE_TAC[int_divides] THEN EXISTS_TAC `&2:int` THEN + INT_ARITH_TAC)) THEN + ASM_REWRITE_TAC[]]);; + +let IQ_CROSS125_1_NEG1_PARAMETER_CASES = prove + (`!n A k. + iq_positive n A /\ + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (&1) (&5) (-- &1) k) A /\ + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (&1) (&5) (-- &1) k) (&7) + ==> k = &2 \/ k = &3 \/ k = &4 \/ k = &5 \/ + k = &6 \/ k = &7`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(ISPECL [`n:num`; `A:num->num->int`; `&1`; `-- &1`; `k:int`] + IQ_CROSS125_DET_CONSTRAINTS) THEN + ASM_REWRITE_TAC[cross125_det] THEN CONV_TAC INT_REDUCE_CONV THEN + STRIP_TAC THEN + SUBGOAL_THEN + `k = &2 \/ k = &3 \/ k = &4 \/ k = &5 \/ + k = &6 \/ k = &7 \/ k = &8` + MP_TAC THENL + [ASM_INT_ARITH_TAC; + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + ASM_REWRITE_TAC[] THEN + MP_TAC IQ_CROSS125_1_NEG1_8_NOT_REPRESENTS_7 THEN + ASM_REWRITE_TAC[]]);; + +let IQ_CROSS125_0_NEG2_PARAMETER_CASES = prove + (`!n A k. + iq_positive n A /\ + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (&0) (&5) (-- &2) k) A /\ + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (&0) (&5) (-- &2) k) (&7) + ==> k = &1 \/ k = &2 \/ k = &3 \/ k = &4 \/ + k = &5 \/ k = &6 \/ k = &7`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(ISPECL [`n:num`; `A:num->num->int`; `&0`; `-- &2`; `k:int`] + IQ_CROSS125_DET_CONSTRAINTS) THEN + ASM_REWRITE_TAC[cross125_det] THEN CONV_TAC INT_REDUCE_CONV THEN + STRIP_TAC THEN ASM_INT_ARITH_TAC);; + +(* Multiplying the last coordinate by 9 clears the index-three denominator + in the orthogonal complement. *) +let INT_CROSS125_CHILD_SHIFT9 = prove + (`!b c k s x y z:int. + x pow 2 + + &2 * (y - (&5 * b - c) * s) pow 2 + + &2 * (y - (&5 * b - c) * s) * + (z + (b - &2 * c) * s) + + &5 * (z + (b - &2 * c) * s) pow 2 + + &2 * b * (y - (&5 * b - c) * s) * (&9 * s) + + &2 * c * (z + (b - &2 * c) * s) * (&9 * s) + + k * (&9 * s) pow 2 = + x pow 2 + &2 * y pow 2 + &2 * y * z + &5 * z pow 2 + + &9 * cross125_det b c k * s pow 2`, + REPEAT GEN_TAC THEN REWRITE_TAC[cross125_det] THEN CONV_TAC INT_RING);; + +let INT_REPRESENTS_CROSS125_CHILD_SHIFT9 = prove + (`!b c k s n:int. + (?x y z:int. + x pow 2 + &2 * y pow 2 + &2 * y * z + &5 * z pow 2 = + n - &9 * cross125_det b c k * s pow 2) + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &2 * y * z + &5 * z pow 2 + + &2 * b * y * w + &2 * c * z * w + k * w pow 2 = n`, + REPEAT GEN_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` (X_CHOOSE_TAC `z:int`))) THEN + MAP_EVERY EXISTS_TAC + [`x:int`; + `y - (&5 * b - c) * s:int`; + `z + (b - &2 * c) * s:int`; + `&9 * s:int`] THEN + MP_TAC(SPECL + [`b:int`; `c:int`; `k:int`; `s:int`; `x:int`; `y:int`; `z:int`] + INT_CROSS125_CHILD_SHIFT9) THEN + FIRST_X_ASSUM(MP_TAC) THEN INT_ARITH_TAC);; + +let INT_REPRESENTS_CROSS125_CHILD_SCALE4 = prove + (`!b c k n:int. + (?x y z w:int. + x pow 2 + &2 * y pow 2 + &2 * y * z + &5 * z pow 2 + + &2 * b * y * w + &2 * c * z * w + k * w pow 2 = n) + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &2 * y * z + &5 * z pow 2 + + &2 * b * y * w + &2 * c * z * w + k * w pow 2 = &4 * n`, + REPEAT GEN_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` + (X_CHOOSE_THEN `z:int` (X_CHOOSE_TAC `w:int`)))) THEN + MAP_EVERY EXISTS_TAC + [`&2 * x:int`; `&2 * y:int`; `&2 * z:int`; `&2 * w:int`] THEN + FIRST_X_ASSUM(MP_TAC) THEN CONV_TAC INT_RING);; + +(* ------------------------------------------------------------------------- *) +(* A generic almost-universality descent for the 32 admissible children. *) +(* ------------------------------------------------------------------------- *) + +let cross125_child_rep = new_definition + `cross125_child_rep (b:int) c k (n:num) <=> + ?x y z w:int. + x pow 2 + &2 * y pow 2 + &2 * y * z + &5 * z pow 2 + + &2 * b * y * w + &2 * c * z * w + k * w pow 2 = &n`;; + +let CROSS125_CHILD_REP_SCALE4 = prove + (`!b c k n. + cross125_child_rep b c k n + ==> cross125_child_rep b c k (4 * n)`, + REPEAT GEN_TAC THEN REWRITE_TAC[cross125_child_rep] THEN + DISCH_TAC THEN + MP_TAC(MATCH_MP + (SPECL [`b:int`; `c:int`; `k:int`; `&n:int`] + INT_REPRESENTS_CROSS125_CHILD_SCALE4) + (ASSUME + `?x y z w:int. + x pow 2 + &2 * y pow 2 + &2 * y * z + &5 * z pow 2 + + &2 * b * y * w + &2 * c * z * w + k * w pow 2 = &n`)) THEN + REWRITE_TAC[GSYM INT_OF_NUM_MUL]);; + +let CROSS125_CHILD_REP_REGULAR = prove + (`!b c k n. + ~(?a m. n = 4 EXP a * (8 * m + 7)) + ==> cross125_child_rep b c k n`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[cross125_child_rep] THEN + MP_TAC(MATCH_MP + (SPEC `n:num` INT_REPRESENTS_CROSS125_OF_LEGENDRE) + (ASSUME `~(?a m. n = 4 EXP a * (8 * m + 7))`)) THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` (X_CHOOSE_TAC `z:int`))) THEN + MAP_EVERY EXISTS_TAC [`x:int`; `y:int`; `z:int`; `&0:int`] THEN + FIRST_X_ASSUM(MP_TAC) THEN CONV_TAC INT_RING);; + +let NUM_CROSS125_SUB_AVOIDS = prove + (`!n c:num. + c <= n /\ n MOD 8 = 7 /\ + (c MOD 8 = 2 \/ c MOD 8 = 4 \/ c MOD 8 = 6) + ==> ~(?a m. n - c = 4 EXP a * (8 * m + 7))`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC)) THEN + MATCH_MP_TAC(SPEC `n - c:num` THREE_SQUARES_AVOIDS_OF_MOD) THEN + MP_TAC(MATCH_MP (SPECL [`n:num`; `8`; `7`] NUM_DECOMPOSE_MOD) + (CONJ (ARITH_RULE `~(8 = 0)`) (ASSUME `n MOD 8 = 7`))) THEN + DISCH_THEN(X_CHOOSE_THEN `qn:num` SUBST_ALL_TAC) THEN + UNDISCH_TAC `c MOD 8 = 2 \/ c MOD 8 = 4 \/ c MOD 8 = 6` THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THENL + [MP_TAC(MATCH_MP (SPECL [`c:num`; `8`; `2`] NUM_DECOMPOSE_MOD) + (CONJ (ARITH_RULE `~(8 = 0)`) (ASSUME `c MOD 8 = 2`))); + MP_TAC(MATCH_MP (SPECL [`c:num`; `8`; `4`] NUM_DECOMPOSE_MOD) + (CONJ (ARITH_RULE `~(8 = 0)`) (ASSUME `c MOD 8 = 4`))); + MP_TAC(MATCH_MP (SPECL [`c:num`; `8`; `6`] NUM_DECOMPOSE_MOD) + (CONJ (ARITH_RULE `~(8 = 0)`) (ASSUME `c MOD 8 = 6`)))] THEN + DISCH_THEN(X_CHOOSE_THEN `qc:num` SUBST_ALL_TAC) THENL + [SUBGOAL_THEN + `(8 * qn + 7) - (8 * qc + 2) = 8 * (qn - qc) + 5` + SUBST1_TAC THENL [ASM_ARITH_TAC; ALL_TAC]; + SUBGOAL_THEN + `(8 * qn + 7) - (8 * qc + 4) = 8 * (qn - qc) + 3` + SUBST1_TAC THENL [ASM_ARITH_TAC; ALL_TAC]; + SUBGOAL_THEN + `(8 * qn + 7) - (8 * qc + 6) = 8 * (qn - qc) + 1` + SUBST1_TAC THENL [ASM_ARITH_TAC; ALL_TAC]] THEN + (CONJ_TAC THENL + [REWRITE_TAC + [ARITH_RULE `8*q+r = 4*(2*q)+r`; MOD_MULT_ADD] THEN + CONV_TAC NUM_REDUCE_CONV; + REWRITE_TAC[MOD_MULT_ADD] THEN CONV_TAC NUM_REDUCE_CONV]));; + +let INT_CROSS125_OFFSET_COERCE = prove + (`!n d s:num. + 9 * d * s EXP 2 <= n + ==> &(n - 9 * d * s EXP 2) = + (&n:int) - &9 * &d * (&s:int) pow 2`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `(&n:int) - &(9 * d * s EXP 2)` THEN + CONJ_TAC THENL + [MATCH_ACCEPT_TAC(SYM(MATCH_MP + (SPECL [`9 * d * s EXP 2`; `n:num`] INT_OF_NUM_SUB) + (ASSUME `9 * d * s EXP 2 <= n`))); + REWRITE_TAC[INT_OF_NUM_MUL; INT_OF_NUM_POW] THEN + CONV_TAC INT_RING]);; + +let INT_CROSS125_CHILD_OFFSET_COERCE = prove + (`!b c k n d s. + cross125_det b c k = &d /\ 9 * d * s EXP 2 <= n + ==> &(n - 9 * d * s EXP 2) = + (&n:int) - &9 * cross125_det b c k * (&s:int) pow 2`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(MATCH_MP + (SPECL [`n:num`; `d:num`; `s:num`] INT_CROSS125_OFFSET_COERCE) + (ASSUME `9 * d * s EXP 2 <= n`)) THEN + ASM_REWRITE_TAC[]);; + +let CROSS125_CHILD_REP_RESIDUE7 = prove + (`!b c k d s. + cross125_det b c k = &d /\ 0 < d /\ + ((9 * d * s EXP 2) MOD 8 = 2 \/ + (9 * d * s EXP 2) MOD 8 = 4 \/ + (9 * d * s EXP 2) MOD 8 = 6) /\ + (!q:num. + 8 * q + 7 < 9 * d * s EXP 2 /\ ~(q = 1) + ==> cross125_child_rep b c k (8 * q + 7)) + ==> !n:num. + 0 < n /\ n MOD 8 = 7 /\ ~(n = 15) + ==> cross125_child_rep b c k n`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "det") + (CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 (LABEL_TAC "offsetmod") (LABEL_TAC "base")))) THEN + X_GEN_TAC `n:num` THEN STRIP_TAC THEN + MP_TAC(MATCH_MP (SPECL [`n:num`; `8`; `7`] NUM_DECOMPOSE_MOD) + (CONJ (ARITH_RULE `~(8 = 0)`) (ASSUME `n MOD 8 = 7`))) THEN + DISCH_THEN(X_CHOOSE_THEN `q:num` SUBST_ALL_TAC) THEN + SUBGOAL_THEN `~(q = 1)` ASSUME_TAC THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + ASM_CASES_TAC `8 * q + 7 < 9 * d * s EXP 2` THENL + [REMOVE_THEN "base" (MATCH_MP_TAC o SPEC `q:num`) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `9 * d * s EXP 2 <= 8 * q + 7` ASSUME_TAC THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[cross125_child_rep] THEN + MATCH_MP_TAC(SPECL + [`b:int`; `c:int`; `k:int`; `&s:int`; `&(8 * q + 7):int`] + INT_REPRESENTS_CROSS125_CHILD_SHIFT9) THEN + SUBGOAL_THEN + `~(?a m. + (8 * q + 7) - 9 * d * s EXP 2 = 4 EXP a * (8 * m + 7))` + ASSUME_TAC THENL + [MATCH_MP_TAC(SPECL [`8 * q + 7`; `9 * d * s EXP 2`] + NUM_CROSS125_SUB_AVOIDS) THEN + REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + REWRITE_TAC[MOD_MULT_ADD] THEN CONV_TAC NUM_REDUCE_CONV; + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + MP_TAC(MATCH_MP + (SPEC `(8 * q + 7) - 9 * d * s EXP 2` + INT_REPRESENTS_CROSS125_OF_LEGENDRE) + (ASSUME + `~(?a m. + (8 * q + 7) - 9 * d * s EXP 2 = + 4 EXP a * (8 * m + 7))`)) THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` + (X_CHOOSE_THEN `z:int` (LABEL_TAC "tern")))) THEN + MAP_EVERY EXISTS_TAC [`x:int`; `y:int`; `z:int`] THEN + MP_TAC(MATCH_MP + (SPECL + [`b:int`; `c:int`; `k:int`; `8 * q + 7`; `d:num`; `s:num`] + INT_CROSS125_CHILD_OFFSET_COERCE) + (CONJ + (ASSUME `cross125_det b c k = &d`) + (ASSUME `9 * d * s EXP 2 <= 8 * q + 7`))) THEN + REMOVE_THEN "tern" MP_TAC THEN CONV_TAC INT_RING);; + +let CROSS125_CHILD_ALMOST15 = prove + (`!b c k. + cross125_child_rep b c k 60 /\ + (!n:num. + 0 < n /\ n MOD 8 = 7 /\ ~(n = 15) + ==> cross125_child_rep b c k n) + ==> !n:num. + 0 < n /\ ~(n = 15) + ==> cross125_child_rep b c k n`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "sixty") + (LABEL_TAC "residue7")) THEN + MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN + DISCH_THEN(LABEL_TAC "ind") THEN STRIP_TAC THEN + ASM_CASES_TAC `4 divides n` THENL + [FIRST_X_ASSUM(X_CHOOSE_THEN `q:num` ASSUME_TAC o + REWRITE_RULE[divides]) THEN + ASM_CASES_TAC `q = 15` THENL + [SUBGOAL_THEN `n = 60` SUBST_ALL_TAC THENL + [ASM_ARITH_TAC; + REMOVE_THEN "sixty" MATCH_ACCEPT_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN `q < n /\ 0 < q` STRIP_ASSUME_TAC THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + ONCE_REWRITE_TAC[ASSUME `n = 4 * q`] THEN + MATCH_MP_TAC(SPECL [`b:int`; `c:int`; `k:int`; `q:num`] + CROSS125_CHILD_REP_SCALE4) THEN + REMOVE_THEN "ind" (MP_TAC o SPEC `q:num`) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + ASM_CASES_TAC `n MOD 8 = 7` THENL + [REMOVE_THEN "residue7" (MATCH_MP_TAC o SPEC `n:num`) THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC(SPECL [`b:int`; `c:int`; `k:int`; `n:num`] + CROSS125_CHILD_REP_REGULAR) THEN + MATCH_MP_TAC(SPEC `n:num` THREE_SQUARES_AVOIDS_OF_MOD) THEN + CONJ_TAC THENL + [UNDISCH_TAC `~(4 divides n)` THEN REWRITE_TAC[DIVIDES_MOD]; + ASM_REWRITE_TAC[]]]);; + +(* The search below is only a witness generator. Every returned quadruple is + checked by INT_REDUCE_CONV before it enters the theorem. *) + +let cross125_num_of_int i = + if i < 0 + then minus_num(num_of_string(string_of_int(-i))) + else num_of_string(string_of_int i);; + +let CROSS125_CERT_TAC b c k = + fun (asl,goal) -> + let _,bod = strip_exists goal in + let _,rhs = dest_eq bod in + let n = int_of_string(string_of_num(dest_intconst rhs)) in + let d = 9*k - (b+c)*(b+c) - (2*b-c)*(2*b-c) in + let isqrt r = int_of_float(float_sqrt(float_of_int r)) in + let signed i = + if i = 0 then 0 + else if i mod 2 = 1 then (i + 1) / 2 else -(i / 2) in + let check x y z w = + x*x + 2*y*y + 2*y*z + 5*z*z + + 2*b*y*w + 2*c*z*w + k*w*w = n in + let recover x w u v = + let zn = u - v + (b - 2*c)*w + and yn = u + 2*v - (5*b - c)*w in + if zn mod 9 <> 0 || yn mod 9 <> 0 then None else + let z = zn / 9 and y = yn / 9 in + if check x y z w then Some(x,y,z,w) else None in + let wmax = isqrt((9*n) / d) in + let rec find_w iw = + if iw > 2*wmax then failwith "CROSS125_CERT_TAC" else + let w = signed iw in + let rw = 9*n - d*w*w in + if rw < 0 then find_w (iw+1) else + let xmax = isqrt(rw / 9) in + let rec find_x x = + if x > xmax then find_w (iw+1) else + let r = rw - 9*x*x in + let umax = isqrt r in + let rec find_u iu = + if iu > 2*umax then find_x (x+1) else + let u = signed iu in + let v2 = r - u*u in + if v2 < 0 then find_u (iu+1) else + let v = isqrt v2 in + if v*v <> v2 then find_u (iu+1) else + match recover x w u v with + | Some ans -> ans + | None -> + if v = 0 then find_u (iu+1) else + match recover x w u (-v) with + | Some ans -> ans + | None -> find_u (iu+1) in + find_u 0 in + find_x 0 in + let x,y,z,w = find_w 0 in + (MAP_EVERY EXISTS_TAC + (map (mk_intconst o cross125_num_of_int) [x;y;z;w]) THEN + CONV_TAC INT_REDUCE_CONV) (asl,goal);; + +(* For odd determinants take s = 2; for even determinants take s = 1. *) +let cross125_admissible = new_definition + `cross125_admissible (b:int) c k (d:num) s <=> + (b = &0 /\ c = &0 /\ k = &1 /\ d = 9 /\ s = 2) \/ + (b = &0 /\ c = &0 /\ k = &2 /\ d = 18 /\ s = 1) \/ + (b = &0 /\ c = &0 /\ k = &3 /\ d = 27 /\ s = 2) \/ + (b = &0 /\ c = &0 /\ k = &4 /\ d = 36 /\ s = 1) \/ + (b = &0 /\ c = &0 /\ k = &5 /\ d = 45 /\ s = 2) \/ + (b = &0 /\ c = &0 /\ k = &6 /\ d = 54 /\ s = 1) \/ + (b = &0 /\ c = &0 /\ k = &7 /\ d = 63 /\ s = 2) \/ + (b = &1 /\ c = &0 /\ k = &1 /\ d = 4 /\ s = 1) \/ + (b = &1 /\ c = &0 /\ k = &2 /\ d = 13 /\ s = 2) \/ + (b = &1 /\ c = &0 /\ k = &3 /\ d = 22 /\ s = 1) \/ + (b = &1 /\ c = &0 /\ k = &4 /\ d = 31 /\ s = 2) \/ + (b = &1 /\ c = &0 /\ k = &6 /\ d = 49 /\ s = 2) \/ + (b = &1 /\ c = &0 /\ k = &7 /\ d = 58 /\ s = 1) \/ + (b = &0 /\ c = -- &1 /\ k = &1 /\ d = 7 /\ s = 2) \/ + (b = &0 /\ c = -- &1 /\ k = &3 /\ d = 25 /\ s = 2) \/ + (b = &0 /\ c = -- &1 /\ k = &4 /\ d = 34 /\ s = 1) \/ + (b = &0 /\ c = -- &1 /\ k = &5 /\ d = 43 /\ s = 2) \/ + (b = &0 /\ c = -- &1 /\ k = &6 /\ d = 52 /\ s = 1) \/ + (b = &0 /\ c = -- &1 /\ k = &7 /\ d = 61 /\ s = 2) \/ + (b = &1 /\ c = -- &1 /\ k = &2 /\ d = 9 /\ s = 2) \/ + (b = &1 /\ c = -- &1 /\ k = &3 /\ d = 18 /\ s = 1) \/ + (b = &1 /\ c = -- &1 /\ k = &4 /\ d = 27 /\ s = 2) \/ + (b = &1 /\ c = -- &1 /\ k = &5 /\ d = 36 /\ s = 1) \/ + (b = &1 /\ c = -- &1 /\ k = &6 /\ d = 45 /\ s = 2) \/ + (b = &1 /\ c = -- &1 /\ k = &7 /\ d = 54 /\ s = 1) \/ + (b = &0 /\ c = -- &2 /\ k = &1 /\ d = 1 /\ s = 2) \/ + (b = &0 /\ c = -- &2 /\ k = &2 /\ d = 10 /\ s = 1) \/ + (b = &0 /\ c = -- &2 /\ k = &3 /\ d = 19 /\ s = 2) \/ + (b = &0 /\ c = -- &2 /\ k = &4 /\ d = 28 /\ s = 1) \/ + (b = &0 /\ c = -- &2 /\ k = &5 /\ d = 37 /\ s = 2) \/ + (b = &0 /\ c = -- &2 /\ k = &6 /\ d = 46 /\ s = 1) \/ + (b = &0 /\ c = -- &2 /\ k = &7 /\ d = 55 /\ s = 2)`;; + +let CROSS125_ADMISSIBLE_DATA = prove + (`!b c k d s. + cross125_admissible b c k d s + ==> cross125_det b c k = &d /\ 0 < d /\ + ((9 * d * s EXP 2) MOD 8 = 2 \/ + (9 * d * s EXP 2) MOD 8 = 4 \/ + (9 * d * s EXP 2) MOD 8 = 6)`, + REPEAT GEN_TAC THEN REWRITE_TAC[cross125_admissible] THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[cross125_det] THEN + CONV_TAC INT_REDUCE_CONV THEN CONV_TAC NUM_REDUCE_CONV);; + +let CROSS125_BASE_CASE_TAC b c k d s = + let hi = (9*d*s*s - 8) / 8 in + CONJ_TAC THENL + [REWRITE_TAC[cross125_child_rep] THEN CROSS125_CERT_TAC b c k; + X_GEN_TAC `q:num` THEN STRIP_TAC THEN + NUM_RANGE_CASES_THEN `q:num` hi + (TRY ASM_ARITH_TAC THEN + REWRITE_TAC[cross125_child_rep] THEN + CONV_TAC NUM_REDUCE_CONV THEN CROSS125_CERT_TAC b c k)];; + +let CROSS125_ADMISSIBLE_BASE = prove + (`!b c k d s. + cross125_admissible b c k d s + ==> cross125_child_rep b c k 60 /\ + (!q:num. + 8 * q + 7 < 9 * d * s EXP 2 /\ ~(q = 1) + ==> cross125_child_rep b c k (8 * q + 7))`, + REPEAT GEN_TAC THEN REWRITE_TAC[cross125_admissible] THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN STRIP_ASSUME_TAC) THENL + [ASM_REWRITE_TAC[] THEN CROSS125_BASE_CASE_TAC 0 0 1 9 2; + ASM_REWRITE_TAC[] THEN CROSS125_BASE_CASE_TAC 0 0 2 18 1; + ASM_REWRITE_TAC[] THEN CROSS125_BASE_CASE_TAC 0 0 3 27 2; + ASM_REWRITE_TAC[] THEN CROSS125_BASE_CASE_TAC 0 0 4 36 1; + ASM_REWRITE_TAC[] THEN CROSS125_BASE_CASE_TAC 0 0 5 45 2; + ASM_REWRITE_TAC[] THEN CROSS125_BASE_CASE_TAC 0 0 6 54 1; + ASM_REWRITE_TAC[] THEN CROSS125_BASE_CASE_TAC 0 0 7 63 2; + ASM_REWRITE_TAC[] THEN CROSS125_BASE_CASE_TAC 1 0 1 4 1; + ASM_REWRITE_TAC[] THEN CROSS125_BASE_CASE_TAC 1 0 2 13 2; + ASM_REWRITE_TAC[] THEN CROSS125_BASE_CASE_TAC 1 0 3 22 1; + ASM_REWRITE_TAC[] THEN CROSS125_BASE_CASE_TAC 1 0 4 31 2; + ASM_REWRITE_TAC[] THEN CROSS125_BASE_CASE_TAC 1 0 6 49 2; + ASM_REWRITE_TAC[] THEN CROSS125_BASE_CASE_TAC 1 0 7 58 1; + ASM_REWRITE_TAC[] THEN CROSS125_BASE_CASE_TAC 0 (-1) 1 7 2; + ASM_REWRITE_TAC[] THEN CROSS125_BASE_CASE_TAC 0 (-1) 3 25 2; + ASM_REWRITE_TAC[] THEN CROSS125_BASE_CASE_TAC 0 (-1) 4 34 1; + ASM_REWRITE_TAC[] THEN CROSS125_BASE_CASE_TAC 0 (-1) 5 43 2; + ASM_REWRITE_TAC[] THEN CROSS125_BASE_CASE_TAC 0 (-1) 6 52 1; + ASM_REWRITE_TAC[] THEN CROSS125_BASE_CASE_TAC 0 (-1) 7 61 2; + ASM_REWRITE_TAC[] THEN CROSS125_BASE_CASE_TAC 1 (-1) 2 9 2; + ASM_REWRITE_TAC[] THEN CROSS125_BASE_CASE_TAC 1 (-1) 3 18 1; + ASM_REWRITE_TAC[] THEN CROSS125_BASE_CASE_TAC 1 (-1) 4 27 2; + ASM_REWRITE_TAC[] THEN CROSS125_BASE_CASE_TAC 1 (-1) 5 36 1; + ASM_REWRITE_TAC[] THEN CROSS125_BASE_CASE_TAC 1 (-1) 6 45 2; + ASM_REWRITE_TAC[] THEN CROSS125_BASE_CASE_TAC 1 (-1) 7 54 1; + ASM_REWRITE_TAC[] THEN CROSS125_BASE_CASE_TAC 0 (-2) 1 1 2; + ASM_REWRITE_TAC[] THEN CROSS125_BASE_CASE_TAC 0 (-2) 2 10 1; + ASM_REWRITE_TAC[] THEN CROSS125_BASE_CASE_TAC 0 (-2) 3 19 2; + ASM_REWRITE_TAC[] THEN CROSS125_BASE_CASE_TAC 0 (-2) 4 28 1; + ASM_REWRITE_TAC[] THEN CROSS125_BASE_CASE_TAC 0 (-2) 5 37 2; + ASM_REWRITE_TAC[] THEN CROSS125_BASE_CASE_TAC 0 (-2) 6 46 1; + ASM_REWRITE_TAC[] THEN CROSS125_BASE_CASE_TAC 0 (-2) 7 55 2]);; + +let CROSS125_ADMISSIBLE_ALMOST15 = prove + (`!b c k d s. + cross125_admissible b c k d s + ==> !n:num. + 0 < n /\ ~(n = 15) + ==> cross125_child_rep b c k n`, + REPEAT GEN_TAC THEN DISCH_THEN(LABEL_TAC "admissible") THEN + MP_TAC(MATCH_MP + (SPECL [`b:int`; `c:int`; `k:int`; `d:num`; `s:num`] + CROSS125_ADMISSIBLE_BASE) + (ASSUME `cross125_admissible b c k d s`)) THEN + DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "sixty") (LABEL_TAC "base")) THEN + MP_TAC(MATCH_MP + (SPECL [`b:int`; `c:int`; `k:int`; `d:num`; `s:num`] + CROSS125_ADMISSIBLE_DATA) + (ASSUME `cross125_admissible b c k d s`)) THEN + DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "det") + (CONJUNCTS_THEN2 (LABEL_TAC "dpos") (LABEL_TAC "offsetmod"))) THEN + MATCH_MP_TAC(SPECL [`b:int`; `c:int`; `k:int`] + CROSS125_CHILD_ALMOST15) THEN + CONJ_TAC THENL + [REMOVE_THEN "sixty" MATCH_ACCEPT_TAC; + MATCH_MP_TAC(SPECL + [`b:int`; `c:int`; `k:int`; `d:num`; `s:num`] + CROSS125_CHILD_REP_RESIDUE7) THEN + REPEAT CONJ_TAC THENL + [REMOVE_THEN "det" MATCH_ACCEPT_TAC; + REMOVE_THEN "dpos" MATCH_ACCEPT_TAC; + REMOVE_THEN "offsetmod" MATCH_ACCEPT_TAC; + REMOVE_THEN "base" MATCH_ACCEPT_TAC]]);; + +let IQ_CROSS125_CHILD_REP_OF_NUM = prove + (`!b c k m. + cross125_child_rep b c k m + ==> iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) b (&5) c k) (&m)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[cross125_child_rep; iq_represents] THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` + (X_CHOOSE_THEN `z:int` (X_CHOOSE_TAC `w:int`)))) THEN + EXISTS_TAC + `\i:num. + if i = 0 then (x:int) else if i = 1 then y else + if i = 2 then z else w` THEN + REWRITE_TAC[IQEVAL_MAT4] THEN CONV_TAC NUM_REDUCE_CONV THEN + FIRST_X_ASSUM(MP_TAC) THEN CONV_TAC INT_RING);; + +let IQ_UNIVERSAL_OF_CROSS125_ADMISSIBLE_CHILD = prove + (`!n A b c k d s. + cross125_admissible b c k d s /\ + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) b (&5) c k) A /\ + iq_represents n A (&15) + ==> iq_universal n A`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "admissible") + (CONJUNCTS_THEN2 (LABEL_TAC "emb") (LABEL_TAC "fifteen"))) THEN + REWRITE_TAC[iq_universal] THEN + X_GEN_TAC `m:int` THEN DISCH_TAC THEN + ASM_CASES_TAC `m = &15` THENL + [REMOVE_THEN "fifteen" MP_TAC THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MP_TAC(EQ_MP (SYM(SPEC `m:int` INT_OF_NUM_EXISTS)) + (MATCH_MP (SPECL [`&0:int`; `m:int`] INT_LT_IMP_LE) + (ASSUME `&0 < m`))) THEN + DISCH_THEN(X_CHOOSE_THEN `u:num` SUBST_ALL_TAC) THEN + MATCH_MP_TAC(ISPECL + [`n:num`; `4`; + `iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) b (&5) c k`; + `A:num->num->int`; `&u:int`] IQ_REPRESENTS_OF_EMBEDS) THEN + CONJ_TAC THENL + [REMOVE_THEN "emb" MATCH_ACCEPT_TAC; + MATCH_MP_TAC(SPECL [`b:int`; `c:int`; `k:int`; `u:num`] + IQ_CROSS125_CHILD_REP_OF_NUM) THEN + MATCH_MP_TAC(MATCH_MP + (SPECL [`b:int`; `c:int`; `k:int`; `d:num`; `s:num`] + CROSS125_ADMISSIBLE_ALMOST15) + (ASSUME `cross125_admissible b c k d s`)) THEN + CONJ_TAC THENL + [UNDISCH_TAC `&0 < &u` THEN REWRITE_TAC[INT_OF_NUM_LT]; + UNDISCH_TAC `~(&u = &15)` THEN REWRITE_TAC[INT_OF_NUM_EQ]]]);; + +let CROSS125_00_ADMISSIBLE = prove + (`!k:int. + k = &1 \/ k = &2 \/ k = &3 \/ k = &4 \/ + k = &5 \/ k = &6 \/ k = &7 + ==> ?d s. cross125_admissible (&0) (&0) k d s`, + GEN_TAC THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THENL + [MAP_EVERY EXISTS_TAC [`9`; `2`]; + MAP_EVERY EXISTS_TAC [`18`; `1`]; + MAP_EVERY EXISTS_TAC [`27`; `2`]; + MAP_EVERY EXISTS_TAC [`36`; `1`]; + MAP_EVERY EXISTS_TAC [`45`; `2`]; + MAP_EVERY EXISTS_TAC [`54`; `1`]; + MAP_EVERY EXISTS_TAC [`63`; `2`]] THEN + REWRITE_TAC[cross125_admissible]);; + +let CROSS125_10_ADMISSIBLE = prove + (`!k:int. + k = &1 \/ k = &2 \/ k = &3 \/ k = &4 \/ k = &6 \/ k = &7 + ==> ?d s. cross125_admissible (&1) (&0) k d s`, + GEN_TAC THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THENL + [MAP_EVERY EXISTS_TAC [`4`; `1`]; + MAP_EVERY EXISTS_TAC [`13`; `2`]; + MAP_EVERY EXISTS_TAC [`22`; `1`]; + MAP_EVERY EXISTS_TAC [`31`; `2`]; + MAP_EVERY EXISTS_TAC [`49`; `2`]; + MAP_EVERY EXISTS_TAC [`58`; `1`]] THEN + REWRITE_TAC[cross125_admissible]);; + +let CROSS125_0_NEG1_ADMISSIBLE = prove + (`!k:int. + k = &1 \/ k = &3 \/ k = &4 \/ k = &5 \/ k = &6 \/ k = &7 + ==> ?d s. cross125_admissible (&0) (-- &1) k d s`, + GEN_TAC THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THENL + [MAP_EVERY EXISTS_TAC [`7`; `2`]; + MAP_EVERY EXISTS_TAC [`25`; `2`]; + MAP_EVERY EXISTS_TAC [`34`; `1`]; + MAP_EVERY EXISTS_TAC [`43`; `2`]; + MAP_EVERY EXISTS_TAC [`52`; `1`]; + MAP_EVERY EXISTS_TAC [`61`; `2`]] THEN + REWRITE_TAC[cross125_admissible]);; + +let CROSS125_1_NEG1_ADMISSIBLE = prove + (`!k:int. + k = &2 \/ k = &3 \/ k = &4 \/ k = &5 \/ k = &6 \/ k = &7 + ==> ?d s. cross125_admissible (&1) (-- &1) k d s`, + GEN_TAC THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THENL + [MAP_EVERY EXISTS_TAC [`9`; `2`]; + MAP_EVERY EXISTS_TAC [`18`; `1`]; + MAP_EVERY EXISTS_TAC [`27`; `2`]; + MAP_EVERY EXISTS_TAC [`36`; `1`]; + MAP_EVERY EXISTS_TAC [`45`; `2`]; + MAP_EVERY EXISTS_TAC [`54`; `1`]] THEN + REWRITE_TAC[cross125_admissible]);; + +let CROSS125_0_NEG2_ADMISSIBLE = prove + (`!k:int. + k = &1 \/ k = &2 \/ k = &3 \/ k = &4 \/ + k = &5 \/ k = &6 \/ k = &7 + ==> ?d s. cross125_admissible (&0) (-- &2) k d s`, + GEN_TAC THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THENL + [MAP_EVERY EXISTS_TAC [`1`; `2`]; + MAP_EVERY EXISTS_TAC [`10`; `1`]; + MAP_EVERY EXISTS_TAC [`19`; `2`]; + MAP_EVERY EXISTS_TAC [`28`; `1`]; + MAP_EVERY EXISTS_TAC [`37`; `2`]; + MAP_EVERY EXISTS_TAC [`46`; `1`]; + MAP_EVERY EXISTS_TAC [`55`; `2`]] THEN + REWRITE_TAC[cross125_admissible]);; + +let CROSS125_UNIVERSAL_CHILD_TAC b c cases admissible = + MP_TAC(ISPECL [`n:num`; `A:num->num->int`; `k:int`] cases) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(fun th -> MP_TAC(MATCH_MP + (SPEC `k:int` admissible) th)) THEN + DISCH_THEN(X_CHOOSE_THEN `d:num` (X_CHOOSE_TAC `s:num`)) THEN + MATCH_MP_TAC(ISPECL + [`n:num`; `A:num->num->int`; b; c; `k:int`; `d:num`; `s:num`] + IQ_UNIVERSAL_OF_CROSS125_ADMISSIBLE_CHILD) THEN + ASM_REWRITE_TAC[];; + +let IQ_UNIVERSAL_OF_EMBEDS_CROSS125 = prove + (`!n A. + iq_symmetric n A /\ iq_positive n A /\ + iq_embeds n 3 + (iqmat3 (&1) (&0) (&0) (&2) (&1) (&5)) A /\ + iq_represents n A (&7) /\ + iq_represents n A (&15) + ==> iq_universal n A`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(SPECL [`n:num`; `A:num->num->int`] + IQ_EMBEDS_QUATERNARY_CROSS125) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN + (X_CHOOSE_THEN `k:int` + (REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC))) THENL + [CROSS125_UNIVERSAL_CHILD_TAC + `&0:int` `&0:int` + IQ_CROSS125_00_PARAMETER_CASES CROSS125_00_ADMISSIBLE; + CROSS125_UNIVERSAL_CHILD_TAC + `&1:int` `&0:int` + IQ_CROSS125_10_PARAMETER_CASES CROSS125_10_ADMISSIBLE; + CROSS125_UNIVERSAL_CHILD_TAC + `&0:int` `-- &1:int` + IQ_CROSS125_0_NEG1_PARAMETER_CASES CROSS125_0_NEG1_ADMISSIBLE; + CROSS125_UNIVERSAL_CHILD_TAC + `&1:int` `-- &1:int` + IQ_CROSS125_1_NEG1_PARAMETER_CASES CROSS125_1_NEG1_ADMISSIBLE; + CROSS125_UNIVERSAL_CHILD_TAC + `&0:int` `-- &2:int` + IQ_CROSS125_0_NEG2_PARAMETER_CASES CROSS125_0_NEG2_ADMISSIBLE]);; + +let cross124_det = new_definition + `cross124_det (b:int) c k = + &7 * k - &4 * b pow 2 + &2 * b * c - &2 * c pow 2`;; + +(* Representatives for Z^2 modulo the Gram matrix [[2,1],[1,4]]. *) +let INT_CROSS124_REMAINDER = prove + (`!b c:int. + ?q r rb rc. + b = &2 * q + r + rb /\ + c = q + &4 * r + rc /\ + ((rb = &0 /\ rc = &0) \/ + (rb = &1 /\ rc = &0) \/ + (rb = &0 /\ rc = -- &1) \/ + (rb = &1 /\ rc = -- &1) \/ + (rb = -- &1 /\ rc = &1) \/ + (rb = &0 /\ rc = &1) \/ + (rb = -- &1 /\ rc = &0))`, + REPEAT GEN_TAC THEN + MP_TAC(SPECL [`b - &2 * c:int`; `&7:int`] INT_DIVISION) THEN + ANTS_TAC THENL [INT_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC)) THEN + ABBREV_TAC `d = (b - &2 * c) div &7` THEN + ABBREV_TAC `e = (b - &2 * c) rem &7` THEN + SUBGOAL_THEN + `b - &2 * c = d * &7 + e /\ &0 <= e /\ e < &7` + STRIP_ASSUME_TAC THENL + [EXPAND_TAC "d" THEN EXPAND_TAC "e" THEN ASM_INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `e = &0 \/ e = &1 \/ e = &2 \/ e = &3 \/ + e = &4 \/ e = &5 \/ e = &6` + MP_TAC THENL + [ASM_INT_ARITH_TAC; + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THENL + [MAP_EVERY EXISTS_TAC + [`c + &4 * d:int`; `--d:int`; `&0:int`; `&0:int`]; + MAP_EVERY EXISTS_TAC + [`c + &4 * d:int`; `--d:int`; `&1:int`; `&0:int`]; + MAP_EVERY EXISTS_TAC + [`c + &4 * d + &1:int`; `--d:int`; `&0:int`; `-- &1:int`]; + MAP_EVERY EXISTS_TAC + [`c + &4 * d + &1:int`; `--d:int`; `&1:int`; `-- &1:int`]; + MAP_EVERY EXISTS_TAC + [`c + &4 * d + &3:int`; `--d - &1:int`; `-- &1:int`; `&1:int`]; + MAP_EVERY EXISTS_TAC + [`c + &4 * d + &3:int`; `--d - &1:int`; `&0:int`; `&1:int`]; + MAP_EVERY EXISTS_TAC + [`c + &4 * d + &4:int`; `--d - &1:int`; `-- &1:int`; `&0:int`]] + THEN ASM_REWRITE_TAC[] THEN ASM_INT_ARITH_TAC]);; + +let iqclear_cross124 = new_definition + `iqclear_cross124 a q r = + iqrows4 + (&1) (&0) (&0) (&0) + (&0) (&1) (&0) (&0) + (&0) (&0) (&1) (&0) + (--a) (--q) (--r) (&1)`;; + +let IQ_EMBEDS_CLEAR_CROSS124 = prove + (`!n A a q r rb rc t. + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) a + (&2) (&1) (&2 * q + r + rb) + (&4) (q + &4 * r + rc) t) A + ==> iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) rb (&4) rc + (t - a pow 2 - + &2 * q pow 2 - &2 * q * r - &4 * r pow 2 - + &2 * q * rb - &2 * r * rc)) A`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(ISPECL + [`n:num`; `4`; + `iqgram 4 + (iqmat4 (&1) (&0) (&0) a + (&2) (&1) (&2 * q + r + rb) + (&4) (q + &4 * r + rc) t) + (iqclear_cross124 a q r)`; + `iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) rb (&4) rc + (t - a pow 2 - + &2 * q pow 2 - &2 * q * r - &4 * r pow 2 - + &2 * q * rb - &2 * r * rc)`; + `A:num->num->int`] IQ_EMBEDS_EQ) THEN + CONJ_TAC THENL + [MATCH_MP_TAC IQ_EMBEDS_CONGRUENCE THEN ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC THEN + (SUBGOAL_THEN `i = 0 \/ i = 1 \/ i = 2 \/ i = 3` MP_TAC THENL + [ASM_ARITH_TAC; ALL_TAC]) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + (SUBGOAL_THEN `j = 0 \/ j = 1 \/ j = 2 \/ j = 3` MP_TAC THENL + [ASM_ARITH_TAC; ALL_TAC]) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + ASM_REWRITE_TAC[iqgram; IQBILIN_MAT4; iqclear_cross124; iqrows4; + iqmat4; iqsym] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC INT_RING]);; + +let IQ_CROSS124_REDUCED_REPRESENTS_7 = prove + (`!a q r rb rc k. + k = &7 - a pow 2 - + &2 * q pow 2 - &2 * q * r - &4 * r pow 2 - + &2 * q * rb - &2 * r * rc + ==> iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) rb (&4) rc k) (&7)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[iq_represents] THEN + EXISTS_TAC + `\i:num. + if i = 0 then (a:int) else if i = 1 then q else + if i = 2 then r else &1` THEN + REWRITE_TAC[IQEVAL_MAT4] THEN + CONV_TAC NUM_REDUCE_CONV THEN + FIRST_X_ASSUM(MP_TAC) THEN CONV_TAC INT_RING);; + +let iqflip_cross124 = new_definition + `iqflip_cross124 = + iqrows4 + (&1) (&0) (&0) (&0) + (&0) (&1) (&0) (&0) + (&0) (&0) (&1) (&0) + (&0) (&0) (&0) (-- &1)`;; + +let IQ_EMBEDS_FLIP_CROSS124 = prove + (`!n A b c k. + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) b (&4) c k) A + ==> iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (--b) (&4) (--c) k) A`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(ISPECL + [`n:num`; `4`; + `iqgram 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) b (&4) c k) + iqflip_cross124`; + `iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (--b) (&4) (--c) k`; + `A:num->num->int`] IQ_EMBEDS_EQ) THEN + CONJ_TAC THENL + [MATCH_MP_TAC IQ_EMBEDS_CONGRUENCE THEN ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC THEN + (SUBGOAL_THEN `i = 0 \/ i = 1 \/ i = 2 \/ i = 3` MP_TAC THENL + [ASM_ARITH_TAC; ALL_TAC]) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + (SUBGOAL_THEN `j = 0 \/ j = 1 \/ j = 2 \/ j = 3` MP_TAC THENL + [ASM_ARITH_TAC; ALL_TAC]) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + ASM_REWRITE_TAC[iqgram; IQBILIN_MAT4; iqflip_cross124; iqrows4; + iqmat4; iqsym] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC INT_RING]);; + +let IQ_REPRESENTS_FLIP_CROSS124 = prove + (`!b c k t. + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) b (&4) c k) t + ==> iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (--b) (&4) (--c) k) t`, + REPEAT GEN_TAC THEN + REWRITE_TAC[iq_represents] THEN + DISCH_THEN(X_CHOOSE_TAC `v:num->int`) THEN + EXISTS_TAC `\i:num. if i = 3 then --(v i) else v i` THEN + FIRST_X_ASSUM(MP_TAC) THEN + REWRITE_TAC[IQEVAL_MAT4] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC INT_RING);; + +(* The binary part satisfies + 2(2y^2 + 2yz + 4z^2) = (2y+z)^2 + 7z^2. *) +let INT_CROSS124_BINARY_NONNEG = prove + (`!y z:int. &0 <= &2 * y pow 2 + &2 * y * z + &4 * z pow 2`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN + `&2 * (&2 * y pow 2 + &2 * y * z + &4 * z pow 2) = + (&2 * y + z) pow 2 + &7 * z pow 2` + ASSUME_TAC THENL + [CONV_TAC INT_RING; + ALL_TAC] THEN + MP_TAC(SPEC `&2 * y + z:int` INT_LE_POW_2) THEN + MP_TAC(SPEC `z:int` INT_LE_POW_2) THEN + ASM_INT_ARITH_TAC);; + +let INT_2SQ_NOT_7_CORE = prove + (`!a b:int. + (a = &0 \/ a = &1 \/ a = &4) /\ + (b = &0 \/ b = &1 \/ b = &4) /\ + (&2 * a + b) rem &8 = &7 + ==> F`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + POP_ASSUM MP_TAC THEN ASM_REWRITE_TAC[] THEN + CONV_TAC INT_REDUCE_CONV);; + +let INT_2SQ_NOT_7 = prove + (`!x y:int. ~(&2 * x pow 2 + y pow 2 = &7)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(SPECL + [`x pow 2 rem &8`; `y pow 2 rem &8`] INT_2SQ_NOT_7_CORE) THEN + REWRITE_TAC[SQ_MOD_8] THEN + SUBGOAL_THEN + `(&2 * (x pow 2 rem &8) + y pow 2 rem &8) rem &8 = + (&2 * x pow 2 + y pow 2) rem &8` + SUBST1_TAC THENL + [CONV_TAC INT_REM_DOWN_CONV THEN REFL_TAC; + ASM_REWRITE_TAC[] THEN CONV_TAC INT_REDUCE_CONV]);; + +let INT_CROSS124_NOT_7 = prove + (`!x y z:int. + ~(x pow 2 + &2 * y pow 2 + &2 * y * z + &4 * z pow 2 = &7)`, + REPEAT GEN_TAC THEN DISCH_THEN(LABEL_TAC "repr") THEN + SUBGOAL_THEN + `&2 * x pow 2 + (&2 * y + z) pow 2 + &7 * z pow 2 = &14` + (LABEL_TAC "double") THENL + [REMOVE_THEN "repr" MP_TAC THEN CONV_TAC INT_RING; + ALL_TAC] THEN + SUBGOAL_THEN `z pow 2 <= &2` ASSUME_TAC THENL + [MP_TAC(SPEC `x:int` INT_LE_POW_2) THEN + MP_TAC(SPEC `&2 * y + z:int` INT_LE_POW_2) THEN + REMOVE_THEN "double" MP_TAC THEN INT_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(MATCH_MP (SPEC `z:int` INT_SQ_LE_2_CASES) + (ASSUME `z pow 2 <= &2`)) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THENL + [MP_TAC(SPECL [`x:int`; `&2 * y - &1:int`] INT_2SQ_NOT_7); + MP_TAC(SPECL [`y:int`; `x:int`] INT_2SQ_NOT_7); + MP_TAC(SPECL [`x:int`; `&2 * y + &1:int`] INT_2SQ_NOT_7)] THEN + REMOVE_THEN "double" MP_TAC THEN CONV_TAC INT_RING);; + +let INT_CROSS124_CHILD_DET_IDENTITY = prove + (`!b c k x y z w:int. + &49 * + (x pow 2 + &2 * y pow 2 + &2 * y * z + &4 * z pow 2 + + &2 * b * y * w + &2 * c * z * w + k * w pow 2) = + (&7 * x) pow 2 + + &2 * (&7 * y + (&4 * b - c) * w) pow 2 + + &2 * (&7 * y + (&4 * b - c) * w) * + (&7 * z + (--b + &2 * c) * w) + + &4 * (&7 * z + (--b + &2 * c) * w) pow 2 + + &7 * cross124_det b c k * w pow 2`, + REPEAT GEN_TAC THEN REWRITE_TAC[cross124_det] THEN CONV_TAC INT_RING);; + +let INT_CROSS124_ORTHOGONAL_VALUE = prove + (`!b c k:int. + &2 * (--(&4 * b - c)) pow 2 + + &2 * (--(&4 * b - c)) * (b - &2 * c) + + &2 * b * (--(&4 * b - c)) * &7 + + &4 * (b - &2 * c) pow 2 + + &2 * c * (b - &2 * c) * &7 + + k * &49 = + &7 * cross124_det b c k`, + REPEAT GEN_TAC THEN REWRITE_TAC[cross124_det] THEN CONV_TAC INT_RING);; + +let IQ_CROSS124_DET_NONNEG = prove + (`!n A b c k. + iq_positive n A /\ + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) b (&4) c k) A + ==> &0 <= cross124_det b c k`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(MATCH_MP + (ISPECL + [`n:num`; `4`; + `iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) b (&4) c k`; + `A:num->num->int`] IQ_EMBEDDED_NONNEG) + (CONJ + (ASSUME `iq_positive n A`) + (ASSUME + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) b (&4) c k) A`))) THEN + DISCH_THEN(MP_TAC o SPEC + `\i:num. + if i = 1 then --(&4 * b - c) else + if i = 2 then b - &2 * c else + if i = 3 then &7 else &0`) THEN + REWRITE_TAC[IQEVAL_MAT4] THEN + CONV_TAC NUM_REDUCE_CONV THEN + SIMP_TAC[INT_MUL_LZERO; INT_MUL_RZERO; INT_ADD_LID; INT_ADD_RID; + INT_MUL_LID; INT_MUL_RID] THEN + CONV_TAC INT_REDUCE_CONV THEN + DISCH_TAC THEN + MP_TAC(SPECL [`b:int`; `c:int`; `k:int`] + INT_CROSS124_ORTHOGONAL_VALUE) THEN + ASM_INT_ARITH_TAC);; + +let INT_CROSS124_REDUCED_NORM_NOT_DIV7 = prove + (`!b c:int. + (((b = &0 /\ c = &0) \/ + (b = &1 /\ c = &0) \/ + (b = &0 /\ c = -- &1) \/ + (b = &1 /\ c = -- &1) \/ + (b = -- &1 /\ c = &1) \/ + (b = &0 /\ c = &1) \/ + (b = -- &1 /\ c = &0)) /\ + ~(b = &0 /\ c = &0)) + ==> ~(&7 divides + (&4 * b pow 2 - &2 * b * c + &2 * c pow 2))`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 + (REPEAT_TCL DISJ_CASES_THEN STRIP_ASSUME_TAC) ASSUME_TAC) THEN + ASM_REWRITE_TAC[GSYM INT_REM_EQ_0] THEN + CONV_TAC INT_REDUCE_CONV THEN + ASM_MESON_TAC[]);; + +let IQ_CROSS124_DET_POSITIVE = prove + (`!n A b c k. + iq_positive n A /\ + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) b (&4) c k) A /\ + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) b (&4) c k) (&7) /\ + ((b = &0 /\ c = &0) \/ + (b = &1 /\ c = &0) \/ + (b = &0 /\ c = -- &1) \/ + (b = &1 /\ c = -- &1) \/ + (b = -- &1 /\ c = &1) \/ + (b = &0 /\ c = &1) \/ + (b = -- &1 /\ c = &0)) + ==> &0 < cross124_det b c k`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC))) THEN + SUBGOAL_THEN `&0 <= cross124_det b c k` ASSUME_TAC THENL + [MATCH_MP_TAC(ISPECL + [`n:num`; `A:num->num->int`; `b:int`; `c:int`; `k:int`] + IQ_CROSS124_DET_NONNEG) THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + ASM_CASES_TAC `cross124_det b c k = &0` THENL + [ASM_CASES_TAC `b = &0 /\ c = &0` THENL + [UNDISCH_TAC `b = &0 /\ c = &0` THEN STRIP_TAC THEN + SUBGOAL_THEN `k = &0` ASSUME_TAC THENL + [UNDISCH_TAC `cross124_det b c k = &0` THEN + ASM_REWRITE_TAC[cross124_det] THEN INT_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(ASSUME + `iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) b (&4) c k) (&7)`) THEN + REWRITE_TAC[iq_represents] THEN + DISCH_THEN(X_CHOOSE_THEN `v:num->int` (LABEL_TAC "repr")) THEN + MP_TAC(SPECL [`v 0:int`; `v 1:int`; `v 2:int`] + INT_CROSS124_NOT_7) THEN + REMOVE_THEN "repr" MP_TAC THEN + REWRITE_TAC[IQEVAL_MAT4] THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN + CONV_TAC INT_RING; + SUBGOAL_THEN + `~(&7 divides + (&4 * b pow 2 - &2 * b * c + &2 * c pow 2))` + ASSUME_TAC THENL + [MATCH_MP_TAC(SPECL [`b:int`; `c:int`] + INT_CROSS124_REDUCED_NORM_NOT_DIV7) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `&7 divides + (&4 * b pow 2 - &2 * b * c + &2 * c pow 2)` + ASSUME_TAC THENL + [REWRITE_TAC[int_divides] THEN EXISTS_TAC `k:int` THEN + UNDISCH_TAC `cross124_det b c k = &0` THEN + REWRITE_TAC[cross124_det] THEN CONV_TAC INT_RING; + ASM_MESON_TAC[]]]; + ASM_INT_ARITH_TAC]);; + +let IQ_CROSS124_DET_LE_49 = prove + (`!n A b c k. + iq_positive n A /\ + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) b (&4) c k) A /\ + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) b (&4) c k) (&7) /\ + ((b = &0 /\ c = &0) \/ + (b = &1 /\ c = &0) \/ + (b = &0 /\ c = -- &1) \/ + (b = &1 /\ c = -- &1) \/ + (b = -- &1 /\ c = &1) \/ + (b = &0 /\ c = &1) \/ + (b = -- &1 /\ c = &0)) + ==> cross124_det b c k <= &49`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC))) THEN + SUBGOAL_THEN `&0 < cross124_det b c k` ASSUME_TAC THENL + [MATCH_MP_TAC(ISPECL + [`n:num`; `A:num->num->int`; `b:int`; `c:int`; `k:int`] + IQ_CROSS124_DET_POSITIVE) THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MP_TAC(ASSUME + `iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) b (&4) c k) (&7)`) THEN + REWRITE_TAC[iq_represents] THEN + DISCH_THEN(X_CHOOSE_THEN `v:num->int` (LABEL_TAC "repr")) THEN + SUBGOAL_THEN `~(v 3 = &0)` ASSUME_TAC THENL + [DISCH_TAC THEN + MP_TAC(SPECL [`v 0:int`; `v 1:int`; `v 2:int`] + INT_CROSS124_NOT_7) THEN + REMOVE_THEN "repr" MP_TAC THEN + REWRITE_TAC[IQEVAL_MAT4] THEN ASM_REWRITE_TAC[] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC INT_RING; + ALL_TAC] THEN + SUBGOAL_THEN + `cross124_det b c k <= cross124_det b c k * v 3 pow 2` + ASSUME_TAC THENL + [GEN_REWRITE_TAC (LAND_CONV) [GSYM INT_MUL_RID] THEN + MATCH_MP_TAC INT_LE_LMUL THEN + CONJ_TAC THENL [ASM_INT_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[INT_ARITH `&1 <= x <=> &0 < x`] THEN + ASM_SIMP_TAC[INT_LT_POW_2]; + ALL_TAC] THEN + SUBGOAL_THEN `cross124_det b c k * v 3 pow 2 <= &49` + ASSUME_TAC THENL + [MP_TAC(SPECL + [`b:int`; `c:int`; `k:int`; `v 0:int`; `v 1:int`; + `v 2:int`; `v 3:int`] INT_CROSS124_CHILD_DET_IDENTITY) THEN + MP_TAC(ASSUME + `iqeval 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) b (&4) c k) v = &7`) THEN + REWRITE_TAC[IQEVAL_MAT4] THEN CONV_TAC NUM_REDUCE_CONV THEN + MP_TAC(ISPEC `&7 * v 0:int` INT_LE_POW_2) THEN + MP_TAC(ISPECL + [`&7 * v 1 + (&4 * b - c) * v 3:int`; + `&7 * v 2 + (--b + &2 * c) * v 3:int`] + INT_CROSS124_BINARY_NONNEG) THEN + INT_ARITH_TAC; + ASM_INT_ARITH_TAC]);; + +let IQ_CROSS124_DET_CONSTRAINTS = prove + (`!n A b c k. + iq_positive n A /\ + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) b (&4) c k) A /\ + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) b (&4) c k) (&7) /\ + ((b = &0 /\ c = &0) \/ + (b = &1 /\ c = &0) \/ + (b = &0 /\ c = -- &1) \/ + (b = &1 /\ c = -- &1) \/ + (b = -- &1 /\ c = &1) \/ + (b = &0 /\ c = &1) \/ + (b = -- &1 /\ c = &0)) + ==> &0 < cross124_det b c k /\ + cross124_det b c k <= &49`, + MESON_TAC[IQ_CROSS124_DET_POSITIVE; IQ_CROSS124_DET_LE_49]);; + +let IQ_EMBEDS_QUATERNARY_CROSS124_RAW = prove + (`!n A. + iq_symmetric n A /\ iq_positive n A /\ + iq_embeds n 3 + (iqmat3 (&1) (&0) (&0) (&2) (&1) (&4)) A /\ + iq_represents n A (&7) + ==> ?a q r rb rc k. + ((rb = &0 /\ rc = &0) \/ + (rb = &1 /\ rc = &0) \/ + (rb = &0 /\ rc = -- &1) \/ + (rb = &1 /\ rc = -- &1) \/ + (rb = -- &1 /\ rc = &1) \/ + (rb = &0 /\ rc = &1) \/ + (rb = -- &1 /\ rc = &0)) /\ + k = &7 - a pow 2 - + &2 * q pow 2 - &2 * q * r - &4 * r pow 2 - + &2 * q * rb - &2 * r * rc /\ + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) rb (&4) rc k) A /\ + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) rb (&4) rc k) (&7)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(SPECL + [`n:num`; `A:num->num->int`; + `&1:int`; `&0:int`; `&0:int`; `&2:int`; `&1:int`; `&4:int`; + `&7:int`] IQ_ESCALATE_MAT3) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `a:int` + (X_CHOOSE_THEN `b:int` + (X_CHOOSE_THEN `c:int` STRIP_ASSUME_TAC))) THEN + MP_TAC(SPECL [`b:int`; `c:int`] INT_CROSS124_REMAINDER) THEN + DISCH_THEN(X_CHOOSE_THEN `q:int` + (X_CHOOSE_THEN `r:int` + (X_CHOOSE_THEN `rb:int` + (X_CHOOSE_THEN `rc:int` + (CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC)))))) THEN + let kval = + `&7 - a pow 2 - + &2 * q pow 2 - &2 * q * r - &4 * r pow 2 - + &2 * q * rb - &2 * r * rc` in + let source_emb = REWRITE_RULE + [ASSUME `b = &2 * q + r + rb`; + ASSUME `c = q + &4 * r + rc`] + (ASSUME + `iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) a + (&2) (&1) b (&4) c (&7)) A`) in + let emb = MATCH_MP + (ISPECL + [`n:num`; `A:num->num->int`; `a:int`; `q:int`; `r:int`; + `rb:int`; `rc:int`; `&7:int`] IQ_EMBEDS_CLEAR_CROSS124) + source_emb in + let rep7 = MATCH_MP + (SPECL + [`a:int`; `q:int`; `r:int`; `rb:int`; `rc:int`; kval] + IQ_CROSS124_REDUCED_REPRESENTS_7) + (REFL kval) in + MAP_EVERY EXISTS_TAC + [`a:int`; `q:int`; `r:int`; `rb:int`; `rc:int`; kval] THEN + ACCEPT_TAC + (CONJ + (ASSUME + `(rb = &0 /\ rc = &0) \/ + (rb = &1 /\ rc = &0) \/ + (rb = &0 /\ rc = -- &1) \/ + (rb = &1 /\ rc = -- &1) \/ + (rb = -- &1 /\ rc = &1) \/ + (rb = &0 /\ rc = &1) \/ + (rb = -- &1 /\ rc = &0)`) + (CONJ (REFL kval) (CONJ emb rep7))));; + +let IQ_EMBEDS_REPRESENTS_FLIP_CROSS124 = prove + (`!n A b c k t. + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) b (&4) c k) A /\ + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) b (&4) c k) t + ==> iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (--b) (&4) (--c) k) A /\ + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (--b) (&4) (--c) k) t`, + MESON_TAC[IQ_EMBEDS_FLIP_CROSS124; IQ_REPRESENTS_FLIP_CROSS124]);; + +let IQ_EMBEDS_QUATERNARY_CROSS124 = prove + (`!n A. + iq_symmetric n A /\ iq_positive n A /\ + iq_embeds n 3 + (iqmat3 (&1) (&0) (&0) (&2) (&1) (&4)) A /\ + iq_represents n A (&7) + ==> (?k. + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (&0) (&4) (&0) k) A /\ + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (&0) (&4) (&0) k) (&7)) \/ + (?k. + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (&1) (&4) (&0) k) A /\ + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (&1) (&4) (&0) k) (&7)) \/ + (?k. + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (&0) (&4) (-- &1) k) A /\ + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (&0) (&4) (-- &1) k) (&7)) \/ + (?k. + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (&1) (&4) (-- &1) k) A /\ + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (&1) (&4) (-- &1) k) (&7))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(SPECL [`n:num`; `A:num->num->int`] + IQ_EMBEDS_QUATERNARY_CROSS124_RAW) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `a:int` + (X_CHOOSE_THEN `q:int` + (X_CHOOSE_THEN `r:int` + (X_CHOOSE_THEN `rb:int` + (X_CHOOSE_THEN `rc:int` + (X_CHOOSE_THEN `k:int` + (CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 (K ALL_TAC) + (CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC))))))))) THEN + UNDISCH_TAC + `(rb = &0 /\ rc = &0) \/ + (rb = &1 /\ rc = &0) \/ + (rb = &0 /\ rc = -- &1) \/ + (rb = &1 /\ rc = -- &1) \/ + (rb = -- &1 /\ rc = &1) \/ + (rb = &0 /\ rc = &1) \/ + (rb = -- &1 /\ rc = &0)` THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN STRIP_ASSUME_TAC) THENL + [DISJ1_TAC THEN EXISTS_TAC `k:int` THEN + REPEAT(FIRST_X_ASSUM SUBST_ALL_TAC) THEN ASM_REWRITE_TAC[]; + DISJ2_TAC THEN DISJ1_TAC THEN + EXISTS_TAC `k:int` THEN + REPEAT(FIRST_X_ASSUM SUBST_ALL_TAC) THEN ASM_REWRITE_TAC[]; + DISJ2_TAC THEN DISJ2_TAC THEN DISJ1_TAC THEN + EXISTS_TAC `k:int` THEN + REPEAT(FIRST_X_ASSUM SUBST_ALL_TAC) THEN ASM_REWRITE_TAC[]; + DISJ2_TAC THEN DISJ2_TAC THEN DISJ2_TAC THEN + EXISTS_TAC `k:int` THEN + REPEAT(FIRST_X_ASSUM SUBST_ALL_TAC) THEN ASM_REWRITE_TAC[]; + DISJ2_TAC THEN DISJ2_TAC THEN DISJ2_TAC THEN + EXISTS_TAC `k:int` THEN + REPEAT(FIRST_X_ASSUM SUBST_ALL_TAC) THEN + MATCH_MP_TAC(CONV_RULE INT_REDUCE_CONV + (ISPECL + [`n:num`; `A:num->num->int`; `-- &1`; `&1`; `k:int`; `&7:int`] + IQ_EMBEDS_REPRESENTS_FLIP_CROSS124)) THEN + ASM_REWRITE_TAC[]; + DISJ2_TAC THEN DISJ2_TAC THEN DISJ1_TAC THEN + EXISTS_TAC `k:int` THEN + REPEAT(FIRST_X_ASSUM SUBST_ALL_TAC) THEN + MATCH_MP_TAC(CONV_RULE INT_REDUCE_CONV + (ISPECL + [`n:num`; `A:num->num->int`; `&0`; `&1`; `k:int`; `&7:int`] + IQ_EMBEDS_REPRESENTS_FLIP_CROSS124)) THEN + ASM_REWRITE_TAC[]; + DISJ2_TAC THEN DISJ1_TAC THEN + EXISTS_TAC `k:int` THEN + REPEAT(FIRST_X_ASSUM SUBST_ALL_TAC) THEN + MATCH_MP_TAC(CONV_RULE INT_REDUCE_CONV + (ISPECL + [`n:num`; `A:num->num->int`; `-- &1`; `&0`; `k:int`; `&7:int`] + IQ_EMBEDS_REPRESENTS_FLIP_CROSS124)) THEN + ASM_REWRITE_TAC[]]);; + +(* Two odd squares together with twice a square cannot sum to 8. *) +let INT_2SQ_TWO_ODD_NOT_8 = prove + (`!x y z:int. + ~(&2 * x pow 2 + + (&2 * y + &1) pow 2 + (&2 * z + &1) pow 2 = &8)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN + `~(&2 divides &2 * y + &1) /\ + ~(&2 divides &2 * z + &1)` + STRIP_ASSUME_TAC THENL + [CONJ_TAC THENL + [REWRITE_TAC[int_divides] THEN + DISCH_THEN(X_CHOOSE_TAC `q:int`) THEN + MP_TAC(SPEC `q - y:int` INT_TWO_MUL_NE_ONE) THEN + ASM_INT_ARITH_TAC; + REWRITE_TAC[int_divides] THEN + DISCH_THEN(X_CHOOSE_TAC `q:int`) THEN + MP_TAC(SPEC `q - z:int` INT_TWO_MUL_NE_ONE) THEN + ASM_INT_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN + `((&2 * y + &1) pow 2) rem &8 = &1 /\ + ((&2 * z + &1) pow 2) rem &8 = &1` + STRIP_ASSUME_TAC THENL + [ASM_REWRITE_TAC[ODD_SQ_MOD_8]; + ALL_TAC] THEN + MP_TAC(SPEC `x:int` SQ_MOD_8) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THEN + (SUBGOAL_THEN + `(&2 * (x pow 2 rem &8) + + ((&2 * y + &1) pow 2) rem &8 + + ((&2 * z + &1) pow 2) rem &8) rem &8 = + (&2 * x pow 2 + + (&2 * y + &1) pow 2 + (&2 * z + &1) pow 2) rem &8` + MP_TAC THENL + [CONV_TAC INT_REM_DOWN_CONV THEN REFL_TAC; + ASM_REWRITE_TAC[] THEN CONV_TAC INT_REDUCE_CONV]));; + +let INT_CROSS124_BINARY_NOT_7 = prove + (`!u v:int. + ~(&2 * u pow 2 + &2 * u * v + &4 * v pow 2 = &7)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN `&2 divides (&7:int)` MP_TAC THENL + [REWRITE_TAC[int_divides] THEN + EXISTS_TAC `u pow 2 + u * v + &2 * v pow 2` THEN + FIRST_X_ASSUM(MP_TAC) THEN CONV_TAC INT_RING; + REWRITE_TAC[GSYM INT_REM_EQ_0] THEN CONV_TAC INT_REDUCE_CONV]);; + +let INT_CROSS124_0_NEG1_2_NOT_7 = prove + (`!x y z w:int. + ~(x pow 2 + &2 * y pow 2 + &2 * y * z + &4 * z pow 2 - + &2 * z * w + &2 * w pow 2 = &7)`, + REPEAT GEN_TAC THEN DISCH_THEN(LABEL_TAC "rep") THEN + SUBGOAL_THEN + `&2 * x pow 2 + (&2 * y + z) pow 2 + + (&2 * w - z) pow 2 + &6 * z pow 2 = &14` + (LABEL_TAC "double") THENL + [REMOVE_THEN "rep" MP_TAC THEN CONV_TAC INT_RING; + ALL_TAC] THEN + SUBGOAL_THEN `z pow 2 <= &2` ASSUME_TAC THENL + [MP_TAC(SPEC `x:int` INT_LE_POW_2) THEN + MP_TAC(SPEC `&2 * y + z:int` INT_LE_POW_2) THEN + MP_TAC(SPEC `&2 * w - z:int` INT_LE_POW_2) THEN + USE_THEN "double" MP_TAC THEN INT_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(MATCH_MP (SPEC `z:int` INT_SQ_LE_2_CASES) + (ASSUME `z pow 2 <= &2`)) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THENL + [MP_TAC(SPECL [`x:int`; `y - &1:int`; `w:int`] + INT_2SQ_TWO_ODD_NOT_8); + MP_TAC(SPECL [`x:int`; `y:int`; `w:int`] INT_122_NOT_7); + MP_TAC(SPECL [`x:int`; `y:int`; `w - &1:int`] + INT_2SQ_TWO_ODD_NOT_8)] THEN + REMOVE_THEN "double" MP_TAC THEN CONV_TAC INT_RING);; + +let IQ_CROSS124_0_NEG1_2_NOT_REPRESENTS_7 = prove + (`~iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (&0) (&4) (-- &1) (&2)) (&7)`, + REWRITE_TAC[iq_represents] THEN + DISCH_THEN(X_CHOOSE_THEN `v:num->int` (LABEL_TAC "rep")) THEN + MP_TAC(SPECL [`v 0:int`; `v 1:int`; `v 2:int`; `v 3:int`] + INT_CROSS124_0_NEG1_2_NOT_7) THEN + REMOVE_THEN "rep" MP_TAC THEN + REWRITE_TAC[IQEVAL_MAT4] THEN CONV_TAC NUM_REDUCE_CONV THEN + CONV_TAC INT_RING);; + +let INT_CROSS124_1_NEG1_8_NOT_7 = prove + (`!x y z w:int. + ~(x pow 2 + &2 * y pow 2 + &2 * y * z + &4 * z pow 2 + + &2 * y * w - &2 * z * w + &8 * w pow 2 = &7)`, + REPEAT GEN_TAC THEN DISCH_THEN(LABEL_TAC "rep") THEN + ASM_CASES_TAC `w = &0` THENL + [MP_TAC(SPECL [`x:int`; `y:int`; `z:int`] INT_CROSS124_NOT_7) THEN + REMOVE_THEN "rep" MP_TAC THEN ASM_REWRITE_TAC[] THEN + CONV_TAC INT_RING; + ALL_TAC] THEN + SUBGOAL_THEN `&1 <= w pow 2` ASSUME_TAC THENL + [REWRITE_TAC[INT_ARITH `&1 <= q <=> &0 < q`] THEN + ASM_SIMP_TAC[INT_LT_POW_2]; + ALL_TAC] THEN + SUBGOAL_THEN + `(&7 * x) pow 2 + + &2 * (&7 * y + &5 * w) pow 2 + + &2 * (&7 * y + &5 * w) * (&7 * z - &3 * w) + + &4 * (&7 * z - &3 * w) pow 2 + + &336 * w pow 2 = &343` + (LABEL_TAC "detid") THENL + [MP_TAC(SPECL + [`&1:int`; `-- &1:int`; `&8:int`; + `x:int`; `y:int`; `z:int`; `w:int`] + INT_CROSS124_CHILD_DET_IDENTITY) THEN + REMOVE_THEN "rep" MP_TAC THEN + REWRITE_TAC[cross124_det] THEN CONV_TAC INT_REDUCE_CONV THEN + CONV_TAC INT_RING; + ALL_TAC] THEN + SUBGOAL_THEN + `&0 <= + &2 * (&7 * y + &5 * w) pow 2 + + &2 * (&7 * y + &5 * w) * (&7 * z - &3 * w) + + &4 * (&7 * z - &3 * w) pow 2` + ASSUME_TAC THENL + [MATCH_ACCEPT_TAC(SPECL + [`&7 * y + &5 * w:int`; `&7 * z - &3 * w:int`] + INT_CROSS124_BINARY_NONNEG); + ALL_TAC] THEN + SUBGOAL_THEN `w pow 2 = &1` ASSUME_TAC THENL + [MP_TAC(SPEC `&7 * x:int` INT_LE_POW_2) THEN + USE_THEN "detid" MP_TAC THEN ASM_INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `x = &0` ASSUME_TAC THENL + [SUBGOAL_THEN `(&7 * x) pow 2 <= &7` ASSUME_TAC THENL + [USE_THEN "detid" MP_TAC THEN ASM_INT_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(MATCH_MP (SPEC `&7 * x:int` INT_SQ_LE_7_CASES) + (ASSUME `(&7 * x) pow 2 <= &7`)) THEN + ASM_INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `&2 * (&7 * y + &5 * w) pow 2 + + &2 * (&7 * y + &5 * w) * (&7 * z - &3 * w) + + &4 * (&7 * z - &3 * w) pow 2 = &7` + ASSUME_TAC THENL + [REMOVE_THEN "detid" MP_TAC THEN ASM_REWRITE_TAC[] THEN INT_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(SPECL + [`&7 * y + &5 * w:int`; `&7 * z - &3 * w:int`] + INT_CROSS124_BINARY_NOT_7) THEN + ASM_REWRITE_TAC[]);; + +let IQ_CROSS124_1_NEG1_8_NOT_REPRESENTS_7 = prove + (`~iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (&1) (&4) (-- &1) (&8)) (&7)`, + REWRITE_TAC[iq_represents] THEN + DISCH_THEN(X_CHOOSE_THEN `v:num->int` (LABEL_TAC "rep")) THEN + MP_TAC(SPECL [`v 0:int`; `v 1:int`; `v 2:int`; `v 3:int`] + INT_CROSS124_1_NEG1_8_NOT_7) THEN + REMOVE_THEN "rep" MP_TAC THEN + REWRITE_TAC[IQEVAL_MAT4] THEN CONV_TAC NUM_REDUCE_CONV THEN + CONV_TAC INT_RING);; + +let IQ_CROSS124_00_PARAMETER_CASES = prove + (`!n A k. + iq_positive n A /\ + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (&0) (&4) (&0) k) A /\ + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (&0) (&4) (&0) k) (&7) + ==> k = &1 \/ k = &2 \/ k = &3 \/ k = &4 \/ + k = &5 \/ k = &6 \/ k = &7`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(ISPECL [`n:num`; `A:num->num->int`; `&0`; `&0`; `k:int`] + IQ_CROSS124_DET_CONSTRAINTS) THEN + ASM_REWRITE_TAC[cross124_det] THEN CONV_TAC INT_REDUCE_CONV THEN + STRIP_TAC THEN ASM_INT_ARITH_TAC);; + +let IQ_CROSS124_10_PARAMETER_CASES = prove + (`!n A k. + iq_positive n A /\ + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (&1) (&4) (&0) k) A /\ + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (&1) (&4) (&0) k) (&7) + ==> k = &1 \/ k = &2 \/ k = &3 \/ k = &4 \/ + k = &5 \/ k = &6 \/ k = &7`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(ISPECL [`n:num`; `A:num->num->int`; `&1`; `&0`; `k:int`] + IQ_CROSS124_DET_CONSTRAINTS) THEN + ASM_REWRITE_TAC[cross124_det] THEN CONV_TAC INT_REDUCE_CONV THEN + STRIP_TAC THEN ASM_INT_ARITH_TAC);; + +let IQ_CROSS124_0_NEG1_PARAMETER_CASES = prove + (`!n A k. + iq_positive n A /\ + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (&0) (&4) (-- &1) k) A /\ + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (&0) (&4) (-- &1) k) (&7) + ==> k = &1 \/ k = &3 \/ k = &4 \/ + k = &5 \/ k = &6 \/ k = &7`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(ISPECL [`n:num`; `A:num->num->int`; `&0`; `-- &1`; `k:int`] + IQ_CROSS124_DET_CONSTRAINTS) THEN + ASM_REWRITE_TAC[cross124_det] THEN CONV_TAC INT_REDUCE_CONV THEN + STRIP_TAC THEN + SUBGOAL_THEN + `k = &1 \/ k = &2 \/ k = &3 \/ k = &4 \/ + k = &5 \/ k = &6 \/ k = &7` + MP_TAC THENL + [ASM_INT_ARITH_TAC; + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + ASM_REWRITE_TAC[] THEN + MP_TAC IQ_CROSS124_0_NEG1_2_NOT_REPRESENTS_7 THEN + ASM_REWRITE_TAC[]]);; + +let IQ_CROSS124_1_NEG1_PARAMETER_CASES = prove + (`!n A k. + iq_positive n A /\ + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (&1) (&4) (-- &1) k) A /\ + iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (&1) (&4) (-- &1) k) (&7) + ==> k = &2 \/ k = &3 \/ k = &4 \/ + k = &5 \/ k = &6 \/ k = &7`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(ISPECL [`n:num`; `A:num->num->int`; `&1`; `-- &1`; `k:int`] + IQ_CROSS124_DET_CONSTRAINTS) THEN + ASM_REWRITE_TAC[cross124_det] THEN CONV_TAC INT_REDUCE_CONV THEN + STRIP_TAC THEN + SUBGOAL_THEN + `k = &2 \/ k = &3 \/ k = &4 \/ k = &5 \/ + k = &6 \/ k = &7 \/ k = &8` + MP_TAC THENL + [ASM_INT_ARITH_TAC; + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + ASM_REWRITE_TAC[] THEN + MP_TAC IQ_CROSS124_1_NEG1_8_NOT_REPRESENTS_7 THEN + ASM_REWRITE_TAC[]]);; + +(* Multiplying the last coordinate by 7 clears the denominator in the + orthogonal complement of the crossed <1,2,4> ternary sublattice. *) +let INT_CROSS124_CHILD_SHIFT7 = prove + (`!b c k s x y z:int. + x pow 2 + + &2 * (y - (&4 * b - c) * s) pow 2 + + &2 * (y - (&4 * b - c) * s) * + (z + (b - &2 * c) * s) + + &4 * (z + (b - &2 * c) * s) pow 2 + + &2 * b * (y - (&4 * b - c) * s) * (&7 * s) + + &2 * c * (z + (b - &2 * c) * s) * (&7 * s) + + k * (&7 * s) pow 2 = + x pow 2 + &2 * y pow 2 + &2 * y * z + &4 * z pow 2 + + &7 * cross124_det b c k * s pow 2`, + REPEAT GEN_TAC THEN REWRITE_TAC[cross124_det] THEN CONV_TAC INT_RING);; + +let INT_REPRESENTS_CROSS124_CHILD_SHIFT7 = prove + (`!b c k s n:int. + (?x y z:int. + x pow 2 + &2 * y pow 2 + &2 * y * z + &4 * z pow 2 = + n - &7 * cross124_det b c k * s pow 2) + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &2 * y * z + &4 * z pow 2 + + &2 * b * y * w + &2 * c * z * w + k * w pow 2 = n`, + REPEAT GEN_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` (X_CHOOSE_TAC `z:int`))) THEN + MAP_EVERY EXISTS_TAC + [`x:int`; + `y - (&4 * b - c) * s:int`; + `z + (b - &2 * c) * s:int`; + `&7 * s:int`] THEN + MP_TAC(SPECL + [`b:int`; `c:int`; `k:int`; `s:int`; `x:int`; `y:int`; `z:int`] + INT_CROSS124_CHILD_SHIFT7) THEN + FIRST_X_ASSUM(MP_TAC) THEN INT_ARITH_TAC);; + +(* The 7-adic exceptional squareclasses occupy only four residues modulo + 49. This one-way test is convenient for certified finite shift searches. *) +let DISC7_EXCEPTION_MOD49 = prove + (`!n:num. + disc7_exception n + ==> n MOD 49 = 0 \/ n MOD 49 = 21 \/ + n MOD 49 = 35 \/ n MOD 49 = 42`, + GEN_TAC THEN REWRITE_TAC[disc7_exception] THEN + DISCH_THEN(X_CHOOSE_THEN `a:num` + (X_CHOOSE_THEN `b:num` + (X_CHOOSE_THEN `r:num` + (CONJUNCTS_THEN2 (LABEL_TAC "r") (LABEL_TAC "eq"))))) THEN + ASM_CASES_TAC `a = 0` THENL + [REMOVE_THEN "r" (REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + ASM_REWRITE_TAC[EXP; MULT_CLAUSES; MOD_MULT_ADD] THEN + CONV_TAC NUM_REDUCE_CONV; + MP_TAC(SPEC `a:num` num_CASES) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST_ALL_TAC) THEN + DISJ1_TAC THEN ASM_REWRITE_TAC[EXP] THEN + ONCE_REWRITE_TAC[ARITH_RULE `(49*a)*b = 49*(a*b)`] THEN + REWRITE_TAC[MOD_MULT] THEN CONV_TAC NUM_REDUCE_CONV]);; + +let DISC7_NOT_EXCEPTION_OF_MOD49 = prove + (`!n:num. + ~(n MOD 49 = 0) /\ ~(n MOD 49 = 21) /\ + ~(n MOD 49 = 35) /\ ~(n MOD 49 = 42) + ==> ~disc7_exception n`, + MESON_TAC[DISC7_EXCEPTION_MOD49]);; + +let num_shift_rem = new_definition + `num_shift_rem r c p = + if c MOD p <= r then r - c MOD p else r + p - c MOD p`;; + +let NUM_MOD_SUB_EXACT = prove + (`!n c p:num. + c <= n /\ ~(p = 0) + ==> (n - c) MOD p = num_shift_rem (n MOD p) c p`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + REWRITE_TAC[num_shift_rem] THEN + SUBGOAL_THEN + `((n - c) MOD p + c MOD p) MOD p = n MOD p` + ASSUME_TAC THENL + [REWRITE_TAC[MOD_ADD_MOD] THEN ASM_SIMP_TAC[SUB_ADD]; + ALL_TAC] THEN + MP_TAC(SPECL [`(n-c) MOD p`; `c MOD p`; `p:num`] MOD_ADD_CASES) THEN + ANTS_TAC THENL + [CONJ_TAC THEN REWRITE_TAC[MOD_LT_EQ] THEN ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[] THEN + COND_CASES_TAC THEN COND_CASES_TAC THEN ASM_ARITH_TAC]);; + +let cross124_generic_offset = new_definition + `cross124_generic_offset (m:num) <=> + m = 1 \/ m = 2 \/ m = 4 \/ m = 5 \/ m = 6 \/ m = 7 \/ + m = 70 \/ m = 119 \/ m = 217 \/ m = 266 \/ + m = 35 \/ m = 133 \/ m = 182 \/ m = 280 \/ m = 329 \/ + m = 42 \/ m = 91 \/ m = 140 \/ m = 238 \/ m = 287`;; + +let CROSS124_FINITE_SHIFT_TAC = + FIRST + (map + (fun s -> + EXISTS_TAC (mk_small_numeral s) THEN + REWRITE_TAC[num_shift_rem] THEN + CONV_TAC NUM_REDUCE_CONV THEN ACCEPT_TAC TRUTH) + (1--9));; + +let CROSS124_CONTR_FALSE_ASSUM_TAC (asl,w) = + let _,th = find (fun (_,th) -> concl th = `F`) asl in + CONTR_TAC th (asl,w);; + +let CROSS124_BOUNDED_FINITE_SHIFT_SELECTOR_TAC = + REPEAT GEN_TAC THEN STRIP_TAC THEN + NUM_RANGE_CASES_THEN `r12:num` 11 + (NUM_RANGE_CASES_THEN `r49:num` 48 + (RULE_ASSUM_TAC(CONV_RULE NUM_REDUCE_CONV) THEN + TRY CROSS124_CONTR_FALSE_ASSUM_TAC THEN + CROSS124_FINITE_SHIFT_TAC));; + +let CROSS124_GENERIC_OFFSET_FINITE_SHIFT = prove + (`!m r12 r49:num. + cross124_generic_offset m /\ + r12 < 12 /\ r49 < 49 /\ + ~(r12 MOD 4 = 0) /\ ~(r49 = 0) + ==> ?s. + 1 <= s /\ s <= 9 /\ + ~(num_shift_rem r12 (m * s EXP 2) 12 = 7) /\ + ~(num_shift_rem r12 (m * s EXP 2) 12 = 10) /\ + ~(num_shift_rem r49 (m * s EXP 2) 49 = 0) /\ + ~(num_shift_rem r49 (m * s EXP 2) 49 = 21) /\ + ~(num_shift_rem r49 (m * s EXP 2) 49 = 35) /\ + ~(num_shift_rem r49 (m * s EXP 2) 49 = 42)`, + REPEAT GEN_TAC THEN REWRITE_TAC[cross124_generic_offset] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) STRIP_ASSUME_TAC) THEN + NUM_RANGE_CASES_THEN `r12:num` 11 + (NUM_RANGE_CASES_THEN `r49:num` 48 + (RULE_ASSUM_TAC(CONV_RULE NUM_REDUCE_CONV) THEN + TRY CROSS124_CONTR_FALSE_ASSUM_TAC THEN + CROSS124_FINITE_SHIFT_TAC)));; + +let CROSS124_GENERIC_OFFSET_SHIFT = prove + (`!m n:num. + cross124_generic_offset m /\ + 81 * m <= n /\ + ~(4 divides n) /\ ~(49 divides n) + ==> ?s. + 1 <= s /\ s <= 9 /\ m * s EXP 2 <= n /\ + ~((n - m * s EXP 2) MOD 12 = 7) /\ + ~((n - m * s EXP 2) MOD 12 = 10) /\ + ~((n - m * s EXP 2) MOD 49 = 0) /\ + ~((n - m * s EXP 2) MOD 49 = 21) /\ + ~((n - m * s EXP 2) MOD 49 = 35) /\ + ~((n - m * s EXP 2) MOD 49 = 42)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(SPECL + [`m:num`; `n MOD 12`; `n MOD 49`] + CROSS124_GENERIC_OFFSET_FINITE_SHIFT) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + REWRITE_TAC[MOD_LT_EQ] THEN CONV_TAC NUM_REDUCE_CONV; + REWRITE_TAC[MOD_LT_EQ] THEN CONV_TAC NUM_REDUCE_CONV; + UNDISCH_TAC `~(4 divides n)` THEN + REWRITE_TAC[DIVIDES_MOD; ARITH_RULE `12 = 4 * 3`; MOD_MOD]; + UNDISCH_TAC `~(49 divides n)` THEN REWRITE_TAC[DIVIDES_MOD]]; + DISCH_THEN(X_CHOOSE_THEN `s:num` STRIP_ASSUME_TAC)] THEN + EXISTS_TAC `s:num` THEN + SUBGOAL_THEN `m * s EXP 2 <= n` ASSUME_TAC THENL + [MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `81 * m` THEN + CONJ_TAC THENL + [GEN_REWRITE_TAC RAND_CONV [MULT_SYM] THEN + MATCH_MP_TAC LE_MULT2 THEN REWRITE_TAC[LE_REFL] THEN + MP_TAC(SPECL [`s:num`; `9`; `2`] EXP_MONO_LE_IMP) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV; + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + MP_TAC(SPECL + [`n:num`; `m * s EXP 2`; `12`] NUM_MOD_SUB_EXACT) THEN + MP_TAC(SPECL + [`n:num`; `m * s EXP 2`; `49`] NUM_MOD_SUB_EXACT) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN + ASM_MESON_TAC[]);; + +let cross124_child_rep = new_definition + `cross124_child_rep (b:int) c k (n:num) <=> + ?x y z w:int. + x pow 2 + &2 * y pow 2 + &2 * y * z + &4 * z pow 2 + + &2 * b * y * w + &2 * c * z * w + k * w pow 2 = &n`;; + +let CROSS124_CHILD_REP_SCALE = prove + (`!b c k t n. + cross124_child_rep b c k n + ==> cross124_child_rep b c k (t EXP 2 * n)`, + REPEAT GEN_TAC THEN REWRITE_TAC[cross124_child_rep] THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` + (X_CHOOSE_THEN `z:int` (X_CHOOSE_TAC `w:int`)))) THEN + MAP_EVERY EXISTS_TAC + [`&t * x:int`; `&t * y:int`; `&t * z:int`; `&t * w:int`] THEN + FIRST_X_ASSUM(MP_TAC) THEN + REWRITE_TAC[GSYM INT_OF_NUM_MUL; GSYM INT_OF_NUM_POW] THEN + CONV_TAC INT_RING);; + +let cross124_generic_child = new_definition + `cross124_generic_child (b:int) c k (m:num) <=> + (b = &0 /\ c = &0 /\ k = &1 /\ m = 1) \/ + (b = &0 /\ c = &0 /\ k = &2 /\ m = 2) \/ + (b = &0 /\ c = &0 /\ k = &4 /\ m = 4) \/ + (b = &0 /\ c = &0 /\ k = &5 /\ m = 5) \/ + (b = &0 /\ c = &0 /\ k = &6 /\ m = 6) \/ + (b = &0 /\ c = &0 /\ k = &7 /\ m = 7) \/ + (b = &1 /\ c = &0 /\ k = &2 /\ m = 70) \/ + (b = &1 /\ c = &0 /\ k = &3 /\ m = 119) \/ + (b = &1 /\ c = &0 /\ k = &5 /\ m = 217) \/ + (b = &1 /\ c = &0 /\ k = &6 /\ m = 266) \/ + (b = &0 /\ c = -- &1 /\ k = &1 /\ m = 35) \/ + (b = &0 /\ c = -- &1 /\ k = &3 /\ m = 133) \/ + (b = &0 /\ c = -- &1 /\ k = &4 /\ m = 182) \/ + (b = &0 /\ c = -- &1 /\ k = &6 /\ m = 280) \/ + (b = &0 /\ c = -- &1 /\ k = &7 /\ m = 329) \/ + (b = &1 /\ c = -- &1 /\ k = &2 /\ m = 42) \/ + (b = &1 /\ c = -- &1 /\ k = &3 /\ m = 91) \/ + (b = &1 /\ c = -- &1 /\ k = &4 /\ m = 140) \/ + (b = &1 /\ c = -- &1 /\ k = &6 /\ m = 238) \/ + (b = &1 /\ c = -- &1 /\ k = &7 /\ m = 287)`;; + +let CROSS124_GENERIC_CHILD_DATA = prove + (`!b c k m. + cross124_generic_child b c k m + ==> cross124_generic_offset m /\ + ((b = &0 /\ c = &0 /\ k = &m) \/ + &m = &7 * cross124_det b c k)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[cross124_generic_child] THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[cross124_generic_offset; cross124_det] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC INT_REDUCE_CONV);; + +let INT_CROSS124_OFFSET_COERCE = prove + (`!n m s:num. + m * s EXP 2 <= n + ==> &(n - m * s EXP 2) = + (&n:int) - &m * (&s:int) pow 2`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `(&n:int) - &(m * s EXP 2)` THEN + CONJ_TAC THENL + [MATCH_ACCEPT_TAC(SYM(MATCH_MP + (SPECL [`m * s EXP 2`; `n:num`] INT_OF_NUM_SUB) + (ASSUME `m * s EXP 2 <= n`))); + REWRITE_TAC[INT_OF_NUM_MUL; INT_OF_NUM_POW] THEN + CONV_TAC INT_RING]);; + +let CROSS124_GENERIC_CHILD_REP_SHIFT = prove + (`!b c k m s n. + cross124_generic_child b c k m /\ + m * s EXP 2 <= n /\ + (?x y z:int. + x pow 2 + &2 * y pow 2 + &2 * y * z + &4 * z pow 2 = + &(n - m * s EXP 2)) + ==> cross124_child_rep b c k n`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "child") + (CONJUNCTS_THEN2 (LABEL_TAC "bound") (LABEL_TAC "tern"))) THEN + MP_TAC(MATCH_MP + (SPECL [`b:int`; `c:int`; `k:int`; `m:num`] + CROSS124_GENERIC_CHILD_DATA) + (ASSUME `cross124_generic_child b c k m`)) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (DISJ_CASES_THEN (LABEL_TAC "data"))) THEN + MP_TAC(MATCH_MP + (SPECL [`n:num`; `m:num`; `s:num`] INT_CROSS124_OFFSET_COERCE) + (ASSUME `m * s EXP 2 <= n`)) THEN + DISCH_THEN(LABEL_TAC "coerce") THEN + REMOVE_THEN "tern" + (X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` + (X_CHOOSE_THEN `z:int` (LABEL_TAC "tern")))) THENL + [REWRITE_TAC[cross124_child_rep] THEN + MAP_EVERY EXISTS_TAC [`x:int`; `y:int`; `z:int`; `&s:int`] THEN + REMOVE_THEN "data" STRIP_ASSUME_TAC THEN ASM_REWRITE_TAC[] THEN + REMOVE_THEN "tern" MP_TAC THEN REMOVE_THEN "coerce" MP_TAC THEN + CONV_TAC INT_RING; + REWRITE_TAC[cross124_child_rep] THEN + MATCH_MP_TAC(SPECL + [`b:int`; `c:int`; `k:int`; `&s:int`; `&n:int`] + INT_REPRESENTS_CROSS124_CHILD_SHIFT7) THEN + MAP_EVERY EXISTS_TAC [`x:int`; `y:int`; `z:int`] THEN + REMOVE_THEN "tern" MP_TAC THEN REMOVE_THEN "coerce" MP_TAC THEN + REMOVE_THEN "data" MP_TAC THEN CONV_TAC INT_RING]);; + +let CROSS124_GENERIC_CHILD_REP_LARGE = prove + (`!b c k m n. + cross124_generic_child b c k m /\ + 81 * m < n /\ + ~(4 divides n) /\ ~(49 divides n) + ==> cross124_child_rep b c k n`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(MATCH_MP + (SPECL [`b:int`; `c:int`; `k:int`; `m:num`] + CROSS124_GENERIC_CHILD_DATA) + (ASSUME `cross124_generic_child b c k m`)) THEN + DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "offset") ASSUME_TAC) THEN + MP_TAC(SPECL [`m:num`; `n:num`] CROSS124_GENERIC_OFFSET_SHIFT) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; + DISCH_THEN(X_CHOOSE_THEN `s:num` STRIP_ASSUME_TAC)] THEN + SUBGOAL_THEN `m * s EXP 2 <= 81 * m` ASSUME_TAC THENL + [GEN_REWRITE_TAC RAND_CONV [MULT_SYM] THEN + MATCH_MP_TAC LE_MULT2 THEN REWRITE_TAC[LE_REFL] THEN + MP_TAC(SPECL [`s:num`; `9`; `2`] EXP_MONO_LE_IMP) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + SUBGOAL_THEN `0 < n - m * s EXP 2` ASSUME_TAC THENL + [ASM_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(SPECL + [`b:int`; `c:int`; `k:int`; `m:num`; `s:num`; `n:num`] + CROSS124_GENERIC_CHILD_REP_SHIFT) THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(SPEC `n - m * s EXP 2` DISC7_CROSS124_REGULAR) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + MATCH_MP_TAC DISC7_NOT_EXCEPTION_OF_MOD49 THEN ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]]; + MESON_TAC[]]);; + +let CROSS124_GENERIC_CHILD_REP_LARGE_OF_FINITE = prove + (`!b c k m h n. + cross124_generic_child b c k m /\ + (!r12 r49:num. + r12 < 12 /\ r49 < 49 /\ + ~(r12 MOD 4 = 0) /\ ~(r49 = 0) + ==> ?s. + 1 <= s /\ m * s EXP 2 <= h /\ + ~(num_shift_rem r12 (m * s EXP 2) 12 = 7) /\ + ~(num_shift_rem r12 (m * s EXP 2) 12 = 10) /\ + ~(num_shift_rem r49 (m * s EXP 2) 49 = 0) /\ + ~(num_shift_rem r49 (m * s EXP 2) 49 = 21) /\ + ~(num_shift_rem r49 (m * s EXP 2) 49 = 35) /\ + ~(num_shift_rem r49 (m * s EXP 2) 49 = 42)) /\ + h < n /\ ~(4 divides n) /\ ~(49 divides n) + ==> cross124_child_rep b c k n`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "child") + (CONJUNCTS_THEN2 (LABEL_TAC "finite") STRIP_ASSUME_TAC)) THEN + REMOVE_THEN "finite" (MP_TAC o SPECL [`n MOD 12`; `n MOD 49`]) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [REWRITE_TAC[MOD_LT_EQ] THEN CONV_TAC NUM_REDUCE_CONV; + REWRITE_TAC[MOD_LT_EQ] THEN CONV_TAC NUM_REDUCE_CONV; + UNDISCH_TAC `~(4 divides n)` THEN + REWRITE_TAC[DIVIDES_MOD; ARITH_RULE `12 = 4 * 3`; MOD_MOD]; + UNDISCH_TAC `~(49 divides n)` THEN REWRITE_TAC[DIVIDES_MOD]]; + DISCH_THEN(X_CHOOSE_THEN `s:num` STRIP_ASSUME_TAC)] THEN + SUBGOAL_THEN `m * s EXP 2 <= n` ASSUME_TAC THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `0 < n - m * s EXP 2` ASSUME_TAC THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + MP_TAC(SPECL [`n:num`; `m * s EXP 2`; `12`] NUM_MOD_SUB_EXACT) THEN + MP_TAC(SPECL [`n:num`; `m * s EXP 2`; `49`] NUM_MOD_SUB_EXACT) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN + REPEAT DISCH_TAC THEN + MATCH_MP_TAC(SPECL + [`b:int`; `c:int`; `k:int`; `m:num`; `s:num`; `n:num`] + CROSS124_GENERIC_CHILD_REP_SHIFT) THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(SPEC `n - m * s EXP 2` DISC7_CROSS124_REGULAR) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + MATCH_MP_TAC DISC7_NOT_EXCEPTION_OF_MOD49 THEN ASM_MESON_TAC[]; + ASM_MESON_TAC[]; + ASM_MESON_TAC[]]; + MESON_TAC[]]);; + +let cross124_needs_check = new_definition + `cross124_needs_check (n:num) <=> + disc7_exception n \/ n MOD 12 = 7 \/ n MOD 12 = 10`;; + +let CROSS124_CHILD_REP_REGULAR = prove + (`!b c k n. + 0 < n /\ ~cross124_needs_check n + ==> cross124_child_rep b c k n`, + REPEAT GEN_TAC THEN REWRITE_TAC[cross124_needs_check] THEN + STRIP_TAC THEN REWRITE_TAC[cross124_child_rep] THEN + MP_TAC(SPEC `n:num` DISC7_CROSS124_REGULAR) THEN + ANTS_TAC THENL + [ASM_MESON_TAC[]; + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` (X_CHOOSE_TAC `z:int`)))] THEN + MAP_EVERY EXISTS_TAC [`x:int`; `y:int`; `z:int`; `&0:int`] THEN + FIRST_X_ASSUM(MP_TAC) THEN CONV_TAC INT_RING);; + +let CROSS124_GENERIC_CHILD_REP_OF_BASE = prove + (`!b c k m. + cross124_generic_child b c k m /\ + (!n:num. + 0 < n /\ n <= 81 * m /\ + ~(4 divides n) /\ ~(49 divides n) /\ + cross124_needs_check n + ==> cross124_child_rep b c k n) + ==> !n:num. 0 < n ==> cross124_child_rep b c k n`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 + (LABEL_TAC "child") (LABEL_TAC "base")) THEN + MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN + DISCH_THEN(LABEL_TAC "ih") THEN DISCH_TAC THEN + ASM_CASES_TAC `4 divides n` THENL + [FIRST_X_ASSUM(X_CHOOSE_THEN `q:num` ASSUME_TAC o + REWRITE_RULE[divides]) THEN + SUBGOAL_THEN `q < n /\ 0 < q` STRIP_ASSUME_TAC THENL + [ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `n = 2 EXP 2 * q` SUBST1_TAC THENL + [UNDISCH_TAC `n = 4 * q` THEN CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + MATCH_MP_TAC(SPECL + [`b:int`; `c:int`; `k:int`; `2`; `q:num`] + CROSS124_CHILD_REP_SCALE) THEN + REMOVE_THEN "ih" (MP_TAC o SPEC `q:num`) THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + ASM_CASES_TAC `49 divides n` THENL + [FIRST_X_ASSUM(X_CHOOSE_THEN `q:num` ASSUME_TAC o + REWRITE_RULE[divides]) THEN + SUBGOAL_THEN `q < n /\ 0 < q` STRIP_ASSUME_TAC THENL + [ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `n = 7 EXP 2 * q` SUBST1_TAC THENL + [UNDISCH_TAC `n = 49 * q` THEN CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + MATCH_MP_TAC(SPECL + [`b:int`; `c:int`; `k:int`; `7`; `q:num`] + CROSS124_CHILD_REP_SCALE) THEN + REMOVE_THEN "ih" (MP_TAC o SPEC `q:num`) THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + ASM_CASES_TAC `n <= 81 * m` THENL + [ASM_CASES_TAC `cross124_needs_check n` THENL + [REMOVE_THEN "base" (MATCH_MP_TAC o SPEC `n:num`) THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC(SPECL + [`b:int`; `c:int`; `k:int`; `n:num`] + CROSS124_CHILD_REP_REGULAR) THEN + ASM_REWRITE_TAC[]]; + MATCH_MP_TAC(SPECL + [`b:int`; `c:int`; `k:int`; `m:num`; `n:num`] + CROSS124_GENERIC_CHILD_REP_LARGE) THEN + ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC]);; + +let cross124_maybe_check = new_definition + `cross124_maybe_check (n:num) <=> + n MOD 12 = 7 \/ n MOD 12 = 10 \/ + n MOD 49 = 0 \/ n MOD 49 = 21 \/ + n MOD 49 = 35 \/ n MOD 49 = 42`;; + +let CROSS124_NEEDS_IMP_MAYBE_CHECK = prove + (`!n:num. cross124_needs_check n ==> cross124_maybe_check n`, + GEN_TAC THEN + REWRITE_TAC[cross124_needs_check; cross124_maybe_check] THEN + DISCH_THEN(DISJ_CASES_THEN2 + (LABEL_TAC "exc") (DISJ_CASES_THEN ASSUME_TAC)) THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(MATCH_MP + (SPEC `n:num` DISC7_EXCEPTION_MOD49) + (ASSUME `disc7_exception n`)) THEN + MESON_TAC[]);; + +let cross124_num_of_int i = + if i < 0 + then minus_num(num_of_string(string_of_int(-i))) + else num_of_string(string_of_int i);; + +(* This search only generates witnesses. INT_REDUCE_CONV checks every + returned quadruple before it enters a theorem. *) +let CROSS124_CERT_TAC b c k = + fun (asl,goal) -> + let _,bod = strip_exists goal in + let _,rhs = dest_eq bod in + let n = int_of_string(string_of_num(dest_intconst rhs)) in + let d = 7*k - 4*b*b + 2*b*c - 2*c*c in + let isqrt r = int_of_float(float_sqrt(float_of_int r)) in + let signed i = + if i = 0 then 0 + else if i mod 2 = 1 then (i + 1) / 2 else -(i / 2) in + let check x y z w = + x*x + 2*y*y + 2*y*z + 4*z*z + + 2*b*y*w + 2*c*z*w + k*w*w = n in + let recover x w zz uu = + if (uu - zz) mod 2 <> 0 then None else + let yy = (uu - zz) / 2 in + let yn = yy - (4*b - c)*w + and zn = zz - (-b + 2*c)*w in + if yn mod 7 <> 0 || zn mod 7 <> 0 then None else + let y = yn / 7 and z = zn / 7 in + if check x y z w then Some(x,y,z,w) else None in + let wmax = isqrt((7*n) / d) in + let rec find_w iw = + if iw > 2*wmax then failwith "CROSS124_CERT_TAC" else + let w = signed iw in + let r = 49*n - 7*d*w*w in + if r < 0 then find_w (iw + 1) else + let xmax = isqrt(r / 49) in + let rec find_x x = + if x > xmax then find_w (iw + 1) else + let t = 2*(r - 49*x*x) in + let zmax = isqrt(t / 7) in + let rec find_z iz = + if iz > 2*zmax then find_x (x + 1) else + let zz = signed iz in + let u2 = t - 7*zz*zz in + if u2 < 0 then find_z (iz + 1) else + let u = isqrt u2 in + if u*u <> u2 then find_z (iz + 1) else + match recover x w zz u with + | Some ans -> ans + | None -> + if u = 0 then find_z (iz + 1) else + match recover x w zz (-u) with + | Some ans -> ans + | None -> find_z (iz + 1) in + find_z 0 in + find_x 0 in + let x,y,z,w = find_w 0 in + (MAP_EVERY EXISTS_TAC + (map (mk_intconst o cross124_num_of_int) [x;y;z;w]) THEN + CONV_TAC INT_REDUCE_CONV) (asl,goal);; + +let CROSS124_BASE_TAC b c k hi = + GEN_TAC THEN STRIP_TAC THEN + NUM_RANGE_CASES_THEN `n:num` hi + (TRY ASM_ARITH_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[cross124_maybe_check]) THEN + RULE_ASSUM_TAC(CONV_RULE NUM_REDUCE_CONV) THEN + TRY CROSS124_CONTR_FALSE_ASSUM_TAC THEN + REWRITE_TAC[cross124_child_rep] THEN + CONV_TAC NUM_REDUCE_CONV THEN CROSS124_CERT_TAC b c k);; + +let CROSS124_DIAG1_BASE = prove + (`!n:num. + 0 < n /\ n <= 81 /\ + ~(4 divides n) /\ ~(49 divides n) /\ + cross124_maybe_check n + ==> cross124_child_rep (&0) (&0) (&1) n`, + CROSS124_BASE_TAC 0 0 1 81);; + +let CROSS124_DIAG2_BASE = prove + (`!n:num. + 0 < n /\ n <= 162 /\ + ~(4 divides n) /\ ~(49 divides n) /\ + cross124_maybe_check n + ==> cross124_child_rep (&0) (&0) (&2) n`, + CROSS124_BASE_TAC 0 0 2 162);; + +let CROSS124_DIAG4_BASE = prove + (`!n:num. + 0 < n /\ n <= 324 /\ + ~(4 divides n) /\ ~(49 divides n) /\ + cross124_maybe_check n + ==> cross124_child_rep (&0) (&0) (&4) n`, + CROSS124_BASE_TAC 0 0 4 324);; + +let CROSS124_DIAG5_BASE = prove + (`!n:num. + 0 < n /\ n <= 405 /\ + ~(4 divides n) /\ ~(49 divides n) /\ + cross124_maybe_check n + ==> cross124_child_rep (&0) (&0) (&5) n`, + CROSS124_BASE_TAC 0 0 5 405);; + +let CROSS124_DIAG6_BASE = prove + (`!n:num. + 0 < n /\ n <= 486 /\ + ~(4 divides n) /\ ~(49 divides n) /\ + cross124_maybe_check n + ==> cross124_child_rep (&0) (&0) (&6) n`, + CROSS124_BASE_TAC 0 0 6 486);; + +let CROSS124_DIAG7_BASE = prove + (`!n:num. + 0 < n /\ n <= 567 /\ + ~(4 divides n) /\ ~(49 divides n) /\ + cross124_maybe_check n + ==> cross124_child_rep (&0) (&0) (&7) n`, + CROSS124_BASE_TAC 0 0 7 567);; + +let CROSS124_GENERIC_CHILD_UNIVERSAL_OF_MAYBE_BASE = prove + (`!b c k m. + cross124_generic_child b c k m /\ + (!n:num. + 0 < n /\ n <= 81 * m /\ + ~(4 divides n) /\ ~(49 divides n) /\ + cross124_maybe_check n + ==> cross124_child_rep b c k n) + ==> !n:num. 0 < n ==> cross124_child_rep b c k n`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 + (LABEL_TAC "child") (LABEL_TAC "base")) THEN + MATCH_MP_TAC(SPECL + [`b:int`; `c:int`; `k:int`; `m:num`] + CROSS124_GENERIC_CHILD_REP_OF_BASE) THEN + ASM_REWRITE_TAC[] THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN + REMOVE_THEN "base" (MATCH_MP_TAC o SPEC `n:num`) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC CROSS124_NEEDS_IMP_MAYBE_CHECK THEN ASM_REWRITE_TAC[]);; + +let CROSS124_GENERIC_CHILD_UNIVERSAL_OF_FINITE_BASE = prove + (`!b c k m h. + cross124_generic_child b c k m /\ + (!r12 r49:num. + r12 < 12 /\ r49 < 49 /\ + ~(r12 MOD 4 = 0) /\ ~(r49 = 0) + ==> ?s. + 1 <= s /\ m * s EXP 2 <= h /\ + ~(num_shift_rem r12 (m * s EXP 2) 12 = 7) /\ + ~(num_shift_rem r12 (m * s EXP 2) 12 = 10) /\ + ~(num_shift_rem r49 (m * s EXP 2) 49 = 0) /\ + ~(num_shift_rem r49 (m * s EXP 2) 49 = 21) /\ + ~(num_shift_rem r49 (m * s EXP 2) 49 = 35) /\ + ~(num_shift_rem r49 (m * s EXP 2) 49 = 42)) /\ + (!n:num. + 0 < n /\ n <= h /\ + ~(4 divides n) /\ ~(49 divides n) /\ + cross124_maybe_check n + ==> cross124_child_rep b c k n) + ==> !n:num. 0 < n ==> cross124_child_rep b c k n`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "child") + (CONJUNCTS_THEN2 (LABEL_TAC "finite") (LABEL_TAC "base"))) THEN + MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN + DISCH_THEN(LABEL_TAC "ih") THEN DISCH_TAC THEN + ASM_CASES_TAC `4 divides n` THENL + [FIRST_X_ASSUM(X_CHOOSE_THEN `q:num` ASSUME_TAC o + REWRITE_RULE[divides]) THEN + SUBGOAL_THEN `q < n /\ 0 < q` STRIP_ASSUME_TAC THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `n = 2 EXP 2 * q` SUBST1_TAC THENL + [UNDISCH_TAC `n = 4 * q` THEN CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + MATCH_MP_TAC(SPECL + [`b:int`; `c:int`; `k:int`; `2`; `q:num`] + CROSS124_CHILD_REP_SCALE) THEN + REMOVE_THEN "ih" (MP_TAC o SPEC `q:num`) THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + ASM_CASES_TAC `49 divides n` THENL + [FIRST_X_ASSUM(X_CHOOSE_THEN `q:num` ASSUME_TAC o + REWRITE_RULE[divides]) THEN + SUBGOAL_THEN `q < n /\ 0 < q` STRIP_ASSUME_TAC THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `n = 7 EXP 2 * q` SUBST1_TAC THENL + [UNDISCH_TAC `n = 49 * q` THEN CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + MATCH_MP_TAC(SPECL + [`b:int`; `c:int`; `k:int`; `7`; `q:num`] + CROSS124_CHILD_REP_SCALE) THEN + REMOVE_THEN "ih" (MP_TAC o SPEC `q:num`) THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + ASM_CASES_TAC `(n:num) <= h` THENL + [ASM_CASES_TAC `cross124_maybe_check n` THENL + [REMOVE_THEN "base" + (fun th -> + MATCH_ACCEPT_TAC(MATCH_MP (SPEC `n:num` th) + (end_itlist CONJ + [ASSUME `0 < (n:num)`; + ASSUME `(n:num) <= h`; + ASSUME `~(4 divides (n:num))`; + ASSUME `~(49 divides (n:num))`; + ASSUME `cross124_maybe_check (n:num)`]))); + MATCH_MP_TAC(SPECL + [`b:int`; `c:int`; `k:int`; `n:num`] + CROSS124_CHILD_REP_REGULAR) THEN + ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[CROSS124_NEEDS_IMP_MAYBE_CHECK]]; + SUBGOAL_THEN `(h:num) < n` ASSUME_TAC THENL + [REWRITE_TAC[GSYM NOT_LE] THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC(SPECL + [`b:int`; `c:int`; `k:int`; `m:num`; `h:num`; `n:num`] + CROSS124_GENERIC_CHILD_REP_LARGE_OF_FINITE) THEN + ASM_REWRITE_TAC[]]);; + +let CROSS124_DIAG1_UNIVERSAL = prove + (`!n:num. 0 < n ==> cross124_child_rep (&0) (&0) (&1) n`, + MATCH_MP_TAC(ISPECL + [`&0:int`; `&0:int`; `&1:int`; `1:num`] + CROSS124_GENERIC_CHILD_UNIVERSAL_OF_MAYBE_BASE) THEN + CONJ_TAC THENL + [REWRITE_TAC[cross124_generic_child]; + X_GEN_TAC `n:num` THEN CONV_TAC NUM_REDUCE_CONV THEN + MATCH_ACCEPT_TAC(SPEC `n:num` CROSS124_DIAG1_BASE)]);; + +let CROSS124_DIAG2_UNIVERSAL = prove + (`!n:num. 0 < n ==> cross124_child_rep (&0) (&0) (&2) n`, + MATCH_MP_TAC(ISPECL + [`&0:int`; `&0:int`; `&2:int`; `2:num`] + CROSS124_GENERIC_CHILD_UNIVERSAL_OF_MAYBE_BASE) THEN + CONJ_TAC THENL + [REWRITE_TAC[cross124_generic_child]; + X_GEN_TAC `n:num` THEN CONV_TAC NUM_REDUCE_CONV THEN + MATCH_ACCEPT_TAC(SPEC `n:num` CROSS124_DIAG2_BASE)]);; + +let CROSS124_DIAG4_UNIVERSAL = prove + (`!n:num. 0 < n ==> cross124_child_rep (&0) (&0) (&4) n`, + MATCH_MP_TAC(ISPECL + [`&0:int`; `&0:int`; `&4:int`; `4:num`] + CROSS124_GENERIC_CHILD_UNIVERSAL_OF_MAYBE_BASE) THEN + CONJ_TAC THENL + [REWRITE_TAC[cross124_generic_child]; + X_GEN_TAC `n:num` THEN CONV_TAC NUM_REDUCE_CONV THEN + MATCH_ACCEPT_TAC(SPEC `n:num` CROSS124_DIAG4_BASE)]);; + +let CROSS124_DIAG5_UNIVERSAL = prove + (`!n:num. 0 < n ==> cross124_child_rep (&0) (&0) (&5) n`, + MATCH_MP_TAC(ISPECL + [`&0:int`; `&0:int`; `&5:int`; `5:num`] + CROSS124_GENERIC_CHILD_UNIVERSAL_OF_MAYBE_BASE) THEN + CONJ_TAC THENL + [REWRITE_TAC[cross124_generic_child]; + X_GEN_TAC `n:num` THEN CONV_TAC NUM_REDUCE_CONV THEN + MATCH_ACCEPT_TAC(SPEC `n:num` CROSS124_DIAG5_BASE)]);; + +let CROSS124_DIAG6_UNIVERSAL = prove + (`!n:num. 0 < n ==> cross124_child_rep (&0) (&0) (&6) n`, + MATCH_MP_TAC(ISPECL + [`&0:int`; `&0:int`; `&6:int`; `6:num`] + CROSS124_GENERIC_CHILD_UNIVERSAL_OF_MAYBE_BASE) THEN + CONJ_TAC THENL + [REWRITE_TAC[cross124_generic_child]; + X_GEN_TAC `n:num` THEN CONV_TAC NUM_REDUCE_CONV THEN + MATCH_ACCEPT_TAC(SPEC `n:num` CROSS124_DIAG6_BASE)]);; + +let CROSS124_DIAG7_UNIVERSAL = prove + (`!n:num. 0 < n ==> cross124_child_rep (&0) (&0) (&7) n`, + MATCH_MP_TAC(ISPECL + [`&0:int`; `&0:int`; `&7:int`; `7:num`] + CROSS124_GENERIC_CHILD_UNIVERSAL_OF_MAYBE_BASE) THEN + CONJ_TAC THENL + [REWRITE_TAC[cross124_generic_child]; + X_GEN_TAC `n:num` THEN CONV_TAC NUM_REDUCE_CONV THEN + MATCH_ACCEPT_TAC(SPEC `n:num` CROSS124_DIAG7_BASE)]);; + +(* Quotient/remainder splitting keeps the recursive case depth modest. *) +let CROSS124_QUOTIENT_BASE_TAC b c k hi = + let qhi = hi / 100 in + let qbound = + mk_comb + (mk_comb(`(<=):num->num->bool`,`q:num`), + mk_small_numeral qhi) in + GEN_TAC THEN STRIP_TAC THEN + ABBREV_TAC `q = n DIV 100` THEN + ABBREV_TAC `r = n MOD 100` THEN + SUBGOAL_THEN `n = 100 * q + r` (LABEL_TAC "decomp") THENL + [EXPAND_TAC "q" THEN EXPAND_TAC "r" THEN + MP_TAC(SPECL [`n:num`; `100`] (CONJUNCT2 DIVISION_SIMP)) THEN + ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `r < 100` ASSUME_TAC THENL + [EXPAND_TAC "r" THEN REWRITE_TAC[MOD_LT_EQ] THEN + CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + SUBGOAL_THEN qbound ASSUME_TAC THENL + [USE_THEN "decomp" MP_TAC THEN ASM_ARITH_TAC; + ALL_TAC] THEN + NUM_INTERVAL_CASES_THEN `q:num` 0 qhi + (NUM_RANGE_CASES_THEN `r:num` 99 + (REMOVE_THEN "decomp" SUBST_ALL_TAC THEN + TRY ASM_ARITH_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[cross124_maybe_check]) THEN + RULE_ASSUM_TAC(CONV_RULE NUM_REDUCE_CONV) THEN + TRY CROSS124_CONTR_FALSE_ASSUM_TAC THEN + REWRITE_TAC[cross124_child_rep] THEN + CONV_TAC NUM_REDUCE_CONV THEN CROSS124_CERT_TAC b c k));; + +let CROSS124_0_NEG1_1_BASE = prove + (`!n:num. + 0 < n /\ n <= 2835 /\ + ~(4 divides n) /\ ~(49 divides n) /\ + cross124_maybe_check n + ==> cross124_child_rep (&0) (-- &1) (&1) n`, + CROSS124_QUOTIENT_BASE_TAC 0 (-1) 1 2835);; + +let CROSS124_0_NEG1_1_UNIVERSAL = prove + (`!n:num. 0 < n ==> cross124_child_rep (&0) (-- &1) (&1) n`, + MATCH_MP_TAC(ISPECL + [`&0:int`; `-- &1:int`; `&1:int`; `35:num`] + CROSS124_GENERIC_CHILD_UNIVERSAL_OF_MAYBE_BASE) THEN + CONJ_TAC THENL + [REWRITE_TAC[cross124_generic_child]; + X_GEN_TAC `n:num` THEN CONV_TAC NUM_REDUCE_CONV THEN + MATCH_ACCEPT_TAC(SPEC `n:num` CROSS124_0_NEG1_1_BASE)]);; + +let CROSS124_1_NEG1_2_BASE = prove + (`!n:num. + 0 < n /\ n <= 3402 /\ + ~(4 divides n) /\ ~(49 divides n) /\ + cross124_maybe_check n + ==> cross124_child_rep (&1) (-- &1) (&2) n`, + CROSS124_QUOTIENT_BASE_TAC 1 (-1) 2 3402);; + +let CROSS124_1_NEG1_2_UNIVERSAL = prove + (`!n:num. 0 < n ==> cross124_child_rep (&1) (-- &1) (&2) n`, + MATCH_MP_TAC(ISPECL + [`&1:int`; `-- &1:int`; `&2:int`; `42:num`] + CROSS124_GENERIC_CHILD_UNIVERSAL_OF_MAYBE_BASE) THEN + CONJ_TAC THENL + [REWRITE_TAC[cross124_generic_child]; + X_GEN_TAC `n:num` THEN CONV_TAC NUM_REDUCE_CONV THEN + MATCH_ACCEPT_TAC(SPEC `n:num` CROSS124_1_NEG1_2_BASE)]);; + +let CROSS124_10_2_BASE = prove + (`!n:num. + 0 < n /\ n <= 5670 /\ + ~(4 divides n) /\ ~(49 divides n) /\ + cross124_maybe_check n + ==> cross124_child_rep (&1) (&0) (&2) n`, + CROSS124_QUOTIENT_BASE_TAC 1 0 2 5670);; + +let CROSS124_10_2_UNIVERSAL = prove + (`!n:num. 0 < n ==> cross124_child_rep (&1) (&0) (&2) n`, + MATCH_MP_TAC(ISPECL + [`&1:int`; `&0:int`; `&2:int`; `70:num`] + CROSS124_GENERIC_CHILD_UNIVERSAL_OF_MAYBE_BASE) THEN + CONJ_TAC THENL + [REWRITE_TAC[cross124_generic_child]; + X_GEN_TAC `n:num` THEN CONV_TAC NUM_REDUCE_CONV THEN + MATCH_ACCEPT_TAC(SPEC `n:num` CROSS124_10_2_BASE)]);; + +let CROSS124_1_NEG1_3_BASE = prove + (`!n:num. + 0 < n /\ n <= 7371 /\ + ~(4 divides n) /\ ~(49 divides n) /\ + cross124_maybe_check n + ==> cross124_child_rep (&1) (-- &1) (&3) n`, + CROSS124_QUOTIENT_BASE_TAC 1 (-1) 3 7371);; + +let CROSS124_1_NEG1_3_UNIVERSAL = prove + (`!n:num. 0 < n ==> cross124_child_rep (&1) (-- &1) (&3) n`, + MATCH_MP_TAC(ISPECL + [`&1:int`; `-- &1:int`; `&3:int`; `91:num`] + CROSS124_GENERIC_CHILD_UNIVERSAL_OF_MAYBE_BASE) THEN + CONJ_TAC THENL + [REWRITE_TAC[cross124_generic_child]; + X_GEN_TAC `n:num` THEN CONV_TAC NUM_REDUCE_CONV THEN + MATCH_ACCEPT_TAC(SPEC `n:num` CROSS124_1_NEG1_3_BASE)]);; + +let CROSS124_10_3_BASE = prove + (`!n:num. + 0 < n /\ n <= 9639 /\ + ~(4 divides n) /\ ~(49 divides n) /\ + cross124_maybe_check n + ==> cross124_child_rep (&1) (&0) (&3) n`, + CROSS124_QUOTIENT_BASE_TAC 1 0 3 9639);; + +let CROSS124_10_3_UNIVERSAL = prove + (`!n:num. 0 < n ==> cross124_child_rep (&1) (&0) (&3) n`, + MATCH_MP_TAC(ISPECL + [`&1:int`; `&0:int`; `&3:int`; `119:num`] + CROSS124_GENERIC_CHILD_UNIVERSAL_OF_MAYBE_BASE) THEN + CONJ_TAC THENL + [REWRITE_TAC[cross124_generic_child]; + X_GEN_TAC `n:num` THEN CONV_TAC NUM_REDUCE_CONV THEN + MATCH_ACCEPT_TAC(SPEC `n:num` CROSS124_10_3_BASE)]);; + +let CROSS124_0_NEG1_3_FINITE_SHIFT = prove + (`!r12 r49:num. + r12 < 12 /\ r49 < 49 /\ ~(r12 MOD 4 = 0) /\ ~(r49 = 0) + ==> ?s. + 1 <= s /\ 133 * s EXP 2 <= 10773 /\ + ~(num_shift_rem r12 (133 * s EXP 2) 12 = 7) /\ + ~(num_shift_rem r12 (133 * s EXP 2) 12 = 10) /\ + ~(num_shift_rem r49 (133 * s EXP 2) 49 = 0) /\ + ~(num_shift_rem r49 (133 * s EXP 2) 49 = 21) /\ + ~(num_shift_rem r49 (133 * s EXP 2) 49 = 35) /\ + ~(num_shift_rem r49 (133 * s EXP 2) 49 = 42)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + NUM_RANGE_CASES_THEN `r12:num` 11 + (NUM_RANGE_CASES_THEN `r49:num` 48 + (RULE_ASSUM_TAC(CONV_RULE NUM_REDUCE_CONV) THEN + TRY CROSS124_CONTR_FALSE_ASSUM_TAC THEN + CROSS124_FINITE_SHIFT_TAC)));; + +let CROSS124_0_NEG1_3_BASE = prove + (`!n:num. + 0 < n /\ n <= 10773 /\ + ~(4 divides n) /\ ~(49 divides n) /\ + cross124_maybe_check n + ==> cross124_child_rep (&0) (-- &1) (&3) n`, + CROSS124_QUOTIENT_BASE_TAC 0 (-1) 3 10773);; + +let CROSS124_0_NEG1_3_UNIVERSAL = prove + (`!n:num. 0 < n ==> cross124_child_rep (&0) (-- &1) (&3) n`, + MATCH_MP_TAC(ISPECL + [`&0:int`; `-- &1:int`; `&3:int`; `133:num`; `10773:num`] + CROSS124_GENERIC_CHILD_UNIVERSAL_OF_FINITE_BASE) THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[cross124_generic_child]; + MATCH_ACCEPT_TAC CROSS124_0_NEG1_3_FINITE_SHIFT; + MATCH_ACCEPT_TAC CROSS124_0_NEG1_3_BASE]);; + +let CROSS124_1_NEG1_4_FINITE_SHIFT = prove + (`!r12 r49:num. + r12 < 12 /\ r49 < 49 /\ ~(r12 MOD 4 = 0) /\ ~(r49 = 0) + ==> ?s. + 1 <= s /\ 140 * s EXP 2 <= 11340 /\ + ~(num_shift_rem r12 (140 * s EXP 2) 12 = 7) /\ + ~(num_shift_rem r12 (140 * s EXP 2) 12 = 10) /\ + ~(num_shift_rem r49 (140 * s EXP 2) 49 = 0) /\ + ~(num_shift_rem r49 (140 * s EXP 2) 49 = 21) /\ + ~(num_shift_rem r49 (140 * s EXP 2) 49 = 35) /\ + ~(num_shift_rem r49 (140 * s EXP 2) 49 = 42)`, + CROSS124_BOUNDED_FINITE_SHIFT_SELECTOR_TAC);; + +let CROSS124_1_NEG1_4_BASE = prove + (`!n:num. + 0 < n /\ n <= 11340 /\ + ~(4 divides n) /\ ~(49 divides n) /\ + cross124_maybe_check n + ==> cross124_child_rep (&1) (-- &1) (&4) n`, + CROSS124_QUOTIENT_BASE_TAC 1 (-1) 4 11340);; + +let CROSS124_1_NEG1_4_UNIVERSAL = prove + (`!n:num. 0 < n ==> cross124_child_rep (&1) (-- &1) (&4) n`, + MATCH_MP_TAC(ISPECL + [`&1:int`; `-- &1:int`; `&4:int`; `140:num`; `11340:num`] + CROSS124_GENERIC_CHILD_UNIVERSAL_OF_FINITE_BASE) THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[cross124_generic_child]; + MATCH_ACCEPT_TAC CROSS124_1_NEG1_4_FINITE_SHIFT; + MATCH_ACCEPT_TAC CROSS124_1_NEG1_4_BASE]);; + +let CROSS124_0_NEG1_4_FINITE_SHIFT = prove + (`!r12 r49:num. + r12 < 12 /\ r49 < 49 /\ ~(r12 MOD 4 = 0) /\ ~(r49 = 0) + ==> ?s. + 1 <= s /\ 182 * s EXP 2 <= 6552 /\ + ~(num_shift_rem r12 (182 * s EXP 2) 12 = 7) /\ + ~(num_shift_rem r12 (182 * s EXP 2) 12 = 10) /\ + ~(num_shift_rem r49 (182 * s EXP 2) 49 = 0) /\ + ~(num_shift_rem r49 (182 * s EXP 2) 49 = 21) /\ + ~(num_shift_rem r49 (182 * s EXP 2) 49 = 35) /\ + ~(num_shift_rem r49 (182 * s EXP 2) 49 = 42)`, + CROSS124_BOUNDED_FINITE_SHIFT_SELECTOR_TAC);; + +let CROSS124_0_NEG1_4_BASE = prove + (`!n:num. + 0 < n /\ n <= 6552 /\ + ~(4 divides n) /\ ~(49 divides n) /\ + cross124_maybe_check n + ==> cross124_child_rep (&0) (-- &1) (&4) n`, + CROSS124_QUOTIENT_BASE_TAC 0 (-1) 4 6552);; + +let CROSS124_0_NEG1_4_UNIVERSAL = prove + (`!n:num. 0 < n ==> cross124_child_rep (&0) (-- &1) (&4) n`, + MATCH_MP_TAC(ISPECL + [`&0:int`; `-- &1:int`; `&4:int`; `182:num`; `6552:num`] + CROSS124_GENERIC_CHILD_UNIVERSAL_OF_FINITE_BASE) THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[cross124_generic_child]; + MATCH_ACCEPT_TAC CROSS124_0_NEG1_4_FINITE_SHIFT; + MATCH_ACCEPT_TAC CROSS124_0_NEG1_4_BASE]);; + +let CROSS124_10_5_FINITE_SHIFT = prove + (`!r12 r49:num. + r12 < 12 /\ r49 < 49 /\ ~(r12 MOD 4 = 0) /\ ~(r49 = 0) + ==> ?s. + 1 <= s /\ 217 * s EXP 2 <= 17577 /\ + ~(num_shift_rem r12 (217 * s EXP 2) 12 = 7) /\ + ~(num_shift_rem r12 (217 * s EXP 2) 12 = 10) /\ + ~(num_shift_rem r49 (217 * s EXP 2) 49 = 0) /\ + ~(num_shift_rem r49 (217 * s EXP 2) 49 = 21) /\ + ~(num_shift_rem r49 (217 * s EXP 2) 49 = 35) /\ + ~(num_shift_rem r49 (217 * s EXP 2) 49 = 42)`, + CROSS124_BOUNDED_FINITE_SHIFT_SELECTOR_TAC);; + +let CROSS124_10_5_BASE = prove + (`!n:num. + 0 < n /\ n <= 17577 /\ + ~(4 divides n) /\ ~(49 divides n) /\ + cross124_maybe_check n + ==> cross124_child_rep (&1) (&0) (&5) n`, + CROSS124_QUOTIENT_BASE_TAC 1 0 5 17577);; + +let CROSS124_10_5_UNIVERSAL = prove + (`!n:num. 0 < n ==> cross124_child_rep (&1) (&0) (&5) n`, + MATCH_MP_TAC(ISPECL + [`&1:int`; `&0:int`; `&5:int`; `217:num`; `17577:num`] + CROSS124_GENERIC_CHILD_UNIVERSAL_OF_FINITE_BASE) THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[cross124_generic_child]; + MATCH_ACCEPT_TAC CROSS124_10_5_FINITE_SHIFT; + MATCH_ACCEPT_TAC CROSS124_10_5_BASE]);; + +let CROSS124_1_NEG1_6_FINITE_SHIFT = prove + (`!r12 r49:num. + r12 < 12 /\ r49 < 49 /\ ~(r12 MOD 4 = 0) /\ ~(r49 = 0) + ==> ?s. + 1 <= s /\ 238 * s EXP 2 <= 8568 /\ + ~(num_shift_rem r12 (238 * s EXP 2) 12 = 7) /\ + ~(num_shift_rem r12 (238 * s EXP 2) 12 = 10) /\ + ~(num_shift_rem r49 (238 * s EXP 2) 49 = 0) /\ + ~(num_shift_rem r49 (238 * s EXP 2) 49 = 21) /\ + ~(num_shift_rem r49 (238 * s EXP 2) 49 = 35) /\ + ~(num_shift_rem r49 (238 * s EXP 2) 49 = 42)`, + CROSS124_BOUNDED_FINITE_SHIFT_SELECTOR_TAC);; + +let CROSS124_1_NEG1_6_BASE = prove + (`!n:num. + 0 < n /\ n <= 8568 /\ + ~(4 divides n) /\ ~(49 divides n) /\ + cross124_maybe_check n + ==> cross124_child_rep (&1) (-- &1) (&6) n`, + CROSS124_QUOTIENT_BASE_TAC 1 (-1) 6 8568);; + +let CROSS124_1_NEG1_6_UNIVERSAL = prove + (`!n:num. 0 < n ==> cross124_child_rep (&1) (-- &1) (&6) n`, + MATCH_MP_TAC(ISPECL + [`&1:int`; `-- &1:int`; `&6:int`; `238:num`; `8568:num`] + CROSS124_GENERIC_CHILD_UNIVERSAL_OF_FINITE_BASE) THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[cross124_generic_child]; + MATCH_ACCEPT_TAC CROSS124_1_NEG1_6_FINITE_SHIFT; + MATCH_ACCEPT_TAC CROSS124_1_NEG1_6_BASE]);; + +let CROSS124_10_6_FINITE_SHIFT = prove + (`!r12 r49:num. + r12 < 12 /\ r49 < 49 /\ ~(r12 MOD 4 = 0) /\ ~(r49 = 0) + ==> ?s. + 1 <= s /\ 266 * s EXP 2 <= 9576 /\ + ~(num_shift_rem r12 (266 * s EXP 2) 12 = 7) /\ + ~(num_shift_rem r12 (266 * s EXP 2) 12 = 10) /\ + ~(num_shift_rem r49 (266 * s EXP 2) 49 = 0) /\ + ~(num_shift_rem r49 (266 * s EXP 2) 49 = 21) /\ + ~(num_shift_rem r49 (266 * s EXP 2) 49 = 35) /\ + ~(num_shift_rem r49 (266 * s EXP 2) 49 = 42)`, + CROSS124_BOUNDED_FINITE_SHIFT_SELECTOR_TAC);; + +let CROSS124_10_6_BASE = prove + (`!n:num. + 0 < n /\ n <= 9576 /\ + ~(4 divides n) /\ ~(49 divides n) /\ + cross124_maybe_check n + ==> cross124_child_rep (&1) (&0) (&6) n`, + CROSS124_QUOTIENT_BASE_TAC 1 0 6 9576);; + +let CROSS124_10_6_UNIVERSAL = prove + (`!n:num. 0 < n ==> cross124_child_rep (&1) (&0) (&6) n`, + MATCH_MP_TAC(ISPECL + [`&1:int`; `&0:int`; `&6:int`; `266:num`; `9576:num`] + CROSS124_GENERIC_CHILD_UNIVERSAL_OF_FINITE_BASE) THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[cross124_generic_child]; + MATCH_ACCEPT_TAC CROSS124_10_6_FINITE_SHIFT; + MATCH_ACCEPT_TAC CROSS124_10_6_BASE]);; + +let CROSS124_0_NEG1_6_FINITE_SHIFT = prove + (`!r12 r49:num. + r12 < 12 /\ r49 < 49 /\ ~(r12 MOD 4 = 0) /\ ~(r49 = 0) + ==> ?s. + 1 <= s /\ 280 * s EXP 2 <= 22680 /\ + ~(num_shift_rem r12 (280 * s EXP 2) 12 = 7) /\ + ~(num_shift_rem r12 (280 * s EXP 2) 12 = 10) /\ + ~(num_shift_rem r49 (280 * s EXP 2) 49 = 0) /\ + ~(num_shift_rem r49 (280 * s EXP 2) 49 = 21) /\ + ~(num_shift_rem r49 (280 * s EXP 2) 49 = 35) /\ + ~(num_shift_rem r49 (280 * s EXP 2) 49 = 42)`, + CROSS124_BOUNDED_FINITE_SHIFT_SELECTOR_TAC);; + +let CROSS124_0_NEG1_6_BASE = prove + (`!n:num. + 0 < n /\ n <= 22680 /\ + ~(4 divides n) /\ ~(49 divides n) /\ + cross124_maybe_check n + ==> cross124_child_rep (&0) (-- &1) (&6) n`, + CROSS124_QUOTIENT_BASE_TAC 0 (-1) 6 22680);; + +let CROSS124_0_NEG1_6_UNIVERSAL = prove + (`!n:num. 0 < n ==> cross124_child_rep (&0) (-- &1) (&6) n`, + MATCH_MP_TAC(ISPECL + [`&0:int`; `-- &1:int`; `&6:int`; `280:num`; `22680:num`] + CROSS124_GENERIC_CHILD_UNIVERSAL_OF_FINITE_BASE) THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[cross124_generic_child]; + MATCH_ACCEPT_TAC CROSS124_0_NEG1_6_FINITE_SHIFT; + MATCH_ACCEPT_TAC CROSS124_0_NEG1_6_BASE]);; + +let CROSS124_1_NEG1_7_FINITE_SHIFT = prove + (`!r12 r49:num. + r12 < 12 /\ r49 < 49 /\ ~(r12 MOD 4 = 0) /\ ~(r49 = 0) + ==> ?s. + 1 <= s /\ 287 * s EXP 2 <= 23247 /\ + ~(num_shift_rem r12 (287 * s EXP 2) 12 = 7) /\ + ~(num_shift_rem r12 (287 * s EXP 2) 12 = 10) /\ + ~(num_shift_rem r49 (287 * s EXP 2) 49 = 0) /\ + ~(num_shift_rem r49 (287 * s EXP 2) 49 = 21) /\ + ~(num_shift_rem r49 (287 * s EXP 2) 49 = 35) /\ + ~(num_shift_rem r49 (287 * s EXP 2) 49 = 42)`, + CROSS124_BOUNDED_FINITE_SHIFT_SELECTOR_TAC);; + +let CROSS124_1_NEG1_7_BASE = prove + (`!n:num. + 0 < n /\ n <= 23247 /\ + ~(4 divides n) /\ ~(49 divides n) /\ + cross124_maybe_check n + ==> cross124_child_rep (&1) (-- &1) (&7) n`, + CROSS124_QUOTIENT_BASE_TAC 1 (-1) 7 23247);; + +let CROSS124_1_NEG1_7_UNIVERSAL = prove + (`!n:num. 0 < n ==> cross124_child_rep (&1) (-- &1) (&7) n`, + MATCH_MP_TAC(ISPECL + [`&1:int`; `-- &1:int`; `&7:int`; `287:num`; `23247:num`] + CROSS124_GENERIC_CHILD_UNIVERSAL_OF_FINITE_BASE) THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[cross124_generic_child]; + MATCH_ACCEPT_TAC CROSS124_1_NEG1_7_FINITE_SHIFT; + MATCH_ACCEPT_TAC CROSS124_1_NEG1_7_BASE]);; + +let CROSS124_0_NEG1_7_FINITE_SHIFT = prove + (`!r12 r49:num. + r12 < 12 /\ r49 < 49 /\ ~(r12 MOD 4 = 0) /\ ~(r49 = 0) + ==> ?s. + 1 <= s /\ 329 * s EXP 2 <= 26649 /\ + ~(num_shift_rem r12 (329 * s EXP 2) 12 = 7) /\ + ~(num_shift_rem r12 (329 * s EXP 2) 12 = 10) /\ + ~(num_shift_rem r49 (329 * s EXP 2) 49 = 0) /\ + ~(num_shift_rem r49 (329 * s EXP 2) 49 = 21) /\ + ~(num_shift_rem r49 (329 * s EXP 2) 49 = 35) /\ + ~(num_shift_rem r49 (329 * s EXP 2) 49 = 42)`, + CROSS124_BOUNDED_FINITE_SHIFT_SELECTOR_TAC);; + +let CROSS124_0_NEG1_7_BASE = prove + (`!n:num. + 0 < n /\ n <= 26649 /\ + ~(4 divides n) /\ ~(49 divides n) /\ + cross124_maybe_check n + ==> cross124_child_rep (&0) (-- &1) (&7) n`, + CROSS124_QUOTIENT_BASE_TAC 0 (-1) 7 26649);; + +let CROSS124_0_NEG1_7_UNIVERSAL = prove + (`!n:num. 0 < n ==> cross124_child_rep (&0) (-- &1) (&7) n`, + MATCH_MP_TAC(ISPECL + [`&0:int`; `-- &1:int`; `&7:int`; `329:num`; `26649:num`] + CROSS124_GENERIC_CHILD_UNIVERSAL_OF_FINITE_BASE) THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[cross124_generic_child]; + MATCH_ACCEPT_TAC CROSS124_0_NEG1_7_FINITE_SHIFT; + MATCH_ACCEPT_TAC CROSS124_0_NEG1_7_BASE]);; + +(* The exceptional (1,0,4) child is Table 2's determinant-24 case. + The following parity transformations show that its ternary complement + represents every integer represented by x^2 + y^2 + 3z^2. *) + +let INT_REPRESENTS_DET3_COMPLEMENT = prove + (`!n a b c:int. + a pow 2 + b pow 2 + &3 * c pow 2 = n + ==> ?y z w. + y pow 2 + y * z + &2 * z pow 2 + + y * w + &2 * w pow 2 = n`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MP_TAC(SPEC `a:int` INT_PARITY_WITNESS) THEN + MP_TAC(SPEC `b:int` INT_PARITY_WITNESS) THEN + MP_TAC(SPEC `c:int` INT_PARITY_WITNESS) THEN + DISCH_THEN(DISJ_CASES_THEN (X_CHOOSE_THEN `C:int` ASSUME_TAC)) THEN + DISCH_THEN(DISJ_CASES_THEN (X_CHOOSE_THEN `B:int` ASSUME_TAC)) THEN + DISCH_THEN(DISJ_CASES_THEN (X_CHOOSE_THEN `A:int` ASSUME_TAC)) THENL + [MAP_EVERY EXISTS_TAC + [`--b - c:int`; `c - A:int`; `c + A:int`]; + MAP_EVERY EXISTS_TAC + [`--a - c:int`; `c - B:int`; `c + B:int`]; + MAP_EVERY EXISTS_TAC + [`--b - c:int`; `c - A:int`; `c + A:int`]; + MAP_EVERY EXISTS_TAC + [`--(&2 * A) + &2 * C - &1:int`; + `A - B + C:int`; `A + B + C + &1:int`]; + MAP_EVERY EXISTS_TAC + [`--b - c:int`; `c - A:int`; `c + A:int`]; + MAP_EVERY EXISTS_TAC + [`--a - c:int`; `c - B:int`; `c + B:int`]; + MAP_EVERY EXISTS_TAC + [`--b - c:int`; `c - A:int`; `c + A:int`]; + MP_TAC(SPEC `B:int` INT_PARITY_WITNESS) THEN + MP_TAC(SPEC `C:int` INT_PARITY_WITNESS) THEN + DISCH_THEN(DISJ_CASES_THEN (X_CHOOSE_THEN `Q:int` ASSUME_TAC)) THEN + DISCH_THEN(DISJ_CASES_THEN (X_CHOOSE_THEN `P:int` ASSUME_TAC)) THENL + [MAP_EVERY EXISTS_TAC + [`--(&2 * A + &1) + &2 * Q - &2 * P:int`; + `P - &5 * Q - &1:int`; `&3 * P + Q + &1:int`]; + MAP_EVERY EXISTS_TAC + [`--(&2 * A + &1) - &2 * P - &2 * Q - &2:int`; + `P + &5 * Q + &2:int`; `&3 * P - Q + &2:int`]; + MAP_EVERY EXISTS_TAC + [`--(&2 * A + &1) - &2 * P - &2 * Q - &2:int`; + `P + &5 * Q + &4:int`; `&3 * P - Q:int`]; + MAP_EVERY EXISTS_TAC + [`--(&2 * A + &1) + &2 * Q - &2 * P:int`; + `P - &5 * Q - &3:int`; `&3 * P + Q + &3:int`]]] THEN + MAP_EVERY UNDISCH_TAC + [`a pow 2 + b pow 2 + &3 * c pow 2 = n`] THEN + ASM_REWRITE_TAC[] THEN CONV_TAC INT_RING);; + +let CROSS124_10_4_REP_OF_1226 = prove + (`!n x a b c:int. + x pow 2 + &2 * a pow 2 + &2 * b pow 2 + &6 * c pow 2 = n + ==> ?x y z w:int. + x pow 2 + &2 * y pow 2 + &2 * y * z + &4 * z pow 2 + + &2 * y * w + &4 * w pow 2 = n`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MP_TAC(SPECL + [`(a:int) pow 2 + b pow 2 + &3 * c pow 2`; + `a:int`; `b:int`; `c:int`] INT_REPRESENTS_DET3_COMPLEMENT) THEN + REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `y:int` + (X_CHOOSE_THEN `z:int` (X_CHOOSE_TAC `w:int`))) THEN + MAP_EVERY EXISTS_TAC [`x:int`; `y:int`; `z:int`; `w:int`] THEN + FIRST_X_ASSUM(MP_TAC o check (is_eq o concl)) THEN + FIRST_X_ASSUM(MP_TAC o check (is_eq o concl)) THEN + CONV_TAC INT_RING);; + +let CROSS124_10_4_UNIVERSAL = prove + (`!n:num. 0 < n ==> cross124_child_rep (&1) (&0) (&4) n`, + REPEAT STRIP_TAC THEN + MP_TAC IQ_UNIVERSAL_1226 THEN + REWRITE_TAC[iq_universal; iq_represents] THEN + DISCH_THEN(MP_TAC o SPEC `&n:int`) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[INT_OF_NUM_LT]; + DISCH_THEN(X_CHOOSE_THEN `v:num->int` (LABEL_TAC "rep"))] THEN + REWRITE_TAC[cross124_child_rep] THEN + MP_TAC(SPECL + [`&n:int`; `v 0:int`; `v 1:int`; `v 2:int`; `v 3:int`] + CROSS124_10_4_REP_OF_1226) THEN + ANTS_TAC THENL + [REMOVE_THEN "rep" MP_TAC THEN + REWRITE_TAC[IQEVAL_DIAG4] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC INT_RING; + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` + (X_CHOOSE_THEN `z:int` + (X_CHOOSE_THEN `w:int` (LABEL_TAC "transferred")))))] THEN + MAP_EVERY EXISTS_TAC [`x:int`; `y:int`; `z:int`; `w:int`] THEN + REMOVE_THEN "transferred" MP_TAC THEN CONV_TAC INT_RING);; + +(* Some reduced children are closed more economically by a different + ternary sublattice than the original crossed <1,2,4>. *) + +let iqselect013 = new_definition + `iqselect013 i j = + if i = 0 then (if j = 0 then &1 else &0) + else if i = 1 then (if j = 1 then &1 else &0) + else if i = 2 then (if j = 3 then &1 else &0) + else &0`;; + +let IQ_EMBEDS_CROSS124_SELECT013 = prove + (`!n A b c k. + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) b (&4) c k) A + ==> iq_embeds n 3 + (iqmat3 (&1) (&0) (&0) (&2) b k) A`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(ISPECL + [`n:num`; `3`; + `iqgram 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) b (&4) c k) + iqselect013`; + `iqmat3 (&1) (&0) (&0) (&2) b k`; + `A:num->num->int`] IQ_EMBEDS_EQ) THEN + CONJ_TAC THENL + [MATCH_MP_TAC IQ_EMBEDS_CONGRUENCE THEN ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC THEN + (SUBGOAL_THEN `i = 0 \/ i = 1 \/ i = 2` MP_TAC THENL + [ASM_ARITH_TAC; ALL_TAC]) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + (SUBGOAL_THEN `j = 0 \/ j = 1 \/ j = 2` MP_TAC THENL + [ASM_ARITH_TAC; ALL_TAC]) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + ASM_REWRITE_TAC[iqgram; IQBILIN_MAT4; iqselect013; + iqmat4; iqmat3; iqsym] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC INT_RING]);; + +let iqselect111_cross124 = new_definition + `iqselect111_cross124 i j = + if i = 0 then (if j = 0 then &1 else &0) + else if i = 1 then (if j = 3 then &1 else &0) + else if i = 2 then + (if j = 1 then &1 else if j = 3 then -- &1 else &0) + else &0`;; + +let IQ_EMBEDS_CROSS124_10_1_EMBEDS_111 = prove + (`!n A. + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (&1) (&4) (&0) (&1)) A + ==> iq_embeds n 3 + (iqmat3 (&1) (&0) (&0) (&1) (&0) (&1)) A`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(ISPECL + [`n:num`; `3`; + `iqgram 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (&1) (&4) (&0) (&1)) + iqselect111_cross124`; + `iqmat3 (&1) (&0) (&0) (&1) (&0) (&1)`; + `A:num->num->int`] IQ_EMBEDS_EQ) THEN + CONJ_TAC THENL + [MATCH_MP_TAC IQ_EMBEDS_CONGRUENCE THEN ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC THEN + (SUBGOAL_THEN `i = 0 \/ i = 1 \/ i = 2` MP_TAC THENL + [ASM_ARITH_TAC; ALL_TAC]) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + (SUBGOAL_THEN `j = 0 \/ j = 1 \/ j = 2` MP_TAC THENL + [ASM_ARITH_TAC; ALL_TAC]) THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THEN + ASM_REWRITE_TAC[iqgram; IQBILIN_MAT4; iqselect111_cross124; + iqmat4; iqmat3; iqsym] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC INT_RING]);; + +let IQ_UNIVERSAL_OF_CROSS124_00_3_CHILD = prove + (`!n A. + iq_symmetric n A /\ iq_positive n A /\ + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (&0) (&4) (&0) (&3)) A /\ + iq_represents n A (&10) + ==> iq_universal n A`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC(SPECL [`n:num`; `A:num->num->int`] + IQ_UNIVERSAL_OF_EMBEDS_123) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(ISPECL + [`n:num`; `A:num->num->int`; `&0`; `&0`; `&3`] + IQ_EMBEDS_CROSS124_SELECT013) THEN + ASM_REWRITE_TAC[]);; + +let IQ_UNIVERSAL_OF_CROSS124_10_1_CHILD = prove + (`!n A. + iq_symmetric n A /\ iq_positive n A /\ + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (&1) (&4) (&0) (&1)) A /\ + iq_represents n A (&7) + ==> iq_universal n A`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC(SPECL [`n:num`; `A:num->num->int`] + IQ_UNIVERSAL_OF_EMBEDS_111) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC IQ_EMBEDS_CROSS124_10_1_EMBEDS_111 THEN + ASM_REWRITE_TAC[]);; + +let IQ_UNIVERSAL_OF_CROSS124_0_NEG1_5_CHILD = prove + (`!n A. + iq_symmetric n A /\ iq_positive n A /\ + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (&0) (&4) (-- &1) (&5)) A /\ + iq_represents n A (&10) /\ + iq_represents n A (&15) + ==> iq_universal n A`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC(SPECL [`n:num`; `A:num->num->int`] + IQ_UNIVERSAL_OF_EMBEDS_125) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(ISPECL + [`n:num`; `A:num->num->int`; `&0`; `-- &1`; `&5`] + IQ_EMBEDS_CROSS124_SELECT013) THEN + ASM_REWRITE_TAC[]);; + +let IQ_UNIVERSAL_OF_CROSS124_1_NEG1_5_CHILD = prove + (`!n A. + iq_symmetric n A /\ iq_positive n A /\ + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) (&1) (&4) (-- &1) (&5)) A /\ + iq_represents n A (&7) /\ + iq_represents n A (&15) + ==> iq_universal n A`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC(SPECL [`n:num`; `A:num->num->int`] + IQ_UNIVERSAL_OF_EMBEDS_CROSS125) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(ISPECL + [`n:num`; `A:num->num->int`; `&1`; `-- &1`; `&5`] + IQ_EMBEDS_CROSS124_SELECT013) THEN + ASM_REWRITE_TAC[]);; + +(* The exceptional (1,0,7) form contains twice the crossed <1,2,5> + ternary form, with an orthogonal complement of norm 90. *) + +let INT_CROSS124_10_7_TABLE2_IDENTITY = prove + (`!a b c s:int. + (-- &2 * b - c) pow 2 + + &2 * (--a - c - s) pow 2 + + &2 * (--a - c - s) * (c + &4 * s) + + &4 * (c + &4 * s) pow 2 + + &2 * (--a - c - s) * (c - &2 * s) + + &7 * (c - &2 * s) pow 2 = + &2 * (a pow 2 + &2 * b pow 2 + &2 * b * c + &5 * c pow 2) + + &90 * s pow 2`, + REPEAT GEN_TAC THEN CONV_TAC INT_RING);; + +let CROSS124_10_7_EVEN_SHIFT = prove + (`!q s:num. + 45 * s EXP 2 <= q /\ + ~(?a m. q - 45 * s EXP 2 = 4 EXP a * (8 * m + 7)) + ==> cross124_child_rep (&1) (&0) (&7) (2 * q)`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 + (LABEL_TAC "bound") (LABEL_TAC "not_exception")) THEN + MP_TAC(MATCH_MP + (SPEC `q - 45 * s EXP 2` INT_REPRESENTS_CROSS125_OF_LEGENDRE) + (ASSUME + `~(?a m. q - 45 * s EXP 2 = 4 EXP a * (8 * m + 7))`)) THEN + DISCH_THEN(X_CHOOSE_THEN `a:int` + (X_CHOOSE_THEN `b:int` + (X_CHOOSE_THEN `c:int` (LABEL_TAC "ternary")))) THEN + REWRITE_TAC[cross124_child_rep] THEN + MAP_EVERY EXISTS_TAC + [`-- &2 * b - c:int`; + `--a - c - &s:int`; + `c + &4 * &s:int`; + `c - &2 * &s:int`] THEN + MP_TAC(SPECL [`a:int`; `b:int`; `c:int`; `&s:int`] + INT_CROSS124_10_7_TABLE2_IDENTITY) THEN + MP_TAC(MATCH_MP + (SPECL [`q:num`; `45`; `s:num`] INT_CROSS124_OFFSET_COERCE) + (ASSUME `45 * s EXP 2 <= q`)) THEN + REMOVE_THEN "ternary" MP_TAC THEN + REWRITE_TAC[GSYM INT_OF_NUM_MUL; GSYM INT_OF_NUM_POW] THEN + CONV_TAC INT_RING);; + +let CROSS124_90_FINITE_SHIFT_TAC = + FIRST + (map + (fun s -> + EXISTS_TAC (mk_small_numeral s) THEN + REWRITE_TAC[num_shift_rem] THEN + CONV_TAC NUM_REDUCE_CONV THEN ACCEPT_TAC TRUTH) + [1;2]);; + +let CROSS124_90_RESIDUE_SELECTOR = prove + (`!r:num. + r < 8 /\ r MOD 2 = 1 + ==> ?s. + 1 <= s /\ s <= 2 /\ + ~((num_shift_rem r (45 * s EXP 2) 8) MOD 4 = 0) /\ + ~(num_shift_rem r (45 * s EXP 2) 8 = 7)`, + GEN_TAC THEN STRIP_TAC THEN + NUM_RANGE_CASES_THEN `r:num` 7 + (RULE_ASSUM_TAC(CONV_RULE NUM_REDUCE_CONV) THEN + TRY CROSS124_CONTR_FALSE_ASSUM_TAC THEN + CROSS124_90_FINITE_SHIFT_TAC));; + +let CROSS124_10_7_EVEN_LARGE = prove + (`!q:num. + 252 < q /\ q MOD 2 = 1 + ==> cross124_child_rep (&1) (&0) (&7) (2 * q)`, + GEN_TAC THEN STRIP_TAC THEN + MP_TAC(SPEC `q MOD 8` CROSS124_90_RESIDUE_SELECTOR) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [REWRITE_TAC[MOD_LT_EQ] THEN CONV_TAC NUM_REDUCE_CONV; + SUBGOAL_THEN `q MOD 8 MOD 2 = q MOD 2` SUBST1_TAC THENL + [REWRITE_TAC[ARITH_RULE `8 = 2 * 4`; MOD_MOD]; + ASM_REWRITE_TAC[]]]; + DISCH_THEN(X_CHOOSE_THEN `s:num` STRIP_ASSUME_TAC)] THEN + SUBGOAL_THEN `s = 1 \/ s = 2` (LABEL_TAC "s_cases") THENL + [UNDISCH_TAC `1 <= s` THEN UNDISCH_TAC `s <= 2` THEN ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `45 * s EXP 2 <= q` ASSUME_TAC THENL + [REMOVE_THEN "s_cases" (DISJ_CASES_THEN SUBST_ALL_TAC) THEN + CONV_TAC NUM_REDUCE_CONV THEN ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `(q - 45 * s EXP 2) MOD 8 = + num_shift_rem (q MOD 8) (45 * s EXP 2) 8` + ASSUME_TAC THENL + [MATCH_MP_TAC NUM_MOD_SUB_EXACT THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + MATCH_MP_TAC(SPECL [`q:num`; `s:num`] CROSS124_10_7_EVEN_SHIFT) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(SPEC `q - 45 * s EXP 2` THREE_SQUARES_AVOIDS_OF_MOD) THEN + CONJ_TAC THENL + [SUBGOAL_THEN + `(q - 45 * s EXP 2) MOD 4 = + (q - 45 * s EXP 2) MOD 8 MOD 4` + SUBST1_TAC THENL + [REWRITE_TAC[ARITH_RULE `8 = 4 * 2`; MOD_MOD]; + ASM_REWRITE_TAC[]]; + ASM_REWRITE_TAC[]]);; + +(* For odd targets, the original crossed <1,2,4> complement has norm 315. + Nine square shifts suffice to avoid both exceptional residue sets. *) + +let CROSS124_315_RESIDUE_SELECTOR = prove + (`!r12 r49:num. + r12 < 12 /\ r49 < 49 /\ r12 MOD 2 = 1 + ==> ?s. + 1 <= s /\ 315 * s EXP 2 <= 25515 /\ + ~(num_shift_rem r12 (315 * s EXP 2) 12 = 7) /\ + ~(num_shift_rem r12 (315 * s EXP 2) 12 = 10) /\ + ~(num_shift_rem r49 (315 * s EXP 2) 49 = 0) /\ + ~(num_shift_rem r49 (315 * s EXP 2) 49 = 21) /\ + ~(num_shift_rem r49 (315 * s EXP 2) 49 = 35) /\ + ~(num_shift_rem r49 (315 * s EXP 2) 49 = 42)`, + CROSS124_BOUNDED_FINITE_SHIFT_SELECTOR_TAC);; + +let CROSS124_10_7_ODD_SHIFT = prove + (`!n s:num. + 315 * s EXP 2 <= n /\ + (?x y z:int. + x pow 2 + &2 * y pow 2 + &2 * y * z + &4 * z pow 2 = + &(n - 315 * s EXP 2)) + ==> cross124_child_rep (&1) (&0) (&7) n`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "bound") (LABEL_TAC "tern")) THEN + REWRITE_TAC[cross124_child_rep] THEN + MATCH_MP_TAC(SPECL + [`&1:int`; `&0:int`; `&7:int`; `&s:int`; `&n:int`] + INT_REPRESENTS_CROSS124_CHILD_SHIFT7) THEN + REMOVE_THEN "tern" + (X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` (X_CHOOSE_THEN `z:int` (LABEL_TAC "tern")))) THEN + MAP_EVERY EXISTS_TAC [`x:int`; `y:int`; `z:int`] THEN + MP_TAC(MATCH_MP + (SPECL [`n:num`; `315`; `s:num`] INT_CROSS124_OFFSET_COERCE) + (ASSUME `315 * s EXP 2 <= n`)) THEN + REMOVE_THEN "tern" MP_TAC THEN + REWRITE_TAC[cross124_det; GSYM INT_OF_NUM_POW] THEN + CONV_TAC INT_RING);; + +let CROSS124_10_7_ODD_LARGE = prove + (`!n:num. + 25515 < n /\ n MOD 2 = 1 + ==> cross124_child_rep (&1) (&0) (&7) n`, + GEN_TAC THEN STRIP_TAC THEN + MP_TAC(SPECL [`n MOD 12`; `n MOD 49`] + CROSS124_315_RESIDUE_SELECTOR) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [REWRITE_TAC[MOD_LT_EQ] THEN CONV_TAC NUM_REDUCE_CONV; + REWRITE_TAC[MOD_LT_EQ] THEN CONV_TAC NUM_REDUCE_CONV; + SUBGOAL_THEN `n MOD 12 MOD 2 = n MOD 2` SUBST1_TAC THENL + [REWRITE_TAC[ARITH_RULE `12 = 2 * 6`; MOD_MOD]; + ASM_REWRITE_TAC[]]]; + DISCH_THEN(X_CHOOSE_THEN `s:num` STRIP_ASSUME_TAC)] THEN + SUBGOAL_THEN `315 * s EXP 2 <= n` ASSUME_TAC THENL + [UNDISCH_TAC `315 * s EXP 2 <= 25515` THEN + UNDISCH_TAC `25515 < n` THEN ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `(n - 315 * s EXP 2) MOD 12 = + num_shift_rem (n MOD 12) (315 * s EXP 2) 12` + ASSUME_TAC THENL + [MATCH_MP_TAC NUM_MOD_SUB_EXACT THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + SUBGOAL_THEN + `(n - 315 * s EXP 2) MOD 49 = + num_shift_rem (n MOD 49) (315 * s EXP 2) 49` + ASSUME_TAC THENL + [MATCH_MP_TAC NUM_MOD_SUB_EXACT THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + MATCH_MP_TAC(SPECL [`n:num`; `s:num`] CROSS124_10_7_ODD_SHIFT) THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(SPEC `n - 315 * s EXP 2` DISC7_CROSS124_REGULAR) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [ASM_ARITH_TAC; + MATCH_MP_TAC DISC7_NOT_EXCEPTION_OF_MOD49 THEN ASM_MESON_TAC[]; + ASM_MESON_TAC[]; + ASM_MESON_TAC[]]; + MESON_TAC[]]);; + +let CROSS124_10_7_ODD_BASE = prove + (`!n:num. + 0 < n /\ n <= 25515 /\ n MOD 2 = 1 /\ + ~(49 divides n) /\ cross124_maybe_check n + ==> cross124_child_rep (&1) (&0) (&7) n`, + CROSS124_QUOTIENT_BASE_TAC 1 0 7 25515);; + +let CROSS124_10_7_ODD_UNIVERSAL = prove + (`!n:num. + 0 < n /\ n MOD 2 = 1 + ==> cross124_child_rep (&1) (&0) (&7) n`, + MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN + DISCH_THEN(LABEL_TAC "ih") THEN STRIP_TAC THEN + ASM_CASES_TAC `49 divides n` THENL + [FIRST_X_ASSUM(X_CHOOSE_THEN `q:num` ASSUME_TAC o + REWRITE_RULE[divides]) THEN + SUBGOAL_THEN `q < n /\ 0 < q` STRIP_ASSUME_TAC THENL + [ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `q MOD 2 = 1` ASSUME_TAC THENL + [UNDISCH_TAC `n = 49 * q` THEN DISCH_THEN SUBST_ALL_TAC THEN + UNDISCH_TAC `(49 * q) MOD 2 = 1` THEN + ONCE_REWRITE_TAC + [GSYM(SPECL [`49`; `2`; `q:num`] MOD_MULT_LMOD)] THEN + CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[MULT_CLAUSES]; + ALL_TAC] THEN + SUBGOAL_THEN `n = 7 EXP 2 * q` SUBST1_TAC THENL + [UNDISCH_TAC `n = 49 * q` THEN CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + MATCH_MP_TAC(SPECL + [`&1:int`; `&0:int`; `&7:int`; `7`; `q:num`] + CROSS124_CHILD_REP_SCALE) THEN + REMOVE_THEN "ih" (MP_TAC o SPEC `q:num`) THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + ASM_CASES_TAC `n <= 25515` THENL + [ASM_CASES_TAC `cross124_maybe_check n` THENL + [MATCH_MP_TAC(SPEC `n:num` CROSS124_10_7_ODD_BASE) THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC(SPECL + [`&1:int`; `&0:int`; `&7:int`; `n:num`] + CROSS124_CHILD_REP_REGULAR) THEN + ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[CROSS124_NEEDS_IMP_MAYBE_CHECK]]; + MATCH_MP_TAC(SPEC `n:num` CROSS124_10_7_ODD_LARGE) THEN + ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC]);; + +let CROSS124_10_7_SMALL = prove + (`!n:num. + 0 < n /\ n <= 504 + ==> cross124_child_rep (&1) (&0) (&7) n`, + GEN_TAC THEN STRIP_TAC THEN + NUM_RANGE_CASES_THEN `n:num` 504 + (TRY ASM_ARITH_TAC THEN + REWRITE_TAC[cross124_child_rep] THEN + CONV_TAC NUM_REDUCE_CONV THEN CROSS124_CERT_TAC 1 0 7));; + +let CROSS124_10_7_UNIVERSAL = prove + (`!n:num. 0 < n ==> cross124_child_rep (&1) (&0) (&7) n`, + MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN + DISCH_THEN(LABEL_TAC "ih") THEN DISCH_TAC THEN + ASM_CASES_TAC `4 divides n` THENL + [FIRST_X_ASSUM(X_CHOOSE_THEN `q:num` ASSUME_TAC o + REWRITE_RULE[divides]) THEN + SUBGOAL_THEN `q < n /\ 0 < q` STRIP_ASSUME_TAC THENL + [ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `n = 2 EXP 2 * q` SUBST1_TAC THENL + [UNDISCH_TAC `n = 4 * q` THEN CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + MATCH_MP_TAC(SPECL + [`&1:int`; `&0:int`; `&7:int`; `2`; `q:num`] + CROSS124_CHILD_REP_SCALE) THEN + REMOVE_THEN "ih" (MP_TAC o SPEC `q:num`) THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + ASM_CASES_TAC `n MOD 2 = 0` THENL + [ASM_CASES_TAC `n <= 504` THENL + [MATCH_MP_TAC(SPEC `n:num` CROSS124_10_7_SMALL) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + ABBREV_TAC `q = n DIV 2` THEN + SUBGOAL_THEN `n = 2 * q` ASSUME_TAC THENL + [EXPAND_TAC "q" THEN + MP_TAC(SPECL [`n:num`; `2`] DIVISION) THEN + CONV_TAC NUM_REDUCE_CONV THEN + ASM_REWRITE_TAC[ADD_CLAUSES] THEN ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `q MOD 2 = 1` ASSUME_TAC THENL + [ASM_CASES_TAC `q MOD 2 = 0` THENL + [SUBGOAL_THEN `2 divides q` (LABEL_TAC "q_even") THENL + [ASM_REWRITE_TAC[DIVIDES_MOD]; + ALL_TAC] THEN + REMOVE_THEN "q_even" + (X_CHOOSE_THEN `r:num` (LABEL_TAC "q_factor") o + REWRITE_RULE[divides]) THEN + SUBGOAL_THEN `4 divides n` MP_TAC THENL + [REWRITE_TAC[divides] THEN EXISTS_TAC `r:num` THEN + REMOVE_THEN "q_factor" MP_TAC THEN + UNDISCH_TAC `n = 2 * q` THEN ARITH_TAC; + ASM_REWRITE_TAC[]]; + MP_TAC(SPECL [`q:num`; `2`] MOD_LT_EQ) THEN + CONV_TAC NUM_REDUCE_CONV THEN ASM_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN `252 < q` ASSUME_TAC THENL + [ASM_ARITH_TAC; + ALL_TAC] THEN + SUBST1_TAC(ASSUME `n = 2 * q`) THEN + MATCH_MP_TAC(SPEC `q:num` CROSS124_10_7_EVEN_LARGE) THEN + ASM_REWRITE_TAC[]; + SUBGOAL_THEN `n MOD 2 = 1` ASSUME_TAC THENL + [MP_TAC(SPECL [`n:num`; `2`] MOD_LT_EQ) THEN + CONV_TAC NUM_REDUCE_CONV THEN ASM_ARITH_TAC; + MATCH_MP_TAC(SPEC `n:num` CROSS124_10_7_ODD_UNIVERSAL) THEN + ASM_REWRITE_TAC[]]]);; + +let IQ_CROSS124_CHILD_REP_OF_NUM = prove + (`!b c k m. + cross124_child_rep b c k m + ==> iq_represents 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) b (&4) c k) (&m)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[cross124_child_rep; iq_represents] THEN + DISCH_THEN(X_CHOOSE_THEN `x:int` + (X_CHOOSE_THEN `y:int` + (X_CHOOSE_THEN `z:int` (X_CHOOSE_TAC `w:int`)))) THEN + EXISTS_TAC + `\i:num. + if i = 0 then (x:int) else if i = 1 then y else + if i = 2 then z else w` THEN + REWRITE_TAC[IQEVAL_MAT4] THEN CONV_TAC NUM_REDUCE_CONV THEN + FIRST_X_ASSUM(MP_TAC) THEN CONV_TAC INT_RING);; + +let IQ_UNIVERSAL_OF_CROSS124_REP_CHILD = prove + (`!n A b c k. + iq_embeds n 4 + (iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) b (&4) c k) A /\ + (!m:num. 0 < m ==> cross124_child_rep b c k m) + ==> iq_universal n A`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "emb") (LABEL_TAC "univ")) THEN + REWRITE_TAC[iq_universal] THEN + X_GEN_TAC `m:int` THEN DISCH_TAC THEN + MP_TAC(EQ_MP (SYM(SPEC `m:int` INT_OF_NUM_EXISTS)) + (MATCH_MP (SPECL [`&0:int`; `m:int`] INT_LT_IMP_LE) + (ASSUME `&0 < m`))) THEN + DISCH_THEN(X_CHOOSE_THEN `u:num` SUBST_ALL_TAC) THEN + MATCH_MP_TAC(ISPECL + [`n:num`; `4`; + `iqmat4 (&1) (&0) (&0) (&0) + (&2) (&1) b (&4) c k`; + `A:num->num->int`; `&u:int`] IQ_REPRESENTS_OF_EMBEDS) THEN + CONJ_TAC THENL + [REMOVE_THEN "emb" MATCH_ACCEPT_TAC; + MATCH_MP_TAC(SPECL [`b:int`; `c:int`; `k:int`; `u:num`] + IQ_CROSS124_CHILD_REP_OF_NUM) THEN + REMOVE_THEN "univ" (MATCH_MP_TAC o SPEC `u:num`) THEN + UNDISCH_TAC `&0 < &u` THEN REWRITE_TAC[INT_OF_NUM_LT]]);; + +let CROSS124_UNIVERSAL_CHILD_TAC b c k th = + MATCH_MP_TAC(ISPECL + [`n:num`; `A:num->num->int`; b; c; k] + IQ_UNIVERSAL_OF_CROSS124_REP_CHILD) THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + MATCH_ACCEPT_TAC th];; + +let IQ_UNIVERSAL_OF_EMBEDS_CROSS124 = prove + (`!n A. + iq_symmetric n A /\ iq_positive n A /\ + iq_embeds n 3 + (iqmat3 (&1) (&0) (&0) (&2) (&1) (&4)) A /\ + iq_represents n A (&7) /\ + iq_represents n A (&10) /\ + iq_represents n A (&15) + ==> iq_universal n A`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(SPECL [`n:num`; `A:num->num->int`] + IQ_EMBEDS_QUATERNARY_CROSS124) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN + (X_CHOOSE_THEN `k:int` + (REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC))) THENL + [MP_TAC(ISPECL [`n:num`; `A:num->num->int`; `k:int`] + IQ_CROSS124_00_PARAMETER_CASES) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THENL + [CROSS124_UNIVERSAL_CHILD_TAC + `&0:int` `&0:int` `&1:int` CROSS124_DIAG1_UNIVERSAL; + CROSS124_UNIVERSAL_CHILD_TAC + `&0:int` `&0:int` `&2:int` CROSS124_DIAG2_UNIVERSAL; + MATCH_MP_TAC(SPECL [`n:num`; `A:num->num->int`] + IQ_UNIVERSAL_OF_CROSS124_00_3_CHILD) THEN ASM_REWRITE_TAC[]; + CROSS124_UNIVERSAL_CHILD_TAC + `&0:int` `&0:int` `&4:int` CROSS124_DIAG4_UNIVERSAL; + CROSS124_UNIVERSAL_CHILD_TAC + `&0:int` `&0:int` `&5:int` CROSS124_DIAG5_UNIVERSAL; + CROSS124_UNIVERSAL_CHILD_TAC + `&0:int` `&0:int` `&6:int` CROSS124_DIAG6_UNIVERSAL; + CROSS124_UNIVERSAL_CHILD_TAC + `&0:int` `&0:int` `&7:int` CROSS124_DIAG7_UNIVERSAL]; + MP_TAC(ISPECL [`n:num`; `A:num->num->int`; `k:int`] + IQ_CROSS124_10_PARAMETER_CASES) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THENL + [MATCH_MP_TAC(SPECL [`n:num`; `A:num->num->int`] + IQ_UNIVERSAL_OF_CROSS124_10_1_CHILD) THEN ASM_REWRITE_TAC[]; + CROSS124_UNIVERSAL_CHILD_TAC + `&1:int` `&0:int` `&2:int` CROSS124_10_2_UNIVERSAL; + CROSS124_UNIVERSAL_CHILD_TAC + `&1:int` `&0:int` `&3:int` CROSS124_10_3_UNIVERSAL; + CROSS124_UNIVERSAL_CHILD_TAC + `&1:int` `&0:int` `&4:int` CROSS124_10_4_UNIVERSAL; + CROSS124_UNIVERSAL_CHILD_TAC + `&1:int` `&0:int` `&5:int` CROSS124_10_5_UNIVERSAL; + CROSS124_UNIVERSAL_CHILD_TAC + `&1:int` `&0:int` `&6:int` CROSS124_10_6_UNIVERSAL; + CROSS124_UNIVERSAL_CHILD_TAC + `&1:int` `&0:int` `&7:int` CROSS124_10_7_UNIVERSAL]; + MP_TAC(ISPECL [`n:num`; `A:num->num->int`; `k:int`] + IQ_CROSS124_0_NEG1_PARAMETER_CASES) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THENL + [CROSS124_UNIVERSAL_CHILD_TAC + `&0:int` `-- &1:int` `&1:int` CROSS124_0_NEG1_1_UNIVERSAL; + CROSS124_UNIVERSAL_CHILD_TAC + `&0:int` `-- &1:int` `&3:int` CROSS124_0_NEG1_3_UNIVERSAL; + CROSS124_UNIVERSAL_CHILD_TAC + `&0:int` `-- &1:int` `&4:int` CROSS124_0_NEG1_4_UNIVERSAL; + MATCH_MP_TAC(SPECL [`n:num`; `A:num->num->int`] + IQ_UNIVERSAL_OF_CROSS124_0_NEG1_5_CHILD) THEN ASM_REWRITE_TAC[]; + CROSS124_UNIVERSAL_CHILD_TAC + `&0:int` `-- &1:int` `&6:int` CROSS124_0_NEG1_6_UNIVERSAL; + CROSS124_UNIVERSAL_CHILD_TAC + `&0:int` `-- &1:int` `&7:int` CROSS124_0_NEG1_7_UNIVERSAL]; + MP_TAC(ISPECL [`n:num`; `A:num->num->int`; `k:int`] + IQ_CROSS124_1_NEG1_PARAMETER_CASES) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST_ALL_TAC) THENL + [CROSS124_UNIVERSAL_CHILD_TAC + `&1:int` `-- &1:int` `&2:int` CROSS124_1_NEG1_2_UNIVERSAL; + CROSS124_UNIVERSAL_CHILD_TAC + `&1:int` `-- &1:int` `&3:int` CROSS124_1_NEG1_3_UNIVERSAL; + CROSS124_UNIVERSAL_CHILD_TAC + `&1:int` `-- &1:int` `&4:int` CROSS124_1_NEG1_4_UNIVERSAL; + MATCH_MP_TAC(SPECL [`n:num`; `A:num->num->int`] + IQ_UNIVERSAL_OF_CROSS124_1_NEG1_5_CHILD) THEN ASM_REWRITE_TAC[]; + CROSS124_UNIVERSAL_CHILD_TAC + `&1:int` `-- &1:int` `&6:int` CROSS124_1_NEG1_6_UNIVERSAL; + CROSS124_UNIVERSAL_CHILD_TAC + `&1:int` `-- &1:int` `&7:int` CROSS124_1_NEG1_7_UNIVERSAL]]);; + +let IQ_UNIVERSAL_OF_REPRESENTS_UP_TO_15 = prove + (`!n A. + iq_symmetric n A /\ iq_positive n A /\ + (!m:int. &0 < m /\ m <= &15 ==> iq_represents n A m) + ==> iq_universal n A`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + let REPRESENT_TAC = + FIRST_ASSUM MATCH_MP_TAC THEN CONV_TAC INT_REDUCE_CONV in + SUBGOAL_THEN `iq_represents n A (&1)` ASSUME_TAC THENL + [REPRESENT_TAC; ALL_TAC] THEN + SUBGOAL_THEN `iq_represents n A (&2)` ASSUME_TAC THENL + [REPRESENT_TAC; ALL_TAC] THEN + SUBGOAL_THEN `iq_represents n A (&3)` ASSUME_TAC THENL + [REPRESENT_TAC; ALL_TAC] THEN + SUBGOAL_THEN `iq_represents n A (&5)` ASSUME_TAC THENL + [REPRESENT_TAC; ALL_TAC] THEN + SUBGOAL_THEN `iq_represents n A (&6)` ASSUME_TAC THENL + [REPRESENT_TAC; ALL_TAC] THEN + SUBGOAL_THEN `iq_represents n A (&7)` ASSUME_TAC THENL + [REPRESENT_TAC; ALL_TAC] THEN + SUBGOAL_THEN `iq_represents n A (&10)` ASSUME_TAC THENL + [REPRESENT_TAC; ALL_TAC] THEN + SUBGOAL_THEN `iq_represents n A (&14)` ASSUME_TAC THENL + [REPRESENT_TAC; ALL_TAC] THEN + SUBGOAL_THEN `iq_represents n A (&15)` ASSUME_TAC THENL + [REPRESENT_TAC; ALL_TAC] THEN + MP_TAC(SPECL [`n:num`; `A:num->num->int`] IQ_EMBEDS_TERNARY) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THENL + [MATCH_MP_TAC(SPECL [`n:num`; `A:num->num->int`] + IQ_UNIVERSAL_OF_EMBEDS_111) THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC(SPECL [`n:num`; `A:num->num->int`] + IQ_UNIVERSAL_OF_EMBEDS_112) THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC(SPECL [`n:num`; `A:num->num->int`] + IQ_UNIVERSAL_OF_EMBEDS_113) THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC(SPECL [`n:num`; `A:num->num->int`] + IQ_UNIVERSAL_OF_EMBEDS_122) THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC(SPECL [`n:num`; `A:num->num->int`] + IQ_UNIVERSAL_OF_EMBEDS_123) THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC(SPECL [`n:num`; `A:num->num->int`] + IQ_UNIVERSAL_OF_EMBEDS_124) THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC(SPECL [`n:num`; `A:num->num->int`] + IQ_UNIVERSAL_OF_EMBEDS_125) THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC(SPECL [`n:num`; `A:num->num->int`] + IQ_UNIVERSAL_OF_EMBEDS_CROSS124) THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC(SPECL [`n:num`; `A:num->num->int`] + IQ_UNIVERSAL_OF_EMBEDS_CROSS125) THEN ASM_REWRITE_TAC[]]);; + +let FIFTEEN_THEOREM = prove + (`!n A. + iq_symmetric n A /\ iq_positive n A + ==> ((!m:int. &0 < m /\ m <= &15 ==> iq_represents n A m) <=> + (!m:int. &0 < m ==> iq_represents n A m))`, + MESON_TAC[IQ_UNIVERSAL_OF_REPRESENTS_UP_TO_15; iq_universal]);; diff --git a/Autoformalization/fourier_transform.ml b/Autoformalization/fourier_transform.ml new file mode 100644 index 00000000..8dfbc389 --- /dev/null +++ b/Autoformalization/fourier_transform.ml @@ -0,0 +1,7880 @@ +(* ========================================================================= *) +(* The Fourier transform on R (Fremlin, Measure Theory vol 2, sections *) +(* 283-284). *) +(* *) +(* NORMALIZATION (Fremlin 283Ba): symmetric, so the transform is an L^2 *) +(* isometry (Plancherel constant 1): *) +(* (fourier f)(y) = (1 / sqrt(2*pi)) * INT_R e^{-i y x} f(x) dx. *) +(* f : real->complex (= real^1->real^2); the spatial variable ranges over R *) +(* via drop of a real^1 integration variable. The normalizing constant is *) +(* written Cx(&1) / Cx(sqrt(&2 * pi)) (division kept at the COMPLEX level) *) +(* so COMPLEX_FIELD / SIMPLE_COMPLEX_ARITH can normalize it as an atom -- *) +(* Cx(&1 / sqrt(&2 * pi)) instead jams those tactics on the sqrt inside Cx. *) +(* ========================================================================= *) + +needs "100/fourier.ml";; + +let fourier = new_definition + `fourier (f:real->complex) (y:real) = + (Cx(&1) / Cx(sqrt(&2 * pi))) * + integral (:real^1) (\x. cexp(--(ii * Cx y * Cx(drop x))) * f(drop x))`;; + +(* The transform kernel at frequency y. *) +let fourier_kernel = new_definition + `fourier_kernel (y:real) (x:real) = cexp(--(ii * Cx y * Cx x))`;; + +(* ========================================================================= *) +(* SECTION 1. Basic properties of the Fourier transform. *) +(* ========================================================================= *) + +(* ------------------------------------------------------------------------- *) +(* 283C(a,b): linearity. Under integrability of the transform integrand at + y *) +(* (automatic for the L^1 / Schwartz functions we apply it to). *) +(* ------------------------------------------------------------------------- *) + +let FOURIER_LMUL = prove + (`!f c y. + (\x. cexp(--(ii * Cx y * Cx(drop x))) * f(drop x)) + integrable_on (:real^1) + ==> fourier (\x. c * f x) y = c * fourier f y`, + REPEAT STRIP_TAC THEN REWRITE_TAC[fourier] THEN + SUBGOAL_THEN + `integral (:real^1) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * (c * f(drop x))) = + c * integral (:real^1) (\x. cexp(--(ii * Cx y * Cx(drop x))) * f(drop x))` + (fun th -> REWRITE_TAC[th]) THENL + [SUBGOAL_THEN + `(\x. cexp(--(ii * Cx y * Cx(drop x))) * (c * f(drop x))) = + (\x. c * (cexp(--(ii * Cx y * Cx(drop x))) * f(drop x)))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + SIMPLE_COMPLEX_ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[INTEGRAL_COMPLEX_LMUL]; + ALL_TAC] THEN + SIMPLE_COMPLEX_ARITH_TAC);; + +let FOURIER_ADD = prove + (`!f g y. + (\x. cexp(--(ii * Cx y * Cx(drop x))) * f(drop x)) + integrable_on (:real^1) /\ + (\x. cexp(--(ii * Cx y * Cx(drop x))) * g(drop x)) + integrable_on (:real^1) + ==> fourier (\x. f x + g x) y = fourier f y + fourier g y`, + REPEAT STRIP_TAC THEN REWRITE_TAC[fourier] THEN + SUBGOAL_THEN + `integral (:real^1) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * (f(drop x) + g(drop x))) = + integral (:real^1) (\x. cexp(--(ii * Cx y * Cx(drop x))) * f(drop x)) + + integral (:real^1) (\x. cexp(--(ii * Cx y * Cx(drop x))) * g(drop x))` + (fun th -> REWRITE_TAC[th]) THENL + [SUBGOAL_THEN + `(\x. cexp(--(ii * Cx y * Cx(drop x))) * (f(drop x) + g(drop x))) = + (\x. (cexp(--(ii * Cx y * Cx(drop x))) * f(drop x)) + + (cexp(--(ii * Cx y * Cx(drop x))) * g(drop x)))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN SIMPLE_COMPLEX_ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[INTEGRAL_ADD]; ALL_TAC] THEN + SIMPLE_COMPLEX_ARITH_TAC);; + +(* The Fourier transform of the zero function is zero. *) +let FOURIER_0 = prove + (`!y. fourier (\x. Cx(&0)) y = Cx(&0)`, + GEN_TAC THEN REWRITE_TAC[fourier] THEN + REWRITE_TAC[COMPLEX_MUL_RZERO; GSYM COMPLEX_VEC_0; INTEGRAL_0] THEN + REWRITE_TAC[COMPLEX_VEC_0; COMPLEX_MUL_RZERO]);; + +(* ------------------------------------------------------------------------- *) +(* Translation-invariance of the integral over R, at the real->complex level *) +(* (reusable for the change-of-variables in the shift/dilation rules). *) +(* ------------------------------------------------------------------------- *) + +let INTEGRAL_TRANSLATION_R = prove + (`!G:real->complex c. + integral (:real^1) (\x. G(c + drop x)) = + integral (:real^1) (\x. G(drop x))`, + REPEAT GEN_TAC THEN + MP_TAC(ISPECL [`\x:real^1. (G:real->complex)(drop x)`; `(:real^1)`; `lift c`] + INTEGRAL_TRANSLATION) THEN + REWRITE_TAC[DROP_ADD; LIFT_DROP] THEN + SUBGOAL_THEN `IMAGE (\x:real^1. lift c + x) (:real^1) = (:real^1)` + SUBST1_TAC THENL + [REWRITE_TAC[TRANSLATION_UNIV]; ALL_TAC] THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]));; + +(* ------------------------------------------------------------------------- *) +(* 283C(c): the SHIFT rule. If h(x) = f(x + c) then h^(y) = e^{icy} f^(y). *) +(* Change of variables x |-> x - c inside the integral, then pull the *) +(* constant e^{icy} out. *) +(* ------------------------------------------------------------------------- *) + +let FOURIER_SHIFT = prove + (`!f c y. + (\x. cexp(--(ii * Cx y * Cx(drop x))) * f(drop x)) + integrable_on (:real^1) + ==> fourier (\x. f(x + c)) y = cexp(ii * Cx c * Cx y) * fourier f y`, + REPEAT STRIP_TAC THEN REWRITE_TAC[fourier] THEN + SUBGOAL_THEN + `integral (:real^1) (\x. cexp(--(ii * Cx y * Cx(drop x))) * f(drop x + c)) = + cexp(ii * Cx c * Cx y) * + integral (:real^1) (\x. cexp(--(ii * Cx y * Cx(drop x))) * f(drop x))` + (fun th -> REWRITE_TAC[th]) THENL [ALL_TAC; SIMPLE_COMPLEX_ARITH_TAC] THEN + SUBGOAL_THEN + `integral (:real^1) (\x. cexp(--(ii * Cx y * Cx(drop x))) * f(drop x + c)) = + integral (:real^1) + (\x. (\u. cexp(--(ii * Cx y * Cx(u - c))) * (f:real->complex) + u)(c + drop x))` + SUBST1_TAC THENL + [AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + REWRITE_TAC[] THEN + REWRITE_TAC[REAL_ARITH `!c x:real. (c + x) - c = x`; REAL_ADD_SYM]; + ALL_TAC] THEN + REWRITE_TAC[INTEGRAL_TRANSLATION_R] THEN + SUBGOAL_THEN + `!x:real^1. cexp(--(ii * Cx y * Cx(drop x - c))) * f(drop x) = + cexp(ii * Cx c * Cx y) * + (cexp(--(ii * Cx y * Cx(drop x))) * f(drop x))` + (fun th -> REWRITE_TAC[th]) THENL + [GEN_TAC THEN + SUBGOAL_THEN `cexp(--(ii * Cx y * Cx(drop x - c))) = + cexp(ii * Cx c * Cx y) * + cexp(--(ii * Cx y * Cx(drop x)))` SUBST1_TAC THENL + [REWRITE_TAC[GSYM CEXP_ADD] THEN AP_TERM_TAC THEN REWRITE_TAC[CX_SUB] THEN + SIMPLE_COMPLEX_ARITH_TAC; + SIMPLE_COMPLEX_ARITH_TAC]; ALL_TAC] THEN + MATCH_MP_TAC INTEGRAL_COMPLEX_LMUL THEN ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* 283C(d): the MODULATION rule. If h(x) = e^{icx} f(x) then + h^(y)=f^(y - c). *) +(* No change of variables -- just combine the two exponentials. *) +(* ------------------------------------------------------------------------- *) + +let FOURIER_MODULATION = prove + (`!f c y. fourier (\x. cexp(ii * Cx c * Cx x) * f x) y = fourier f (y - c)`, + REPEAT GEN_TAC THEN REWRITE_TAC[fourier] THEN AP_TERM_TAC THEN + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:real^1` THEN + REWRITE_TAC[COMPLEX_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[GSYM CEXP_ADD] THEN AP_TERM_TAC THEN REWRITE_TAC[CX_SUB] THEN + SIMPLE_COMPLEX_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* The transform kernel has modulus 1 (real frequency/position), hence the *) +(* fundamental L^1 -> L^infinity bound: |f^(y)| <= (1/sqrt(2 pi)) ||f||_1. *) +(* This is the Riemann-Lebesgue-adjacent boundedness (283B): the transform + of *) +(* an integrable function is bounded. *) +(* ------------------------------------------------------------------------- *) + +let FOURIER_KERNEL_NORM = prove + (`!y x. norm(cexp(--(ii * Cx y * Cx x))) = &1`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `--(ii * Cx y * Cx x) = ii * Cx(--(y * x))` SUBST1_TAC THENL + [REWRITE_TAC[CX_NEG; CX_MUL] THEN SIMPLE_COMPLEX_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[NORM_CEXP_II]);; + +let FOURIER_BOUND = prove + (`!f y. + (\x. cexp(--(ii * Cx y * Cx(drop x))) * f(drop x)) + integrable_on (:real^1) /\ + (\x. lift(norm(f(drop x)))) integrable_on (:real^1) + ==> norm(fourier f y) <= + (&1 / sqrt(&2 * pi)) * + drop(integral (:real^1) (\x. lift(norm(f(drop x)))))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[fourier] THEN + REWRITE_TAC[COMPLEX_NORM_MUL] THEN + SUBGOAL_THEN `norm(Cx(&1) / Cx(sqrt(&2 * pi))) = &1 / sqrt(&2 * pi)` + SUBST1_TAC THENL + [REWRITE_TAC[COMPLEX_NORM_DIV; COMPLEX_NORM_CX; REAL_ABS_NUM] THEN + AP_TERM_TAC THEN REWRITE_TAC[REAL_ABS_REFL] THEN + MATCH_MP_TAC SQRT_POS_LE THEN + MP_TAC PI_POS THEN REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_DIV THEN CONJ_TAC THENL + [REAL_ARITH_TAC; + MATCH_MP_TAC SQRT_POS_LE THEN MP_TAC PI_POS THEN REAL_ARITH_TAC]; + ALL_TAC] THEN + MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN + REWRITE_TAC[LIFT_DROP; COMPLEX_NORM_MUL; FOURIER_KERNEL_NORM; REAL_MUL_LID; + REAL_LE_REFL]);; + +(* ------------------------------------------------------------------------- *) +(* Reflection. Whole-line reflection of the R->complex integral (reusable), *) +(* and the transform reflection rule (\x. f(--x))^(y) = f^(--y). *) +(* ------------------------------------------------------------------------- *) + +let INTEGRAL_REFLECT_R = prove + (`!G:real->complex. + integral (:real^1) (\x. G(--(drop x))) = + integral (:real^1) (\x. G(drop x))`, + GEN_TAC THEN + MP_TAC(ISPECL [`\x:real^1. (G:real->complex)(drop x)`; `(:real^1)`] + INTEGRAL_REFLECT_GEN) THEN + REWRITE_TAC[DROP_NEG] THEN + SUBGOAL_THEN `IMAGE (--) (:real^1) = (:real^1)` SUBST1_TAC THENL + [REWRITE_TAC[REFLECT_UNIV]; ALL_TAC] THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]));; + +let FOURIER_REFLECT = prove + (`!f y. fourier (\x. f(--x)) y = fourier f (--y)`, + REPEAT GEN_TAC THEN REWRITE_TAC[fourier] THEN AP_TERM_TAC THEN + SUBGOAL_THEN + `integral (:real^1) (\x. cexp(--(ii * Cx y * Cx(drop x))) * f(--drop x)) = + integral (:real^1) + (\x. (\u. cexp(ii * Cx y * Cx u) * (f:real->complex) u)(--(drop x)))` + SUBST1_TAC THENL + [AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + REWRITE_TAC[] THEN + REWRITE_TAC[CX_NEG] THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + SIMPLE_COMPLEX_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[INTEGRAL_REFLECT_R] THEN + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN REWRITE_TAC[] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[CX_NEG] THEN + SIMPLE_COMPLEX_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* 283C(e): the DILATION rule. For c > 0, if h(x) = f(cx) then *) +(* h^(y) = (1/c) f^(y/c). Uses the whole-line integral stretch. *) +(* ------------------------------------------------------------------------- *) + +let INTEGRAL_STRETCH_R = prove + (`!G:real->complex c. &0 < c /\ (\x. G(drop x)) integrable_on (:real^1) + ==> integral (:real^1) (\x. G(c * drop x)) = + (&1 / c) % integral (:real^1) (\x. G(drop x))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\x:real^1. (G:real->complex)(drop x)`; + `integral (:real^1) (\x:real^1. (G:real->complex)(drop x))`; + `(:real^1)`; `c:real`; `vec 0:real^1`] + HAS_INTEGRAL_AFFINITY) THEN + ASM_SIMP_TAC[REAL_LT_IMP_NZ; VECTOR_MUL_RZERO; VECTOR_ADD_RID; + VECTOR_NEG_0] THEN + ANTS_TAC THENL + [MATCH_MP_TAC INTEGRABLE_INTEGRAL THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `IMAGE (\x:real^1. inv c % x) (:real^1) = (:real^1)` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_UNIV] THEN X_GEN_TAC `z:real^1` THEN + EXISTS_TAC `c % z:real^1` THEN + ASM_SIMP_TAC[VECTOR_MUL_ASSOC; REAL_MUL_LINV; REAL_LT_IMP_NZ; + VECTOR_MUL_LID]; ALL_TAC] THEN + REWRITE_TAC[DIMINDEX_1; REAL_POW_1] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < c ==> abs c = c`] THEN + REWRITE_TAC[DROP_CMUL] THEN + DISCH_THEN(MP_TAC o MATCH_MP INTEGRAL_UNIQUE) THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN + REWRITE_TAC[real_div; REAL_MUL_LID]);; + +let FOURIER_DILATION = prove + (`!f c y. + &0 < c /\ + (\x. cexp(--(ii * Cx (y/c) * Cx(drop x))) * f(drop x)) + integrable_on (:real^1) + ==> fourier (\x. f(c * x)) y = Cx(&1 / c) * fourier f (y / c)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[fourier] THEN + SUBGOAL_THEN + `integral (:real^1) (\x. cexp(--(ii * Cx y * Cx(drop x))) * f(c * drop x)) = + integral (:real^1) + (\x. (\u. cexp(--(ii * Cx (y/c) * Cx u)) * (f:real->complex) + u)(c * drop x))` + SUBST1_TAC THENL + [AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + REWRITE_TAC[] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[CX_MUL] THEN + SUBGOAL_THEN `Cx(y / c) * Cx c = Cx y` + (fun th -> ONCE_REWRITE_TAC[GSYM th]) THENL + [REWRITE_TAC[GSYM CX_MUL] THEN AP_TERM_TAC THEN + ASM_SIMP_TAC[REAL_DIV_RMUL; REAL_LT_IMP_NZ]; ALL_TAC] THEN + SIMPLE_COMPLEX_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[INTEGRAL_STRETCH_R] THEN + REWRITE_TAC[COMPLEX_CMUL] THEN + SPEC_TAC(`integral (:real^1) + (\x. cexp(--(ii * Cx (y/c) * Cx(drop x))) * + (f:real->complex)(drop x))`, + `z:complex`) THEN + GEN_TAC THEN CONV_TAC COMPLEX_FIELD);; + +(* ------------------------------------------------------------------------- *) +(* CONTINUITY of the Fourier transform (283D-adjacent): for f in L^1, f^ is *) +(* continuous. Proved via dominated convergence -- for any y_k -> y the *) +(* transform integrands are dominated by |f| and converge pointwise, so the *) +(* integrals converge. Stated in sequential form. *) +(* First two auxiliary limits: the kernel argument, and the kernel value. *) +(* ------------------------------------------------------------------------- *) + +let FOURIER_KARG_LIM = prove + (`!x:real yy y. (yy ---> y) sequentially + ==> ((\k. --(ii * Cx (yy k) * Cx x)) --> --(ii * Cx y * Cx x)) + sequentially`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC LIM_NEG THEN + ONCE_REWRITE_TAC[COMPLEX_RING `ii * Cx a * Cx x = (ii * Cx x) * Cx a`] THEN + MATCH_MP_TAC LIM_COMPLEX_LMUL THEN + FIRST_X_ASSUM(MP_TAC o REWRITE_RULE[REALLIM_COMPLEX]) THEN + REWRITE_TAC[o_DEF]);; + +let FOURIER_KVAL_LIM = prove + (`!x:real yy y. (yy ---> y) sequentially + ==> ((\k. cexp(--(ii * Cx (yy k) * Cx x))) --> + cexp(--(ii * Cx y * Cx x))) sequentially`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`cexp`; `--(ii * Cx y * Cx x)`] + CONTINUOUS_AT_SEQUENTIALLY) THEN + REWRITE_TAC[CONTINUOUS_AT_CEXP] THEN + DISCH_THEN(MP_TAC o SPEC `\k. --(ii * Cx ((yy:num->real) k) * Cx x)`) THEN + ASM_SIMP_TAC[FOURIER_KARG_LIM; o_DEF]);; + +(* The integral part is sequentially continuous in the frequency (DCT). *) +let FOURIER_INTEGRAL_CONTINUOUS = prove + (`!f y. (!y'. (\x. cexp(--(ii * Cx y' * Cx(drop x))) * f(drop x)) + integrable_on (:real^1)) /\ + (\x. lift(norm(f(drop x)))) integrable_on (:real^1) + ==> !yy. (yy ---> y) sequentially + ==> ((\k. integral (:real^1) + (\x. cexp(--(ii * Cx (yy k) * Cx(drop x))) * + f(drop x))) + --> integral (:real^1) + (\x. cexp(--(ii * Cx y * Cx(drop x))) * f(drop x))) + sequentially`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`\k x. cexp(--(ii * Cx ((yy:num->real) k) * Cx(drop x))) * + (f:real->complex)(drop x)`; + `\x. cexp(--(ii * Cx y * Cx(drop x))) * (f:real->complex)(drop x)`; + `\x. lift(norm((f:real->complex)(drop x)))`; + `(:real^1)`] DOMINATED_CONVERGENCE) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [GEN_TAC THEN ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN + REWRITE_TAC[LIFT_DROP; COMPLEX_NORM_MUL] THEN + SUBGOAL_THEN + `norm(cexp(--(ii * Cx (yy(k:num)) * Cx(drop(x:real^1))))) = &1` + SUBST1_TAC THENL + [SUBGOAL_THEN `--(ii * Cx (yy(k:num)) * Cx(drop(x:real^1))) = + ii * Cx(--(yy k * drop x))` + SUBST1_TAC THENL + [REWRITE_TAC[CX_NEG; CX_MUL] THEN SIMPLE_COMPLEX_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[NORM_CEXP_II]; ALL_TAC] THEN + REWRITE_TAC[REAL_MUL_LID; REAL_LE_REFL]; + REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[COMPLEX_RING `a * b = b * a`] THEN + MATCH_MP_TAC LIM_COMPLEX_LMUL THEN ASM_SIMP_TAC[FOURIER_KVAL_LIM]]; + DISCH_THEN(fun th -> MP_TAC(CONJUNCT2 th)) THEN REWRITE_TAC[]]);; + +let FOURIER_CONTINUOUS_SEQ = prove + (`!f y. (!y'. (\x. cexp(--(ii * Cx y' * Cx(drop x))) * f(drop x)) + integrable_on (:real^1)) /\ + (\x. lift(norm(f(drop x)))) integrable_on (:real^1) + ==> !yy. (yy ---> y) sequentially + ==> ((\k. fourier f (yy k)) --> fourier f y) sequentially`, + REPEAT GEN_TAC THEN STRIP_TAC THEN X_GEN_TAC `yy:num->real` THEN + DISCH_TAC THEN + REWRITE_TAC[fourier] THEN MATCH_MP_TAC LIM_COMPLEX_LMUL THEN + MP_TAC(ISPECL [`f:real->complex`; `y:real`] FOURIER_INTEGRAL_CONTINUOUS) THEN + ASM_SIMP_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* The elementary oscillatory integral INT_{-a}^a e^{iby} dy = 2 sin(ab)/b *) +(* (b =/= 0, a >= 0), the kernel of the Fubini step in the inversion theorem *) +(* 283H. Antiderivative e^{iby}/(ib); vector FTC along the reals. *) +(* ------------------------------------------------------------------------- *) + +(* d/dy [ e^{iby}/(ib) ] = e^{iby} (real->complex chain rule). *) +let CEXP_IB_VECTOR_DERIV = prove + (`!b y. ~(b = &0) + ==> ((\y. cexp(ii * Cx b * Cx(drop y)) / (ii * Cx b)) + has_vector_derivative + cexp(ii * Cx b * Cx(drop y))) (at y)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_REAL_COMPLEX THEN + SUBGOAL_THEN `~(ii * Cx b = Cx(&0))` ASSUME_TAC THENL + [REWRITE_TAC[COMPLEX_ENTIRE; II_NZ; CX_INJ] THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + COMPLEX_DIFF_TAC THEN POP_ASSUM MP_TAC THEN CONV_TAC COMPLEX_FIELD);; + +(* (P + iQ)/(iw) - (P - iQ)/(iw) = 2 Q/w (the endpoint combination). *) +let COMPLEX_FRAC_COMBINE = prove + (`!P Q w. ~(w = Cx(&0)) + ==> (P + ii * Q) / (ii * w) - (P + ii * (--Q)) / (ii * w) = + Cx(&2) * Q / w`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[complex_div; GSYM COMPLEX_SUB_RDISTRIB] THEN + SUBGOAL_THEN `(P + ii * Q) - (P + ii * --Q) = ii * (Cx(&2) * Q)` + SUBST1_TAC THENL + [SIMPLE_COMPLEX_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[COMPLEX_INV_MUL; COMPLEX_MUL_ASSOC] THEN + SUBGOAL_THEN `ii * Cx(&2) * Q * inv ii = Cx(&2) * Q` SUBST1_TAC THENL + [MP_TAC II_NZ THEN CONV_TAC COMPLEX_FIELD; ALL_TAC] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN MP_TAC II_NZ THEN CONV_TAC COMPLEX_FIELD);; + +(* The endpoint value e^{iab}/(ib) - e^{-iab}/(ib) = 2 sin(ab)/b. *) +let CEXP_ENDPOINT_ID = prove + (`!a b. ~(b = &0) + ==> cexp(ii * Cx b * Cx a) / (ii * Cx b) - + cexp(ii * Cx b * Cx(--a)) / (ii * Cx b) = + Cx(&2 * sin(a * b) / b)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `ii * Cx b * Cx a = ii * Cx(a * b) /\ + ii * Cx b * Cx(--a) = ii * Cx(--(a * b))` + (fun th -> REWRITE_TAC[th]) THENL + [REWRITE_TAC[CX_NEG; CX_MUL] THEN CONJ_TAC THEN SIMPLE_COMPLEX_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[CEXP_EULER; GSYM CX_SIN; GSYM CX_COS] THEN + REWRITE_TAC[SIN_NEG; COS_NEG] THEN + MP_TAC(ISPECL [`Cx(cos(a*b))`; `Cx(sin(a*b))`; `Cx b`] + COMPLEX_FRAC_COMBINE) THEN + ANTS_TAC THENL [REWRITE_TAC[CX_INJ] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[GSYM CX_NEG] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[GSYM CX_DIV; GSYM CX_MUL] THEN AP_TERM_TAC THEN + REWRITE_TAC[real_div] THEN REAL_ARITH_TAC);; + +(* INT_{[-a,a]} e^{iby} dy = 2 sin(ab)/b. *) +let CEXP_INTERVAL_INTEGRAL = prove + (`!a b. &0 <= a /\ ~(b = &0) + ==> integral (interval[lift(--a), lift a]) + (\y. cexp(ii * Cx b * Cx(drop y))) = + Cx(&2 * sin(a * b) / b)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN + MP_TAC(ISPECL + [`\y. cexp(ii * Cx b * Cx(drop y)) / (ii * Cx b)`; + `\y. cexp(ii * Cx b * Cx(drop y))`; + `lift(--a)`; `lift a`] FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN + REWRITE_TAC[LIFT_DROP; DROP_NEG] THEN ANTS_TAC THENL + [CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_AT_WITHIN THEN + ASM_SIMP_TAC[CEXP_IB_VECTOR_DERIV]]; + ALL_TAC] THEN + REWRITE_TAC[LIFT_DROP; DROP_NEG] THEN + ASM_SIMP_TAC[CEXP_ENDPOINT_ID]);; + + +(* ========================================================================= *) +(* SECTION 2. Dirichlet sine integral and inversion foundations *) +(* (Fremlin 283D-283J). *) +(* Underpins Fourier INVERSION and thence the Schwartz theory (284) and *) +(* Plancherel. *) +(* (Uses DIRICHLET_KERNEL* / RIEMANN_LEBESGUE* from 100/fourier.ml, and *) +(* REAL_SECOND_MEAN_VALUE_THEOREM = Fremlin 224J.) *) +(* *) +(* Foundation: the "sinc" function (sin x / x extended by 1 at 0) is smooth/ *) +(* continuous, so its running integral F(a) = INT_0^a sin/x is well-behaved. *) +(* Fremlin 283D: F(a) -> pi/2 as a -> +inf, and |INT_a^b sin(cx)/x| <= K *) +(* uniformly (the two facts the inversion theorem 283F consumes). *) +(* ========================================================================= *) + +let sinc = new_definition + `sinc x = if x = &0 then &1 else sin x / x`;; + + +(* sinc is continuous everywhere (the singularity at 0 is removable). *) +let SINC_CONTINUOUS = prove + (`!x. sinc real_continuous atreal x`, + GEN_TAC THEN ASM_CASES_TAC `x = &0` THENL + [ASM_REWRITE_TAC[REAL_CONTINUOUS_ATREAL] THEN + SUBGOAL_THEN `sinc(&0) = &1` SUBST1_TAC THENL + [REWRITE_TAC[sinc]; ALL_TAC] THEN + MATCH_MP_TAC REALLIM_TRANSFORM_EVENTUALLY THEN + EXISTS_TAC `\x. sin x / x` THEN CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_ATREAL] THEN EXISTS_TAC `&1` THEN + REWRITE_TAC[REAL_LT_01] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[sinc] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[REALLIM_SIN_OVER_X]]; + MATCH_MP_TAC REAL_CONTINUOUS_TRANSFORM_ATREAL THEN + EXISTS_TAC `\x. sin x / x` THEN EXISTS_TAC `abs x` THEN + REPEAT CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; + X_GEN_TAC `x':real` THEN DISCH_TAC THEN REWRITE_TAC[sinc] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_CONTINUOUS_DIV_ATREAL THEN + REWRITE_TAC[REAL_CONTINUOUS_AT_SIN; REAL_CONTINUOUS_AT_ID] THEN + ASM_REWRITE_TAC[]]]);; + +(* sinc is continuous on every interval, hence integrable there. *) +let SINC_CONTINUOUS_ON = prove + (`!s. sinc real_continuous_on s`, + GEN_TAC THEN REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_WITHINREAL THEN + REWRITE_TAC[SINC_CONTINUOUS]);; + +let SINC_INTEGRABLE = prove + (`!a b. sinc real_integrable_on real_interval[a,b]`, + REPEAT GEN_TAC THEN MATCH_MP_TAC REAL_INTEGRABLE_CONTINUOUS THEN + REWRITE_TAC[SINC_CONTINUOUS_ON]);; + +(* t |-> sinc(c t) is continuous (composition), hence integrable on any *) +(* interval. *) +let SINC_STRETCH_INTEGRABLE = prove + (`!c a b. (\t. sinc(c * t)) real_integrable_on real_interval[a,b]`, + REPEAT GEN_TAC THEN MATCH_MP_TAC REAL_INTEGRABLE_CONTINUOUS THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_WITHINREAL THEN + SUBGOAL_THEN `(\t. sinc(c * t)) = sinc o (\t. c * t)` SUBST1_TAC THENL + [REWRITE_TAC[o_DEF]; ALL_TAC] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_COMPOSE THEN + REWRITE_TAC[SINC_CONTINUOUS] THEN + MATCH_MP_TAC REAL_CONTINUOUS_LMUL THEN REWRITE_TAC[REAL_CONTINUOUS_AT_ID]);; + +(* Hence sin(c t)/t is integrable on any interval, for c > 0 (= c sinc(c *) +(* t)). *) +let SIN_STRETCH_OVER_X_INTEGRABLE = prove + (`!c a b. &0 < c ==> (\t. sin(c * t) / t) real_integrable_on + real_interval[a,b]`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] REAL_INTEGRABLE_SPIKE) THEN + MAP_EVERY EXISTS_TAC [`\t. c * sinc(c * t)`; `{&0}`] THEN + REWRITE_TAC[REAL_NEGLIGIBLE_SING] THEN CONJ_TAC THENL + [REWRITE_TAC[IN_DIFF; IN_SING] THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[sinc] THEN COND_CASES_TAC THEN + REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[REAL_ENTIRE] THEN + TRY(ASM_REAL_ARITH_TAC) THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC(REAL_FIELD + `~(c = &0) /\ ~(x = &0) ==> sin (c * x) / x = c * sin (c * x) / (c * x)`) + THEN + ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_INTEGRABLE_LMUL THEN + REWRITE_TAC[SINC_STRETCH_INTEGRABLE]]);; + +(* ------------------------------------------------------------------------- *) +(* 283D(b): the uniform bound |INT_a^b sin(cx)/x| <= K. Core estimate here: *) +(* for 0 < a <= b, |INT_a^b sin x/x dx| <= 2/a + 2/b, via the second mean *) +(* value theorem (Fremlin 224J) with the decreasing weight 1/x. *) +(* ------------------------------------------------------------------------- *) + +let SIN_MVT = prove + (`!a b. &0 < a /\ a <= b + ==> ?c. c IN real_interval[a,b] /\ + real_integral (real_interval[a,b]) (\x. --(inv x) * sin x) = + --(inv a) * real_integral (real_interval[a,c]) sin + + --(inv b) * real_integral (real_interval[c,b]) sin`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`sin`; `\x:real. --(inv x)`; `a:real`; `b:real`] + REAL_SECOND_MEAN_VALUE_THEOREM) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [REWRITE_TAC[REAL_INTERVAL_NE_EMPTY] THEN REPEAT CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_INTEGRABLE_CONTINUOUS THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_SIN]; + REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_LE_NEG2] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o REWRITE_RULE[IN_REAL_INTERVAL])) THEN + ASM_REAL_ARITH_TAC]; + DISCH_THEN(X_CHOOSE_THEN `c:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `c:real` THEN + ASM_REWRITE_TAC[]]);; + +let REAL_INTEGRAL_SIN = prove + (`!a c. a <= c ==> real_integral (real_interval[a,c]) sin = cos a - cos c`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + MP_TAC(ISPECL [`\x. --(cos x)`; `sin`; `a:real`; `c:real`] + REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_REAL_DERIVATIVE_ATREAL_WITHIN THEN REAL_DIFF_TAC THEN + REAL_ARITH_TAC; + REWRITE_TAC[REAL_ARITH `--cos c - --cos a = cos a - cos c`]]);; + +let SIN_OVER_X_INTEGRABLE = prove + (`!a b. &0 < a ==> (\x. sin x / x) real_integrable_on real_interval[a,b]`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRABLE_CONTINUOUS THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_WITHINREAL THEN + MATCH_MP_TAC REAL_CONTINUOUS_DIV_ATREAL THEN + REWRITE_TAC[REAL_CONTINUOUS_AT_SIN; REAL_CONTINUOUS_AT_ID] THEN + FIRST_X_ASSUM(MP_TAC o REWRITE_RULE[IN_REAL_INTERVAL]) THEN + ASM_REAL_ARITH_TAC);; + +let NEG_INV_SIN_INTEGRAL = prove + (`!a b. &0 < a + ==> real_integral (real_interval[a,b]) (\x. --(inv x) * sin x) = + --(real_integral (real_interval[a,b]) (\x. sin x / x))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(\x. --(inv x) * sin x) = (\x. --(sin x / x))` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN REWRITE_TAC[real_div] THEN + REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_INTEGRAL_NEG THEN MATCH_MP_TAC SIN_OVER_X_INTEGRABLE THEN + ASM_REWRITE_TAC[]);; + +let ABS_MUL_BOUND = prove + (`!i d:real. &0 < i /\ abs d <= &2 ==> abs(i * d) <= &2 * i`, + REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ABS_MUL] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs i * &2` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[REAL_ABS_POS]; + SUBGOAL_THEN `abs i = i` SUBST1_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN REAL_ARITH_TAC]);; + +let SIN_OVER_X_BOUND = prove + (`!a b. &0 < a /\ a <= b + ==> abs(real_integral (real_interval[a,b]) (\x. sin x / x)) <= &2 * inv a + + &2 * inv b`, + REPEAT STRIP_TAC THEN MP_TAC(SPECL [`a:real`;`b:real`] SIN_MVT) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `c:real` STRIP_ASSUME_TAC) THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_REAL_INTERVAL]) THEN + MP_TAC(SPECL [`a:real`; `b:real`] NEG_INV_SIN_INTEGRAL) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MP_TAC(SPECL [`a:real`; `c:real`] REAL_INTEGRAL_SIN) THEN ANTS_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN SUBST_ALL_TAC THEN + MP_TAC(SPECL [`c:real`; `b:real`] REAL_INTEGRAL_SIN) THEN ANTS_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN SUBST_ALL_TAC THEN + SUBGOAL_THEN `real_integral (real_interval[a,b]) (\x. sin x / x) = + inv a * (cos a - cos c) + inv b * (cos c - cos b)` SUBST1_TAC + THENL + [REPEAT(FIRST_X_ASSUM(fun th -> if is_eq(concl th) then MP_TAC th else + ALL_TAC)) THEN REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < inv a /\ &0 < inv b` STRIP_ASSUME_TAC THENL + [CONJ_TAC THEN MATCH_MP_TAC REAL_LT_INV THEN + ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(SPEC `a:real` COS_BOUNDS) THEN MP_TAC(SPEC `b:real` COS_BOUNDS) THEN + MP_TAC(SPEC `c:real` COS_BOUNDS) THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC(REAL_ARITH + `abs u <= &2 * inv a /\ abs v <= &2 * inv b ==> abs(u + v) <= &2 * inv a + + &2 * inv b`) THEN + CONJ_TAC THEN MATCH_MP_TAC ABS_MUL_BOUND THEN ASM_REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* 283D(a): the VALUE. lim_{a->inf} INT_{-a}^a sin x/x dx = pi (so the *) +(* one-sided limit is pi/2). On the critical path to 283I inversion (hence *) +(* 284C Schwartz inversion and 284O Plancherel). *) +(* *) +(* Route (avoids Fremlin's abstract gamma-existence Cauchy step): prove the *) +(* two-sided running integral G(a) = INT_{-a}^a sin/x -> pi directly at *) +(* posinfinity, anchoring the value on the subsequence a = pi(n+1/2) via the *) +(* Dirichlet kernel, and controlling the tail with SIN_OVER_X_BOUND. *) +(* ------------------------------------------------------------------------- *) + +(* sin x / x is integrable on EVERY interval (unconditional: = sinc off *) +(* {0}). *) +let SIN_OVER_X_INTEGRABLE_UNIV = prove + (`!a b. (\x. sin x / x) real_integrable_on real_interval[a,b]`, + REPEAT GEN_TAC THEN + MP_TAC(ISPECL [`sinc`; `\x. sin x / x`; `{&0}`; `real_interval[a:real,b]`] + REAL_INTEGRABLE_SPIKE) THEN + REWRITE_TAC[REAL_NEGLIGIBLE_SING; SINC_INTEGRABLE] THEN + DISCH_THEN MATCH_MP_TAC THEN + REWRITE_TAC[IN_DIFF; IN_SING; sinc] THEN REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[]);; + +(* Change of variables x = c t (c > 0): stretch [--p,p] by c. *) +let SIN_OVER_X_STRETCH_IMAGE = prove + (`!c p. &0 < c /\ &0 <= p + ==> IMAGE (\x. inv c * x) (real_interval[--(c*p),c*p]) = + real_interval[--p,p]`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `~(c = &0) /\ &0 <= c * p` STRIP_ASSUME_TAC THENL + [CONJ_TAC THENL [ASM_REAL_ARITH_TAC; MATCH_MP_TAC REAL_LE_MUL THEN + ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + REWRITE_TAC[IMAGE_STRETCH_REAL_INTERVAL] THEN + COND_CASES_TAC THENL + [FIRST_X_ASSUM(MP_TAC o REWRITE_RULE[REAL_INTERVAL_EQ_EMPTY]) THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `&0 <= inv c` (fun th -> REWRITE_TAC[th]) THENL + [MATCH_MP_TAC REAL_LE_INV THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_FIELD `~(c = &0) ==> inv c * (c * p) = p`; + REAL_FIELD `~(c = &0) ==> inv c * --(c * p) = --p`]);; + +(* INT_{-c p}^{c p} sin x/x dx = INT_{-p}^p sin(c t)/t dt, for c > 0, p >= *) +(* 0. Stretch x = c t via HAS_REAL_INTEGRAL_STRETCH gives sin(ct)/(ct); *) +(* scale by c (LMUL) and repair the integrand at 0 (SPIKE) to reach *) +(* sin(ct)/t. *) +let SIN_OVER_X_SUBST = prove + (`!c p. &0 < c /\ &0 <= p + ==> real_integral (real_interval[--(c*p), c*p]) (\x. sin x / x) = + real_integral (real_interval[--p,p]) (\t. sin(c * t) / t)`, + REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + MP_TAC(ISPECL [`\x. sin x / x`; + `real_integral (real_interval[--(c*p),c*p]) (\x. sin x / x)`; + `--(c*p):real`; `c*p:real`; + `c:real`] HAS_REAL_INTEGRAL_STRETCH) THEN + ASM_SIMP_TAC[REAL_INTEGRABLE_INTEGRAL; REAL_LT_IMP_NZ; + SIN_OVER_X_INTEGRABLE_UNIV; + SIN_OVER_X_STRETCH_IMAGE] THEN + DISCH_THEN(MP_TAC o SPEC `c:real` o MATCH_MP HAS_REAL_INTEGRAL_LMUL) THEN + REWRITE_TAC[] THEN + SUBGOAL_THEN + `c * inv(abs c) * + real_integral (real_interval[--(c*p),c*p]) (\x. sin x / x) = + real_integral (real_interval[--(c*p),c*p]) (\x. sin x / x)` + SUBST1_TAC THENL + [SUBGOAL_THEN `inv(abs c) = inv c` SUBST1_TAC THENL + [AP_TERM_TAC THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_MUL_ASSOC; REAL_MUL_RINV; REAL_LT_IMP_NZ; REAL_MUL_LID]; + ALL_TAC] THEN + DISCH_TAC THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_SPIKE THEN + MAP_EVERY EXISTS_TAC [`\x. c * sin (c * x) / (c * x)`; `{&0}`] THEN + ASM_REWRITE_TAC[REAL_NEGLIGIBLE_SING] THEN + REWRITE_TAC[IN_DIFF; IN_SING] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC(REAL_FIELD + `~(c = &0) /\ ~(x = &0) ==> sin (c * x) / x = c * sin (c * x) / (c * x)`) + THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* The Dirichlet-kernel comparison function phi(t) = 1/t - 1/(2 sin(t/2)), *) +(* extended by 0 at t = 0. Near 0 the two singular terms cancel; the point *) +(* is that phi is BOUNDED and MEASURABLE on [--pi,pi], hence abs-integrable. *) +(* This is what lets Riemann-Lebesgue kill INT sin((n+1/2)t) phi(t) dt. *) +(* The Taylor estimates SIN_SUB_X_BOUND, SIN_OVER_X_SUB1_BOUND, *) +(* SIN_LOWER_BOUND_HALF and INV_SIN_SUB_INV_BOUND are provided by *) +(* 100/fourier.ml (loaded above). *) +(* ------------------------------------------------------------------------- *) + +(* abs(sin u) = sin|u| when |u| <= pi (sin is odd and >= 0 on [0,pi]). *) +let ABS_SIN_EQ = prove + (`!u. abs u <= pi ==> abs(sin u) = sin(abs u)`, + GEN_TAC THEN DISCH_TAC THEN ASM_CASES_TAC `&0 <= u` THENL + [ASM_SIMP_TAC[REAL_ARITH `&0 <= u ==> abs u = u`] THEN + REWRITE_TAC[REAL_ABS_REFL] THEN MATCH_MP_TAC SIN_POS_PI_LE THEN + ASM_REAL_ARITH_TAC; + ASM_SIMP_TAC[REAL_ARITH `~(&0 <= u) ==> abs u = --u`; SIN_NEG] THEN + MATCH_MP_TAC(REAL_ARITH `s <= &0 ==> abs s = --s`) THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= --(sin u) ==> sin u <= &0`) THEN + REWRITE_TAC[GSYM SIN_NEG] THEN MATCH_MP_TAC SIN_POS_PI_LE THEN + ASM_REAL_ARITH_TAC]);; + +(* Away from 0: sin(1/2) <= |sin(t/2)| when 1 <= |t| <= pi. *) +let SIN_HALF_LOWER_BOUND = prove + (`!t. &1 <= abs t /\ abs t <= pi ==> sin(&1 / &2) <= abs(sin(t / &2))`, + GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `abs(sin(t / &2)) = sin(abs(t / &2))` SUBST1_TAC THENL + [MATCH_MP_TAC ABS_SIN_EQ THEN MP_TAC PI_APPROX_32 THEN + ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_ABS_DIV; REAL_ABS_NUM] THEN + MATCH_MP_TAC SIN_MONO_LE THEN MP_TAC PI_APPROX_32 THEN ASM_REAL_ARITH_TAC);; + +(* phi(t) = 1/t - 1/(2 sin(t/2)) is MEASURABLE on [--pi,pi]: each term is + 1/g *) +(* with g continuous and vanishing only on a countable (negligible) set. *) +let DIRICHLET_PHI_MEASURABLE = prove + (`(\t. inv t - inv(&2 * sin(t / &2))) real_measurable_on + real_interval[--pi,pi]`, + MATCH_MP_TAC REAL_MEASURABLE_ON_SUB THEN CONJ_TAC THEN + GEN_REWRITE_TAC (LAND_CONV) [GSYM ETA_AX] THEN REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[REAL_ARITH `inv x = &1 / x`] THEN + MATCH_MP_TAC REAL_MEASURABLE_ON_DIV THEN + SIMP_TAC[REAL_CONTINUOUS_IMP_REAL_MEASURABLE_ON_CLOSED_SUBSET; + REAL_CLOSED_REAL_INTERVAL; REAL_CONTINUOUS_ON_CONST; + REAL_CONTINUOUS_ON_ID; SING_GSPEC; REAL_NEGLIGIBLE_SING; + REAL_CLOSED_UNIV] THEN + CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_IMP_REAL_MEASURABLE_ON THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_WITHINREAL THEN + MATCH_MP_TAC REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL THEN + REAL_DIFFERENTIABLE_TAC; + MATCH_MP_TAC REAL_NEGLIGIBLE_COUNTABLE THEN + MATCH_MP_TAC COUNTABLE_SUBSET THEN + EXISTS_TAC `IMAGE (\n. &2 * n * pi) integer` THEN CONJ_TAC THENL + [MATCH_MP_TAC COUNTABLE_IMAGE THEN + REWRITE_TAC[COUNTABLE_INTEGER]; ALL_TAC] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_IMAGE] THEN X_GEN_TAC `x:real` THEN + ASM_CASES_TAC `sin(x / &2) = &0` THENL + [ALL_TAC; ASM_REWRITE_TAC[REAL_ENTIRE] THEN + CONV_TAC REAL_RAT_REDUCE_CONV] THEN + DISCH_TAC THEN MP_TAC(SPEC `x / &2` SIN_EQ_0) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `n:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `n:real` THEN ASM_REWRITE_TAC[IN] THEN ASM_REAL_ARITH_TAC]);; + +(* phi is BOUNDED on [--pi,pi]: |phi(t)| <= 2 + 2/sin(1/2). Near 0 the *) +(* singular terms cancel (INV_SIN_SUB_INV_BOUND); away from 0 both are + bounded. *) +let DIRICHLET_PHI_BOUND = prove + (`!t. t IN real_interval[--pi,pi] + ==> abs(inv t - inv(&2 * sin(t / &2))) <= &2 + &2 * inv(sin(&1 / &2))`, + REWRITE_TAC[IN_REAL_INTERVAL] THEN GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `&0 <= &2 * inv(sin(&1 / &2))` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_POS] THEN + MATCH_MP_TAC REAL_LE_INV THEN MATCH_MP_TAC SIN_POS_PI_LE THEN + MP_TAC PI_APPROX_32 THEN REAL_ARITH_TAC; ALL_TAC] THEN + ASM_CASES_TAC `t = &0` THENL + [ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `inv(&0) - inv(&2 * sin(&0 / &2)) = &0` SUBST1_TAC THENL + [REWRITE_TAC[real_div; REAL_MUL_LZERO; SIN_0; REAL_MUL_RZERO; + REAL_INV_0] THEN + REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_ABS_NUM] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_CASES_TAC `abs t <= &1` THENL + [SUBGOAL_THEN `~(sin(t / &2) = &0)` ASSUME_TAC THENL + [MP_TAC(SPEC `t / &2` SIN_EQ_0_PI) THEN MP_TAC PI_APPROX_32 THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[REAL_FIELD `~(t = &0) /\ ~(sin(t / &2) = &0) + ==> inv t - inv(&2 * sin(t / &2)) = + --(&1 / &2) * (inv(sin(t / &2)) - inv(t / &2))`] THEN + MP_TAC(SPEC `t / &2` INV_SIN_SUB_INV_BOUND) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN DISCH_TAC THEN + REWRITE_TAC[REAL_ABS_MUL] THEN ASM_REAL_ARITH_TAC; + SUBGOAL_THEN `sin(&1 / &2) <= abs(sin(t / &2))` ASSUME_TAC THENL + [MATCH_MP_TAC SIN_HALF_LOWER_BOUND THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `&0 < sin(&1 / &2)` ASSUME_TAC THENL + [MATCH_MP_TAC SIN_POS_PI THEN MP_TAC PI_APPROX_32 THEN + REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `abs(inv t) <= &1` ASSUME_TAC THENL + [REWRITE_TAC[REAL_ABS_INV] THEN MATCH_MP_TAC REAL_INV_LE_1 THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `abs(inv(&2 * sin(t / &2))) <= inv(sin(&1 / &2))` ASSUME_TAC THENL + [REWRITE_TAC[REAL_ABS_INV; REAL_ABS_MUL; REAL_ABS_NUM] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(&2 * sin(&1 / &2))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INV2 THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LT_MUL THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REAL_ARITH_TAC]; + MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + ASM_REAL_ARITH_TAC]);; + +(* Hence phi is absolutely integrable on [--pi,pi] (bounded x measurable). *) +let DIRICHLET_PHI_ABSINT = prove + (`(\t. inv t - inv(&2 * sin(t / &2))) absolutely_real_integrable_on + real_interval[--pi,pi]`, + SUBGOAL_THEN + `(\t. (inv t - inv(&2 * sin(t / &2))) * &1) absolutely_real_integrable_on + real_interval[--pi,pi]` + MP_TAC THENL + [MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT THEN + REWRITE_TAC[DIRICHLET_PHI_MEASURABLE; + ABSOLUTELY_REAL_INTEGRABLE_CONST] THEN + REWRITE_TAC[REAL_BOUNDED_POS; FORALL_IN_IMAGE] THEN + EXISTS_TAC `&2 + &2 * inv(sin(&1 / &2)) + &1` THEN CONJ_TAC THENL + [MP_TAC(SPEC `&0` DIRICHLET_PHI_BOUND) THEN + REWRITE_TAC[IN_REAL_INTERVAL] THEN ANTS_TAC THENL + [MP_TAC PI_APPROX_32 THEN REAL_ARITH_TAC; ALL_TAC] THEN REAL_ARITH_TAC; + REPEAT STRIP_TAC THEN MP_TAC(SPEC `x:real` DIRICHLET_PHI_BOUND) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC]; + REWRITE_TAC[REAL_MUL_RID]]);; + +(* The two summands of sin((n+1/2)t)/t = sin(...) phi + sin(...)/(2 *) +(* sin(t/2)) are each integrable on [--pi,pi]. *) +let DIRICHLET_SINPHI_INTEGRABLE = prove + (`!n. (\t. sin((&n + &1 / &2) * t) * (inv t - inv(&2 * sin(t / &2)))) + real_integrable_on real_interval[--pi,pi]`, + GEN_TAC THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT THEN + REWRITE_TAC[DIRICHLET_PHI_ABSINT] THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_IMP_REAL_MEASURABLE_ON_CLOSED_SUBSET THEN + REWRITE_TAC[REAL_CLOSED_REAL_INTERVAL] THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_WITHINREAL THEN + MATCH_MP_TAC REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL THEN + REAL_DIFFERENTIABLE_TAC; + REWRITE_TAC[REAL_BOUNDED_POS; FORALL_IN_IMAGE] THEN EXISTS_TAC `&1` THEN + REWRITE_TAC[REAL_LT_01] THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[SIN_BOUND]]);; + +let DIRICHLET_SININV_INTEGRABLE = prove + (`!n. (\t. sin((&n + &1 / &2) * t) / (&2 * sin(t / &2))) + real_integrable_on real_interval[--pi,pi]`, + GEN_TAC THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] REAL_INTEGRABLE_SPIKE) THEN + MAP_EVERY EXISTS_TAC [`dirichlet_kernel n`; `{&0}`] THEN + REWRITE_TAC[REAL_NEGLIGIBLE_SING] THEN CONJ_TAC THENL + [REWRITE_TAC[IN_DIFF; IN_SING] THEN REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[dirichlet_kernel]; + MP_TAC(SPEC `n:num` HAS_REAL_INTEGRAL_DIRICHLET_KERNEL) THEN + REWRITE_TAC[HAS_REAL_INTEGRAL_INTEGRABLE_INTEGRAL] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[]]);; + +(* The Dirichlet-kernel integral value in sin/(2 sin) form: = pi for all n. *) +let DIRICHLET_SININV_VALUE = prove + (`!n. real_integral (real_interval[--pi,pi]) + (\t. sin((&n + &1 / &2) * t) / (&2 * sin(t / &2))) = pi`, + GEN_TAC THEN + MP_TAC(ISPECL [`\x:real. &1`; `n:num`; `real_interval[--pi,pi]`] + REAL_INTEGRAL_DIRICHLET_KERNEL_MUL_EXPAND) THEN + REWRITE_TAC[REAL_MUL_RID] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + REWRITE_TAC[ETA_AX; HAS_REAL_INTEGRAL_DIRICHLET_KERNEL]);; + +(* ------------------------------------------------------------------------- *) +(* The sequential Dirichlet limit: INT_{-pi}^pi sin((n+1/2)t)/t dt -> pi. *) +(* Split sin((n+1/2)t)/t = sin(...) phi(t) + sin(...)/(2 sin(t/2)); the + first *) +(* integral -> 0 by Riemann-Lebesgue (phi abs-integrable), the second = pi. *) +(* ------------------------------------------------------------------------- *) + +let DIRICHLET_SINE_LIMIT_SEQ = prove + (`((\n. real_integral (real_interval[--pi,pi]) + (\t. sin((&n + &1 / &2) * t) / t)) + ---> pi) sequentially`, + SUBGOAL_THEN + `!n. real_integral (real_interval[--pi,pi]) + (\t. sin((&n + &1 / &2) * t) / t) = + real_integral (real_interval[--pi,pi]) + (\t. sin((&n + &1 / &2) * t) * (inv t - inv(&2 * sin(t / &2)))) + pi` + (fun th -> REWRITE_TAC[th]) THENL + [GEN_TAC THEN + SUBGOAL_THEN + `real_integral (real_interval[--pi,pi]) + (\t. sin((&n + &1 / &2) * t) / t) = + real_integral (real_interval[--pi,pi]) + (\t. sin((&n + &1 / &2) * t) * (inv t - inv(&2 * sin(t / &2))) + + sin((&n + &1 / &2) * t) / (&2 * sin(t / &2)))` + SUBST1_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_EQ THEN X_GEN_TAC `t:real` THEN + REWRITE_TAC[IN_REAL_INTERVAL] THEN STRIP_TAC THEN + REWRITE_TAC[real_div; + REAL_ARITH `!s a b:real. s * (a - b) + s * b = s * a`]; + ALL_TAC] THEN + ASM_SIMP_TAC[REAL_INTEGRAL_ADD; DIRICHLET_SINPHI_INTEGRABLE; + DIRICHLET_SININV_INTEGRABLE] THEN + REWRITE_TAC[DIRICHLET_SININV_VALUE]; + ALL_TAC] THEN + MP_TAC(ISPECL [`sequentially`; + `\n. real_integral (real_interval[--pi,pi]) + (\t. sin((&n + &1 / &2) * t) * (inv t - inv(&2 * sin(t / &2))))`; + `\n:num. pi`; `&0`; `pi`] REALLIM_ADD) THEN + REWRITE_TAC[REALLIM_CONST; REAL_ADD_LID] THEN DISCH_THEN MATCH_MP_TAC THEN + MATCH_MP_TAC RIEMANN_LEBESGUE_SIN_HALF THEN + REWRITE_TAC[DIRICHLET_PHI_ABSINT]);; + +(* ------------------------------------------------------------------------- *) +(* Upgrade the sequential limit to the continuous one at +infinity. Two *) +(* facts: sin x/x is EVEN so G(a) = INT_{-a}^a = 2 INT_0^a; and G on the *) +(* samples a = (n+1/2)pi equals the sin((n+1/2)t)/t integral + (SIN_OVER_X_SUBST *) +(* with c = n+1/2), which -> pi. The tail bound SIN_OVER_X_BOUND fills in. *) +(* ------------------------------------------------------------------------- *) + +(* sin x/x is even: INT_{-a}^0 sin x/x = INT_0^a sin x/x. *) +let SIN_OVER_X_REFLECT_HALF = prove + (`!a. real_integral (real_interval[--a,&0]) (\x. sin x / x) = + real_integral (real_interval[&0,a]) (\x. sin x / x)`, + GEN_TAC THEN + MP_TAC(ISPECL [`\x. sin x / x`; `&0:real`; `a:real`] + REAL_INTEGRAL_REFLECT) THEN + REWRITE_TAC[REAL_NEG_0; SIN_NEG; real_div; REAL_INV_NEG; REAL_NEG_MUL2] THEN + REWRITE_TAC[GSYM real_div] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REFL_TAC);; + +(* Hence the two-sided integral is twice the one-sided: G(a) = 2 INT_0^a. *) +let SIN_OVER_X_TWO_SIDED = prove + (`!a. &0 <= a + ==> real_integral (real_interval[--a,a]) (\x. sin x / x) = + &2 * real_integral (real_interval[&0,a]) (\x. sin x / x)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\x. sin x / x`; `--a:real`; `a:real`; `&0:real`] + REAL_INTEGRAL_COMBINE) THEN + ASM_SIMP_TAC[SIN_OVER_X_INTEGRABLE_UNIV; + REAL_ARITH `&0 <= a ==> --a <= &0`] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[SIN_OVER_X_REFLECT_HALF] THEN + REAL_ARITH_TAC);; + +(* The samples: INT_{-(n+1/2)pi}^{(n+1/2)pi} sin x/x = + INT_{-pi}^pi sin((n+1/2)t)/t. *) +let SIN_OVER_X_SAMPLE = prove + (`!n. real_integral + (real_interval[--((&n + &1 / &2) * pi), (&n + &1 / &2) * pi]) + (\x. sin x / x) = + real_integral (real_interval[--pi,pi]) + (\t. sin((&n + &1 / &2) * t) / t)`, + GEN_TAC THEN MATCH_MP_TAC SIN_OVER_X_SUBST THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&1 / &2` THEN + CONJ_TAC THENL [REAL_ARITH_TAC; SIMP_TAC[REAL_LE_ADDL; REAL_POS]]; + MP_TAC PI_POS THEN REAL_ARITH_TAC]);; + +(* Hence G on the samples tends to pi. *) +let SIN_OVER_X_SAMPLE_LIMIT = prove + (`((\n. real_integral + (real_interval[--((&n + &1 / &2) * pi), (&n + &1 / &2) * pi]) + (\x. sin x / x)) ---> pi) sequentially`, + REWRITE_TAC[SIN_OVER_X_SAMPLE; DIRICHLET_SINE_LIMIT_SEQ]);; + +(* Tail control: 0 < b <= a ==> |G(a) - G(b)| <= 8/b (G(a) = INT_{-a}^a). *) +(* Both endpoints share the small lower endpoint b, so the difference is a *) +(* single tail INT_b^a bounded by SIN_OVER_X_BOUND -- no nearest-sample + needed. *) +let SIN_OVER_X_TAIL_DIFF = prove + (`!a b. &0 < b /\ b <= a + ==> abs(real_integral (real_interval[--a,a]) (\x. sin x / x) - + real_integral (real_interval[--b,b]) (\x. sin x / x)) <= &8 / b`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&0 <= a /\ &0 <= b` STRIP_ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[SIN_OVER_X_TWO_SIDED] THEN + SUBGOAL_THEN + `real_integral (real_interval[&0,a]) (\x. sin x / x) - + real_integral (real_interval[&0,b]) (\x. sin x / x) = + real_integral (real_interval[b,a]) (\x. sin x / x)` + (fun th -> + ONCE_REWRITE_TAC[REAL_ARITH `&2 * x - &2 * y = &2 * (x - y)`] THEN + REWRITE_TAC[th]) THENL + [MP_TAC(ISPECL [`\x. sin x / x`; `&0:real`; `a:real`; `b:real`] + REAL_INTEGRAL_COMBINE) THEN + ASM_SIMP_TAC[SIN_OVER_X_INTEGRABLE_UNIV] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NUM] THEN + MP_TAC(SPECL [`b:real`; `a:real`] SIN_OVER_X_BOUND) THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `inv a <= inv b` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + DISCH_TAC THEN + SUBGOAL_THEN `&8 / b = &2 * (&2 * inv b + &2 * inv b)` SUBST1_TAC THENL + [REWRITE_TAC[real_div] THEN REAL_ARITH_TAC; ALL_TAC] THEN + ASM_REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* 283D(a), first form: lim_{a->+inf} INT_{-a}^a sin x/x dx = pi. *) +(* Anchor at a fixed sample b = (N+1/2)pi with N large enough that both *) +(* |G(b) - pi| < e/2 (sequential limit) and 8/b < e/2 (b >= 16/e); then for *) +(* every a >= b, |G(a) - pi| <= |G(a) - G(b)| + |G(b) - pi| <= 8/b + e/2 + < e. *) +(* ------------------------------------------------------------------------- *) + +let SIN_OVER_X_LIMIT_POSINF = prove + (`((\a. real_integral (real_interval[--a,a]) (\x. sin x / x)) ---> pi) + at_posinfinity`, + REWRITE_TAC[REALLIM_AT_POSINFINITY] THEN X_GEN_TAC `e:real` THEN + DISCH_TAC THEN + MP_TAC SIN_OVER_X_SAMPLE_LIMIT THEN REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `N1:num` ASSUME_TAC) THEN + MP_TAC(SPEC `&16 / e` REAL_ARCH_SIMPLE) THEN + DISCH_THEN(X_CHOOSE_THEN `N2:num` ASSUME_TAC) THEN + EXISTS_TAC `(&(N1 + N2) + &1 / &2) * pi` THEN + X_GEN_TAC `x:real` THEN REWRITE_TAC[real_ge] THEN DISCH_TAC THEN + ABBREV_TAC `b = (&(N1 + N2) + &1 / &2) * pi` THEN + SUBGOAL_THEN `&0 < b` ASSUME_TAC THENL + [EXPAND_TAC "b" THEN MATCH_MP_TAC REAL_LT_MUL THEN + CONJ_TAC THENL [REAL_ARITH_TAC; MP_TAC PI_POS THEN REAL_ARITH_TAC]; + ALL_TAC] THEN + MP_TAC(SPECL [`x:real`; `b:real`] SIN_OVER_X_TAIL_DIFF) THEN + ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `N1 + N2:num`) THEN + ANTS_TAC THENL [ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN + SUBGOAL_THEN `&16 / e <= b` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&N2` THEN + ASM_REWRITE_TAC[] THEN + EXPAND_TAC "b" THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&(N1+N2) + &1 / &2` THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC; + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN + CONJ_TAC THENL + [REAL_ARITH_TAC; MP_TAC PI_APPROX_32 THEN REAL_ARITH_TAC]]; + ALL_TAC] THEN + SUBGOAL_THEN `&8 / b <= e / &2` ASSUME_TAC THENL + [SUBGOAL_THEN `&16 <= b * e` ASSUME_TAC THENL + [ASM_MESON_TAC[REAL_LE_LDIV_EQ]; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_REAL_ARITH_TAC);; + +(* Corollary (Fremlin 283D(a) as stated): lim_{a->+inf} INT_0^a sin x/x = + pi/2. *) +let SIN_OVER_X_LIMIT_POSINF_HALF = prove + (`((\a. real_integral (real_interval[&0,a]) (\x. sin x / x)) ---> pi / &2) + at_posinfinity`, + MP_TAC SIN_OVER_X_LIMIT_POSINF THEN + REWRITE_TAC[REALLIM_AT_POSINFINITY] THEN MATCH_MP_TAC MONO_FORALL THEN + X_GEN_TAC `e:real` THEN MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` ASSUME_TAC) THEN + EXISTS_TAC `abs B + &1` THEN X_GEN_TAC `a:real` THEN + REWRITE_TAC[real_ge] THEN + DISCH_TAC THEN + SUBGOAL_THEN `&0 <= a` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `a:real`) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[SIN_OVER_X_TWO_SIDED] THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* The frequency-scaled Dirichlet limit needed by 283E: *) +(* lim_{a->inf} INT_{-a}^a sin(b x)/x dx = pi (b>0), -pi (b<0), 0 (b=0). *) +(* For b>0, substitute u = b x (SIN_OVER_X_SUBST) so the integral becomes + the *) +(* plain one over [-ba, ba] with ba -> +inf. b<0 is the odd reflection; b=0 *) +(* trivial. *) +(* ------------------------------------------------------------------------- *) + +let SIN_BX_OVER_X_LIMIT_POS = prove + (`!b. &0 < b + ==> ((\a. real_integral (real_interval[--a,a]) (\t. sin(b * t) / t)) ---> + pi) + at_posinfinity`, + REPEAT STRIP_TAC THEN + MP_TAC SIN_OVER_X_LIMIT_POSINF THEN REWRITE_TAC[REALLIM_AT_POSINFINITY] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `e:real` THEN + MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` ASSUME_TAC) THEN + EXISTS_TAC `(abs B + &1) / b` THEN X_GEN_TAC `a:real` THEN + REWRITE_TAC[real_ge] THEN DISCH_TAC THEN + SUBGOAL_THEN `&0 <= a` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(abs B + &1) / b` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_DIV THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `(b:real) * a >= B` ASSUME_TAC THENL + [REWRITE_TAC[real_ge] THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `abs B + &1` THEN CONJ_TAC THENL + [REAL_ARITH_TAC; + MP_TAC(ISPECL [`(abs B + &1) / b`; `a:real`; `b:real`] REAL_LE_RMUL) THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_DIV_RMUL; REAL_LT_IMP_NZ] THEN + REWRITE_TAC[REAL_MUL_SYM]]; ALL_TAC] THEN + SUBGOAL_THEN + `real_integral (real_interval[--a,a]) (\t. sin(b * t) / t) = + real_integral (real_interval[--(b * a), b * a]) (\x. sin x / x)` + SUBST1_TAC THENL + [MP_TAC(SPECL [`b:real`; `a:real`] SIN_OVER_X_SUBST) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REFL_TAC; + ALL_TAC] THEN + UNDISCH_TAC + `forall x. x >= B + ==> abs (real_integral (real_interval [--x,x]) (\x. sin x / x) - pi) + < e` THEN + DISCH_THEN(MP_TAC o SPEC `(b:real) * a`) THEN ASM_REWRITE_TAC[]);; + +(* Pointwise reflection: for b<0, INT sin(bt)/t = -INT sin(-b t)/t (-b>0). *) +let SIN_BX_OVER_X_REFLECT = prove + (`!b a. b < &0 + ==> real_integral (real_interval[--a,a]) (\t. sin(b * t) / t) = + --(real_integral (real_interval[--a,a]) (\t. sin(--b * t) / t))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\t. sin(--b * t) / t`; `real_interval[--a,a]`] + REAL_INTEGRAL_NEG) THEN + ANTS_TAC THENL + [MATCH_MP_TAC SIN_STRETCH_OVER_X_INTEGRABLE THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC REAL_INTEGRAL_EQ THEN X_GEN_TAC `t:real` THEN DISCH_TAC THEN + REWRITE_TAC[REAL_MUL_LNEG; SIN_NEG; real_div] THEN REAL_ARITH_TAC);; + +(* sin(bx)/x is odd in b, giving the full sign-cased limit that 283E *) +(* consumes. *) +let SIN_BX_OVER_X_LIMIT = prove + (`!b. ((\a. real_integral (real_interval[--a,a]) (\t. sin(b * t) / t)) ---> + (if &0 < b then pi else if b < &0 then --pi else &0)) at_posinfinity`, + GEN_TAC THEN + REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC + (REAL_ARITH `&0 < b \/ b < &0 \/ b = &0`) THENL + [ASM_SIMP_TAC[SIN_BX_OVER_X_LIMIT_POS]; + ASM_SIMP_TAC[REAL_ARITH `b < &0 ==> ~(&0 < b)`; SIN_BX_OVER_X_REFLECT] THEN + MATCH_MP_TAC REALLIM_NEG THEN MATCH_MP_TAC SIN_BX_OVER_X_LIMIT_POS THEN + ASM_REAL_ARITH_TAC; + ASM_REWRITE_TAC[REAL_LT_REFL] THEN + REWRITE_TAC[REAL_MUL_LZERO; SIN_0; real_div; REAL_MUL_LZERO] THEN + REWRITE_TAC[REAL_INTEGRAL_0; REALLIM_CONST]]);; + +(* ========================================================================= *) +(* SECTION 3. Riemann-Lebesgue lemma on the whole real line *) +(* (Fremlin 283Cg / 282E). *) +(* INT_R h(u) sin(a u) du -> 0 as a -> +inf, for h in L^1(R). *) +(* This ingredient of the pointwise Fourier inversion theorem 283I is not *) +(* already in HOL Light: the base library's Riemann-Lebesgue lemma is *) +(* PERIODIC (100/fourier.ml, on [-pi,pi], via Bessel/orthonormal systems) and *) +(* does not transfer to the line. *) +(* *) +(* Route: L^1 density by continuous bounded functions, the *) +(* |INT h sin(au)| <= INT|h| transfer, and the *) +(* half-period translation trick, which needs L^1-continuity of translation. *) +(* ========================================================================= *) + +(* ------------------------------------------------------------------------- *) +(* Whole-line translation invariance of the real integral (foundational). *) +(* ------------------------------------------------------------------------- *) + +let HAS_REAL_INTEGRAL_TRANSLATION_UNIV = prove + (`!H c i. ((\u. H(u + c)) has_real_integral i) (:real) <=> + (H has_real_integral i) (:real)`, + REPEAT GEN_TAC THEN REWRITE_TAC[has_real_integral; IMAGE_LIFT_UNIV] THEN + SUBGOAL_THEN `lift o (\u. H(u + c)) o drop = + (\x. (lift o H o drop)(lift c + x))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; o_THM] THEN GEN_TAC THEN + REWRITE_TAC[DROP_ADD; LIFT_DROP] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[HAS_INTEGRAL_TRANSLATION] THEN + REWRITE_TAC[TRANSLATION_UNIV]);; + +let REAL_INTEGRABLE_TRANSLATION_UNIV = prove + (`!H c. (\u. H(u + c)) real_integrable_on (:real) <=> + H real_integrable_on (:real)`, + REWRITE_TAC[real_integrable_on; HAS_REAL_INTEGRAL_TRANSLATION_UNIV]);; + +let REAL_INTEGRAL_TRANSLATION_UNIV = prove + (`!H c. real_integral (:real) (\u. H(u + c)) = real_integral (:real) H`, + REPEAT GEN_TAC THEN REWRITE_TAC[real_integral] THEN + AP_TERM_TAC THEN ABS_TAC THEN + REWRITE_TAC[HAS_REAL_INTEGRAL_TRANSLATION_UNIV]);; + +let ABSOLUTELY_REAL_INTEGRABLE_TRANSLATION_UNIV = prove + (`!H c. (\u. H(u + c)) absolutely_real_integrable_on (:real) <=> + H absolutely_real_integrable_on (:real)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_ON; IMAGE_LIFT_UNIV] THEN + SUBGOAL_THEN `lift o (\u. H(u + c)) o drop = + (\x. (lift o H o drop)(lift c + x))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; o_THM] THEN GEN_TAC THEN + REWRITE_TAC[DROP_ADD; LIFT_DROP] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[ABSOLUTELY_INTEGRABLE_TRANSLATION] THEN + REWRITE_TAC[TRANSLATION_UNIV]);; + +(* The abs-difference of an L^1 function and its translate is integrable. *) +let ABS_DIFF_TRANSLATION_INTEGRABLE = prove + (`!H c. H absolutely_real_integrable_on (:real) + ==> (\u. abs(H(u + c) - H u)) real_integrable_on (:real)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_ABS THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_SUB THEN + ASM_REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_TRANSLATION_UNIV]);; + +(* ------------------------------------------------------------------------- *) +(* L^1-CONTINUITY OF TRANSLATION (the analytic heart): for H in L^1(R), *) +(* INT_R |H(u+c) - H(u)| du -> 0 as c -> 0. *) +(* Bridged from the vector CONTINUOUS_ON_ABSOLUTELY_INTEGRABLE_TRANSLATION_ *) +(* NORM (measure.ml) via the lift/drop <-> real_integral dictionary. *) +(* ------------------------------------------------------------------------- *) + +let REAL_TRANSLATION_CONTINUITY = prove + (`!H. H absolutely_real_integrable_on (:real) + ==> ((\c. real_integral (:real) (\u. abs(H(u + c) - H u))) ---> &0) + (atreal(&0))`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o + REWRITE_RULE[ABSOLUTELY_REAL_INTEGRABLE_ON; IMAGE_LIFT_UNIV]) THEN + DISCH_THEN(MP_TAC o + MATCH_MP CONTINUOUS_ON_ABSOLUTELY_INTEGRABLE_TRANSLATION_NORM) THEN + REWRITE_TAC[o_THM; LIFT_DROP; GSYM LIFT_SUB; NORM_LIFT] THEN + REWRITE_TAC[REALLIM_ATREAL_AT; LIFT_NUM; TENDSTO_REAL; o_DEF] THEN + SUBGOAL_THEN + `(\a. integral (:real^1) (\x. lift(abs(H(drop(a + x)) - H(drop x))))) = + (\x. lift(real_integral (:real) (\u. abs(H(u + drop x) - H u))))` + (fun th -> REWRITE_TAC[th]) THEN + REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `a:real^1` THEN + MP_TAC(SPECL [`H:real->real`; `drop(a:real^1)`] + ABS_DIFF_TRANSLATION_INTEGRABLE) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(fun th -> REWRITE_TAC[MATCH_MP REAL_INTEGRAL th]) THEN + REWRITE_TAC[IMAGE_LIFT_UNIV; LIFT_DROP] THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM; o_THM] THEN X_GEN_TAC `x:real^1` THEN + REWRITE_TAC[LIFT_DROP; DROP_ADD] THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[REAL_ADD_SYM]);; + +(* ------------------------------------------------------------------------- *) +(* Assembling Riemann-Lebesgue via the half-period translation trick. *) +(* H in L^1(R) => H(.) sin(a.) is absolutely integrable; the half-period *) +(* identity INT H(u)sin(au) = -INT H(u-pi/a)sin(au); hence 2 INT H sin(au) + = *) +(* INT (H(u)-H(u-pi/a)) sin(au), which is O(INT|H(u)-H(u-pi/a)|) -> 0. *) +(* ------------------------------------------------------------------------- *) + +(* H in L^1 => H(.) sin(a.) absolutely integrable (bounded x L^1). *) +let FOURIER_SIN_ABSINT = prove + (`!H a. H absolutely_real_integrable_on (:real) + ==> (\u. H u * sin(a * u)) absolutely_real_integrable_on (:real)`, + REPEAT STRIP_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_IMP_REAL_MEASURABLE_ON_CLOSED_SUBSET THEN + REWRITE_TAC[REAL_CLOSED_UNIV] THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_WITHINREAL THEN + MATCH_MP_TAC REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL THEN + REAL_DIFFERENTIABLE_TAC; + REWRITE_TAC[REAL_BOUNDED_POS; FORALL_IN_IMAGE] THEN EXISTS_TAC `&1` THEN + REWRITE_TAC[REAL_LT_01] THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[SIN_BOUND]]);; + +(* sin(x - pi) = -sin x. *) +let SIN_SUB_PI = prove + (`!x. sin(x - pi) = --sin x`, + GEN_TAC THEN + REWRITE_TAC[REAL_ARITH `x - pi = --pi + x`; SIN_ADD; SIN_NEG; COS_NEG; + SIN_PI; COS_PI] THEN REAL_ARITH_TAC);; + +(* The half-period identity. *) +let FOURIER_SIN_HALF_PERIOD = prove + (`!H a. ~(a = &0) /\ H absolutely_real_integrable_on (:real) + ==> real_integral (:real) (\u. H u * sin(a * u)) = + --(real_integral (:real) (\u. H(u - pi / a) * sin(a * u)))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\u. H(u) * sin(a * u)`; `--(pi / a)`] + REAL_INTEGRAL_TRANSLATION_UNIV) THEN + REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + SUBGOAL_THEN + `(\u. H (u + --(pi / a)) * sin (a * (u + --(pi / a)))) = + (\u. --(H(u - pi / a) * sin(a * u)))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `u:real` THEN + REWRITE_TAC[REAL_ARITH `u + --(pi / a) = u - pi / a`] THEN + SUBGOAL_THEN `a * (u - pi / a) = (a * u) - pi` SUBST1_TAC THENL + [REWRITE_TAC[REAL_SUB_LDISTRIB] THEN + SUBGOAL_THEN `a * (pi / a) = pi` SUBST1_TAC THENL + [MATCH_MP_TAC REAL_DIV_LMUL THEN ASM_REWRITE_TAC[]; REAL_ARITH_TAC]; + ALL_TAC] THEN + REWRITE_TAC[SIN_SUB_PI; REAL_MUL_RNEG]; ALL_TAC] THEN + MATCH_MP_TAC REAL_INTEGRAL_NEG THEN + ONCE_REWRITE_TAC[REAL_ARITH `u - pi / a = u + (--(pi / a))`] THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC FOURIER_SIN_ABSINT THEN + REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_TRANSLATION_UNIV] THEN + ASM_REWRITE_TAC[]);; + +(* 2 INT H sin(au) = INT (H(u) - H(u-pi/a)) sin(au) (from the half-period + id). *) +let FOURIER_SIN_DOUBLE = prove + (`!H a. ~(a = &0) /\ H absolutely_real_integrable_on (:real) + ==> &2 * real_integral (:real) (\u. H u * sin(a * u)) = + real_integral (:real) (\u. (H u - H(u - pi / a)) * sin(a * u))`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`H:real->real`; `a:real`] FOURIER_SIN_HALF_PERIOD) THEN + ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN + SUBGOAL_THEN + `real_integral (:real) (\u. (H u - H(u - pi / a)) * sin(a * u)) = + real_integral (:real) (\u. H u * sin(a * u)) - + real_integral (:real) (\u. H(u - pi / a) * sin(a * u))` + SUBST1_TAC THENL + [REWRITE_TAC[REAL_SUB_RDISTRIB] THEN MATCH_MP_TAC REAL_INTEGRAL_SUB THEN + CONJ_TAC THEN MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE THENL + [MATCH_MP_TAC FOURIER_SIN_ABSINT THEN ASM_REWRITE_TAC[]; + ONCE_REWRITE_TAC[REAL_ARITH `u - pi / a = u + --(pi / a)`] THEN + MATCH_MP_TAC FOURIER_SIN_ABSINT THEN + ASM_REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_TRANSLATION_UNIV]]; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; + +(* |INT (H(u)-H(u-pi/a)) sin(au)| <= INT |H(u)-H(u-pi/a)| (|sin| <= 1). *) +let FOURIER_SIN_DIFF_BOUND = prove + (`!H a. H absolutely_real_integrable_on (:real) + ==> abs(real_integral (:real) (\u. (H u - H(u - pi / a)) * sin(a * u))) <= + real_integral (:real) (\u. abs(H u - H(u - pi / a)))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_ABS_BOUND_INTEGRAL THEN + SUBGOAL_THEN + `(\u. H u - H(u - pi / a)) absolutely_real_integrable_on (:real)` + ASSUME_TAC THENL + [MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_SUB THEN ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[REAL_ARITH `u - pi / a = u + --(pi / a)`] THEN + ASM_REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_TRANSLATION_UNIV]; ALL_TAC] THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC FOURIER_SIN_ABSINT THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_ABS THEN ASM_REWRITE_TAC[]; + X_GEN_TAC `u:real` THEN DISCH_TAC THEN REWRITE_TAC[REAL_ABS_MUL] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS; SIN_BOUND]]);; + +(* ------------------------------------------------------------------------- *) +(* THE RIEMANN-LEBESGUE LEMMA on the real line (Fremlin 283Cg / 282E): *) +(* INT_R H(u) sin(a u) du -> 0 as a -> +inf, for H in L^1(R). *) +(* eps-B: translation-continuity gives delta for eps; take B = pi/delta + 1; *) +(* for a >= B, pi/a < delta, so 2|INT H sin(au)| = |INT (H(u)-H(u-pi/a))sin| *) +(* <= INT|H(u)-H(u-pi/a)| = INT|H(u-pi/a)-H(u)| < eps, whence |INT| < eps. *) +(* ------------------------------------------------------------------------- *) + +let RIEMANN_LEBESGUE_RLINE = prove + (`!H. H absolutely_real_integrable_on (:real) + ==> ((\a. real_integral (:real) (\u. H u * sin(a * u))) ---> &0) + at_posinfinity`, + REPEAT STRIP_TAC THEN REWRITE_TAC[REALLIM_AT_POSINFINITY] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP REAL_TRANSLATION_CONTINUITY) THEN + REWRITE_TAC[REALLIM_ATREAL] THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `pi / d + &1` THEN X_GEN_TAC `a:real` THEN + REWRITE_TAC[real_ge] THEN + DISCH_TAC THEN + SUBGOAL_THEN `&0 < a` ASSUME_TAC THENL + [MP_TAC PI_POS THEN + SUBGOAL_THEN `&0 < pi / d` MP_TAC THENL + [MATCH_MP_TAC REAL_LT_DIV THEN ASM_REWRITE_TAC[PI_POS]; + ASM_REAL_ARITH_TAC]; ALL_TAC] THEN + SUBGOAL_THEN `pi / a < d` ASSUME_TAC THENL + [ASM_SIMP_TAC[REAL_LT_LDIV_EQ] THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `d * (pi / d + &1)` THEN + CONJ_TAC THENL + [ASM_SIMP_TAC[REAL_ADD_LDISTRIB; REAL_DIV_LMUL; REAL_LT_IMP_NZ] THEN + ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REAL_ARITH_TAC]; ALL_TAC] THEN + REWRITE_TAC[REAL_SUB_RZERO] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `--(pi / a)`) THEN + REWRITE_TAC[REAL_SUB_RZERO; REAL_ABS_NEG] THEN + SUBGOAL_THEN `&0 < pi / a` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LT_DIV THEN ASM_REWRITE_TAC[PI_POS]; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < p ==> abs p = p`] THEN DISCH_TAC THEN + MP_TAC(SPECL [`H:real->real`; `a:real`] FOURIER_SIN_DOUBLE) THEN + ASM_SIMP_TAC[REAL_LT_IMP_NZ] THEN DISCH_TAC THEN + MP_TAC(SPECL [`H:real->real`; `a:real`] FOURIER_SIN_DIFF_BOUND) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + SUBGOAL_THEN + `real_integral (:real) (\u. abs(H u - H(u - pi / a))) = + real_integral (:real) (\u. abs(H (u + --(pi / a)) - H u))` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_EQ THEN X_GEN_TAC `u:real` THEN DISCH_TAC THEN + REWRITE_TAC[REAL_ARITH `u + --(pi / a) = u - pi / a`] THEN + REAL_ARITH_TAC; ALL_TAC] THEN + ASM_REAL_ARITH_TAC);; + + +(* ========================================================================= *) +(* SECTION 4. Pointwise Fourier inversion (Fremlin 283H -> 283I -> 283J). *) +(* 283H: (1/sqrt(2pi)) INT_{-a}^a e^{ixy} fhat(y) dy *) +(* = (1/pi) INT_R (sin a u / u) f(x-u) du (Fubini + 283D value) *) +(* 283I: if f is integrable over R and differentiable at x, the limit of *) +(* the above as a -> inf is f(x) (Riemann-Lebesgue + 283Da). *) +(* 283J: if in addition fhat is integrable, f = (fhat) check. *) +(* Uses the Riemann-Lebesgue lemma and the Dirichlet-integral facts (283I). *) +(* *) +(* 283H is a 2D Fubini over the strip [-a,a] x R; the inner integral is the *) +(* oscillatory CEXP_INTERVAL_INTEGRAL. Bookkeeping is at *) +(* real^(1,1)finite_sum *) +(* via pastecart (fstcart = frequency y in [-a,a], sndcart = space t). *) +(* ========================================================================= *) + +(* The frequency strip [-a,a] x R is lebesgue-measurable in R^2. *) +let STRIP_MEASURABLE = prove + (`!a. lebesgue_measurable + {z:real^(1,1)finite_sum | drop(fstcart z) IN real_interval[--a,a]}`, + GEN_TAC THEN + SUBGOAL_THEN + `{z:real^(1,1)finite_sum | drop(fstcart z) IN real_interval[--a,a]} = + (interval[lift(--a), lift a]) PCROSS (:real^1)` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; FORALL_PASTECART; IN_ELIM_THM; PASTECART_IN_PCROSS; + FSTCART_PASTECART; IN_UNIV; IN_INTERVAL_1; + IN_REAL_INTERVAL; LIFT_DROP]; + REWRITE_TAC[LEBESGUE_MEASURABLE_PCROSS; LEBESGUE_MEASURABLE_INTERVAL; + LEBESGUE_MEASURABLE_UNIV]]);; + +(* The two exponential factors of the 283H integrand are continuous on R^2. *) +let CEXP_FST_CONTINUOUS = prove + (`!x. (\z:real^(1,1)finite_sum. cexp(ii * Cx x * Cx(drop(fstcart z)))) + continuous_on (:real^(1,1)finite_sum)`, + GEN_TAC THEN SUBGOAL_THEN + `(\z:real^(1,1)finite_sum. cexp(ii * Cx x * Cx(drop(fstcart z)))) = + cexp o (\z. (ii * Cx x) * Cx(drop(fstcart z)))` + SUBST1_TAC THENL [REWRITE_TAC[o_DEF; COMPLEX_MUL_ASSOC]; ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN REWRITE_TAC[CONTINUOUS_ON_CEXP] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN + REWRITE_TAC[CONTINUOUS_ON_CONST] THEN + MATCH_MP_TAC CONTINUOUS_ON_CX_DROP THEN + MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN + REWRITE_TAC[LINEAR_FSTCART]);; + +let CEXP_FSTSND_CONTINUOUS = prove + (`(\z:real^(1,1)finite_sum. + cexp(--(ii * Cx(drop(fstcart z)) * Cx(drop(sndcart z))))) + continuous_on (:real^(1,1)finite_sum)`, + SUBGOAL_THEN + `(\z:real^(1,1)finite_sum. + cexp(--(ii * Cx(drop(fstcart z)) * Cx(drop(sndcart z))))) = + cexp o (\z. --(ii * Cx(drop(fstcart z)) * Cx(drop(sndcart z))))` + SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN REWRITE_TAC[CONTINUOUS_ON_CEXP] THEN + MATCH_MP_TAC CONTINUOUS_ON_NEG THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN + REWRITE_TAC[CONTINUOUS_ON_CONST] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN CONJ_TAC THEN + MATCH_MP_TAC CONTINUOUS_ON_CX_DROP THEN + MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN + REWRITE_TAC[LINEAR_FSTCART; LINEAR_SNDCART]);; + +(* The 283H strip integrand is measurable on R^2, given f measurable on R. *) +let STRIP_INTEGRAND_MEASURABLE = prove + (`!(f:real->complex) a x. + (\z. f(drop z)) measurable_on (:real^1) + ==> (\z:real^(1,1)finite_sum. + if drop(fstcart z) IN real_interval[--a,a] + then cexp(ii * Cx x * Cx(drop(fstcart z))) * + cexp(--(ii * Cx(drop(fstcart z)) * Cx(drop(sndcart z)))) * + f(drop(sndcart z)) + else vec 0) measurable_on (:real^(1,1)finite_sum)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_ON_CASES THEN + REWRITE_TAC[STRIP_MEASURABLE; MEASURABLE_ON_0] THEN + MATCH_MP_TAC MEASURABLE_ON_COMPLEX_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_IMP_MEASURABLE_ON THEN + REWRITE_TAC[CEXP_FST_CONTINUOUS]; + ALL_TAC] THEN + MATCH_MP_TAC MEASURABLE_ON_COMPLEX_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_IMP_MEASURABLE_ON THEN + REWRITE_TAC[CEXP_FSTSND_CONTINUOUS]; + MP_TAC(INST_TYPE [`:1`,`:M`; `:1`,`:N`] + (ISPEC `\z. (f:real->complex)(drop z)` + MEASURABLE_ON_COMPOSE_SNDCART)) THEN + ASM_REWRITE_TAC[o_DEF; ETA_AX]]);; + +(* The strip integrand has modulus |f(t)| (both exponential factors have *) +(* modulus 1). *) +let STRIP_INTEGRAND_NORM = prove + (`!x y t (f:real->complex). + norm(cexp(ii * Cx x * Cx y) * cexp(--(ii * Cx y * Cx t)) * f t) = + norm(f t)`, + REPEAT GEN_TAC THEN REWRITE_TAC[COMPLEX_NORM_MUL] THEN + SUBGOAL_THEN + `norm(cexp(ii * Cx x * Cx y)) = &1 /\ + norm(cexp(--(ii * Cx y * Cx t))) = &1` + (fun th -> REWRITE_TAC[th; REAL_MUL_LID]) THEN + CONJ_TAC THENL + [SUBGOAL_THEN `ii * Cx x * Cx y = ii * Cx(x * y)` SUBST1_TAC THENL + [REWRITE_TAC[CX_MUL] THEN SIMPLE_COMPLEX_ARITH_TAC; + REWRITE_TAC[NORM_CEXP_II]]; + REWRITE_TAC[FOURIER_KERNEL_NORM]]);; + +(* The modulation integrand y |-> e^{-i d y} f(y) is absolutely integrable *) +(* (bounded modulus-1 factor x an L^1 function). This is the nonzero + t-slice of *) +(* the 283H strip integrand at a fixed frequency d, up to a constant factor. *) +let FOURIER_MODULATION_ABSINT = prove + (`!(f:real->complex) d. + (\z. f(drop z)) absolutely_integrable_on (:real^1) + ==> (\y. cexp(--(ii * Cx d * Cx(drop y))) * f(drop y)) + absolutely_integrable_on (:real^1)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`( * ):complex->complex->complex`; + `\y:real^1. cexp(--(ii * Cx d * Cx(drop y)))`; + `\y:real^1. (f:real->complex)(drop y)`; `(:real^1)`] + ABSOLUTELY_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT) THEN + ASM_REWRITE_TAC[BILINEAR_COMPLEX_MUL] THEN DISCH_THEN MATCH_MP_TAC THEN + CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_IMP_MEASURABLE_ON THEN + SUBGOAL_THEN `(\y:real^1. cexp(--(ii * Cx d * Cx(drop y)))) = + cexp o (\y. --((ii * Cx d) * Cx(drop y)))` + SUBST1_TAC THENL [REWRITE_TAC[o_DEF; COMPLEX_MUL_ASSOC]; ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN + REWRITE_TAC[CONTINUOUS_ON_CEXP] THEN + MATCH_MP_TAC CONTINUOUS_ON_NEG THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN + REWRITE_TAC[CONTINUOUS_ON_CONST] THEN + MATCH_MP_TAC CONTINUOUS_ON_CX_DROP THEN + REWRITE_TAC[CONTINUOUS_ON_ID]; + REWRITE_TAC[bounded; FORALL_IN_IMAGE] THEN EXISTS_TAC `&1` THEN + X_GEN_TAC `y:real^1` THEN + SUBGOAL_THEN `--(ii * Cx d * Cx(drop y)) = ii * Cx(--(d * drop y))` + SUBST1_TAC THENL + [REWRITE_TAC[CX_NEG; CX_MUL] THEN SIMPLE_COMPLEX_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[NORM_CEXP_II] THEN REAL_ARITH_TAC]);; + +(* Every t-slice of the 283H strip integrand (at a fixed frequency x0) is *) +(* absolutely integrable: the vec-0 slices trivially, the others = a *) +(* constant times a modulation integrand. *) +let STRIP_SLICE_ABSINT = prove + (`!(f:real->complex) a x x0. + (\z. f(drop z)) absolutely_integrable_on (:real^1) + ==> (\y. if drop(fstcart(pastecart (x0:real^1) y)) IN real_interval[--a,a] + then cexp(ii * Cx x * Cx(drop(fstcart(pastecart x0 y)))) * + cexp(--(ii * Cx(drop(fstcart(pastecart x0 y))) * + Cx(drop(sndcart(pastecart x0 y))))) * + f(drop(sndcart(pastecart x0 y))) + else vec 0) absolutely_integrable_on (:real^1)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN + ASM_CASES_TAC `drop(x0:real^1) IN real_interval[--a,a]` THEN + ASM_REWRITE_TAC[ABSOLUTELY_INTEGRABLE_0] THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_COMPLEX_LMUL THEN + ASM_SIMP_TAC[FOURIER_MODULATION_ABSINT]);; + +(* The inner (t-)integral of |G| is a step function of the frequency x0: *) +(* INT_t |G(pastecart x0 y)| = if drop x0 IN [-a,a] then INT_R |f| else 0. *) +let STRIP_INNER_NORM_INTEGRAL = prove + (`!(f:real->complex) a x x0. + integral (:real^1) (\y. lift(norm( + if drop(fstcart(pastecart (x0:real^1) y)) IN real_interval[--a,a] + then cexp(ii * Cx x * Cx(drop(fstcart(pastecart x0 y)))) * + cexp(--(ii * Cx(drop(fstcart(pastecart x0 y))) * + Cx(drop(sndcart(pastecart x0 y))))) * + f(drop(sndcart(pastecart x0 y))) + else vec 0))) = + (if drop x0 IN real_interval[--a,a] + then integral (:real^1) (\y. lift(norm(f(drop y)))) else vec 0)`, + REPEAT GEN_TAC THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[NORM_0; LIFT_NUM; INTEGRAL_0] THEN + REWRITE_TAC[STRIP_INTEGRAND_NORM]);; + +(* A constant restricted to the frequency strip is integrable over R. *) +let STRIP_STEP_INTEGRABLE = prove + (`!a (C:real^1). + (\x0:real^1. if drop x0 IN real_interval[--a,a] then C else vec 0) + integrable_on (:real^1)`, + REPEAT GEN_TAC THEN + ONCE_REWRITE_TAC[MESON[IN_INTERVAL_1; IN_REAL_INTERVAL; LIFT_DROP] + `(if drop x0 IN real_interval[--a,a] then (C:real^1) else vec 0) = + (if x0 IN interval[lift(--a), lift a] then C else vec 0)`] THEN + REWRITE_TAC[INTEGRABLE_RESTRICT_UNIV; INTEGRABLE_CONST]);; + +(* The 283H strip integrand G is absolutely integrable over R^2, via FUBINI_ *) +(* TONELLI: it is measurable, all t-slices are absolutely integrable (so the *) +(* bad- slice set is empty), and the iterated norm-integral is the step *) +(* function 1_[-a,a](x0) INT_R |f|, which is integrable. *) +let STRIP_INTEGRAND_ABSINT = prove + (`!(f:real->complex) a w. + (\z. f(drop z)) absolutely_integrable_on (:real^1) + ==> (\z:real^(1,1)finite_sum. + if drop(fstcart z) IN real_interval[--a,a] + then cexp(ii * Cx w * Cx(drop(fstcart z))) * + cexp(--(ii * Cx(drop(fstcart z)) * Cx(drop(sndcart z)))) * + f(drop(sndcart z)) + else vec 0) absolutely_integrable_on (:real^(1,1)finite_sum)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC + `\z:real^(1,1)finite_sum. + if drop(fstcart z) IN real_interval[--a,a] + then cexp(ii * Cx w * Cx(drop(fstcart z))) * + cexp(--(ii * Cx(drop(fstcart z)) * Cx(drop(sndcart z)))) * + f(drop(sndcart z)) + else vec 0` (INST_TYPE [`:1`,`:M`; `:1`,`:N`] FUBINI_TONELLI)) THEN + ANTS_TAC THENL + [MATCH_MP_TAC STRIP_INTEGRAND_MEASURABLE THEN + ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE; + INTEGRABLE_IMP_MEASURABLE]; ALL_TAC] THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN CONJ_TAC THENL + [SUBGOAL_THEN + `{x | ~((\y. (if drop(fstcart(pastecart (x:real^1) y)) IN + real_interval[--a,a] + then cexp(ii * Cx w * Cx(drop(fstcart(pastecart x y)))) * + cexp(--(ii * Cx(drop(fstcart(pastecart x y))) * + Cx(drop(sndcart(pastecart x y))))) * + f(drop(sndcart(pastecart x y))) + else vec 0)) absolutely_integrable_on (:real^1))} = {}` + (fun th -> REWRITE_TAC[th; NEGLIGIBLE_EMPTY]) THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN + ASM_SIMP_TAC[STRIP_SLICE_ABSINT]; + ASM_REWRITE_TAC[STRIP_INNER_NORM_INTEGRAL; STRIP_STEP_INTEGRABLE]]);; + +(* Fubini's theorem for the strip integrand: swap the order of the frequency + (x) *) +(* and space (y=t) integrations. This is the heart of 283H. *) +let STRIP_FUBINI_SWAP = prove + (`!(f:real->complex) a w. + (\z. f(drop z)) absolutely_integrable_on (:real^1) + ==> integral (:real^1) + (\x. integral (:real^1) (\y. + if drop(fstcart(pastecart (x:real^1) y)) IN real_interval[--a,a] + then cexp(ii * Cx w * Cx(drop(fstcart(pastecart x y)))) * + cexp(--(ii * Cx(drop(fstcart(pastecart x y))) * + Cx(drop(sndcart(pastecart x y))))) * + f(drop(sndcart(pastecart x y))) + else vec 0)) = + integral (:real^1) + (\y. integral (:real^1) (\x. + if drop(fstcart(pastecart (x:real^1) y)) IN real_interval[--a,a] + then cexp(ii * Cx w * Cx(drop(fstcart(pastecart x y)))) * + cexp(--(ii * Cx(drop(fstcart(pastecart x y))) * + Cx(drop(sndcart(pastecart x y))))) * + f(drop(sndcart(pastecart x y))) + else vec 0))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC + `\z:real^(1,1)finite_sum. + if drop(fstcart z) IN real_interval[--a,a] + then cexp(ii * Cx w * Cx(drop(fstcart z))) * + cexp(--(ii * Cx(drop(fstcart z)) * Cx(drop(sndcart z)))) * + f(drop(sndcart z)) + else vec 0` + (INST_TYPE [`:1`,`:M`; `:1`,`:N`] FUBINI_INTEGRAL_SWAP)) THEN + ASM_SIMP_TAC[STRIP_INTEGRAND_ABSINT]);; + +(* ------------------------------------------------------------------------- *) +(* Evaluating the two iterated integrals. *) +(* ------------------------------------------------------------------------- *) + +(* LHS inner (t-)integral reproduces the (unnormalized) Fourier transform. *) +let LHS_INNER = prove + (`!(f:real->complex) x0. + integral (:real^1) + (\y. cexp(--(ii * Cx(drop x0) * Cx(drop y))) * f(drop y)) = + Cx(sqrt(&2 * pi)) * fourier f (drop x0)`, + REPEAT GEN_TAC THEN REWRITE_TAC[fourier] THEN + REWRITE_TAC[COMPLEX_MUL_ASSOC] THEN + SUBGOAL_THEN `Cx(sqrt(&2 * pi)) * Cx(&1) / Cx(sqrt(&2 * pi)) = Cx(&1)` + SUBST1_TAC THENL + [MATCH_MP_TAC(COMPLEX_FIELD `~(z = Cx(&0)) ==> z * Cx(&1)/z = Cx(&1)`) THEN + REWRITE_TAC[CX_INJ] THEN MATCH_MP_TAC REAL_LT_IMP_NZ THEN + MATCH_MP_TAC SQRT_POS_LT THEN MP_TAC PI_POS THEN REAL_ARITH_TAC; + REWRITE_TAC[COMPLEX_MUL_LID]]);; + +(* Combine the two exponentials of the RHS inner integrand. *) +let CEXP_COMBINE = prove + (`!w t x. cexp(ii * Cx w * Cx x) * cexp(--(ii * Cx x * Cx t)) = + cexp(ii * Cx(w - t) * Cx x)`, + REPEAT GEN_TAC THEN REWRITE_TAC[GSYM CEXP_ADD] THEN AP_TERM_TAC THEN + REWRITE_TAC[CX_SUB] THEN SIMPLE_COMPLEX_ARITH_TAC);; + +(* The frequency-restricted single exponential is integrable and integrates *) +(* to the Dirichlet-kernel value (CEXP_INTERVAL_INTEGRAL over the strip *) +(* [-a,a]). *) +let CEXP_RESTRICT_INTEGRABLE = prove + (`!a b. (\x:real^1. if drop x IN real_interval[--a,a] + then cexp(ii * Cx b * Cx(drop x)) else vec 0) + integrable_on (:real^1)`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN + `(\x:real^1. if drop x IN real_interval[--a,a] + then cexp(ii * Cx b * Cx(drop x)) else vec 0) = + (\x. if x IN interval[lift(--a), lift a] + then cexp(ii * Cx b * Cx(drop x)) else vec 0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + REWRITE_TAC[IN_INTERVAL_1; IN_REAL_INTERVAL; LIFT_DROP]; ALL_TAC] THEN + REWRITE_TAC[INTEGRABLE_RESTRICT_UNIV] THEN + MATCH_MP_TAC INTEGRABLE_CONTINUOUS THEN + SUBGOAL_THEN `(\x:real^1. cexp(ii * Cx b * Cx(drop x))) = + cexp o (\x. (ii * Cx b) * Cx(drop x))` + SUBST1_TAC THENL [REWRITE_TAC[o_DEF; COMPLEX_MUL_ASSOC]; ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN REWRITE_TAC[CONTINUOUS_ON_CEXP] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN + REWRITE_TAC[CONTINUOUS_ON_CONST] THEN + MATCH_MP_TAC CONTINUOUS_ON_CX_DROP THEN REWRITE_TAC[CONTINUOUS_ON_ID]);; + +let CEXP_RESTRICT_INTEGRAL = prove + (`!a b. &0 <= a /\ ~(b = &0) + ==> integral (:real^1) (\x. if drop x IN real_interval[--a,a] + then cexp(ii * Cx b * Cx(drop x)) else vec 0) = + Cx(&2 * sin(a * b) / b)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\x:real^1. if drop x IN real_interval[--a,a] + then cexp(ii * Cx b * Cx(drop x)) else vec 0) = + (\x. if x IN interval[lift(--a), lift a] + then cexp(ii * Cx b * Cx(drop x)) else vec 0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + REWRITE_TAC[IN_INTERVAL_1; IN_REAL_INTERVAL; LIFT_DROP]; ALL_TAC] THEN + REWRITE_TAC[INTEGRAL_RESTRICT_UNIV] THEN + ASM_SIMP_TAC[CEXP_INTERVAL_INTEGRAL]);; + +(* RHS inner (frequency-)integral = f(t) * 2 sin((w-t)a)/(w-t) (w =/= t). *) +let RHS_INNER = prove + (`!(f:real->complex) a w t y. &0 <= a /\ ~(w - t = &0) + ==> integral (:real^1) + (\x. if drop(fstcart(pastecart (x:real^1) (y:real^1))) IN + real_interval[--a,a] + then cexp(ii * Cx w * Cx(drop(fstcart(pastecart x y)))) * + cexp(--(ii * Cx(drop(fstcart(pastecart x y))) * Cx t)) * f t + else vec 0) = + Cx(&2 * sin((w - t) * a) / (w - t)) * f t`, + REPEAT STRIP_TAC THEN REWRITE_TAC[FSTCART_PASTECART] THEN + ONCE_REWRITE_TAC[COMPLEX_MUL_ASSOC] THEN REWRITE_TAC[CEXP_COMBINE] THEN + SUBGOAL_THEN + `!x. (if drop x IN real_interval[--a,a] + then cexp(ii * Cx(w - t) * Cx(drop x)) * f t else vec 0) = + (if drop x IN real_interval[--a,a] + then cexp(ii * Cx(w - t) * Cx(drop x)) else vec 0) * + (f:real->complex) t` + (fun th -> REWRITE_TAC[th]) THENL + [GEN_TAC THEN COND_CASES_TAC THEN + REWRITE_TAC[COMPLEX_VEC_0; COMPLEX_MUL_LZERO]; ALL_TAC] THEN + ASM_SIMP_TAC[INTEGRAL_COMPLEX_RMUL; CEXP_RESTRICT_INTEGRABLE] THEN + ASM_SIMP_TAC[CEXP_RESTRICT_INTEGRAL] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[REAL_MUL_SYM]);; + +(* LHS outer integrand: after the inner t-integral, the frequency integrand + is *) +(* 1_[-a,a](x) * e^{iwx} sqrt(2pi) fhat(x). *) +let LHS_OUTER_INTEGRAND = prove + (`!(f:real->complex) a w x. + (\z. f(drop z)) absolutely_integrable_on (:real^1) + ==> integral (:real^1) + (\y. if drop(fstcart(pastecart (x:real^1) (y:real^1))) IN + real_interval[--a,a] + then cexp(ii * Cx w * Cx(drop(fstcart(pastecart x y)))) * + cexp(--(ii * Cx(drop(fstcart(pastecart x y))) * + Cx(drop(sndcart(pastecart x y))))) * + f(drop(sndcart(pastecart x y))) + else vec 0) = + (if drop x IN real_interval[--a,a] + then cexp(ii * Cx w * Cx(drop x)) * Cx(sqrt(&2 * pi)) * + fourier f (drop x) + else vec 0)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN + COND_CASES_TAC THEN REWRITE_TAC[INTEGRAL_0] THEN + MP_TAC(ISPECL [`\y:real^1. cexp(--(ii * Cx(drop(x:real^1)) * Cx(drop y))) * + (f:real->complex)(drop y)`; + `(:real^1)`; `cexp(ii * Cx w * Cx(drop(x:real^1)))`] + INTEGRAL_COMPLEX_LMUL) THEN + ANTS_TAC THENL + [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC FOURIER_MODULATION_ABSINT THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[LHS_INNER] THEN + DISCH_THEN(fun th -> REWRITE_TAC[GSYM COMPLEX_MUL_ASSOC; GSYM th]) THEN + REWRITE_TAC[COMPLEX_MUL_ASSOC]);; + +(* LHS of the Fubini swap, fully evaluated: the frequency integral over *) +(* [-a,a] of e^{iwy} sqrt(2pi) fhat(y). *) +let LHS_SIDE = prove + (`!(f:real->complex) a w. + (\z. f(drop z)) absolutely_integrable_on (:real^1) + ==> integral (:real^1) + (\x. integral (:real^1) (\y. + if drop(fstcart(pastecart (x:real^1) y)) IN real_interval[--a,a] + then cexp(ii * Cx w * Cx(drop(fstcart(pastecart x y)))) * + cexp(--(ii * Cx(drop(fstcart(pastecart x y))) * + Cx(drop(sndcart(pastecart x y))))) * + f(drop(sndcart(pastecart x y))) + else vec 0)) = + integral (interval[lift(--a), lift a]) + (\y. cexp(ii * Cx w * Cx(drop y)) * Cx(sqrt(&2 * pi)) * + fourier f (drop y))`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[LHS_OUTER_INTEGRAND] THEN + SUBGOAL_THEN + `(\x. if drop x IN real_interval[--a,a] + then cexp(ii * Cx w * Cx(drop x)) * Cx(sqrt(&2 * pi)) * + fourier f (drop x) + else vec 0) = + (\x:real^1. if x IN interval[lift(--a),lift a] + then cexp(ii * Cx w * Cx(drop x)) * Cx(sqrt(&2 * pi)) * + fourier f (drop x) + else vec 0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + REWRITE_TAC[IN_INTERVAL_1; IN_REAL_INTERVAL; LIFT_DROP]; ALL_TAC] THEN + REWRITE_TAC[INTEGRAL_RESTRICT_UNIV]);; + +(* RHS of the Fubini swap, fully evaluated (via a spike at the single point *) +(* t=w): the space integral of 2 sin((w-t)a)/(w-t) f(t). *) +let RHS_SIDE = prove + (`!(f:real->complex) a w. + &0 <= a + ==> integral (:real^1) + (\y. integral (:real^1) (\x. + if drop(fstcart(pastecart (x:real^1) y)) IN real_interval[--a,a] + then cexp(ii * Cx w * Cx(drop(fstcart(pastecart x y)))) * + cexp(--(ii * Cx(drop(fstcart(pastecart x y))) * + Cx(drop(sndcart(pastecart x y))))) * + f(drop(sndcart(pastecart x y))) + else vec 0)) = + integral (:real^1) + (\y. Cx(&2 * sin((w - drop y) * a) / (w - drop y)) * f(drop y))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_SPIKE THEN + EXISTS_TAC `{lift w}` THEN REWRITE_TAC[NEGLIGIBLE_SING] THEN + X_GEN_TAC `y:real^1` THEN REWRITE_TAC[IN_DIFF; IN_UNIV; IN_SING] THEN + DISCH_TAC THEN + REWRITE_TAC[SNDCART_PASTECART] THEN CONV_TAC SYM_CONV THEN + MP_TAC(ISPECL [`f:real->complex`; `a:real`; `w:real`; `drop(y:real^1)`; + `y:real^1`] RHS_INNER) THEN + REWRITE_TAC[SNDCART_PASTECART] THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[REAL_SUB_0] THEN + DISCH_TAC THEN UNDISCH_TAC `~(y = lift w)` THEN REWRITE_TAC[] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM LIFT_DROP] THEN ASM_REWRITE_TAC[]; + DISCH_THEN ACCEPT_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* 283H (Fremlin), clean intermediate form. For a >= 0 and f in L^1(R): *) +(* sqrt(2pi) INT_{-a}^a e^{iwy} fhat(y) dy = + INT_R (2 sin((w-t)a)/(w-t)) f(t) dt.*) +(* Chains the two evaluated sides through the Fubini swap. (The Fremlin + form *) +(* (1/sqrt2pi)INT e^{iwy}fhat = (1/pi)INT sin.../(w-t) f follows by dividing + by *) +(* 2 sqrt(2pi); the sin((w-t)a)/(w-t) kernel is exactly the sinc kernel that *) +(* 283I feeds to Riemann-Lebesgue + 283Da.) *) +let FOURIER_283H_RAW = prove + (`!(f:real->complex) a w. + &0 <= a /\ (\z. f(drop z)) absolutely_integrable_on (:real^1) + ==> integral (interval[lift(--a), lift a]) + (\y. cexp(ii * Cx w * Cx(drop y)) * Cx(sqrt(&2 * pi)) * + fourier f (drop y)) = + integral (:real^1) + (\y. Cx(&2 * sin((w - drop y) * a) / (w - drop y)) * f(drop y))`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`f:real->complex`; `a:real`; `w:real`] LHS_SIDE) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + MP_TAC(SPECL [`f:real->complex`; `a:real`; `w:real`] RHS_SIDE) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC STRIP_FUBINI_SWAP THEN ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* The complex-valued Riemann-Lebesgue lemma on R (for 283I): the real RL *) +(* applied to the real and imaginary parts. INT_R Cx(sin(a u)) H(u) --> + vec 0.*) +(* ------------------------------------------------------------------------- *) + +(* Cx(sin(a * drop u)) is continuous on R^1 (needed for measurability). *) +let CX_SIN_STRETCH_CONTINUOUS = prove + (`!a. (\u:real^1. Cx(sin(a * drop u))) continuous_on (:real^1)`, + GEN_TAC THEN REWRITE_TAC[CONTINUOUS_ON_CX_LIFT] THEN + SUBGOAL_THEN `(\u:real^1. lift(sin(a * drop u))) = + lift o (\t. sin(a * t)) o drop` + SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN + GEN_REWRITE_TAC (RAND_CONV) [GSYM IMAGE_LIFT_UNIV] THEN + REWRITE_TAC[GSYM REAL_CONTINUOUS_ON] THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_WITHINREAL THEN + MATCH_MP_TAC REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL THEN + REAL_DIFFERENTIABLE_TAC);; + +(* Cx(sin(a u)) H(u) is integrable (bounded x L^1). *) +let CX_SIN_H_INTEGRABLE = prove + (`!(H:real->complex) a. (\z. H(drop z)) absolutely_integrable_on (:real^1) + ==> (\u. Cx(sin(a * drop u)) * H(drop u)) integrable_on (:real^1)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MP_TAC(ISPECL [`( * ):complex->complex->complex`; + `\u:real^1. Cx(sin(a * drop u))`; + `\u:real^1. (H:real->complex)(drop u)`; `(:real^1)`] + ABSOLUTELY_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT) THEN + ASM_REWRITE_TAC[BILINEAR_COMPLEX_MUL] THEN DISCH_THEN MATCH_MP_TAC THEN + CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_IMP_MEASURABLE_ON THEN + REWRITE_TAC[CX_SIN_STRETCH_CONTINUOUS]; + REWRITE_TAC[bounded; FORALL_IN_IMAGE] THEN EXISTS_TAC `&1` THEN + REWRITE_TAC[COMPLEX_NORM_CX] THEN GEN_TAC THEN + MP_TAC(SPEC `a * drop(x:real^1)` SIN_BOUND) THEN REAL_ARITH_TAC]);; + +(* The real and imaginary parts of an L^1 complex function are real-L^1. *) +(* GEN_REWRITE_RULE I [ABSOLUTELY_INTEGRABLE_COMPONENTWISE] applies the iff + at *) +(* precisely the TOP LEVEL of the chosen hypothesis, turning the complex L^1 *) +(* fact into its two lifted components. (A plain REWRITE_RULE would loop -- + the *) +(* iff's RHS re-matches its LHS pattern; and ONCE_REWRITE_RULE, which + descends, *) +(* would silently no-op if FIRST_X_ASSUM grabbed a non-matching hypothesis. + The *) +(* top-level `I` conversion instead fails there, so FIRST_X_ASSUM + backtracks.) *) +let RE_H_ABSINT = prove + (`!(H:real->complex). (\z. H(drop z)) absolutely_integrable_on (:real^1) + ==> (\u. Re(H u)) absolutely_real_integrable_on (:real)`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o + GEN_REWRITE_RULE I [ABSOLUTELY_INTEGRABLE_COMPONENTWISE]) THEN + REWRITE_TAC[DIMINDEX_2; FORALL_2] THEN STRIP_TAC THEN + REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_ON; IMAGE_LIFT_UNIV; o_DEF; + RE_DEF] THEN + ASM_REWRITE_TAC[]);; + +let IM_H_ABSINT = prove + (`!(H:real->complex). (\z. H(drop z)) absolutely_integrable_on (:real^1) + ==> (\u. Im(H u)) absolutely_real_integrable_on (:real)`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o + GEN_REWRITE_RULE I [ABSOLUTELY_INTEGRABLE_COMPONENTWISE]) THEN + REWRITE_TAC[DIMINDEX_2; FORALL_2] THEN STRIP_TAC THEN + REWRITE_TAC[ABSOLUTELY_REAL_INTEGRABLE_ON; IMAGE_LIFT_UNIV; o_DEF; + IM_DEF] THEN + ASM_REWRITE_TAC[]);; + +(* The two real components of INT_R Cx(sin(a u)) H(u) du are the real *) +(* integrals of Re(H) sin and Im(H) sin -- the bridge from the complex *) +(* integral to the real RL (INTEGRAL_COMPONENT + REAL_INTEGRAL + *) +(* RE_MUL_CX/IM_MUL_CX). *) +let RE_COMPONENT_BRIDGE = prove + (`!(H:real->complex) a. (\z. H(drop z)) absolutely_integrable_on (:real^1) + ==> (integral (:real^1) (\u. Cx(sin(a * drop u)) * H(drop u)))$1 = + real_integral (:real) (\u. Re(H u) * sin(a * u))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\u. Re((H:real->complex) u) * sin(a * u)) real_integrable_on (:real)` + ASSUME_TAC THENL + [MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC FOURIER_SIN_ABSINT THEN ASM_SIMP_TAC[RE_H_ABSINT]; + ALL_TAC] THEN + MP_TAC(INST [`(:real^1)`,`s:real^1->bool`; `1`,`k:num`] + (ISPEC `\u. Cx(sin(a * drop u)) * (H:real->complex)(drop u)` + INTEGRAL_COMPONENT)) THEN + ASM_SIMP_TAC[CX_SIN_H_INTEGRABLE] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[GSYM RE_DEF; RE_MUL_CX] THEN + ASM_SIMP_TAC[REAL_INTEGRAL] THEN + REWRITE_TAC[IMAGE_LIFT_UNIV; o_DEF; LIFT_DROP] THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + AP_TERM_TAC THEN REWRITE_TAC[REAL_MUL_SYM]);; + +let IM_COMPONENT_BRIDGE = prove + (`!(H:real->complex) a. (\z. H(drop z)) absolutely_integrable_on (:real^1) + ==> (integral (:real^1) (\u. Cx(sin(a * drop u)) * H(drop u)))$2 = + real_integral (:real) (\u. Im(H u) * sin(a * u))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\u. Im((H:real->complex) u) * sin(a * u)) real_integrable_on (:real)` + ASSUME_TAC THENL + [MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC FOURIER_SIN_ABSINT THEN + ASM_SIMP_TAC[IM_H_ABSINT]; ALL_TAC] THEN + MP_TAC(INST [`(:real^1)`,`s:real^1->bool`; `2`,`k:num`] + (ISPEC `\u. Cx(sin(a * drop u)) * (H:real->complex)(drop u)` + INTEGRAL_COMPONENT)) THEN + ASM_SIMP_TAC[CX_SIN_H_INTEGRABLE] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[GSYM IM_DEF; IM_MUL_CX] THEN + ASM_SIMP_TAC[REAL_INTEGRAL] THEN + REWRITE_TAC[IMAGE_LIFT_UNIV; o_DEF; LIFT_DROP] THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + AP_TERM_TAC THEN REWRITE_TAC[REAL_MUL_SYM]);; + +(* The complex-valued Riemann-Lebesgue lemma on R: INT_R Cx(sin(a u)) H(u) *) +(* du *) +(* --> vec 0 at +inf, for complex H in L^1(R). Componentwise from the real *) +(* RL. *) +let RIEMANN_LEBESGUE_RLINE_COMPLEX = prove + (`!(H:real->complex). + (\z. H(drop z)) absolutely_integrable_on (:real^1) + ==> ((\a. integral (:real^1) (\u. Cx(sin(a * drop u)) * H(drop u))) --> + vec 0) + at_posinfinity`, + REPEAT STRIP_TAC THEN REWRITE_TAC[LIM_COMPONENTWISE_REAL] THEN + REWRITE_TAC[DIMINDEX_2; FORALL_2; GSYM tendsto_real_def; VEC_COMPONENT] THEN + CONJ_TAC THENL + [ASM_SIMP_TAC[RE_COMPONENT_BRIDGE] THEN + MATCH_MP_TAC RIEMANN_LEBESGUE_RLINE THEN ASM_SIMP_TAC[RE_H_ABSINT]; + ASM_SIMP_TAC[IM_COMPONENT_BRIDGE] THEN + MATCH_MP_TAC RIEMANN_LEBESGUE_RLINE THEN ASM_SIMP_TAC[IM_H_ABSINT]]);; + +(* ------------------------------------------------------------------------- *) +(* 283I ingredients. The truncation g(u) = f(x) for |u|<=1, 0 otherwise *) +(* contributes INT_{-1}^1 sin(a u)/u du * f(x); the sinc factor's limit is *) +(* pi (from 283Da via the x = a t substitution SIN_OVER_X_SUBST). *) +(* (Uses SIN_OVER_X_SUBST / SIN_OVER_X_LIMIT_POSINF, proved above.) *) +(* ------------------------------------------------------------------------- *) + +let GPART_LIMIT = prove + (`((\a. real_integral (real_interval[--(&1),&1]) (\u. sin(a * u) / u)) ---> + pi) + at_posinfinity`, + MATCH_MP_TAC REALLIM_TRANSFORM_EVENTUALLY THEN + EXISTS_TAC `\a. real_integral (real_interval[--a,a]) (\x. sin x / x)` THEN + REWRITE_TAC[SIN_OVER_X_LIMIT_POSINF] THEN + REWRITE_TAC[EVENTUALLY_AT_POSINFINITY] THEN EXISTS_TAC `&1` THEN + X_GEN_TAC `a:real` THEN REWRITE_TAC[real_ge] THEN DISCH_TAC THEN + MP_TAC(SPECL [`a:real`; `&1`] SIN_OVER_X_SUBST) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_MUL_RID] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REFL_TAC);; + +(* u |-> f(x - u) is L^1 when f is (reflection m=-1 + translation c = lift *) +(* x, via *) +(* ABSOLUTELY_INTEGRABLE_AFFINITY). Used for the L^1 tail of the 283I *) +(* integrand. *) +let F_REFLECT_TRANSLATE_ABSINT = prove + (`!(f:real->complex) x. (\z. f(drop z)) absolutely_integrable_on (:real^1) + ==> (\z. f(x - drop z)) absolutely_integrable_on (:real^1)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\z:real^1. (f:real->complex)(drop z)`; `(:real^1)`; `--(&1)`; + `lift x`] + ABSOLUTELY_INTEGRABLE_AFFINITY) THEN + ASM_REWRITE_TAC[REAL_ARITH `~(--(&1) = &0)`] THEN + SUBGOAL_THEN + `IMAGE (\z:real^1. inv(--(&1)) % z + --(inv(--(&1)) % lift x)) (:real^1) = + (:real^1)` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_UNIV] THEN X_GEN_TAC `z:real^1` THEN + EXISTS_TAC `--z + lift x:real^1` THEN + REWRITE_TAC[REAL_INV_NEG; REAL_INV_1] THEN VECTOR_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[DROP_ADD; DROP_CMUL; LIFT_DROP] THEN REAL_ARITH_TAC);; + +(* Scalar quotient bound (the arithmetic heart of the 283I near-0 estimate): *) +(* if n <= K v and v > 0 then 2 (1/v) n <= 2 K. Applied with v = |u|, n = *) +(* norm(f(x-u)-f x) to bound the difference-quotient integrand near u = 0. *) +let SCALAR_QUOTIENT_BOUND = prove + (`!v n K:real. &0 < v /\ n <= K * v ==> &2 * inv v * n <= &2 * K`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&2 * K = &2 * inv v * (K * v)` SUBST1_TAC THENL + [SUBGOAL_THEN `~(v = &0)` MP_TAC THENL + [ASM_REAL_ARITH_TAC; CONV_TAC REAL_FIELD]; ALL_TAC] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_LE_INV_EQ]);; + +(* The singular factor Cx(2/u) is measurable on R^1: 2 inv(drop z) is real- *) +(* measurable (inv of the identity, zeros = {0} negligible), then compose *) +(* with *) +(* the continuous Cx(drop .). (Part of the 283I integrand's measurability.) *) +let CX_2INV_MEASURABLE = prove + (`(\z:real^1. Cx(&2 * inv(drop z))) measurable_on (:real^1)`, + SUBGOAL_THEN + `(\z:real^1. Cx(&2 * inv(drop z))) = (\w. Cx(drop w)) o (\z. lift(&2 * + inv(drop z)))` + SUBST1_TAC THENL [REWRITE_TAC[o_DEF; LIFT_DROP]; ALL_TAC] THEN + MATCH_MP_TAC MEASURABLE_ON_COMPOSE_CONTINUOUS THEN CONJ_TAC THENL + [SUBGOAL_THEN + `(\z:real^1. lift(&2 * inv(drop z))) = lift o (\u. &2 * inv u) o drop` + SUBST1_TAC THENL [REWRITE_TAC[o_DEF]; ALL_TAC] THEN + REWRITE_TAC[GSYM IMAGE_LIFT_UNIV; GSYM real_measurable_on] THEN + MATCH_MP_TAC REAL_MEASURABLE_ON_LMUL THEN + MP_TAC(ISPEC `\x:real. x` REAL_MEASURABLE_ON_INV) THEN + REWRITE_TAC[ETA_AX] THEN DISCH_THEN MATCH_MP_TAC THEN + REWRITE_TAC[SING_GSPEC; REAL_NEGLIGIBLE_SING] THEN + MATCH_MP_TAC CONTINUOUS_IMP_REAL_MEASURABLE_ON THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_ID]; + MATCH_MP_TAC CONTINUOUS_ON_CX_DROP THEN REWRITE_TAC[CONTINUOUS_ON_ID]]);; + +(* The truncation window {u : |u| <= 1} is (the lift of) a bounded interval, *) +(* hence lebesgue-measurable -- needed for measurability of the *) +(* g-truncation. *) +let TRUNC_WINDOW_MEASURABLE = prove + (`lebesgue_measurable {z:real^1 | abs(drop z) <= &1}`, + SUBGOAL_THEN + `{z:real^1 | abs(drop z) <= &1} = interval[lift(--(&1)), lift(&1)]` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INTERVAL_1; LIFT_DROP] THEN + GEN_TAC THEN REAL_ARITH_TAC; + REWRITE_TAC[LEBESGUE_MEASURABLE_INTERVAL]]);; + +(* The 283I integrand H(u) = 2/u (f(x-u) - g(u)) is measurable on R^1, where *) +(* g(u) = f(x) for |u| <= 1 and 0 otherwise. Product of the measurable *) +(* factors *) +(* Cx(2/u) and (f(x-u) - g(u)) (affine-of-f minus a two-case function). *) +let H283I_MEASURABLE = prove + (`!(f:real->complex) x. (\z. f(drop z)) absolutely_integrable_on (:real^1) + ==> (\z. Cx(&2 * inv(drop z)) * + (f(x - drop z) - (if abs(drop z) <= &1 then f x else vec 0))) + measurable_on (:real^1)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC MEASURABLE_ON_COMPLEX_MUL THEN + REWRITE_TAC[CX_2INV_MEASURABLE] THEN + MATCH_MP_TAC MEASURABLE_ON_SUB THEN CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_IMP_MEASURABLE THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + ASM_SIMP_TAC[F_REFLECT_TRANSLATE_ABSINT]; + MATCH_MP_TAC MEASURABLE_ON_CASES THEN + REWRITE_TAC[MEASURABLE_ON_CONST; MEASURABLE_ON_0; + TRUNC_WINDOW_MEASURABLE]]);; + +(* A constant on a symmetric window is integrable over R (extend by 0). *) +let CONST_WINDOW_INTEGRABLE = prove + (`!c r. (\z:real^1. lift(c * (if abs(drop z) <= r then &1 else &0))) + integrable_on (:real^1)`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN + `(\z:real^1. lift(c * (if abs(drop z) <= r then &1 else &0))) = + (\z. if z IN interval[lift(--r), lift r] then lift c else vec 0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP] THEN + COND_CASES_TAC THEN + ASM_REWRITE_TAC[REAL_MUL_RID; REAL_MUL_RZERO; LIFT_NUM] THEN + ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[INTEGRABLE_RESTRICT_UNIV; INTEGRABLE_CONST]);; + +(* The dominating function for the 283I integrand H is integrable: a sum of *) +(* a box (near 0), (2/d) |f(x-u)| (an L^1 translate/reflect of f), and a *) +(* box. *) +let DOMINATOR_INTEGRABLE = prove + (`!(f:real->complex) x K d. (\z. f(drop z)) absolutely_integrable_on (:real^1) + ==> (\z:real^1. lift(&2 * K * (if abs(drop z) <= d then &1 else &0)) + + lift(&2 / d * norm(f(x - drop z))) + + lift(&2 / d * norm(f x) * (if abs(drop z) <= &1 then &1 else + &0))) + integrable_on (:real^1)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRABLE_ADD THEN CONJ_TAC THENL + [ONCE_REWRITE_TAC[REAL_MUL_ASSOC] THEN + REWRITE_TAC[CONST_WINDOW_INTEGRABLE]; ALL_TAC] THEN + MATCH_MP_TAC INTEGRABLE_ADD THEN CONJ_TAC THENL + [REWRITE_TAC[LIFT_CMUL] THEN MATCH_MP_TAC INTEGRABLE_CMUL THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN + ASM_SIMP_TAC[F_REFLECT_TRANSLATE_ABSINT]; + ONCE_REWRITE_TAC[REAL_MUL_ASSOC] THEN + REWRITE_TAC[CONST_WINDOW_INTEGRABLE]]);; + +(* norm of the singular-factor product: |Cx(2/u) w| = 2 (1/|u|) |w|. *) +let NORM_CX_2INV_MUL = prove + (`!u (w:complex). norm(Cx(&2 * inv u) * w) = &2 * inv(abs u) * norm w`, + REPEAT GEN_TAC THEN REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX] THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NUM; REAL_ABS_INV] THEN + REWRITE_TAC[REAL_MUL_ASSOC]);; + +(* The three terms of the dominator are nonnegative (handles the u = 0 *) +(* case). *) +let NEAR_REGION_BOUND = prove + (`!(f:real->complex) x K d u. + &0 < d /\ d <= &1 /\ &0 <= K /\ ~(u = &0) /\ abs u <= d /\ + (!v. abs v <= d ==> norm(f(x - v) - f x) <= K * abs v) + ==> &2 * inv(abs u) * norm(f(x - u) - (if abs u <= &1 then f x else vec + 0)) + <= &2 * K * (if abs u <= d then &1 else &0) + + &2 / d * norm(f(x - u)) + + &2 / d * norm(f x) * (if abs u <= &1 then &1 else &0)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `abs u <= &1` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&2 * K` THEN CONJ_TAC THENL + [MP_TAC(ISPECL [`abs u`; `norm((f:real->complex)(x - u) - f x)`; `K:real`] + SCALAR_QUOTIENT_BOUND) THEN + ASM_SIMP_TAC[GSYM REAL_ABS_NZ] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_SIMP_TAC[]; + MATCH_MP_TAC(REAL_ARITH `&0 <= t2 /\ &0 <= t3 ==> &2 * K <= &2 * K + t2 + + t3`) THEN + CONJ_TAC THEN MATCH_MP_TAC REAL_LE_MUL THEN + ASM_SIMP_TAC[REAL_LE_DIV; REAL_LT_IMP_LE; REAL_POS; NORM_POS_LE]]);; + +(* Far region abs u > delta: norm H <= (2/abs u)(norm f(x-u) + norm g(u)) <= *) +(* (2/delta) norm f(x-u) + (2/delta) norm(f x) on the unit window (inv *) +(* monotone + triangle inequality). *) +let FAR_REGION_BOUND = prove + (`!(f:real->complex) x K d u. + &0 < d /\ ~(u = &0) /\ ~(abs u <= d) + ==> &2 * inv(abs u) * norm(f(x - u) - (if abs u <= &1 then f x else vec + 0)) + <= &2 * K * (if abs u <= d then &1 else &0) + + &2 / d * norm(f(x - u)) + + &2 / d * norm(f x) * (if abs u <= &1 then &1 else &0)`, + REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[REAL_MUL_RZERO; REAL_ADD_LID] THEN + ONCE_REWRITE_TAC[REAL_MUL_ASSOC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(&2 * inv(abs u)) * + (norm((f:real->complex)(x - u)) + norm(if abs u <= &1 then f x + else vec 0))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN + REWRITE_TAC[REAL_POS; REAL_LE_INV_EQ; REAL_ABS_POS]; + NORM_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN `&2 * inv(abs u) <= &2 / d` ASSUME_TAC THENL + [REWRITE_TAC[real_div] THEN MATCH_MP_TAC REAL_LE_LMUL THEN + REWRITE_TAC[REAL_POS] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&2 / d * (norm((f:real->complex)(x - u)) + norm(if abs u <= &1 + then f x else vec 0))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_RMUL THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_ADD THEN REWRITE_TAC[NORM_POS_LE]; + REWRITE_TAC[REAL_ADD_LDISTRIB] THEN MATCH_MP_TAC REAL_LE_ADD2 THEN + REWRITE_TAC[REAL_LE_REFL] THEN COND_CASES_TAC THEN + REWRITE_TAC[REAL_MUL_RID; NORM_0; REAL_MUL_RZERO; REAL_LE_REFL]]);; + +(* Combining the regions: the pointwise domination norm(H(u)) <= drop D(u). *) +let H283I_POINTWISE_BOUND = prove + (`!(f:real->complex) x K d u. + &0 < d /\ d <= &1 /\ &0 <= K /\ + (!v. abs v <= d ==> norm(f(x - v) - f x) <= K * abs v) + ==> norm(Cx(&2 * inv u) * (f(x - u) - (if abs u <= &1 then f x else vec + 0))) + <= &2 * K * (if abs u <= d then &1 else &0) + + &2 / d * norm(f(x - u)) + + &2 / d * norm(f x) * (if abs u <= &1 then &1 else &0)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[NORM_CX_2INV_MUL] THEN + ASM_CASES_TAC `u = &0` THENL + [ASM_REWRITE_TAC[REAL_ABS_NUM; REAL_INV_0; REAL_MUL_LZERO; + REAL_MUL_RZERO] THEN + REPEAT(MATCH_MP_TAC REAL_LE_ADD THEN CONJ_TAC) THEN + REPEAT(MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC) THEN + ASM_SIMP_TAC[REAL_POS; NORM_POS_LE; REAL_LE_DIV; REAL_LT_IMP_LE] THEN + COND_CASES_TAC THEN REWRITE_TAC[REAL_POS]; ALL_TAC] THEN + ASM_CASES_TAC `abs u <= d` THENL + [MP_TAC(ISPECL [`f:real->complex`; `x:real`; `K:real`; `d:real`; + `u:real`] NEAR_REGION_BOUND) THEN + ASM_SIMP_TAC[]; + MP_TAC(ISPECL [`f:real->complex`; `x:real`; `K:real`; `d:real`; + `u:real`] FAR_REGION_BOUND) THEN + ASM_SIMP_TAC[]]);; + +(* The 283I integrand H(u) = (2/u)(f(x-u) - g(u)) is absolutely integrable *) +(* on R *) +(* (measurable + dominated by the integrable D). This is the L^1-ness that *) +(* lets *) +(* Riemann-Lebesgue kill the "difference" part of the inversion integral. *) +let H283I_ABSINT = prove + (`!(f:real->complex) x K d. + &0 < d /\ d <= &1 /\ &0 <= K /\ + (!v. abs v <= d ==> norm(f(x - v) - f x) <= K * abs v) /\ + (\z. f(drop z)) absolutely_integrable_on (:real^1) + ==> (\z. Cx(&2 * inv(drop z)) * + (f(x - drop z) - (if abs(drop z) <= &1 then f x else vec 0))) + absolutely_integrable_on (:real^1)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE THEN + EXISTS_TAC + `\z:real^1. lift(&2 * K * (if abs(drop z) <= d then &1 else &0)) + + lift(&2 / d * norm((f:real->complex)(x - drop z))) + + lift(&2 / d * norm(f x) * (if abs(drop z) <= &1 then &1 else + &0))` THEN + REPEAT CONJ_TAC THENL + [ASM_SIMP_TAC[H283I_MEASURABLE]; + ASM_SIMP_TAC[DOMINATOR_INTEGRABLE]; + GEN_TAC THEN REWRITE_TAC[IN_UNIV] THEN + REWRITE_TAC[DROP_ADD; LIFT_DROP] THEN BETA_TAC THEN + MATCH_MP_TAC H283I_POINTWISE_BOUND THEN ASM_REWRITE_TAC[]]);; + +(* The Riemann-Lebesgue "difference" part of the 283I integral vanishes: *) +(* INT_R sin(a u)/u (f(x-u) - g(u)) du --> 0, since (f(x-u)-g(u))/u is L^1. *) +let RLPART_LIMIT = prove + (`!(f:real->complex) x K d. + &0 < d /\ d <= &1 /\ &0 <= K /\ + (!v. abs v <= d ==> norm(f(x - v) - f x) <= K * abs v) /\ + (\z. f(drop z)) absolutely_integrable_on (:real^1) + ==> ((\a. integral (:real^1) + (\u. Cx(sin(a * drop u)) * + (Cx(&2 * inv(drop u)) * + (f(x - drop u) - (if abs(drop u) <= &1 then f x else vec + 0))))) + --> vec 0) at_posinfinity`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `\u. Cx(&2 * inv u) * + ((f:real->complex)(x - u) - (if abs u <= &1 then f x else + vec 0))` + RIEMANN_LEBESGUE_RLINE_COMPLEX) THEN + REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + MP_TAC(ISPECL [`f:real->complex`; `x:real`; `K:real`; + `d:real`] H283I_ABSINT) THEN + ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Assembly bricks for 283I: change of variable t = x - u in the 283H RHS, *) +(* the pointwise integrand split, and a Cx / real_integral bridge. *) +(* ------------------------------------------------------------------------- *) + +(* Change of variable u |-> c - u on the whole real line: reflect + *) +(* translate. *) +let SUBST_REFLECT_INTEGRAL_UNIV = prove + (`!(H:real^1->real^N) c. + integral (:real^1) (\u. H(c - u)) = integral (:real^1) H`, + REPEAT GEN_TAC THEN + MP_TAC(ISPECL [`\x:real^1. (H:real^1->real^N)(c + x)`; `(:real^1)`] + INTEGRAL_REFLECT_GEN) THEN + REWRITE_TAC[REFLECT_UNIV] THEN BETA_TAC THEN + REWRITE_TAC[VECTOR_ARITH `(c:real^1) + --x = c - x`] THEN + DISCH_THEN SUBST1_TAC THEN + MP_TAC(ISPECL [`H:real^1->real^N`; `(:real^1)`; `c:real^1`] + INTEGRAL_TRANSLATION) THEN + REWRITE_TAC[TRANSLATION_UNIV] THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]));; + +(* The 283H RHS integral, after t = x - u: the sinc kernel becomes sin(a *) +(* u)/u. *) +let SUBSTITUTED_RHS = prove + (`!(f:real->complex) x a. + integral (:real^1) + (\y. Cx (&2 * sin ((x - drop y) * a) / (x - drop y)) * f (drop y)) = + integral (:real^1) + (\u. Cx (&2 * sin (a * drop u) / drop u) * f (x - drop u))`, + REPEAT GEN_TAC THEN + MP_TAC(ISPECL + [`\y. Cx (&2 * sin ((x - drop y) * a) / (x - drop y)) * + (f:real->complex) (drop y)`; + `lift x`] SUBST_REFLECT_INTEGRAL_UNIV) THEN + DISCH_THEN(fun th -> GEN_REWRITE_TAC LAND_CONV [GSYM th]) THEN + AP_TERM_TAC THEN ABS_TAC THEN BETA_TAC THEN + REWRITE_TAC[DROP_SUB; LIFT_DROP] THEN + REWRITE_TAC[REAL_ARITH `(x:real) - (x - u) = u`; REAL_MUL_SYM]);; + +(* Split the substituted integrand into the L^1 "difference" part (feeds *) +(* Riemann-Lebesgue) and the singular "g" part (feeds the Dirichlet limit). *) +let INTEGRAND_SPLIT_283I = prove + (`!(f:real->complex) x a u:real^1. + Cx (&2 * sin (a * drop u) / drop u) * f (x - drop u) = + Cx (sin (a * drop u)) * + (Cx (&2 * inv (drop u)) * + (f (x - drop u) - (if abs (drop u) <= &1 then f x else vec 0))) + + Cx (sin (a * drop u)) * + (Cx (&2 * inv (drop u)) * + (if abs (drop u) <= &1 then f x else vec 0))`, + REPEAT GEN_TAC THEN + REWRITE_TAC[COMPLEX_ADD_LDISTRIB; GSYM COMPLEX_ADD_ASSOC] THEN + REWRITE_TAC[GSYM COMPLEX_ADD_LDISTRIB] THEN + REWRITE_TAC[COMPLEX_SUB_ADD] THEN + REWRITE_TAC[CX_MUL; GSYM COMPLEX_MUL_ASSOC] THEN + REWRITE_TAC[real_div; CX_MUL; COMPLEX_MUL_AC]);; + +(* Integral of Cx of a real function = Cx of the real integral (a linear *) +(* map). *) +let CX_REAL_INTEGRAL_BRIDGE = prove + (`!(g:real->real) s. + g real_integrable_on s + ==> integral (IMAGE lift s) (\u. Cx(g(drop u))) = + Cx(real_integral s g)`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP REAL_INTEGRABLE_INTEGRAL) THEN + REWRITE_TAC[has_real_integral] THEN DISCH_TAC THEN + MP_TAC(ISPECL + [`lift o (g:real->real) o drop`; `lift(real_integral s (g:real->real))`; + `IMAGE lift s`; + `(\z. Cx(drop z)):real^1->complex`] HAS_INTEGRAL_LINEAR) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [REWRITE_TAC[linear; DROP_ADD; DROP_CMUL; CX_ADD; CX_MUL; COMPLEX_CMUL; + CX_MUL]; + REWRITE_TAC[o_DEF; LIFT_DROP] THEN + DISCH_THEN(SUBST1_TAC o MATCH_MP INTEGRAL_UNIQUE) THEN REFL_TAC]);; + +(* Cx of a real-integrable function is (vector) integrable on the lifted *) +(* set. *) +let INTEGRABLE_CX_DROP_COMPOSE = prove + (`!(g:real->real) s. + g real_integrable_on s + ==> (\u. Cx(g(drop u))) integrable_on (IMAGE lift s)`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o REWRITE_RULE[real_integrable_on]) THEN + REWRITE_TAC[has_real_integral] THEN + DISCH_THEN(X_CHOOSE_TAC `y:real`) THEN + MP_TAC(ISPECL + [`lift o (g:real->real) o drop`; `(\z. Cx(drop z)):real^1->complex`; + `IMAGE lift s`] INTEGRABLE_LINEAR) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [REWRITE_TAC[integrable_on] THEN EXISTS_TAC `lift(y:real)` THEN + ASM_REWRITE_TAC[]; + REWRITE_TAC[linear; DROP_ADD; DROP_CMUL; CX_ADD; CX_MUL; + COMPLEX_CMUL; CX_MUL]]; + REWRITE_TAC[o_DEF; LIFT_DROP]]);; + +(* Two small helpers for the g-part value. *) +let COMPLEX_MUL_COND_VEC0 = prove + (`!A B c P:bool. A * (B * (if P then c else vec 0)) = + (if P then A * (B * c) else vec 0)`, + REPEAT GEN_TAC THEN COND_CASES_TAC THEN + REWRITE_TAC[COMPLEX_VEC_0; COMPLEX_MUL_RZERO]);; + +let GPART_INTEGRAND_REWRITE = prove + (`!(fx:complex) a u:real^1. + Cx (sin (a * drop u)) * (Cx (&2 * inv (drop u)) * fx) = + fx * Cx(&2 * sin (a * drop u) / drop u)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[real_div; CX_MUL; GSYM COMPLEX_MUL_ASSOC] THEN + REWRITE_TAC[COMPLEX_MUL_AC]);; + +(* The singular "g" part of the 283I integral: it equals f x times the *) +(* Dirichlet integral over [-1,1] (scaled by 2), which tends to 2 pi f x. *) +let GPART_VALUE = prove + (`!(f:real->complex) x a. + &0 < a + ==> integral (:real^1) + (\u. Cx (sin (a * drop u)) * + (Cx (&2 * inv (drop u)) * + (if abs (drop u) <= &1 then f x else vec 0))) = + f x * + Cx(real_integral (real_interval[-- &1,&1]) (\u. &2 * sin(a * u) / + u))`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[COMPLEX_MUL_COND_VEC0] THEN + SUBGOAL_THEN + `!u:real^1. abs(drop u) <= &1 <=> u IN interval[lift(-- &1),lift(&1)]` + (fun th -> REWRITE_TAC[th]) THENL + [REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP] THEN GEN_TAC THEN REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[INTEGRAL_RESTRICT_UNIV; GPART_INTEGRAND_REWRITE] THEN + SUBGOAL_THEN + `(\u:real. &2 * sin(a * u) / u) real_integrable_on real_interval[-- &1,&1]` + ASSUME_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_LMUL THEN + ASM_SIMP_TAC[SIN_STRETCH_OVER_X_INTEGRABLE]; + ALL_TAC] THEN + MP_TAC(ISPECL [`\u:real. &2 * sin(a * u) / u`; `real_interval[-- &1,&1]`] + CX_REAL_INTEGRAL_BRIDGE) THEN + ASM_REWRITE_TAC[IMAGE_LIFT_REAL_INTERVAL] THEN BETA_TAC THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC INTEGRAL_COMPLEX_LMUL THEN + REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL] THEN + MATCH_MP_TAC INTEGRABLE_CX_DROP_COMPOSE THEN ASM_REWRITE_TAC[]);; + +(* Unconditional integrability of the stretched sinc sin(c u)/u on any *) +(* interval (the c > 0 case is SIN_STRETCH_OVER_X_INTEGRABLE; c < 0 by *) +(* oddness, c = 0 trivially). *) +let SIN_STRETCH_OVER_X_INTEGRABLE_ALL = prove + (`!a b c:real. (\u. sin(c * u) / u) real_integrable_on real_interval[a,b]`, + REPEAT GEN_TAC THEN + DISJ_CASES_TAC(REAL_ARITH `c = &0 \/ &0 < c \/ &0 < --c`) THENL + [ASM_REWRITE_TAC[REAL_MUL_LZERO; SIN_0; real_div; REAL_MUL_LZERO] THEN + REWRITE_TAC[REAL_INTEGRABLE_0]; + POP_ASSUM STRIP_ASSUME_TAC THENL + [ASM_SIMP_TAC[SIN_STRETCH_OVER_X_INTEGRABLE]; + SUBGOAL_THEN + `(\u. sin(c * u) / u) = (\u. --(sin(--c * u) / u))` + (fun th -> REWRITE_TAC[th]) THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + REWRITE_TAC[REAL_MUL_LNEG; SIN_NEG] THEN + REWRITE_TAC[real_div; REAL_MUL_LNEG; REAL_NEG_NEG]; + MATCH_MP_TAC REAL_INTEGRABLE_NEG THEN + ASM_SIMP_TAC[SIN_STRETCH_OVER_X_INTEGRABLE]]]]);; + +(* The g-part of the 283I integral tends to f x times 2 pi (the Dirichlet *) +(* limit GPART_LIMIT gives pi over [-1,1]; the factor 2 from the kernel *) +(* doubles it). *) +let GPART_LIMIT_FULL = prove + (`!(f:real->complex) x. + ((\a. integral (:real^1) + (\u. Cx (sin (a * drop u)) * + (Cx (&2 * inv (drop u)) * + (if abs (drop u) <= &1 then f x else vec 0)))) + --> f x * Cx(&2 * pi)) at_posinfinity`, + REPEAT GEN_TAC THEN + MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN + EXISTS_TAC + `\a. (f:real->complex) x * + Cx(real_integral (real_interval[-- &1,&1]) (\u. &2 * sin(a * u) / u))` + THEN + CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_AT_POSINFINITY] THEN + EXISTS_TAC `&1` THEN X_GEN_TAC `a:real` THEN DISCH_TAC THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC GPART_VALUE THEN + ASM_REAL_ARITH_TAC; + SUBGOAL_THEN + `!a. real_integral (real_interval[-- &1,&1]) (\u. &2 * sin(a * u) / u) = + &2 * real_integral (real_interval[-- &1,&1]) (\u. sin(a * u) / u)` + (fun th -> REWRITE_TAC[th]) THENL + [GEN_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_LMUL THEN + REWRITE_TAC[SIN_STRETCH_OVER_X_INTEGRABLE_ALL]; + ALL_TAC] THEN + REWRITE_TAC[CX_MUL; COMPLEX_MUL_ASSOC] THEN + MATCH_MP_TAC LIM_COMPLEX_LMUL THEN + MP_TAC(REWRITE_RULE[REALLIM_COMPLEX; o_DEF] GPART_LIMIT) THEN + REWRITE_TAC[]]);; + +(* The g-part integrand is integrable on the whole line (needed to split the *) +(* substituted integral into RL-part + g-part via INTEGRAL_ADD). *) +let GPART_INTEGRABLE = prove + (`!(f:real->complex) x a. + (\u. Cx (sin (a * drop u)) * + (Cx (&2 * inv (drop u)) * + (if abs (drop u) <= &1 then f x else vec 0))) integrable_on + (:real^1)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[COMPLEX_MUL_COND_VEC0] THEN + SUBGOAL_THEN + `!u:real^1. abs(drop u) <= &1 <=> u IN interval[lift(-- &1),lift(&1)]` + (fun th -> REWRITE_TAC[th]) THENL + [REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP] THEN GEN_TAC THEN REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[INTEGRABLE_RESTRICT_UNIV; GPART_INTEGRAND_REWRITE] THEN + MATCH_MP_TAC INTEGRABLE_COMPLEX_LMUL THEN + REWRITE_TAC[GSYM IMAGE_LIFT_REAL_INTERVAL] THEN + MATCH_MP_TAC INTEGRABLE_CX_DROP_COMPOSE THEN + MATCH_MP_TAC REAL_INTEGRABLE_LMUL THEN + REWRITE_TAC[SIN_STRETCH_OVER_X_INTEGRABLE_ALL]);; + +(* 283I crux: after t = x - u, the whole inversion integral tends to 2 pi f *) +(* x. Split the integrand (INTEGRAND_SPLIT_283I) into the L^1 "difference" *) +(* part (--> 0 by Riemann-Lebesgue, RLPART_LIMIT) and the singular "g" part *) +(* (--> 2 pi f x, GPART_LIMIT_FULL); add the two limits. *) +let SUBST_INTEGRAL_LIMIT = prove + (`!(f:real->complex) x K d. + &0 < d /\ d <= &1 /\ &0 <= K /\ + (!v. abs v <= d ==> norm(f(x - v) - f x) <= K * abs v) /\ + (\z. f(drop z)) absolutely_integrable_on (:real^1) + ==> ((\a. integral (:real^1) + (\u. Cx (&2 * sin (a * drop u) / drop u) * f (x - drop u))) + --> f x * Cx(&2 * pi)) at_posinfinity`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[INTEGRAND_SPLIT_283I] THEN + SUBGOAL_THEN + `!a. integral (:real^1) + (\u. Cx (sin (a * drop u)) * + (Cx (&2 * inv (drop u)) * + (f (x - drop u) - (if abs (drop u) <= &1 then f x else vec 0))) + + + Cx (sin (a * drop u)) * + (Cx (&2 * inv (drop u)) * + (if abs (drop u) <= &1 then f x else vec 0))) = + integral (:real^1) + (\u. Cx (sin (a * drop u)) * + (Cx (&2 * inv (drop u)) * + (f (x - drop u) - (if abs (drop u) <= &1 then f x else vec + 0)))) + + integral (:real^1) + (\u. Cx (sin (a * drop u)) * + (Cx (&2 * inv (drop u)) * + (if abs (drop u) <= &1 then f x else vec 0)))` + (fun th -> REWRITE_TAC[th]) THENL + [GEN_TAC THEN MATCH_MP_TAC INTEGRAL_ADD THEN + REWRITE_TAC[GPART_INTEGRABLE] THEN + MP_TAC(ISPECL + [`\u. Cx (&2 * inv u) * + ((f:real->complex)(x - u) - (if abs u <= &1 then f x else vec 0))`; + `a:real`] CX_SIN_H_INTEGRABLE) THEN + REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + MP_TAC(ISPECL [`f:real->complex`; `x:real`; `K:real`; + `d:real`] H283I_ABSINT) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV) [GSYM VECTOR_ADD_LID] THEN + MATCH_MP_TAC LIM_ADD THEN CONJ_TAC THENL + [MP_TAC(ISPECL [`f:real->complex`; `x:real`; `K:real`; + `d:real`] RLPART_LIMIT) THEN + ASM_REWRITE_TAC[]; + REWRITE_TAC[GPART_LIMIT_FULL]]);; + +(* ------------------------------------------------------------------------- *) +(* Fremlin 283I (raw form): if f is L^1 on the line and Lipschitz at x, then *) +(* INT_{-a}^a e^{ixy} sqrt(2 pi) fhat(y) dy --> 2 pi f x as a --> +inf. *) +(* Chain FOURIER_283H_RAW (Fubini identity), SUBSTITUTED_RHS (t = x - u), *) +(* and *) +(* SUBST_INTEGRAL_LIMIT (the split limit). *) +(* ------------------------------------------------------------------------- *) +let FOURIER_283I_RAW = prove + (`!(f:real->complex) x K d. + &0 < d /\ d <= &1 /\ &0 <= K /\ + (!v. abs v <= d ==> norm(f(x - v) - f x) <= K * abs v) /\ + (\z. f(drop z)) absolutely_integrable_on (:real^1) + ==> ((\a. integral (interval[lift(--a),lift a]) + (\y. cexp(ii * Cx x * Cx(drop y)) * Cx(sqrt(&2 * pi)) * + fourier f (drop y))) + --> f x * Cx(&2 * pi)) at_posinfinity`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC LIM_TRANSFORM_EVENTUALLY THEN + EXISTS_TAC + `\a. integral (:real^1) + (\u. Cx (&2 * sin (a * drop u) / drop u) * (f:real->complex) (x - + drop u))` THEN + CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_AT_POSINFINITY] THEN + EXISTS_TAC `&0` THEN X_GEN_TAC `a:real` THEN DISCH_TAC THEN + MP_TAC(ISPECL [`f:real->complex`; `a:real`; + `x:real`] FOURIER_283H_RAW) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[REAL_ARITH `a >= &0 ==> &0 <= a`]; + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[SUBSTITUTED_RHS]]; + MP_TAC(ISPECL [`f:real->complex`; `x:real`; `K:real`; `d:real`] + SUBST_INTEGRAL_LIMIT) THEN ASM_REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Normalisation of 283I to the standard inversion form. First: fhat is *) +(* continuous on the line (from sequential continuity *) +(* FOURIER_CONTINUOUS_SEQ), *) +(* hence the modulated integrand e^{ixy} fhat(y) is integrable on [-a,a]. *) +(* ------------------------------------------------------------------------- *) +let FOURIER_CONTINUOUS_ON = prove + (`!(f:real->complex). + (\z. f(drop z)) absolutely_integrable_on (:real^1) + ==> (\z. fourier f (drop z)) continuous_on (:real^1)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[CONTINUOUS_ON_SEQUENTIALLY] THEN + MAP_EVERY X_GEN_TAC [`xx:num->real^1`; `aa:real^1`] THEN STRIP_TAC THEN + REWRITE_TAC[o_DEF] THEN + MP_TAC(ISPECL [`f:real->complex`; `drop aa`] FOURIER_CONTINUOUS_SEQ) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + ASM_SIMP_TAC[FOURIER_MODULATION_ABSINT]; + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + FIRST_ASSUM(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_NORM) THEN + REWRITE_TAC[o_DEF]]; + DISCH_THEN(MP_TAC o ISPEC `\k:num. drop(xx k)`) THEN + REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + REWRITE_TAC[GSYM o_DEF; GSYM REAL_TENDSTO] THEN + FIRST_X_ASSUM ACCEPT_TAC]);; + +(* The modulated fhat integrand e^{ixy} fhat(y) is integrable on [-a,a] *) +(* (continuous fhat times continuous exponential, on a compact interval). *) +let FOURIER_MODULATED_INTEGRABLE = prove + (`!(f:real->complex) x a. + (\z. f(drop z)) absolutely_integrable_on (:real^1) + ==> (\y. cexp(ii * Cx x * Cx(drop y)) * fourier f (drop y)) + integrable_on interval[lift(--a),lift a]`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC INTEGRABLE_CONTINUOUS THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN CONJ_TAC THENL + [REWRITE_TAC[CONTINUOUS_ON_CX_LIFT] THEN + ONCE_REWRITE_TAC[GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL + [ONCE_REWRITE_TAC[COMPLEX_MUL_ASSOC] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_LMUL THEN + MP_TAC(ISPECL [`\y:real^1. y`; `interval[lift(--a),lift a]`] + CONTINUOUS_ON_CX_DROP) THEN + REWRITE_TAC[CONTINUOUS_ON_ID]; + REWRITE_TAC[CONTINUOUS_ON_CEXP; CONTINUOUS_ON_ID]]; + MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `(:real^1)` THEN + ASM_SIMP_TAC[FOURIER_CONTINUOUS_ON; SUBSET_UNIV]]);; + +(* Constants for normalising sqrt(2 pi). *) +let SQRT_2PI_POS = prove + (`&0 < sqrt(&2 * pi)`, + MATCH_MP_TAC SQRT_POS_LT THEN MP_TAC PI_POS THEN REAL_ARITH_TAC);; + +let CX_INV_2PI_SQRT = prove + (`Cx(inv(&2 * pi)) * Cx(sqrt(&2 * pi)) = Cx(inv(sqrt(&2 * pi)))`, + REWRITE_TAC[GSYM CX_MUL] THEN AP_TERM_TAC THEN + MP_TAC SQRT_2PI_POS THEN MP_TAC(SPEC `&2 * pi` SQRT_POW_2) THEN + MP_TAC PI_POS THEN CONV_TAC REAL_FIELD);; + +let CX_INV_2PI_CANCEL = prove + (`!fx. Cx(inv(&2 * pi)) * (fx * Cx(&2 * pi)) = fx`, + GEN_TAC THEN REWRITE_TAC[COMPLEX_RING `ic * (fx * tp) = (ic * tp) * fx`] THEN + REWRITE_TAC[GSYM CX_MUL] THEN + SUBGOAL_THEN `inv(&2 * pi) * (&2 * pi) = &1` SUBST1_TAC THENL + [MP_TAC PI_POS THEN CONV_TAC REAL_FIELD; + REWRITE_TAC[COMPLEX_MUL_LID]]);; + +(* ------------------------------------------------------------------------- *) +(* Fremlin 283I (standard normalised form): the pointwise Fourier inversion. *) +(* If f is L^1 on the line and Lipschitz at x, then *) +(* (1 / sqrt(2 pi)) INT_{-a}^a e^{ixy} fhat(y) dy --> f x as a --> +inf. *) +(* Obtained from FOURIER_283I_RAW by pulling out sqrt(2 pi) (the integrand *) +(* is *) +(* integrable, FOURIER_MODULATED_INTEGRABLE) and rescaling the limit. *) +(* ------------------------------------------------------------------------- *) +let FOURIER_283I = prove + (`!(f:real->complex) x K d. + &0 < d /\ d <= &1 /\ &0 <= K /\ + (!v. abs v <= d ==> norm(f(x - v) - f x) <= K * abs v) /\ + (\z. f(drop z)) absolutely_integrable_on (:real^1) + ==> ((\a. Cx(inv(sqrt(&2 * pi))) * + integral (interval[lift(--a),lift a]) + (\y. cexp(ii * Cx x * Cx(drop y)) * fourier f (drop y))) + --> f x) at_posinfinity`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:real->complex`; `x:real`; `K:real`; + `d:real`] FOURIER_283I_RAW) THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `!a. integral (interval[lift(--a),lift a]) + (\y. cexp(ii * Cx x * Cx(drop y)) * Cx(sqrt(&2 * pi)) * + (fourier:(real->complex)->real->complex) f (drop y)) = + Cx(sqrt(&2 * pi)) * + integral (interval[lift(--a),lift a]) + (\y. cexp(ii * Cx x * Cx(drop y)) * fourier f (drop y))` + (fun th -> REWRITE_TAC[th]) THENL + [GEN_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o ABS_CONV) + [SIMPLE_COMPLEX_ARITH `cexp e * Cx s * ff = Cx s * (cexp e * ff)`] THEN + MATCH_MP_TAC INTEGRAL_COMPLEX_LMUL THEN + ASM_SIMP_TAC[FOURIER_MODULATED_INTEGRABLE]; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o ISPEC `Cx(inv(&2 * pi))` o MATCH_MP LIM_COMPLEX_LMUL) + THEN + REWRITE_TAC[COMPLEX_MUL_ASSOC; CX_INV_2PI_SQRT] THEN + REWRITE_TAC[GSYM COMPLEX_MUL_ASSOC; CX_INV_2PI_CANCEL]);; + +(* ------------------------------------------------------------------------- *) +(* Fremlin 283J: when fhat is itself integrable, the truncation limit of *) +(* 283I *) +(* collapses to the genuine full-line inverse-transform integral, which then *) +(* equals f x. I.e. f = (fhat)check at any Lipschitz point. *) +(* ------------------------------------------------------------------------- *) + +(* Symmetric truncations of an integrable function converge to its integral: *) +(* INT_{[-a,a]} g --> INT_R g as a --> +inf. From HAS_INTEGRAL_ALT (the *) +(* improper integral as a ball-limit); ball(0,B) SUBSET [-a,a] once a >= B. *) +let SYMMETRIC_INTERVAL_LIMIT = prove + (`!(g:real^1->complex). + g integrable_on (:real^1) + ==> ((\a. integral (interval[lift(--a),lift a]) g) --> integral (:real^1) + g) + at_posinfinity`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP INTEGRABLE_INTEGRAL) THEN + GEN_REWRITE_TAC LAND_CONV [HAS_INTEGRAL_ALT] THEN + REWRITE_TAC[IN_UNIV] THEN STRIP_TAC THEN + REWRITE_TAC[LIM_AT_POSINFINITY; dist; real_ge] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `B:real` THEN X_GEN_TAC `a:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`lift(--a)`; `lift a`]) THEN + ANTS_TAC THENL + [REWRITE_TAC[BALL_1; SUBSET_INTERVAL_1] THEN + REWRITE_TAC[LIFT_DROP; DROP_ADD; DROP_SUB; LIFT_NEG; DROP_VEC; + LIFT_NUM] THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[ETA_AX]]);; + +(* When fhat is L^1, e^{ixy} fhat(y) is integrable on the whole line *) +(* (bounded modulation of an L^1 function -- reuse FOURIER_MODULATION_ABSINT *) +(* at d = -x). *) +let FOURIER_INV_MODULATED_INTEGRABLE = prove + (`!(f:real->complex) x. + (\z. fourier f (drop z)) absolutely_integrable_on (:real^1) + ==> (\y. cexp(ii * Cx x * Cx(drop y)) * fourier f (drop y)) + integrable_on (:real^1)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC INTEGRABLE_EQ THEN + EXISTS_TAC + `\y. cexp(--(ii * Cx(--x) * Cx(drop y))) * + (fourier:(real->complex)->real->complex) f (drop y)` THEN + CONJ_TAC THENL + [X_GEN_TAC `y:real^1` THEN DISCH_TAC THEN + REWRITE_TAC[CX_NEG; COMPLEX_MUL_LNEG; COMPLEX_MUL_RNEG; COMPLEX_NEG_NEG]; + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MP_TAC(ISPECL [`fourier (f:real->complex)`; `--x:real`] + FOURIER_MODULATION_ABSINT) THEN + ASM_REWRITE_TAC[]]);; + +(* Fremlin 283J proper: (1/sqrt(2pi)) INT_R e^{ixy} fhat(y) dy = f x. The *) +(* 283I truncation limit and the full-line integral (via SYMMETRIC_INTERVAL_ *) +(* LIMIT, scaled) are two limits of the same sequence, so LIM_UNIQUE. *) +let FOURIER_283J = prove + (`!(f:real->complex) x K d. + &0 < d /\ d <= &1 /\ &0 <= K /\ + (!v. abs v <= d ==> norm(f(x - v) - f x) <= K * abs v) /\ + (\z. f(drop z)) absolutely_integrable_on (:real^1) /\ + (\z. fourier f (drop z)) absolutely_integrable_on (:real^1) + ==> Cx(inv(sqrt(&2 * pi))) * + integral (:real^1) + (\y. cexp(ii * Cx x * Cx(drop y)) * fourier f (drop y)) = + f x`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(ISPEC `at_posinfinity` LIM_UNIQUE) THEN + EXISTS_TAC + `\a. Cx(inv(sqrt(&2 * pi))) * + integral (interval[lift(--a),lift a]) + (\y. cexp(ii * Cx x * Cx(drop y)) * + (fourier:(real->complex)->real->complex) f (drop y))` THEN + REWRITE_TAC[TRIVIAL_LIMIT_AT_POSINFINITY] THEN CONJ_TAC THENL + [MATCH_MP_TAC LIM_COMPLEX_LMUL THEN + MATCH_MP_TAC SYMMETRIC_INTERVAL_LIMIT THEN + MATCH_MP_TAC FOURIER_INV_MODULATED_INTEGRABLE THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC FOURIER_283I THEN + MAP_EVERY EXISTS_TAC [`K:real`; `d:real`] THEN ASM_REWRITE_TAC[]]);; + + +(* ========================================================================= *) +(* SECTION 5. Fourier-transform calculus (Fremlin 283C(f-i), 283K). *) +(* *) +(* Provides the derivative/multiplication duality for the transform: *) +(* 283Cf fhat continuous (already FOURIER_CONTINUOUS_ON) *) +(* 283Cg fhat(y) --> 0 as |y| --> inf *) +(* 283Ch d/dy fhat(y) = -i/sqrt(2pi) INT e^{-iyx} x f(x) dx *) +(* 283Ci transform of a derivative: (f')hat(y) = iy fhat(y) *) +(* 283K f, f', f'' integrable ==> fhat integrable *) +(* These feed the Schwartz-function theory of 284 (284C inversion, 284O *) +(* Plancherel), which 286 needs. *) +(* ========================================================================= *) + +(* Transport a (vector/real) derivative across an equal derivative value: *) +(* rewrite the derivative in the conclusion to a convenient equal form. *) +(* (Replaces a MESON[] `d = e ==> ...` idiom repeated throughout the file.) *) +let VDERIV_EQ = prove + (`!(f:real^1->real^N) d e net. + d = e ==> (f has_vector_derivative d) net ==> (f has_vector_derivative e) + net`, + MESON_TAC[]);; + +let RDERIV_EQ = prove + (`!(f:real->real) d e net. + d = e ==> (f has_real_derivative d) net ==> (f has_real_derivative e) + net`, + MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* An integrable function on the line that has a limit at +infinity must *) +(* have *) +(* limit zero (otherwise the tail integral of its norm would diverge). *) +(* ------------------------------------------------------------------------- *) + +(* Arithmetic helper: keeps the product (N-B)*P atomic (P = |L|/2), avoiding *) +(* the a*b/c reassociation that defeats REAL_ARITH. *) +let TAIL_ARITH_HELPER = prove + (`!M N B P:real. &0 <= M /\ &0 < P /\ (&2 * M) / P < N - B + ==> M < (N - B) * P`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&2 * M < (N - B) * P` MP_TAC THENL + [ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ]; ASM_REAL_ARITH_TAC]);; + +let INTEGRABLE_TENDSTO_POSINFINITY_ZERO = prove + (`!(f:real->complex) L. + (\z. f(drop z)) absolutely_integrable_on (:real^1) /\ + (f --> L) at_posinfinity + ==> L = vec 0`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[GSYM NORM_EQ_0] THEN + MATCH_MP_TAC(REAL_ARITH `~(&0 < n) /\ &0 <= n ==> n = &0`) THEN + REWRITE_TAC[NORM_POS_LE] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [LIM_AT_POSINFINITY]) THEN + DISCH_THEN(MP_TAC o SPEC `norm(L:complex) / &2`) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[real_ge; dist] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` STRIP_ASSUME_TAC) THEN + ABBREV_TAC `g = \z:real^1. lift(norm((f:real->complex)(drop z)))` THEN + SUBGOAL_THEN `(g:real^1->real^1) integrable_on (:real^1)` ASSUME_TAC THENL + [EXPAND_TAC "g" THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + FIRST_ASSUM(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_NORM) THEN + REWRITE_TAC[o_DEF]; + ALL_TAC] THEN + ABBREV_TAC `M = drop(integral (:real^1) (g:real^1->real^1))` THEN + SUBGOAL_THEN `&0 <= M` ASSUME_TAC THENL + [EXPAND_TAC "M" THEN MATCH_MP_TAC INTEGRAL_DROP_POS THEN + ASM_REWRITE_TAC[] THEN EXPAND_TAC "g" THEN + REWRITE_TAC[LIFT_DROP; NORM_POS_LE]; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < norm(L:complex) / &2` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `&0 <= (&2 * M) / (norm(L:complex) / &2)` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_DIV THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + (* choose N with (N - B)*(|L|/2) > M *) + MP_TAC(SPEC `B + (&2 * M) / (norm(L:complex) / &2) + &1` REAL_ARCH_SIMPLE) + THEN + DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN + ABBREV_TAC `N = &n:real` THEN + (* the tail lower bound: content[B,N]*(|L|/2) <= INT_{[B,N]} g <= M *) + SUBGOAL_THEN `B <= N` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `drop(integral (interval[lift B,lift N]) (g:real^1->real^1)) <= M` + ASSUME_TAC THENL + [EXPAND_TAC "M" THEN MATCH_MP_TAC INTEGRAL_SUBSET_DROP_LE THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[SUBSET_UNIV]; + MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `(:real^1)` THEN ASM_REWRITE_TAC[SUBSET_UNIV]; + ASM_REWRITE_TAC[]; + X_GEN_TAC `z:real^1` THEN DISCH_TAC THEN EXPAND_TAC "g" THEN + REWRITE_TAC[LIFT_DROP; NORM_POS_LE]]; + ALL_TAC] THEN + SUBGOAL_THEN + `(N - B) * (norm(L:complex) / &2) <= + drop(integral (interval[lift B,lift N]) (g:real^1->real^1))` + ASSUME_TAC THENL + [MP_TAC(ISPECL [`\z:real^1. lift(norm(L:complex) / &2)`; `g:real^1->real^1`; + `interval[lift B,lift N]`] INTEGRAL_DROP_LE) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [REWRITE_TAC[INTEGRABLE_CONST]; + MATCH_MP_TAC INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `(:real^1)` THEN ASM_REWRITE_TAC[SUBSET_UNIV]; + X_GEN_TAC `z:real^1` THEN REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP] THEN + STRIP_TAC THEN EXPAND_TAC "g" THEN REWRITE_TAC[LIFT_DROP] THEN + MATCH_MP_TAC(NORM_ARITH + `norm(fz - L) < norm L / &2 ==> norm L / &2 <= norm fz`) THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC]; + REWRITE_TAC[INTEGRAL_CONST; LIFT_DROP] THEN + ASM_SIMP_TAC[CONTENT_1; LIFT_DROP; DROP_CMUL] THEN + REAL_ARITH_TAC]; + ALL_TAC] THEN + (* combine: (N-B)*(|L|/2) <= INT <= M, but N chosen so M < (N-B)*(|L|/2) *) + SUBGOAL_THEN `M < (N - B) * (norm(L:complex) / &2)` ASSUME_TAC THENL + [MATCH_MP_TAC TAIL_ARITH_HELPER THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC; + ASM_REAL_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Derivative of the Fourier kernel x |-> e^{-iyx} in x: it is -iy e^{-iyx}. *) +(* ------------------------------------------------------------------------- *) +let CEXP_KERNEL_VECTOR_DERIV = prove + (`!y a:real^1. + ((\z. cexp(--(ii * Cx y * Cx(drop z)))) has_vector_derivative + (--(ii * Cx y) * cexp(--(ii * Cx y * Cx(drop a))))) (at a)`, + REPEAT GEN_TAC THEN MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_REAL_COMPLEX THEN + COMPLEX_DIFF_TAC THEN CONV_TAC COMPLEX_RING);; + +(* A function differentiable everywhere on the line (as a real^1->complex *) +(* map via drop) is continuous there. *) +let FF_CONTINUOUS_ON = prove + (`!(ff:real->complex) (ffp:real->complex). + (!x. ((\z. ff(drop z)) has_vector_derivative (ffp x)) (at(lift x))) + ==> (\z. ff(drop z)) continuous_on (:real^1)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN + X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN + MATCH_MP_TAC DIFFERENTIABLE_IMP_CONTINUOUS_AT THEN + MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_IMP_DIFFERENTIABLE THEN + EXISTS_TAC `(ffp:real->complex)(drop x)` THEN + FIRST_X_ASSUM(MP_TAC o SPEC `drop(x:real^1)`) THEN + REWRITE_TAC[LIFT_DROP]);; + +(* Hence e^{-iyx} ff(x) is integrable on any bounded interval (continuous on *) +(* a compact set). *) +let KERNEL_TIMES_FF_INTEGRABLE = prove + (`!(ff:real->complex) (ffp:real->complex) y a. + (!x. ((\z. ff(drop z)) has_vector_derivative (ffp x)) (at(lift x))) + ==> (\z. cexp(--(ii * Cx y * Cx(drop z))) * ff(drop z)) + integrable_on interval[lift(--a),lift a]`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRABLE_CONTINUOUS THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_MUL THEN CONJ_TAC THENL + [REWRITE_TAC[CONTINUOUS_ON_CX_LIFT] THEN ONCE_REWRITE_TAC[GSYM o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL + [ONCE_REWRITE_TAC[COMPLEX_MUL_ASSOC] THEN + MATCH_MP_TAC CONTINUOUS_ON_NEG THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPLEX_LMUL THEN + MP_TAC(ISPECL [`\z:real^1. z`; `interval[lift(--a),lift a]`] + CONTINUOUS_ON_CX_DROP) THEN REWRITE_TAC[CONTINUOUS_ON_ID]; + REWRITE_TAC[CONTINUOUS_ON_CEXP; CONTINUOUS_ON_ID]]; + MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `(:real^1)` THEN + REWRITE_TAC[SUBSET_UNIV] THEN + MATCH_MP_TAC FF_CONTINUOUS_ON THEN EXISTS_TAC `ffp:real->complex` THEN + ASM_REWRITE_TAC[]]);; + +(* Abstract rearrangement (kept away from COMPLEX_RING's concrete-atom *) +(* lookup, which trips on the integral/cexp subterms). *) +let COMPLEX_COMBINE_SUB = prove + (`!A B C D:complex. A = B - C /\ A = D ==> C = B + --D`, + CONV_TAC COMPLEX_RING);; + +(* Pull the constant -iy out of INT((-iy k) ff) = -iy INT(k ff). Bound *) +(* variable *) +(* z chosen to match the target integrals so the atoms coincide for *) +(* COMPLEX_RING. *) +let KERNEL_LMUL_INTEGRAL = prove + (`!(ff:real->complex) (ffp:real->complex) y a. + (!x. ((\z. ff(drop z)) has_vector_derivative (ffp x)) (at(lift x))) + ==> integral (interval[lift(--a),lift a]) + (\z. (--(ii * Cx y) * cexp(--(ii * Cx y * Cx(drop z)))) * ff(drop z)) + = + --(ii * Cx y) * integral (interval[lift(--a),lift a]) + (\z. cexp(--(ii * Cx y * Cx(drop z))) * ff(drop z))`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[GSYM COMPLEX_MUL_ASSOC] THEN + MATCH_MP_TAC INTEGRAL_COMPLEX_LMUL THEN + MATCH_MP_TAC KERNEL_TIMES_FF_INTEGRABLE THEN + EXISTS_TAC `ffp:real->complex` THEN ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Finite-interval integration by parts for the Fourier kernel: for ff *) +(* differentiable with derivative ffp (both viewed via drop), and *) +(* e^{-iyx}ffp *) +(* integrable on [-a,a], *) +(* INT_{-a}^a e^{-iyx} ffp(x) dx = *) +(* (e^{-iya}ff(a) - e^{iya}ff(-a)) + iy INT_{-a}^a e^{-iyx} ff(x) dx. *) +(* ------------------------------------------------------------------------- *) +let FOURIER_IBP_FINITE = prove + (`!(ff:real->complex) (ffp:real->complex) y a. + &0 <= a /\ + (!x. ((\z. ff(drop z)) has_vector_derivative (ffp x)) (at(lift x))) /\ + (\z. cexp(--(ii * Cx y * Cx(drop z))) * ffp(drop z)) + integrable_on interval[lift(--a),lift a] + ==> integral (interval[lift(--a),lift a]) + (\z. cexp(--(ii * Cx y * Cx(drop z))) * ffp(drop z)) = + (cexp(--(ii * Cx y * Cx a)) * ff a - + cexp(--(ii * Cx y * Cx(--a))) * ff(--a)) + + (ii * Cx y) * + integral (interval[lift(--a),lift a]) + (\z. cexp(--(ii * Cx y * Cx(drop z))) * ff(drop z))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`( * ):complex->complex->complex`; + `\z:real^1. cexp(--(ii * Cx y * Cx(drop z)))`; + `\z:real^1. (ff:real->complex)(drop z)`; + `\z:real^1. --(ii * Cx y) * cexp(--(ii * Cx y * Cx(drop z)))`; + `\z:real^1. (ffp:real->complex)(drop z)`; + `lift(--a)`; `lift a`; + `(cexp(--(ii * Cx y * Cx a)) * ff a - + cexp(--(ii * Cx y * Cx(--a))) * ff(--a)) - + integral (interval[lift(--a),lift a]) + (\z. cexp(--(ii * Cx y * Cx(drop z))) * ffp(drop z))`] + INTEGRATION_BY_PARTS_SIMPLE) THEN + REWRITE_TAC[BILINEAR_COMPLEX_MUL; LIFT_DROP] THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; + GEN_TAC THEN DISCH_TAC THEN CONJ_TAC THENL + [MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_AT_WITHIN THEN + REWRITE_TAC[CEXP_KERNEL_VECTOR_DERIV]; + MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_AT_WITHIN THEN + FIRST_X_ASSUM(MP_TAC o SPEC `drop(x:real^1)`) THEN + REWRITE_TAC[LIFT_DROP]]; + REWRITE_TAC[COMPLEX_RING `b - (b - z) = z`] THEN + ASM_SIMP_TAC[INTEGRABLE_INTEGRAL]]; + ALL_TAC] THEN + (* Endgame: INTEGRAL_UNIQUE gives INT((-iy k) ff) = boundary - INT(k ffp); *) + (* KERNEL_LMUL_INTEGRAL rewrites that LHS to -iy INT(k ff); COMPLEX_RING *) + (* closes. *) + DISCH_THEN(ASSUME_TAC o REWRITE_RULE[] o + MATCH_MP INTEGRAL_UNIQUE o REWRITE_RULE[]) THEN + MP_TAC(ISPECL [`ff:real->complex`; `ffp:real->complex`; `y:real`; `a:real`] + KERNEL_LMUL_INTEGRAL) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + DISCH_TAC THEN + (* Combine INT((-iy k) ff) = boundary - INT(k ffp) with = -iy INT(k ff) *) + (* via the abstract rearrangement, then simplify --(-iy X) = iy X. *) + FIRST_X_ASSUM(fun eq2 -> FIRST_X_ASSUM(fun eq1 -> + MP_TAC(MATCH_MP COMPLEX_COMBINE_SUB (CONJ eq1 eq2)))) THEN + REWRITE_TAC[COMPLEX_MUL_LNEG; COMPLEX_NEG_NEG]);; + +(* ------------------------------------------------------------------------- *) +(* The two boundary terms e^{-iya}ff(a) and e^{iya}ff(-a) vanish as a-->+inf *) +(* (kernel modulus 1, ff --> 0 at each end). *) +(* ------------------------------------------------------------------------- *) +let BOUNDARY_TERM_POS = prove + (`!(ff:real->complex) y. + (ff --> vec 0) at_posinfinity + ==> ((\a. cexp(--(ii * Cx y * Cx a)) * ff a) --> vec 0) at_posinfinity`, + REPEAT STRIP_TAC THEN REWRITE_TAC[COMPLEX_VEC_0] THEN + MATCH_MP_TAC LIM_NULL_COMPLEX_LMUL_BOUNDED THEN + EXISTS_TAC `&1` THEN CONJ_TAC THENL + [MATCH_MP_TAC ALWAYS_EVENTUALLY THEN GEN_TAC THEN BETA_TAC THEN + DISJ1_TAC THEN REWRITE_TAC[FOURIER_KERNEL_NORM; REAL_LE_REFL]; + ASM_REWRITE_TAC[GSYM COMPLEX_VEC_0]]);; + +let BOUNDARY_TERM_NEG = prove + (`!(ff:real->complex) y. + ((\a. ff(--a)) --> vec 0) at_posinfinity + ==> ((\a. cexp(--(ii * Cx y * Cx(--a))) * ff(--a)) --> vec 0) + at_posinfinity`, + REPEAT STRIP_TAC THEN REWRITE_TAC[COMPLEX_VEC_0] THEN + MATCH_MP_TAC LIM_NULL_COMPLEX_LMUL_BOUNDED THEN + EXISTS_TAC `&1` THEN CONJ_TAC THENL + [MATCH_MP_TAC ALWAYS_EVENTUALLY THEN GEN_TAC THEN BETA_TAC THEN + DISJ1_TAC THEN REWRITE_TAC[FOURIER_KERNEL_NORM; REAL_LE_REFL]; + ASM_REWRITE_TAC[GSYM COMPLEX_VEC_0]]);; + +(* ------------------------------------------------------------------------- *) +(* Fremlin 283Ci (raw form): the transform of a derivative. For ff *) +(* differentiable with derivative ffp (both L^1 after modulation), ff --> 0 *) +(* at both ends, *) +(* INT_R e^{-iyx} ffp(x) dx = iy INT_R e^{-iyx} ff(x) dx. *) +(* Take a --> +inf in FOURIER_IBP_FINITE: LHS and the INT(k ff) both *) +(* converge *) +(* (SYMMETRIC_INTERVAL_LIMIT), the boundary term vanishes (BOUNDARY_TERM *) +(* lemmas). *) +(* ------------------------------------------------------------------------- *) +let FOURIER_283CI_RAW = prove + (`!(ff:real->complex) (ffp:real->complex) y. + (!x. ((\z. ff(drop z)) has_vector_derivative (ffp x)) (at(lift x))) /\ + (ff --> vec 0) at_posinfinity /\ + ((\a. ff(--a)) --> vec 0) at_posinfinity /\ + (\z. cexp(--(ii * Cx y * Cx(drop z))) * ffp(drop z)) + absolutely_integrable_on (:real^1) /\ + (\z. cexp(--(ii * Cx y * Cx(drop z))) * ff(drop z)) + absolutely_integrable_on (:real^1) + ==> integral (:real^1) (\z. cexp(--(ii * Cx y * Cx(drop z))) * ffp(drop + z)) = + (ii * Cx y) * + integral (:real^1) (\z. cexp(--(ii * Cx y * Cx(drop z))) * ff(drop + z))`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(ISPEC `at_posinfinity` LIM_UNIQUE) THEN + EXISTS_TAC + `\a. integral (interval[lift(--a),lift a]) + (\z. cexp(--(ii * Cx y * Cx(drop z))) * (ffp:real->complex)(drop z))` + THEN + REWRITE_TAC[TRIVIAL_LIMIT_AT_POSINFINITY] THEN CONJ_TAC THENL + [MATCH_MP_TAC SYMMETRIC_INTERVAL_LIMIT THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`at_posinfinity`; + `\a. (cexp(--(ii * Cx y * Cx a)) * (ff:real->complex) a - + cexp(--(ii * Cx y * Cx(--a))) * ff(--a)) + + (ii * Cx y) * + integral (interval[lift(--a),lift a]) + (\z. cexp(--(ii * Cx y * Cx(drop z))) * ff(drop z))`; + `\a. integral (interval[lift(--a),lift a]) + (\z. cexp(--(ii * Cx y * Cx(drop z))) * (ffp:real->complex)(drop + z))`; + `(ii * Cx y) * + integral (:real^1) (\z. cexp(--(ii * Cx y * Cx(drop z))) * + (ff:real->complex)(drop z))`] + LIM_TRANSFORM_EVENTUALLY) THEN + ANTS_TAC THENL [ALL_TAC; REWRITE_TAC[]] THEN + CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_AT_POSINFINITY] THEN EXISTS_TAC `&0` THEN + X_GEN_TAC `a:real` THEN DISCH_TAC THEN BETA_TAC THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC FOURIER_IBP_FINITE THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `(:real^1)` THEN ASM_REWRITE_TAC[SUBSET_UNIV]]; + GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV) [GSYM VECTOR_ADD_LID] THEN + MATCH_MP_TAC LIM_ADD THEN CONJ_TAC THENL + [SUBST1_TAC(VECTOR_ARITH `vec 0:complex = vec 0 - vec 0`) THEN + MATCH_MP_TAC LIM_SUB THEN + ASM_SIMP_TAC[BOUNDARY_TERM_POS; BOUNDARY_TERM_NEG]; + MATCH_MP_TAC LIM_COMPLEX_LMUL THEN + MATCH_MP_TAC SYMMETRIC_INTERVAL_LIMIT THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + ASM_REWRITE_TAC[]]]);; + +(* ------------------------------------------------------------------------- *) +(* Fremlin 283Ci, normalised: (f')hat(y) = iy fhat(y). The 1/sqrt(2pi) *) +(* normalising constant is a commuting factor (MUL_SWAP3 keeps it away from *) +(* COMPLEX_RING's concrete-atom lookup). *) +(* ------------------------------------------------------------------------- *) +let MUL_SWAP3 = prove + (`!c e w:complex. c * (e * w) = e * (c * w)`, CONV_TAC COMPLEX_RING);; + +let FOURIER_283CI = prove + (`!(ff:real->complex) (ffp:real->complex) y. + (!x. ((\z. ff(drop z)) has_vector_derivative (ffp x)) (at(lift x))) /\ + (ff --> vec 0) at_posinfinity /\ + ((\a. ff(--a)) --> vec 0) at_posinfinity /\ + (\z. cexp(--(ii * Cx y * Cx(drop z))) * ffp(drop z)) + absolutely_integrable_on (:real^1) /\ + (\z. cexp(--(ii * Cx y * Cx(drop z))) * ff(drop z)) + absolutely_integrable_on (:real^1) + ==> fourier ffp y = (ii * Cx y) * fourier ff y`, + REPEAT STRIP_TAC THEN REWRITE_TAC[fourier] THEN + MP_TAC(ISPECL [`ff:real->complex`; `ffp:real->complex`; `y:real`] + FOURIER_283CI_RAW) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[MUL_SWAP3]);; + +(* ------------------------------------------------------------------------- *) +(* Auxiliary for 283K: 1/(1+y^2) is integrable over the whole line, with *) +(* INT_{-a}^a = 2 atn a; this is the dominator for fhat. *) +(* ------------------------------------------------------------------------- *) +let INV_SQ_INTERVAL_INTEGRAL = prove + (`!a. &0 <= a + ==> real_integral (real_interval[--a,a]) (\y. inv(&1 + y pow 2)) = &2 * + atn a`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + SUBGOAL_THEN `&2 * atn a = atn a - atn(--a)` SUBST1_TAC THENL + [REWRITE_TAC[ATN_NEG] THEN REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS THEN CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_REAL_DERIVATIVE_ATREAL_WITHIN THEN + REWRITE_TAC[HAS_REAL_DERIVATIVE_ATN]]);; + +let INV_SQ_REAL_INTEGRABLE = prove + (`(\y. inv(&1 + y pow 2)) real_integrable_on (:real)`, + MP_TAC(ISPECL + [`\k y. if abs y <= &k then inv(&1 + y pow 2) else &0`; + `\y. inv(&1 + y pow 2)`; `(:real)`] + REAL_MONOTONE_CONVERGENCE_INCREASING) THEN + ANTS_TAC THENL [ALL_TAC; SIMP_TAC[]] THEN + REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [GEN_TAC THEN + SUBGOAL_THEN + `(\y. if abs y <= &k then inv(&1 + y pow 2) else &0) = + (\y. if y IN real_interval[-- &k, &k] then inv(&1 + y pow 2) else &0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; IN_REAL_INTERVAL] THEN GEN_TAC THEN + REWRITE_TAC[REAL_ARITH `abs y <= k <=> --k <= y /\ y <= k`]; + ALL_TAC] THEN + REWRITE_TAC[REAL_INTEGRABLE_RESTRICT_UNIV] THEN + MATCH_MP_TAC REAL_INTEGRABLE_CONTINUOUS THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_INV THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_ON_ADD THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_CONST] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_POW THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_ID]; + X_GEN_TAC `w:real` THEN DISCH_TAC THEN + MP_TAC(SPEC `w:real` REAL_LE_POW_2) THEN REAL_ARITH_TAC]; + REPEAT GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN `&0 <= inv(&1 + x pow 2)` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_INV THEN MP_TAC(SPEC `x:real` REAL_LE_POW_2) THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + REPEAT COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN + REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[GSYM REAL_OF_NUM_SUC] THEN + REAL_ARITH_TAC; + GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC REALLIM_EVENTUALLY THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN + MP_TAC(SPEC `abs x` REAL_ARCH_SIMPLE) THEN + DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `N:num` THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `abs x <= &n` (fun th -> ASM_MESON_TAC[th]) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&N:real` THEN + ASM_REWRITE_TAC[REAL_OF_NUM_LE]; + REWRITE_TAC[real_bounded; FORALL_IN_GSPEC] THEN + EXISTS_TAC `pi` THEN X_GEN_TAC `k:num` THEN + SUBGOAL_THEN + `real_integral (:real) (\y. if abs y <= &k then inv(&1 + y pow 2) else &0) + = + &2 * atn(&k)` + SUBST1_TAC THENL + [SUBGOAL_THEN + `(\y. if abs y <= &k then inv(&1 + y pow 2) else &0) = + (\y. if y IN real_interval[-- &k, &k] then inv(&1 + y pow 2) else &0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; IN_REAL_INTERVAL] THEN GEN_TAC THEN + REWRITE_TAC[REAL_ARITH `abs y <= k <=> --k <= y /\ y <= k`]; + ALL_TAC] THEN + REWRITE_TAC[REAL_INTEGRAL_RESTRICT_UNIV] THEN + MATCH_MP_TAC INV_SQ_INTERVAL_INTEGRAL THEN REWRITE_TAC[REAL_POS]; + MP_TAC(SPEC `&k:real` ATN_BOUND) THEN MP_TAC PI_POS THEN + REAL_ARITH_TAC]]);; + +(* ------------------------------------------------------------------------- *) +(* 283K: if f, f', f'' are integrable (with f, f' vanishing at +-inf and *) +(* f differentiable with derivative f', f' with derivative f''), then fhat *) +(* is *) +(* integrable. Iterating 283Ci gives (f'')hat(y) = -y^2 fhat(y); with fhat *) +(* and *) +(* (f'')hat bounded (FOURIER_BOUND_UNIFORM) this yields |fhat(y)| <= *) +(* 2K/(1+y^2), *) +(* an integrable dominator. *) +(* ------------------------------------------------------------------------- *) + +(* (iy)^2 = -y^2 as a complex scalar (Cx(y^2) opaque to COMPLEX_RING unless *) +(* rewritten to (Cx y) pow 2 first). *) +let II_CX_SQ = prove + (`!y. (ii * Cx y) * (ii * Cx y) = --(Cx(y pow 2))`, + GEN_TAC THEN + SUBGOAL_THEN `(ii * Cx y) * (ii * Cx y) = (ii * ii) * Cx(y pow 2)` + SUBST1_TAC THENL + [REWRITE_TAC[CX_POW] THEN CONV_TAC COMPLEX_RING; + REWRITE_TAC[GSYM COMPLEX_POW_2; COMPLEX_POW_II_2] THEN + CONV_TAC COMPLEX_RING]);; + +(* |w| <= K and |-y^2 w| <= K ==> |w| <= 2K/(1+y^2). *) +let FHAT_DOMINATION_BOUND = prove + (`!(w:complex) y K. + norm w <= K /\ norm(--(Cx(y pow 2)) * w) <= K + ==> norm w <= (&2 * K) * inv(&1 + y pow 2)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `norm(--(Cx(y pow 2)) * w) = y pow 2 * norm w` ASSUME_TAC THENL + [REWRITE_TAC[COMPLEX_NORM_MUL; NORM_NEG; COMPLEX_NORM_CX] THEN + MP_TAC(SPEC `y:real` REAL_LE_POW_2) THEN REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < &1 + y pow 2` ASSUME_TAC THENL + [MP_TAC(SPEC `y:real` REAL_LE_POW_2) THEN REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; GSYM real_div] THEN + REWRITE_TAC[REAL_ADD_RDISTRIB; REAL_MUL_LID] THEN + ASM_REAL_ARITH_TAC);; + +(* fhat is uniformly bounded when f is L^1. *) +let FOURIER_BOUND_UNIFORM = prove + (`!(f:real->complex). + (\z. f(drop z)) absolutely_integrable_on (:real^1) + ==> ?K. !y. norm(fourier f y) <= K`, + REPEAT STRIP_TAC THEN + EXISTS_TAC `&1 / sqrt(&2 * pi) * + drop(integral (:real^1) (\x. lift(norm((f:real->complex)(drop + x)))))` THEN + GEN_TAC THEN MATCH_MP_TAC FOURIER_BOUND THEN CONJ_TAC THENL + [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + ASM_SIMP_TAC[FOURIER_MODULATION_ABSINT]; + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + FIRST_ASSUM(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_NORM) THEN + REWRITE_TAC[o_DEF]]);; + +(* The K/(1+y^2) dominator, as a vector function integrable on the whole *) +(* line. *) +let DOMINATOR_SQ_INTEGRABLE = prove + (`!K. (\z:real^1. lift((&2 * K) * inv(&1 + drop z pow 2))) integrable_on + (:real^1)`, + GEN_TAC THEN + SUBGOAL_THEN `(\y. (&2 * K) * inv(&1 + y pow 2)) real_integrable_on (:real)` + MP_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_LMUL THEN REWRITE_TAC[INV_SQ_REAL_INTEGRABLE]; + REWRITE_TAC[REAL_INTEGRABLE_ON; IMAGE_LIFT_UNIV; o_DEF; LIFT_DROP]]);; + +(* Fremlin 283K proper: f, f', f'' integrable (with f, f' differentiable and *) +(* vanishing at +-inf) ==> fhat integrable. The dominating bound |fhat(y)| *) +(* <= *) +(* 2K/(1+y^2) comes from (f'')hat(y) = -y^2 fhat(y) (283Ci twice) and *) +(* boundedness. *) +let FOURIER_283K = prove + (`!(f:real->complex) (f':real->complex) (f'':real->complex). + (!x. ((\z. f(drop z)) has_vector_derivative (f' x)) (at(lift x))) /\ + (!x. ((\z. f'(drop z)) has_vector_derivative (f'' x)) (at(lift x))) /\ + (f --> vec 0) at_posinfinity /\ ((\a. f(--a)) --> vec 0) at_posinfinity /\ + (f' --> vec 0) at_posinfinity /\ ((\a. f'(--a)) --> vec 0) at_posinfinity + /\ + (\z. f(drop z)) absolutely_integrable_on (:real^1) /\ + (\z. f'(drop z)) absolutely_integrable_on (:real^1) /\ + (\z. f''(drop z)) absolutely_integrable_on (:real^1) + ==> (\z. fourier f (drop z)) absolutely_integrable_on (:real^1)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `!(g:real->complex) y. + (\z. g(drop z)) absolutely_integrable_on (:real^1) + ==> (\z. cexp(--(ii * Cx y * Cx(drop z))) * g(drop z)) + absolutely_integrable_on (:real^1)` + (LABEL_TAC "MOD") THENL + [REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[FOURIER_MODULATION_ABSINT]; ALL_TAC] THEN + SUBGOAL_THEN + `!y. fourier f'' y = --(Cx(y pow 2)) * fourier f y` + (LABEL_TAC "REL") THENL + [GEN_TAC THEN + SUBGOAL_THEN + `fourier f' y = (ii * Cx y) * fourier f y /\ + fourier f'' y = (ii * Cx y) * fourier f' y` + (fun th -> REWRITE_TAC[CONJUNCT2 th; CONJUNCT1 th] THEN + REWRITE_TAC[COMPLEX_MUL_ASSOC; II_CX_SQ]) THEN + CONJ_TAC THEN MATCH_MP_TAC FOURIER_283CI THEN ASM_SIMP_TAC[]; + ALL_TAC] THEN + MP_TAC(ISPEC `f:real->complex` FOURIER_BOUND_UNIFORM) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `K1:real`) THEN + MP_TAC(ISPEC `f'':real->complex` FOURIER_BOUND_UNIFORM) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `K2:real`) THEN + MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE THEN + EXISTS_TAC `\z:real^1. lift((&2 * (abs K1 + abs K2)) * inv(&1 + drop z pow + 2))` THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_IMP_MEASURABLE_ON THEN + ASM_SIMP_TAC[FOURIER_CONTINUOUS_ON]; + REWRITE_TAC[DOMINATOR_SQ_INTEGRABLE]; + X_GEN_TAC `z:real^1` THEN REWRITE_TAC[IN_UNIV; LIFT_DROP] THEN + MATCH_MP_TAC FHAT_DOMINATION_BOUND THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `K1:real` THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + USE_THEN "REL" (MP_TAC o SPEC `drop(z:real^1)`) THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `K2:real` THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC]]);; + + +(* ========================================================================= *) +(* SECTION 6. Schwartz (rapidly decreasing) test functions *) +(* (Fremlin 284A-284C). *) +(* *) +(* A Schwartz function h:R->C is smooth with *) +(* sup_x |x|^k |h^(m)(x)| < inf for all k,m. *) +(* We encode smoothness by an explicit derivative sequence d (d 0 = h, *) +(* d(SUC n) the vector derivative of d n via drop) and the decay bounds. *) +(* *) +(* The initial consequences establish integrability, decay, and inversion; *) +(* later sections develop the smooth bump and differentiation machinery used *) +(* for density, Plancherel, and closure under the Fourier transform. *) +(* ========================================================================= *) + +let schwartz = new_definition + `schwartz (h:real->complex) <=> + ?d:num->real->complex. + d 0 = h /\ + (!n x. ((\z. d n (drop z)) has_vector_derivative (d (SUC n) x)) + (at(lift x))) /\ + (!k m. ?B. !x. abs(x) pow k * norm(d m x) <= B)`;; + +(* Core domination: the k=0 and k=2 decay bounds give |g x| <= *) +(* (B0+B2)/(1+x^2). *) +let SCHWARTZ_DECAY_DOMINATION = prove + (`!(g:real->complex) B0 B2 x. + (!x. abs(x) pow 0 * norm(g x) <= B0) /\ + (!x. abs(x) pow 2 * norm(g x) <= B2) + ==> norm(g x) <= (B0 + B2) * inv(&1 + x pow 2)`, + REPEAT STRIP_TAC THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `x:real`)) THEN + REWRITE_TAC[real_pow; REAL_MUL_LID; REAL_POW2_ABS] THEN + SUBGOAL_THEN `&0 < &1 + x pow 2` ASSUME_TAC THENL + [MP_TAC(SPEC `x:real` REAL_LE_POW_2) THEN REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[GSYM real_div] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ] THEN + REWRITE_TAC[REAL_ADD_RDISTRIB; REAL_MUL_LID] THEN REAL_ARITH_TAC);; + +(* 284Bc, integrability half: a Schwartz function is (absolutely) *) +(* integrable. From the k=0 and k=2 decay bounds |h(x)| <= (B0+B2)/(1+x^2), *) +(* dominated by the integrable 1/(1+x^2); h is measurable (continuous, being *) +(* differentiable). *) +let SCHWARTZ_ABSINT = prove + (`!(h:real->complex). schwartz h + ==> (\z. h(drop z)) absolutely_integrable_on (:real^1)`, + REWRITE_TAC[schwartz] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN + MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE THEN + FIRST_ASSUM(X_CHOOSE_TAC `B0:real` o SPECL [`0`; `0`]) THEN + FIRST_ASSUM(X_CHOOSE_TAC `B2:real` o SPECL [`2`; `0`]) THEN + EXISTS_TAC + `\z:real^1. lift((&2 * (abs B0 + abs B2)) * inv(&1 + drop z pow 2))` THEN + REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_IMP_MEASURABLE_ON THEN + MATCH_MP_TAC FF_CONTINUOUS_ON THEN + EXISTS_TAC `(d:num->real->complex)(SUC 0)` THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[DOMINATOR_SQ_INTEGRABLE]; + X_GEN_TAC `z:real^1` THEN REWRITE_TAC[IN_UNIV; LIFT_DROP] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(abs B0 + abs B2) * inv(&1 + drop z pow 2)` THEN CONJ_TAC THENL + [MATCH_MP_TAC SCHWARTZ_DECAY_DOMINATION THEN + CONJ_TAC THEN X_GEN_TAC `x:real` THENL + [MP_TAC(SPEC `x:real` (ASSUME + `!x. abs(x) pow 0 * norm((d:num->real->complex) 0 x) <= B0`)) THEN + REAL_ARITH_TAC; + MP_TAC(SPEC `x:real` (ASSUME + `!x. abs(x) pow 2 * norm((d:num->real->complex) 0 x) <= B2`)) THEN + REAL_ARITH_TAC]; + MATCH_MP_TAC REAL_LE_RMUL THEN CONJ_TAC THENL + [REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LE_INV THEN MP_TAC(SPEC `drop z` REAL_LE_POW_2) THEN + REAL_ARITH_TAC]]]);; + +(* A Schwartz function is globally Lipschitz (its derivative d 1 is bounded, *) +(* so *) +(* VECTOR_DIFFERENTIABLE_BOUND / the mean value inequality applies). This *) +(* supplies *) +(* the Lipschitz-at-x hypothesis of 283J. *) +let SCHWARTZ_LIPSCHITZ = prove + (`!(h:real->complex). schwartz h + ==> ?K. &0 <= K /\ !u w. norm(h u - h w) <= K * abs(u - w)`, + REWRITE_TAC[schwartz] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN + FIRST_ASSUM(X_CHOOSE_TAC `B:real` o SPECL [`0`; `SUC 0`]) THEN + EXISTS_TAC `abs B` THEN CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`u:real`; `w:real`] THEN + MP_TAC(ISPECL [`\z:real^1. (d:num->real->complex) 0 (drop z)`; + `\z:real^1. (d:num->real->complex) (SUC 0) (drop z)`; + `(:real^1)`; `abs B`] VECTOR_DIFFERENTIABLE_BOUND) THEN + ANTS_TAC THENL + [REWRITE_TAC[CONVEX_UNIV; IN_UNIV] THEN CONJ_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_AT_WITHIN THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`0`; `drop x`]) THEN + REWRITE_TAC[LIFT_DROP]; + GEN_TAC THEN + MP_TAC(SPEC `drop x` (ASSUME + `!x. abs(x) pow 0 * norm((d:num->real->complex)(SUC 0) x) <= B`)) THEN + REWRITE_TAC[real_pow; REAL_MUL_LID] THEN REAL_ARITH_TAC]; + DISCH_THEN(MP_TAC o SPECL [`lift u`; `lift w`]) THEN + REWRITE_TAC[IN_UNIV; LIFT_DROP; GSYM LIFT_SUB; NORM_LIFT]]);; + +(* Arithmetic core of the tail estimate: x*n <= B and x >= (|B|+1)/e force n *) +(* < e. *) +let SCHWARTZ_TAIL_ARITH = prove + (`!x e B n:real. &0 < e /\ &0 < x /\ &0 <= n /\ x * n <= B /\ (abs B + &1) / e + <= x + ==> n < e`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `abs B + &1 <= x * e` ASSUME_TAC THENL + [MP_TAC(ISPECL [`abs B + &1`; `x:real`; `e:real`] REAL_LE_LDIV_EQ) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `x * n < x * e` MP_TAC THENL + [MP_TAC(SPEC `B:real` (REAL_ARITH `!B:real. B <= abs B`)) THEN + UNDISCH_TAC `x * n <= B` THEN UNDISCH_TAC `abs B + &1 <= x * e` THEN + REAL_ARITH_TAC; + ASM_SIMP_TAC[REAL_LT_LMUL_EQ]]);; + +(* A Schwartz function (and its reflection) vanish at +infinity: the k=1 *) +(* bound *) +(* |x| |h(x)| <= B gives |h(x)| <= B/|x| --> 0. Feeds 283K's vanishing *) +(* hypotheses. *) +let SCHWARTZ_TENDSTO_POS = prove + (`!(h:real->complex). schwartz h ==> (h --> vec 0) at_posinfinity`, + REWRITE_TAC[schwartz] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN + FIRST_ASSUM(X_CHOOSE_TAC `B:real` o SPECL [`SUC 0`; `0`]) THEN + REWRITE_TAC[LIM_AT_POSINFINITY; dist; real_ge] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + EXISTS_TAC `(abs B + &1) / e` THEN X_GEN_TAC `x:real` THEN DISCH_TAC THEN + REWRITE_TAC[VECTOR_SUB_RZERO] THEN + MATCH_MP_TAC SCHWARTZ_TAIL_ARITH THEN + MAP_EVERY EXISTS_TAC [`x:real`; `B:real`] THEN + ASM_REWRITE_TAC[NORM_POS_LE] THEN + SUBGOAL_THEN `&0 < x` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `(abs B + &1) / e` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_DIV THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real`) THEN + REWRITE_TAC[ARITH_RULE `SUC 0 = 1`; REAL_POW_1] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < x ==> abs x = x`]);; + +let SCHWARTZ_TENDSTO_NEG = prove + (`!(h:real->complex). schwartz h ==> ((\a. h(--a)) --> vec 0) at_posinfinity`, + REWRITE_TAC[schwartz] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN + FIRST_ASSUM(X_CHOOSE_TAC `B:real` o SPECL [`SUC 0`; `0`]) THEN + REWRITE_TAC[LIM_AT_POSINFINITY; dist; real_ge] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + EXISTS_TAC `(abs B + &1) / e` THEN X_GEN_TAC `x:real` THEN DISCH_TAC THEN + REWRITE_TAC[VECTOR_SUB_RZERO] THEN + MATCH_MP_TAC SCHWARTZ_TAIL_ARITH THEN + MAP_EVERY EXISTS_TAC [`x:real`; `B:real`] THEN + ASM_REWRITE_TAC[NORM_POS_LE] THEN + SUBGOAL_THEN `&0 < x` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `(abs B + &1) / e` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_DIV THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `--x:real`) THEN + REWRITE_TAC[ARITH_RULE `SUC 0 = 1`; REAL_POW_1; REAL_ABS_NEG] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < x ==> abs x = x`]);; + +(* Shifting a Schwartz witness: the derivative d 1 is itself Schwartz. *) +let SCHWARTZ_SHIFT = prove + (`!(d:num->real->complex). + (!n x. ((\z. d n (drop z)) has_vector_derivative (d (SUC n) x)) (at(lift + x))) /\ + (!k m. ?B. !x. abs(x) pow k * norm(d m x) <= B) + ==> schwartz (d 1)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[schwartz] THEN + EXISTS_TAC `\n. (d:num->real->complex)(SUC n)` THEN + REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[ARITH_RULE `SUC 0 = 1`]; + ASM_REWRITE_TAC[]; + REPEAT GEN_TAC THEN + FIRST_X_ASSUM(fun th -> MP_TAC(SPECL [`k:num`; `SUC m`] th)) THEN + REWRITE_TAC[]]);; + +(* fhat of a Schwartz function is integrable (Fremlin 283K applied to *) +(* h,h',h''). *) +let SCHWARTZ_FHAT_ABSINT = prove + (`!(h:real->complex). schwartz h + ==> (\z. fourier h (drop z)) absolutely_integrable_on (:real^1)`, + GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(X_CHOOSE_THEN `d:num->real->complex` STRIP_ASSUME_TAC o + REWRITE_RULE[schwartz]) THEN + FIRST_X_ASSUM(fun th -> SUBST_ALL_TAC(SYM th)) THEN + MATCH_MP_TAC FOURIER_283K THEN + MAP_EVERY EXISTS_TAC + [`(d:num->real->complex)(SUC 0)`; `(d:num->real->complex)(SUC(SUC 0))`] THEN + (* d(SUC 0) and d(SUC(SUC 0)) are Schwartz (shift twice); the derivative *) + (* goals then match the witness chain directly, and *) + (* vanishing/integrability follow. *) + SUBGOAL_THEN `schwartz ((d:num->real->complex) (SUC 0))` ASSUME_TAC THENL + [REWRITE_TAC[ARITH_RULE `SUC 0 = 1`] THEN + MATCH_MP_TAC SCHWARTZ_SHIFT THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `schwartz ((d:num->real->complex) (SUC(SUC 0)))` ASSUME_TAC THENL + [REWRITE_TAC[ARITH_RULE `SUC(SUC 0) = 2`] THEN + SUBGOAL_THEN `(d:num->real->complex) 2 = (\n. d(SUC n)) 1` SUBST1_TAC THENL + [REWRITE_TAC[ARITH_RULE `SUC 1 = 2`]; + MATCH_MP_TAC SCHWARTZ_SHIFT THEN REWRITE_TAC[] THEN CONJ_TAC THENL + [REPEAT GEN_TAC THEN + FIRST_X_ASSUM(fun th -> MP_TAC(SPECL [`SUC n`; `x:real`] th)) THEN + REWRITE_TAC[]; + REPEAT GEN_TAC THEN + FIRST_X_ASSUM(fun th -> MP_TAC(SPECL [`k:num`; `SUC m`] th)) THEN + REWRITE_TAC[]]]; + ALL_TAC] THEN + REPEAT CONJ_TAC THEN + TRY(ASM_REWRITE_TAC[] THEN NO_TAC) THEN + TRY(MATCH_MP_TAC SCHWARTZ_TENDSTO_POS THEN ASM_REWRITE_TAC[] THEN + NO_TAC) THEN + TRY(MATCH_MP_TAC SCHWARTZ_TENDSTO_NEG THEN REWRITE_TAC[ETA_AX] THEN + ASM_REWRITE_TAC[] THEN NO_TAC) THEN + TRY(MATCH_MP_TAC SCHWARTZ_ABSINT THEN REWRITE_TAC[ETA_AX] THEN + ASM_REWRITE_TAC[] THEN NO_TAC));; + +(* ------------------------------------------------------------------------- *) +(* Fremlin 284C (inversion half): for a Schwartz function h, the inverse *) +(* Fourier transform recovers h everywhere: *) +(* (1/sqrt(2 pi)) INT_R e^{ixy} hhat(y) dy = h x. *) +(* Direct from 283J: h is L^1 (SCHWARTZ_ABSINT), globally Lipschitz *) +(* (SCHWARTZ_LIPSCHITZ, giving the Lipschitz-at-x bound with d = 1), and *) +(* hhat *) +(* is L^1 (SCHWARTZ_FHAT_ABSINT). *) +(* ------------------------------------------------------------------------- *) +let FOURIER_284C_INVERSION = prove + (`!(h:real->complex) x. schwartz h + ==> Cx(inv(sqrt(&2 * pi))) * + integral (:real^1) (\y. cexp(ii * Cx x * Cx(drop y)) * fourier h (drop + y)) = + h x`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(X_CHOOSE_THEN + `K:real` STRIP_ASSUME_TAC o MATCH_MP SCHWARTZ_LIPSCHITZ) THEN + MATCH_MP_TAC FOURIER_283J THEN + MAP_EVERY EXISTS_TAC [`K:real`; `&1`] THEN + ASM_SIMP_TAC[SCHWARTZ_ABSINT; SCHWARTZ_FHAT_ABSINT; REAL_LE_REFL; + REAL_LT_01] THEN + X_GEN_TAC `v:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`x - v:real`; `x:real`]) THEN + REWRITE_TAC[REAL_ARITH `abs((x - v) - x) = abs v`]);; + +(* ------------------------------------------------------------------------- *) +(* Fremlin 283O prep: the 2D integrand f(x) e^{-ixy} g(y) is absolutely *) +(* integrable on the plane (product of two L^1 functions times a *) +(* unit-modulus *) +(* kernel). This is the Fubini input for the multiplication formula *) +(* INT f*ghat = INT fhat*g. *) +(* ------------------------------------------------------------------------- *) + +(* In R^1, scalar*vector commutes as a % v = drop v % lift a (use ONCE only *) +(* -- it re-matches its own RHS). *) +let CMUL_LIFT_SWAP = prove + (`!a:real. !v:real^1. a % v = drop v % lift a`, + REWRITE_TAC[CART_EQ; VECTOR_MUL_COMPONENT; LIFT_COMPONENT; drop; + DIMINDEX_1] THEN + REPEAT STRIP_TAC THEN SUBGOAL_THEN `i = 1` SUBST1_TAC THENL + [ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[LIFT_COMPONENT; drop] THEN + REAL_ARITH_TAC);; + +let FOURIER_283O_2D_ABSINT = prove + (`!(f:real->complex) (g:real->complex). + (\z. f(drop z)) absolutely_integrable_on (:real^1) /\ + (\z. g(drop z)) absolutely_integrable_on (:real^1) + ==> (\z:real^(1,1)finite_sum. + f(drop(fstcart z)) * + cexp(--(ii * Cx(drop(fstcart z)) * Cx(drop(sndcart z)))) * + g(drop(sndcart z))) absolutely_integrable_on + (:real^(1,1)finite_sum)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\x:real^1. lift(norm((g:real->complex)(drop x)))) + integrable_on (:real^1)` + ASSUME_TAC THENL + [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + UNDISCH_TAC `(\z. (g:real->complex)(drop z)) absolutely_integrable_on + (:real^1)` THEN + DISCH_THEN(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_NORM) THEN + REWRITE_TAC[o_DEF]; + ALL_TAC] THEN + SUBGOAL_THEN + `(\x:real^1. lift(norm((f:real->complex)(drop x)))) + integrable_on (:real^1)` + ASSUME_TAC THENL + [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + UNDISCH_TAC `(\z. (f:real->complex)(drop z)) absolutely_integrable_on + (:real^1)` THEN + DISCH_THEN(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_NORM) THEN + REWRITE_TAC[o_DEF]; + ALL_TAC] THEN + MP_TAC(ISPEC + `\z:real^(1,1)finite_sum. f(drop(fstcart z)) * + cexp(--(ii * Cx(drop(fstcart z)) * Cx(drop(sndcart z)))) * + g(drop(sndcart z))` + (INST_TYPE [`:1`,`:M`; `:1`,`:N`] FUBINI_TONELLI)) THEN + ANTS_TAC THENL + [MATCH_MP_TAC MEASURABLE_ON_COMPLEX_MUL THEN CONJ_TAC THENL + [MP_TAC(INST_TYPE [`:1`,`:M`; `:1`,`:N`; `:2`,`:P`] + (ISPEC `\w:real^1. (f:real->complex)(drop w)` + MEASURABLE_ON_COMPOSE_FSTCART)) THEN + REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE; + INTEGRABLE_IMP_MEASURABLE]; + MATCH_MP_TAC MEASURABLE_ON_COMPLEX_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_IMP_MEASURABLE_ON THEN + REWRITE_TAC[CEXP_FSTSND_CONTINUOUS]; + MP_TAC(INST_TYPE [`:1`,`:M`; `:1`,`:N`; `:2`,`:P`] + (ISPEC `\w:real^1. (g:real->complex)(drop w)` + MEASURABLE_ON_COMPOSE_SNDCART)) THEN + REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE; + INTEGRABLE_IMP_MEASURABLE]]]; + ALL_TAC] THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN CONJ_TAC THENL + [SUBGOAL_THEN + `{x:real^1 | ~((\y. f(drop x) * + cexp(--(ii * Cx(drop x) * Cx(drop y))) * g(drop y)) + absolutely_integrable_on (:real^1))} = {}` + (fun th -> REWRITE_TAC[th; NEGLIGIBLE_EMPTY]) THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN + X_GEN_TAC `x:real^1` THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_COMPLEX_LMUL THEN + ASM_SIMP_TAC[FOURIER_MODULATION_ABSINT]; + SUBGOAL_THEN + `!x:real^1. integral (:real^1) + (\y. lift(norm(f(drop x) * + cexp(--(ii * Cx(drop x) * Cx(drop y))) * g(drop y)))) = + norm(f(drop x)) % integral (:real^1) (\y. lift(norm(g(drop y))))` + (fun th -> REWRITE_TAC[th]) THENL + [GEN_TAC THEN + REWRITE_TAC[COMPLEX_NORM_MUL; FOURIER_KERNEL_NORM; REAL_MUL_LID] THEN + REWRITE_TAC[LIFT_CMUL] THEN MATCH_MP_TAC INTEGRAL_CMUL THEN + ASM_REWRITE_TAC[]; + ONCE_REWRITE_TAC[CMUL_LIFT_SWAP] THEN MATCH_MP_TAC INTEGRABLE_CMUL THEN + ASM_REWRITE_TAC[]]]);; + +(* ------------------------------------------------------------------------- *) +(* Fremlin 283O: the multiplication formula INT f*ghat = INT fhat*g, the *) +(* Parseval-type identity leading into Plancherel (284O). Both sides equal *) +(* (1/sqrt(2pi)) of the plane integral of f(x) e^{-ixy} g(y), computed by *) +(* Fubini in the two orders (FOURIER_283O_2D_ABSINT justifies the swap). *) +(* ------------------------------------------------------------------------- *) + +(* Inner integral: INT_y e^{-ixy} g(y) dy = sqrt(2pi) * ghat(x). *) +let INNER_INT_FOURIER = prove + (`!(g:real->complex) x. + integral (:real^1) (\y. cexp(--(ii * Cx x * Cx(drop y))) * g(drop y)) = + Cx(sqrt(&2 * pi)) * fourier g x`, + REPEAT GEN_TAC THEN REWRITE_TAC[fourier] THEN + REWRITE_TAC[COMPLEX_MUL_ASSOC] THEN + SUBGOAL_THEN + `Cx(sqrt(&2 * pi)) * Cx(&1) / Cx(sqrt(&2 * pi)) = Cx(&1)` SUBST1_TAC THENL + [MP_TAC SQRT_2PI_POS THEN SIMP_TAC[CX_INJ; REAL_LT_IMP_NZ; COMPLEX_FIELD + `~(s = Cx(&0)) ==> s * Cx(&1) / s = Cx(&1)`]; + REWRITE_TAC[COMPLEX_MUL_LID]]);; + +let INNER_LMUL = prove + (`!(g:real->complex) c x. + (\z. g(drop z)) absolutely_integrable_on (:real^1) + ==> integral (:real^1) (\y. c * cexp(--(ii * Cx x * Cx(drop y))) * g(drop + y)) = + c * Cx(sqrt(&2 * pi)) * fourier g x`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[INTEGRAL_COMPLEX_LMUL; ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE; + FOURIER_MODULATION_ABSINT] THEN + REWRITE_TAC[INNER_INT_FOURIER; COMPLEX_MUL_ASSOC]);; + +(* f * ghat is L^1 (ghat continuous and bounded, f L^1). *) +let FHAT_TIMES_L1_ABSINT = prove + (`!(f:real->complex) (g:real->complex). + (\z. f(drop z)) absolutely_integrable_on (:real^1) /\ + (\z. g(drop z)) absolutely_integrable_on (:real^1) + ==> (\z. f(drop z) * fourier g (drop z)) absolutely_integrable_on + (:real^1)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`( * ):complex->complex->complex`; + `\z:real^1. fourier g (drop z)`; + `\z:real^1. (f:real->complex)(drop z)`; + `(:real^1)`] ABSOLUTELY_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT) THEN + REWRITE_TAC[BILINEAR_COMPLEX_MUL] THEN ASM_REWRITE_TAC[] THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_IMP_MEASURABLE_ON THEN + ASM_SIMP_TAC[FOURIER_CONTINUOUS_ON]; + REWRITE_TAC[bounded; FORALL_IN_IMAGE; IN_UNIV] THEN + FIRST_ASSUM(X_CHOOSE_TAC `K:real` o MATCH_MP FOURIER_BOUND_UNIFORM) THEN + EXISTS_TAC `K:real` THEN ASM_REWRITE_TAC[]]; + DISCH_TAC THEN ONCE_REWRITE_TAC[COMPLEX_MUL_SYM] THEN ASM_REWRITE_TAC[]]);; + +let FOURIER_283O_DIR1 = prove + (`!(f:real->complex) (g:real->complex). + (\z. f(drop z)) absolutely_integrable_on (:real^1) /\ + (\z. g(drop z)) absolutely_integrable_on (:real^1) + ==> integral (:real^(1,1)finite_sum) + (\z. f(drop(fstcart z)) * + cexp(--(ii * Cx(drop(fstcart z)) * Cx(drop(sndcart z)))) * + g(drop(sndcart z))) = + Cx(sqrt(&2 * pi)) * + integral (:real^1) (\z. f(drop z) * fourier g (drop z))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC + `\z:real^(1,1)finite_sum. f(drop(fstcart z)) * + cexp(--(ii * Cx(drop(fstcart z)) * Cx(drop(sndcart z)))) * + g(drop(sndcart z))` + (INST_TYPE [`:1`,`:M`; `:1`,`:N`] FUBINI_INTEGRAL)) THEN + ASM_SIMP_TAC[FOURIER_283O_2D_ABSINT] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN + ASM_SIMP_TAC[INNER_LMUL] THEN + ONCE_REWRITE_TAC[COMPLEX_MUL_ASSOC] THEN + ONCE_REWRITE_TAC[SIMPLE_COMPLEX_ARITH `(f * s) * gh = s * (f * gh)`] THEN + MATCH_MP_TAC INTEGRAL_COMPLEX_LMUL THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + ASM_SIMP_TAC[FHAT_TIMES_L1_ABSINT]);; + +let FOURIER_283O_DIR2 = prove + (`!(f:real->complex) (g:real->complex). + (\z. f(drop z)) absolutely_integrable_on (:real^1) /\ + (\z. g(drop z)) absolutely_integrable_on (:real^1) + ==> integral (:real^(1,1)finite_sum) + (\z. f(drop(fstcart z)) * + cexp(--(ii * Cx(drop(fstcart z)) * Cx(drop(sndcart z)))) * + g(drop(sndcart z))) = + Cx(sqrt(&2 * pi)) * + integral (:real^1) (\z. g(drop z) * fourier f (drop z))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC + `\z:real^(1,1)finite_sum. f(drop(fstcart z)) * + cexp(--(ii * Cx(drop(fstcart z)) * Cx(drop(sndcart z)))) * + g(drop(sndcart z))` + (INST_TYPE [`:1`,`:M`; `:1`,`:N`] FUBINI_INTEGRAL_ALT)) THEN + ASM_SIMP_TAC[FOURIER_283O_2D_ABSINT] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[FSTCART_PASTECART; SNDCART_PASTECART] THEN + SUBGOAL_THEN + `!y:real^1. integral (:real^1) + (\x. f(drop x) * cexp(--(ii * Cx(drop x) * Cx(drop y))) * g(drop y)) = + integral (:real^1) + (\x. g(drop y) * cexp(--(ii * Cx(drop y) * Cx(drop x))) * f(drop x))` + (fun th -> REWRITE_TAC[th]) THENL + [GEN_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN + SUBGOAL_THEN `ii * Cx(drop x) * Cx(drop y) = ii * Cx(drop y) * Cx(drop x)` + SUBST1_TAC THENL [CONV_TAC COMPLEX_RING; CONV_TAC COMPLEX_RING]; + ALL_TAC] THEN + ASM_SIMP_TAC[INNER_LMUL] THEN + ONCE_REWRITE_TAC[COMPLEX_MUL_ASSOC] THEN + ONCE_REWRITE_TAC[SIMPLE_COMPLEX_ARITH `(g * s) * fh = s * (g * fh)`] THEN + MATCH_MP_TAC INTEGRAL_COMPLEX_LMUL THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + ASM_SIMP_TAC[FHAT_TIMES_L1_ABSINT]);; + +let FOURIER_283O = prove + (`!(f:real->complex) (g:real->complex). + (\z. f(drop z)) absolutely_integrable_on (:real^1) /\ + (\z. g(drop z)) absolutely_integrable_on (:real^1) + ==> integral (:real^1) (\z. f(drop z) * fourier g (drop z)) = + integral (:real^1) (\z. fourier f (drop z) * g(drop z))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:real->complex`; `g:real->complex`] FOURIER_283O_DIR1) THEN + MP_TAC(ISPECL [`f:real->complex`; `g:real->complex`] FOURIER_283O_DIR2) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN SUBST1_TAC THEN DISCH_THEN(MP_TAC o SYM) THEN + SUBGOAL_THEN `~(Cx(sqrt(&2 * pi)) = Cx(&0))` ASSUME_TAC THENL + [REWRITE_TAC[CX_INJ] THEN MP_TAC SQRT_2PI_POS THEN REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[COMPLEX_EQ_MUL_LCANCEL] THEN + DISCH_THEN SUBST1_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN + REWRITE_TAC[COMPLEX_MUL_SYM]);; + +(* ------------------------------------------------------------------------- *) +(* Analytic core for 283Ch (differentiating fhat): the Fourier kernel is *) +(* 1-Lipschitz in its frequency, |e^{ia} - e^{ib}| <= |a - b|. With a = -xy *) +(* this bounds the difference quotient of e^{-ixy} by |x|, giving the |x *) +(* f(x)| *) +(* dominator for dominated convergence. *) +(* ------------------------------------------------------------------------- *) +let CEXP_II_DIFF_BOUND = prove + (`!a b:real. norm(cexp(ii * Cx a) - cexp(ii * Cx b)) <= abs(a - b)`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN + `cexp(ii * Cx a) - cexp(ii * Cx b) = + cexp(ii * Cx b) * (cexp(ii * Cx(a - b)) - Cx(&1))` + SUBST1_TAC THENL + [REWRITE_TAC[COMPLEX_SUB_LDISTRIB; GSYM CEXP_ADD; COMPLEX_MUL_RID] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[CX_SUB] THEN CONV_TAC COMPLEX_RING; + ALL_TAC] THEN + REWRITE_TAC[COMPLEX_NORM_MUL; NORM_CEXP_II; REAL_MUL_LID; + DIST_CEXP_II_1] THEN + MP_TAC(SPEC `(a - b) / &2` REAL_ABS_SIN_BOUND_LE) THEN REAL_ARITH_TAC);; + + +(* ========================================================================= *) +(* SECTION 7. Smooth-bump infrastructure toward Fremlin 284N. *) +(* Foundation layer: polynomial-times-decaying-exponential limits, which *) +(* drive the C^inf smoothness of the standard bump phi(x) = exp(-1/x) *) +(* (x > 0, else 0) -- its m-th derivative has the form poly(1/x) exp(-1/x), *) +(* whose limit at 0+ is controlled by t^k exp(-t) -> 0 as t -> +inf. *) +(* *) +(* Uses only the HOL Light analysis library. *) +(* ========================================================================= *) + +(* ------------------------------------------------------------------------- *) +(* The real exponential series, as a real_sums statement (bridged from the *) +(* complex Taylor series CEXP_CONVERGES). *) +(* ------------------------------------------------------------------------- *) + +let REAL_EXP_SERIES = prove + (`!x. ((\n. x pow n / &(FACT n)) real_sums exp x) (from 0)`, + GEN_TAC THEN REWRITE_TAC[REAL_SUMS_COMPLEX; o_DEF] THEN + MP_TAC(SPEC `Cx x` CEXP_CONVERGES) THEN + REWRITE_TAC[GSYM CX_EXP] THEN REWRITE_TAC[CX_DIV; CX_POW; CX_EXP]);; + +(* ------------------------------------------------------------------------- *) +(* Every single Taylor term is dominated by exp x for x >= 0 (a nonnegative *) +(* term of a convergent nonnegative series is at most the sum). *) +(* ------------------------------------------------------------------------- *) + +let REAL_EXP_MONOMIAL_LE = prove + (`!x k. &0 <= x ==> x pow k / &(FACT k) <= exp x`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\n. x pow n / &(FACT n)`; `from 0`; `{k:num}`] + REAL_PARTIAL_SUMS_LE_INFSUM_GEN) THEN + REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY; SING_SUBSET; IN_FROM; SUM_SING] THEN + REWRITE_TAC[LE_0] THEN ANTS_TAC THENL + [CONJ_TAC THENL + [REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_DIV THEN + ASM_SIMP_TAC[REAL_POW_LE; REAL_POS]; + REWRITE_TAC[real_summable] THEN EXISTS_TAC `exp x` THEN + REWRITE_TAC[REAL_EXP_SERIES]]; + MATCH_MP_TAC(REAL_ARITH `s = e ==> t <= s ==> t <= e`) THEN + MATCH_MP_TAC REAL_INFSUM_UNIQUE THEN REWRITE_TAC[REAL_EXP_SERIES]]);; + +(* ------------------------------------------------------------------------- *) +(* inv x -> 0 as x -> +inf (the elementary reciprocal decay). *) +(* ------------------------------------------------------------------------- *) + +let REALLIM_INV_AT_POSINFINITY = prove + (`((\x. inv x) ---> &0) at_posinfinity`, + REWRITE_TAC[REALLIM_COMPLEX; o_DEF; CX_INV; LIM_INV_X]);; + +(* ------------------------------------------------------------------------- *) +(* Abstract arithmetic reshaping used by the comparison bound: *) +(* p*x <= e*f, with x,e > 0 ==> p*inv e <= f*inv x. *) +(* ------------------------------------------------------------------------- *) + +let DECAY_ARITH = prove + (`!p x e f. &0 < x /\ &0 < e /\ p * x <= e * f ==> p * inv e <= f * inv x`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `~(e = &0) /\ ~(x = &0)` STRIP_ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_RCANCEL_IMP THEN EXISTS_TAC `e * x:real` THEN + CONJ_TAC THENL [MATCH_MP_TAC REAL_LT_MUL THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_FIELD `~(e = &0) /\ ~(x = &0) ==> + (p * inv e) * (e * x) = p * x /\ (f * inv x) * (e * x) = e * f`] THEN + ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Polynomial-over-exponential decay: x^n / exp x -> 0 as x -> +inf. *) +(* Comparison with (n+1)! * inv x, using x^(n+1)/(n+1)! <= exp x. *) +(* ------------------------------------------------------------------------- *) + +let POW_OVER_EXP_LIMIT = prove + (`!n. ((\x. x pow n / exp x) ---> &0) at_posinfinity`, + GEN_TAC THEN MATCH_MP_TAC REALLIM_NULL_COMPARISON THEN + EXISTS_TAC `\x. &(FACT(n+1)) * inv x` THEN CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_AT_POSINFINITY] THEN EXISTS_TAC `&1` THEN + X_GEN_TAC `x:real` THEN DISCH_TAC THEN + SUBGOAL_THEN `&0 < x` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `&0 < exp x` ASSUME_TAC THENL + [REWRITE_TAC[REAL_EXP_POS_LT]; ALL_TAC] THEN + REWRITE_TAC[real_div; REAL_ABS_MUL] THEN + ASM_SIMP_TAC[REAL_ABS_INV; real_abs; REAL_LT_IMP_LE; REAL_EXP_POS_LE; + REAL_POW_LE] THEN + MATCH_MP_TAC DECAY_ARITH THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`x:real`; `n+1`] REAL_EXP_MONOMIAL_LE) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_POW_ADD; REAL_POW_1] THEN + SUBGOAL_THEN `&0 < &(FACT(n+1))` ASSUME_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_LT; FACT_LT]; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ]; + REWRITE_TAC[GSYM REAL_MUL_LZERO] THEN MATCH_MP_TAC REALLIM_NULL_LMUL THEN + MP_TAC REALLIM_INV_AT_POSINFINITY THEN REWRITE_TAC[ETA_AX]]);; + +(* ------------------------------------------------------------------------- *) +(* Composed form: t^n exp(--t) -> 0 as t -> +inf. This is the exact input *) +(* for the bump: with t = 1/x, the m-th derivative of exp(-1/x) is *) +(* poly(1/x) exp(-1/x), and poly(t) exp(-t) -> 0 gives the C^inf gluing at 0.*) +(* ------------------------------------------------------------------------- *) + +let POW_TIMES_EXP_NEG_LIMIT = prove + (`!n. ((\t. t pow n * exp(--t)) ---> &0) at_posinfinity`, + GEN_TAC THEN MP_TAC(SPEC `n:num` POW_OVER_EXP_LIMIT) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN + ABS_TAC THEN REWRITE_TAC[REAL_EXP_NEG; real_div]);; + +(* ------------------------------------------------------------------------- *) +(* MASTER BOUND for the bump: exp(-1/t) <= N! t^N for every N and t > 0. *) +(* Directly from REAL_EXP_MONOMIAL_LE at x = 1/t: (1/t)^N/N! <= exp(1/t), so *) +(* exp(-1/t) = 1/exp(1/t) <= N! t^N. This single family of inequalities *) +(* squeezes ALL the junction limits at 0 (continuity of phi and every *) +(* derivative phi^(m) = P_m(1/x) exp(-1/x), which -> 0 since bounded by a *) +(* polynomial in 1/t times exp(-1/t) <= (that poly) * N! t^N -> 0). *) +(* ------------------------------------------------------------------------- *) + +let PHI_MASTER_BOUND = prove + (`!N t. &0 < t ==> exp(--(inv t)) <= &(FACT N) * t pow N`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`inv t:real`; `N:num`] REAL_EXP_MONOMIAL_LE) THEN + ASM_SIMP_TAC[REAL_LE_INV_EQ; REAL_LT_IMP_LE] THEN + REWRITE_TAC[REAL_EXP_NEG; REAL_POW_INV; real_div] THEN + SUBGOAL_THEN `&0 < exp(inv t)` ASSUME_TAC THENL + [REWRITE_TAC[REAL_EXP_POS_LT]; ALL_TAC] THEN + SUBGOAL_THEN `&0 < t pow N /\ &0 < &(FACT N)` STRIP_ASSUME_TAC THENL + [ASM_SIMP_TAC[REAL_POW_LT; REAL_OF_NUM_LT; FACT_LT]; ALL_TAC] THEN + DISCH_TAC THEN + SUBGOAL_THEN `inv(exp(inv t)) <= &(FACT N) * t pow N` MP_TAC THENL + [ALL_TAC; REWRITE_TAC[]] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `inv(inv(t pow N) * inv(&(FACT N)))` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[REAL_LT_INV_EQ]; + REWRITE_TAC[REAL_INV_MUL; REAL_INV_INV] THEN + MATCH_MP_TAC(REAL_ARITH `a = b ==> a <= b`) THEN + REWRITE_TAC[REAL_MUL_AC]]);; + +(* ------------------------------------------------------------------------- *) +(* Polynomial growth bound (t >= 1): for a real^1 polynomial p there are *) +(* C >= 0 and N with |p(lift t)| <= C t^N. Proved by induction on the *) +(* polynomial structure (coordinate/constant/sum/product); the sum and *) +(* product steps are factored out as separate lemmas. *) +(* ------------------------------------------------------------------------- *) + +let POLY_GROWTH_SUMCASE = prove + (`!(f:real^1->real) g C1 N1 C2 N2. + &0 <= C1 /\ (!t. &1 <= t ==> abs(f(lift t)) <= C1 * t pow N1) /\ + &0 <= C2 /\ (!t. &1 <= t ==> abs(g(lift t)) <= C2 * t pow N2) + ==> ?C N. &0 <= C /\ + !t. &1 <= t ==> abs(f(lift t) + g(lift t)) <= C * t pow N`, + REPEAT STRIP_TAC THEN + MAP_EVERY EXISTS_TAC [`C1 + C2:real`; `MAX N1 N2`] THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + X_GEN_TAC `t:real` THEN DISCH_TAC THEN + SUBGOAL_THEN `abs(f(lift t):real) <= C1 * t pow (MAX N1 N2) /\ + abs(g(lift t):real) <= C2 * t pow (MAX N1 N2)` + (fun th -> MP_TAC th THEN REAL_ARITH_TAC) THEN + CONJ_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THENL + [EXISTS_TAC `(C1:real) * t pow N1`; EXISTS_TAC `(C2:real) * t pow N2`] THEN + ASM_SIMP_TAC[] THEN MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_POW_MONO THEN ASM_REWRITE_TAC[] THEN ARITH_TAC);; + +let POLY_GROWTH_MULCASE = prove + (`!(f:real^1->real) g C1 N1 C2 N2. + &0 <= C1 /\ (!t. &1 <= t ==> abs(f(lift t)) <= C1 * t pow N1) /\ + &0 <= C2 /\ (!t. &1 <= t ==> abs(g(lift t)) <= C2 * t pow N2) + ==> ?C N. &0 <= C /\ + !t. &1 <= t ==> abs(f(lift t) * g(lift t)) <= C * t pow N`, + REPEAT STRIP_TAC THEN + MAP_EVERY EXISTS_TAC [`C1 * C2:real`; `N1 + N2:num`] THEN + CONJ_TAC THENL [MATCH_MP_TAC REAL_LE_MUL THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + X_GEN_TAC `t:real` THEN DISCH_TAC THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_POW_ADD] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(C1 * t pow N1) * (C2 * t pow N2):real` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_SIMP_TAC[REAL_ABS_POS]; + MATCH_MP_TAC(REAL_ARITH `a = b ==> a <= b`) THEN REAL_ARITH_TAC]);; + +let POLY_GROWTH_BOUND = prove + (`!p:real^1->real. real_polynomial_function p + ==> ?C N. &0 <= C /\ !t. &1 <= t ==> abs(p(lift t)) <= C * t pow N`, + MATCH_MP_TAC real_polynomial_function_INDUCT THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[DIMINDEX_1; FORALL_1; GSYM drop; LIFT_DROP] THEN + MAP_EVERY EXISTS_TAC [`&1`; `1`] THEN + REWRITE_TAC[REAL_POS; REAL_POW_1; REAL_MUL_LID] THEN + REPEAT STRIP_TAC THEN ASM_REAL_ARITH_TAC; + X_GEN_TAC `c:real` THEN MAP_EVERY EXISTS_TAC [`abs c`; `0`] THEN + REWRITE_TAC[REAL_ABS_POS; real_pow; REAL_MUL_RID; REAL_LE_REFL]; + MAP_EVERY X_GEN_TAC [`f:real^1->real`; `g:real^1->real`] THEN + REWRITE_TAC[] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `C1:real` (X_CHOOSE_THEN `N1:num` STRIP_ASSUME_TAC)) + (X_CHOOSE_THEN `C2:real` (X_CHOOSE_THEN `N2:num` STRIP_ASSUME_TAC))) THEN + MATCH_MP_TAC POLY_GROWTH_SUMCASE THEN + MAP_EVERY EXISTS_TAC [`C1:real`; `N1:num`; `C2:real`; `N2:num`] THEN + ASM_REWRITE_TAC[]; + MAP_EVERY X_GEN_TAC [`f:real^1->real`; `g:real^1->real`] THEN + REWRITE_TAC[] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `C1:real` (X_CHOOSE_THEN `N1:num` STRIP_ASSUME_TAC)) + (X_CHOOSE_THEN `C2:real` (X_CHOOSE_THEN `N2:num` STRIP_ASSUME_TAC))) THEN + MATCH_MP_TAC POLY_GROWTH_MULCASE THEN + MAP_EVERY EXISTS_TAC [`C1:real`; `N1:num`; `C2:real`; `N2:num`] THEN + ASM_REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* THE bump payoff at the level of decay: any polynomial times exp(--t) *) +(* tends to 0 at +inf. This controls poly(1/x) exp(-1/x) -> 0 as x -> 0+. *) +(* ------------------------------------------------------------------------- *) + +let POLY_TIMES_EXP_NEG_DECAY = prove + (`!p:real^1->real. real_polynomial_function p + ==> ((\t. p(lift t) * exp(--t)) ---> &0) at_posinfinity`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP POLY_GROWTH_BOUND) THEN + DISCH_THEN(X_CHOOSE_THEN `C:real` (X_CHOOSE_THEN + `N:num` STRIP_ASSUME_TAC)) THEN + MATCH_MP_TAC REALLIM_NULL_COMPARISON THEN + EXISTS_TAC `\t. C * (t pow N * exp(--t))` THEN CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_AT_POSINFINITY] THEN EXISTS_TAC `&1` THEN + X_GEN_TAC `t:real` THEN REWRITE_TAC[real_ge] THEN DISCH_TAC THEN + REWRITE_TAC[REAL_ABS_MUL] THEN + SUBGOAL_THEN `abs(exp(--t)) = exp(--t)` SUBST1_TAC THENL + [REWRITE_TAC[REAL_ABS_REFL; REAL_EXP_POS_LE]; ALL_TAC] THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN CONJ_TAC THENL + [ASM_SIMP_TAC[]; REWRITE_TAC[REAL_EXP_POS_LE]]; + REWRITE_TAC[GSYM REAL_MUL_LZERO] THEN MATCH_MP_TAC REALLIM_NULL_LMUL THEN + REWRITE_TAC[POW_TIMES_EXP_NEG_LIMIT]]);; + +(* ------------------------------------------------------------------------- *) +(* Decoupling "smooth compactly-supported ==> Schwartz". This is the clean *) +(* reusable lemma that reduces 284N to merely BUILDING a smooth bump: once *) +(* we *) +(* have a derivative chain all supported in a compact interval [-R,R], the *) +(* Schwartz decay bounds |x|^k |d m x| <= B are automatic. *) +(* ------------------------------------------------------------------------- *) + +(* A nonnegative continuous function that vanishes off [-R,R] is bounded. *) +let BOUNDED_SUPPORT_CONT = prove + (`!g:real->real R. + &0 <= R /\ g real_continuous_on real_interval[--R,R] /\ + (!x. abs(x) > R ==> g x = &0) /\ (!x. &0 <= g x) + ==> ?B. !x. g x <= B`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`g:real->real`; `real_interval[--R,R]`] + REAL_CONTINUOUS_ATTAINS_SUP) THEN + ASM_REWRITE_TAC[REAL_COMPACT_INTERVAL; REAL_INTERVAL_NE_EMPTY] THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `x0:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `max (g(x0:real)) (&0)` THEN X_GEN_TAC `x:real` THEN + ASM_CASES_TAC `abs(x) > R` THENL + [ASM_SIMP_TAC[] THEN REAL_ARITH_TAC; + FIRST_X_ASSUM(MP_TAC o SPEC `x:real`) THEN + ANTS_TAC THENL + [REWRITE_TAC[IN_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC; + REAL_ARITH_TAC]]);; + +(* The norm of a term in a has_vector_derivative chain is real-continuous. *) +let NORM_CONT_BRIDGE = prove + (`!(dm:real->complex) dm1 s. + (!x. ((\z. dm(drop z)) has_vector_derivative (dm1 x)) (at(lift x))) + ==> (\x. norm(dm x)) real_continuous_on s`, + REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_CONTINUOUS_ON; o_DEF] THEN + MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN + REWRITE_TAC[FORALL_IN_IMAGE] THEN X_GEN_TAC `x:real` THEN DISCH_TAC THEN + REWRITE_TAC[LIFT_DROP] THEN + MP_TAC(ISPECL [`at(lift x)`; `\z. (dm:real->complex)(drop z)`] + CONTINUOUS_LIFT_NORM_COMPOSE) THEN + REWRITE_TAC[o_DEF] THEN ANTS_TAC THENL + [MATCH_MP_TAC DIFFERENTIABLE_IMP_CONTINUOUS_AT THEN + ASM_MESON_TAC[HAS_VECTOR_DERIVATIVE_IMP_DIFFERENTIABLE]; + REWRITE_TAC[LIFT_DROP]]);; + +(* MAIN: a derivative chain (d n) with d n differentiable-via-drop and every *) +(* d m supported in [-R,R] gives schwartz(d 0). *) +let COMPACT_SUPPORT_SMOOTH_IMP_SCHWARTZ = prove + (`!d:num->real->complex. !R. + &0 <= R /\ + (!n x. ((\z. d n(drop z)) has_vector_derivative (d(SUC n) x))(at(lift x))) + /\ + (!m x. abs(x) > R ==> d m x = Cx(&0)) + ==> schwartz (d 0)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[schwartz] THEN + EXISTS_TAC `d:num->real->complex` THEN + ASM_REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`k:num`; `m:num`] THEN + MATCH_MP_TAC BOUNDED_SUPPORT_CONT THEN EXISTS_TAC `R:real` THEN + ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_ON_MUL THEN CONJ_TAC THENL + [MP_TAC(ISPECL [`\x:real. abs x`; `k:num`; `real_interval[--R,R]`] + REAL_CONTINUOUS_ON_POW) THEN + REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + MP_TAC(ISPECL [`\x:real. x`; `real_interval[--R,R]`] + REAL_CONTINUOUS_ON_ABS) THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_ID]; + MATCH_MP_TAC NORM_CONT_BRIDGE THEN + EXISTS_TAC `(d:num->real->complex)(SUC m)` THEN ASM_REWRITE_TAC[]]; + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(d:num->real->complex) m x = Cx(&0)` SUBST1_TAC THENL + [ASM_SIMP_TAC[]; REWRITE_TAC[COMPLEX_NORM_0; REAL_MUL_RZERO]]; + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_MUL THEN + SIMP_TAC[REAL_POW_LE; REAL_ABS_POS; NORM_POS_LE]]);; + +(* ------------------------------------------------------------------------- *) +(* Differential calculus of the bump phi(x) = exp(-1/x) on x > 0. *) +(* Its m-th derivative is P_m(1/x) exp(-1/x) with P_m a real polynomial, *) +(* obeying the recurrence P_{m+1}(u) = u^2 (P_m(u) - P_m'(u)). *) +(* ------------------------------------------------------------------------- *) + + +(* d/dx P(1/x) = -inv(x^2) P'(1/x) (chain rule through inv). *) +let BUMP_FACTOR1 = prove + (`!(P:real->real) P1 x. + &0 < x /\ (!y. (P has_real_derivative P1 y) (atreal y)) + ==> ((\x. P(inv x)) has_real_derivative (--(inv(x pow 2)) * P1(inv x))) + (atreal x)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `~(x = &0)` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `((P:real->real) o inv has_real_derivative (P1(inv x) * (--(inv(x pow 2))))) + (atreal x)` + MP_TAC THENL + [MATCH_MP_TAC REAL_DIFF_CHAIN_ATREAL THEN CONJ_TAC THENL + [MP_TAC(ISPECL [`\x:real. x`; `&1`; + `x:real`] HAS_REAL_DERIVATIVE_INV_ATREAL) THEN + ASM_REWRITE_TAC[HAS_REAL_DERIVATIVE_ID; ETA_AX] THEN + MATCH_MP_TAC RDERIV_EQ THEN + REWRITE_TAC[real_div; REAL_MUL_LID; REAL_MUL_LNEG] THEN AP_TERM_TAC THEN + REWRITE_TAC[REAL_INV_POW]; + ASM_REWRITE_TAC[]]; + REWRITE_TAC[o_DEF] THEN + MATCH_MP_TAC RDERIV_EQ THEN + REWRITE_TAC[REAL_MUL_SYM]]);; + +(* d/dx exp(-1/x) = exp(-1/x) inv(x^2). *) +let BUMP_FACTOR2 = prove + (`!x. &0 < x + ==> ((\x. exp(--(inv x))) has_real_derivative (exp(--(inv x)) * inv(x pow + 2))) + (atreal x)`, + REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN + POP_ASSUM MP_TAC THEN CONV_TAC REAL_FIELD);; + +(* The derivative recurrence: d/dx [P(1/x) exp(-1/x)] *) +(* = inv(x^2) (P(1/x) - P'(1/x)) exp(-1/x) on x > 0. *) +let BUMP_DERIV_STEP = prove + (`!(P:real->real) P1 x. + &0 < x /\ (!y. (P has_real_derivative P1 y) (atreal y)) + ==> ((\x. P(inv x) * exp(--(inv x))) has_real_derivative + (inv(x pow 2) * (P(inv x) - P1(inv x)) * exp(--(inv x)))) + (atreal x)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `~(x = &0)` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `((\x. (P:real->real)(inv x) * exp(--(inv x))) has_real_derivative + ((P(inv x)) * (exp(--(inv x)) * inv(x pow 2)) + + (--(inv(x pow 2)) * P1(inv x)) * exp(--(inv x)))) (atreal x)` + MP_TAC THENL + [MATCH_MP_TAC HAS_REAL_DERIVATIVE_MUL_ATREAL THEN CONJ_TAC THENL + [MP_TAC(ISPECL [`P:real->real`; `P1:real->real`; + `x:real`] BUMP_FACTOR1) THEN + ASM_REWRITE_TAC[]; + MP_TAC(ISPEC `x:real` BUMP_FACTOR2) THEN ASM_REWRITE_TAC[]]; + MATCH_MP_TAC RDERIV_EQ THEN + POP_ASSUM(K ALL_TAC) THEN POP_ASSUM MP_TAC THEN CONV_TAC REAL_FIELD]);; + +(* Bridge from a real derivative to the Cx-valued vector derivative in the *) +(* exact shape the schwartz / COMPACT_SUPPORT_SMOOTH_IMP_SCHWARTZ chain *) +(* wants: (g has_real_derivative g')(atreal x) lifts to (\z. Cx(g(drop z))) *) +(* has_vector_derivative (Cx g') (at(lift x)). *) +let CX_VECTOR_DERIV_BRIDGE = prove + (`!g:real->real. !g' x. + (g has_real_derivative g') (atreal x) + ==> ((\z. Cx(g(drop z))) has_vector_derivative (Cx g')) (at(lift x))`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o REWRITE_RULE[HAS_REAL_VECTOR_DERIVATIVE_AT]) THEN + REWRITE_TAC[has_vector_derivative] THEN + DISCH_THEN(MP_TAC o ISPEC `Cx(&1)` o MATCH_MP HAS_DERIVATIVE_VMUL_DROP) THEN + REWRITE_TAC[o_DEF; LIFT_DROP; DROP_CMUL; COMPLEX_CMUL; COMPLEX_MUL_RID] THEN + REWRITE_TAC[GSYM COMPLEX_CMUL] THEN + MATCH_MP_TAC(MESON[] `f = g /\ a = b + ==> (f has_derivative a) net ==> (g has_derivative b) net`) THEN + CONJ_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + REWRITE_TAC[COMPLEX_CMUL; COMPLEX_MUL_RID; GSYM CX_MUL] THEN + REWRITE_TAC[REAL_MUL_SYM]);; + +(* ------------------------------------------------------------------------- *) +(* The junction limit: for any polynomial Q, Q(1/x) exp(-1/x) -> 0 as x->0+. *) +(* This is the analytic heart of gluing phi at 0 (continuity and every *) +(* derivative limit reduce to this via the recurrence). *) +(* ------------------------------------------------------------------------- *) + +(* Regroup helper (abstract, so REAL_RING applies to plain vars). *) +let REGROUP = prove + (`!c a ff b x:real. a * b = x ==> (c * a) * (ff * b) = (c * ff) * x`, + REPEAT GEN_TAC THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + MP_TAC(REAL_RING `!c a ff b:real. (c * a) * (ff * b) = (c * ff) * (a * b)`) + THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]));; + +(* The pointwise squeeze bound on 0 < x < 1: |Q(1/x) exp(-1/x)| <= C(K+1)! *) +(* x. *) +let JUNCTION_ARITH = prove + (`!(Q:real->real) C K x. + &0 <= C /\ (!t. &1 <= t ==> abs((\z:real^1. Q(drop z))(lift t)) <= C * t + pow K) /\ + &0 < x /\ x < &1 /\ &1 <= inv x + ==> abs(Q(inv x) * exp(--(inv x))) <= (C * &(FACT(K+1))) * x`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `inv(x:real)` o check(fun th -> is_forall(concl + th))) THEN + ASM_REWRITE_TAC[LIFT_DROP] THEN DISCH_TAC THEN + SUBGOAL_THEN `abs(exp(--(inv x))) = exp(--(inv x))` ASSUME_TAC THENL + [REWRITE_TAC[REAL_ABS_REFL; REAL_EXP_POS_LE]; ALL_TAC] THEN + REWRITE_TAC[REAL_ABS_MUL] THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(C * inv x pow K) * exp(--(inv x))` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_RMUL THEN + ASM_REWRITE_TAC[REAL_EXP_POS_LE]; ALL_TAC] THEN + MP_TAC(ISPECL [`K+1`; `x:real`] PHI_MASTER_BOUND) THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN + TRANS_TAC REAL_LE_TRANS `(C * inv x pow K) * (&(FACT(K+1)) * x pow (K+1))` + THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_MUL THEN + ASM_SIMP_TAC[REAL_POW_LE; REAL_LE_INV_EQ; REAL_LT_IMP_LE]; + MATCH_MP_TAC(REAL_ARITH `a = b ==> a <= b`) THEN + MATCH_MP_TAC REGROUP THEN + REWRITE_TAC[REAL_POW_ADD; REAL_POW_1; REAL_POW_INV] THEN + MATCH_MP_TAC(REAL_FIELD `~(x = &0) ==> inv(x pow K) * (x pow K * x) = x`) + THEN + ASM_REAL_ARITH_TAC]);; + +(* Linear limit helper: (\x. c x) -> 0 as x -> 0 within any set. *) +let LIN_LIMIT_0 = prove + (`!c s. ((\x:real. c * x) ---> &0) (atreal(&0) within s)`, + REPEAT GEN_TAC THEN + MP_TAC(REWRITE_RULE[] + (ISPECL [`atreal(&0) within s`; `\x:real. x`; + `c:real`] REALLIM_NULL_LMUL)) THEN + DISCH_THEN MATCH_MP_TAC THEN + MATCH_MP_TAC REALLIM_ATREAL_WITHINREAL THEN + REWRITE_TAC[REALLIM_ATREAL_ID]);; + +let JUNCTION_LIMIT = prove + (`!Q:real->real. real_polynomial_function (\z:real^1. Q(drop z)) + ==> ((\x. Q(inv x) * exp(--(inv x))) ---> &0) + (atreal(&0) within {x | &0 < x})`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP POLY_GROWTH_BOUND) THEN + DISCH_THEN(X_CHOOSE_THEN `C:real` (X_CHOOSE_THEN + `K:num` STRIP_ASSUME_TAC)) THEN + MATCH_MP_TAC REALLIM_NULL_COMPARISON THEN + EXISTS_TAC `\x:real. (C * &(FACT(K+1))) * x` THEN CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_WITHINREAL] THEN EXISTS_TAC `&1` THEN + REWRITE_TAC[REAL_LT_01; IN_ELIM_THM] THEN + X_GEN_TAC `x:real` THEN STRIP_TAC THEN BETA_TAC THEN + MP_TAC(ISPECL [`Q:real->real`; `C:real`; `K:num`; + `x:real`] JUNCTION_ARITH) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_INV_1_LE THEN ASM_REAL_ARITH_TAC; + DISCH_THEN ACCEPT_TAC]; + REWRITE_TAC[LIN_LIMIT_0]]);; + +(* ------------------------------------------------------------------------- *) +(* The bump-generating function phi(x) = exp(-1/x) for x > 0, else 0, and *) +(* the *) +(* predicate bumpP characterising the members of its derivative chain: each *) +(* is Cx(Q(1/x) exp(-1/x)) on x>0 and Cx 0 on x<=0 for some real polynomial *) +(* Q. *) +(* ------------------------------------------------------------------------- *) + +let cphi = new_definition + `cphi (x:real) = if &0 < x then Cx(exp(--(inv x))) else Cx(&0)`;; + +let bumpP = new_definition + `bumpP (f:real->complex) <=> + ?Q:real->real. real_polynomial_function (\z:real^1. Q(drop z)) /\ + (!x. &0 < x ==> f x = Cx(Q(inv x) * exp(--(inv x)))) /\ + (!x. x <= &0 ==> f x = Cx(&0))`;; + +(* Derivative-chain glue at a point: vector-derivative on two sets covering *) +(* the line gives the derivative at the point. *) +let HAS_VDERIV_GLUE = prove + (`!f:real^1->real^N f' a s t. + (f has_vector_derivative f') (at a within s) /\ + (f has_vector_derivative f') (at a within t) /\ + s UNION t = (:real^1) + ==> (f has_vector_derivative f') (at a)`, + REPEAT GEN_TAC THEN REWRITE_TAC[has_vector_derivative] THEN + REWRITE_TAC[has_derivative_within; has_derivative_at] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC LIM_UNION_UNIV THEN + MAP_EVERY EXISTS_TAC [`s:real^1->bool`; `t:real^1->bool`] THEN + ASM_REWRITE_TAC[]);; + +(* Left half-line: on {drop z <= 0}, a bumpP function is identically 0, so *) +(* its derivative there is 0. *) +let JUNCTION_LEFT = prove + (`!f:real->complex. bumpP f + ==> ((\z. f(drop z)) has_vector_derivative (Cx(&0))) + (at(lift(&0)) within {z | drop z <= &0})`, + REWRITE_TAC[bumpP] THEN REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[GSYM COMPLEX_VEC_0] THEN + MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_TRANSFORM_WITHIN THEN + MAP_EVERY EXISTS_TAC [`\z:real^1. vec 0:complex`; `&1`] THEN + REWRITE_TAC[REAL_LT_01; IN_ELIM_THM; LIFT_DROP; DROP_VEC] THEN + REPEAT CONJ_TAC THENL + [REAL_ARITH_TAC; + X_GEN_TAC `z:real^1` THEN STRIP_TAC THEN CONV_TAC SYM_CONV THEN + REWRITE_TAC[COMPLEX_VEC_0] THEN ASM_MESON_TAC[]; + REWRITE_TAC[HAS_VECTOR_DERIVATIVE_CONST]]);; + +(* Right half-line derivative at 0. The difference quotient inv(drop y) % *) +(* f(drop y) equals Cx((1/x) Q(1/x) exp(-1/x)) = Cx(R(1/x) exp(-1/x)) with *) +(* R(u)=u Q(u), which -> 0 by JUNCTION_LIMIT. *) + +(* drop is a real polynomial function (as a real^1->real map). *) +let RPF_DROP = prove + (`real_polynomial_function (drop:real^1->real)`, + SUBGOAL_THEN `drop = \z:real^1. z$1` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; drop]; ALL_TAC] THEN + SIMP_TAC[real_polynomial_function_RULES; DIMINDEX_1; LE_REFL]);; + +(* {drop z >= 0} minus the origin is exactly the (lifted) open right *) +(* half-line. *) +let HALFLINE_DELETE = prove + (`{z:real^1 | &0 <= drop z} DELETE lift(&0) = IMAGE lift {x | &0 < x}`, + REWRITE_TAC[EXTENSION; IN_DELETE; IN_ELIM_THM; IN_IMAGE] THEN + X_GEN_TAC `z:real^1` THEN + REWRITE_TAC[GSYM DROP_EQ; LIFT_DROP] THEN + EQ_TAC THENL + [STRIP_TAC THEN EXISTS_TAC `drop z` THEN + ASM_REWRITE_TAC[LIFT_DROP] THEN ASM_REAL_ARITH_TAC; + STRIP_TAC THEN ASM_REWRITE_TAC[LIFT_DROP] THEN ASM_REAL_ARITH_TAC]);; + +(* On the right half-line the transformed quotient agrees with *) +(* Cx(R(1/x)e^..). *) +let JUNCTION_RIGHT_AGREE = prove + (`!(f:real->complex) Q x'. + (!x. &0 < x ==> f x = Cx(Q(inv x) * exp(--(inv x)))) /\ + x' IN {z | &0 <= drop z} /\ &0 < dist(x',lift(&0)) /\ dist(x',lift(&0)) < + &1 + ==> Cx (inv (drop x') * Q (inv (drop x')) * exp (--inv (drop x'))) = + inv (drop (x' - lift (&0))) % f (drop x')`, + REWRITE_TAC[IN_ELIM_THM; DIST_REAL; GSYM drop; LIFT_DROP; DROP_VEC] THEN + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&0 < drop x'` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[] THEN + REWRITE_TAC[DROP_SUB; LIFT_DROP; DROP_VEC; REAL_SUB_RZERO] THEN + REWRITE_TAC[COMPLEX_CMUL; GSYM CX_MUL; REAL_MUL_ASSOC]);; + +(* The transformed quotient -> Cx 0 (JUNCTION_LIMIT on R(u)=u Q(u), bridged *) +(* complex<->real via REALLIM_COMPLEX and net-lifted via *) +(* LIM_WITHINREAL_WITHIN; the closed half-line reduces to the open one by *) +(* LIM_WITHIN_DELETE). *) +let JUNCTION_RIGHT_LIMIT = prove + (`!Q:real->real. real_polynomial_function (\z:real^1. Q(drop z)) + ==> ((\y. Cx(inv(drop y) * Q(inv(drop y)) * exp(--(inv(drop y))))) --> + Cx(&0)) + (at(lift(&0)) within {z | &0 <= drop z})`, + REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[GSYM LIM_WITHIN_DELETE] THEN + REWRITE_TAC[HALFLINE_DELETE] THEN + MP_TAC(ISPEC `\u:real. u * Q u` JUNCTION_LIMIT) THEN + ANTS_TAC THENL + [REWRITE_TAC[] THEN MATCH_MP_TAC REAL_POLYNOMIAL_FUNCTION_MUL THEN + ASM_REWRITE_TAC[RPF_DROP]; + ALL_TAC] THEN + REWRITE_TAC[REALLIM_COMPLEX; o_DEF; REALLIM_WITHINREAL_WITHIN; + LIM_WITHINREAL_WITHIN] THEN + REWRITE_TAC[o_DEF; REAL_MUL_ASSOC]);; + +let JUNCTION_RIGHT = prove + (`!f:real->complex. bumpP f + ==> ((\z. f(drop z)) has_vector_derivative (Cx(&0))) + (at(lift(&0)) within {z | &0 <= drop z})`, + REWRITE_TAC[bumpP] THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[HAS_VECTOR_DERIVATIVE_WITHIN_1D] THEN + REWRITE_TAC[LIFT_DROP; DROP_VEC; VECTOR_SUB_RZERO] THEN + SUBGOAL_THEN `(f:real->complex)(&0) = Cx(&0)` SUBST1_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[COMPLEX_SUB_RZERO] THEN + MATCH_MP_TAC LIM_TRANSFORM_WITHIN THEN + EXISTS_TAC `\y:real^1. Cx(inv(drop y) * (Q(inv(drop y)) * exp(--(inv(drop + y)))))` THEN + EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_LT_01] THEN CONJ_TAC THENL + [REPEAT STRIP_TAC THEN MATCH_MP_TAC JUNCTION_RIGHT_AGREE THEN + ASM_REWRITE_TAC[]; + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN + MATCH_MP_TAC JUNCTION_RIGHT_LIMIT THEN ASM_REWRITE_TAC[]]);; + +(* phi and every derivative-chain member is differentiable at 0 with deriv *) +(* 0. *) +let JUNCTION_DIFF = prove + (`!f:real->complex. bumpP f + ==> ((\z. f(drop z)) has_vector_derivative (Cx(&0))) (at(lift(&0)))`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_VDERIV_GLUE THEN + MAP_EVERY EXISTS_TAC [`{z:real^1 | drop z <= &0}`; + `{z:real^1 | &0 <= drop z}`] THEN + ASM_SIMP_TAC[JUNCTION_LEFT; JUNCTION_RIGHT] THEN + REWRITE_TAC[EXTENSION; IN_UNION; IN_ELIM_THM; IN_UNIV] THEN + REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* The derivative chain: assembling the pieces. On x>0 the derivative is *) +(* the next bump-polynomial form; on x<0 it is 0; at x=0 it is 0 (JUNCTION_ *) +(* DIFF). This gives the inductive step BUMP_STEP for building the whole *) +(* chain of derivatives. *) +(* ------------------------------------------------------------------------- *) + +(* x>0 derivative of the raw form Cx(Q(1/.)e^{-1/.}). *) +let BUMP_DERIV_POS_CORE = prove + (`!(Q:real->real) Q1 x. + (!y. (Q has_real_derivative Q1 y) (atreal y)) /\ &0 < x + ==> ((\z. Cx(Q(inv(drop z)) * exp(--(inv(drop z))))) has_vector_derivative + (Cx(inv(x pow 2) * (Q(inv x) - Q1(inv x)) * exp(--(inv x))))) + (at(lift x))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\w. Q(inv w) * exp(--(inv w))`; + `inv(x pow 2) * (Q(inv x) - Q1(inv x)) * exp(--(inv x))`; + `x:real`] + CX_VECTOR_DERIV_BRIDGE) THEN + REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + MP_TAC(ISPECL [`Q:real->real`; `Q1:real->real`; + `x:real`] BUMP_DERIV_STEP) THEN + ASM_REWRITE_TAC[]);; + +(* x>0 derivative of f (transformed to the raw form near x). *) +let BUMP_DERIV_POS = prove + (`!(f:real->complex) Q Q1 x. + (!x. &0 < x ==> f x = Cx(Q(inv x) * exp(--(inv x)))) /\ + (!y. (Q has_real_derivative Q1 y) (atreal y)) /\ &0 < x + ==> ((\z. f(drop z)) has_vector_derivative + (Cx(inv(x pow 2) * (Q(inv x) - Q1(inv x)) * exp(--(inv x))))) + (at(lift x))`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_TRANSFORM_AT THEN + EXISTS_TAC `\z. Cx(Q(inv(drop z)) * exp(--(inv(drop z))))` THEN + EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [X_GEN_TAC `z:real^1` THEN REWRITE_TAC[DIST_REAL; GSYM drop; LIFT_DROP] THEN + DISCH_TAC THEN CONV_TAC SYM_CONV THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REAL_ARITH_TAC; + MATCH_MP_TAC BUMP_DERIV_POS_CORE THEN ASM_REWRITE_TAC[]]);; + +(* x<0 derivative of f (identically 0 near x). *) +let BUMP_DERIV_NEG = prove + (`!(f:real->complex) x. + (!y. y <= &0 ==> f y = Cx(&0)) /\ x < &0 + ==> ((\z. f(drop z)) has_vector_derivative (Cx(&0))) (at(lift x))`, + REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[GSYM COMPLEX_VEC_0] THEN + MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_TRANSFORM_AT THEN + EXISTS_TAC `\z:real^1. vec 0:complex` THEN + EXISTS_TAC `--x:real` THEN + ASM_REWRITE_TAC[HAS_VECTOR_DERIVATIVE_CONST] THEN CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; + X_GEN_TAC `z:real^1` THEN REWRITE_TAC[DIST_REAL; GSYM drop; LIFT_DROP] THEN + DISCH_TAC THEN CONV_TAC SYM_CONV THEN REWRITE_TAC[COMPLEX_VEC_0] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC]);; + +(* Full-line derivative into the next bump member (the if-form). *) +let BUMP_DERIV_ALL = prove + (`!(f:real->complex) Q Q1 x. + (!x. &0 < x ==> f x = Cx(Q(inv x) * exp(--(inv x)))) /\ + (!x. x <= &0 ==> f x = Cx(&0)) /\ + (!y. (Q has_real_derivative Q1 y) (atreal y)) /\ + real_polynomial_function (\z:real^1. Q(drop z)) + ==> ((\z. f(drop z)) has_vector_derivative + (if &0 < x + then Cx((inv x pow 2 * (Q(inv x) - Q1(inv x))) * exp(--(inv x))) + else Cx(&0))) + (at(lift x))`, + REPEAT STRIP_TAC THEN + DISJ_CASES_TAC(REAL_ARITH `x < &0 \/ x = &0 \/ &0 < x`) THENL + [SUBGOAL_THEN `~(&0 < x)` (fun th -> REWRITE_TAC[th]) THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC BUMP_DERIV_NEG THEN ASM_REWRITE_TAC[]; + FIRST_X_ASSUM DISJ_CASES_TAC THENL + [ASM_REWRITE_TAC[REAL_LT_REFL] THEN + MATCH_MP_TAC JUNCTION_DIFF THEN REWRITE_TAC[bumpP] THEN + EXISTS_TAC `Q:real->real` THEN ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `(Cx((inv x pow 2 * (Q(inv x) - Q1(inv x))) * exp(--(inv x)))):complex = + Cx(inv(x pow 2) * (Q(inv x) - Q1(inv x)) * exp(--(inv x)))` + SUBST1_TAC THENL + [AP_TERM_TAC THEN REWRITE_TAC[REAL_INV_POW] THEN REAL_ARITH_TAC; + MATCH_MP_TAC BUMP_DERIV_POS THEN ASM_REWRITE_TAC[]]]]);; + +(* THE inductive step: a bumpP function has a bumpP derivative-successor. *) +let BUMP_STEP = prove + (`!f:real->complex. bumpP f + ==> ?g. bumpP g /\ + (!x. ((\z. f(drop z)) has_vector_derivative (g x)) (at(lift x)))`, + REWRITE_TAC[bumpP] THEN REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP REAL_POLY_DERIVATIVE) THEN + DISCH_THEN(X_CHOOSE_THEN `Q1c:real^1->real` STRIP_ASSUME_TAC) THEN + ABBREV_TAC `Q1 = \u:real. (Q1c:real^1->real)(lift u)` THEN + SUBGOAL_THEN `!y. ((Q:real->real) has_real_derivative (Q1 y)) (atreal y)` + ASSUME_TAC THENL + [X_GEN_TAC `y:real` THEN EXPAND_TAC "Q1" THEN REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `y:real` o check(fun th -> is_forall(concl + th))) THEN + REWRITE_TAC[o_DEF; LIFT_DROP; ETA_AX]; + ALL_TAC] THEN + SUBGOAL_THEN + `real_polynomial_function (\z:real^1. Q1 (drop z))` ASSUME_TAC THENL + [EXPAND_TAC "Q1" THEN REWRITE_TAC[LIFT_DROP; ETA_AX] THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + EXISTS_TAC + `\x. if &0 < x + then Cx((inv x pow 2 * (Q(inv x) - Q1(inv x))) * exp(--(inv x))) + else Cx(&0)` THEN + CONJ_TAC THENL + [EXISTS_TAC `\u:real. u pow 2 * (Q u - Q1 u)` THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_POLYNOMIAL_FUNCTION_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_POLYNOMIAL_FUNCTION_POW THEN REWRITE_TAC[RPF_DROP]; + MATCH_MP_TAC REAL_POLYNOMIAL_FUNCTION_SUB THEN ASM_REWRITE_TAC[]]; + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[] THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[] THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC]; + GEN_TAC THEN REWRITE_TAC[] THEN + MATCH_MP_TAC BUMP_DERIV_ALL THEN ASM_REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* The full C^inf-ness of phi: cphi is a bumpP function (base case), and a *) +(* whole derivative chain d exists with d 0 = cphi and (d n)' = d(SUC n). *) +(* ------------------------------------------------------------------------- *) + +let BUMPP_CPHI = prove + (`bumpP cphi`, + REWRITE_TAC[bumpP; cphi] THEN EXISTS_TAC `\u:real. &1` THEN + REWRITE_TAC[REAL_MUL_LID] THEN REPEAT CONJ_TAC THENL + [SIMP_TAC[real_polynomial_function_RULES]; + GEN_TAC THEN DISCH_TAC THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + GEN_TAC THEN DISCH_TAC THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC]);; + +let BUMP_CHAIN = prove + (`?d:num->real->complex. + d 0 = cphi /\ + (!n. bumpP (d n)) /\ + (!n x. ((\z. d n (drop z)) has_vector_derivative (d(SUC n) x)) (at(lift + x)))`, + MP_TAC(ISPECL + [`\(n:num) (f:real->complex). bumpP f`; + `\(n:num) (f:real->complex) (g:real->complex). + !x. ((\z. f(drop z)) has_vector_derivative (g x)) (at(lift x))`; + `cphi`] DEPENDENT_CHOICE_FIXED) THEN + REWRITE_TAC[BUMPP_CPHI] THEN ANTS_TAC THENL + [REPEAT GEN_TAC THEN REWRITE_TAC[] THEN + DISCH_THEN(fun th -> MATCH_MP_TAC BUMP_STEP THEN ACCEPT_TAC th); + REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Toward a compactly-supported bump psi = phi(1+.) phi(1-.): the product *) +(* derivative infrastructure (single product rule + VSUM derivative), for *) +(* the *) +(* Leibniz chain of the product of two smooth (chained) functions. *) +(* ------------------------------------------------------------------------- *) + +(* Product rule for two complex chains at a point. *) +let CMUL_DERIV = prove + (`!(a:real->complex) b a' b' x. + ((\z. a(drop z)) has_vector_derivative a') (at(lift x)) /\ + ((\z. b(drop z)) has_vector_derivative b') (at(lift x)) + ==> ((\z. a(drop z) * b(drop z)) has_vector_derivative + (a(x) * b' + a' * b(x))) (at(lift x))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`( * ):complex->complex->complex`; `\z. (a:real->complex)(drop z)`; + `\z. (b:real->complex)(drop z)`; `a':complex`; `b':complex`; `lift x`] + HAS_VECTOR_DERIVATIVE_BILINEAR_AT) THEN + REWRITE_TAC[BILINEAR_COMPLEX_MUL; LIFT_DROP] THEN ASM_REWRITE_TAC[]);; + +(* Vector derivative of a finite sum of complex chains. *) +let HAS_VDERIV_VSUM = prove + (`!s. FINITE s ==> !(f:num->real^1->complex) f' x. + (!i. i IN s ==> ((f i) has_vector_derivative (f' i)) (at x)) + ==> ((\z. vsum s (\i. f i z)) has_vector_derivative (vsum s f')) (at x)`, + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[VSUM_CLAUSES] THEN CONJ_TAC THENL + [REPEAT STRIP_TAC THEN + REWRITE_TAC[GSYM COMPLEX_VEC_0; HAS_VECTOR_DERIVATIVE_CONST]; + MAP_EVERY X_GEN_TAC [`a:num`; `t:num->bool`] THEN STRIP_TAC THEN + MAP_EVERY X_GEN_TAC [`f:num->real^1->complex`; `f':num->complex`; + `x:real^1`] THEN + DISCH_TAC THEN MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_ADD THEN CONJ_TAC THENL + [REWRITE_TAC[ETA_AX] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[IN_INSERT]; + FIRST_X_ASSUM MATCH_MP_TAC THEN GEN_TAC THEN DISCH_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[IN_INSERT]]]);; + +(* ------------------------------------------------------------------------- *) +(* Binomial / vsum algebra for the Leibniz rule: shift, Pascal peel, and the *) +(* key Pascal-combination identity *) +(* sum_{0..n} binom(n,k) B k + sum_{0..n} binom(n,k) B(SUC k) *) +(* = sum_{0..SUC n} binom(SUC n,k) B k. *) +(* ------------------------------------------------------------------------- *) + +let VSUM_SHIFT_SUC = prove + (`!(g:num->complex) n. vsum(0..n)(\k. g(SUC k)) = vsum(1..SUC n) g`, + GEN_TAC THEN INDUCT_TAC THEN + ASM_SIMP_TAC[VSUM_CLAUSES_NUMSEG; LE_0; + ARITH_RULE `1 <= SUC n`; ARITH_RULE `1 <= SUC(SUC n)`] THEN + REWRITE_TAC[ARITH] THEN VECTOR_ARITH_TAC);; + +let PEEL_PASCAL = prove + (`!(C:num->complex) n. + vsum(0..SUC n)(\k. Cx(&(binom(SUC n,k))) * C k) = + C 0 + vsum(0..n)(\k. Cx(&(binom(n,SUC k)) + &(binom(n,k))) * C(SUC k))`, + REPEAT GEN_TAC THEN + ASM_SIMP_TAC[VSUM_CLAUSES_LEFT; ARITH_RULE `0 <= SUC n`] THEN + REWRITE_TAC[ADD_CLAUSES; binom; COMPLEX_MUL_LID] THEN AP_TERM_TAC THEN + MP_TAC(ISPECL [`\k. Cx(&(binom(SUC n,k))) * (C:num->complex) k`; `n:num`] + VSUM_SHIFT_SUC) THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC VSUM_EQ_NUMSEG THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN + REWRITE_TAC[binom; GSYM CX_ADD; GSYM REAL_OF_NUM_ADD] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + ARITH_TAC);; + +let PEEL_N = prove + (`!(B:num->complex) n. + vsum(0..n)(\k. Cx(&(binom(n,k))) * B k) = + B 0 + vsum(0..n)(\k. Cx(&(binom(n,SUC k))) * B(SUC k))`, + REPEAT GEN_TAC THEN + MP_TAC(REWRITE_RULE[](ISPECL [`\k. Cx(&(binom(n,k))) * (B:num->complex) k`; + `n:num`] + VSUM_SHIFT_SUC)) THEN + DISCH_THEN(fun th -> GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [th]) THEN + GEN_REWRITE_TAC (LAND_CONV) + [MATCH_MP VSUM_CLAUSES_LEFT (ARITH_RULE `0 <= n:num`)] THEN + REWRITE_TAC[VSUM_CLAUSES_NUMSEG; LE_0; ADD_CLAUSES] THEN + SUBGOAL_THEN `binom(n,SUC n) = 0` SUBST1_TAC THENL + [MATCH_MP_TAC BINOM_LT THEN ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[binom; COMPLEX_MUL_LID; COMPLEX_MUL_LZERO] THEN + REWRITE_TAC[GSYM COMPLEX_VEC_0; COMPLEX_ADD_RID] THEN + REWRITE_TAC[ARITH_RULE `1 <= SUC n`]);; + +let PASCAL_VSUM = prove + (`!(B:num->complex) n. + vsum(0..n)(\k. Cx(&(binom(n,k))) * B k) + + vsum(0..n)(\k. Cx(&(binom(n,k))) * B (SUC k)) = + vsum(0..SUC n)(\k. Cx(&(binom(SUC n,k))) * B k)`, + REPEAT GEN_TAC THEN GEN_REWRITE_TAC RAND_CONV [PEEL_PASCAL] THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV) [PEEL_N] THEN + SUBGOAL_THEN + `vsum(0..n)(\k. Cx(&(binom(n,SUC k)) + &(binom(n,k))) * (B:num->complex)(SUC + k)) = + vsum(0..n)(\k. Cx(&(binom(n,SUC k))) * B(SUC k)) + + vsum(0..n)(\k. Cx(&(binom(n,k))) * B(SUC k))` + SUBST1_TAC THENL + [REWRITE_TAC[GSYM VSUM_ADD_NUMSEG] THEN MATCH_MP_TAC VSUM_EQ_NUMSEG THEN + REPEAT STRIP_TAC THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD; CX_ADD; COMPLEX_ADD_RDISTRIB]; + REWRITE_TAC[COMPLEX_ADD_AC]]);; + +(* ------------------------------------------------------------------------- *) +(* Leibniz rule: the product of two functions each carrying a full *) +(* derivative *) +(* chain again carries one, with n-th derivative the binomial sum. This is *) +(* Fremlin 284Bb (Schwartz closed under product), used to build the *) +(* compactly-supported bump psi = phi(1+.) phi(1-.). *) +(* ------------------------------------------------------------------------- *) + +(* A constant times a chain scales the derivative. *) +let CONST_CHAIN_DERIV = prove + (`!c (a:real->complex) a' x. + ((\z. a(drop z)) has_vector_derivative a') (at(lift x)) + ==> ((\z. c * a(drop z)) has_vector_derivative (c * a')) (at(lift x))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\u:real. c:complex`; `a:real->complex`; `Cx(&0)`; + `a':complex`; + `x:real`] CMUL_DERIV) THEN + ASM_REWRITE_TAC[HAS_VECTOR_DERIVATIVE_CONST; GSYM COMPLEX_VEC_0] THEN + REWRITE_TAC[COMPLEX_VEC_0; COMPLEX_MUL_LZERO; COMPLEX_ADD_RID]);; + +(* SUC(n-k) = SUC n - k inside the sum (valid for k <= n). *) +let SUM1EQ = prove + (`!(A:num->num->complex) n. + vsum(0..n)(\k. Cx(&(binom(n,k))) * A k (SUC(n-k))) = + vsum(0..n)(\k. Cx(&(binom(n,k))) * A k (SUC n - k))`, + REPEAT GEN_TAC THEN MATCH_MP_TAC VSUM_EQ_NUMSEG THEN + X_GEN_TAC `i:num` THEN STRIP_TAC THEN REWRITE_TAC[] THEN + ASM_SIMP_TAC[ARITH_RULE `i <= n ==> SUC(n - i) = SUC n - i`]);; + +(* Derivative of a single Leibniz term. *) +let LEIB_TERM = prove + (`!(d:num->real->complex) e n k x. + (!m y. ((\z. d m(drop z)) has_vector_derivative (d(SUC m) y))(at(lift y))) + /\ + (!m y. ((\z. e m(drop z)) has_vector_derivative (e(SUC m) y))(at(lift y))) + ==> ((\z. Cx(&(binom(n,k))) * d k (drop z) * e (n-k)(drop z)) + has_vector_derivative + (Cx(&(binom(n,k))) * (d k x * e(SUC(n-k)) x + d(SUC k) x * e(n-k) + x))) + (at(lift x))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC CONST_CHAIN_DERIV THEN + MP_TAC(ISPECL [`(d:num->real->complex) k`; `(e:num->real->complex)(n-k)`; + `(d:num->real->complex)(SUC k) x`; `(e:num->real->complex)(SUC(n-k)) x`; + `x:real`] + CMUL_DERIV) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC VDERIV_EQ THEN + CONV_TAC COMPLEX_RING);; + +(* The derivative-sum equals the SUC n Leibniz sum (SUM1EQ + PASCAL_VSUM). *) +let LEIB_VALEQ = prove + (`!(d:num->real->complex) e n x. + vsum(0..n)(\k. Cx(&(binom(n,k))) * + (d k x * e(SUC(n-k)) x + d(SUC k) x * e(n-k) x)) = + vsum(0..SUC n)(\k. Cx(&(binom(SUC n,k))) * d k x * e (SUC n-k) x)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[COMPLEX_ADD_LDISTRIB; VSUM_ADD_NUMSEG] THEN + MP_TAC(REWRITE_RULE[](ISPEC `\k j. (d:num->real->complex) k x * + (e:num->real->complex) j x` SUM1EQ)) THEN + DISCH_THEN(fun th -> ONCE_REWRITE_TAC[SPEC `n:num` th]) THEN + MP_TAC(ISPEC `\k. (d:num->real->complex) k x * (e:num->real->complex) (SUC n + - k) x` + PASCAL_VSUM) THEN + DISCH_THEN(MP_TAC o SPEC `n:num`) THEN REWRITE_TAC[] THEN + MATCH_MP_TAC(MESON[] `a = a' /\ b = b' /\ c = c' + ==> (a' + b' = c') ==> (a + b = c)`) THEN + REPEAT CONJ_TAC THEN MATCH_MP_TAC VSUM_EQ_NUMSEG THEN + X_GEN_TAC `k:num` THEN STRIP_TAC THEN REWRITE_TAC[COMPLEX_MUL_ASSOC] THEN + TRY(AP_THM_TAC THEN AP_TERM_TAC) THEN + REWRITE_TAC[GSYM COMPLEX_MUL_ASSOC] THEN + REPEAT AP_TERM_TAC THEN TRY AP_THM_TAC THEN TRY AP_TERM_TAC THEN + ASM_ARITH_TAC);; + +(* The Leibniz derivative step: (n-sum)' = (SUC n)-sum. *) +let LEIBNIZ_DERIV = prove + (`!(d:num->real->complex) e n x. + (!m y. ((\z. d m(drop z)) has_vector_derivative (d(SUC m) y))(at(lift y))) + /\ + (!m y. ((\z. e m(drop z)) has_vector_derivative (e(SUC m) y))(at(lift y))) + ==> ((\z. vsum(0..n)(\k. Cx(&(binom(n,k))) * d k (drop z) * e (n-k)(drop + z))) + has_vector_derivative + (vsum(0..SUC n)(\k. Cx(&(binom(SUC n,k))) * d k x * e (SUC n-k) x))) + (at(lift x))`, + REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[GSYM LEIB_VALEQ] THEN + MP_TAC(ISPEC `0..n` HAS_VDERIV_VSUM) THEN REWRITE_TAC[FINITE_NUMSEG] THEN + DISCH_THEN(MP_TAC o ISPECL + [`\k z. Cx(&(binom(n,k))) * (d:num->real->complex) k (drop z) * e (n-k)(drop + z)`; + `\k. Cx(&(binom(n,k))) * ((d:num->real->complex) k x * e(SUC(n-k)) x + + d(SUC k) x * e(n-k) x)`; + `lift x`]) THEN + BETA_TAC THEN DISCH_THEN MATCH_MP_TAC THEN + REWRITE_TAC[IN_NUMSEG] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC LEIB_TERM THEN ASM_REWRITE_TAC[]);; + +(* Product of two chains carries a chain. *) +let LEIBNIZ_CHAIN = prove + (`!(d:num->real->complex) e. + (!m y. ((\z. d m(drop z)) has_vector_derivative (d(SUC m) y))(at(lift y))) + /\ + (!m y. ((\z. e m(drop z)) has_vector_derivative (e(SUC m) y))(at(lift y))) + ==> ?p:num->real->complex. + (!x. p 0 x = d 0 x * e 0 x) /\ + (!n y. ((\z. p n(drop z)) has_vector_derivative (p(SUC n) + y))(at(lift y)))`, + REPEAT STRIP_TAC THEN + EXISTS_TAC `\n x. vsum(0..n)(\k. Cx(&(binom(n,k))) * (d:num->real->complex) k + x * e (n-k) x)` THEN + REWRITE_TAC[] THEN CONJ_TAC THENL + [GEN_TAC THEN + REWRITE_TAC[VSUM_CLAUSES_NUMSEG; SUB_0; binom; COMPLEX_MUL_LID]; + REPEAT GEN_TAC THEN MATCH_MP_TAC LEIBNIZ_DERIV THEN ASM_REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Affine reparametrisation of a chain: composing a chain d with x |-> c+s*x *) +(* yields the chain n |-> Cx s pow n * d n (c + s*x). Used to build chains *) +(* for cphi(1+x) (c=1,s=1) and cphi(1-x) (c=1,s=-1). *) +(* ------------------------------------------------------------------------- *) + +let AFFINE_DERIV = prove + (`!c s x. ((\z:real^1. lift(c + s * drop z)) has_vector_derivative (lift s)) + (at(lift x))`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN + `(\z:real^1. lift(c + s * drop z)) = (\z:real^1. lift c + s % z)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; LIFT_ADD; LIFT_CMUL; LIFT_DROP]; ALL_TAC] THEN + SUBGOAL_THEN `(lift s):real^1 = vec 0 + s % vec 1` SUBST1_TAC THENL + [REWRITE_TAC[GSYM DROP_EQ; DROP_ADD; DROP_VEC; DROP_CMUL; LIFT_DROP] THEN + REAL_ARITH_TAC; + MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_ADD THEN + REWRITE_TAC[HAS_VECTOR_DERIVATIVE_CONST] THEN + MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_CMUL THEN + REWRITE_TAC[HAS_VECTOR_DERIVATIVE_ID]]);; + +let AFFINE_CHAIN_STEP = prove + (`!(g:real->complex) g' c s x. + ((\z. g(drop z)) has_vector_derivative g') (at(lift(c + s * x))) + ==> ((\z. g(c + s * drop z)) has_vector_derivative (s % g')) (at(lift + x))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\z:real^1. lift(c + s * drop z)`; + `\w:real^1. (g:real->complex)(drop w)`; + `lift s`; `g':complex`; `lift x`] VECTOR_DIFF_CHAIN_AT) THEN + REWRITE_TAC[o_DEF; LIFT_DROP; DROP_CMUL] THEN + ASM_REWRITE_TAC[AFFINE_DERIV; LIFT_DROP]);; + +let AFFINE_CHAIN = prove + (`!(d:num->real->complex) c s. + (!m y. ((\z. d m(drop z)) has_vector_derivative (d(SUC m) y))(at(lift y))) + ==> (!m y. ((\z. (\n x. Cx s pow n * d n (c + s * x)) m (drop z)) + has_vector_derivative + ((\n x. Cx s pow n * d n (c + s * x)) (SUC m) y))(at(lift + y)))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN + MP_TAC(ISPECL [`\w. Cx s pow m * (d:num->real->complex) m w`; + `Cx s pow m * (d:num->real->complex)(SUC m)(c + s * y)`; `c:real`; + `s:real`; `y:real`] + AFFINE_CHAIN_STEP) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [MATCH_MP_TAC CONST_CHAIN_DERIV THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC VDERIV_EQ THEN + REWRITE_TAC[COMPLEX_CMUL; complex_pow] THEN CONV_TAC COMPLEX_RING]);; + +(* ------------------------------------------------------------------------- *) +(* The compactly-supported bump psi(x) = cphi(1+x) cphi(1-x) and its *) +(* Schwartz-ness. psi is supported in [-1,1], C^inf (Leibniz product of two *) +(* affine reparametrisations of the phi chain), hence Schwartz -- the first *) +(* concrete compactly-supported Schwartz function. *) +(* ------------------------------------------------------------------------- *) + +let PSI_CHAIN = prove + (`?p:num->real->complex. + (!x. p 0 x = cphi(&1 + x) * cphi(&1 - x)) /\ + (!n y. ((\z. p n(drop z)) has_vector_derivative (p(SUC n) y))(at(lift + y)))`, + MP_TAC BUMP_CHAIN THEN + DISCH_THEN(X_CHOOSE_THEN `d:num->real->complex` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`d:num->real->complex`; `&1`; `&1`] AFFINE_CHAIN) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`d:num->real->complex`; `&1`; `-- &1`] AFFINE_CHAIN) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`\n x. Cx(&1) pow n * (d:num->real->complex) n (&1 + &1 * x)`; + `\n x. Cx(-- &1) pow n * (d:num->real->complex) n (&1 + -- &1 + * x)`] + LEIBNIZ_CHAIN) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `p:num->real->complex` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `p:num->real->complex` THEN ASM_REWRITE_TAC[] THEN + GEN_TAC THEN FIRST_X_ASSUM(fun th -> REWRITE_TAC[th]) THEN + REWRITE_TAC[complex_pow; COMPLEX_MUL_LID] THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[REAL_MUL_LID; REAL_ARITH `&1 + -- &1 * x = &1 - x`]);; + +(* If a chain's base vanishes off [-R,R], the whole chain does (a derivative *) +(* of a locally-zero function is zero; VECTOR_DERIVATIVE_UNIQUE_AT). *) +let CHAIN_SUPPORT = prove + (`!(p:num->real->complex) R. + &0 <= R /\ (!x. R < abs x ==> p 0 x = Cx(&0)) /\ + (!n y. ((\z. p n(drop z)) has_vector_derivative (p(SUC n) y))(at(lift y))) + ==> !n x. R < abs x ==> p n x = Cx(&0)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `x:real` THEN DISCH_TAC THEN + MP_TAC(ISPECL + [`\z. (p:num->real->complex) n (drop z)`; `lift x`; + `(p:num->real->complex)(SUC n) x`; `Cx(&0)`] + VECTOR_DERIVATIVE_UNIQUE_AT) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + ONCE_REWRITE_TAC[GSYM COMPLEX_VEC_0] THEN + MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_TRANSFORM_AT THEN + EXISTS_TAC `\z:real^1. vec 0:complex` THEN EXISTS_TAC `abs x - R` THEN + ASM_REWRITE_TAC[HAS_VECTOR_DERIVATIVE_CONST] THEN CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; + X_GEN_TAC `z:real^1` THEN REWRITE_TAC[DIST_REAL; GSYM drop; LIFT_DROP] THEN + DISCH_TAC THEN CONV_TAC SYM_CONV THEN REWRITE_TAC[COMPLEX_VEC_0] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC]);; + +let SCHWARTZ_PSI = prove + (`schwartz (\x. cphi(&1 + x) * cphi(&1 - x))`, + MP_TAC PSI_CHAIN THEN + DISCH_THEN(X_CHOOSE_THEN `p:num->real->complex` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `(\x. cphi(&1 + x) * cphi(&1 - x)) = (p:num->real->complex) 0` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC COMPACT_SUPPORT_SMOOTH_IMP_SCHWARTZ THEN + EXISTS_TAC `&1` THEN REWRITE_TAC[REAL_POS] THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[real_gt] THEN + MP_TAC(ISPECL [`p:num->real->complex`; `&1`] CHAIN_SUPPORT) THEN + ASM_REWRITE_TAC[REAL_POS] THEN DISCH_THEN MATCH_MP_TAC THEN + X_GEN_TAC `x:real` THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[cphi] THEN + REPEAT COND_CASES_TAC THEN + ASM_REWRITE_TAC[COMPLEX_MUL_LZERO; COMPLEX_MUL_RZERO] THEN + ASM_REAL_ARITH_TAC);; + + +(* ========================================================================= *) +(* SECTION 8. Differentiation under the integral sign (Fremlin 123D). *) +(* *) +(* This supplies a differentiation-under-the-integral result not otherwise *) +(* available in the required form. It is built via the sequential Dominated *) +(* Theorem on difference quotients: *) +(* d/dy INT F(y,x) dx = INT dF/dy(y,x) dx *) +(* when dF/dy is dominated by an integrable function uniformly in y. *) +(* *) +(* This unlocks Fremlin 283Ch (transform of x f(x)) and thence 284C-Schwartz *) +(* (fhat is a rapidly decreasing test function) and Plancherel-on-Schwartz. *) +(* *) +(* Uses only the HOL Light analysis library. *) +(* ========================================================================= *) + +(* ------------------------------------------------------------------------- *) +(* Pointwise convergence of the difference quotient, from the derivative at *) +(* y0 and any sequence yy -> lift y0 avoiding lift y0. *) +(* ------------------------------------------------------------------------- *) + +let DQ_PTWISE = prove + (`!(g:real->complex) g' y0 yy. + ((\z. g(drop z)) has_vector_derivative g') (at(lift y0)) /\ + (!n. ~(yy n = lift y0)) /\ (yy --> lift y0) sequentially + ==> ((\n. inv(drop(yy n) - y0) % (g(drop(yy n)) - g y0)) --> g') + sequentially`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `yy:num->real^1` o + REWRITE_RULE[LIM_AT_SEQUENTIALLY; HAS_VECTOR_DERIVATIVE_AT_1D]) THEN + ASM_REWRITE_TAC[o_DEF; DROP_SUB; LIFT_DROP]);; + +(* ------------------------------------------------------------------------- *) +(* Increment bound from a globally bounded derivative (mean value). *) +(* ------------------------------------------------------------------------- *) + +let INCR_BOUND = prove + (`!(g:real->complex) g' B a b. + (!y. ((\z. g(drop z)) has_vector_derivative (g' y)) (at(lift y))) /\ + (!y. norm(g' y) <= B) + ==> norm(g a - g b) <= B * abs(a - b)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\z. (g:real->complex)(drop z)`; + `\z. (g':real->complex)(drop z)`; + `(:real^1)`; `B:real`] VECTOR_DIFFERENTIABLE_BOUND) THEN + REWRITE_TAC[CONVEX_UNIV; IN_UNIV] THEN ANTS_TAC THENL + [CONJ_TAC THENL + [X_GEN_TAC `w:real^1` THEN + MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_AT_WITHIN THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM LIFT_DROP] THEN + ASM_REWRITE_TAC[]; + GEN_TAC THEN ASM_REWRITE_TAC[]]; + DISCH_THEN(MP_TAC o ISPECL [`lift a`; `lift b`]) THEN + REWRITE_TAC[LIFT_DROP; GSYM LIFT_SUB; NORM_LIFT]]);; + +(* ------------------------------------------------------------------------- *) +(* Domination of the difference quotient by the dominator dm. *) +(* ------------------------------------------------------------------------- *) + +let DQ_DOMINATED = prove + (`!(ff:real->real->complex) gg dm y0 (yy:num->real^1) n (x:real). + (!y (x:real). ((\z. ff (drop z) x) has_vector_derivative (gg y x)) + (at(lift y))) /\ + (!y (x:real). norm(gg y x) <= dm x) /\ ~(yy n = lift y0) + ==> norm(inv(drop(yy n) - y0) % (ff (drop(yy n)) x - ff y0 x)) <= dm x`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `~(drop(yy(n:num)) - y0 = &0)` ASSUME_TAC THENL + [DISCH_TAC THEN UNDISCH_TAC `~((yy:num->real^1) n = lift y0)` THEN + REWRITE_TAC[GSYM DROP_EQ; LIFT_DROP] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPECL [`\t. (ff:real->real->complex) t x`; + `\y. (gg:real->real->complex) y x`; + `(dm:real->real)(x:real)`; `drop(yy(n:num))`; `y0:real`] INCR_BOUND) THEN + ANTS_TAC THENL [BETA_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + BETA_TAC THEN DISCH_TAC THEN + REWRITE_TAC[NORM_MUL; REAL_ABS_INV] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `inv(abs(drop(yy(n:num)) - y0)) * ((dm:real->real) x * + abs(drop(yy(n:num)) - y0))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN + ASM_REWRITE_TAC[REAL_LE_INV_EQ; REAL_ABS_POS]; + MATCH_MP_TAC REAL_EQ_IMP_LE THEN + ASM_SIMP_TAC[REAL_FIELD `~(d = &0) ==> inv(abs d) * (dmx * abs d) = + dmx`]]);; + +(* ------------------------------------------------------------------------- *) +(* The difference quotient of two integrals is the integral of the *) +(* difference *) +(* quotient (linearity). *) +(* ------------------------------------------------------------------------- *) + +let DQ_INTEGRAL = prove + (`!(ff:real->real->complex) a b c. + (\x:real^1. ff a (drop x)) absolutely_integrable_on (:real^1) /\ + (\x:real^1. ff b (drop x)) absolutely_integrable_on (:real^1) + ==> c % (integral (:real^1) (\x. ff a (drop x)) - + integral (:real^1) (\x. ff b (drop x))) = + integral (:real^1) (\x. c % (ff a (drop x) - ff b (drop x)))`, + REPEAT STRIP_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[GSYM ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE]) THEN + ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE; + INTEGRAL_CMUL; INTEGRABLE_SUB; INTEGRAL_SUB]);; + +(* ------------------------------------------------------------------------- *) +(* The Dominated Convergence engine: the difference quotients of integrals *) +(* converge to the integral of the derivative, along any sequence yy->lift *) +(* y0. *) +(* ------------------------------------------------------------------------- *) + +let DCT_PART = prove + (`!(ff:real->real->complex) gg dm y0 (yy:num->real^1). + (!y (x:real). ((\z. ff (drop z) x) has_vector_derivative (gg y x)) + (at(lift y))) /\ + (!y. (\x:real^1. ff y (drop x)) absolutely_integrable_on (:real^1)) /\ + (\x:real^1. gg y0 (drop x)) absolutely_integrable_on (:real^1) /\ + (!y (x:real). norm(gg y x) <= dm x) /\ + (\x:real^1. lift(dm(drop x))) absolutely_integrable_on (:real^1) /\ + (!n. ~(yy n = lift y0)) /\ (yy --> lift y0) sequentially + ==> ((\n. integral (:real^1) + (\x. inv(drop(yy n) - y0) % (ff (drop(yy n)) (drop x) - ff y0 + (drop x)))) + --> integral (:real^1) (\x. gg y0 (drop x))) sequentially`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`\n x:real^1. inv(drop(yy(n:num)) - y0) % (ff (drop(yy n)) (drop x) - ff y0 + (drop x)):complex`; + `\x:real^1. (gg:real->real->complex) y0 (drop x)`; + `\x:real^1. lift(dm(drop x))`; `(:real^1)`] DOMINATED_CONVERGENCE) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC INTEGRABLE_CMUL THEN + MATCH_MP_TAC INTEGRABLE_SUB THEN + ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE]; + ASM_SIMP_TAC[ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE]; + REWRITE_TAC[LIFT_DROP] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC DQ_DOMINATED THEN + EXISTS_TAC `gg:real->real->complex` THEN ASM_REWRITE_TAC[]; + X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN + MP_TAC(BETA_RULE(ISPECL [`\t. (ff:real->real->complex) t (drop x)`; + `(gg:real->real->complex) y0 (drop x)`; `y0:real`; + `yy:num->real^1`] DQ_PTWISE)) THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]; + SIMP_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* DIFFERENTIATION UNDER THE INTEGRAL SIGN (Fremlin 123D). *) +(* If for each x the parameter-map t |-> ff t x is differentiable with *) +(* derivative gg y x, all ff y and gg y0 are integrable, and |gg y x| <= dm *) +(* x *) +(* with dm integrable (a uniform-in-y dominator), then *) +(* d/dy INT ff(y,x) dx |_{y0} = INT gg(y0,x) dx. *) +(* ------------------------------------------------------------------------- *) + +let DIFF_UNDER_INTEGRAL = prove + (`!(ff:real->real->complex) gg dm y0. + (!y (x:real). ((\z. ff (drop z) x) has_vector_derivative (gg y x)) + (at(lift y))) /\ + (!y. (\x:real^1. ff y (drop x)) absolutely_integrable_on (:real^1)) /\ + (\x:real^1. gg y0 (drop x)) absolutely_integrable_on (:real^1) /\ + (!y (x:real). norm(gg y x) <= dm x) /\ + (\x:real^1. lift(dm(drop x))) absolutely_integrable_on (:real^1) + ==> ((\z. integral (:real^1) (\x. ff (drop z) (drop x))) + has_vector_derivative + (integral (:real^1) (\x. gg y0 (drop x)))) (at(lift y0))`, + REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[HAS_VECTOR_DERIVATIVE_AT_1D] THEN + REWRITE_TAC[LIM_AT_SEQUENTIALLY] THEN + X_GEN_TAC `yy:num->real^1` THEN STRIP_TAC THEN REWRITE_TAC[o_DEF] THEN + SUBGOAL_THEN + `!n. inv(drop(yy(n:num) - lift y0)) % + (integral (:real^1) (\x. ff (drop(yy n)) (drop x)) - + integral (:real^1) (\x. ff (drop(lift y0)) (drop x))) = + integral (:real^1) (\x. inv(drop(yy n) - y0) % + (ff (drop(yy n)) (drop x) - ff y0 (drop x)))` + (fun th -> REWRITE_TAC[th]) THENL + [GEN_TAC THEN REWRITE_TAC[DROP_SUB; LIFT_DROP] THEN + MATCH_MP_TAC DQ_INTEGRAL THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC DCT_PART THEN + EXISTS_TAC `dm:real->real` THEN ASM_REWRITE_TAC[]]);; + + +(* ========================================================================= *) +(* SECTION 9. Fremlin 283Ch: differentiating the transform. *) +(* (fourier f)'(y) = -i * fourier (x |-> x f(x)) (y) *) +(* whenever f and x f(x) are (absolutely) integrable. This is the first *) +(* application of DIFF_UNDER_INTEGRAL (proved above), and the key input *) +(* to 284C (fhat is a rapidly decreasing test function). *) +(* ========================================================================= *) + +(* Derivative of the kernel x |-> e^{-iyx} in the FREQUENCY y: it is -ix *) +(* e^.. *) +let KERNEL_DERIV_Y = prove + (`!(x:real) a:real^1. + ((\z. cexp(--(ii * Cx(drop z) * Cx x))) has_vector_derivative + (--(ii * Cx x) * cexp(--(ii * Cx(drop a) * Cx x)))) (at a)`, + REPEAT GEN_TAC THEN MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_REAL_COMPLEX THEN + COMPLEX_DIFF_TAC THEN CONV_TAC COMPLEX_RING);; + +(* Parametric (in y) derivative of the full integrand e^{-iyx} f(x). *) +let FFY_DERIV = prove + (`!(f:real->complex) (x:real) y. + ((\z. cexp(--(ii * Cx(drop z) * Cx x)) * f x) has_vector_derivative + (--(ii * Cx x) * cexp(--(ii * Cx y * Cx x)) * f x)) (at(lift y))`, + REPEAT GEN_TAC THEN + MP_TAC(ISPECL + [`( * ):complex->complex->complex`; + `\z. cexp(--(ii * Cx(drop z) * Cx x))`; `\z:real^1. (f:real->complex) x`; + `--(ii * Cx x) * cexp(--(ii * Cx y * Cx x))`; `Cx(&0)`; `lift y`] + HAS_VECTOR_DERIVATIVE_BILINEAR_AT) THEN + REWRITE_TAC[BILINEAR_COMPLEX_MUL; LIFT_DROP] THEN ANTS_TAC THENL + [CONJ_TAC THENL + [MP_TAC(ISPECL [`x:real`; `lift y`] KERNEL_DERIV_Y) THEN + REWRITE_TAC[LIFT_DROP]; + REWRITE_TAC[GSYM COMPLEX_VEC_0; HAS_VECTOR_DERIVATIVE_CONST]]; + MATCH_MP_TAC VDERIV_EQ THEN + CONV_TAC COMPLEX_RING]);; + +(* |d/dy integrand| = |x f(x)| (kernel has unit modulus), the DCT dominator. *) +let GG_DOM = prove + (`!(f:real->complex) (x:real) y. + norm(--(ii * Cx x) * cexp(--(ii * Cx y * Cx x)) * f x) <= norm(Cx x * f + x)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[COMPLEX_NORM_MUL; NORM_NEG; COMPLEX_NORM_II; + COMPLEX_NORM_CX; FOURIER_KERNEL_NORM] THEN REAL_ARITH_TAC);; + +(* The derivative integrand -ix e^{-iyx} f(x) is absolutely integrable *) +(* (modulation of x f(x)). *) +let GGY0_ABSINT = prove + (`!(f:real->complex) y0. + (\x:real^1. Cx(drop x) * f(drop x)) absolutely_integrable_on (:real^1) + ==> (\x:real^1. --(ii * Cx(drop x)) * cexp(--(ii * Cx y0 * Cx(drop x))) * + f(drop x)) + absolutely_integrable_on (:real^1)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\t. Cx t * (f:real->complex) t`; + `y0:real`] FOURIER_MODULATION_ABSINT) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `--ii` o MATCH_MP + ABSOLUTELY_INTEGRABLE_COMPLEX_LMUL) THEN + MATCH_MP_TAC(MESON[] `f = g ==> f absolutely_integrable_on s ==> g + absolutely_integrable_on s`) THEN + REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN CONV_TAC COMPLEX_RING);; + +(* 283Ch (unnormalised): derivative of the inner Fourier integral in y. *) +let FOURIER_283CH_RAW = prove + (`!(f:real->complex) y0. + (!y. (\x:real^1. cexp(--(ii * Cx y * Cx(drop x))) * f(drop x)) + absolutely_integrable_on (:real^1)) /\ + (\x:real^1. Cx(drop x) * f(drop x)) absolutely_integrable_on (:real^1) + ==> ((\z. integral (:real^1) (\x. cexp(--(ii * Cx(drop z) * Cx(drop x))) * + f(drop x))) + has_vector_derivative + (integral (:real^1) (\x. --(ii * Cx(drop x)) * cexp(--(ii * Cx y0 * + Cx(drop x))) * f(drop x)))) + (at(lift y0))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`\y x. cexp(--(ii * Cx y * Cx x)) * (f:real->complex) x`; + `\y x. --(ii * Cx x) * cexp(--(ii * Cx y * Cx x)) * (f:real->complex) x`; + `\x. norm(Cx x * (f:real->complex) x)`; + `y0:real`] DIFF_UNDER_INTEGRAL) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [REPEAT GEN_TAC THEN REWRITE_TAC[FFY_DERIV]; + ASM_REWRITE_TAC[]; MATCH_MP_TAC GGY0_ABSINT THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[GG_DOM]; + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_NORM THEN ASM_REWRITE_TAC[]]; + SIMP_TAC[]]);; + +(* Reshape the derivative integral into -i * fourier(x f). *) +let CH_RESHAPE = prove + (`!(f:real->complex) y0. + (\x:real^1. Cx(drop x) * f(drop x)) absolutely_integrable_on (:real^1) + ==> Cx(&1) / Cx(sqrt(&2 * pi)) * + integral (:real^1) (\x. --(ii * Cx(drop x)) * cexp(--(ii * Cx y0 * + Cx(drop x))) * f(drop x)) = + --ii * fourier (\x. Cx x * f x) y0`, + REPEAT STRIP_TAC THEN REWRITE_TAC[fourier] THEN + SUBGOAL_THEN + `integral (:real^1) (\x. --(ii * Cx(drop x)) * cexp(--(ii * Cx y0 * Cx(drop + x))) * f(drop x)) = + --ii * integral (:real^1) (\x. cexp(--(ii * Cx y0 * Cx(drop x))) * (Cx(drop + x) * f(drop x)))` + SUBST1_TAC THENL + [W(MP_TAC o PART_MATCH (rand o rand) INTEGRAL_COMPLEX_LMUL o rand o snd) + THEN + ANTS_TAC THENL + [MP_TAC(ISPECL [`\t. Cx t * (f:real->complex) t`; + `y0:real`] FOURIER_MODULATION_ABSINT) THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE]; + DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC INTEGRAL_EQ THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN CONV_TAC COMPLEX_RING]; + CONV_TAC COMPLEX_RING]);; + +(* 283Ch (Fremlin form): (fourier f)'(y0) = -i * fourier(x |-> x f(x))(y0). *) +let FOURIER_283CH = prove + (`!(f:real->complex) y0. + (!y. (\x:real^1. cexp(--(ii * Cx y * Cx(drop x))) * f(drop x)) + absolutely_integrable_on (:real^1)) /\ + (\x:real^1. Cx(drop x) * f(drop x)) absolutely_integrable_on (:real^1) + ==> ((\z. fourier f (drop z)) has_vector_derivative + (--ii * fourier (\x. Cx x * f x) y0)) (at(lift y0))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `--ii * fourier (\x. Cx x * (f:real->complex) x) y0 = + Cx(&1) / Cx(sqrt(&2 * pi)) * + integral (:real^1) (\x. --(ii * Cx(drop x)) * cexp(--(ii * Cx y0 * Cx(drop + x))) * f(drop x))` + SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC CH_RESHAPE THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[fourier] THEN MATCH_MP_TAC CONST_CHAIN_DERIV THEN + MATCH_MP_TAC FOURIER_283CH_RAW THEN ASM_REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Conjugate of the transform = inverse transform of the conjugate: *) +(* cnj(fourier f y) = (1/sqrt2pi) INT e^{+iyx} cnj(f x) dx. *) +(* The bridge for Plancherel-on-Schwartz (284O(a)(i)): g-bar = *) +(* (f-bar)-check. *) +(* ------------------------------------------------------------------------- *) + +let CNJ_FOURIER = prove + (`!(f:real->complex) y. + (\x:real^1. cexp(--(ii * Cx y * Cx(drop x))) * f(drop x)) integrable_on + (:real^1) + ==> cnj(fourier f y) = + Cx(&1)/Cx(sqrt(&2*pi)) * + integral (:real^1) (\x. cexp(ii * Cx y * Cx(drop x)) * cnj(f(drop + x)))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[fourier] THEN + REWRITE_TAC[CNJ_MUL; CNJ_DIV; CNJ_CX] THEN BINOP_TAC THENL + [REWRITE_TAC[]; + MP_TAC(ISPECL [`\x. cexp(--(ii * Cx y * Cx(drop x))) * + (f:real->complex)(drop x)`; + `(:real^1)`; `cnj`] INTEGRAL_LINEAR) THEN + ASM_REWRITE_TAC[LINEAR_CNJ] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[o_DEF; CNJ_MUL; CNJ_CEXP] THEN + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[CNJ_NEG; CNJ_MUL; CNJ_II; CNJ_CX] THEN + SIMPLE_COMPLEX_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* The inverse Fourier transform is the forward transform at the negated *) +(* frequency: (1/sqrt2pi) INT e^{+iyx} f(x) dx = fourier f (-y). *) +(* ------------------------------------------------------------------------- *) + +let FOURIER_INV_NEG = prove + (`!(f:real->complex) y. fourier f (--y) = + Cx(&1)/Cx(sqrt(&2*pi)) * integral (:real^1) (\x. cexp(ii * Cx y * Cx(drop + x)) * f(drop x))`, + REPEAT GEN_TAC THEN REWRITE_TAC[fourier] THEN AP_TERM_TAC THEN + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[CX_NEG] THEN SIMPLE_COMPLEX_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Plancherel on Schwartz functions (Fremlin 284O(a)(i)): *) +(* INT fhat * conj(fhat) = INT f * conj(f), i.e. ||fhat||_2 = ||f||_2. *) +(* Via the multiplication formula 283O applied to (fhat, x |-> conj(f(-x))), *) +(* the conjugate/reflection bridges, and the double-transform reflection. *) +(* ------------------------------------------------------------------------- *) + +(* fourier(x |-> conj(f(-x)))(z) = conj(fourier f z) (modulated f *) +(* integrable). *) +let FOURIER_CNJ_REFLECT = prove + (`!(f:real->complex) z. + (\x:real^1. cexp(--(ii * Cx z * Cx(drop x))) * f(drop x)) integrable_on + (:real^1) + ==> fourier (\x. cnj(f(--x))) z = cnj(fourier f z)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\x. cnj((f:real->complex) x)`; + `z:real`] FOURIER_REFLECT) THEN + REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + MP_TAC(ISPECL [`f:real->complex`; `z:real`] CNJ_FOURIER) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[GSYM FOURIER_INV_NEG]);; + +(* Double transform is reflection: fourier(fourier h)(-z) = h z (Schwartz *) +(* h). *) +let DOUBLE_TRANSFORM = prove + (`!(h:real->complex) z. schwartz h ==> fourier (fourier h) (--z) = h z`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`fourier(h:real->complex)`; `z:real`] FOURIER_INV_NEG) THEN + REWRITE_TAC[GSYM CX_INV; complex_div; COMPLEX_MUL_LID] THEN + DISCH_THEN SUBST1_TAC THEN + MP_TAC(ISPECL [`h:real->complex`; `z:real`] FOURIER_284C_INVERSION) THEN + ASM_REWRITE_TAC[]);; + +(* conj(f(-.)) is absolutely integrable when f is. *) +let CNJ_REFLECT_ABSINT = prove + (`!(h:real->complex). (\z:real^1. h(drop z)) absolutely_integrable_on + (:real^1) + ==> (\z:real^1. cnj(h(--(drop z)))) absolutely_integrable_on (:real^1)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\z:real^1. cnj(h(--(drop z)))) = cnj o (\z:real^1. h(drop(--z)))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; o_THM; DROP_NEG]; ALL_TAC] THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_LINEAR THEN REWRITE_TAC[LINEAR_CNJ] THEN + REWRITE_TAC[ABSOLUTELY_INTEGRABLE_REFLECT_GEN] THEN + SUBGOAL_THEN `IMAGE (--) (:real^1) = (:real^1)` SUBST1_TAC THENL + [REWRITE_TAC[REFLECT_UNIV]; ASM_REWRITE_TAC[]]);; + +(* Modulated integrand is integrable when f is absolutely integrable. *) +let MODINT = prove + (`!(h:real->complex) z. (\x:real^1. h(drop x)) absolutely_integrable_on + (:real^1) + ==> (\x:real^1. cexp(--(ii * Cx z * Cx(drop x))) * h(drop x)) + integrable_on (:real^1)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC FOURIER_MODULATION_ABSINT THEN ASM_REWRITE_TAC[]);; + +let PARSEVAL_SCHWARTZ = prove + (`!(h:real->complex). schwartz h + ==> integral (:real^1) (\z. fourier h (drop z) * cnj(fourier h (drop z))) + = + integral (:real^1) (\z. h(drop z) * cnj(h(drop z)))`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP SCHWARTZ_ABSINT) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP SCHWARTZ_FHAT_ABSINT) THEN + MP_TAC(ISPECL [`fourier(h:real->complex)`; + `\x. cnj((h:real->complex)(--x))`] FOURIER_283O) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CNJ_REFLECT_ABSINT THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `integral (:real^1) (\z. fourier h (drop z) * fourier (\x. + cnj((h:real->complex)(--x))) (drop z)) = + integral (:real^1) (\z. fourier h (drop z) * cnj(fourier h (drop z)))` + SUBST1_TAC THENL + [MATCH_MP_TAC INTEGRAL_EQ THEN X_GEN_TAC `z:real^1` THEN DISCH_TAC THEN + REWRITE_TAC[] THEN AP_TERM_TAC THEN + MATCH_MP_TAC FOURIER_CNJ_REFLECT THEN MATCH_MP_TAC MODINT THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[] THEN + SUBGOAL_THEN + `integral (:real^1) (\z. fourier (fourier h) (drop z) * + cnj((h:real->complex)(--(drop z)))) = + integral (:real^1) (\z. h(--(drop z)) * cnj(h(--(drop z))))` + SUBST1_TAC THENL + [MATCH_MP_TAC INTEGRAL_EQ THEN X_GEN_TAC `z:real^1` THEN DISCH_TAC THEN + REWRITE_TAC[] THEN AP_THM_TAC THEN AP_TERM_TAC THEN + ONCE_REWRITE_TAC[GSYM REAL_NEG_NEG] THEN + ASM_SIMP_TAC[DOUBLE_TRANSFORM; REAL_NEG_NEG]; + MP_TAC(ISPEC `\t. (h:real->complex) t * cnj(h t)` INTEGRAL_REFLECT_R) THEN + REWRITE_TAC[]]);; + + +(* ========================================================================= *) +(* SECTION 10. Density of Schwartz functions in L^2 (Fremlin 284N). *) +(* *) +(* The proof uses a *) +(* convolution-free route that reuses the compactly-supported Schwartz bump *) +(* SCHWARTZ_PSI (proved above): *) +(* *) +(* Brick 1 LSPACE_APPROXIMATE_COMPACT_SUPPORT *) +(* compactly-supported functions are L^p dense (general p, any *) +(* dimension), by dominated convergence on the ball truncations. *) +(* Brick 2 a smooth plateau eta (=1 on [-R,R], supported in [-R-2,R+2]) *) +(* built from a smooth ramp Theta(t) = (1/I) INT_{-2}^{t} psi. *) +(* Brick 3 284N: truncate (brick 1) -> polynomial-approximate on the *) +(* bounded support (LSPACE_APPROXIMATE_VECTOR_POLYNOMIAL_FUNCTION) *) +(* -> multiply by the plateau to get a compactly-supported smooth *) +(* (hence Schwartz) approximant. *) +(* ========================================================================= *) + +(* The L^p norm of a difference is symmetric in its two arguments. *) +let LNORM_SUB_SYM = prove + (`!s p (a:real^M->real^N) b. + lnorm s p (\x. a x - b x) = lnorm s p (\x. b x - a x)`, + REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [GSYM LNORM_NEG] THEN + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN VECTOR_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Brick 1: compactly-supported functions are dense in L^p. *) +(* ------------------------------------------------------------------------- *) + +(* The truncation of an L^p function to a measurable set stays in L^p. *) +let TRUNC_IN_LSPACE = prove + (`!(f:real^M->real^N) t p. + &0 < p /\ f IN lspace (:real^M) p /\ lebesgue_measurable t + ==> (\x. if x IN t then f x else vec 0) IN lspace (:real^M) p`, + REPEAT GEN_TAC THEN + REWRITE_TAC[lspace; IN_ELIM_THM] THEN STRIP_TAC THEN CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_ON_RESTRICT THEN ASM_REWRITE_TAC[]; + SUBGOAL_THEN + `(\x:real^M. lift (norm (if x IN t then (f:real^M->real^N) x else vec 0) + rpow p)) = + (\x. if x IN t then lift(norm(f x) rpow p) else vec 0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[NORM_0] THEN + ASM_SIMP_TAC[RPOW_ZERO; REAL_LT_IMP_NZ; LIFT_NUM]; + REWRITE_TAC[INTEGRABLE_RESTRICT_UNIV] THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN + EXISTS_TAC `(:real^M)` THEN ASM_REWRITE_TAC[SUBSET_UNIV] THEN + MATCH_MP_TAC NONNEGATIVE_ABSOLUTELY_INTEGRABLE THEN + ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `i = 1` SUBST_ALL_TAC THENL + [ASM_MESON_TAC[DIMINDEX_1; LE_ANTISYM]; ALL_TAC] THEN + ASM_SIMP_TAC[GSYM drop; LIFT_DROP; RPOW_POS_LE; NORM_POS_LE]]]);; + +(* Dominated convergence: the ball-truncations converge to f in *) +(* L^p-seminorm. *) +let TRUNC_LNORM_LIM = prove + (`!(f:real^M->real^N) p. + &0 < p /\ f IN lspace (:real^M) p + ==> ((\n. lnorm (:real^M) p + (\x. f x - (if x IN ball(vec 0,&n) then f x else vec 0))) ---> + &0) + sequentially`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\n. lnorm (:real^M) p + (\x. (f:real^M->real^N) x - (if x IN ball(vec 0,&n) then f x else vec + 0))) = + (\n. lnorm (:real^M) p + (\x. (if x IN ball(vec 0,&n) then f x else vec 0) - f x))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + REWRITE_TAC[LNORM_SUB_SYM]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`\n:num. \x:real^M. if x IN ball(vec 0,&n) then (f:real^M->real^N) x else + vec 0`; + `f:real^M->real^N`; `f:real^M->real^N`; `(:real^M)`; `p:real`; + `{}:real^M->bool`] + LSPACE_DOMINATED_CONVERGENCE) THEN + ASM_REWRITE_TAC[NEGLIGIBLE_EMPTY; DIFF_EMPTY] THEN ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC TRUNC_IN_LSPACE THEN + ASM_SIMP_TAC[LEBESGUE_MEASURABLE_BALL]; + REPEAT GEN_TAC THEN COND_CASES_TAC THEN + REWRITE_TAC[NORM_0; REAL_LE_REFL; NORM_POS_LE]; + X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN + MATCH_MP_TAC LIM_EVENTUALLY THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN + MP_TAC(ISPEC `norm(x:real^M)` REAL_ARCH_SIMPLE) THEN + DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `N + 1` THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN + REWRITE_TAC[IN_BALL_0] THEN COND_CASES_TAC THEN REWRITE_TAC[] THEN + SUBGOAL_THEN `norm(x:real^M) < &n` (fun th -> ASM_MESON_TAC[th]) THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `&N:real` THEN + ASM_REWRITE_TAC[REAL_OF_NUM_LT] THEN ASM_ARITH_TAC]; + SIMP_TAC[]]);; + +(* Brick 1: compactly-supported L^p approximation (Fremlin's tail step). *) +let LSPACE_APPROXIMATE_COMPACT_SUPPORT = prove + (`!(f:real^M->real^N) p e. + &0 < p /\ f IN lspace (:real^M) p /\ &0 < e + ==> ?g R. g IN lspace (:real^M) p /\ + (!x. R < norm x ==> g x = vec 0) /\ + lnorm (:real^M) p (\x. f x - g x) < e`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:real^M->real^N`; `p:real`] TRUNC_LNORM_LIM) THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` (MP_TAC o SPEC `N:num`)) THEN + REWRITE_TAC[LE_REFL] THEN DISCH_TAC THEN + EXISTS_TAC `\x:real^M. if x IN ball(vec 0,&N) then (f:real^M->real^N) x else + vec 0` THEN + EXISTS_TAC `&N:real` THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC TRUNC_IN_LSPACE THEN ASM_SIMP_TAC[LEBESGUE_MEASURABLE_BALL]; + X_GEN_TAC `x:real^M` THEN DISCH_TAC THEN REWRITE_TAC[IN_BALL_0] THEN + COND_CASES_TAC THEN REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + SUBGOAL_THEN + `&0 <= lnorm (:real^M) p + (\x. (f:real^M->real^N) x - (if x IN ball(vec 0,&N) then f x else vec + 0))` + MP_TAC THENL + [MATCH_MP_TAC LNORM_POS_LE THEN MATCH_MP_TAC LSPACE_SUB THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; TRUNC_IN_LSPACE; LEBESGUE_MEASURABLE_BALL]; + ASM_REAL_ARITH_TAC]]);; + +(* ------------------------------------------------------------------------- *) +(* Brick 2: a smooth plateau. The building block is the real bump *) +(* rpsi(x) = rphi(1+x) * rphi(1-x), rphi(x) = exp(-1/x) [x>0], 0 [x<=0], *) +(* i.e. the real form of the SCHWARTZ_PSI bump: nonnegative, continuous, *) +(* supported in [-1,1], with strictly positive total integral. *) +(* ------------------------------------------------------------------------- *) + +let rphi = new_definition + `rphi (x:real) = if &0 < x then exp(--(inv x)) else &0`;; + +let rpsi = new_definition + `rpsi (x:real) = rphi(&1 + x) * rphi(&1 - x)`;; + +(* Bridge to the complex bump cphi (defined above). *) +let CPHI_RPHI = prove + (`!x. cphi x = Cx(rphi x)`, + GEN_TAC THEN REWRITE_TAC[cphi; rphi] THEN COND_CASES_TAC THEN + REWRITE_TAC[]);; + +let CPSI_RPSI = prove + (`!x. cphi(&1 + x) * cphi(&1 - x) = Cx(rpsi x)`, + GEN_TAC THEN REWRITE_TAC[CPHI_RPHI; rpsi; GSYM CX_MUL]);; + +let RPSI_POS = prove + (`!x. &0 <= rpsi x`, + GEN_TAC THEN REWRITE_TAC[rpsi; rphi] THEN REPEAT COND_CASES_TAC THEN + REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_LE_REFL] THEN + MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_EXP_POS_LE]);; + +let RPSI_SUPPORT = prove + (`!x. &1 < abs x ==> rpsi x = &0`, + GEN_TAC THEN REWRITE_TAC[rpsi; rphi] THEN REPEAT COND_CASES_TAC THEN + REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO] THEN ASM_REAL_ARITH_TAC);; + +(* Continuity of rpsi: p 0 of PSI_CHAIN is differentiable and equals Cx o *) +(* rpsi. *) +let CX_RPSI_CONT = prove + (`(\z:real^1. Cx(rpsi(drop z))) continuous_on (:real^1)`, + X_CHOOSE_THEN `p:num->real->complex` STRIP_ASSUME_TAC PSI_CHAIN THEN + SUBGOAL_THEN + `(\z:real^1. Cx(rpsi(drop z))) = (\z. (p:num->real->complex) 0 (drop z))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + ASM_REWRITE_TAC[CPSI_RPSI]; ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN X_GEN_TAC `x:real^1` THEN + DISCH_TAC THEN MATCH_MP_TAC DIFFERENTIABLE_IMP_CONTINUOUS_AT THEN + REWRITE_TAC[differentiable] THEN + EXISTS_TAC `\h. drop h % (p:num->real->complex) 1 (drop x)` THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`0`; `drop(x:real^1)`]) THEN + REWRITE_TAC[LIFT_DROP; has_vector_derivative; ARITH_RULE `SUC 0 = 1`]);; + +let RPSI_REAL_CONT = prove + (`rpsi real_continuous_on (:real)`, + REWRITE_TAC[REAL_CONTINUOUS_ON; IMAGE_LIFT_UNIV] THEN + MP_TAC CX_RPSI_CONT THEN REWRITE_TAC[CONTINUOUS_ON; o_DEF] THEN + REWRITE_TAC[LIM_CX_LIFT]);; + +let RPSI_REAL_INT = prove + (`rpsi real_integrable_on (:real)`, + MATCH_MP_TAC REAL_INTEGRABLE_ON_SUPERSET THEN + EXISTS_TAC `real_interval[-- &1, &1]` THEN REWRITE_TAC[SUBSET_UNIV] THEN + CONJ_TAC THENL + [X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN + DISCH_TAC THEN MATCH_MP_TAC RPSI_SUPPORT THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_INTEGRABLE_CONTINUOUS THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `(:real)` THEN + REWRITE_TAC[SUBSET_UNIV; RPSI_REAL_CONT]]);; + +let RPSI_INT_HALF = prove + (`rpsi real_integrable_on real_interval[-- &1 / &2, &1 / &2]`, + MATCH_MP_TAC REAL_INTEGRABLE_CONTINUOUS THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `(:real)` THEN + REWRITE_TAC[SUBSET_UNIV; RPSI_REAL_CONT]);; + +(* rpsi >= exp(-4) on [-1/2,1/2]: both factors exp(-1/(1 +- x)) >= exp(-2). *) +let RPSI_LOWER = prove + (`!x. x IN real_interval[-- &1 / &2, &1 / &2] ==> exp(-- &4) <= rpsi x`, + X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN STRIP_TAC THEN + REWRITE_TAC[rpsi; rphi] THEN + SUBGOAL_THEN `&0 < &1 + x /\ &0 < &1 - x` STRIP_ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `exp(-- &4) = exp(-- &2) * exp(-- &2)` SUBST1_TAC THENL + [REWRITE_TAC[GSYM REAL_EXP_ADD] THEN AP_TERM_TAC THEN + REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN + REWRITE_TAC[REAL_EXP_POS_LE; REAL_EXP_MONO_LE; REAL_LE_NEG2] THEN + CONJ_TAC THEN + SUBGOAL_THEN `&2 = inv(&1 / &2)` SUBST1_TAC THENL + [CONV_TAC REAL_RAT_REDUCE_CONV; + MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REAL_ARITH_TAC; + CONV_TAC REAL_RAT_REDUCE_CONV; + MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REAL_ARITH_TAC]);; + +(* The normalising constant I = INT rpsi is strictly positive. *) +let IPSI_POS = prove + (`&0 < real_integral (:real) rpsi`, + SUBGOAL_THEN + `exp(-- &4) <= real_integral (real_interval[-- &1 / &2, &1 / &2]) rpsi /\ + real_integral (real_interval[-- &1 / &2, &1 / &2]) rpsi <= + real_integral (:real) rpsi` + MP_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `real_integral (real_interval[-- &1 / &2, &1 / &2]) (\x. + exp(-- &4))` THEN + CONJ_TAC THENL + [SIMP_TAC[REAL_INTEGRAL_CONST; REAL_ARITH `-- &1 / &2 <= &1 / &2`] THEN + REAL_ARITH_TAC; + MATCH_MP_TAC REAL_INTEGRAL_LE THEN + ASM_SIMP_TAC[REAL_INTEGRABLE_CONST; RPSI_INT_HALF; RPSI_LOWER]]; + MATCH_MP_TAC REAL_INTEGRAL_SUBSET_LE THEN + REWRITE_TAC[SUBSET_UNIV; RPSI_POS; RPSI_REAL_INT; RPSI_INT_HALF]]; + MP_TAC(SPEC `-- &4` REAL_EXP_POS_LT) THEN REAL_ARITH_TAC]);; + +(* rpsi vanishes on (-inf,-1] (rphi(1+x)=0 there); needed at the endpoint *) +(* -1. *) +let RPSI_ZERO_LEFT = prove + (`!x. x <= -- &1 ==> rpsi x = &0`, + REPEAT STRIP_TAC THEN REWRITE_TAC[rpsi; rphi] THEN + COND_CASES_TAC THEN REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO] THEN + ASM_REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* The smooth ramp rtheta(t) = (1/I) INT_{[-2,t]} rpsi, I = INT rpsi. *) +(* It is 0 on (-inf,-1], climbs to 1 on [1,inf), stays in [0,1], and is *) +(* everywhere differentiable with rtheta' = (1/I) rpsi (FTC for t > -2; *) +(* locally constant 0 for t < -1; the two ranges cover R since -2 < -1). *) +(* ------------------------------------------------------------------------- *) + +let rtheta = new_definition + `rtheta (t:real) = inv(real_integral (:real) rpsi) * + real_integral (real_interval[-- &2, t]) rpsi`;; + +let RTHETA_LAM = prove + (`rtheta = \t. inv(real_integral (:real) rpsi) * real_integral + (real_interval[-- &2, t]) rpsi`, + REWRITE_TAC[FUN_EQ_THM; rtheta]);; + +let RTHETA_INT_HALF = prove + (`!t. rpsi real_integrable_on real_interval[-- &2, t]`, + GEN_TAC THEN MATCH_MP_TAC REAL_INTEGRABLE_CONTINUOUS THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `(:real)` THEN + REWRITE_TAC[SUBSET_UNIV; RPSI_REAL_CONT]);; + +(* rtheta vanishes on (-inf,-1]: the integrand rpsi is 0 throughout [-2,t]. *) +let RTHETA_ZERO = prove + (`!t. t <= -- &1 ==> rtheta t = &0`, + REPEAT STRIP_TAC THEN REWRITE_TAC[rtheta] THEN + SUBGOAL_THEN + `real_integral (real_interval[-- &2, t]) rpsi = &0` SUBST1_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_EQ_0 THEN X_GEN_TAC `x:real` THEN + REWRITE_TAC[IN_REAL_INTERVAL] THEN STRIP_TAC THEN + MATCH_MP_TAC RPSI_ZERO_LEFT THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[REAL_MUL_RZERO]]);; + +(* Derivative for t > -2 via the fundamental theorem of calculus. *) +let RTHETA_DERIV_POS = prove + (`!t. -- &2 < t + ==> (rtheta has_real_derivative (inv(real_integral (:real) rpsi) * rpsi + t)) + (atreal t)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[RTHETA_LAM] THEN + MATCH_MP_TAC HAS_REAL_DERIVATIVE_LMUL_ATREAL THEN + MP_TAC(ISPECL + [`\u. real_integral (real_interval [-- &2,u]) rpsi`; `rpsi t`; + `t:real`; `real_interval(-- &2, t + &1)`] + HAS_REAL_DERIVATIVE_WITHIN_REAL_OPEN) THEN + REWRITE_TAC[REAL_OPEN_REAL_INTERVAL; IN_REAL_INTERVAL] THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; DISCH_THEN(SUBST1_TAC o SYM)] THEN + MATCH_MP_TAC HAS_REAL_DERIVATIVE_WITHIN_SUBSET THEN + EXISTS_TAC `real_interval[-- &2, t + &1]` THEN + REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN CONJ_TAC THENL + [MP_TAC(ISPECL [`rpsi`; `-- &2`; + `t + &1`] REAL_INTEGRAL_HAS_REAL_DERIVATIVE) THEN + ANTS_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `(:real)` THEN + REWRITE_TAC[SUBSET_UNIV; RPSI_REAL_CONT]; + DISCH_THEN(MP_TAC o SPEC `t:real`) THEN + REWRITE_TAC[IN_REAL_INTERVAL] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_REAL_ARITH_TAC]; + ASM_REAL_ARITH_TAC]);; + +(* Derivative for t < -1: rtheta is locally constant 0 there. *) +let RTHETA_DERIV_NEG = prove + (`!t. t < -- &1 + ==> (rtheta has_real_derivative (inv(real_integral (:real) rpsi) * rpsi + t)) + (atreal t)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `inv(real_integral (:real) rpsi) * rpsi t = &0` SUBST1_TAC THENL + [SUBGOAL_THEN `rpsi t = &0` SUBST1_TAC THENL + [MATCH_MP_TAC RPSI_ZERO_LEFT THEN + ASM_REAL_ARITH_TAC; REWRITE_TAC[REAL_MUL_RZERO]]; + ALL_TAC] THEN + MATCH_MP_TAC HAS_REAL_DERIVATIVE_TRANSFORM_ATREAL THEN + MAP_EVERY EXISTS_TAC [`\t:real. &0`; `-- &1 - t`] THEN + REPEAT CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; + X_GEN_TAC `x:real` THEN REWRITE_TAC[] THEN STRIP_TAC THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC RTHETA_ZERO THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[HAS_REAL_DERIVATIVE_CONST]]);; + +(* rtheta is everywhere differentiable with derivative (1/I) rpsi. *) +let RTHETA_DERIV = prove + (`!t. (rtheta has_real_derivative (inv(real_integral (:real) rpsi) * rpsi t)) + (atreal t)`, + GEN_TAC THEN DISJ_CASES_TAC(REAL_ARITH `t < -- &1 \/ -- &2 < t`) THENL + [MATCH_MP_TAC RTHETA_DERIV_NEG THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC RTHETA_DERIV_POS THEN ASM_REWRITE_TAC[]]);; + +let RTHETA_ONE = prove + (`!t. &1 <= t ==> rtheta t = &1`, + REPEAT STRIP_TAC THEN REWRITE_TAC[rtheta] THEN + SUBGOAL_THEN + `real_integral (real_interval[-- &2, t]) rpsi = real_integral (:real) rpsi` + SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_ON_SUPERSET THEN + EXISTS_TAC `real_interval[-- &2, t]` THEN REWRITE_TAC[SUBSET_UNIV] THEN + CONJ_TAC THENL + [X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN + DISCH_TAC THEN MATCH_MP_TAC RPSI_SUPPORT THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_INTEGRABLE_INTEGRAL THEN REWRITE_TAC[RTHETA_INT_HALF]]; + MATCH_MP_TAC REAL_MUL_LINV THEN MP_TAC IPSI_POS THEN REAL_ARITH_TAC]);; + +let RTHETA_BOUNDS = prove + (`!t. &0 <= rtheta t /\ rtheta t <= &1`, + GEN_TAC THEN REWRITE_TAC[rtheta] THEN + SUBGOAL_THEN `&0 < real_integral (:real) rpsi` ASSUME_TAC THENL + [REWRITE_TAC[IPSI_POS]; ALL_TAC] THEN + SUBGOAL_THEN `&0 <= real_integral (real_interval[-- &2, t]) rpsi /\ + real_integral (real_interval[-- &2, t]) rpsi <= real_integral + (:real) rpsi` + STRIP_ASSUME_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_POS THEN + REWRITE_TAC[RTHETA_INT_HALF; RPSI_POS]; + MATCH_MP_TAC REAL_INTEGRAL_SUBSET_LE THEN + REWRITE_TAC[SUBSET_UNIV; RPSI_POS; RPSI_REAL_INT; RTHETA_INT_HALF]]; + ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN ASM_SIMP_TAC[REAL_LE_INV_EQ; REAL_LT_IMP_LE]; + SUBGOAL_THEN + `inv(real_integral (:real) rpsi) * real_integral (real_interval[-- &2, t]) + rpsi <= + inv(real_integral (:real) rpsi) * real_integral (:real) rpsi` + MP_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN + ASM_SIMP_TAC[REAL_LE_INV_EQ; REAL_LT_IMP_LE]; + ASM_SIMP_TAC[REAL_MUL_LINV; REAL_LT_IMP_NZ]]]);; + +(* The complex ramp Cx o rtheta carries a full smooth derivative chain: its *) +(* first derivative is (1/I) times the SCHWARTZ_PSI chain p, so every higher *) +(* derivative is a constant multiple of a p-derivative. *) +let RTHETA_CHAIN = prove + (`?d:num->real->complex. + d 0 = (\x. Cx(rtheta x)) /\ + (!n y. ((\z. d n(drop z)) has_vector_derivative (d(SUC n) y))(at(lift + y)))`, + X_CHOOSE_THEN `p:num->real->complex` STRIP_ASSUME_TAC PSI_CHAIN THEN + EXISTS_TAC + `\n. if n = 0 then (\x. Cx(rtheta x)) + else (\x. Cx(inv(real_integral (:real) rpsi)) * + (p:num->real->complex)(n - 1) x)` THEN + CONJ_TAC THENL [REWRITE_TAC[]; ALL_TAC] THEN + X_GEN_TAC `n:num` THEN X_GEN_TAC `y:real` THEN + ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[NOT_SUC; SUC_SUB1; ARITH] THENL + [REWRITE_TAC[CPSI_RPSI; GSYM CX_MUL] THEN + MATCH_MP_TAC CX_VECTOR_DERIV_BRIDGE THEN REWRITE_TAC[RTHETA_DERIV]; + SUBGOAL_THEN `p n = (p:num->real->complex)(SUC(n - 1))` SUBST1_TAC THENL + [AP_TERM_TAC THEN ASM_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC CONST_CHAIN_DERIV THEN ASM_REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* The plateau eta R x = rtheta(x+R+1) * rtheta(R+1-x): = 1 on [-R,R], *) +(* supported in [-R-2,R+2], with values in [0,1] and a full smooth chain. *) +(* ------------------------------------------------------------------------- *) + +let eta = new_definition + `eta (R:real) (x:real) = rtheta(x + (R + &1)) * rtheta((R + &1) - x)`;; + +let ETA_SUPPORT = prove + (`!R x. &0 <= R /\ R + &2 < abs x ==> eta R x = &0`, + REPEAT STRIP_TAC THEN REWRITE_TAC[eta] THEN + DISJ_CASES_TAC(REAL_ARITH `x < &0 \/ &0 <= x`) THENL + [SUBGOAL_THEN `rtheta(x + (R + &1)) = &0` SUBST1_TAC THENL + [MATCH_MP_TAC RTHETA_ZERO THEN + ASM_REAL_ARITH_TAC; REWRITE_TAC[REAL_MUL_LZERO]]; + SUBGOAL_THEN `rtheta((R + &1) - x) = &0` SUBST1_TAC THENL + [MATCH_MP_TAC RTHETA_ZERO THEN + ASM_REAL_ARITH_TAC; REWRITE_TAC[REAL_MUL_RZERO]]]);; + +let ETA_ONE = prove + (`!R x. abs x <= R ==> eta R x = &1`, + REPEAT STRIP_TAC THEN REWRITE_TAC[eta] THEN + SUBGOAL_THEN `rtheta(x + (R + &1)) = &1 /\ rtheta((R + &1) - x) = &1` + (fun th -> REWRITE_TAC[th; REAL_MUL_LID]) THEN + CONJ_TAC THEN MATCH_MP_TAC RTHETA_ONE THEN ASM_REAL_ARITH_TAC);; + +let ETA_BOUNDS = prove + (`!R x. &0 <= eta R x /\ eta R x <= &1`, + REPEAT GEN_TAC THEN REWRITE_TAC[eta] THEN + MP_TAC(SPEC `x + (R + &1)` RTHETA_BOUNDS) THEN + MP_TAC(SPEC `(R + &1) - x` RTHETA_BOUNDS) THEN + STRIP_TAC THEN STRIP_TAC THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `rtheta(x + (R + &1)) * &1` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[REAL_MUL_RID] THEN ASM_REAL_ARITH_TAC]]);; + +(* Smooth chain for Cx o eta R, from PLATEAU_CHAIN = LEIBNIZ of two affine *) +(* copies of the ramp chain. *) +let PLATEAU_CHAIN = prove + (`!R. ?q:num->real->complex. + q 0 = (\x. Cx(rtheta(x + (R + &1))) * Cx(rtheta((R + &1) - x))) /\ + (!n y. ((\z. q n(drop z)) has_vector_derivative (q(SUC n) y))(at(lift + y)))`, + GEN_TAC THEN X_CHOOSE_THEN + `d:num->real->complex` STRIP_ASSUME_TAC RTHETA_CHAIN THEN + MP_TAC(ISPECL [`d:num->real->complex`; `R + &1`; `&1`] AFFINE_CHAIN) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`d:num->real->complex`; `R + &1`; `-- &1`] AFFINE_CHAIN) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MP_TAC(ISPECL + [`\n x. Cx(&1) pow n * (d:num->real->complex) n ((R + &1) + &1 * x)`; + `\n x. Cx(-- &1) pow n * (d:num->real->complex) n ((R + &1) + -- &1 * x)`] + LEIBNIZ_CHAIN) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `q:num->real->complex` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `q:num->real->complex` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:real` THEN + ASM_REWRITE_TAC[complex_pow; COMPLEX_MUL_LID] THEN + REWRITE_TAC[REAL_ARITH `(R + &1) + &1 * x = x + R + &1`; + REAL_ARITH `(R + &1) + -- &1 * x = (R + &1) - x`]);; + +let ETA_CHAIN = prove + (`!R. ?q:num->real->complex. + q 0 = (\x. Cx(eta R x)) /\ + (!n y. ((\z. q n(drop z)) has_vector_derivative (q(SUC n) y))(at(lift + y)))`, + GEN_TAC THEN X_CHOOSE_THEN `q:num->real->complex` STRIP_ASSUME_TAC + (SPEC `R:real` PLATEAU_CHAIN) THEN + EXISTS_TAC `q:num->real->complex` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[FUN_EQ_THM; eta; CX_MUL]);; + +(* Any vector polynomial function, viewed as real->complex, carries a chain *) +(* (its derivatives are again vector polynomials). *) +let POLY_CHAIN = prove + (`!P:real^1->real^2. vector_polynomial_function P + ==> ?e:num->real->complex. + e 0 = (\x. P(lift x)) /\ + (!n y. ((\z. e n(drop z)) has_vector_derivative (e(SUC n) + y))(at(lift y)))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`\(n:num) (Q:real^1->real^2). vector_polynomial_function Q`; + `\(n:num) (Q:real^1->real^2) (Q':real^1->real^2). + !x. (Q has_vector_derivative (Q' x)) (at x)`; + `P:real^1->real^2`] DEPENDENT_CHOICE_FIXED) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP + HAS_VECTOR_DERIVATIVE_VECTOR_POLYNOMIAL_FUNCTION) THEN + MATCH_MP_TAC MONO_EXISTS THEN MESON_TAC[]; + DISCH_THEN(X_CHOOSE_THEN `f:num->real^1->real^2` STRIP_ASSUME_TAC)] THEN + EXISTS_TAC `\n:num. \x:real. (f:num->real^1->real^2) n (lift x)` THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + REPEAT GEN_TAC THEN REWRITE_TAC[LIFT_DROP; ETA_AX] THEN + ASM_REWRITE_TAC[]]);; + +(* The plateau times any polynomial is Schwartz (smooth product chain via *) +(* LEIBNIZ_CHAIN, compact support inherited from the plateau). This is the *) +(* bridge from the polynomial L^2-approximant to a Schwartz approximant. *) +let ETAP_SCHWARTZ = prove + (`!R (P:real^1->real^2). &0 <= R /\ vector_polynomial_function P + ==> schwartz (\x. Cx(eta R x) * P(lift x))`, + REPEAT STRIP_TAC THEN + X_CHOOSE_THEN + `q:num->real->complex` STRIP_ASSUME_TAC (SPEC `R:real` ETA_CHAIN) THEN + FIRST_ASSUM(X_CHOOSE_THEN `en:num->real->complex` STRIP_ASSUME_TAC o + MATCH_MP POLY_CHAIN) THEN + MP_TAC(ISPECL [`q:num->real->complex`; + `en:num->real->complex`] LEIBNIZ_CHAIN) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `s:num->real->complex` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `(\x. Cx (eta R x) * P(lift x)) = (s:num->real->complex) 0` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC COMPACT_SUPPORT_SMOOTH_IMP_SCHWARTZ THEN + EXISTS_TAC `R + &2` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[real_gt] THEN MATCH_MP_TAC CHAIN_SUPPORT THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; + X_GEN_TAC `x:real` THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `eta R x = &0` SUBST1_TAC THENL + [MATCH_MP_TAC ETA_SUPPORT THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[CX_MUL; COMPLEX_MUL_LZERO; CX_INJ]]]);; + +(* ------------------------------------------------------------------------- *) +(* Brick 3: Schwartz functions are dense in L^2 (Fremlin 284N). *) +(* Supporting facts: a Schwartz function is continuous, bounded, and in L^2. *) +(* ------------------------------------------------------------------------- *) + +let SCHWARTZ_CONT = prove + (`!h:real->complex. schwartz h ==> (\z:real^1. h(drop z)) continuous_on + (:real^1)`, + REWRITE_TAC[schwartz] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC CONTINUOUS_AT_IMP_CONTINUOUS_ON THEN X_GEN_TAC `x:real^1` THEN + DISCH_TAC THEN MATCH_MP_TAC DIFFERENTIABLE_IMP_CONTINUOUS_AT THEN + REWRITE_TAC[differentiable] THEN + EXISTS_TAC `\h'. drop h' % (d:num->real->complex) 1 (drop x)` THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`0`; `drop(x:real^1)`]) THEN + ASM_REWRITE_TAC[LIFT_DROP; has_vector_derivative; + ARITH_RULE `SUC 0 = 1`] THEN + FIRST_X_ASSUM(fun th -> REWRITE_TAC[th]) THEN REWRITE_TAC[]);; + +let SCHWARTZ_BOUNDED = prove + (`!h:real->complex. schwartz h ==> ?B. !x. norm(h x) <= B`, + REWRITE_TAC[schwartz] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`0`; `0`]) THEN + DISCH_THEN(X_CHOOSE_TAC `B:real`) THEN EXISTS_TAC `B:real` THEN + X_GEN_TAC `x:real` THEN FIRST_X_ASSUM(MP_TAC o SPEC `x:real`) THEN + ASM_REWRITE_TAC[real_pow; REAL_MUL_LID]);; + +(* A Schwartz function is square-integrable: |h|^2 <= B|h| with |h| in L^1. *) +let SCHWARTZ_L2 = prove + (`!h:real->complex. schwartz h ==> (\z:real^1. h(drop z)) IN lspace (:real^1) + (&2)`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP SCHWARTZ_CONT) THEN + FIRST_ASSUM(X_CHOOSE_TAC `B:real` o MATCH_MP SCHWARTZ_BOUNDED) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP SCHWARTZ_ABSINT) THEN + SUBGOAL_THEN `(\z:real^1. (h:real->complex)(drop z)) measurable_on (:real^1)` + ASSUME_TAC THENL + [MATCH_MP_TAC CONTINUOUS_IMP_MEASURABLE_ON THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[lspace; IN_ELIM_THM] THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN + EXISTS_TAC `\z:real^1. B % lift(norm((h:real->complex)(drop z)))` THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_ON_LIFT_RPOW THEN + CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_ON_NORM THEN ASM_REWRITE_TAC[]; REAL_ARITH_TAC]; + MATCH_MP_TAC INTEGRABLE_CMUL THEN + FIRST_ASSUM(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_NORM) THEN + REWRITE_TAC[o_DEF] THEN REWRITE_TAC[ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE]; + X_GEN_TAC `z:real^1` THEN DISCH_TAC THEN + REWRITE_TAC[NORM_LIFT; DROP_CMUL; LIFT_DROP; REAL_ABS_RPOW; + REAL_ABS_NORM] THEN + REWRITE_TAC[RPOW_POW] THEN + SUBGOAL_THEN + `norm((h:real->complex)(drop z)) pow 2 = + norm(h(drop z)) * norm(h(drop z))` + SUBST1_TAC THENL [REWRITE_TAC[REAL_POW_2]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN ASM_REWRITE_TAC[NORM_POS_LE]]);; + +(* Glue: the L^2 seminorm over all of R equals that over a set s whenever *) +(* the function vanishes off s (needs p>0, so &0 rpow p = &0). *) +let LNORM_SUPPORTED = prove + (`!(phi:real^1->real^2) s p. + &0 < p /\ (!x. ~(x IN s) ==> phi x = vec 0) + ==> lnorm (:real^1) p phi = lnorm s p phi`, + REPEAT STRIP_TAC THEN REWRITE_TAC[lnorm] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + MP_TAC(ISPECL [`\x:real^1. lift(norm((phi:real^1->real^2) x) rpow p)`; + `s:real^1->bool`] + INTEGRAL_RESTRICT_UNIV) THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC INTEGRAL_EQ THEN X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN + REWRITE_TAC[] THEN COND_CASES_TAC THEN REWRITE_TAC[] THEN + ASM_SIMP_TAC[NORM_0; RPOW_ZERO; REAL_LT_IMP_NZ; LIFT_NUM]);; + +(* ------------------------------------------------------------------------- *) +(* 284N: Schwartz functions are dense in L^2 (Fremlin 284N). *) +(* Assembly of the three bricks: *) +(* (1) truncate f to a compactly-supported g (LSPACE_APPROXIMATE_COMPACT_ *) +(* SUPPORT), with ||f-g||_2 < e/2, g supported in |x|<=R; *) +(* (2) approximate g by a polynomial P on the bounded set *) +(* s = interval[-(|R|+2), |R|+2] (LSPACE_APPROXIMATE_VECTOR_ *) +(* POLYNOMIAL_FUNCTION), with ||g-P||_{2,s} < e/2; *) +(* (3) the Schwartz approximant is eta_(|R|) * P (ETAP_SCHWARTZ). Since *) +(* eta = 1 where g <> 0 we have g = eta*g, so f - eta*P = (f-g) + *) +(* eta*(g-P); the second term is supported in s (LNORM_SUPPORTED) and *) +(* dominated pointwise by g-P (|eta|<=1, LNORM_MONO). *) +let LSPACE_APPROXIMATE_SCHWARTZ = prove + (`!f:real^1->real^2. f IN lspace (:real^1) (&2) + ==> !e. &0 < e + ==> ?h. schwartz h /\ + lnorm (:real^1) (&2) (\x. f x - (\z. h(drop z)) x) < e`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:real^1->real^2`; `&2`; `e / &2`] + LSPACE_APPROXIMATE_COMPACT_SUPPORT) THEN + ASM_REWRITE_TAC[REAL_HALF; REAL_ARITH `&0 < &2`] THEN + DISCH_THEN(X_CHOOSE_THEN `g:real^1->real^2` + (X_CHOOSE_THEN `R:real` STRIP_ASSUME_TAC)) THEN + ABBREV_TAC `s = interval[lift(--(abs R + &2)), lift(abs R + &2)]` THEN + SUBGOAL_THEN + `bounded s /\ measurable s /\ lebesgue_measurable(s:real^1->bool)` + STRIP_ASSUME_TAC THENL + [EXPAND_TAC "s" THEN + REWRITE_TAC[BOUNDED_INTERVAL; MEASURABLE_INTERVAL; + LEBESGUE_MEASURABLE_INTERVAL]; + ALL_TAC] THEN + MP_TAC(ISPECL [`g:real^1->real^2`; `s:real^1->bool`; `&2`; `e / &2`] + LSPACE_APPROXIMATE_VECTOR_POLYNOMIAL_FUNCTION) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[REAL_HALF; REAL_ARITH `&1 <= &2`] THEN + MATCH_MP_TAC LSPACE_SUBSET THEN EXISTS_TAC `(:real^1)` THEN + ASM_REWRITE_TAC[SUBSET_UNIV]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `P:real^1->real^2` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `\x. Cx(eta (abs R) x) * (P:real^1->real^2)(lift x)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC ETAP_SCHWARTZ THEN ASM_REWRITE_TAC[REAL_ABS_POS]; + ALL_TAC] THEN + REWRITE_TAC[LIFT_DROP] THEN + SUBGOAL_THEN + `!x:real^1. Cx(eta (abs R) (drop x)) * (g:real^1->real^2) x = g x` + ASSUME_TAC THENL + [X_GEN_TAC `x:real^1` THEN + ASM_CASES_TAC `norm(x:real^1) <= abs R` THENL + [SUBGOAL_THEN `eta (abs R) (drop x) = &1` SUBST1_TAC THENL + [MATCH_MP_TAC ETA_ONE THEN + POP_ASSUM MP_TAC THEN REWRITE_TAC[NORM_REAL; GSYM drop] THEN + REAL_ARITH_TAC; + REWRITE_TAC[COMPLEX_MUL_LID]]; + SUBGOAL_THEN `(g:real^1->real^2) x = vec 0` SUBST1_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[COMPLEX_VEC_0; COMPLEX_MUL_RZERO]]]; + ALL_TAC] THEN + SUBGOAL_THEN + `(\x:real^1. Cx(eta (abs R) (drop x)) * (P:real^1->real^2) x) IN lspace + (:real^1) (&2)` + ASSUME_TAC THENL + [SUBGOAL_THEN + `(\x:real^1. Cx(eta (abs R) (drop x)) * (P:real^1->real^2) x) = + (\z:real^1. (\x. Cx(eta (abs R) x) * P(lift x))(drop z))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; LIFT_DROP]; + MATCH_MP_TAC SCHWARTZ_L2 THEN MATCH_MP_TAC ETAP_SCHWARTZ THEN + ASM_REWRITE_TAC[REAL_ABS_POS]]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `lnorm (:real^1) (&2) (\x. f x - (g:real^1->real^2) x) + + lnorm (:real^1) (&2) (\x. (g:real^1->real^2) x - + Cx(eta (abs R) (drop x)) * P x)` THEN + CONJ_TAC THENL + [SUBGOAL_THEN + `(\x. f x - Cx(eta (abs R) (drop x)) * (P:real^1->real^2) x) = + (\x. (\x. f x - g x) x + (\x. g x - Cx(eta (abs R) (drop x)) * P x) x)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN VECTOR_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC LNORM_TRIANGLE THEN + REWRITE_TAC[REAL_ARITH `&1 <= &2`; REAL_ARITH `&0 <= &2`] THEN + CONJ_TAC THEN MATCH_MP_TAC LSPACE_SUB THEN + ASM_REWRITE_TAC[REAL_ARITH `&0 <= &2`]; + ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `a < e / &2 /\ b <= e / &2 ==> a + b < e`) THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `(\x. (g:real^1->real^2) x - Cx(eta (abs R) (drop x)) * P x) = + (\x. Cx(eta (abs R) (drop x)) * ((g:real^1->real^2) x - P x))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:real^1` THEN + REWRITE_TAC[COMPLEX_SUB_LDISTRIB] THEN ASM_REWRITE_TAC[] THEN + VECTOR_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `lnorm (:real^1) (&2) (\x. Cx(eta (abs R) (drop x)) * ((g:real^1->real^2) x + - P x)) = + lnorm s (&2) (\x. Cx(eta (abs R) (drop x)) * ((g:real^1->real^2) x - P x))` + SUBST1_TAC THENL + [MATCH_MP_TAC LNORM_SUPPORTED THEN REWRITE_TAC[REAL_ARITH `&0 < &2`] THEN + X_GEN_TAC `x:real^1` THEN EXPAND_TAC "s" THEN + REWRITE_TAC[IN_INTERVAL_1; LIFT_DROP] THEN DISCH_TAC THEN + SUBGOAL_THEN `eta (abs R) (drop x) = &0` SUBST1_TAC THENL + [MATCH_MP_TAC ETA_SUPPORT THEN + REWRITE_TAC[REAL_ABS_POS; NORM_REAL; GSYM drop] THEN + POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; + REWRITE_TAC[COMPLEX_VEC_0; COMPLEX_MUL_LZERO]]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `lnorm s (&2) (\x. (g:real^1->real^2) x - P x)` THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN + MATCH_MP_TAC LNORM_MONO THEN EXISTS_TAC `{}:real^1->bool` THEN + REWRITE_TAC[NEGLIGIBLE_EMPTY; DIFF_EMPTY; REAL_ARITH `&0 <= &2`] THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC LSPACE_SUBSET THEN EXISTS_TAC `(:real^1)` THEN + ASM_REWRITE_TAC[SUBSET_UNIV] THEN + SUBGOAL_THEN + `(\x:real^1. Cx(eta (abs R) (drop x)) * ((g:real^1->real^2) x - P x)) = + (\x. g x - Cx(eta (abs R) (drop x)) * P x)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:real^1` THEN + REWRITE_TAC[COMPLEX_SUB_LDISTRIB] THEN ASM_REWRITE_TAC[] THEN + VECTOR_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC LSPACE_SUB THEN ASM_REWRITE_TAC[REAL_ARITH `&0 <= &2`]; + MATCH_MP_TAC LSPACE_SUB THEN ASM_REWRITE_TAC[REAL_ARITH `&0 <= &2`] THEN + MATCH_MP_TAC LSPACE_SUBSET THEN EXISTS_TAC `(:real^1)` THEN + ASM_REWRITE_TAC[SUBSET_UNIV]; + X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_CX] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN + MP_TAC(SPECL [`abs R`; `drop x`] ETA_BOUNDS) THEN REAL_ARITH_TAC]);; + + +(* ========================================================================= *) +(* SECTION 11. Plancherel's theorem on L^2 (Fremlin 284O(a)). *) +(* *) +(* Every square-integrable f has a Fourier transform represented by some *) +(* square-integrable g with ||g||_2 = ||f||_2. The transform is defined as *) +(* the L^2 limit of *) +(* the classical transforms of a Schwartz approximating sequence (284N), *) +(* which is Cauchy by Plancherel-on-Schwartz (PARSEVAL_SCHWARTZ) and hence *) +(* convergent by completeness of L^2 (RIESZ_FISCHER). *) +(* ========================================================================= *) + +(* ------------------------------------------------------------------------- *) +(* Schwartz functions form a linear space (closed under +, -, negation): *) +(* the two derivative chains add termwise and the rapid-decay bounds add. *) +(* ------------------------------------------------------------------------- *) + +let SCHWARTZ_ADD = prove + (`!h1 h2:real->complex. schwartz h1 /\ schwartz h2 ==> schwartz (\x. h1 x + h2 + x)`, + REPEAT GEN_TAC THEN REWRITE_TAC[schwartz] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `d:num->real->complex` STRIP_ASSUME_TAC) + (X_CHOOSE_THEN `e:num->real->complex` STRIP_ASSUME_TAC)) THEN + EXISTS_TAC `\n:num. \x:real. (d:num->real->complex) n x + + (e:num->real->complex) n x` THEN + REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[FUN_EQ_THM]; + REPEAT GEN_TAC THEN MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_ADD THEN + ASM_REWRITE_TAC[]; + MAP_EVERY X_GEN_TAC [`k:num`; `m:num`] THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`k:num`; `m:num`]) THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`k:num`; `m:num`]) THEN + DISCH_THEN(X_CHOOSE_TAC `B1:real`) THEN + DISCH_THEN(X_CHOOSE_TAC `B2:real`) THEN + EXISTS_TAC `B1 + B2:real` THEN X_GEN_TAC `x:real` THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `abs x pow k * norm((d:num->real->complex) m x) + + abs x pow k * norm((e:num->real->complex) m x)` THEN + CONJ_TAC THENL + [REWRITE_TAC[GSYM REAL_ADD_LDISTRIB] THEN MATCH_MP_TAC REAL_LE_LMUL THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_POW_LE THEN REWRITE_TAC[REAL_ABS_POS]; + CONV_TAC NORM_ARITH]; + MATCH_MP_TAC REAL_LE_ADD2 THEN ASM_REWRITE_TAC[]]]);; + +let SCHWARTZ_NEG = prove + (`!h:real->complex. schwartz h ==> schwartz (\x. --(h x))`, + GEN_TAC THEN REWRITE_TAC[schwartz] THEN + DISCH_THEN(X_CHOOSE_THEN `d:num->real->complex` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `\n:num. \x:real. --((d:num->real->complex) n x)` THEN + REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[FUN_EQ_THM]; + REPEAT GEN_TAC THEN MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_NEG THEN + ASM_REWRITE_TAC[]; + MAP_EVERY X_GEN_TAC [`k:num`; `m:num`] THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`k:num`; `m:num`]) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `B:real` THEN + REWRITE_TAC[NORM_NEG]]);; + +let SCHWARTZ_SUB = prove + (`!h1 h2:real->complex. schwartz h1 /\ schwartz h2 ==> schwartz (\x. h1 x - h2 + x)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\x. h1 x - h2 x) = (\x:real. h1 x + (\x. --(h2 x)) x)` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN CONV_TAC COMPLEX_RING; + MATCH_MP_TAC SCHWARTZ_ADD THEN ASM_SIMP_TAC[SCHWARTZ_NEG]]);; + +(* ------------------------------------------------------------------------- *) +(* The Fourier transform of a Schwartz function is square-integrable: it is *) +(* uniformly bounded (FOURIER_BOUND_UNIFORM, from f in L^1) and in L^1 *) +(* (SCHWARTZ_FHAT_ABSINT), so |fhat|^2 <= K|fhat| is integrable. (Avoids the *) +(* full 284C fact that fhat is itself Schwartz.) *) +(* ------------------------------------------------------------------------- *) + +let SCHWARTZ_FOURIER_L2 = prove + (`!f:real->complex. schwartz f ==> (\z. fourier f (drop z)) IN lspace + (:real^1) (&2)`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP SCHWARTZ_ABSINT) THEN + FIRST_ASSUM(X_CHOOSE_TAC `K:real` o MATCH_MP FOURIER_BOUND_UNIFORM) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP SCHWARTZ_FHAT_ABSINT) THEN + SUBGOAL_THEN + `(\z:real^1. fourier f (drop z)) measurable_on (:real^1)` ASSUME_TAC THENL + [MATCH_MP_TAC CONTINUOUS_IMP_MEASURABLE_ON THEN + MATCH_MP_TAC FOURIER_CONTINUOUS_ON THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[lspace; IN_ELIM_THM] THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN + EXISTS_TAC `\z:real^1. K % lift(norm(fourier f (drop z)))` THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_ON_LIFT_RPOW THEN + CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_ON_NORM THEN ASM_REWRITE_TAC[]; REAL_ARITH_TAC]; + MATCH_MP_TAC INTEGRABLE_CMUL THEN + FIRST_ASSUM(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_NORM) THEN + REWRITE_TAC[o_DEF] THEN REWRITE_TAC[ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE]; + X_GEN_TAC `z:real^1` THEN DISCH_TAC THEN + REWRITE_TAC[NORM_LIFT; DROP_CMUL; LIFT_DROP; REAL_ABS_RPOW; + REAL_ABS_NORM] THEN + REWRITE_TAC[RPOW_POW] THEN + SUBGOAL_THEN `norm(fourier f (drop z)) pow 2 = + norm(fourier f (drop z)) * norm(fourier f (drop z))` + SUBST1_TAC THENL [REWRITE_TAC[REAL_POW_2]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN + ASM_REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Plancherel-on-Schwartz in lnorm form: ||fhat||_2 = ||f||_2. Since *) +(* lproduct s f f = Cx((lnorm s 2 f) pow 2) (LPRODUCT_SELF_LNORM), this is *) +(* PARSEVAL_SCHWARTZ (lproduct fhat fhat = lproduct f f) with the two *) +(* nonnegative L^2 seminorms cancelled. *) +(* ------------------------------------------------------------------------- *) + +let PLANCHEREL_LNORM_SCHWARTZ = prove + (`!h:real->complex. schwartz h + ==> lnorm (:real^1) (&2) (\z. fourier h (drop z)) = + lnorm (:real^1) (&2) (\z. h (drop z))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\z:real^1. (h:real->complex) (drop z)) IN lspace (:real^1) (&2) /\ + (\z:real^1. fourier (h:real->complex) (drop z)) IN lspace (:real^1) (&2)` + STRIP_ASSUME_TAC THENL + [ASM_SIMP_TAC[SCHWARTZ_L2; SCHWARTZ_FOURIER_L2]; ALL_TAC] THEN + MATCH_MP_TAC REAL_POW_EQ THEN EXISTS_TAC `2` THEN + ASM_SIMP_TAC[LNORM_POS_LE; ARITH] THEN + REWRITE_TAC[GSYM CX_INJ] THEN + ASM_SIMP_TAC[GSYM LPRODUCT_SELF_LNORM] THEN + REWRITE_TAC[lproduct] THEN + MATCH_MP_TAC PARSEVAL_SCHWARTZ THEN ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Linearity of the transform on Schwartz functions (both integrands exist). *) +(* ------------------------------------------------------------------------- *) + +let SCHWARTZ_MOD_INT = prove + (`!h:real->complex y. schwartz h + ==> (\x. cexp(--(ii * Cx y * Cx(drop x))) * h(drop x)) integrable_on + (:real^1)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC FOURIER_MODULATION_ABSINT THEN MATCH_MP_TAC SCHWARTZ_ABSINT THEN + ASM_REWRITE_TAC[]);; + +let FOURIER_SUB_SCHWARTZ = prove + (`!h1 h2:real->complex. schwartz h1 /\ schwartz h2 + ==> !y. fourier (\x. h1 x - h2 x) y = fourier h1 y - fourier h2 y`, + REPEAT GEN_TAC THEN STRIP_TAC THEN GEN_TAC THEN + SUBGOAL_THEN + `(\x. h1 x - h2 x) = (\x:real. h1 x + (\x. --Cx(&1) * h2 x) x)` SUBST1_TAC + THENL + [REWRITE_TAC[FUN_EQ_THM] THEN CONV_TAC COMPLEX_RING; ALL_TAC] THEN + W(MP_TAC o PART_MATCH (lhand o rand) FOURIER_ADD o lhs o snd) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC SCHWARTZ_MOD_INT THEN ASM_REWRITE_TAC[]; + SUBGOAL_THEN + `(\x. cexp(--(ii * Cx y * Cx(drop x))) * (\x. --Cx(&1) * h2 x)(drop x)) + = + (\x. --Cx(&1) * (\x. cexp(--(ii * Cx y * Cx(drop x))) * h2(drop x)) x)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN CONV_TAC COMPLEX_RING; + MATCH_MP_TAC INTEGRABLE_COMPLEX_LMUL THEN + MATCH_MP_TAC SCHWARTZ_MOD_INT THEN ASM_REWRITE_TAC[]]]; + DISCH_THEN SUBST1_TAC] THEN + SUBGOAL_THEN + `fourier (\x. --Cx(&1) * h2 x) y = --Cx(&1) * fourier h2 y` + SUBST1_TAC THENL + [W(MP_TAC o PART_MATCH (lhand o rand) FOURIER_LMUL o lhs o snd) THEN + ANTS_TAC THENL + [MATCH_MP_TAC SCHWARTZ_MOD_INT THEN ASM_REWRITE_TAC[]; SIMP_TAC[]]; + CONV_TAC COMPLEX_RING]);; + +(* ------------------------------------------------------------------------- *) +(* 284O(a): Plancherel on all of L^2. Every f in L^2 has a Fourier transform *) +(* represented by g in L^2 with ||g||_2 = ||f||_2. g is the L^2 limit of the *) +(* classical transforms of a Schwartz approximating sequence (284N); the *) +(* transformed sequence is Cauchy by the Schwartz isometry (PLANCHEREL_DIFF) *) +(* and converges by completeness (RIESZ_FISCHER); norms pass to the limit. *) +(* ------------------------------------------------------------------------- *) + +(* Difference triangle and reverse triangle for the L^2 seminorm. *) +let LNORM_TRIANGLE_SUB = prove + (`!s (a:real^M->real^N) b c. + a IN lspace s (&2) /\ b IN lspace s (&2) /\ c IN lspace s (&2) + ==> lnorm s (&2) (\x. a x - c x) <= + lnorm s (&2) (\x. a x - b x) + lnorm s (&2) (\x. b x - c x)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(\x. (a:real^M->real^N) x - c x) = + (\x. (\x. a x - b x) x + (\x. b x - c x) x)` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN VECTOR_ARITH_TAC; + MATCH_MP_TAC LNORM_TRIANGLE THEN REWRITE_TAC[REAL_ARITH `&1 <= &2`] THEN + CONJ_TAC THEN MATCH_MP_TAC LSPACE_SUB THEN + ASM_REWRITE_TAC[REAL_ARITH `&0 <= &2`]]);; + +let LNORM_REV = prove + (`!s (a:real^M->real^N) b. + a IN lspace s (&2) /\ b IN lspace s (&2) + ==> abs(lnorm s (&2) a - lnorm s (&2) b) <= lnorm s (&2) (\x. a x - b + x)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `lnorm s (&2) (a:real^M->real^N) <= lnorm s (&2) b + lnorm s (&2) (\x. a x + - b x) /\ + lnorm s (&2) (b:real^M->real^N) <= lnorm s (&2) a + lnorm s + (&2) (\x. a x - b x)` + MP_TAC THENL + [CONJ_TAC THENL + [MP_TAC(ISPECL [`s:real^M->bool`; `&2`; `b:real^M->real^N`; + `\x. (a:real^M->real^N) x - b x`] + LNORM_TRIANGLE) THEN + ASM_SIMP_TAC[REAL_ARITH `&1 <= &2`; LSPACE_SUB; + REAL_ARITH `&0 <= &2`] THEN + MATCH_MP_TAC(REAL_ARITH `l = m ==> m <= r ==> l <= r`) THEN + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN VECTOR_ARITH_TAC; + MP_TAC(ISPECL [`s:real^M->bool`; `&2`; `a:real^M->real^N`; + `\x. (b:real^M->real^N) x - a x`] + LNORM_TRIANGLE) THEN + ASM_SIMP_TAC[REAL_ARITH `&1 <= &2`; LSPACE_SUB; + REAL_ARITH `&0 <= &2`] THEN + SUBGOAL_THEN `lnorm s (&2) (\x. (b:real^M->real^N) x - a x) = + lnorm s (&2) (\x. a x - b x)` SUBST1_TAC THENL + [REWRITE_TAC[LNORM_SUB_SYM]; ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `l = m ==> m <= r ==> l <= r`) THEN + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN VECTOR_ARITH_TAC]; + REAL_ARITH_TAC]);; + +(* Isometry on differences of Schwartz functions. *) +let PLANCHEREL_DIFF = prove + (`!a b:real->complex. schwartz a /\ schwartz b + ==> lnorm (:real^1) (&2) (\z. fourier a (drop z) - fourier b (drop z)) = + lnorm (:real^1) (&2) (\z. a (drop z) - b (drop z))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`a:real->complex`; + `b:real->complex`] FOURIER_SUB_SCHWARTZ) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + SUBGOAL_THEN + `(\z. fourier a (drop z) - fourier b (drop z)) = + (\z. fourier (\x. a x - b x) (drop z))` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN ASM_REWRITE_TAC[]; + MP_TAC(ISPEC `\x. (a:real->complex) x - b x` PLANCHEREL_LNORM_SCHWARTZ) + THEN + ANTS_TAC THENL + [MATCH_MP_TAC SCHWARTZ_SUB THEN ASM_REWRITE_TAC[]; + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[]]]);; + +(* A Schwartz sequence approximating f in L^2 at rate inv(n+1). *) +let SCHWARTZ_SEQ = prove + (`!f:real^1->real^2. f IN lspace (:real^1) (&2) + ==> ?fn:num->real->complex. + (!n. schwartz (fn n)) /\ + (!n. lnorm (:real^1) (&2) (\z. f z - fn n (drop z)) < inv(&n + + &1))`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP LSPACE_APPROXIMATE_SCHWARTZ) THEN + DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `inv(&n + &1)`) THEN + REWRITE_TAC[REAL_LT_INV_EQ] THEN + SIMP_TAC[REAL_ARITH `&0 <= &n ==> &0 < &n + &1`; REAL_POS] THEN + REWRITE_TAC[SKOLEM_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `fn:num->real->complex` THEN + REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN ASM_REWRITE_TAC[]);; + +let ABS_EPS_EQ = prove + (`!a b:real. (!e. &0 < e ==> abs(a - b) < e) ==> a = b`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(REAL_ARITH `~(&0 < abs(a - b)) ==> a = b`) THEN + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `abs(a - b:real)`) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* If gn ---> g in L^2 norm and ||gn n|| ---> c, then ||g|| = c. *) +(* The L^2 norm is continuous along L^2-convergent sequences (reverse *) +(* triangle inequality LNORM_REV), so its limit is unique. *) +(* ------------------------------------------------------------------------- *) + +let L2LIM_NORM = prove + (`!(gn:num->real^1->complex) g c. + (!n. gn n IN lspace (:real^1) (&2)) /\ g IN lspace (:real^1) (&2) /\ + (!e. &0 < e ==> ?N. !n. n >= N + ==> lnorm (:real^1) (&2) (\x. gn n x - g x) < e) /\ + ((\n. lnorm (:real^1) (&2) (gn n)) ---> c) sequentially + ==> lnorm (:real^1) (&2) g = c`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `((\n. lnorm (:real^1) (&2) ((gn:num->real^1->complex) n)) + ---> lnorm (:real^1) (&2) (g:real^1->complex)) sequentially` + ASSUME_TAC THENL + [REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `N:num` THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `lnorm (:real^1) (&2) (\x. (gn:num->real^1->complex) n x - g x)` + THEN + CONJ_TAC THENL + [MP_TAC(ISPECL [`(:real^1)`; `(gn:num->real^1->complex) n`; + `g:real^1->complex`] + LNORM_REV) THEN ASM_REWRITE_TAC[REAL_ABS_SUB]; + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[GE]]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`sequentially`; + `\n. lnorm (:real^1) (&2) ((gn:num->real^1->complex) n)`; + `lnorm (:real^1) (&2) (g:real^1->complex)`; `c:real`] REALLIM_UNIQUE) THEN + REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* 284O(b): bilinear Parseval on Schwartz functions. *) +(* = , i.e. INT f * cnj g = INT fhat * cnj ghat. *) +(* Generalises PARSEVAL_SCHWARTZ (the f = g diagonal) by the same route: *) +(* the multiplication formula 283O on (fhat, x |-> cnj(g(-x))), the *) +(* conjugate *) +(* -reflection bridge, and the double-transform reflection. Gives the *) +(* orthogonality of transforms with disjoint frequency support. *) +(* ------------------------------------------------------------------------- *) + +let PARSEVAL_SCHWARTZ_BILINEAR = prove + (`!(f:real->complex) (g:real->complex). schwartz f /\ schwartz g + ==> integral (:real^1) (\z. f(drop z) * cnj(g(drop z))) = + integral (:real^1) (\z. fourier f (drop z) * cnj(fourier g (drop + z)))`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP SCHWARTZ_ABSINT o + check(fun th -> concl th = `schwartz(g:real->complex)`)) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP SCHWARTZ_FHAT_ABSINT o + check(fun th -> concl th = `schwartz(f:real->complex)`)) THEN + MP_TAC(ISPECL [`fourier(f:real->complex)`; + `\x. cnj((g:real->complex)(--x))`] FOURIER_283O) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CNJ_REFLECT_ABSINT THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `integral (:real^1) (\z. fourier f (drop z) * fourier (\x. + cnj((g:real->complex)(--x))) (drop z)) = + integral (:real^1) (\z. fourier f (drop z) * cnj(fourier g (drop z)))` + SUBST1_TAC THENL + [MATCH_MP_TAC INTEGRAL_EQ THEN X_GEN_TAC `z:real^1` THEN DISCH_TAC THEN + REWRITE_TAC[] THEN AP_TERM_TAC THEN + MATCH_MP_TAC FOURIER_CNJ_REFLECT THEN MATCH_MP_TAC MODINT THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `integral (:real^1) (\z. fourier (fourier f) (drop z) * (\x. + cnj((g:real->complex)(--x))) (drop z)) = + integral (:real^1) (\z. f(--(drop z)) * cnj(g(--(drop z))))` + SUBST1_TAC THENL + [MATCH_MP_TAC INTEGRAL_EQ THEN X_GEN_TAC `z:real^1` THEN DISCH_TAC THEN + REWRITE_TAC[] THEN AP_THM_TAC THEN AP_TERM_TAC THEN + ONCE_REWRITE_TAC[GSYM REAL_NEG_NEG] THEN + ASM_SIMP_TAC[DOUBLE_TRANSFORM; REAL_NEG_NEG]; + DISCH_THEN SUBST1_TAC] THEN + MP_TAC(ISPEC `\t. (f:real->complex) t * cnj(g t)` INTEGRAL_REFLECT_R) THEN + REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN REFL_TAC);; + + +(* ========================================================================= *) +(* SECTION 12. Schwartz calculus continued (Fremlin 284C). *) +(* *) +(* Schwartz functions are closed under *) +(* differentiation (SCHWARTZ_DERIV), multiplication by x (SCHWARTZ_MUL_X), *) +(* affine reparametrisation and modulation (SCHWARTZ_AFFINE / _CMUL / *) +(* _MODULATE / _MODAFFINE), and -- the payoff -- under the Fourier transform *) +(* itself (SCHWARTZ_FOURIER, Fremlin 284C). Also the L^2 Fourier *) +(* representative FOURIER_L2_REP and bilinear-Parseval orthogonality of *) +(* disjoint-frequency-support transforms. *) +(* ========================================================================= *) + +(* ------------------------------------------------------------------------- *) +(* Schwartz closure under differentiation (via chain-shift). *) +(* ------------------------------------------------------------------------- *) + +(* Every function in a Schwartz derivative-chain is itself Schwartz. *) +let SCHWARTZ_CHAIN_ALL = prove + (`!h:real->complex. schwartz h + ==> ?d. d 0 = h /\ (!n. schwartz (d n)) /\ + (!n x. ((\z. d n(drop z)) has_vector_derivative d(SUC n) + x)(at(lift x)))`, + GEN_TAC THEN REWRITE_TAC[schwartz] THEN + DISCH_THEN(X_CHOOSE_THEN `d:num->real->complex` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `d:num->real->complex` THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `n:num` THEN + EXISTS_TAC `\j. (d:num->real->complex)(n + j)` THEN + REWRITE_TAC[ADD_CLAUSES] THEN CONJ_TAC THENL + [REPEAT GEN_TAC THEN REWRITE_TAC[ADD_SUC] THEN ASM_REWRITE_TAC[]; + MAP_EVERY X_GEN_TAC [`k:num`; `m:num`] THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`k:num`; `n + m:num`]) THEN + MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[]]);; + +let SCHWARTZ_DERIV = prove + (`!h h':real->complex. + schwartz h /\ (!x. ((\z. h(drop z)) has_vector_derivative h' x)(at(lift + x))) + ==> schwartz h'`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `d:num->real->complex` STRIP_ASSUME_TAC o + MATCH_MP SCHWARTZ_CHAIN_ALL) THEN + FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN + SUBGOAL_THEN + `!x. ((\z. (d:num->real->complex) 0 (drop z)) has_vector_derivative d 1 + x)(at(lift x))` + ASSUME_TAC THENL + [GEN_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`0`; `x:real`]) THEN + REWRITE_TAC[ARITH_RULE `SUC 0 = 1`]; ALL_TAC] THEN + SUBGOAL_THEN `h' = (d:num->real->complex) 1` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:real` THEN + MATCH_MP_TAC VECTOR_DERIVATIVE_UNIQUE_AT THEN + MAP_EVERY EXISTS_TAC [`\z. (d:num->real->complex) 0 (drop z)`; + `lift x`] THEN + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* The smooth plateau psi0 = rtheta(11-60x) rtheta(11+60x): *) +(* = 1 on [-1/6,1/6], supported in [-1/5,1/5], values in [0,1], even. *) +(* ------------------------------------------------------------------------- *) + +let MULX_DERIV_STEP = prove + (`!(a:real->complex) a' x. + ((\z. a(drop z)) has_vector_derivative a') (at(lift x)) + ==> ((\z. Cx(drop z) * a(drop z)) has_vector_derivative + (a x + Cx x * a')) (at(lift x))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`( * ):complex->complex->complex`; + `\z:real^1. Cx(drop z)`; `\z:real^1. (a:real->complex)(drop z)`; + `Cx(&1)`; `a':complex`; `lift x`] + HAS_VECTOR_DERIVATIVE_BILINEAR_AT) THEN + REWRITE_TAC[BILINEAR_COMPLEX_MUL; LIFT_DROP] THEN ANTS_TAC THENL + [CONJ_TAC THENL + [MP_TAC(ISPECL [`\t:real. t`; `&1`; `x:real`] CX_VECTOR_DERIV_BRIDGE) THEN + REWRITE_TAC[HAS_REAL_DERIVATIVE_ID; ETA_AX] THEN REWRITE_TAC[LIFT_DROP]; + ASM_REWRITE_TAC[]]; + MATCH_MP_TAC VDERIV_EQ THEN + CONV_TAC COMPLEX_RING]);; + +(* Schwartz closed under multiplication by x: the chain for x*h is *) +(* e m x = x (d m x) + m (d(m-1) x) (d = h's chain); e 0 = x h. *) +(* MULX_CHAIN_DERIV gives its derivative relation, and the decay bounds add. *) +let CMUL_PRED_DERIV = prove + (`!(d:num->real->complex) m x. + ~(m = 0) /\ + (!n x. ((\z. d n(drop z)) has_vector_derivative d(SUC n) x)(at(lift x))) + ==> ((\z. Cx(&m) * d(m-1)(drop z)) has_vector_derivative Cx(&m) * d m + x)(at(lift x))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `(d:num->real->complex) m = d(SUC(m-1))` ASSUME_TAC THENL + [AP_TERM_TAC THEN ASM_ARITH_TAC; ALL_TAC] THEN + ONCE_ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONST_CHAIN_DERIV THEN + ASM_REWRITE_TAC[]);; + +let MULX_CHAIN_DERIV = prove + (`!(d:num->real->complex). + (!n x. ((\z. d n(drop z)) has_vector_derivative d(SUC n) x)(at(lift x))) + ==> !m x. ((\z. Cx(drop z) * d m (drop z) + Cx(&m) * d(m-1)(drop z)) + has_vector_derivative + (Cx x * d(SUC m) x + Cx(&(SUC m)) * d((SUC m)-1) x))(at(lift + x))`, + GEN_TAC THEN DISCH_TAC THEN X_GEN_TAC `m:num` THEN X_GEN_TAC `x:real` THEN + REWRITE_TAC[SUC_SUB1] THEN + SUBGOAL_THEN + `Cx x * d(SUC m) x + Cx(&(SUC m)) * (d:num->real->complex) m x = + ((d:num->real->complex) m x + Cx x * d(SUC m) x) + Cx(&m) * d m x` + SUBST1_TAC THENL + [REWRITE_TAC[GSYM REAL_OF_NUM_SUC; CX_ADD] THEN + CONV_TAC COMPLEX_RING; ALL_TAC] THEN + MATCH_MP_TAC HAS_VECTOR_DERIVATIVE_ADD THEN CONJ_TAC THENL + [MATCH_MP_TAC MULX_DERIV_STEP THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_CASES_TAC `m = 0` THENL + [ASM_REWRITE_TAC[] THEN REWRITE_TAC[COMPLEX_MUL_LZERO] THEN + REWRITE_TAC[GSYM COMPLEX_VEC_0; HAS_VECTOR_DERIVATIVE_CONST]; + MATCH_MP_TAC CMUL_PRED_DERIV THEN ASM_REWRITE_TAC[]]);; + +let SCHWARTZ_MUL_X = prove + (`!h:real->complex. schwartz h ==> schwartz (\x. Cx x * h x)`, + GEN_TAC THEN REWRITE_TAC[schwartz] THEN + DISCH_THEN(X_CHOOSE_THEN `d:num->real->complex` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `\m. \x. Cx x * (d:num->real->complex) m x + Cx(&m) * d(m-1) x` + THEN + REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + REWRITE_TAC[COMPLEX_MUL_LZERO; COMPLEX_ADD_RID] THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC MULX_CHAIN_DERIV THEN ASM_REWRITE_TAC[]; + MAP_EVERY X_GEN_TAC [`k:num`; `m:num`] THEN + FIRST_ASSUM(X_CHOOSE_TAC `B1:real` o SPECL [`SUC k`; `m:num`]) THEN + FIRST_ASSUM(X_CHOOSE_TAC `B2:real` o SPECL [`k:num`; `m - 1`]) THEN + EXISTS_TAC `B1 + &m * B2:real` THEN X_GEN_TAC `x:real` THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `abs x pow k * (abs x * norm((d:num->real->complex) m x) + + &m * norm(d(m-1) x))` THEN + CONJ_TAC THENL + [MP_TAC(ISPECL [`abs x pow k`; + `norm(Cx x * (d:num->real->complex) m x + Cx(&m) * d(m-1) x)`; + `abs x * norm((d:num->real->complex) m x) + &m * norm(d(m-1) x)`] + REAL_LE_LMUL) THEN + ANTS_TAC THENL [ALL_TAC; SIMP_TAC[]] THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_POW_LE THEN REWRITE_TAC[REAL_ABS_POS]; + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `norm(Cx x * (d:num->real->complex) m x) + norm(Cx(&m) * + d(m-1) x)` THEN + REWRITE_TAC[NORM_TRIANGLE; COMPLEX_NORM_MUL; COMPLEX_NORM_CX; + REAL_ABS_NUM; + REAL_LE_REFL]]; + REWRITE_TAC[REAL_ADD_LDISTRIB] THEN MATCH_MP_TAC REAL_LE_ADD2 THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `abs x pow (SUC k) * norm((d:num->real->complex) m x)` THEN + CONJ_TAC THENL + [REWRITE_TAC[real_pow] THEN MATCH_MP_TAC REAL_EQ_IMP_LE THEN + CONV_TAC REAL_RING; + ASM_REWRITE_TAC[]]; + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&m * (abs x pow k * norm((d:num->real->complex)(m-1) x))` + THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_EQ_IMP_LE THEN CONV_TAC REAL_RING; + MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[REAL_POS]]]]]);; + +(* ------------------------------------------------------------------------- *) +(* Toward 284C, smoothness half: fourier g has a smooth derivative chain *) +(* when *) +(* g is Schwartz. d/dy (fourier g) = -i fourier(x g) (283Ch, all conditions *) +(* automatic for Schwartz), iterated: (fourier g)^(m) = (-i)^m fourier(x^m *) +(* g). *) +(* ------------------------------------------------------------------------- *) + +let FOURIER_SCHWARTZ_DERIV = prove + (`!g:real->complex y0. schwartz g + ==> ((\z. fourier g (drop z)) has_vector_derivative + (--ii * fourier (\x. Cx x * g x) y0)) (at(lift y0))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC FOURIER_283CH THEN CONJ_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC FOURIER_MODULATION_ABSINT THEN + MATCH_MP_TAC SCHWARTZ_ABSINT THEN ASM_REWRITE_TAC[]; + MP_TAC(ISPEC `g:real->complex` SCHWARTZ_MUL_X) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o MATCH_MP SCHWARTZ_ABSINT) THEN REWRITE_TAC[]]);; + +(* Transform of the derivative (the dual of FOURIER_SCHWARTZ_DERIV): for a *) +(* Schwartz h with derivative h', (h')^(y) = iy . h^(y). All the side *) +(* conditions of FOURIER_283CI are discharged from schwartz-ness (h' is *) +(* again *) +(* Schwartz by SCHWARTZ_DERIV; decay by SCHWARTZ_TENDSTO_*; modulated *) +(* integrability by FOURIER_MODULATION_ABSINT o SCHWARTZ_ABSINT). *) +let FOURIER_SCHWARTZ_DIFF = prove + (`!(h:real->complex) h' y. schwartz h /\ + (!x. ((\z. h(drop z)) has_vector_derivative (h' x)) (at(lift x))) + ==> fourier h' y = (ii * Cx y) * fourier h y`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC FOURIER_283CI THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `schwartz (h':real->complex)` ASSUME_TAC THENL + [MATCH_MP_TAC SCHWARTZ_DERIV THEN EXISTS_TAC `h:real->complex` THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC SCHWARTZ_TENDSTO_POS THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC SCHWARTZ_TENDSTO_NEG THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC FOURIER_MODULATION_ABSINT THEN + MATCH_MP_TAC SCHWARTZ_ABSINT THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC FOURIER_MODULATION_ABSINT THEN + MATCH_MP_TAC SCHWARTZ_ABSINT THEN ASM_REWRITE_TAC[]]);; + +(* The Schwartz sequence gg n = x^n g (all Schwartz). *) +let XPOW_SCHWARTZ_SEQ = prove + (`!g:real->complex. schwartz g + ==> ?gg. gg 0 = g /\ (!n. schwartz(gg n)) /\ + (!n. gg(SUC n) = (\t. Cx t * gg n t))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`\(n:num) (f:real->complex). schwartz f`; + `\(n:num) (f:real->complex) (f':real->complex). f' = (\t. Cx t * f t)`; + `g:real->complex`] DEPENDENT_CHOICE_FIXED) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [X_GEN_TAC `f:real->complex` THEN DISCH_TAC THEN + EXISTS_TAC `\t. Cx t * (f:real->complex) t` THEN + ASM_SIMP_TAC[SCHWARTZ_MUL_X]; + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `gg:num->real->complex` THEN + REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC THEN ASM_REWRITE_TAC[]]);; + +(* fourier g has a full smooth chain (each term (-i)^n fourier(x^n g)). *) +let FOURIER_SCHWARTZ_CHAIN = prove + (`!g:real->complex. schwartz g + ==> ?D. D 0 = (\y. fourier g y) /\ + (!n y. ((\z. D n (drop z)) has_vector_derivative D(SUC n) + y)(at(lift y)))`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(X_CHOOSE_THEN `gg:num->real->complex` STRIP_ASSUME_TAC o + MATCH_MP XPOW_SCHWARTZ_SEQ) THEN + EXISTS_TAC `\n. \y. (--ii) pow n * fourier ((gg:num->real->complex) n) y` + THEN + REWRITE_TAC[] THEN CONJ_TAC THENL + [REWRITE_TAC[complex_pow; COMPLEX_MUL_LID] THEN ASM_REWRITE_TAC[]; + REPEAT GEN_TAC THEN + SUBGOAL_THEN + `(--ii) pow SUC n * fourier ((gg:num->real->complex)(SUC n)) y = + (--ii) pow n * (--ii * fourier (\t. Cx t * gg n t) y)` + SUBST1_TAC THENL + [ASM_REWRITE_TAC[complex_pow] THEN CONV_TAC COMPLEX_RING; ALL_TAC] THEN + MATCH_MP_TAC CONST_CHAIN_DERIV THEN + MP_TAC(ISPECL [`(gg:num->real->complex) n`; + `y:real`] FOURIER_SCHWARTZ_DERIV) THEN + ASM_REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Toward 284C, decay half: a Schwartz function vanishes at infinity *) +(* (needed to apply 283Ci -- differentiation under the transform). *) +(* ------------------------------------------------------------------------- *) + +let INV_ABS_LIM = prove + (`((\x:real. inv(abs x)) ---> &0) at_posinfinity`, + REWRITE_TAC[REALLIM_AT_POSINFINITY] THEN X_GEN_TAC `e:real` THEN + DISCH_TAC THEN + EXISTS_TAC `inv e + &1:real` THEN X_GEN_TAC `x:real` THEN DISCH_TAC THEN + SUBGOAL_THEN `&0 < x /\ inv e < x` STRIP_ASSUME_TAC THENL + [MP_TAC(SPEC `e:real` REAL_LT_INV) THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < x ==> abs x = x`; REAL_SUB_RZERO; + REAL_ABS_INV] THEN + ONCE_REWRITE_TAC[GSYM REAL_INV_INV] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_INV_INV] THEN + MATCH_MP_TAC REAL_LT_INV2 THEN ASM_SIMP_TAC[REAL_LT_INV; REAL_INV_INV]);; + +let BINV_LIFT_LIM = prove + (`!B. ((\x. lift(B * inv(abs x))) --> vec 0) at_posinfinity`, + GEN_TAC THEN REWRITE_TAC[LIFT_CMUL] THEN + SUBST1_TAC(VECTOR_ARITH `vec 0:real^1 = B % vec 0`) THEN + MATCH_MP_TAC LIM_CMUL THEN + MP_TAC INV_ABS_LIM THEN REWRITE_TAC[REAL_TENDSTO] THEN + REWRITE_TAC[o_DEF; LIFT_DROP; DROP_VEC]);; + +let SCHWARTZ_VANISH = prove + (`!h:real->complex. schwartz h ==> (h --> vec 0) at_posinfinity`, + GEN_TAC THEN REWRITE_TAC[schwartz] THEN + DISCH_THEN(X_CHOOSE_THEN `d:num->real->complex` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN + FIRST_ASSUM(X_CHOOSE_TAC `B:real` o SPECL [`1`; `0`]) THEN + RULE_ASSUM_TAC(REWRITE_RULE[REAL_POW_1]) THEN + MATCH_MP_TAC LIM_NULL_COMPARISON THEN + EXISTS_TAC `\x. B * inv(abs x)` THEN REWRITE_TAC[BINV_LIFT_LIM] THEN + REWRITE_TAC[EVENTUALLY_AT_POSINFINITY] THEN EXISTS_TAC `&1` THEN + X_GEN_TAC `x:real` THEN DISCH_TAC THEN + SUBGOAL_THEN `&0 < abs x` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[GSYM real_div] THEN ASM_SIMP_TAC[REAL_LE_RDIV_EQ] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real`) THEN REAL_ARITH_TAC);; + +(* Schwartz closed under reflection; reflected vanishing; the *) +(* y-multiplication *) +(* identity iy fourier(h) = fourier(h') (283Ci for Schwartz, all conditions *) +(* automatic). Iterating this brings down y^k, bounding |y|^k norm(fourier *) +(* h). *) +let SCHWARTZ_REFLECT = prove + (`!h:real->complex. schwartz h ==> schwartz (\x. h(--x))`, + GEN_TAC THEN REWRITE_TAC[schwartz] THEN + DISCH_THEN(X_CHOOSE_THEN `d:num->real->complex` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `\n:num. \x. Cx(-- &1) pow n * (d:num->real->complex) n (&0 + -- + &1 * x)` THEN + REWRITE_TAC[complex_pow; COMPLEX_MUL_LID] THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + REWRITE_TAC[REAL_ARITH `&0 + -- &1 * x = --x`] THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[GSYM complex_pow] THEN + MP_TAC(ISPECL [`d:num->real->complex`; `&0`; `-- &1`] AFFINE_CHAIN) THEN + ASM_REWRITE_TAC[]; + MAP_EVERY X_GEN_TAC [`k:num`; `m:num`] THEN + REWRITE_TAC[REAL_ARITH `&0 + -- &1 * x = --x`] THEN + FIRST_ASSUM(X_CHOOSE_TAC `B:real` o SPECL [`k:num`; `m:num`]) THEN + EXISTS_TAC `B:real` THEN X_GEN_TAC `x:real` THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_POW; COMPLEX_NORM_CX] THEN + REWRITE_TAC[REAL_ABS_NEG; REAL_ABS_NUM; REAL_POW_ONE; REAL_MUL_LID] THEN + ONCE_REWRITE_TAC[REAL_ARITH `abs x = abs(--x)`] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `--x:real`) THEN REWRITE_TAC[REAL_ABS_NEG]]);; + +let SCHWARTZ_VANISH_NEG = prove + (`!h:real->complex. schwartz h ==> ((\a. h(--a)) --> vec 0) at_posinfinity`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `\x. (h:real->complex)(--x)` SCHWARTZ_VANISH) THEN + ASM_SIMP_TAC[SCHWARTZ_REFLECT]);; + +let SCHWARTZ_MOD_ABSINT = prove + (`!h:real->complex y. schwartz h + ==> (\x. cexp(--(ii * Cx y * Cx(drop x))) * h(drop x)) + absolutely_integrable_on (:real^1)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC FOURIER_MODULATION_ABSINT THEN + MATCH_MP_TAC SCHWARTZ_ABSINT THEN ASM_REWRITE_TAC[]);; + +(* y-uniform form (one hp = h' for all y). *) +let FOURIER_SCHWARTZ_YMUL_U = prove + (`!h:real->complex. schwartz h + ==> ?hp. schwartz hp /\ !y. fourier hp y = (ii * Cx y) * fourier h y`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(X_CHOOSE_THEN `d:num->real->complex` STRIP_ASSUME_TAC o + MATCH_MP SCHWARTZ_CHAIN_ALL) THEN + EXISTS_TAC `(d:num->real->complex) 1` THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[]; ALL_TAC] THEN + X_GEN_TAC `y:real` THEN + FIRST_X_ASSUM(fun th -> if concl th = `(d:num->real->complex) 0 = h` then + SUBST1_TAC(SYM th) else NO_TAC) THEN + MATCH_MP_TAC FOURIER_283CI THEN REPEAT CONJ_TAC THENL + [X_GEN_TAC `x:real` THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`0`; `x:real`]) THEN + REWRITE_TAC[ARITH_RULE `SUC 0 = 1`]; + MATCH_MP_TAC SCHWARTZ_VANISH THEN REWRITE_TAC[ETA_AX] THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC SCHWARTZ_VANISH_NEG THEN REWRITE_TAC[ETA_AX] THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC SCHWARTZ_MOD_ABSINT THEN REWRITE_TAC[ETA_AX] THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC SCHWARTZ_MOD_ABSINT THEN REWRITE_TAC[ETA_AX] THEN + ASM_REWRITE_TAC[]]);; + +(* Decay: |y|^k norm(fourier h y) is bounded, for every k (iterate the *) +(* y-multiplication identity; base case = FOURIER_BOUND_UNIFORM). *) +let FOURIER_SCHWARTZ_YPOW_BOUND = prove + (`!k. !h:real->complex. schwartz h + ==> ?B. !y. abs y pow k * norm(fourier h y) <= B`, + INDUCT_TAC THENL + [REPEAT STRIP_TAC THEN REWRITE_TAC[real_pow; REAL_MUL_LID] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP SCHWARTZ_ABSINT) THEN + DISCH_THEN(MP_TAC o MATCH_MP FOURIER_BOUND_UNIFORM) THEN + MATCH_MP_TAC MONO_EXISTS THEN REWRITE_TAC[]; + REPEAT STRIP_TAC THEN + FIRST_ASSUM(X_CHOOSE_THEN `hp:real->complex` STRIP_ASSUME_TAC o + MATCH_MP FOURIER_SCHWARTZ_YMUL_U) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `hp:real->complex`) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `B:real` THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `y:real` THEN + MATCH_MP_TAC(REAL_ARITH `a = b ==> b <= B ==> a <= B`) THEN + ASM_REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_II; COMPLEX_NORM_CX] THEN + REWRITE_TAC[real_pow] THEN REAL_ARITH_TAC]);; + +(* Fremlin 284C(a): the Fourier transform of a Schwartz function is *) +(* Schwartz. *) +let SCHWARTZ_FOURIER = prove + (`!g:real->complex. schwartz g ==> schwartz (fourier g)`, + GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(X_CHOOSE_THEN `gg:num->real->complex` STRIP_ASSUME_TAC o + MATCH_MP XPOW_SCHWARTZ_SEQ) THEN + REWRITE_TAC[schwartz] THEN + EXISTS_TAC `\n. \y. (--ii) pow n * fourier ((gg:num->real->complex) n) y` + THEN + REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[complex_pow; COMPLEX_MUL_LID; FUN_EQ_THM] THEN + ASM_REWRITE_TAC[]; + REPEAT GEN_TAC THEN + SUBGOAL_THEN + `(--ii) pow SUC n * fourier ((gg:num->real->complex)(SUC n)) x = + (--ii) pow n * (--ii * fourier (\t. Cx t * gg n t) x)` + SUBST1_TAC THENL + [ASM_REWRITE_TAC[complex_pow] THEN CONV_TAC COMPLEX_RING; ALL_TAC] THEN + MATCH_MP_TAC CONST_CHAIN_DERIV THEN + MP_TAC(ISPECL [`(gg:num->real->complex) n`; + `x:real`] FOURIER_SCHWARTZ_DERIV) THEN + ASM_REWRITE_TAC[]; + MAP_EVERY X_GEN_TAC [`k:num`; `m:num`] THEN + MP_TAC(ISPECL [`k:num`; + `(gg:num->real->complex) m`] FOURIER_SCHWARTZ_YPOW_BOUND) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `B:real` THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `x:real` THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_POW; NORM_NEG; + COMPLEX_NORM_II] THEN + REWRITE_TAC[REAL_POW_ONE; REAL_MUL_LID]]);; + +(* ------------------------------------------------------------------------- *) +(* Fremlin 284O(a): every square-integrable f has a Fourier transform *) +(* REPRESENTED by a square-integrable g (in the tempered/distributional *) +(* sense *) +(* of 284H: INT g*h = INT f*fourier h for every Schwartz h), with *) +(* ||g||_2 = ||f||_2. The "represents" relation (not just the norm identity) *) +(* is what lets one identify g's own Fourier transform with f (284Ib). *) +(* *) +(* Proof (Fremlin's): fn Schwartz with ||f-fn||->0 (SCHWARTZ_SEQ); the *) +(* transforms gn = fourier(fn) are L^2-Cauchy (PLANCHEREL_DIFF) so converge *) +(* to some g (RIESZ_FISCHER) with ||g||=lim||gn||=lim||fn||=||f|| *) +(* (L2LIM_NORM). *) +(* For the represents clause, INT gn*h = INT fn*fourier h for each n (283O), *) +(* and both sides converge (LPRODUCT_L2LIM: gn->g and fn->f in L^2, h and *) +(* fourier h being fixed L^2 functions), so INT g*h = INT f*fourier h. *) +(* ------------------------------------------------------------------------- *) + +let FOURIER_L2_REP = prove + (`!f:real^1->complex. f IN lspace (:real^1) (&2) + ==> ?g:real^1->complex. g IN lspace (:real^1) (&2) /\ + lnorm (:real^1) (&2) g = lnorm (:real^1) (&2) f /\ + (!h. schwartz h + ==> integral (:real^1) (\z. g z * h(drop z)) = + integral (:real^1) (\z. f z * fourier h (drop z)))`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(X_CHOOSE_THEN `fn:num->real->complex` STRIP_ASSUME_TAC o + MATCH_MP SCHWARTZ_SEQ) THEN + ABBREV_TAC `gn = \n. \z:real^1. fourier ((fn:num->real->complex) n) (drop z)` + THEN + SUBGOAL_THEN + `!n. (gn:num->real^1->complex) n IN lspace (:real^1) (&2)` ASSUME_TAC THENL + [GEN_TAC THEN EXPAND_TAC "gn" THEN REWRITE_TAC[] THEN + MATCH_MP_TAC SCHWARTZ_FOURIER_L2 THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `!n. (\z:real^1. (fn:num->real->complex) n (drop z)) + IN lspace (:real^1) (&2)` + ASSUME_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC SCHWARTZ_L2 THEN REWRITE_TAC[ETA_AX] THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + (* fn ---> f mode (from SCHWARTZ_SEQ inv-bound) *) + SUBGOAL_THEN + `!e. &0 < e ==> ?N. !n. n >= N + ==> lnorm (:real^1) (&2) (\z. (fn:num->real->complex) n (drop z) - f z) + < e` + (LABEL_TAC "FNCONV") THENL + [X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(SPEC `e:real` REAL_ARCH_INV) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `N:num` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + SUBGOAL_THEN + `lnorm (:real^1) (&2) (\z. (fn:num->real->complex) n (drop z) - f z) = + lnorm (:real^1) (&2) (\z. f z - fn n (drop z))` SUBST1_TAC + THENL + [REWRITE_TAC[LNORM_SUB_SYM]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `inv(&n + &1)` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `inv(&N)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INV2 THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_LT] THEN ASM_ARITH_TAC; + RULE_ASSUM_TAC(REWRITE_RULE[GE; GSYM REAL_OF_NUM_LE]) THEN + ASM_REAL_ARITH_TAC]; + ASM_SIMP_TAC[REAL_LT_IMP_LE]]; + ALL_TAC] THEN + (* gn Cauchy in L2 (via PLANCHEREL_DIFF) *) + SUBGOAL_THEN + `!m n. lnorm (:real^1) (&2) (\z. (gn:num->real^1->complex) m z - gn n z) = + lnorm (:real^1) (&2) (\z. (fn:num->real->complex) m (drop z) - fn n + (drop z))` + ASSUME_TAC THENL + [REPEAT GEN_TAC THEN EXPAND_TAC "gn" THEN REWRITE_TAC[] THEN + MATCH_MP_TAC PLANCHEREL_DIFF THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `!e. &0 < e ==> ?N. !m n. m >= N /\ n >= N + ==> lnorm (:real^1) (&2) (\z. (gn:num->real^1->complex) m z - gn n z) < + e` + ASSUME_TAC THENL + [X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(SPEC `e / &2` REAL_ARCH_INV) THEN ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `N:num` THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `lnorm (:real^1) (&2) (\z. (fn:num->real->complex) m (drop z) - + f z) + + lnorm (:real^1) (&2) (\z. f z - fn n (drop z))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC LNORM_TRIANGLE_SUB THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `e / &2 + e / &2` THEN + CONJ_TAC THENL [ALL_TAC; REAL_ARITH_TAC] THEN + MATCH_MP_TAC REAL_LT_ADD2 THEN CONJ_TAC THENL + [SUBGOAL_THEN + `lnorm (:real^1) (&2) (\z. (fn:num->real->complex) m (drop z) - f z) = + lnorm (:real^1) (&2) (\z. f z - fn m (drop z))` SUBST1_TAC + THENL + [REWRITE_TAC[LNORM_SUB_SYM]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `inv(&m + &1)` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `inv(&N)` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INV2 THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_LT] THEN ASM_ARITH_TAC; + RULE_ASSUM_TAC(REWRITE_RULE[GE; GSYM REAL_OF_NUM_LE]) THEN + ASM_REAL_ARITH_TAC]; + ASM_SIMP_TAC[REAL_LT_IMP_LE]]; + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `inv(&n + &1)` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `inv(&N)` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INV2 THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_LT] THEN ASM_ARITH_TAC; + RULE_ASSUM_TAC(REWRITE_RULE[GE; GSYM REAL_OF_NUM_LE]) THEN + ASM_REAL_ARITH_TAC]; + ASM_SIMP_TAC[REAL_LT_IMP_LE]]]; + ALL_TAC] THEN + MP_TAC(ISPECL [`gn:num->real^1->complex`; `&2`; + `(:real^1)`] RIESZ_FISCHER) THEN + ASM_REWRITE_TAC[REAL_ARITH `&1 <= &2`] THEN + DISCH_THEN(X_CHOOSE_THEN `g:real^1->complex` + (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "RCONV"))) THEN + EXISTS_TAC `g:real^1->complex` THEN ASM_REWRITE_TAC[] THEN + (* per-index Plancherel norm ||gn n|| = ||fn n|| *) + SUBGOAL_THEN + `!n. lnorm (:real^1) (&2) ((gn:num->real^1->complex) n) = + lnorm (:real^1) (&2) (\z. (fn:num->real->complex) n (drop z))` + (LABEL_TAC "PNORM") THENL + [GEN_TAC THEN EXPAND_TAC "gn" THEN REWRITE_TAC[] THEN + MATCH_MP_TAC PLANCHEREL_LNORM_SCHWARTZ THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + (* ||fn n|| ---> ||f|| (from FNCONV via L2LIM_NORM), hence ||gn n|| ---> *) + (* ||f|| *) + SUBGOAL_THEN + `((\n. lnorm (:real^1) (&2) ((gn:num->real^1->complex) n)) + ---> lnorm (:real^1) (&2) (f:real^1->complex)) sequentially` + (LABEL_TAC "GNORMLIM") THENL + [SUBGOAL_THEN + `(\n. lnorm (:real^1) (&2) ((gn:num->real^1->complex) n)) = + (\n. lnorm (:real^1) (&2) (\z. (fn:num->real->complex) n (drop z)))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + USE_THEN "PNORM" (fun th -> REWRITE_TAC[th]); ALL_TAC] THEN + REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + USE_THEN "FNCONV" (MP_TAC o SPEC `e:real`) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `N:num` THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `lnorm (:real^1) (&2) + (\z. (\z:real^1. (fn:num->real->complex) n (drop z)) z - f z)` THEN + CONJ_TAC THENL + [MP_TAC(ISPECL [`(:real^1)`; + `\z:real^1. (fn:num->real->complex) n (drop z)`; + `f:real^1->complex`] LNORM_REV) THEN ASM_REWRITE_TAC[REAL_ABS_SUB]; + REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[GE]]; + ALL_TAC] THEN + CONJ_TAC THENL + [(* NORM EQUALITY via L2LIM_NORM *) + MATCH_MP_TAC L2LIM_NORM THEN + EXISTS_TAC `gn:num->real^1->complex` THEN + ASM_REWRITE_TAC[] THEN USE_THEN "RCONV" (fun th -> REWRITE_TAC[th]); + ALL_TAC] THEN + (* THE REPRESENTS PROPERTY *) + X_GEN_TAC `h:real->complex` THEN DISCH_TAC THEN + MATCH_MP_TAC(ISPEC `sequentially` LIM_UNIQUE) THEN + EXISTS_TAC `\n. integral (:real^1) (\z. (gn:num->real^1->complex) n z * + h(drop z))` THEN + REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN CONJ_TAC THENL + [(* LHS: int gn*h ---> int g*h, via gn ---> g *) + SUBGOAL_THEN + `(\z:real^1. cnj(h(drop z))) IN lspace (:real^1) (&2)` ASSUME_TAC THENL + [MATCH_MP_TAC LSPACE_CNJ THEN MATCH_MP_TAC SCHWARTZ_L2 THEN + ASM_REWRITE_TAC[ETA_AX]; ALL_TAC] THEN + SUBGOAL_THEN + `!a:real^1->complex. integral (:real^1) (\z. a z * h(drop z)) = + lproduct (:real^1) a (\z. cnj(h(drop z)))` + (fun th -> REWRITE_TAC[th]) THENL + [GEN_TAC THEN REWRITE_TAC[lproduct; CNJ_CNJ]; ALL_TAC] THEN + MATCH_MP_TAC LPRODUCT_L2LIM THEN ASM_REWRITE_TAC[ETA_AX] THEN + USE_THEN "RCONV" (fun th -> REWRITE_TAC[th]); + ALL_TAC] THEN + (* the sequence int gn*h EQUALS int fn*fhat (per n), which ---> int f*fhat *) + SUBGOAL_THEN + `!n. integral (:real^1) (\z. (gn:num->real^1->complex) n z * h(drop z)) = + integral (:real^1) (\z. (fn:num->real->complex) n (drop z) * fourier h + (drop z))` + (fun th -> REWRITE_TAC[th]) THENL + [GEN_TAC THEN EXPAND_TAC "gn" THEN REWRITE_TAC[] THEN + MP_TAC(ISPECL [`(fn:num->real->complex) n`; + `h:real->complex`] FOURIER_283O) THEN + ANTS_TAC THENL + [CONJ_TAC THEN MATCH_MP_TAC SCHWARTZ_ABSINT THEN ASM_REWRITE_TAC[ETA_AX]; + DISCH_THEN(SUBST1_TAC o SYM) THEN REFL_TAC]; + ALL_TAC] THEN + (* RHS: int fn*fhat ---> int f*fhat, via fn ---> f, with fixed fourier h *) + (* (Schwartz) *) + SUBGOAL_THEN `schwartz (fourier h)` ASSUME_TAC THENL + [MATCH_MP_TAC SCHWARTZ_FOURIER THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `(\z:real^1. cnj(fourier h (drop z))) IN lspace (:real^1) (&2)` ASSUME_TAC + THENL + [MATCH_MP_TAC LSPACE_CNJ THEN MATCH_MP_TAC SCHWARTZ_L2 THEN + ASM_REWRITE_TAC[ETA_AX]; ALL_TAC] THEN + SUBGOAL_THEN + `(\n. integral (:real^1) (\z. (fn:num->real->complex) n (drop z) * fourier h + (drop z))) = + (\n. lproduct (:real^1) (\z. (fn:num->real->complex) n (drop z)) + (\z. cnj(fourier h (drop z))))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN REWRITE_TAC[lproduct; CNJ_CNJ]; + ALL_TAC] THEN + SUBGOAL_THEN + `integral (:real^1) (\z. f z * fourier h (drop z)) = + lproduct (:real^1) (f:real^1->complex) (\z. cnj(fourier h (drop z)))` + SUBST1_TAC THENL + [REWRITE_TAC[lproduct; CNJ_CNJ]; ALL_TAC] THEN + MP_TAC(ISPECL + [`\n. \z:real^1. (fn:num->real->complex) n (drop z)`; + `f:real^1->complex`; `\z:real^1. cnj(fourier h (drop z))`; + `(:real^1)`] LPRODUCT_L2LIM) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + USE_THEN "FNCONV" (fun th -> REWRITE_TAC[th]));; + +(* ------------------------------------------------------------------------- *) +(* Change-of-variable helpers: an invertible affine map is a bijection of R, *) +(* so integral/integrability transfer under dilation and shift. *) +(* ------------------------------------------------------------------------- *) + +let AFFINE_IMAGE_UNIV = prove + (`!c:real b:real^1. ~(c = &0) + ==> IMAGE (\x. inv c % x + --(inv c % b)) (:real^1) = (:real^1)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[EXTENSION; IN_IMAGE; IN_UNIV] THEN + X_GEN_TAC `x:real^1` THEN EXISTS_TAC `c % x + b:real^1` THEN + REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC] THEN + ASM_SIMP_TAC[REAL_MUL_LINV; VECTOR_MUL_LID] THEN VECTOR_ARITH_TAC);; + +(* Dilation change-of-variables on the whole line (from *) +(* HAS_INTEGRAL_AFFINITY): INT ff(c x + b) = (1/|c|) INT ff, and ff(c.+b) *) +(* stays integrable. *) +let INTEGRAL_DILATE_UNIV = prove + (`!(ff:real^1->real^N) c b. ~(c = &0) /\ ff integrable_on (:real^1) + ==> integral (:real^1) (\x. ff(c % x + b)) = inv(abs c) % integral + (:real^1) ff`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`ff:real^1->real^N`; `integral (:real^1) (ff:real^1->real^N)`; + `(:real^1)`; `c:real`; `b:real^1`] HAS_INTEGRAL_AFFINITY) THEN + ASM_SIMP_TAC[INTEGRABLE_INTEGRAL; AFFINE_IMAGE_UNIV; DIMINDEX_1; + REAL_POW_1] THEN + DISCH_THEN(SUBST1_TAC o MATCH_MP INTEGRAL_UNIQUE) THEN REFL_TAC);; + +let INTEGRABLE_DILATE_UNIV = prove + (`!(ff:real^1->real^N) c b. ~(c = &0) /\ ff integrable_on (:real^1) + ==> (\x. ff(c % x + b)) integrable_on (:real^1)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`ff:real^1->real^N`; `integral (:real^1) (ff:real^1->real^N)`; + `(:real^1)`; `c:real`; `b:real^1`] HAS_INTEGRAL_AFFINITY) THEN + ASM_SIMP_TAC[INTEGRABLE_INTEGRAL; AFFINE_IMAGE_UNIV] THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_INTEGRAL_INTEGRABLE) THEN REWRITE_TAC[]);; + +(* Polynomial-moment bounds for an affine reparametrisation, feeding *) +(* SCHWARTZ_AFFINE: |x|^k is dominated by a constant times max(1,|x|)^k, *) +(* which expands through (c + s x) by the binomial-type bound below. *) +let MAXPOW_LE = prove + (`!C t k. &0 <= C /\ &0 <= t ==> (max C t) pow k <= C pow k + t pow k`, + REPEAT STRIP_TAC THEN + DISJ_CASES_TAC(REAL_ARITH `t <= C \/ C <= t`) THENL + [ASM_SIMP_TAC[REAL_ARITH `t <= C ==> max C t = C`] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= y ==> x <= x + y`) THEN + MATCH_MP_TAC REAL_POW_LE THEN ASM_REWRITE_TAC[]; + ASM_SIMP_TAC[REAL_ARITH `C <= t ==> max C t = t`] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> y <= x + y`) THEN + MATCH_MP_TAC REAL_POW_LE THEN ASM_REWRITE_TAC[]]);; + +let POW_ADD_2BOUND = prove + (`!C t k. &0 <= C /\ &0 <= t + ==> (C + t) pow k <= &2 pow k * (C pow k + t pow k)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(&2 * max C t) pow k` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_POW_LE2 THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[REAL_POW_MUL] THEN + MP_TAC(SPECL [`C:real`; `t:real`; `k:num`] MAXPOW_LE) THEN + ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN + MP_TAC(ISPECL [`&2 pow k`; `(max C t) pow k`; `(C:real) pow k + t pow k`] + REAL_LE_LMUL) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_POW_LE THEN REAL_ARITH_TAC; + REWRITE_TAC[]]]);; + +let AFFINE_XPOW_BOUND = prove + (`!s c k x. ~(s = &0) + ==> abs x pow k <= inv(abs s pow k) * (&2 pow k * (abs(c + s * x) pow k + + abs c pow k))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `abs x = inv(abs s) * abs((c + s * x) - c)` SUBST1_TAC THENL + [REWRITE_TAC[GSYM REAL_ABS_INV; GSYM REAL_ABS_MUL] THEN AP_TERM_TAC THEN + UNDISCH_TAC `~(s = &0)` THEN CONV_TAC REAL_FIELD; + ALL_TAC] THEN + REWRITE_TAC[REAL_POW_MUL; GSYM REAL_POW_INV] THEN + MP_TAC(ISPECL [`inv(abs s) pow k`; `abs((c + s * x) - c) pow k`; + `&2 pow k * (abs(c + s * x) pow k + abs c pow k)`] + REAL_LE_LMUL) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC REAL_POW_LE THEN REWRITE_TAC[REAL_LE_INV_EQ; REAL_ABS_POS]; + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(abs(c + s * x) + abs c) pow k` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_POW_LE2 THEN REWRITE_TAC[REAL_ABS_POS] THEN + REAL_ARITH_TAC; + MATCH_MP_TAC POW_ADD_2BOUND THEN REWRITE_TAC[REAL_ABS_POS]]]; + REWRITE_TAC[]]);; + +let AFFINE_WEIGHT_BOUND = prove + (`!s c k x N B0 Bk. + ~(s = &0) /\ &0 <= N /\ + abs(c + s * x) pow k * N <= Bk /\ N <= B0 + ==> abs x pow k * N <= + inv(abs s pow k) * (&2 pow k * (Bk + abs c pow k * B0))`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(inv(abs s pow k) * (&2 pow k * (abs(c + s * x) pow k + abs c pow + k))) * N` THEN + CONJ_TAC THENL + [MP_TAC(ISPECL [`abs x pow k`; + `inv(abs s pow k) * (&2 pow k * (abs(c + s * x) pow k + abs c pow k))`; + `N:real`] + REAL_LE_RMUL) THEN + ASM_SIMP_TAC[AFFINE_XPOW_BOUND]; + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN + MP_TAC(ISPECL [`inv(abs s pow k)`; + `&2 pow k * (abs(c + s * x) pow k + abs c pow k) * N`; + `&2 pow k * (Bk + abs c pow k * B0)`] REAL_LE_LMUL) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INV THEN MATCH_MP_TAC REAL_POW_LE THEN + REWRITE_TAC[REAL_ABS_POS]; + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN + MP_TAC(ISPECL [`&2 pow k`; + `(abs(c + s * x) pow k + abs c pow k) * N`; `Bk + abs c pow k * B0`] + REAL_LE_LMUL) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC REAL_POW_LE THEN REAL_ARITH_TAC; + REWRITE_TAC[REAL_ADD_RDISTRIB] THEN MATCH_MP_TAC REAL_LE_ADD2 THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN + MP_TAC(ISPECL [`abs c pow k`; `N:real`; + `B0:real`] REAL_LE_LMUL) THEN + ASM_SIMP_TAC[REAL_POW_LE; REAL_ABS_POS]]; + REWRITE_TAC[]]]; + REWRITE_TAC[]]]);; + +let SCHWARTZ_AFFINE = prove + (`!phi:real->complex s c. schwartz phi /\ ~(s = &0) + ==> schwartz (\x. phi(c + s * x))`, + REPEAT GEN_TAC THEN REWRITE_TAC[schwartz] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `d:num->real->complex` STRIP_ASSUME_TAC) ASSUME_TAC) THEN + EXISTS_TAC `\n:num. \x. Cx s pow n * (d:num->real->complex) n (c + s * x)` + THEN + REWRITE_TAC[complex_pow; COMPLEX_MUL_LID] THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN ASM_REWRITE_TAC[]; + MP_TAC(ISPECL [`d:num->real->complex`; `c:real`; + `s:real`] AFFINE_CHAIN) THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[complex_pow]; + MAP_EVERY X_GEN_TAC [`k:num`; `m:num`] THEN + FIRST_ASSUM(X_CHOOSE_TAC `B0:real` o SPECL [`0`; `m:num`]) THEN + FIRST_ASSUM(X_CHOOSE_TAC `Bk:real` o SPECL [`k:num`; `m:num`]) THEN + RULE_ASSUM_TAC(REWRITE_RULE[real_pow; REAL_MUL_LID]) THEN + EXISTS_TAC `abs s pow m * (inv(abs s pow k) * (&2 pow k * (Bk + abs c pow k + * B0)))` THEN + X_GEN_TAC `x:real` THEN + REWRITE_TAC[COMPLEX_NORM_MUL; COMPLEX_NORM_POW; COMPLEX_NORM_CX] THEN + REWRITE_TAC[REAL_ARITH `ak * (asm * n):real = asm * (ak * n)`] THEN + MP_TAC(ISPECL [`abs s pow m`; + `abs x pow k * norm((d:num->real->complex) m (c + s * x))`; + `inv(abs s pow k) * (&2 pow k * (Bk + abs c pow k * B0))`] + REAL_LE_LMUL) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC REAL_POW_LE THEN REWRITE_TAC[REAL_ABS_POS]; + MATCH_MP_TAC AFFINE_WEIGHT_BOUND THEN ASM_REWRITE_TAC[NORM_POS_LE]]; + MATCH_MP_TAC(REAL_ARITH `x = y ==> a <= x ==> a <= y`) THEN + REWRITE_TAC[REAL_MUL_AC]]]);; + +(* ------------------------------------------------------------------------- *) +(* Schwartz closed under multiplication by a complex constant. Trivial: same *) +(* chain scaled by c, decay bounds scaled by norm c. *) +(* ------------------------------------------------------------------------- *) + +let SCHWARTZ_CMUL = prove + (`!(h:real->complex) c. schwartz h ==> schwartz (\x. c * h x)`, + REPEAT GEN_TAC THEN REWRITE_TAC[schwartz] THEN + DISCH_THEN(X_CHOOSE_THEN `d:num->real->complex` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `\n x. c * (d:num->real->complex) n x` THEN + REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[FUN_EQ_THM]; + REPEAT GEN_TAC THEN MATCH_MP_TAC CONST_CHAIN_DERIV THEN ASM_REWRITE_TAC[]; + REPEAT GEN_TAC THEN + FIRST_X_ASSUM(X_CHOOSE_TAC `B:real` o SPECL [`k:num`; `m:num`]) THEN + EXISTS_TAC `norm(c:complex) * B` THEN X_GEN_TAC `x:real` THEN + REWRITE_TAC[COMPLEX_NORM_MUL] THEN + GEN_REWRITE_TAC LAND_CONV [REAL_ARITH `!a b cc:real. a * b * cc = b * (a * + cc)`] THEN + MP_TAC(ISPECL [`norm(c:complex)`; + `abs x pow k * norm((d:num->real->complex) m x)`; + `B:real`] REAL_LE_LMUL) THEN + ANTS_TAC THENL + [CONJ_TAC THENL [REWRITE_TAC[NORM_POS_LE]; ASM_REWRITE_TAC[]]; + DISCH_THEN ACCEPT_TAC]]);; + +(* ------------------------------------------------------------------------- *) +(* Inversion in "psi = fhat o reflect" form: for Schwartz phi, *) +(* fourier (\x. fourier phi (--x)) y = phi y. *) +(* This is DOUBLE_TRANSFORM (fourier(fourier h)(--z) = h z) composed with *) +(* FOURIER_REFLECT (fourier(\x. f(--x)) y = fourier f (--y)). *) +(* ------------------------------------------------------------------------- *) + +let PHI_IS_FOURIER = prove + (`!phi:real->complex. schwartz phi + ==> (!y. fourier (\x. fourier phi (--x)) y = phi y)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`fourier(phi:real->complex)`; `y:real`] FOURIER_REFLECT) THEN + DISCH_THEN SUBST1_TAC THEN + MP_TAC(ISPECL [`phi:real->complex`; `y:real`] DOUBLE_TRANSFORM) THEN + ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Schwartz closed under modulation: phi |-> e^{i b x} phi(x). Proved via *) +(* Fourier duality (NOT a Leibniz decay bound): with psi = \x. fourier *) +(* phi(-x), *) +(* one has fourier psi = phi (PHI_IS_FOURIER) and *) +(* e^{i b x} phi(x) = fourier (\u. psi(u + b)) (x) (FOURIER_SHIFT), *) +(* and psi(.+b) is Schwartz (SCHWARTZ_AFFINE), hence so is its transform *) +(* (SCHWARTZ_FOURIER = 284C). Reuses everything; non-circular. *) +(* ------------------------------------------------------------------------- *) + +let SCHWARTZ_MODULATE = prove + (`!phi:real->complex b. schwartz phi + ==> schwartz (\x. cexp(ii * Cx b * Cx x) * phi x)`, + REPEAT STRIP_TAC THEN + ABBREV_TAC `psi = \x. fourier (phi:real->complex) (--x)` THEN + SUBGOAL_THEN `schwartz (psi:real->complex)` ASSUME_TAC THENL + [EXPAND_TAC "psi" THEN MATCH_MP_TAC SCHWARTZ_REFLECT THEN + REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC SCHWARTZ_FOURIER THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `!x. fourier (psi:real->complex) x = phi x` ASSUME_TAC THENL + [EXPAND_TAC "psi" THEN ASM_SIMP_TAC[PHI_IS_FOURIER]; ALL_TAC] THEN + SUBGOAL_THEN + `(\x. cexp(ii * Cx b * Cx x) * (phi:real->complex) x) = fourier (\u. psi(u + + b))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:real` THEN + MP_TAC(ISPECL [`psi:real->complex`; `b:real`; `x:real`] FOURIER_SHIFT) THEN + ANTS_TAC THENL + [MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC SCHWARTZ_MOD_ABSINT THEN ASM_REWRITE_TAC[]; + DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[]]; + MATCH_MP_TAC SCHWARTZ_FOURIER THEN + SUBGOAL_THEN + `(\u. (psi:real->complex)(u + b)) = (\u. psi(b + &1 * u))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN AP_TERM_TAC THEN + REAL_ARITH_TAC; + MATCH_MP_TAC SCHWARTZ_AFFINE THEN ASM_REWRITE_TAC[] THEN + REAL_ARITH_TAC]]);; + +(* ------------------------------------------------------------------------- *) +(* Closure under a modulated affine reparametrisation: *) +(* x |-> e^{i b x} phi(mJ (x - a)) is Schwartz (mJ <> 0). *) +(* Peel e^{i b x} (SCHWARTZ_MODULATE), then the affine reparam *) +(* mJ*(x-a) = --(mJ*a) + mJ*x (SCHWARTZ_AFFINE). *) +(* ------------------------------------------------------------------------- *) + +let SCHWARTZ_MODAFFINE = prove + (`!(phi:real->complex) mJ a b. schwartz phi /\ ~(mJ = &0) + ==> schwartz (\x. cexp(ii * Cx b * Cx x) * phi(mJ * (x - a)))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SCHWARTZ_MODULATE THEN + SUBGOAL_THEN + `(\x. (phi:real->complex)(mJ * (x - a))) = (\x. phi(--(mJ * a) + mJ * x))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN AP_TERM_TAC THEN REAL_ARITH_TAC; + MATCH_MP_TAC SCHWARTZ_AFFINE THEN ASM_REWRITE_TAC[]]);; + +(* Arithmetic identity for dilation scale factors: sqrt m / m = 1 / sqrt m. *) +let SQRT_SCALE_ID = prove + (`!mJ. &0 < mJ ==> sqrt mJ * (&1 / mJ) = &1 / sqrt mJ`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `~(sqrt mJ = &0)` ASSUME_TAC THENL + [ASM_SIMP_TAC[SQRT_EQ_0] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `mJ = sqrt mJ * sqrt mJ` ASSUME_TAC THENL + [ASM_SIMP_TAC[GSYM REAL_POW_2; SQRT_POW_2; REAL_LT_IMP_LE]; ALL_TAC] THEN + UNDISCH_TAC `mJ = sqrt mJ * sqrt mJ` THEN + UNDISCH_TAC `~(sqrt mJ = &0)` THEN CONV_TAC REAL_FIELD);; + +(* ------------------------------------------------------------------------- *) +(* Two Schwartz functions whose Fourier transforms have disjoint support are *) +(* orthogonal: if at every u one of fhat u, ghat u vanishes, then *) +(* INT f cnj(g) = 0. Immediate from bilinear Parseval (284Ob), since the *) +(* transform-side integrand fhat cnj(ghat) is identically 0. *) +(* ------------------------------------------------------------------------- *) + +let SCHWARTZ_ORTHO_DISJOINT_FHAT = prove + (`!(f:real->complex) (g:real->complex). schwartz f /\ schwartz g /\ + (!u. fourier f u = Cx(&0) \/ fourier g u = Cx(&0)) + ==> integral (:real^1) (\z. f(drop z) * cnj(g(drop z))) = Cx(&0)`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[PARSEVAL_SCHWARTZ_BILINEAR] THEN + SUBGOAL_THEN + `(\z. fourier (f:real->complex) (drop z) * cnj(fourier (g:real->complex) + (drop z))) = + (\z:real^1. Cx(&0))` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `z:real^1` THEN REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `drop z`) THEN STRIP_TAC THEN + ASM_REWRITE_TAC[COMPLEX_MUL_LZERO; CNJ_CX; COMPLEX_MUL_RZERO]; + REWRITE_TAC[COMPLEX_VEC_0] THEN + REWRITE_TAC[GSYM COMPLEX_VEC_0; INTEGRAL_0]]);; + + + +(* ========================================================================= *) +(* SECTION 13. Real-line convolution and the convolution theorem: *) +(* (f * g)^ = sqrt(2pi) . f^ . g^; convolution of Schwartz *) +(* functions is continuous / Lipschitz / L^1 / Schwartz. *) +(* *) +(* Builds the convolution operator, the convolution theorem (Fremlin 283M), *) +(* and continuity of a convolution (255K), in the symmetric normalization *) +(* used throughout this file. *) +(* ========================================================================= *) + +(* Convolution operator (real-line, R->complex), symmetric-normalization *) +(* tower. *) +let convol = new_definition + `convol (f:real->complex) (g:real->complex) (x:real) = + integral (:real^1) (\t. f(x - drop t) * g(drop t))`;; + +(* For Schwartz f,g the convolution integrand at x is absolutely integrable: *) +(* t |-> f(x-t) is Schwartz (SCHWARTZ_AFFINE, s=-1), hence *) +(* bounded+measurable, and g is L^1 (SCHWARTZ_ABSINT); bounded x L^1 is *) +(* absolutely integrable. *) +let CONVOL_INTEGRAND_ABSINT = prove + (`!(f:real->complex) g x. schwartz f /\ schwartz g + ==> (\t. f(x - drop t) * g(drop t)) absolutely_integrable_on (:real^1)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`( * ):complex->complex->complex`; + `\t:real^1. (f:real->complex)(x - drop t)`; + `\t:real^1. (g:real->complex)(drop t)`; `(:real^1)`] + ABSOLUTELY_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT) THEN + REWRITE_TAC[BILINEAR_COMPLEX_MUL] THEN + DISCH_THEN MATCH_MP_TAC THEN REPEAT CONJ_TAC THENL + [(* t |-> f(x - drop t) measurable *) + SUBGOAL_THEN `schwartz (\u. (f:real->complex)(x - u))` ASSUME_TAC THENL + [MP_TAC(ISPECL [`f:real->complex`; `-- &1:real`; + `x:real`] SCHWARTZ_AFFINE) THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[REAL_ARITH `x + -- &1 * u = x - u`] THEN + REWRITE_TAC[REAL_ARITH `~(-- &1 = &0)`]; ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_IMP_MEASURABLE_ON THEN + MP_TAC(MATCH_MP SCHWARTZ_CONT (ASSUME `schwartz (\u. (f:real->complex)(x - + u))`)) THEN + REWRITE_TAC[]; + (* bounded image of t |-> f(x - drop t) *) + SUBGOAL_THEN + `?B. !u. norm((f:real->complex)(x - u)) <= B` STRIP_ASSUME_TAC THENL + [MP_TAC(ISPECL [`f:real->complex`; `-- &1:real`; + `x:real`] SCHWARTZ_AFFINE) THEN + ASM_REWRITE_TAC[REAL_ARITH `~(-- &1 = &0)`] THEN + REWRITE_TAC[REAL_ARITH `x + -- &1 * u = x - u`] THEN DISCH_TAC THEN + MP_TAC(MATCH_MP SCHWARTZ_BOUNDED (ASSUME `schwartz (\u. + (f:real->complex)(x - u))`)) THEN + REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[bounded; FORALL_IN_IMAGE] THEN EXISTS_TAC `B:real` THEN + X_GEN_TAC `t:real^1` THEN REWRITE_TAC[IN_UNIV] THEN ASM_REWRITE_TAC[]; + (* g(drop t) absolutely integrable *) + MP_TAC(MATCH_MP SCHWARTZ_ABSINT (ASSUME `schwartz (g:real->complex)`)) THEN + REWRITE_TAC[]]);; + +(* The convolution integrand is integrable (from absolutely integrable). *) +let CONVOL_INTEGRAND_INTEGRABLE = prove + (`!(f:real->complex) g x. schwartz f /\ schwartz g + ==> (\t. f(x - drop t) * g(drop t)) integrable_on (:real^1)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC CONVOL_INTEGRAND_ABSINT THEN ASM_REWRITE_TAC[]);; + +(* The convolution norm is bounded by the integral of the pointwise product *) +(* of norms, by the triangle inequality for vector integrals. *) +let CONVOL_NORM_BOUND = prove + (`!(f:real->complex) g x. schwartz f /\ schwartz g + ==> norm(convol f g x) + <= drop(integral (:real^1) (\t. lift(norm(f(x - drop t)) * norm(g(drop + t)))))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[convol] THEN + MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CONVOL_INTEGRAND_INTEGRABLE THEN ASM_REWRITE_TAC[]; + MP_TAC(ISPECL [`f:real->complex`; `g:real->complex`; + `x:real`] CONVOL_INTEGRAND_ABSINT) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_NORM) THEN + DISCH_THEN(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE) THEN + REWRITE_TAC[o_DEF; COMPLEX_NORM_MUL]; + X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN + REWRITE_TAC[LIFT_DROP; COMPLEX_NORM_MUL; REAL_LE_REFL]]);; + +(* ------------------------------------------------------------------------- *) +(* The 2D transform integrand (x,t) |-> e^{-iyx} f(x-t) g(t) is measurable *) +(* on R^2. All factors are continuous, so the product is continuous. This *) +(* supplies the measurability needed for the convolution theorem's Fubini *) +(* interchange. *) +(* ------------------------------------------------------------------------- *) +let IMAGE_ADD_LEFT_UNIV = prove + (`!a:real^N. IMAGE (\x. a + x) (:real^N) = (:real^N)`, + GEN_TAC THEN REWRITE_TAC[EXTENSION; IN_IMAGE; IN_UNIV] THEN + X_GEN_TAC `y:real^N` THEN EXISTS_TAC `y - a:real^N` THEN VECTOR_ARITH_TAC);; + +let INTEGRAL_NORM_TRANSLATION_UNIV = prove + (`!(f:real^1->complex) a. + integral (:real^1) (\x. lift(norm(f(a + x)))) = + integral (:real^1) (\x. lift(norm(f x)))`, + REPEAT GEN_TAC THEN + MP_TAC(ISPECL [`\x:real^1. lift(norm((f:real^1->complex) x))`; `(:real^1)`; + `a:real^1`] + INTEGRAL_TRANSLATION) THEN + REWRITE_TAC[IMAGE_ADD_LEFT_UNIV] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* 283M brick 3: the x-slice of the transform integrand is absolutely *) +(* integrable (fixed t). \x. e^{-iyx} f(x-t) g(t) = (bounded e^{-iyx} g(t)) *) +(* x *) +(* (L^1 f(x-t)); f(.-t) is Schwartz (SCHWARTZ_AFFINE) hence L^1 (SCHWARTZ_ *) +(* ABSINT). This is the a.e.-slice-absint hypothesis of FUBINI for the *) +(* convolution theorem swap. *) +(* ------------------------------------------------------------------------- *) +let FOURIER_MODULATE_ABSINT = prove + (`!(f:real->complex) w. schwartz f + ==> (\u. cexp(--(ii * Cx w * Cx(drop u))) * f(drop u)) + absolutely_integrable_on (:real^1)`, + MATCH_ACCEPT_TAC SCHWARTZ_MOD_ABSINT);; + + +(* Abstract complex rearrangement (a b = c ==> (a p)(b q) = c (p q)), for *) +(* the modulated-product regroup in CONV283M_INNER (COMPLEX_RING chokes on *) +(* cexp atoms in place, so prove over fresh vars + MATCH_MP forward). *) +let CEXP_PROD_REARR = prove + (`!a b c p q:complex. a * b = c ==> (a * p) * (b * q) = c * (p * q)`, + REPEAT STRIP_TAC THEN FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + CONV_TAC COMPLEX_RING);; + +(* Inner identity: the convolution of the two modulated functions at x *) +(* equals e^{-iwx} times the (unmodulated) convolution -- because the two *) +(* e^{-iw.} factors recombine via drop(x-y) + drop y = drop x. *) +let CONV283M_INNER = prove + (`!(f:real->complex) g w x:real^1. schwartz f /\ schwartz g + ==> integral (:real^1) (\y. (\u. cexp(--(ii * Cx w * Cx(drop u))) * f(drop + u)) (x - y) * + (\u. cexp(--(ii * Cx w * Cx(drop u))) * g(drop + u)) y) = + cexp(--(ii * Cx w * Cx(drop x))) * convol f g (drop x)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[convol] THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC + `integral (:real^1) + (\y. cexp(--(ii * Cx w * Cx(drop x))) * + ((f:real->complex)(drop x - drop y) * (g:real->complex)(drop y)))` + THEN + CONJ_TAC THENL + [MATCH_MP_TAC INTEGRAL_EQ THEN X_GEN_TAC `y:real^1` THEN DISCH_TAC THEN + BETA_TAC THEN REWRITE_TAC[DROP_SUB] THEN MATCH_MP_TAC CEXP_PROD_REARR THEN + REWRITE_TAC[GSYM CEXP_ADD] THEN AP_TERM_TAC THEN + REWRITE_TAC[CX_SUB] THEN SIMPLE_COMPLEX_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `(\y:real^1. (f:real->complex)(drop x - drop y) * g(drop y)) integrable_on + (:real^1)` + ASSUME_TAC THENL + [MP_TAC(ISPECL [`f:real->complex`; `g:real->complex`; `drop(x:real^1)`] + CONVOL_INTEGRAND_INTEGRABLE) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_SIMP_TAC[INTEGRAL_COMPLEX_LMUL]);; + +let FOURIER_CONVOLUTION = prove + (`!(f:real->complex) g w. schwartz f /\ schwartz g + ==> fourier (convol f g) w = Cx(sqrt(&2 * pi)) * fourier f w * fourier g + w`, + REPEAT STRIP_TAC THEN REWRITE_TAC[fourier] THEN + SUBGOAL_THEN + `integral (:real^1) (\x. cexp(--(ii * Cx w * Cx(drop x))) * convol f g (drop + x)) = + integral (:real^1) + (\x. integral (:real^1) + (\y. (\u. cexp(--(ii * Cx w * Cx(drop u))) * (f:real->complex)(drop u)) + (x - y) * + (\u. cexp(--(ii * Cx w * Cx(drop u))) * (g:real->complex)(drop u)) + y))` + SUBST1_TAC THENL + [MATCH_MP_TAC INTEGRAL_EQ THEN X_GEN_TAC `x:real^1` THEN DISCH_TAC THEN + ASM_SIMP_TAC[CONV283M_INNER]; ALL_TAC] THEN + MP_TAC(ISPECL + [`( * ):complex->complex->complex`; + `\u:real^1. cexp(--(ii * Cx w * Cx(drop u))) * (f:real->complex)(drop u)`; + `\u:real^1. cexp(--(ii * Cx w * Cx(drop u))) * (g:real->complex)(drop u)`] + DOUBLE_INTEGRAL_CONVOLUTION) THEN + REWRITE_TAC[BILINEAR_COMPLEX_MUL] THEN ANTS_TAC THENL + [CONJ_TAC THEN MATCH_MP_TAC FOURIER_MODULATE_ABSINT THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[INNER_INT_FOURIER] THEN + MP_TAC PI_POS THEN CONV_TAC COMPLEX_FIELD);; + +(* ------------------------------------------------------------------------- *) +(* 255K: the convolution of two Schwartz functions is continuous everywhere. *) +(* Direct from the library CONTINUOUS_ON_CONVOLUTION_L1_LINF (f in L^1 = *) +(* SCHWARTZ_ABSINT, g measurable + bounded). Combined with 283M + transform *) +(* injectivity (DOUBLE_TRANSFORM) this upgrades the a.e. identity gt_m = *) +(* (1/sqrt2pi) gt*psicheck to an EVERYWHERE identity (Fremlin (h)(v)). *) +(* ------------------------------------------------------------------------- *) +let SCHWARTZ_MEASURABLE_BOUNDED = prove + (`!g:real->complex. schwartz g + ==> (\v. g(drop v)) measurable_on (:real^1) /\ bounded (IMAGE (\v. g(drop + v)) (:real^1))`, + REPEAT STRIP_TAC THENL + [MATCH_MP_TAC CONTINUOUS_IMP_MEASURABLE_ON THEN + MP_TAC(MATCH_MP SCHWARTZ_CONT (ASSUME `schwartz (g:real->complex)`)) THEN + REWRITE_TAC[]; + FIRST_ASSUM(X_CHOOSE_TAC `B:real` o MATCH_MP SCHWARTZ_BOUNDED) THEN + REWRITE_TAC[bounded; FORALL_IN_IMAGE] THEN EXISTS_TAC `B:real` THEN + X_GEN_TAC `v:real^1` THEN REWRITE_TAC[IN_UNIV] THEN ASM_REWRITE_TAC[]]);; + +let CONVOL_CONTINUOUS = prove + (`!(f:real->complex) g. schwartz f /\ schwartz g + ==> (\x. convol f g (drop x)) continuous_on (:real^1)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\x. convol f g (drop x)) = + (\x. integral (:real^1) (\y. (\v. (f:real->complex)(drop v)) (x - y) * + (\v. (g:real->complex)(drop v)) y))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:real^1` THEN + REWRITE_TAC[convol] THEN + MATCH_MP_TAC INTEGRAL_EQ THEN X_GEN_TAC `y:real^1` THEN DISCH_TAC THEN + REWRITE_TAC[DROP_SUB]; ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_CONVOLUTION_L1_LINF THEN + REWRITE_TAC[BILINEAR_COMPLEX_MUL] THEN REPEAT CONJ_TAC THENL + [MP_TAC(MATCH_MP SCHWARTZ_ABSINT (ASSUME `schwartz (f:real->complex)`)) THEN + REWRITE_TAC[]; + MP_TAC(MATCH_MP SCHWARTZ_MEASURABLE_BOUNDED (ASSUME `schwartz + (g:real->complex)`)) THEN + SIMP_TAC[]; + MP_TAC(MATCH_MP SCHWARTZ_MEASURABLE_BOUNDED (ASSUME `schwartz + (g:real->complex)`)) THEN + SIMP_TAC[]]);; + +(* convol f g is globally LIPSCHITZ (f,g Schwartz): the difference splits as *) +(* convol f g u - convol f g w = int_t (f(u-t) - f(w-t)) g(t), *) +(* and |f(u-t)-f(w-t)| <= K_f |u-w| (SCHWARTZ_LIPSCHITZ on f, arg-diff = *) +(* u-w), *) +(* so the norm is <= K_f |u-w| int_t|g| = (K_f ||g||_1) |u-w|. This local *) +(* Lipschitz bound is exactly the hypothesis FOURIER_283J needs to invert *) +(* the *) +(* transform of convol f g pointwise. *) +let CONVOL_LIPSCHITZ = prove + (`!(f:real->complex) g. schwartz f /\ schwartz g + ==> ?K. &0 <= K /\ + !u w. norm(convol f g u - convol f g w) <= K * abs(u - w)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC `f:real->complex` SCHWARTZ_LIPSCHITZ) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `Kf:real` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `(\t. lift(norm((g:real->complex)(drop t)))) integrable_on (:real^1)` + ASSUME_TAC THENL + [MP_TAC(ISPEC `g:real->complex` SCHWARTZ_ABSINT) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_NORM) THEN + REWRITE_TAC[o_DEF] THEN + DISCH_THEN(ACCEPT_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE); + ALL_TAC] THEN + ABBREV_TAC `Ng = drop(integral (:real^1) (\t. + lift(norm((g:real->complex)(drop t)))))` THEN + SUBGOAL_THEN `&0 <= Ng` ASSUME_TAC THENL + [EXPAND_TAC "Ng" THEN MATCH_MP_TAC INTEGRAL_DROP_POS THEN + ASM_REWRITE_TAC[LIFT_DROP; NORM_POS_LE]; ALL_TAC] THEN + EXISTS_TAC `Kf * Ng:real` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`u:real`; `w:real`] THEN + REWRITE_TAC[convol] THEN + MP_TAC(ISPECL [`\t. (f:real->complex)(u - drop t) * g(drop t)`; + `\t. (f:real->complex)(w - drop t) * g(drop t)`; + `(:real^1)`] INTEGRAL_SUB) THEN + ANTS_TAC THENL + [CONJ_TAC THEN MATCH_MP_TAC CONVOL_INTEGRAND_INTEGRABLE THEN + ASM_REWRITE_TAC[]; + DISCH_THEN(SUBST1_TAC o SYM)] THEN + REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `drop(integral (:real^1) (\t. lift(Kf * abs(u - w) * + norm((g:real->complex)(drop t)))))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN REPEAT CONJ_TAC THENL + [MP_TAC(ISPECL [`\t. (f:real->complex)(u - drop t) * g(drop t)`; + `\t. (f:real->complex)(w - drop t) * g(drop t)`; + `(:real^1)`] INTEGRABLE_SUB) THEN + ASM_SIMP_TAC[CONVOL_INTEGRAND_INTEGRABLE]; + REWRITE_TAC[REAL_ARITH `Kf * abs(u - w) * n = (Kf * abs(u - w)) * n`] + THEN + SUBGOAL_THEN + `(\t. lift((Kf * abs(u - w)) * norm((g:real->complex)(drop t)))) = + (\t. (Kf * abs(u - w)) % lift(norm((g:real->complex)(drop t))))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; LIFT_CMUL]; ALL_TAC] THEN + MATCH_MP_TAC INTEGRABLE_CMUL THEN ASM_REWRITE_TAC[]; + X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN REWRITE_TAC[LIFT_DROP] THEN + BETA_TAC THEN + SUBGOAL_THEN + `abs((u - drop t) - (w - drop t)) = abs(u - w)` ASSUME_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[GSYM COMPLEX_SUB_RDISTRIB; COMPLEX_NORM_MUL; + REAL_MUL_ASSOC] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[NORM_POS_LE] THEN + ASM_MESON_TAC[]]; + REWRITE_TAC[REAL_ARITH `Kf * abs(u - w) * n = (Kf * abs(u - w)) * n`] THEN + SUBGOAL_THEN + `(\t. lift((Kf * abs(u - w)) * norm((g:real->complex)(drop t)))) = + (\t. (Kf * abs(u - w)) % lift(norm((g:real->complex)(drop t))))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; LIFT_CMUL]; ALL_TAC] THEN + ASM_SIMP_TAC[INTEGRAL_CMUL; DROP_CMUL] THEN + EXPAND_TAC "Ng" THEN REAL_ARITH_TAC]);; + +(* convol f g is absolutely integrable AS A FUNCTION of x (f,g Schwartz): it *) +(* is *) +(* continuous (CONVOL_CONTINUOUS, hence measurable) and dominated by *) +(* dm(x) = int_t norm(f(x-t)) norm(g(t)) dt = |f|*|g|(x) *) +(* which is integrable [DOUBLE_INTEGRABLE_CONVOLUTION with the bilinear real *) +(* product BILINEAR_LIFT_MUL on the lifted norms of f,g -- both L^1 by *) +(* SCHWARTZ_ABSINT]; norm(convol f g x) <= dm(x) is CONVOL_NORM_BOUND. This *) +(* is *) +(* the L^1 hypothesis FOURIER_283J needs (alongside CONVOL_LIPSCHITZ). *) +let CONVOL_ABSINT = prove + (`!(f:real->complex) g. schwartz f /\ schwartz g + ==> (\z. convol f g (drop z)) absolutely_integrable_on (:real^1)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE THEN + EXISTS_TAC + `\z. integral (:real^1) + (\t. lift(norm((f:real->complex)(drop z - drop t)) * + norm((g:real->complex)(drop t))))` THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_IMP_MEASURABLE_ON THEN + MATCH_MP_TAC CONVOL_CONTINUOUS THEN ASM_REWRITE_TAC[]; + MP_TAC(ISPECL [`\x y. lift(drop x * drop y)`; + `\z. lift(norm((f:real->complex)(drop z)))`; + `\z. lift(norm((g:real->complex)(drop z)))`] + DOUBLE_INTEGRABLE_CONVOLUTION) THEN + REWRITE_TAC[BILINEAR_LIFT_MUL] THEN ANTS_TAC THENL + [CONJ_TAC THENL + [MP_TAC(ISPEC `f:real->complex` SCHWARTZ_ABSINT) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_NORM) THEN + REWRITE_TAC[o_DEF]; + MP_TAC(ISPEC `g:real->complex` SCHWARTZ_ABSINT) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o MATCH_MP ABSOLUTELY_INTEGRABLE_NORM) THEN + REWRITE_TAC[o_DEF]]; + REWRITE_TAC[LIFT_DROP; DROP_SUB]]; + X_GEN_TAC `z:real^1` THEN REWRITE_TAC[IN_UNIV] THEN + MP_TAC(ISPECL [`f:real->complex`; `g:real->complex`; + `drop z`] CONVOL_NORM_BOUND) THEN + ASM_REWRITE_TAC[]]);; + +(* Fremlin (h)(v) uniqueness bridge: if convol cf cg (cf,cg Schwartz) has *) +(* the *) +(* SAME Fourier transform as sqrt2pi times a Schwartz gtm, then *) +(* convol cf cg = sqrt2pi * gtm EVERYWHERE. *) +(* Fremlin's route (avoids proving convol Schwartz): convol cf cg is L^1 *) +(* (CONVOL_ABSINT), Lipschitz (CONVOL_LIPSCHITZ), and its transform sqrt2pi *) +(* gtm^ *) +(* is L^1 (gtm Schwartz => SCHWARTZ_FHAT_ABSINT), so FOURIER_283J inverts it *) +(* pointwise: convol x = (1/sqrt2pi) int e^{ixy}(convol)^ = int e^{ixy} *) +(* gtm^; *) +(* FOURIER_284C_INVERSION on the Schwartz gtm gives int e^{ixy} gtm^ = *) +(* sqrt2pi *) +(* gtm x. Everywhere, not just a.e. *) +let CONVOL_SCHWARTZ_EQ = prove + (`!(cf:real->complex) cg (gtm:real->complex). + schwartz cf /\ schwartz cg /\ schwartz gtm /\ + (!w. fourier (convol cf cg) w = Cx(sqrt(&2 * pi)) * fourier gtm w) + ==> !x. convol cf cg x = Cx(sqrt(&2 * pi)) * gtm x`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`cf:real->complex`; `cg:real->complex`] CONVOL_LIPSCHITZ) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN + `Kc:real` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`convol cf cg`; `x:real`; `Kc:real`; `&1`] FOURIER_283J) THEN + ASM_REWRITE_TAC[REAL_LE_REFL; REAL_LT_01] THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [X_GEN_TAC `v:real` THEN DISCH_TAC THEN + SUBGOAL_THEN `abs((x - v) - x) = abs v` (fun th -> + MP_TAC(GEN_REWRITE_RULE (RAND_CONV o RAND_CONV) [th] + (SPECL [`x - v:real`; `x:real`] + (ASSUME `!u w. norm(convol cf cg u - convol cf cg w) <= Kc * abs(u + - w)`)))) THENL + [REAL_ARITH_TAC; REWRITE_TAC[]]; + MATCH_MP_TAC CONVOL_ABSINT THEN ASM_REWRITE_TAC[]; + SUBGOAL_THEN + `(\z. fourier (convol cf cg) (drop z)) = + (\z. Cx(sqrt(&2 * pi)) * fourier gtm (drop z))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_COMPLEX_LMUL THEN + MATCH_MP_TAC SCHWARTZ_FHAT_ABSINT THEN ASM_REWRITE_TAC[]]; + ASM_REWRITE_TAC[]] THEN + MP_TAC(ISPECL [`gtm:real->complex`; `x:real`] FOURIER_284C_INVERSION) THEN + ASM_REWRITE_TAC[] THEN + ABBREV_TAC `II = integral (:real^1) + (\y. cexp(ii * Cx x * Cx(drop y)) * fourier gtm (drop y))` THEN + SUBGOAL_THEN + `integral (:real^1) + (\y. cexp(ii * Cx x * Cx(drop y)) * Cx(sqrt(&2 * pi)) * fourier gtm (drop + y)) = + Cx(sqrt(&2 * pi)) * II` SUBST1_TAC THENL + [EXPAND_TAC "II" THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o ABS_CONV) + [SIMPLE_COMPLEX_ARITH `a * s * b = s * a * b`] THEN + MATCH_MP_TAC INTEGRAL_COMPLEX_LMUL THEN + MATCH_MP_TAC FOURIER_INV_MODULATED_INTEGRABLE THEN + MATCH_MP_TAC SCHWARTZ_FHAT_ABSINT THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `Cx(inv(sqrt(&2 * pi))) * Cx(sqrt(&2 * pi)) = Cx(&1)` MP_TAC THENL + [REWRITE_TAC[GSYM CX_MUL] THEN AP_TERM_TAC THEN + MATCH_MP_TAC REAL_MUL_LINV THEN MATCH_MP_TAC REAL_LT_IMP_NZ THEN + MATCH_MP_TAC SQRT_POS_LT THEN MP_TAC PI_POS THEN + REAL_ARITH_TAC; ALL_TAC] THEN + POP_ASSUM_LIST(K ALL_TAC) THEN CONV_TAC COMPLEX_RING);; diff --git a/Autoformalization/sarkovskii.ml b/Autoformalization/sarkovskii.ml new file mode 100644 index 00000000..9cfc5fed --- /dev/null +++ b/Autoformalization/sarkovskii.ml @@ -0,0 +1,7807 @@ +(* ========================================================================= *) +(* Sarkovskii's theorem for continuous maps of the real line. *) +(* *) +(* The interval-covering proof is based on Section 1.10 of: *) +(* R. L. Devaney, "An Introduction to Chaotic Dynamical Systems", 2nd ed. *) +(* ========================================================================= *) + +needs "Multivariate/realanalysis.ml";; + +(* ------------------------------------------------------------------------- *) +(* Periodic points and their least periods. *) +(* ------------------------------------------------------------------------- *) + +let periodic_point = new_definition + `periodic_point (f:A->A) n x <=> ITER n f x = x`;; + +let minimal_period = new_definition + `minimal_period (f:A->A) n x <=> + 0 < n /\ + periodic_point f n x /\ + !m. 0 < m /\ m < n ==> ~periodic_point f m x`;; + +let has_period = new_definition + `has_period (f:A->A) n <=> ?x. minimal_period f n x`;; + +let PERIODIC_POINT_0 = prove + (`!f:A->A x. periodic_point f 0 x`, + REWRITE_TAC[periodic_point; ITER]);; + +let PERIODIC_POINT_MULTIPLE = prove + (`!f:A->A n x m. + periodic_point f n x ==> periodic_point f (m * n) x`, + REWRITE_TAC[periodic_point] THEN + MESON_TAC[ITER_FIXPOINT; ITER_MUL]);; + +let PERIODIC_POINT_ITER_ADD = prove + (`!f:A->A n x m. + periodic_point f n x ==> ITER (n + m) f x = ITER m f x`, + REWRITE_TAC[periodic_point] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(n:num) + m = m + n` SUBST1_TAC THENL + [ARITH_TAC; + REWRITE_TAC[GSYM ITER_ADD] THEN ASM_REWRITE_TAC[]]);; + +let PERIODIC_POINT_ITERATE = prove + (`!f:A->A n x i. + periodic_point f n x + ==> periodic_point f n (ITER i f x)`, + REWRITE_TAC[periodic_point; ITER_ADD] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC PERIODIC_POINT_ITER_ADD THEN + ASM_REWRITE_TAC[periodic_point]);; + +let PERIODIC_POINTS_IMAGE_INJ = prove + (`!f:A->A n x y. + 0 < n /\ + periodic_point f n x /\ + periodic_point f n y + ==> (f x = f y <=> x = y)`, + REPEAT GEN_TAC THEN + INTRO_TAC "positive periodx periody" THEN + EQ_TAC THENL + [DISCH_THEN(LABEL_TAC "sameimage") THEN + SUBGOAL_THEN `(n:num) - 1 + 1 = n` (LABEL_TAC "sum") THENL + [ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `ITER (n - 1) (f:A->A) (f x) = x` + (LABEL_TAC "backx") THENL + [GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM ITER_1] THEN + REWRITE_TAC[ITER_ADD] THEN + USE_THEN "sum" (fun th -> REWRITE_TAC[th]) THEN + USE_THEN "periodx" + (ACCEPT_TAC o REWRITE_RULE[periodic_point]); + ALL_TAC] THEN + SUBGOAL_THEN + `ITER (n - 1) (f:A->A) (f y) = y` + (LABEL_TAC "backy") THENL + [GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM ITER_1] THEN + REWRITE_TAC[ITER_ADD] THEN + USE_THEN "sum" (fun th -> REWRITE_TAC[th]) THEN + USE_THEN "periody" + (ACCEPT_TAC o REWRITE_RULE[periodic_point]); + ALL_TAC] THEN + ASM_MESON_TAC[]; + SIMP_TAC[]]);; + +let PERIODIC_POINTS_ITER_INJ = prove + (`!f:A->A n k x y. + 0 < (n:num) /\ + periodic_point (f:A->A) n (x:A) /\ + periodic_point f n (y:A) + ==> (ITER (k:num) f x = ITER k f y <=> x = y)`, + GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THENL + [SIMP_TAC[ITER]; + POP_ASSUM(LABEL_TAC "IH") THEN + MAP_EVERY X_GEN_TAC [`x:A`; `y:A`] THEN + INTRO_TAC "positive periodx periody" THEN + REWRITE_TAC[ITER] THEN + MP_TAC(ISPECL + [`f:A->A`; `n:num`; `ITER (k:num) (f:A->A) (x:A)`; + `ITER (k:num) (f:A->A) (y:A)`] + PERIODIC_POINTS_IMAGE_INJ) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [USE_THEN "positive" ACCEPT_TAC; + MATCH_MP_TAC PERIODIC_POINT_ITERATE THEN + USE_THEN "periodx" ACCEPT_TAC; + MATCH_MP_TAC PERIODIC_POINT_ITERATE THEN + USE_THEN "periody" ACCEPT_TAC]; + DISCH_THEN(fun th -> REWRITE_TAC[th])] THEN + USE_THEN "IH" MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]);; + +let PERIODIC_POINT_ITER = prove + (`!f:A->A k m x. + periodic_point (ITER k f) m x <=> + periodic_point f (m * k) x`, + REWRITE_TAC[periodic_point; ITER_MUL]);; + +let PERIODIC_POINT_ITER_MOD = prove + (`!f:A->A n x m. + 0 < n /\ periodic_point f n x + ==> ITER m f x = ITER (m MOD n) f x`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(SPECL [`m:num`; `n:num`] DIVISION) THEN + ANTS_TAC THENL + [ASM_ARITH_TAC; + INTRO_TAC "division remainder"] THEN + SUBGOAL_THEN + `periodic_point (f:A->A) (m DIV n * n) x` + ASSUME_TAC THENL + [MATCH_MP_TAC PERIODIC_POINT_MULTIPLE THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + TRANS_TAC EQ_TRANS + `ITER (m DIV n * n + m MOD n) (f:A->A) x` THEN + CONJ_TAC THENL + [USE_THEN "division" (fun th -> + ACCEPT_TAC(BETA_RULE + (AP_TERM `\k:num. ITER k (f:A->A) x` th))); + MATCH_MP_TAC PERIODIC_POINT_ITER_ADD THEN ASM_REWRITE_TAC[]]);; + +let PERIODIC_POINT_ITER_EQ = prove + (`!f:A->A n x i j. + periodic_point f n x /\ + i <= j /\ + j <= n /\ + ITER i f x = ITER j f x + ==> periodic_point f (j - i) x`, + REWRITE_TAC[periodic_point] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `ITER ((n:num) - i) (f:A->A) (ITER i f x) = + ITER (n - i) f (ITER j f x)` + MP_TAC THENL + [ASM_REWRITE_TAC[]; + REWRITE_TAC[ITER_ADD]] THEN + SUBGOAL_THEN + `((n:num) - i) + i = n /\ + (n - i) + j = n + (j - i)` + STRIP_ASSUME_TAC THENL + [ASM_ARITH_TAC; + ASM_REWRITE_TAC[] THEN DISCH_TAC] THEN + SUBGOAL_THEN + `ITER (n + (j - i)) (f:A->A) x = ITER (j - i) f x` + ASSUME_TAC THENL + [MATCH_MP_TAC PERIODIC_POINT_ITER_ADD THEN + ASM_REWRITE_TAC[periodic_point]; + ASM_MESON_TAC[]]);; + +let MINIMAL_PERIOD_DIVISIBILITY = prove + (`!f:A->A n x. + minimal_period f n x <=> + 0 < n /\ !m. periodic_point f m x <=> n divides m`, + REPEAT GEN_TAC THEN REWRITE_TAC[minimal_period] THEN EQ_TAC THENL + [INTRO_TAC "positive period least" THEN + CONJ_TAC THENL + [USE_THEN "positive" ACCEPT_TAC; + X_GEN_TAC `m:num` THEN EQ_TAC THENL + [DISCH_THEN(LABEL_TAC "mperiod") THEN + SUBGOAL_THEN + `periodic_point (f:A->A) (m MOD n) x` + (LABEL_TAC "remainder") THENL + [MP_TAC(ISPECL [`f:A->A`; `n:num`; `x:A`; `m:num`] + PERIODIC_POINT_ITER_MOD) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[]; + DISCH_THEN(LABEL_TAC "iterate")] THEN + REWRITE_TAC[periodic_point] THEN + USE_THEN "iterate" (fun th -> REWRITE_TAC[GSYM th]) THEN + USE_THEN "mperiod" + (ACCEPT_TAC o REWRITE_RULE[periodic_point]); + ALL_TAC] THEN + REWRITE_TAC[DIVIDES_MOD] THEN + ASM_CASES_TAC `m MOD n = 0` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `0 < m MOD n /\ m MOD n < n` + (LABEL_TAC "remainderbound") THENL + [CONJ_TAC THENL + [ASM_ARITH_TAC; + ASM_REWRITE_TAC[MOD_LT_EQ_LT]]; + USE_THEN "least" (MP_TAC o SPEC `m MOD n`) THEN + ASM_MESON_TAC[]]; + DISCH_THEN(LABEL_TAC "divides") THEN + USE_THEN "divides" MP_TAC THEN REWRITE_TAC[divides] THEN + DISCH_THEN(X_CHOOSE_THEN `k:num` SUBST1_TAC) THEN + ONCE_REWRITE_TAC[MULT_SYM] THEN + MATCH_MP_TAC PERIODIC_POINT_MULTIPLE THEN + USE_THEN "period" ACCEPT_TAC]]; + INTRO_TAC "positive periods" THEN + REPEAT CONJ_TAC THENL + [USE_THEN "positive" ACCEPT_TAC; + USE_THEN "periods" (MP_TAC o SPEC `n:num`) THEN + REWRITE_TAC[DIVIDES_REFL]; + X_GEN_TAC `m:num` THEN + INTRO_TAC "mpositive mlt" THEN + DISCH_THEN(LABEL_TAC "mperiod") THEN + USE_THEN "periods" (MP_TAC o SPEC `m:num`) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o MATCH_MP DIVIDES_LE) THEN + ASM_ARITH_TAC]]);; + +let MINIMAL_PERIOD_POS = prove + (`!f:A->A n x. minimal_period f n x ==> 0 < n`, + SIMP_TAC[minimal_period]);; + +let HAS_PERIOD_POS = prove + (`!f:A->A n. has_period f n ==> 0 < n`, + REPEAT GEN_TAC THEN REWRITE_TAC[has_period] THEN + DISCH_THEN(X_CHOOSE_THEN `x:A` + (ACCEPT_TAC o MATCH_MP MINIMAL_PERIOD_POS)));; + +let MINIMAL_PERIOD_PERIODIC = prove + (`!f:A->A n x. minimal_period f n x ==> periodic_point f n x`, + SIMP_TAC[minimal_period]);; + +let MINIMAL_PERIOD_DIVIDES = prove + (`!f:A->A n x m. + minimal_period f n x + ==> (periodic_point f m x <=> n divides m)`, + SIMP_TAC[MINIMAL_PERIOD_DIVISIBILITY]);; + +let MINIMAL_PERIOD_ITERATE = prove + (`!f:A->A n x k. + minimal_period f n x + ==> minimal_period f n (ITER k f x)`, + REPEAT GEN_TAC THEN DISCH_THEN(LABEL_TAC "minimal") THEN + REWRITE_TAC[MINIMAL_PERIOD_DIVISIBILITY] THEN CONJ_TAC THENL + [USE_THEN "minimal" (MP_TAC o MATCH_MP MINIMAL_PERIOD_POS) THEN + ARITH_TAC; + X_GEN_TAC `m:num` THEN EQ_TAC THENL + [DISCH_THEN(LABEL_TAC "perioditerate") THEN + SUBGOAL_THEN + `ITER k (f:A->A) (ITER m f x) = + ITER m f (ITER k f x)` + (LABEL_TAC "commute") THENL + [REWRITE_TAC[ITER_ADD] THEN + SUBGOAL_THEN `(k:num) + m = m + k` SUBST1_TAC THENL + [ARITH_TAC; + REFL_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN + `ITER k (f:A->A) (ITER m f x) = ITER k f x` + (LABEL_TAC "sameiterate") THENL + [USE_THEN "commute" (fun th -> REWRITE_TAC[th]) THEN + USE_THEN "perioditerate" + (ACCEPT_TAC o REWRITE_RULE[periodic_point]); + ALL_TAC] THEN + SUBGOAL_THEN `periodic_point (f:A->A) m x` + (LABEL_TAC "period") THENL + [REWRITE_TAC[periodic_point] THEN + MP_TAC(ISPECL + [`f:A->A`; `n:num`; `k:num`; `ITER m (f:A->A) (x:A)`; `x:A`] + PERIODIC_POINTS_ITER_INJ) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [USE_THEN "minimal" (MP_TAC o MATCH_MP MINIMAL_PERIOD_POS) THEN + ARITH_TAC; + MATCH_MP_TAC PERIODIC_POINT_ITERATE THEN + MATCH_MP_TAC MINIMAL_PERIOD_PERIODIC THEN + USE_THEN "minimal" ACCEPT_TAC; + MATCH_MP_TAC MINIMAL_PERIOD_PERIODIC THEN + USE_THEN "minimal" ACCEPT_TAC]; + DISCH_THEN(MP_TAC o fst o EQ_IMP_RULE) THEN + DISCH_THEN MATCH_MP_TAC THEN + USE_THEN "sameiterate" ACCEPT_TAC]; + ALL_TAC] THEN + MP_TAC(ISPECL [`f:A->A`; `n:num`; `x:A`; `m:num`] + MINIMAL_PERIOD_DIVIDES) THEN + ASM_REWRITE_TAC[]; + DISCH_THEN(LABEL_TAC "divides") THEN + MATCH_MP_TAC PERIODIC_POINT_ITERATE THEN + MP_TAC(ISPECL [`f:A->A`; `n:num`; `x:A`; `m:num`] + MINIMAL_PERIOD_DIVIDES) THEN + ASM_REWRITE_TAC[]]]);; + +let MINIMAL_PERIOD_ITER_INJ_LE = prove + (`!f:A->A n x i j. + minimal_period f n x /\ + i <= j /\ + j < n /\ + ITER i f x = ITER j f x + ==> i = j`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN + `periodic_point (f:A->A) (j - i) x` + ASSUME_TAC THENL + [MATCH_MP_TAC(ISPECL + [`f:A->A`; `n:num`; `x:A`; `i:num`; `j:num`] + PERIODIC_POINT_ITER_EQ) THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC MINIMAL_PERIOD_PERIODIC THEN ASM_REWRITE_TAC[]; + ASM_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN `(n:num) divides (j - i)` ASSUME_TAC THENL + [MP_TAC(ISPECL [`f:A->A`; `n:num`; `x:A`; `j - i:num`] + MINIMAL_PERIOD_DIVIDES) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MP_TAC(MATCH_MP DIVIDES_LE + (ASSUME `(n:num) divides (j - i)`)) THEN + ASM_ARITH_TAC);; + +let MINIMAL_PERIOD_ITER_INJ = prove + (`!f:A->A n x i j. + minimal_period f n x /\ + i < n /\ + j < n + ==> (ITER i f x = ITER j f x <=> i = j)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN EQ_TAC THENL + [DISCH_TAC THEN ASM_CASES_TAC `(i:num) <= j` THENL + [MATCH_MP_TAC(ISPECL + [`f:A->A`; `n:num`; `x:A`; `i:num`; `j:num`] + MINIMAL_PERIOD_ITER_INJ_LE) THEN + ASM_REWRITE_TAC[]; + SUBGOAL_THEN `(j:num) = i` MP_TAC THENL + [MATCH_MP_TAC(ISPECL + [`f:A->A`; `n:num`; `x:A`; `j:num`; `i:num`] + MINIMAL_PERIOD_ITER_INJ_LE) THEN + ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; + SIMP_TAC[]]]; + DISCH_THEN SUBST1_TAC THEN REFL_TAC]);; + +let MINIMAL_PERIOD_UNIQUE = prove + (`!f:A->A m n x. + minimal_period f m x /\ minimal_period f n x + ==> m = n`, + REWRITE_TAC[MINIMAL_PERIOD_DIVISIBILITY] THEN + MESON_TAC[DIVIDES_ANTISYM]);; + +let PERIODIC_POINT_IMP_MINIMAL_PERIOD = prove + (`!f:A->A x m. + 0 < m /\ periodic_point f m x + ==> ?n. n divides m /\ minimal_period f n x`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`(=):A->A->bool`; `f:A->A`; `x:A`] + ORDER_EXISTENCE_ITER) THEN + ANTS_TAC THENL [MESON_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN + EXISTS_TAC `n:num` THEN + ASM_REWRITE_TAC[MINIMAL_PERIOD_DIVISIBILITY; periodic_point] THEN + CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN + ASM_REWRITE_TAC[GSYM periodic_point]; + ASM_CASES_TAC `n = 0` THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN + ASM_REWRITE_TAC[GSYM periodic_point; DIVIDES_ZERO] THEN + ASM_ARITH_TAC; + ASM_ARITH_TAC]]);; + +let MINIMAL_PERIOD_ITER = prove + (`!f:A->A n x k. + minimal_period f n x + ==> minimal_period (ITER k f) (n DIV gcd(n,k)) x`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[MINIMAL_PERIOD_DIVISIBILITY; PERIODIC_POINT_ITER] THEN + FIRST_X_ASSUM + (STRIP_ASSUME_TAC o REWRITE_RULE[MINIMAL_PERIOD_DIVISIBILITY]) THEN + SUBGOAL_THEN `gcd(n,k) divides n` ASSUME_TAC THENL + [MESON_TAC[DIVIDES_GCD; DIVIDES_REFL]; + ALL_TAC] THEN + SUBGOAL_THEN `n DIV gcd(n,k) * gcd(n,k) = n` ASSUME_TAC THENL + [ASM_REWRITE_TAC[GSYM DIVIDES_DIV_MULT]; + ALL_TAC] THEN + CONJ_TAC THENL + [ASM_CASES_TAC `n DIV gcd(n,k) = 0` THEN + ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `n DIV gcd(n,k) * gcd(n,k) = n` THEN + ASM_REWRITE_TAC[MULT_CLAUSES] THEN ASM_ARITH_TAC; + X_GEN_TAC `m:num` THEN ASM_REWRITE_TAC[] THEN + MP_TAC(SPECL [`n:num`; `gcd(n,k)`; `m:num`] + DIVIDES_DIV_DIVIDES) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; + DISCH_THEN(fun th -> GEN_REWRITE_TAC RAND_CONV [th])] THEN + REWRITE_TAC[DIVIDES_LMUL_GCD; MULT_SYM]]);; + +let HAS_PERIOD_ITER = prove + (`!f:A->A n k. + has_period f n + ==> has_period (ITER k f) (n DIV gcd(n,k))`, + REWRITE_TAC[has_period] THEN MESON_TAC[MINIMAL_PERIOD_ITER]);; + +let DIVIDES_NOT_SUB = prove + (`!d m r. + d divides m /\ 0 < r /\ r < d /\ r <= m + ==> ~(d divides (m - r))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + DISCH_THEN(LABEL_TAC "subdivides") THEN + SUBGOAL_THEN `(d:num) divides (m - (m - r))` + (LABEL_TAC "difference") THENL + [MATCH_MP_TAC DIVIDES_SUB THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `(m:num) - (m - r) = r` + (LABEL_TAC "subtract") THENL + [ASM_ARITH_TAC; + ALL_TAC] THEN + USE_THEN "subtract" (fun th -> + RULE_ASSUM_TAC(REWRITE_RULE[th])) THEN + USE_THEN "difference" (MP_TAC o MATCH_MP DIVIDES_LE) THEN + ASM_ARITH_TAC);; + +let SUB_NOT_DIVIDES = prove + (`!m r. + 0 < r /\ 2 * r < m + ==> ~((m - r) divides m)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + DISCH_THEN(LABEL_TAC "divides") THEN + MP_TAC(ISPECL [`m - r:num`; `m:num`; `r:num`] + DIVIDES_NOT_SUB) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; + REWRITE_TAC[DIVIDES_REFL]]);; + +(* ------------------------------------------------------------------------- *) +(* Ordered finite orbits. *) +(* ------------------------------------------------------------------------- *) + +let MINIMAL_PERIOD_ORBIT_CARD = prove + (`!f:A->A n x. + minimal_period f n x + ==> CARD (IMAGE (\i. ITER i f x) {i | i < n}) = n`, + REPEAT STRIP_TAC THEN + TRANS_TAC EQ_TRANS `CARD {i:num | i < n}` THEN CONJ_TAC THENL + [MATCH_MP_TAC CARD_IMAGE_INJ THEN CONJ_TAC THENL + [MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN + REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN + MP_TAC(ISPECL [`f:A->A`; `n:num`; `x:A`; `i:num`; `j:num`] + MINIMAL_PERIOD_ITER_INJ) THEN + ASM_REWRITE_TAC[]; + REWRITE_TAC[FINITE_NUMSEG_LT]]; + REWRITE_TAC[CARD_NUMSEG_LT]]);; + +let MINIMAL_PERIOD_ORBIT_IMAGE = prove + (`!f:A->A n x y. + minimal_period f n x /\ + y IN IMAGE (\i. ITER i f x) {i | i < n} + ==> f y IN IMAGE (\i. ITER i f x) {i | i < n}`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "minimal") MP_TAC) THEN + REWRITE_TAC[IN_IMAGE; IN_ELIM_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `i:num` + (CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC)) THEN + SUBGOAL_THEN `0 < (n:num)` ASSUME_TAC THENL + [USE_THEN "minimal" (MP_TAC o MATCH_MP MINIMAL_PERIOD_POS) THEN + ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `periodic_point (f:A->A) n x` ASSUME_TAC THENL + [MATCH_MP_TAC MINIMAL_PERIOD_PERIODIC THEN + USE_THEN "minimal" ACCEPT_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `ITER (SUC i) (f:A->A) x = ITER ((SUC i) MOD n) f x` + (LABEL_TAC "reduce") THENL + [MATCH_MP_TAC PERIODIC_POINT_ITER_MOD THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `(SUC i) MOD n < n` (LABEL_TAC "index") THENL + [REWRITE_TAC[MOD_LT_EQ_LT] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `f(ITER i (f:A->A) x) = ITER ((SUC i) MOD n) f x` + (LABEL_TAC "step") THENL + [GEN_REWRITE_TAC LAND_CONV [GSYM(CONJUNCT2 ITER)] THEN + USE_THEN "reduce" ACCEPT_TAC; + ALL_TAC] THEN + EXISTS_TAC `(SUC i) MOD n` THEN CONJ_TAC THENL + [USE_THEN "step" ACCEPT_TAC; + USE_THEN "index" ACCEPT_TAC]);; + +let MINIMAL_PERIOD_ORBIT_MINIMAL = prove + (`!f:A->A n x y. + minimal_period f n x /\ + y IN IMAGE (\i. ITER i f x) {i | i < n} + ==> minimal_period f n y`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 (LABEL_TAC "minimal") MP_TAC) THEN + REWRITE_TAC[IN_IMAGE; IN_ELIM_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `i:num` + (CONJUNCTS_THEN2 SUBST_ALL_TAC ASSUME_TAC)) THEN + MATCH_MP_TAC MINIMAL_PERIOD_ITERATE THEN + USE_THEN "minimal" ACCEPT_TAC);; + +let MINIMAL_PERIOD_ORDERED_ORBIT = prove + (`!f:real->real n x. + minimal_period f n x + ==> ?z. + (!i j. i < j /\ j < n ==> z i < z j) /\ + IMAGE z {i | i < n} = + IMAGE (\i. ITER i f x) {i | i < n}`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + ABBREV_TAC + `s:real->bool = IMAGE (\i. ITER i (f:real->real) x) {i | i < n}` THEN + SUBGOAL_THEN `(s:real->bool) HAS_SIZE n` ASSUME_TAC THENL + [EXPAND_TAC "s" THEN REWRITE_TAC[HAS_SIZE] THEN CONJ_TAC THENL + [MATCH_MP_TAC FINITE_IMAGE THEN REWRITE_TAC[FINITE_NUMSEG_LT]; + MATCH_MP_TAC MINIMAL_PERIOD_ORBIT_CARD THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + MP_TAC(ISPEC `(<=):real->real->bool` TOPOLOGICAL_SORT) THEN + ANTS_TAC THENL [MESON_TAC[REAL_LE_TRANS; REAL_LE_ANTISYM]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPECL [`n:num`; `s:real->bool`]) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `g:num->real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `\i. (g:num->real)(i + 1)` THEN CONJ_TAC THENL + [MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN STRIP_TAC THEN BETA_TAC THEN + REWRITE_TAC[GSYM REAL_NOT_LE] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[IN_NUMSEG] THEN ASM_ARITH_TAC; + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM; IN_NUMSEG] THEN + X_GEN_TAC `y:real` THEN EQ_TAC THENL + [DISCH_THEN(X_CHOOSE_THEN `i:num` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `i + 1` THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; + DISCH_THEN(X_CHOOSE_THEN `k:num` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `k - 1` THEN + SUBGOAL_THEN `k - 1 + 1 = k` SUBST1_TAC THENL + [ASM_ARITH_TAC; ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC]]]);; + +let FINITE_STRICTLY_INCREASING_INJ = prove + (`!z:num->real n i j. + (!r s. r < s /\ s < n ==> z r < z s) /\ + i < n /\ + j < n + ==> (z i = z j <=> i = j)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN EQ_TAC THENL + [DISCH_TAC THEN ASM_CASES_TAC `(i:num) = j` THEN + ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `(i:num) < j` THENL + [FIRST_X_ASSUM(MP_TAC o SPECL [`i:num`; `j:num`]) THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + FIRST_X_ASSUM(MP_TAC o SPECL [`j:num`; `i:num`]) THEN + ANTS_TAC THENL + [ASM_ARITH_TAC; + ASM_REAL_ARITH_TAC]]; + DISCH_THEN SUBST1_TAC THEN REFL_TAC]);; + +let MINIMAL_PERIOD_ORDERED_ORBIT_TRANSITION = prove + (`!f:real->real n x z. + minimal_period f n x /\ + IMAGE z {i | i < n} = IMAGE (\i. ITER i f x) {i | i < n} + ==> ?p:num->num. + !i. i < n ==> p i < n /\ f(z i) = z(p i)`, + REPEAT GEN_TAC THEN + INTRO_TAC "minimal enum" THEN + ABBREV_TAC + `p:num->num = + \i. @j:num. j < n /\ (f:real->real)((z:num->real) i) = z j` THEN + EXISTS_TAC `p:num->num` THEN X_GEN_TAC `i:num` THEN DISCH_TAC THEN + EXPAND_TAC "p" THEN BETA_TAC THEN + SUBGOAL_THEN + `?j:num. j < n /\ (f:real->real)((z:num->real) i) = z j` + MP_TAC THENL + [SUBGOAL_THEN + `(z:num->real) i IN + IMAGE (\k. ITER k (f:real->real) x) {k | k < n}` + (LABEL_TAC "zi") THENL + [USE_THEN "enum" (fun th -> REWRITE_TAC[GSYM th]) THEN + REWRITE_TAC[IN_IMAGE; IN_ELIM_THM] THEN + EXISTS_TAC `i:num` THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `(f:real->real)((z:num->real) i) IN + IMAGE (\k. ITER k f x) {k | k < n}` + (LABEL_TAC "fzi") THENL + [MATCH_MP_TAC MINIMAL_PERIOD_ORBIT_IMAGE THEN CONJ_TAC THENL + [USE_THEN "minimal" ACCEPT_TAC; + USE_THEN "zi" ACCEPT_TAC]; + ALL_TAC] THEN + USE_THEN "enum" (fun th -> + USE_THEN "fzi" (MP_TAC o REWRITE_RULE[GSYM th])) THEN + REWRITE_TAC[IN_IMAGE; IN_ELIM_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `j:num` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `j:num` THEN ASM_REWRITE_TAC[]; + DISCH_THEN(MP_TAC o SELECT_RULE) THEN BETA_TAC THEN SIMP_TAC[]]);; + +let FINITE_ORBIT_TRANSITION_ITER = prove + (`!f:A->A z p n. + (!i:num. + i < n + ==> (p:num->num) i < n /\ + f((z:num->A) i) = z(p i)) + ==> !k i:num. + i < n + ==> ITER k p i < n /\ + ITER k f (z i) = z(ITER k p i)`, + REPEAT GEN_TAC THEN DISCH_THEN(LABEL_TAC "transition") THEN + INDUCT_TAC THENL + [SIMP_TAC[ITER; I_THM]; + X_GEN_TAC `i:num` THEN DISCH_THEN(LABEL_TAC "ibound") THEN + FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN + ANTS_TAC THENL + [USE_THEN "ibound" ACCEPT_TAC; + ALL_TAC] THEN + INTRO_TAC "iterbound iterate" THEN + USE_THEN "transition" (MP_TAC o SPEC `ITER k (p:num->num) i`) THEN + ANTS_TAC THENL + [USE_THEN "iterbound" ACCEPT_TAC; + ALL_TAC] THEN + INTRO_TAC "nextbound step" THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[ITER; o_THM]; + REWRITE_TAC[ITER; o_THM] THEN + ASM_REWRITE_TAC[]]]);; + +let MINIMAL_PERIOD_ORDERED_ORBIT_TRANSITION_MINIMAL = prove + (`!f:real->real n x z p. + minimal_period f n x /\ + (!i j. i < j /\ j < n ==> z i < z j) /\ + IMAGE z {i | i < n} = + IMAGE (\i. ITER i f x) {i | i < n} /\ + (!i. i < n ==> p i < n /\ f(z i) = z(p i)) + ==> !i. i < n ==> minimal_period p n i`, + REPEAT GEN_TAC THEN + INTRO_TAC "minimal ordered enum transition" THEN + X_GEN_TAC `i:num` THEN DISCH_THEN(LABEL_TAC "ibound") THEN + SUBGOAL_THEN + `(z:num->real) i IN + IMAGE (\k. ITER k (f:real->real) x) {k | k < n}` + (LABEL_TAC "zi") THENL + [USE_THEN "enum" (fun th -> REWRITE_TAC[GSYM th]) THEN + REWRITE_TAC[IN_IMAGE; IN_ELIM_THM] THEN + EXISTS_TAC `i:num` THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `minimal_period (f:real->real) n ((z:num->real) i)` + (LABEL_TAC "pointminimal") THENL + [MATCH_MP_TAC(ISPECL + [`f:real->real`; `n:num`; `x:real`; `(z:num->real) i`] + MINIMAL_PERIOD_ORBIT_MINIMAL) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[MINIMAL_PERIOD_DIVISIBILITY] THEN CONJ_TAC THENL + [USE_THEN "minimal" (MP_TAC o MATCH_MP MINIMAL_PERIOD_POS) THEN + ARITH_TAC; + X_GEN_TAC `m:num` THEN REWRITE_TAC[periodic_point] THEN + MP_TAC(ISPECL + [`f:real->real`; `z:num->real`; `p:num->num`; `n:num`] + FINITE_ORBIT_TRANSITION_ITER) THEN + ANTS_TAC THENL + [USE_THEN "transition" ACCEPT_TAC; + DISCH_THEN(MP_TAC o SPECL [`m:num`; `i:num`])] THEN + ANTS_TAC THENL + [USE_THEN "ibound" ACCEPT_TAC; + INTRO_TAC "iterbound iterate"] THEN + MP_TAC(ISPECL + [`z:num->real`; `n:num`; `ITER m (p:num->num) i`; `i:num`] + FINITE_STRICTLY_INCREASING_INJ) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [USE_THEN "ordered" ACCEPT_TAC; + USE_THEN "iterbound" ACCEPT_TAC; + USE_THEN "ibound" ACCEPT_TAC]; + DISCH_THEN(LABEL_TAC "zinj")] THEN + MP_TAC(ISPECL + [`f:real->real`; `n:num`; `(z:num->real) i`; `m:num`] + MINIMAL_PERIOD_DIVIDES) THEN + ASM_REWRITE_TAC[periodic_point] THEN + ASM_MESON_TAC[]]);; + +let adjacent_interval_cover = new_definition + `adjacent_interval_cover p i j <=> + (p i <= j /\ j + 1 <= p(i + 1)) \/ + (p(i + 1) <= j /\ j + 1 <= p i)`;; + +let ADJACENT_INTERVAL_COVER_BOUND = prove + (`!p n i j. + p i < n /\ + p(i + 1) < n /\ + adjacent_interval_cover p i j + ==> j + 1 < n`, + REWRITE_TAC[adjacent_interval_cover] THEN ARITH_TAC);; + +let ADJACENT_INTERVAL_COVER_MINMAX = prove + (`!p i j. + adjacent_interval_cover p i j <=> + MIN (p i) (p(i + 1)) <= j /\ + j < MAX (p i) (p(i + 1))`, + REPEAT GEN_TAC THEN + REWRITE_TAC[adjacent_interval_cover; MIN; MAX] THEN + COND_CASES_TAC THEN ASM_ARITH_TAC);; + +let ADJACENT_INTERVAL_COVER_CONVEX = prove + (`!p i j k l. + adjacent_interval_cover p i j /\ + adjacent_interval_cover p i k /\ + j <= l /\ + l <= k + ==> adjacent_interval_cover p i l`, + REWRITE_TAC[ADJACENT_INTERVAL_COVER_MINMAX] THEN ARITH_TAC);; + +let ADJACENT_INTERVAL_COVER_BETWEEN = prove + (`!p a b j. + a < b /\ + ((p a <= j /\ j < p b) \/ (p b <= j /\ j < p a)) + ==> ?i. + a <= i /\ + i < b /\ + adjacent_interval_cover p i j`, + SUBGOAL_THEN + `!d p a j. + ((p a <= j /\ j < p(a + SUC d)) \/ + (p(a + SUC d) <= j /\ j < p a)) + ==> ?i. + a <= i /\ + i < a + SUC d /\ + adjacent_interval_cover p i j` + (LABEL_TAC "induction") THENL + [INDUCT_TAC THENL + [MAP_EVERY X_GEN_TAC [`p:num->num`; `a:num`; `j:num`] THEN + DISCH_TAC THEN EXISTS_TAC `a:num` THEN + REWRITE_TAC[adjacent_interval_cover; ADD_CLAUSES] THEN + ASM_ARITH_TAC; + POP_ASSUM(LABEL_TAC "IH") THEN + MAP_EVERY X_GEN_TAC [`p:num->num`; `a:num`; `j:num`] THEN + DISCH_THEN DISJ_CASES_TAC THENL + [ASM_CASES_TAC `(p:num->num) (a + SUC d) <= j` THENL + [EXISTS_TAC `a + SUC d` THEN + RULE_ASSUM_TAC(REWRITE_RULE[ADD_CLAUSES]) THEN + REWRITE_TAC[adjacent_interval_cover; ADD_CLAUSES; + ARITH_RULE + `(a + SUC d) + 1 = a + SUC(SUC d)`] THEN + ASM_ARITH_TAC; + USE_THEN "IH" + (MP_TAC o SPECL [`p:num->num`; `a:num`; `j:num`]) THEN + ANTS_TAC THENL + [ASM_ARITH_TAC; + DISCH_THEN(X_CHOOSE_THEN `i:num` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `i:num` THEN ASM_REWRITE_TAC[] THEN + ASM_ARITH_TAC]]; + ASM_CASES_TAC `(p:num->num) (a + SUC d) <= j` THENL + [USE_THEN "IH" + (MP_TAC o SPECL [`p:num->num`; `a:num`; `j:num`]) THEN + ANTS_TAC THENL + [ASM_ARITH_TAC; + DISCH_THEN(X_CHOOSE_THEN `i:num` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `i:num` THEN ASM_REWRITE_TAC[] THEN + ASM_ARITH_TAC]; + EXISTS_TAC `a + SUC d` THEN + RULE_ASSUM_TAC(REWRITE_RULE[ADD_CLAUSES]) THEN + REWRITE_TAC[adjacent_interval_cover; ADD_CLAUSES; + ARITH_RULE + `(a + SUC d) + 1 = a + SUC(SUC d)`] THEN + ASM_ARITH_TAC]]]; + ALL_TAC] THEN + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(REWRITE_RULE[LT_EXISTS] (ASSUME `(a:num) < b`)) THEN + DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST_ALL_TAC) THEN + USE_THEN "induction" + (MATCH_MP_TAC o SPECL + [`d:num`; `p:num->num`; `a:num`; `j:num`]) THEN + ASM_REWRITE_TAC[]);; + +let ADJACENT_INTERVAL_COVER_RANGE = prove + (`!p a b j k l. + a <= b /\ + adjacent_interval_cover p a j /\ + adjacent_interval_cover p b k /\ + j <= l /\ + l <= k + ==> ?h. + a <= h /\ + h <= b /\ + adjacent_interval_cover p h l`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + ASM_CASES_TAC `adjacent_interval_cover (p:num->num) a l` THENL + [EXISTS_TAC `a:num` THEN ASM_REWRITE_TAC[LE_REFL]; + ALL_TAC] THEN + ASM_CASES_TAC `adjacent_interval_cover (p:num->num) b l` THENL + [EXISTS_TAC `b:num` THEN ASM_REWRITE_TAC[LE_REFL]; + ALL_TAC] THEN + SUBGOAL_THEN + `(p:num->num) a <= l /\ p(a + 1) <= l` + STRIP_ASSUME_TAC THENL + [MP_TAC(ASSUME `adjacent_interval_cover (p:num->num) a j`) THEN + MP_TAC(ASSUME `~adjacent_interval_cover (p:num->num) a l`) THEN + REWRITE_TAC[ADJACENT_INTERVAL_COVER_MINMAX; MIN; MAX] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `l < (p:num->num) b /\ l < p(b + 1)` + STRIP_ASSUME_TAC THENL + [MP_TAC(ASSUME `adjacent_interval_cover (p:num->num) b k`) THEN + MP_TAC(ASSUME `~adjacent_interval_cover (p:num->num) b l`) THEN + REWRITE_TAC[ADJACENT_INTERVAL_COVER_MINMAX; MIN; MAX] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `(a:num) + 1 < b` ASSUME_TAC THENL + [ASM_CASES_TAC `(b:num) = a` THENL + [FIRST_X_ASSUM SUBST_ALL_TAC THEN ASM_ARITH_TAC; + ALL_TAC] THEN + ASM_CASES_TAC `(b:num) = a + 1` THENL + [FIRST_X_ASSUM SUBST_ALL_TAC THEN ASM_ARITH_TAC; + ASM_ARITH_TAC]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`p:num->num`; `a + 1`; `b:num`; `l:num`] + ADJACENT_INTERVAL_COVER_BETWEEN) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN DISJ1_TAC THEN ASM_REWRITE_TAC[]; + DISCH_THEN(X_CHOOSE_THEN `h:num` STRIP_ASSUME_TAC)] THEN + EXISTS_TAC `h:num` THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC);; + +let ADJACENT_INTERVAL_COVER_RANGE_REVERSE = prove + (`!p a b j k l. + a <= b /\ + adjacent_interval_cover p a j /\ + adjacent_interval_cover p b k /\ + k <= l /\ + l <= j + ==> ?h. + a <= h /\ + h <= b /\ + adjacent_interval_cover p h l`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + ASM_CASES_TAC `adjacent_interval_cover (p:num->num) a l` THENL + [EXISTS_TAC `a:num` THEN ASM_REWRITE_TAC[LE_REFL]; + ALL_TAC] THEN + ASM_CASES_TAC `adjacent_interval_cover (p:num->num) b l` THENL + [EXISTS_TAC `b:num` THEN ASM_REWRITE_TAC[LE_REFL]; + ALL_TAC] THEN + SUBGOAL_THEN + `l < (p:num->num) a /\ l < p(a + 1)` + STRIP_ASSUME_TAC THENL + [MP_TAC(ASSUME `adjacent_interval_cover (p:num->num) a j`) THEN + MP_TAC(ASSUME `~adjacent_interval_cover (p:num->num) a l`) THEN + REWRITE_TAC[ADJACENT_INTERVAL_COVER_MINMAX; MIN; MAX] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `(p:num->num) b <= l /\ p(b + 1) <= l` + STRIP_ASSUME_TAC THENL + [MP_TAC(ASSUME `adjacent_interval_cover (p:num->num) b k`) THEN + MP_TAC(ASSUME `~adjacent_interval_cover (p:num->num) b l`) THEN + REWRITE_TAC[ADJACENT_INTERVAL_COVER_MINMAX; MIN; MAX] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `(a:num) + 1 < b` ASSUME_TAC THENL + [ASM_CASES_TAC `(b:num) = a` THENL + [FIRST_X_ASSUM SUBST_ALL_TAC THEN ASM_ARITH_TAC; + ALL_TAC] THEN + ASM_CASES_TAC `(b:num) = a + 1` THENL + [FIRST_X_ASSUM SUBST_ALL_TAC THEN ASM_ARITH_TAC; + ASM_ARITH_TAC]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`p:num->num`; `a + 1`; `b:num`; `l:num`] + ADJACENT_INTERVAL_COVER_BETWEEN) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN DISJ2_TAC THEN ASM_REWRITE_TAC[]; + DISCH_THEN(X_CHOOSE_THEN `h:num` STRIP_ASSUME_TAC)] THEN + EXISTS_TAC `h:num` THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC);; + +let adjacent_interval_reachable = + new_recursive_definition num_RECURSION + `(adjacent_interval_reachable p 0 i j <=> j = i) /\ + (!k. adjacent_interval_reachable p (SUC k) i j <=> + ?h. adjacent_interval_reachable p k i h /\ + adjacent_interval_cover p h j)`;; + +let ADJACENT_INTERVAL_REACHABLE_1 = prove + (`!p i j. + adjacent_interval_reachable p 1 i j <=> + adjacent_interval_cover p i j`, + REWRITE_TAC[ONE; adjacent_interval_reachable] THEN MESON_TAC[]);; + +let ADJACENT_INTERVAL_REACHABLE_BOUND = prove + (`!p n k i j. + (!r. r < n ==> p r < n) /\ + i + 1 < n /\ + adjacent_interval_reachable p k i j + ==> j + 1 < n`, + GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THENL + [MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN + REWRITE_TAC[adjacent_interval_reachable] THEN ARITH_TAC; + POP_ASSUM(LABEL_TAC "IH") THEN + MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN + REWRITE_TAC[adjacent_interval_reachable] THEN + INTRO_TAC "transition ibound @h. path cover" THEN + SUBGOAL_THEN `(h:num) + 1 < n` ASSUME_TAC THENL + [USE_THEN "IH" (MATCH_MP_TAC o SPECL [`i:num`; `h:num`]) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC(ISPECL + [`p:num->num`; `n:num`; `h:num`; `j:num`] + ADJACENT_INTERVAL_COVER_BOUND) THEN + REPEAT CONJ_TAC THENL + [USE_THEN "transition" (MATCH_MP_TAC o SPEC `h:num`) THEN + ASM_ARITH_TAC; + USE_THEN "transition" (MATCH_MP_TAC o SPEC `h + 1`) THEN + ASM_REWRITE_TAC[]; + USE_THEN "cover" ACCEPT_TAC]]);; + +let ADJACENT_INTERVAL_REACHABLE_PREPEND = prove + (`!p k i h j. + adjacent_interval_cover p i h /\ + adjacent_interval_reachable p k h j + ==> adjacent_interval_reachable p (SUC k) i j`, + GEN_TAC THEN INDUCT_TAC THENL + [REWRITE_TAC[adjacent_interval_reachable] THEN MESON_TAC[]; + POP_ASSUM(LABEL_TAC "IH") THEN + MAP_EVERY X_GEN_TAC [`i:num`; `h:num`; `j:num`] THEN + INTRO_TAC "first path" THEN + USE_THEN "path" + (MP_TAC o REWRITE_RULE[adjacent_interval_reachable]) THEN + DISCH_THEN(X_CHOOSE_THEN `l:num` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `adjacent_interval_reachable p (SUC k) i l` + ASSUME_TAC THENL + [USE_THEN "IH" + (MATCH_MP_TAC o SPECL [`i:num`; `h:num`; `l:num`]) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + ONCE_REWRITE_TAC[adjacent_interval_reachable] THEN + EXISTS_TAC `l:num` THEN ASM_REWRITE_TAC[]]);; + +let ADJACENT_INTERVAL_REACHABLE_TRANS = prove + (`!p k l i j h. + adjacent_interval_reachable p k i j /\ + adjacent_interval_reachable p l j h + ==> adjacent_interval_reachable p (k + l) i h`, + GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THENL + [REWRITE_TAC[ADD_CLAUSES; adjacent_interval_reachable] THEN + MESON_TAC[]; + POP_ASSUM(LABEL_TAC "IH") THEN + MAP_EVERY X_GEN_TAC [`i:num`; `j:num`; `h:num`] THEN + INTRO_TAC "first path" THEN + USE_THEN "path" + (MP_TAC o REWRITE_RULE[adjacent_interval_reachable]) THEN + DISCH_THEN(X_CHOOSE_THEN `m:num` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `adjacent_interval_reachable p (k + l) i m` + ASSUME_TAC THENL + [USE_THEN "IH" + (MATCH_MP_TAC o SPECL [`i:num`; `j:num`; `m:num`]) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[ADD_CLAUSES] THEN + ONCE_REWRITE_TAC[adjacent_interval_reachable] THEN + EXISTS_TAC `m:num` THEN ASM_REWRITE_TAC[]]);; + +let ADJACENT_INTERVAL_REACHABLE_SELF = prove + (`!p k i j. + adjacent_interval_cover p i i /\ + adjacent_interval_reachable p k i j + ==> adjacent_interval_reachable p (SUC k) i j`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC(ISPECL + [`p:num->num`; `k:num`; `i:num`; `i:num`; `j:num`] + ADJACENT_INTERVAL_REACHABLE_PREPEND) THEN + ASM_REWRITE_TAC[]);; + +let ADJACENT_INTERVAL_REACHABLE_CONVEX = prove + (`!p k i j l m. + adjacent_interval_reachable p k i j /\ + adjacent_interval_reachable p k i l /\ + j <= m /\ + m <= l + ==> adjacent_interval_reachable p k i m`, + GEN_TAC THEN INDUCT_TAC THENL + [REWRITE_TAC[adjacent_interval_reachable] THEN ARITH_TAC; + POP_ASSUM(LABEL_TAC "IH") THEN + MAP_EVERY X_GEN_TAC + [`i:num`; `j:num`; `l:num`; `m:num`] THEN + INTRO_TAC "pathj pathl jm ml" THEN + USE_THEN "pathj" + (MP_TAC o REWRITE_RULE[adjacent_interval_reachable]) THEN + DISCH_THEN(X_CHOOSE_THEN `a:num` STRIP_ASSUME_TAC) THEN + USE_THEN "pathl" + (MP_TAC o REWRITE_RULE[adjacent_interval_reachable]) THEN + DISCH_THEN(X_CHOOSE_THEN `b:num` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `?h. adjacent_interval_reachable p k i h /\ + adjacent_interval_cover p h m` + MP_TAC THENL + [ASM_CASES_TAC `(a:num) <= b` THENL + [MP_TAC(ISPECL + [`p:num->num`; `a:num`; `b:num`; `j:num`; `l:num`; `m:num`] + ADJACENT_INTERVAL_COVER_RANGE) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[]; + DISCH_THEN(X_CHOOSE_THEN `h:num` STRIP_ASSUME_TAC)] THEN + EXISTS_TAC `h:num` THEN CONJ_TAC THENL + [USE_THEN "IH" + (MATCH_MP_TAC o + SPECL [`i:num`; `a:num`; `b:num`; `h:num`]) THEN + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]]; + MP_TAC(ISPECL + [`p:num->num`; `b:num`; `a:num`; `l:num`; `j:num`; `m:num`] + ADJACENT_INTERVAL_COVER_RANGE_REVERSE) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; + DISCH_THEN(X_CHOOSE_THEN `h:num` STRIP_ASSUME_TAC)] THEN + EXISTS_TAC `h:num` THEN CONJ_TAC THENL + [USE_THEN "IH" + (MATCH_MP_TAC o + SPECL [`i:num`; `b:num`; `a:num`; `h:num`]) THEN + ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; + ASM_REWRITE_TAC[]]]; + DISCH_THEN(X_CHOOSE_THEN `h:num` STRIP_ASSUME_TAC)] THEN + ONCE_REWRITE_TAC[adjacent_interval_reachable] THEN + EXISTS_TAC `h:num` THEN ASM_REWRITE_TAC[]]);; + +let ADJACENT_INTERVAL_REACHABLE_PATH = prove + (`!p k i j. + adjacent_interval_reachable p k i j <=> + ?q. q 0 = i /\ + q k = j /\ + !r. r < k + ==> adjacent_interval_cover p (q r) (q(SUC r))`, + GEN_TAC THEN INDUCT_TAC THENL + [REWRITE_TAC[adjacent_interval_reachable] THEN + MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN EQ_TAC THENL + [DISCH_THEN SUBST1_TAC THEN + EXISTS_TAC `\r:num. (i:num)` THEN REWRITE_TAC[] THEN ARITH_TAC; + DISCH_THEN(X_CHOOSE_THEN `q:num->num` STRIP_ASSUME_TAC) THEN + TRANS_TAC EQ_TRANS `(q:num->num) 0` THEN CONJ_TAC THENL + [ACCEPT_TAC(SYM(ASSUME `(q:num->num) 0 = j`)); + ACCEPT_TAC(ASSUME `(q:num->num) 0 = i`)]]; + POP_ASSUM(LABEL_TAC "IH") THEN + MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN + ONCE_REWRITE_TAC[adjacent_interval_reachable] THEN + EQ_TAC THENL + [DISCH_THEN(X_CHOOSE_THEN `h:num` STRIP_ASSUME_TAC) THEN + USE_THEN "IH" (MP_TAC o SPECL [`i:num`; `h:num`]) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `q:num->num` STRIP_ASSUME_TAC) THEN + EXISTS_TAC + `\r. if r < SUC k then (q:num->num) r else j` THEN + REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[ARITH_RULE `0 < SUC k`]; + REWRITE_TAC[LT_REFL]; + X_GEN_TAC `r:num` THEN DISCH_TAC THEN + ASM_CASES_TAC `(r:num) < k` THENL + [SUBGOAL_THEN `SUC(r:num) < SUC k` ASSUME_TAC THENL + [ASM_ARITH_TAC; + ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]; + SUBGOAL_THEN `(r:num) = k` SUBST_ALL_TAC THENL + [ASM_ARITH_TAC; + ASM_REWRITE_TAC[LT_REFL; GSYM ADD1]]]]; + DISCH_THEN(X_CHOOSE_THEN `q:num->num` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(q:num->num) k` THEN CONJ_TAC THENL + [USE_THEN "IH" + (MATCH_MP_TAC o snd o EQ_IMP_RULE o + SPECL [`i:num`; `(q:num->num) k`]) THEN + EXISTS_TAC `q:num->num` THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `r:num` THEN DISCH_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; + FIRST_X_ASSUM(MP_TAC o SPEC `k:num`) THEN + ANTS_TAC THENL + [ARITH_TAC; + ASM_REWRITE_TAC[]]]]]);; + +let ADJACENT_INTERVAL_PATH_BOUND = prove + (`!p n k i (q:num->num). + (!r. r < n ==> p r < n) /\ + i + 1 < n /\ + q 0 = i /\ + (!r. r < k + ==> adjacent_interval_cover p (q r) (q(SUC r))) + ==> !r. r <= k ==> q r + 1 < n`, + REPEAT GEN_TAC THEN + INTRO_TAC "transition ibound initial path" THEN + INDUCT_TAC THENL + [ASM_REWRITE_TAC[]; + DISCH_TAC THEN + SUBGOAL_THEN `(q:num->num) r + 1 < n` ASSUME_TAC THENL + [MATCH_MP_TAC(ASSUME + `r <= k ==> (q:num->num) r + 1 < n`) THEN + ASM_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(ISPECL + [`p:num->num`; `n:num`; `(q:num->num) r`; + `(q:num->num)(SUC r)`] + ADJACENT_INTERVAL_COVER_BOUND) THEN + REPEAT CONJ_TAC THENL + [USE_THEN "transition" (MATCH_MP_TAC o SPEC `(q:num->num) r`) THEN + ASM_ARITH_TAC; + USE_THEN "transition" + (MATCH_MP_TAC o SPEC `(q:num->num) r + 1`) THEN + ASM_REWRITE_TAC[]; + USE_THEN "path" MATCH_MP_TAC THEN ASM_ARITH_TAC]]);; + +let FINITE_ASCENDING_CHAIN_STABILIZES = prove + (`!s:num->A->bool u. + FINITE u /\ + (!k. s k SUBSET u) /\ + (!k. s k SUBSET s(SUC k)) + ==> ?k. s(SUC k) = s k`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(BETA_RULE(fst(EQ_IMP_RULE + (SPEC `\m. ?k. m = CARD((s:num->A->bool) k)` num_MAX)))) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [EXISTS_TAC `CARD((s:num->A->bool) 0)` THEN + EXISTS_TAC `0` THEN REFL_TAC; + EXISTS_TAC `CARD(u:A->bool)` THEN + X_GEN_TAC `m:num` THEN + DISCH_THEN(X_CHOOSE_THEN `k:num` SUBST1_TAC) THEN + MATCH_MP_TAC CARD_SUBSET THEN ASM_REWRITE_TAC[]]; + INTRO_TAC "@m. (@k. card) maximal"] THEN + USE_THEN "card" SUBST_ALL_TAC THEN + EXISTS_TAC `k:num` THEN + ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN + MATCH_MP_TAC CARD_SUBSET_LE THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `u:A->bool` THEN ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + USE_THEN "maximal" MATCH_MP_TAC THEN + EXISTS_TAC `SUC k` THEN REFL_TAC]);; + +let FINITE_CYCLIC_CLOSED_INTERVAL = prove + (`!p n a b. + a < b /\ + b < n /\ + (!i. i < n ==> p i < n /\ minimal_period p n i) /\ + (!i j. + a <= i /\ + i < b /\ + adjacent_interval_cover p i j + ==> a <= j /\ j < b) + ==> a = 0 /\ b + 1 = n`, + REPEAT GEN_TAC THEN + INTRO_TAC "nontrivial bound cycle closed" THEN + SUBGOAL_THEN + `!h. a <= h /\ h < b + ==> a <= (p:num->num) h /\ + p h <= b /\ + a <= p(h + 1) /\ + p(h + 1) <= b` + (LABEL_TAC "edge_invariant") THENL + [X_GEN_TAC `h:num` THEN STRIP_TAC THEN + SUBGOAL_THEN + `~((p:num->num) h = p(h + 1))` + ASSUME_TAC THENL + [MP_TAC(ISPECL + [`p:num->num`; `n:num`; `h:num`; `h + 1`] + PERIODIC_POINTS_IMAGE_INJ) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [ASM_ARITH_TAC; + MATCH_MP_TAC MINIMAL_PERIOD_PERIODIC THEN + USE_THEN "cycle" (MP_TAC o SPEC `h:num`) THEN + ANTS_TAC THENL + [ASM_ARITH_TAC; + SIMP_TAC[]]; + MATCH_MP_TAC MINIMAL_PERIOD_PERIODIC THEN + USE_THEN "cycle" (MP_TAC o SPEC `h + 1`) THEN + ANTS_TAC THENL + [ASM_ARITH_TAC; + SIMP_TAC[]]]; + ASM_REWRITE_TAC[] THEN ARITH_TAC]; + ALL_TAC] THEN + ASM_CASES_TAC `(p:num->num) h < p(h + 1)` THENL + [SUBGOAL_THEN + `a <= (p:num->num) h /\ p h < b` + STRIP_ASSUME_TAC THENL + [USE_THEN "closed" + (MATCH_MP_TAC o SPECL [`h:num`; `(p:num->num) h`]) THEN + ASM_REWRITE_TAC[adjacent_interval_cover] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `a <= (p:num->num) (h + 1) - 1 /\ + p(h + 1) - 1 < b` + STRIP_ASSUME_TAC THENL + [USE_THEN "closed" + (MATCH_MP_TAC o + SPECL [`h:num`; `(p:num->num) (h + 1) - 1`]) THEN + ASM_REWRITE_TAC[adjacent_interval_cover] THEN ASM_ARITH_TAC; + ASM_ARITH_TAC]; + SUBGOAL_THEN + `(p:num->num) (h + 1) < p h` + ASSUME_TAC THENL + [ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `a <= (p:num->num) (h + 1) /\ p(h + 1) < b` + STRIP_ASSUME_TAC THENL + [USE_THEN "closed" + (MATCH_MP_TAC o + SPECL [`h:num`; `(p:num->num) (h + 1)`]) THEN + ASM_REWRITE_TAC[adjacent_interval_cover] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `a <= (p:num->num) h - 1 /\ p h - 1 < b` + STRIP_ASSUME_TAC THENL + [USE_THEN "closed" + (MATCH_MP_TAC o + SPECL [`h:num`; `(p:num->num) h - 1`]) THEN + ASM_REWRITE_TAC[adjacent_interval_cover] THEN ASM_ARITH_TAC; + ASM_ARITH_TAC]]; + ALL_TAC] THEN + SUBGOAL_THEN + `!r. a <= r /\ r <= b + ==> a <= (p:num->num) r /\ p r <= b` + (LABEL_TAC "invariant") THENL + [X_GEN_TAC `r:num` THEN STRIP_TAC THEN + ASM_CASES_TAC `(r:num) = b` THENL + [FIRST_X_ASSUM SUBST_ALL_TAC THEN + USE_THEN "edge_invariant" (MP_TAC o SPEC `b - 1`) THEN + ANTS_TAC THENL + [ASM_ARITH_TAC; + SUBGOAL_THEN `(b:num) - 1 + 1 = b` ASSUME_TAC THENL + [ASM_ARITH_TAC; + DISCH_THEN STRIP_ASSUME_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE + [ASSUME `(b:num) - 1 + 1 = b`]) THEN + ASM_REWRITE_TAC[]]]; + USE_THEN "edge_invariant" (MP_TAC o SPEC `r:num`) THEN + ASM_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN + `!m. ITER m (p:num->num) a IN (a..b)` + (LABEL_TAC "orbit_in_interval") THENL + [INDUCT_TAC THENL + [REWRITE_TAC[ITER; IN_NUMSEG] THEN ASM_ARITH_TAC; + REWRITE_TAC[ITER; IN_NUMSEG] THEN + MATCH_MP_TAC(SPEC `ITER m (p:num->num) a` + (ASSUME + `!r. a <= r /\ r <= b + ==> a <= (p:num->num) r /\ p r <= b`)) THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_NUMSEG]) THEN + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN + `IMAGE (\m. ITER m (p:num->num) a) {m | m < n} + SUBSET (a..b)` + ASSUME_TAC THENL + [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `CARD(IMAGE (\m. ITER m (p:num->num) a) {m | m < n}) = n` + ASSUME_TAC THENL + [MATCH_MP_TAC MINIMAL_PERIOD_ORBIT_CARD THEN + USE_THEN "cycle" (MP_TAC o SPEC `a:num`) THEN + ANTS_TAC THENL + [ASM_ARITH_TAC; + SIMP_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN + `CARD(IMAGE (\m. ITER m (p:num->num) a) {m | m < n}) <= + CARD(a..b)` + MP_TAC THENL + [MATCH_MP_TAC CARD_SUBSET THEN + ASM_REWRITE_TAC[FINITE_NUMSEG]; + ASM_REWRITE_TAC[CARD_NUMSEG] THEN ASM_ARITH_TAC]);; + +let FINITE_CYCLIC_REACHABLE_ALL = prove + (`!p n i j. + (!r. r < n ==> p r < n /\ minimal_period p n r) /\ + i + 1 < n /\ + j + 1 < n /\ + ~(j = i) /\ + adjacent_interval_cover p i i /\ + adjacent_interval_cover p i j + ==> ?k. + !h. h + 1 < n + ==> adjacent_interval_reachable p k i h`, + REPEAT GEN_TAC THEN + INTRO_TAC "cycle ibound jbound distinct self exit" THEN + SUBGOAL_THEN + `!m. adjacent_interval_reachable (p:num->num) m i i` + (LABEL_TAC "loop") THENL + [INDUCT_TAC THENL + [REWRITE_TAC[adjacent_interval_reachable]; + MATCH_MP_TAC ADJACENT_INTERVAL_REACHABLE_SELF THEN + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`\k. {h | h + 1 < n /\ + adjacent_interval_reachable (p:num->num) k i h}`; + `0..n`] + FINITE_ASCENDING_CHAIN_STABILIZES) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [REWRITE_TAC[FINITE_NUMSEG]; + X_GEN_TAC `m:num` THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_NUMSEG] THEN ARITH_TAC; + X_GEN_TAC `m:num` THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN + X_GEN_TAC `h:num` THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC ADJACENT_INTERVAL_REACHABLE_SELF THEN + ASM_REWRITE_TAC[]]; + DISCH_THEN(X_CHOOSE_THEN `k:num` + (LABEL_TAC "stable" o BETA_RULE))] THEN + SUBGOAL_THEN + `!h l. + h + 1 < n /\ + adjacent_interval_reachable (p:num->num) k i h /\ + adjacent_interval_cover p h l + ==> l + 1 < n /\ + adjacent_interval_reachable p k i l` + (LABEL_TAC "reachclosed") THENL + [MAP_EVERY X_GEN_TAC [`h:num`; `l:num`] THEN STRIP_TAC THEN + SUBGOAL_THEN `(l:num) + 1 < n` ASSUME_TAC THENL + [MATCH_MP_TAC(ISPECL + [`p:num->num`; `n:num`; `h:num`; `l:num`] + ADJACENT_INTERVAL_COVER_BOUND) THEN + REPEAT CONJ_TAC THENL + [USE_THEN "cycle" (MP_TAC o SPEC `h:num`) THEN + ANTS_TAC THENL + [ASM_ARITH_TAC; + SIMP_TAC[]]; + USE_THEN "cycle" (MP_TAC o SPEC `h + 1`) THEN + ANTS_TAC THENL + [ASM_ARITH_TAC; + SIMP_TAC[]]; + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + SUBGOAL_THEN + `l IN {q | q + 1 < n /\ + adjacent_interval_reachable + (p:num->num) k i q}` + MP_TAC THENL + [USE_THEN "stable" (SUBST1_TAC o SYM) THEN + REWRITE_TAC[IN_ELIM_THM] THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + ONCE_REWRITE_TAC[adjacent_interval_reachable] THEN + EXISTS_TAC `h:num` THEN ASM_REWRITE_TAC[]]; + REWRITE_TAC[IN_ELIM_THM] THEN SIMP_TAC[]]]; + ALL_TAC] THEN + SUBGOAL_THEN + `j + 1 < n /\ + adjacent_interval_reachable (p:num->num) k i j` + STRIP_ASSUME_TAC THENL + [USE_THEN "reachclosed" + (MATCH_MP_TAC o SPECL [`i:num`; `j:num`]) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MP_TAC(BETA_RULE(fst(EQ_IMP_RULE + (SPEC + `\h. h + 1 < n /\ + adjacent_interval_reachable (p:num->num) k i h` + num_WOP)))) THEN + ANTS_TAC THENL + [EXISTS_TAC `i:num` THEN ASM_REWRITE_TAC[]; + INTRO_TAC "@a. amin minimal"] THEN + MP_TAC(BETA_RULE(fst(EQ_IMP_RULE + (SPEC + `\h. h + 1 < n /\ + adjacent_interval_reachable (p:num->num) k i h` + num_MAX)))) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [EXISTS_TAC `i:num` THEN ASM_REWRITE_TAC[]; + EXISTS_TAC `n:num` THEN + X_GEN_TAC `h:num` THEN STRIP_TAC THEN ASM_ARITH_TAC]; + INTRO_TAC "@b. bmax maximal"] THEN + SUBGOAL_THEN + `!h. + (h + 1 < n /\ + adjacent_interval_reachable (p:num->num) k i h <=> + a <= h /\ h <= b)` + (LABEL_TAC "range") THENL + [X_GEN_TAC `h:num` THEN EQ_TAC THENL + [DISCH_TAC THEN CONJ_TAC THENL + [ASM_CASES_TAC `(a:num) <= h` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `(h:num) < a` ASSUME_TAC THENL + [ASM_ARITH_TAC; + ALL_TAC] THEN + USE_THEN "minimal" (MP_TAC o SPEC `h:num`) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[]; + DISCH_TAC THEN + UNDISCH_TAC + `h + 1 < n /\ + adjacent_interval_reachable (p:num->num) k i h` THEN + ASM_REWRITE_TAC[]]; + USE_THEN "maximal" MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]; + STRIP_TAC THEN CONJ_TAC THENL + [MP_TAC(CONJUNCT1(ASSUME + `b + 1 < n /\ + adjacent_interval_reachable (p:num->num) k i b`)) THEN + ASM_ARITH_TAC; + MATCH_MP_TAC(ISPECL + [`p:num->num`; `k:num`; `i:num`; + `a:num`; `b:num`; `h:num`] + ADJACENT_INTERVAL_REACHABLE_CONVEX) THEN + ASM_REWRITE_TAC[]]]; + ALL_TAC] THEN + SUBGOAL_THEN `(a:num) < b` ASSUME_TAC THENL + [SUBGOAL_THEN `(a:num) <= i /\ i <= b` + STRIP_ASSUME_TAC THENL + [USE_THEN "range" + (MATCH_MP_TAC o fst o EQ_IMP_RULE o SPEC `i:num`) THEN + CONJ_TAC THENL + [USE_THEN "ibound" ACCEPT_TAC; + USE_THEN "loop" (ACCEPT_TAC o SPEC `k:num`)]; + ALL_TAC] THEN + SUBGOAL_THEN `(a:num) <= j /\ j <= b` + STRIP_ASSUME_TAC THENL + [USE_THEN "range" + (MATCH_MP_TAC o fst o EQ_IMP_RULE o SPEC `j:num`) THEN + CONJ_TAC THENL + [USE_THEN "jbound" ACCEPT_TAC; + ACCEPT_TAC(ASSUME + `adjacent_interval_reachable (p:num->num) k i j`)]; + ASM_CASES_TAC `(a:num) < b` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `(i:num) = j` ASSUME_TAC THENL + [ASM_ARITH_TAC; + UNDISCH_TAC `~((j:num) = i)` THEN ASM_REWRITE_TAC[]]]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`p:num->num`; `n:num`; `a:num`; `b + 1`] + FINITE_CYCLIC_CLOSED_INTERVAL) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [ASM_ARITH_TAC; + ACCEPT_TAC(CONJUNCT1(ASSUME + `b + 1 < n /\ + adjacent_interval_reachable (p:num->num) k i b`)); + USE_THEN "cycle" ACCEPT_TAC; + MAP_EVERY X_GEN_TAC [`h:num`; `l:num`] THEN STRIP_TAC THEN + SUBGOAL_THEN + `h + 1 < n /\ + adjacent_interval_reachable (p:num->num) k i h` + STRIP_ASSUME_TAC THENL + [USE_THEN "range" + (MATCH_MP_TAC o snd o EQ_IMP_RULE o SPEC `h:num`) THEN + ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `l + 1 < n /\ + adjacent_interval_reachable (p:num->num) k i l` + STRIP_ASSUME_TAC THENL + [USE_THEN "reachclosed" + (MATCH_MP_TAC o SPECL [`h:num`; `l:num`]) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `(a:num) <= l /\ l <= b` + STRIP_ASSUME_TAC THENL + [USE_THEN "range" + (MATCH_MP_TAC o fst o EQ_IMP_RULE o SPEC `l:num`) THEN + CONJ_TAC THENL + [ACCEPT_TAC(ASSUME `(l:num) + 1 < n`); + ACCEPT_TAC(ASSUME + `adjacent_interval_reachable (p:num->num) k i l`)]; + ASM_ARITH_TAC]]; + STRIP_TAC] THEN + EXISTS_TAC `k:num` THEN + X_GEN_TAC `h:num` THEN DISCH_TAC THEN + SUBGOAL_THEN + `h + 1 < n /\ + adjacent_interval_reachable (p:num->num) k i h` + MP_TAC THENL + [USE_THEN "range" (fun th -> REWRITE_TAC[th]) THEN + ASM_ARITH_TAC; + SIMP_TAC[]]);; + +let FINITE_CYCLIC_SELFCOVER_EXIT = prove + (`!p n i. + 2 < n /\ + (!r. r < n ==> p r < n /\ minimal_period p n r) /\ + i + 1 < n /\ + adjacent_interval_cover p i i + ==> ?j. + j + 1 < n /\ + ~(j = i) /\ + adjacent_interval_cover p i j`, + REPEAT GEN_TAC THEN + INTRO_TAC "nontrivial cycle ibound self" THEN + SUBGOAL_THEN + `(p:num->num) i < n /\ + minimal_period p n i /\ + p(i + 1) < n` + STRIP_ASSUME_TAC THENL + [REPEAT CONJ_TAC THENL + [USE_THEN "cycle" (MP_TAC o SPEC `i:num`) THEN + ANTS_TAC THENL + [ASM_ARITH_TAC; + SIMP_TAC[]]; + USE_THEN "cycle" (MP_TAC o SPEC `i:num`) THEN + ANTS_TAC THENL + [ASM_ARITH_TAC; + SIMP_TAC[]]; + USE_THEN "cycle" (MP_TAC o SPEC `i + 1`) THEN + ANTS_TAC THENL + [USE_THEN "ibound" ACCEPT_TAC; + SIMP_TAC[]]]; + ALL_TAC] THEN + USE_THEN "self" + (DISJ_CASES_TAC o REWRITE_RULE[adjacent_interval_cover]) THENL + [SUBGOAL_THEN + `(p:num->num) i < i \/ i + 1 < p(i + 1)` + MP_TAC THENL + [ASM_CASES_TAC `(p:num->num) i < i` THEN + ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `i + 1 < (p:num->num) (i + 1)` THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `(p:num->num) i = i` ASSUME_TAC THENL + [ASM_ARITH_TAC; + MP_TAC(ISPECL + [`p:num->num`; `n:num`; `i:num`; `0`; `1`] + MINIMAL_PERIOD_ITER_INJ) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + ASM_ARITH_TAC; + ASM_ARITH_TAC]; + REWRITE_TAC[ITER; ITER_1] THEN ASM_REWRITE_TAC[] THEN + ARITH_TAC]]; + DISCH_THEN DISJ_CASES_TAC THENL + [EXISTS_TAC `i - 1` THEN + ASM_REWRITE_TAC[adjacent_interval_cover] THEN ASM_ARITH_TAC; + EXISTS_TAC `i + 1` THEN + ASM_REWRITE_TAC[adjacent_interval_cover] THEN ASM_ARITH_TAC]]; + SUBGOAL_THEN + `(p:num->num) (i + 1) < i \/ i + 1 < p i` + MP_TAC THENL + [ASM_CASES_TAC `(p:num->num) (i + 1) < i` THEN + ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `i + 1 < (p:num->num) i` THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `(p:num->num) (i + 1) = i /\ p i = i + 1` + STRIP_ASSUME_TAC THENL + [CONJ_TAC THEN ASM_ARITH_TAC; + MP_TAC(ISPECL + [`p:num->num`; `n:num`; `i:num`; `0`; `2`] + MINIMAL_PERIOD_ITER_INJ) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + ASM_ARITH_TAC; + ASM_ARITH_TAC]; + REWRITE_TAC[ARITH_RULE `2 = SUC(SUC 0)`; ITER; o_THM] THEN + ASM_REWRITE_TAC[] THEN ARITH_TAC]]; + DISCH_THEN DISJ_CASES_TAC THENL + [EXISTS_TAC `i - 1` THEN + ASM_REWRITE_TAC[adjacent_interval_cover] THEN ASM_ARITH_TAC; + EXISTS_TAC `i + 1` THEN + ASM_REWRITE_TAC[adjacent_interval_cover] THEN + ASM_ARITH_TAC]]]);; + +let FINITE_CYCLIC_CROSSING = prove + (`!p n. + 1 < n /\ + (!i. i < n ==> p i < n /\ minimal_period p n i) + ==> ?i. + i + 1 < n /\ + p(i + 1) <= i /\ + i + 1 <= p i`, + REPEAT GEN_TAC THEN + INTRO_TAC "nontrivial cycle" THEN + SUBGOAL_THEN + `(p:num->num) 0 < n /\ minimal_period p n 0` + STRIP_ASSUME_TAC THENL + [USE_THEN "cycle" (MATCH_MP_TAC o SPEC `0`) THEN + ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `?i:num. + (i < n /\ i < (p:num->num) i) /\ + !j. j < n /\ j < p j ==> j <= i` + MP_TAC THENL + [MP_TAC(SPEC `\j:num. j < n /\ j < (p:num->num) j` num_MAX) THEN + DISCH_THEN(MP_TAC o BETA_RULE o fst o EQ_IMP_RULE) THEN + DISCH_THEN MATCH_MP_TAC THEN BETA_TAC THEN CONJ_TAC THENL + [EXISTS_TAC `0` THEN CONJ_TAC THENL + [ASM_ARITH_TAC; + REWRITE_TAC[LT_NZ] THEN + MP_TAC(ISPECL + [`p:num->num`; `n:num`; `0`; `0`; `1`] + MINIMAL_PERIOD_ITER_INJ) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + CONJ_TAC THENL + [USE_THEN "nontrivial" MP_TAC THEN ARITH_TAC; + USE_THEN "nontrivial" ACCEPT_TAC]]; + DISCH_THEN(fun ith -> + DISCH_THEN(fun fth -> + MP_TAC(REWRITE_RULE[ITER; ITER_1; fth] ith))) THEN + ARITH_TAC]]; + EXISTS_TAC `n:num` THEN BETA_TAC THEN + X_GEN_TAC `j:num` THEN STRIP_TAC THEN ASM_ARITH_TAC]; + DISCH_THEN(X_CHOOSE_THEN `i:num` STRIP_ASSUME_TAC)] THEN + SUBGOAL_THEN `(i:num) + 1 < n` ASSUME_TAC THENL + [USE_THEN "cycle" (MP_TAC o SPEC `i:num`) THEN + ANTS_TAC THENL + [ACCEPT_TAC(ASSUME `(i:num) < n`); + DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC)] THEN + MP_TAC(ASSUME `(i:num) < (p:num->num) i`) THEN ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `(p:num->num) (i + 1) < n /\ + minimal_period p n (i + 1)` + STRIP_ASSUME_TAC THENL + [USE_THEN "cycle" (MATCH_MP_TAC o SPEC `i + 1`) THEN + ACCEPT_TAC(ASSUME `(i:num) + 1 < n`); + ALL_TAC] THEN + SUBGOAL_THEN `(p:num->num) (i + 1) <= i` + ASSUME_TAC THENL + [ASM_CASES_TAC `(p:num->num) (i + 1) <= i` THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `~((p:num->num) (i + 1) = i + 1)` ASSUME_TAC THENL + [MP_TAC(ISPECL + [`p:num->num`; `n:num`; `i + 1`; `0`; `1`] + MINIMAL_PERIOD_ITER_INJ) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + CONJ_TAC THENL + [USE_THEN "nontrivial" MP_TAC THEN ARITH_TAC; + USE_THEN "nontrivial" ACCEPT_TAC]]; + DISCH_THEN(fun ith -> + DISCH_THEN(fun fth -> + MP_TAC(REWRITE_RULE[ITER; ITER_1; fth] ith))) THEN + ARITH_TAC]; + ALL_TAC] THEN + MP_TAC(SPEC `i + 1` + (ASSUME `!j. j < n /\ j < (p:num->num) j ==> j <= i`)) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [ACCEPT_TAC(ASSUME `(i:num) + 1 < n`); + UNDISCH_TAC `~((p:num->num) (i + 1) <= i)` THEN + UNDISCH_TAC `~((p:num->num) (i + 1) = i + 1)` THEN + ARITH_TAC]; + ARITH_TAC]; + ALL_TAC] THEN + EXISTS_TAC `i:num` THEN CONJ_TAC THENL + [ACCEPT_TAC(ASSUME `(i:num) + 1 < n`); + CONJ_TAC THENL + [ACCEPT_TAC(ASSUME `(p:num->num) (i + 1) <= i`); + MP_TAC(ASSUME `(i:num) < (p:num->num) i`) THEN ARITH_TAC]]);; + +let FINITE_ODD_CYCLIC_RETURN = prove + (`!p n. + ODD n /\ + 2 < n /\ + (!i. i < n ==> p i < n /\ minimal_period p n i) + ==> ?i j. + i + 1 < n /\ + j + 1 < n /\ + ~(j = i) /\ + p(i + 1) <= i /\ + i + 1 <= p i /\ + adjacent_interval_cover p i i /\ + adjacent_interval_cover p j i`, + REPEAT GEN_TAC THEN + INTRO_TAC "odd nontrivial cycle" THEN + MP_TAC(ISPECL [`p:num->num`; `n:num`] FINITE_CYCLIC_CROSSING) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [USE_THEN "nontrivial" MP_TAC THEN ARITH_TAC; + USE_THEN "cycle" ACCEPT_TAC]; + DISCH_THEN(X_CHOOSE_THEN `i:num` STRIP_ASSUME_TAC)] THEN + SUBGOAL_THEN `(p:num->num) i < n` ASSUME_TAC THENL + [USE_THEN "cycle" (MP_TAC o SPEC `i:num`) THEN + ANTS_TAC THENL + [MP_TAC(ASSUME `(i:num) + 1 < n`) THEN ARITH_TAC; + SIMP_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN `(p:num->num) (i + 1) < n` ASSUME_TAC THENL + [USE_THEN "cycle" (MP_TAC o SPEC `i + 1`) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[]; + DISCH_THEN(MP_TAC o CONJUNCT1) THEN SIMP_TAC[]]; + ALL_TAC] THEN + ASM_CASES_TAC + `?j. j + 1 < n /\ ~(j = i) /\ adjacent_interval_cover p j i` + THENL + [POP_ASSUM(X_CHOOSE_THEN `j:num` STRIP_ASSUME_TAC) THEN + MAP_EVERY EXISTS_TAC [`i:num`; `j:num`] THEN + ASM_REWRITE_TAC[adjacent_interval_cover] THEN ASM_ARITH_TAC; + POP_ASSUM(LABEL_TAC "noreturn")] THEN + SUBGOAL_THEN + `!r. r <= i ==> i < (p:num->num) r` + (LABEL_TAC "left") THENL + [X_GEN_TAC `r:num` THEN DISCH_TAC THEN + ASM_CASES_TAC `(r:num) = i` THENL + [ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + ASM_CASES_TAC `i < (p:num->num) r` THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL + [`p:num->num`; `r:num`; `i:num`; `i:num`] + ADJACENT_INTERVAL_COVER_BETWEEN) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [ASM_ARITH_TAC; + DISJ1_TAC THEN ASM_ARITH_TAC]; + DISCH_THEN(X_CHOOSE_THEN `h:num` STRIP_ASSUME_TAC)] THEN + SUBGOAL_THEN + `?j. j + 1 < n /\ + ~(j = i) /\ + adjacent_interval_cover (p:num->num) j i` + MP_TAC THENL + [EXISTS_TAC `h:num` THEN CONJ_TAC THENL + [ASM_ARITH_TAC; + CONJ_TAC THENL + [ASM_ARITH_TAC; + ASM_REWRITE_TAC[]]]; + DISCH_THEN ASSUME_TAC THEN ASM_MESON_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN + `!r. i + 1 <= r /\ r < n ==> (p:num->num) r <= i` + (LABEL_TAC "right") THENL + [X_GEN_TAC `r:num` THEN STRIP_TAC THEN + ASM_CASES_TAC `(p:num->num) r <= i` THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL + [`p:num->num`; `i + 1`; `r:num`; `i:num`] + ADJACENT_INTERVAL_COVER_BETWEEN) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [ASM_CASES_TAC `(r:num) = i + 1` THENL + [FIRST_X_ASSUM SUBST_ALL_TAC THEN ASM_MESON_TAC[]; + ASM_ARITH_TAC]; + DISJ1_TAC THEN ASM_ARITH_TAC]; + DISCH_THEN(X_CHOOSE_THEN `h:num` STRIP_ASSUME_TAC)] THEN + SUBGOAL_THEN + `?j. j + 1 < n /\ + ~(j = i) /\ + adjacent_interval_cover (p:num->num) j i` + MP_TAC THENL + [EXISTS_TAC `h:num` THEN CONJ_TAC THENL + [ASM_ARITH_TAC; + CONJ_TAC THENL + [ASM_ARITH_TAC; + ASM_REWRITE_TAC[]]]; + DISCH_THEN ASSUME_TAC THEN ASM_MESON_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN + `!r s. + r < n /\ s < n /\ (p:num->num) r = p s + ==> r = s` + (LABEL_TAC "injective") THENL + [MAP_EVERY X_GEN_TAC [`r:num`; `s:num`] THEN STRIP_TAC THEN + MP_TAC(ISPECL [`p:num->num`; `n:num`; `r:num`; `s:num`] + PERIODIC_POINTS_IMAGE_INJ) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [USE_THEN "nontrivial" MP_TAC THEN ARITH_TAC; + MATCH_MP_TAC MINIMAL_PERIOD_PERIODIC THEN + USE_THEN "cycle" (MP_TAC o SPEC `r:num`) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[]; + DISCH_THEN(fun th -> ACCEPT_TAC(CONJUNCT2 th))]; + MATCH_MP_TAC MINIMAL_PERIOD_PERIODIC THEN + USE_THEN "cycle" (MP_TAC o SPEC `s:num`) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[]; + DISCH_THEN(fun th -> ACCEPT_TAC(CONJUNCT2 th))]]; + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN + `IMAGE (p:num->num) (0..i) SUBSET ((i + 1)..(n - 1))` + (LABEL_TAC "leftimage") THENL + [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_NUMSEG] THEN + X_GEN_TAC `r:num` THEN STRIP_TAC THEN CONJ_TAC THENL + [USE_THEN "left" (MP_TAC o SPEC `r:num`) THEN ASM_ARITH_TAC; + USE_THEN "cycle" (MP_TAC o SPEC `r:num`) THEN + ANTS_TAC THENL + [ASM_ARITH_TAC; + SIMP_TAC[] THEN ARITH_TAC]]; + ALL_TAC] THEN + SUBGOAL_THEN + `IMAGE (p:num->num) ((i + 1)..(n - 1)) SUBSET (0..i)` + (LABEL_TAC "rightimage") THENL + [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_NUMSEG] THEN + X_GEN_TAC `r:num` THEN STRIP_TAC THEN + USE_THEN "right" (MP_TAC o SPEC `r:num`) THEN ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `CARD(IMAGE (p:num->num) (0..i)) = CARD(0..i)` + (LABEL_TAC "leftcard") THENL + [MATCH_MP_TAC CARD_IMAGE_INJ THEN + REWRITE_TAC[FINITE_NUMSEG] THEN + MAP_EVERY X_GEN_TAC [`r:num`; `s:num`] THEN + REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN + USE_THEN "injective" MATCH_MP_TAC THEN ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `CARD(IMAGE (p:num->num) ((i + 1)..(n - 1))) = + CARD((i + 1)..(n - 1))` + (LABEL_TAC "rightcard") THENL + [MATCH_MP_TAC CARD_IMAGE_INJ THEN + REWRITE_TAC[FINITE_NUMSEG] THEN + MAP_EVERY X_GEN_TAC [`r:num`; `s:num`] THEN + REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN + USE_THEN "injective" MATCH_MP_TAC THEN ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `CARD(0..i) <= CARD((i + 1)..(n - 1))` + ASSUME_TAC THENL + [USE_THEN "leftcard" (fun th -> REWRITE_TAC[GSYM th]) THEN + MATCH_MP_TAC CARD_SUBSET THEN + ASM_REWRITE_TAC[FINITE_NUMSEG]; + ALL_TAC] THEN + SUBGOAL_THEN + `CARD((i + 1)..(n - 1)) <= CARD(0..i)` + ASSUME_TAC THENL + [USE_THEN "rightcard" (fun th -> REWRITE_TAC[GSYM th]) THEN + MATCH_MP_TAC CARD_SUBSET THEN + ASM_REWRITE_TAC[FINITE_NUMSEG]; + ALL_TAC] THEN + SUBGOAL_THEN `(n:num) = 2 * (i + 1)` ASSUME_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE[CARD_NUMSEG]) THEN ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `EVEN n` ASSUME_TAC THENL + [REWRITE_TAC[EVEN_EXISTS] THEN EXISTS_TAC `i + 1` THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + USE_THEN "odd" MP_TAC THEN + REWRITE_TAC[GSYM NOT_EVEN] THEN ASM_REWRITE_TAC[]);; + +let FINITE_ODD_CYCLIC_RETURN_CYCLE = prove + (`!p n. + ODD n /\ + 2 < n /\ + (!i. i < n ==> p i < n /\ minimal_period p n i) + ==> ?k q. + 1 < k /\ + (!r. r <= k ==> q r + 1 < n) /\ + q 0 = q k /\ + p(q 0 + 1) <= q 0 /\ + q 0 + 1 <= p(q 0) /\ + adjacent_interval_cover p (q 0) (q 0) /\ + ~(q(k - 1) = q 0) /\ + (!r. r < k + ==> adjacent_interval_cover p (q r) (q(SUC r)))`, + REPEAT GEN_TAC THEN + INTRO_TAC "odd nontrivial cycle" THEN + MP_TAC(ISPECL [`p:num->num`; `n:num`] + FINITE_ODD_CYCLIC_RETURN) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[]; + DISCH_THEN(X_CHOOSE_THEN `i:num` + (X_CHOOSE_THEN `j:num` STRIP_ASSUME_TAC))] THEN + MP_TAC(ISPECL + [`p:num->num`; `n:num`; `i:num`] + FINITE_CYCLIC_SELFCOVER_EXIT) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[]; + DISCH_THEN(X_CHOOSE_THEN `h:num` STRIP_ASSUME_TAC)] THEN + MP_TAC(ISPECL + [`p:num->num`; `n:num`; `i:num`; `h:num`] + FINITE_CYCLIC_REACHABLE_ALL) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[]; + INTRO_TAC "@m. reachable"] THEN + SUBGOAL_THEN + `adjacent_interval_reachable (p:num->num) m i j` + ASSUME_TAC THENL + [USE_THEN "reachable" MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`p:num->num`; `m:num`; `i:num`; `j:num`] + ADJACENT_INTERVAL_REACHABLE_PATH) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `q:num->num` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `0 < (m:num)` ASSUME_TAC THENL + [ASM_CASES_TAC `(m:num) = 0` THENL + [SUBGOAL_THEN `(j:num) = i` ASSUME_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE + [ASSUME `(m:num) = 0`]) THEN + TRANS_TAC EQ_TRANS `(q:num->num) 0` THEN CONJ_TAC THENL + [ACCEPT_TAC(SYM(ASSUME `(q:num->num) 0 = j`)); + ACCEPT_TAC(ASSUME `(q:num->num) 0 = i`)]; + ASM_MESON_TAC[]]; + ASM_ARITH_TAC]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`p:num->num`; `n:num`; `m:num`; `i:num`; `q:num->num`] + ADJACENT_INTERVAL_PATH_BOUND) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [X_GEN_TAC `r:num` THEN DISCH_TAC THEN + USE_THEN "cycle" (MP_TAC o SPEC `r:num`) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[]; + SIMP_TAC[]]; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]]; + DISCH_THEN(LABEL_TAC "qbound")] THEN + EXISTS_TAC `SUC m` THEN + EXISTS_TAC `\r. if r < SUC m then (q:num->num) r else i` THEN + REPEAT CONJ_TAC THENL + [ASM_ARITH_TAC; + X_GEN_TAC `r:num` THEN DISCH_TAC THEN + ASM_CASES_TAC `(r:num) < SUC m` THENL + [ASM_REWRITE_TAC[] THEN + USE_THEN "qbound" MATCH_MP_TAC THEN ASM_ARITH_TAC; + SUBGOAL_THEN `(r:num) = SUC m` SUBST_ALL_TAC THENL + [ASM_ARITH_TAC; + ASM_REWRITE_TAC[LT_REFL]]]; + ASM_REWRITE_TAC[ARITH_RULE `0 < SUC m`; LT_REFL]; + ASM_REWRITE_TAC[ARITH_RULE `0 < SUC m`]; + ASM_REWRITE_TAC[ARITH_RULE `0 < SUC m`]; + ASM_REWRITE_TAC[ARITH_RULE `0 < SUC m`]; + REWRITE_TAC[ARITH_RULE `SUC m - 1 = m`] THEN + ASM_REWRITE_TAC[ARITH_RULE `m < SUC m`; + ARITH_RULE `0 < SUC m`]; + X_GEN_TAC `r:num` THEN DISCH_TAC THEN + ASM_CASES_TAC `(r:num) < m` THENL + [SUBGOAL_THEN `SUC(r:num) < SUC m` ASSUME_TAC THENL + [ASM_ARITH_TAC; + ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]; + SUBGOAL_THEN `(r:num) = m` SUBST_ALL_TAC THENL + [ASM_ARITH_TAC; + ASM_REWRITE_TAC[LT_REFL]]]]);; + +let PATH_FIRST_RETURN_CYCLE = prove + (`!v e w. + (?k (q:num->A). + 1 < k /\ + (!r. r <= k ==> v(q r)) /\ + q 0 = q k /\ + w(q 0) /\ + ~(q(k - 1) = q 0) /\ + (!r. r < k ==> e (q r) (q(SUC r)))) + ==> ?k q. + 1 < k /\ + (!r. r <= k ==> v(q r)) /\ + q 0 = q k /\ + w(q 0) /\ + (!r. 0 < r /\ r < k ==> ~(q r = q 0)) /\ + (!r. r < k ==> e (q r) (q(SUC r)))`, + REPEAT GEN_TAC THEN DISCH_THEN(LABEL_TAC "exists") THEN + MP_TAC(BETA_RULE(fst(EQ_IMP_RULE + (SPEC + `\k. ?q:num->A. + 1 < k /\ + (!r. r <= k ==> v(q r)) /\ + q 0 = q k /\ + w(q 0) /\ + ~(q(k - 1) = q 0) /\ + (!r. r < k ==> e (q r) (q(SUC r)))` + num_WOP)))) THEN + ANTS_TAC THENL + [REMOVE_THEN "exists" MP_TAC THEN REWRITE_TAC[]; + INTRO_TAC + "@k. (@q. length bound closed base last path) minimal"] THEN + MAP_EVERY EXISTS_TAC [`k:num`; `q:num->A`] THEN + ASM_REWRITE_TAC[] THEN + X_GEN_TAC `r:num` THEN + INTRO_TAC "rpos rlt" THEN + DISCH_THEN(LABEL_TAC "return") THEN + USE_THEN "rlt" (MP_TAC o REWRITE_RULE[LT_EXISTS]) THEN + DISCH_THEN(X_CHOOSE_THEN `d:num` SUBST_ALL_TAC) THEN + SUBGOAL_THEN `~(d = 0)` ASSUME_TAC THENL + [DISCH_THEN SUBST_ALL_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE + [ADD_CLAUSES; ARITH_RULE `(r + SUC 0) - 1 = r`]) THEN + USE_THEN "last" MP_TAC THEN + REWRITE_TAC[TAUT `(~p ==> F) <=> p`] THEN + TRANS_TAC EQ_TRANS `(q:num->A)(SUC r)` THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `1 < (r + SUC d) - r` ASSUME_TAC THENL + [ASM_REWRITE_TAC[ADD_SUB2; + ARITH_RULE `1 < SUC d <=> ~(d = 0)`]; + ALL_TAC] THEN + USE_THEN "minimal" + (MP_TAC o SPEC `((r + SUC d) - r)`) THEN + REWRITE_TAC[ADD_SUB2; LT_ADDR] THEN + USE_THEN "rpos" (fun th -> REWRITE_TAC[th]) THEN + EXISTS_TAC `\s. (q:num->A)(r + s)` THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[ADD_SUB2; + ARITH_RULE `1 < SUC d <=> ~(d = 0)`] THEN + ASM_REWRITE_TAC[]; + X_GEN_TAC `s:num` THEN DISCH_THEN(LABEL_TAC "sbound") THEN + BETA_TAC THEN + USE_THEN "bound" MATCH_MP_TAC THEN + USE_THEN "sbound" MP_TAC THEN + REWRITE_TAC[ADD_SUB2; LE_ADD_LCANCEL]; + BETA_TAC THEN REWRITE_TAC[ADD_0; ADD_SUB2] THEN + USE_THEN "return" ACCEPT_TAC; + BETA_TAC THEN REWRITE_TAC[ADD_0] THEN + ASM_MESON_TAC[]; + BETA_TAC THEN + REWRITE_TAC[ADD_SUB2; ARITH_RULE `SUC d - 1 = d`] THEN + RULE_ASSUM_TAC(REWRITE_RULE + [ADD_CLAUSES; ARITH_RULE `(r + SUC d) - 1 = r + d`]) THEN + DISCH_THEN(LABEL_TAC "repeat") THEN + USE_THEN "last" MP_TAC THEN + REWRITE_TAC[TAUT `(~p ==> F) <=> p`] THEN + TRANS_TAC EQ_TRANS `(q:num->A) r` THEN + ASM_REWRITE_TAC[ADD_0]; + X_GEN_TAC `s:num` THEN DISCH_THEN(LABEL_TAC "slt") THEN + BETA_TAC THEN REWRITE_TAC[ADD_CLAUSES] THEN + USE_THEN "path" MATCH_MP_TAC THEN + USE_THEN "slt" MP_TAC THEN + REWRITE_TAC[ADD_SUB2; LT_ADD_LCANCEL]]);; + +let PATH_SIMPLE_CYCLE = prove + (`!v e w. + (?k (q:num->A). + 1 < k /\ + (!r. r <= k ==> v(q r)) /\ + q 0 = q k /\ + w(q 0) /\ + ~(q(k - 1) = q 0) /\ + (!r. r < k ==> e (q r) (q(SUC r)))) + ==> ?k q. + 1 < k /\ + (!r. r <= k ==> v(q r)) /\ + q 0 = q k /\ + w(q 0) /\ + (!r s. r < s /\ s < k ==> ~(q r = q s)) /\ + (!r. r < k ==> e (q r) (q(SUC r)))`, + REPEAT GEN_TAC THEN DISCH_THEN(LABEL_TAC "exists") THEN + MP_TAC(BETA_RULE(fst(EQ_IMP_RULE + (SPEC + `\k. ?q:num->A. + 1 < k /\ + (!r. r <= k ==> v(q r)) /\ + q 0 = q k /\ + w(q 0) /\ + (!r. 0 < r /\ r < k ==> ~(q r = q 0)) /\ + (!r. r < k ==> e (q r) (q(SUC r)))` + num_WOP)))) THEN + ANTS_TAC THENL + [MATCH_MP_TAC PATH_FIRST_RETURN_CYCLE THEN + REMOVE_THEN "exists" MP_TAC THEN REWRITE_TAC[]; + INTRO_TAC + "@k. (@q. length bound closed base first path) minimal"] THEN + MAP_EVERY EXISTS_TAC [`k:num`; `q:num->A`] THEN + ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC [`r:num`; `s:num`] THEN + INTRO_TAC "rs sk" THEN + DISCH_THEN(LABEL_TAC "repeat") THEN + SUBGOAL_THEN `0 < r` (LABEL_TAC "rpos") THENL + [ASM_CASES_TAC `(r:num) = 0` THENL + [FIRST_X_ASSUM SUBST_ALL_TAC THEN ASM_MESON_TAC[]; + ASM_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN + `r < k - (s - r) /\ + 1 < k - (s - r) /\ + k - (s - r) < k` + (DESTRUCT_TAC "after newlength shorter") THENL + [MAP_EVERY (fun s -> USE_THEN s MP_TAC) ["rs"; "sk"; "rpos"] THEN + ARITH_TAC; + ALL_TAC] THEN + USE_THEN "minimal" + (MP_TAC o SPEC `(k:num) - (s - r)`) THEN + USE_THEN "shorter" (fun th -> REWRITE_TAC[th]) THEN + EXISTS_TAC + `\i. if i <= r then (q:num->A) i else q(i + (s - r))` THEN + REPEAT CONJ_TAC THENL + [USE_THEN "newlength" ACCEPT_TAC; + X_GEN_TAC `i:num` THEN DISCH_TAC THEN BETA_TAC THEN + COND_CASES_TAC THENL + [USE_THEN "bound" MATCH_MP_TAC THEN ASM_ARITH_TAC; + USE_THEN "bound" MATCH_MP_TAC THEN ASM_ARITH_TAC]; + BETA_TAC THEN REWRITE_TAC[LE_0] THEN + ASM_REWRITE_TAC[GSYM NOT_LT] THEN + USE_THEN "rs" (fun rth -> + USE_THEN "sk" (fun sth -> + let eth = MATCH_MP + (SPECL [`k:num`; `(s:num) - r`] SUB_ADD) + (MATCH_MP + (SPECL [`r:num`; `s:num`; `k:num`] + (ARITH_RULE + `!r s k:num. + r < s /\ s < k ==> s - r <= k`)) + (CONJ rth sth)) in + REWRITE_TAC[eth])) THEN + USE_THEN "closed" ACCEPT_TAC; + BETA_TAC THEN REWRITE_TAC[LE_0] THEN + USE_THEN "base" ACCEPT_TAC; + X_GEN_TAC `i:num` THEN + INTRO_TAC "ipos ilt" THEN + BETA_TAC THEN REWRITE_TAC[LE_0] THEN + COND_CASES_TAC THENL + [USE_THEN "first" (MATCH_MP_TAC o SPEC `i:num`) THEN + ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; + USE_THEN "first" + (MATCH_MP_TAC o SPEC `(i:num) + (s - r)`) THEN + ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC]; + X_GEN_TAC `i:num` THEN DISCH_TAC THEN BETA_TAC THEN + ASM_CASES_TAC `(i:num) < r` THENL + [SUBGOAL_THEN + `(i:num) <= r /\ SUC i <= r` + STRIP_ASSUME_TAC THENL + [ASM_ARITH_TAC; + ASM_REWRITE_TAC[] THEN + USE_THEN "path" MATCH_MP_TAC THEN ASM_ARITH_TAC]; + ASM_CASES_TAC `(i:num) = r` THENL + [FIRST_X_ASSUM SUBST_ALL_TAC THEN + ASM_REWRITE_TAC[LE_REFL; + ARITH_RULE `~(SUC r <= r)`] THEN + SUBGOAL_THEN + `SUC r + (s - r) = SUC s` + SUBST1_TAC THENL + [ASM_ARITH_TAC; + USE_THEN "path" (MATCH_MP_TAC o SPEC `s:num`) THEN + ASM_REWRITE_TAC[]]; + SUBGOAL_THEN + `~((i:num) <= r) /\ ~(SUC i <= r)` + STRIP_ASSUME_TAC THENL + [ASM_ARITH_TAC; + ASM_REWRITE_TAC[ADD_CLAUSES] THEN + USE_THEN "path" MATCH_MP_TAC THEN + ASM_ARITH_TAC]]]]);; + +let PATH_SHORTEST_SIMPLE_CYCLE = prove + (`!v e w. + (?k (q:num->A). + 1 < k /\ + (!r. r <= k ==> v(q r)) /\ + q 0 = q k /\ + w(q 0) /\ + ~(q(k - 1) = q 0) /\ + (!r. r < k ==> e (q r) (q(SUC r)))) + ==> ?k q. + 1 < k /\ + (!r. r <= k ==> v(q r)) /\ + q 0 = q k /\ + w(q 0) /\ + (!r s. r < s /\ s < k ==> ~(q r = q s)) /\ + (!r s. r + 1 < s /\ s < k ==> ~e (q r) (q s)) /\ + (!r. 0 < r /\ r + 1 < k ==> ~e (q r) (q 0)) /\ + (!r. r < k ==> e (q r) (q(SUC r)))`, + REPEAT GEN_TAC THEN DISCH_THEN(LABEL_TAC "exists") THEN + MP_TAC(BETA_RULE(fst(EQ_IMP_RULE + (SPEC + `\k. ?q:num->A. + 1 < k /\ + (!r. r <= k ==> v(q r)) /\ + q 0 = q k /\ + w(q 0) /\ + (!r s. r < s /\ s < k ==> ~(q r = q s)) /\ + (!r. r < k ==> e (q r) (q(SUC r)))` + num_WOP)))) THEN + ANTS_TAC THENL + [MATCH_MP_TAC PATH_SIMPLE_CYCLE THEN + REMOVE_THEN "exists" MP_TAC THEN REWRITE_TAC[]; + INTRO_TAC + "@k. (@q. length bound closed base distinct path) minimal"] THEN + MAP_EVERY EXISTS_TAC [`k:num`; `q:num->A`] THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MAP_EVERY X_GEN_TAC [`r:num`; `s:num`] THEN STRIP_TAC THEN + DISCH_THEN(LABEL_TAC "chord") THEN + ABBREV_TAC `d = (s:num) - SUC r` THEN + ABBREV_TAC `l = (k:num) - d` THEN + SUBGOAL_THEN + `0 < (d:num) /\ d <= k /\ 1 < l /\ l < k /\ l + d = k` + STRIP_ASSUME_TAC THENL + [REPEAT CONJ_TAC THEN ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `SUC r + d = s` (LABEL_TAC "jump") THENL + [ASM_ARITH_TAC; + ALL_TAC] THEN + ABBREV_TAC + `h = \i:num. if i <= r then (q:num->A) i else q(i + d)` THEN + SUBGOAL_THEN + `(!i. i <= l ==> v((h:num->A) i)) /\ + (!i. i < l + ==> (if i <= r then i else i + d) < k) /\ + (!i j. i < j /\ j < l + ==> (if i <= r then i else i + d) < + (if j <= r then j else j + d))` + (DESTRUCT_TAC "hbound indexbound indexorder") THENL + [REPEAT CONJ_TAC THENL + [X_GEN_TAC `i:num` THEN DISCH_TAC THEN EXPAND_TAC "h" THEN + BETA_TAC THEN COND_CASES_TAC THEN + USE_THEN "bound" MATCH_MP_TAC THEN ASM_ARITH_TAC; + X_GEN_TAC `i:num` THEN DISCH_TAC THEN + COND_CASES_TAC THEN ASM_ARITH_TAC; + MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN STRIP_TAC THEN + ASM_CASES_TAC `(i:num) <= r` THEN + ASM_CASES_TAC `(j:num) <= r` THEN + ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC]; + ALL_TAC] THEN + USE_THEN "minimal" (fun mth -> + MP_TAC(MATCH_MP (SPEC `l:num` mth) + (ASSUME `(l:num) < k`))) THEN + REWRITE_TAC[TAUT `(~p ==> F) <=> p`] THEN + EXISTS_TAC `h:num->A` THEN + REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + USE_THEN "hbound" ACCEPT_TAC; + EXPAND_TAC "h" THEN BETA_TAC THEN + SUBGOAL_THEN `0 <= (r:num) /\ ~(l <= r)` + STRIP_ASSUME_TAC THENL + [ASM_ARITH_TAC; + ASM_REWRITE_TAC[ADD_CLAUSES] THEN + USE_THEN "closed" ACCEPT_TAC]; + EXPAND_TAC "h" THEN BETA_TAC THEN + REWRITE_TAC[LE_0] THEN USE_THEN "base" ACCEPT_TAC; + MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN STRIP_TAC THEN + EXPAND_TAC "h" THEN BETA_TAC THEN + REWRITE_TAC[GSYM COND_RAND] THEN + USE_THEN "distinct" MATCH_MP_TAC THEN CONJ_TAC THENL + [USE_THEN "indexorder" + (MATCH_MP_TAC o SPECL [`i:num`; `j:num`]) THEN + ASM_REWRITE_TAC[]; + USE_THEN "indexbound" (MATCH_MP_TAC o SPEC `j:num`) THEN + ASM_REWRITE_TAC[]]; + X_GEN_TAC `i:num` THEN DISCH_TAC THEN EXPAND_TAC "h" THEN + BETA_TAC THEN ASM_CASES_TAC `(i:num) < r` THENL + [SUBGOAL_THEN `(i:num) <= r /\ SUC i <= r` + STRIP_ASSUME_TAC THENL + [ASM_ARITH_TAC; + ASM_REWRITE_TAC[] THEN + USE_THEN "path" MATCH_MP_TAC THEN ASM_ARITH_TAC]; + ASM_CASES_TAC `(i:num) = r` THENL + [FIRST_X_ASSUM SUBST_ALL_TAC THEN + ASM_REWRITE_TAC[LE_REFL; + ARITH_RULE `~(SUC r <= r)`] THEN + USE_THEN "jump" (fun th -> REWRITE_TAC[th]) THEN + USE_THEN "chord" ACCEPT_TAC; + SUBGOAL_THEN + `~((i:num) <= r) /\ ~(SUC i <= r)` + STRIP_ASSUME_TAC THENL + [ASM_ARITH_TAC; + ASM_REWRITE_TAC[ADD_CLAUSES] THEN + USE_THEN "path" MATCH_MP_TAC THEN + USE_THEN "indexbound" (fun ith -> + ACCEPT_TAC(REWRITE_RULE[ASSUME `~((i:num) <= r)`] + (MATCH_MP (SPEC `i:num` ith) + (ASSUME `(i:num) < l`))))]]]]; + X_GEN_TAC `r:num` THEN STRIP_TAC THEN + DISCH_THEN(LABEL_TAC "return") THEN + USE_THEN "minimal" (fun mth -> + MP_TAC(MATCH_MP (SPEC `SUC r` mth) + (MATCH_MP + (ARITH_RULE + `0 < r /\ r + 1 < k ==> SUC r < k`) + (CONJ (ASSUME `0 < (r:num)`) + (ASSUME `(r:num) + 1 < k`))))) THEN + REWRITE_TAC[TAUT `(~p ==> F) <=> p`] THEN + EXISTS_TAC + `\i. if i < SUC r then (q:num->A) i else q 0` THEN + REPEAT CONJ_TAC THENL + [ASM_ARITH_TAC; + X_GEN_TAC `i:num` THEN DISCH_TAC THEN BETA_TAC THEN + COND_CASES_TAC THEN USE_THEN "bound" MATCH_MP_TAC THEN + ASM_ARITH_TAC; + BETA_TAC THEN + REWRITE_TAC[ARITH_RULE `0 < SUC r`; + ARITH_RULE `~(SUC r < SUC r)`]; + BETA_TAC THEN REWRITE_TAC[ARITH_RULE `0 < SUC r`] THEN + USE_THEN "base" ACCEPT_TAC; + MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN STRIP_TAC THEN + SUBGOAL_THEN `(i:num) < SUC r` ASSUME_TAC THENL + [ASM_ARITH_TAC; + BETA_TAC THEN ASM_REWRITE_TAC[]] THEN + USE_THEN "distinct" MATCH_MP_TAC THEN ASM_ARITH_TAC; + X_GEN_TAC `i:num` THEN DISCH_TAC THEN BETA_TAC THEN + ASM_CASES_TAC `(i:num) < r` THENL + [SUBGOAL_THEN + `(i:num) < SUC r /\ SUC i < SUC r` + STRIP_ASSUME_TAC THENL + [ASM_ARITH_TAC; + ASM_REWRITE_TAC[] THEN + USE_THEN "path" MATCH_MP_TAC THEN ASM_ARITH_TAC]; + SUBGOAL_THEN `(i:num) = r` SUBST_ALL_TAC THENL + [ASM_ARITH_TAC; + ASM_REWRITE_TAC[ARITH_RULE `r < SUC r`; + ARITH_RULE `~(SUC r < SUC r)`] THEN + USE_THEN "return" ACCEPT_TAC]]]]);; + +let PATH_SIMPLE_CYCLE_WAIT = prove + (`!v e k (q:num->A). + 1 < k /\ + (!i. i <= k ==> v(q i)) /\ + q 0 = q k /\ + e (q 0) (q 0) /\ + (!i j. i < j /\ j < k ==> ~(q i = q j)) /\ + (!i. i < k ==> e (q i) (q(SUC i))) + ==> ?r. + (!i. i <= k + 1 ==> v(r i)) /\ + r 0 = r(k + 1) /\ + (!i. 0 < i /\ i < k + 1 ==> ~(r i = r 0)) /\ + (!i. i < k + 1 ==> e (r i) (r(SUC i)))`, + REPEAT GEN_TAC THEN + INTRO_TAC "length bound closed base distinct path" THEN + SUBGOAL_THEN `~((q:num->A) 0 = q 1)` + (LABEL_TAC "different") THENL + [USE_THEN "distinct" (MATCH_MP_TAC o SPECL [`0`; `1`]) THEN + ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `!j. 1 < j /\ j <= k ==> ~((q:num->A) j = q 1)` + (LABEL_TAC "taildistinct") THENL + [X_GEN_TAC `j:num` THEN STRIP_TAC THEN + ASM_CASES_TAC `(j:num) = k` THENL + [FIRST_X_ASSUM SUBST_ALL_TAC THEN + USE_THEN "closed" (fun th -> REWRITE_TAC[GSYM th]) THEN + USE_THEN "different" ACCEPT_TAC; + DISCH_THEN(LABEL_TAC "same") THEN + ASM_MESON_TAC[LT_LE]]; + ALL_TAC] THEN + EXISTS_TAC + `\i. if i < k then (q:num->A)(SUC i) + else if i = k then q 0 else q 1` THEN + REPEAT CONJ_TAC THENL + [X_GEN_TAC `i:num` THEN DISCH_TAC THEN BETA_TAC THEN + ASM_CASES_TAC `(i:num) < k` THEN ASM_REWRITE_TAC[] THENL + [USE_THEN "bound" MATCH_MP_TAC THEN ASM_ARITH_TAC; + COND_CASES_TAC THEN + USE_THEN "bound" MATCH_MP_TAC THEN ASM_ARITH_TAC]; + BETA_TAC THEN + SUBGOAL_THEN `0 < (k:num)` ASSUME_TAC THENL + [ASM_ARITH_TAC; + ASM_REWRITE_TAC[ARITH_RULE `~(k + 1 < k)`; + ARITH_RULE `~(k + 1 = k)`] THEN + REWRITE_TAC[GSYM ONE]]; + X_GEN_TAC `i:num` THEN + INTRO_TAC "ipos ilt" THEN + BETA_TAC THEN + SUBGOAL_THEN `0 < (k:num)` ASSUME_TAC THENL + [ASM_ARITH_TAC; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `(i:num) < k` THEN ASM_REWRITE_TAC[] THENL + [USE_THEN "taildistinct" (MP_TAC o SPEC `SUC i`) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; REWRITE_TAC[ONE]]; + SUBGOAL_THEN `(i:num) = k` SUBST_ALL_TAC THENL + [ASM_ARITH_TAC; + ASM_REWRITE_TAC[] THEN + USE_THEN "taildistinct" (MP_TAC o SPEC `k:num`) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; REWRITE_TAC[ONE]]]]; + X_GEN_TAC `i:num` THEN DISCH_TAC THEN BETA_TAC THEN + ASM_CASES_TAC `SUC(i:num) < k` THENL + [SUBGOAL_THEN `(i:num) < k` ASSUME_TAC THENL + [ASM_ARITH_TAC; + ASM_REWRITE_TAC[] THEN + USE_THEN "path" MATCH_MP_TAC THEN ASM_ARITH_TAC]; + ASM_CASES_TAC `(i:num) < k` THENL + [SUBGOAL_THEN `SUC(i:num) = k` ASSUME_TAC THENL + [ASM_ARITH_TAC; + ASM_REWRITE_TAC[LT_REFL] THEN + USE_THEN "closed" (fun th -> REWRITE_TAC[GSYM th]) THEN + USE_THEN "base" ACCEPT_TAC]; + SUBGOAL_THEN `(i:num) = k` SUBST_ALL_TAC THENL + [ASM_ARITH_TAC; + ASM_REWRITE_TAC[LT_REFL; + ARITH_RULE `~(SUC k < k)`; + ARITH_RULE `~(SUC k = k)`] THEN + USE_THEN "path" (MP_TAC o SPEC `0`) THEN + ANTS_TAC THENL + [USE_THEN "length" MP_TAC THEN ARITH_TAC; + USE_THEN "closed" (fun th -> + REWRITE_TAC[th; GSYM ONE])]]]]]);; + +let PATH_SIMPLE_CYCLE_WAITS = prove + (`!v e k (q:num->A) t. + 1 < k /\ + 0 < t /\ + (!i. i <= k ==> v(q i)) /\ + q 0 = q k /\ + e (q 0) (q 0) /\ + (!i j. i < j /\ j < k ==> ~(q i = q j)) /\ + (!i. i < k ==> e (q i) (q(SUC i))) + ==> ?r. + (!i. i <= k + t ==> v(r i)) /\ + r 0 = r(k + t) /\ + (!i. 0 < i /\ i < k + t ==> ~(r i = r 0)) /\ + (!i. i < k + t ==> e (r i) (r(SUC i)))`, + REPEAT GEN_TAC THEN + INTRO_TAC "length wait bound closed base distinct path" THEN + SUBGOAL_THEN `~((q:num->A) 0 = q 1)` + (LABEL_TAC "different") THENL + [USE_THEN "distinct" (MATCH_MP_TAC o SPECL [`0`; `1`]) THEN + ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `!j. 1 < j /\ j <= k ==> ~((q:num->A) j = q 1)` + (LABEL_TAC "taildistinct") THENL + [X_GEN_TAC `j:num` THEN STRIP_TAC THEN + ASM_CASES_TAC `(j:num) = k` THENL + [FIRST_X_ASSUM SUBST_ALL_TAC THEN + USE_THEN "closed" (fun th -> REWRITE_TAC[GSYM th]) THEN + USE_THEN "different" ACCEPT_TAC; + DISCH_THEN(LABEL_TAC "same") THEN + ASM_MESON_TAC[LT_LE]]; + ALL_TAC] THEN + EXISTS_TAC + `\i. if i < k then (q:num->A)(SUC i) + else if i < k + t then q 0 else q 1` THEN + REPEAT CONJ_TAC THENL + [X_GEN_TAC `i:num` THEN DISCH_TAC THEN BETA_TAC THEN + ASM_CASES_TAC `(i:num) < k` THEN ASM_REWRITE_TAC[] THENL + [USE_THEN "bound" MATCH_MP_TAC THEN ASM_ARITH_TAC; + COND_CASES_TAC THEN + USE_THEN "bound" MATCH_MP_TAC THEN ASM_ARITH_TAC]; + BETA_TAC THEN + SUBGOAL_THEN `0 < (k:num)` ASSUME_TAC THENL + [ASM_ARITH_TAC; + ASM_REWRITE_TAC[LT_REFL; GSYM ONE] THEN ASM_ARITH_TAC]; + X_GEN_TAC `i:num` THEN + INTRO_TAC "ipos ilt" THEN + BETA_TAC THEN + SUBGOAL_THEN `0 < (k:num)` ASSUME_TAC THENL + [ASM_ARITH_TAC; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `(i:num) < k` THEN ASM_REWRITE_TAC[] THENL + [USE_THEN "taildistinct" (MP_TAC o SPEC `SUC i`) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; REWRITE_TAC[ONE]]; + USE_THEN "closed" (fun th -> + REWRITE_TAC[GSYM th; ARITH_RULE `SUC 0 = 1`]) THEN + USE_THEN "different" ACCEPT_TAC]; + X_GEN_TAC `i:num` THEN DISCH_TAC THEN BETA_TAC THEN + ASM_CASES_TAC `SUC(i:num) < k` THENL + [SUBGOAL_THEN `(i:num) < k` ASSUME_TAC THENL + [ASM_ARITH_TAC; + ASM_REWRITE_TAC[] THEN + USE_THEN "path" MATCH_MP_TAC THEN ASM_ARITH_TAC]; + ASM_CASES_TAC `(i:num) < k` THENL + [SUBGOAL_THEN `SUC(i:num) = k` ASSUME_TAC THENL + [ASM_ARITH_TAC; + SUBGOAL_THEN `(k:num) < k + t` ASSUME_TAC THENL + [ASM_ARITH_TAC; + ASM_REWRITE_TAC[LT_REFL] THEN + USE_THEN "closed" (fun th -> REWRITE_TAC[GSYM th]) THEN + USE_THEN "base" ACCEPT_TAC]]; + SUBGOAL_THEN + `i < k + t /\ ~(i < k) /\ ~(SUC i < k)` + STRIP_ASSUME_TAC THENL + [ASM_ARITH_TAC; + ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `SUC(i:num) < k + t` THEN + ASM_REWRITE_TAC[] THENL + [USE_THEN "closed" (fun th -> REWRITE_TAC[GSYM th]) THEN + USE_THEN "base" ACCEPT_TAC; + USE_THEN "closed" (fun th -> + REWRITE_TAC[GSYM th; ONE]) THEN + USE_THEN "path" (MATCH_MP_TAC o SPEC `0`) THEN + ASM_ARITH_TAC]]]]]);; + +let FINITE_INDEX_ENUMERATION = prove + (`!q (k:num). + (!i. i < k ==> q i < k) /\ + (!i j. i < j /\ j < k ==> ~(q i = q j)) + ==> !x. x < k ==> ?i. i < k /\ q i = x`, + REPEAT GEN_TAC THEN + INTRO_TAC "bound distinct" THEN + MP_TAC(ISPECL [`{i:num | i < k}`; `q:num->num`] + SURJECTIVE_IFF_INJECTIVE) THEN + ANTS_TAC THENL + [REWRITE_TAC[FINITE_NUMSEG_LT; SUBSET; + FORALL_IN_IMAGE; IN_ELIM_THM] THEN + ASM_REWRITE_TAC[]; + DISCH_THEN(fun th -> + ONCE_REWRITE_TAC[REWRITE_RULE[IN_ELIM_THM] th])] THEN + MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN STRIP_TAC THEN + ASM_MESON_TAC[LT_CASES]);; + +(* ------------------------------------------------------------------------- *) +(* Chordless zigzag paths in the adjacent-interval graph. *) +(* ------------------------------------------------------------------------- *) + +let FINITE_PATH_NEXT_COVER = prove + (`!p q k r x. + (!i. i < k ==> q i < k) /\ + (!i j. i < j /\ j < k ==> ~(q i = q j)) /\ + (!i j. i + 1 < j /\ j < k + ==> ~adjacent_interval_cover p (q i) (q j)) /\ + r + 1 < k /\ + x < k /\ + adjacent_interval_cover p (q r) x /\ + (!s. s <= r ==> ~(q s = x)) + ==> x = q(r + 1)`, + REPEAT GEN_TAC THEN + INTRO_TAC "bound distinct chordless next xbound cover unseen" THEN + MP_TAC(ISPECL [`q:num->num`; `k:num`] + FINITE_INDEX_ENUMERATION) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[]; + DISCH_THEN(MP_TAC o SPEC `x:num`) THEN + ASM_REWRITE_TAC[] THEN + INTRO_TAC "@s. sbound same"] THEN + ASM_MESON_TAC + [NOT_LE; + ARITH_RULE `!r s:num. r < s ==> s = r + 1 \/ r + 1 < s`]);; + +let FINITE_PATH_NEXT_OUTSIDE = prove + (`!(q:num->num) k r a b. + (!i j. i < j /\ j < k ==> ~(q i = q j)) /\ + r + 1 < k /\ + (!s. s <= r ==> a <= q s /\ q s <= b) /\ + (!x. a <= x /\ x <= b ==> ?s. s <= r /\ q s = x) + ==> q(r + 1) < a \/ b < q(r + 1)`, + REPEAT GEN_TAC THEN + INTRO_TAC "distinct next range full" THEN + ASM_CASES_TAC `(q:num->num) (r + 1) < a` THENL + [ASM_REWRITE_TAC[]; + ASM_CASES_TAC `b < (q:num->num) (r + 1)` THENL + [ASM_REWRITE_TAC[]; + MP_TAC(SPEC `(q:num->num) (r + 1)` + (ASSUME + `!x. a <= x /\ x <= b + ==> ?s. s <= r /\ (q:num->num) s = x`)) THEN + ANTS_TAC THENL + [ASM_ARITH_TAC; + INTRO_TAC "@s. sle same"] THEN + ASM_MESON_TAC + [ARITH_RULE `!s r:num. s <= r ==> s < r + 1`]]]);; + +let FINITE_PATH_ZIGZAG_DOWN = prove + (`!p q k r a lo hi. + (!i. i < k ==> q i < k) /\ + (!i j. i < j /\ j < k ==> ~(q i = q j)) /\ + (!i j. i + 1 < j /\ j < k + ==> ~adjacent_interval_cover p (q i) (q j)) /\ + r + 1 < k /\ + ~adjacent_interval_cover p (q r) a /\ + adjacent_interval_cover p (q r) (q(r + 1)) /\ + q r = hi /\ + p hi = lo /\ + lo <= a /\ a <= hi /\ + (!s. s <= r ==> lo <= q s /\ q s <= hi) /\ + (!x. lo <= x /\ x <= hi ==> ?s. s <= r /\ q s = x) + ==> 0 < lo /\ + q(r + 1) = lo - 1 /\ + p(hi + 1) = lo - 1 /\ + (!s. s <= r + 1 ==> lo - 1 <= q s /\ q s <= hi) /\ + (!x. lo - 1 <= x /\ x <= hi + ==> ?s. s <= r + 1 /\ q s = x)`, + REPEAT GEN_TAC THEN + INTRO_TAC + ("bound distinct chordless next nobase cover last endpoint " ^ + "alower aupper range full") THEN + SUBGOAL_THEN `(hi:num) < k` (LABEL_TAC "hibound") THENL + [USE_THEN "bound" (MP_TAC o SPEC `r:num`) THEN + USE_THEN "last" (fun th -> REWRITE_TAC[th]) THEN + USE_THEN "next" MP_TAC THEN ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `(q:num->num) (r + 1) < lo \/ hi < q(r + 1)` + (LABEL_TAC "outside") THENL + [MATCH_MP_TAC(ISPECL + [`q:num->num`; `k:num`; `r:num`; `lo:num`; `hi:num`] + FINITE_PATH_NEXT_OUTSIDE) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `(p:num->num) (hi + 1) <= a` + (LABEL_TAC "otherbelow") THENL + [MP_TAC(ASSUME + `~adjacent_interval_cover (p:num->num) + ((q:num->num) (r:num)) a`) THEN + REWRITE_TAC[adjacent_interval_cover] THEN + ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `(q:num->num) (r + 1) < lo` + (LABEL_TAC "nextbelow") THENL + [USE_THEN "outside" DISJ_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ASSUME + `adjacent_interval_cover (p:num->num) + ((q:num->num) (r:num)) (q(r + 1))`) THEN + REWRITE_TAC[adjacent_interval_cover] THEN + ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `(p:num->num) (hi + 1) <= q(r + 1) /\ + q(r + 1) + 1 <= lo` + (LABEL_TAC "orientation") THENL + [MP_TAC(ASSUME + `adjacent_interval_cover (p:num->num) + ((q:num->num) (r:num)) (q(r + 1))`) THEN + REWRITE_TAC[adjacent_interval_cover] THEN + ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `0 < (lo:num)` (LABEL_TAC "lopos") THENL + [ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `adjacent_interval_cover (p:num->num) + ((q:num->num) (r:num)) (lo - 1)` + (LABEL_TAC "coverspredecessor") THENL + [REWRITE_TAC[adjacent_interval_cover] THEN + ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `(lo:num) - 1 = q(r + 1)` + (LABEL_TAC "nextvalue") THENL + [MATCH_MP_TAC(ISPECL + [`p:num->num`; `q:num->num`; `k:num`; `r:num`; `lo - 1`] + FINITE_PATH_NEXT_COVER) THEN + ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [ASM_ARITH_TAC; + X_GEN_TAC `s:num` THEN DISCH_TAC THEN + USE_THEN "range" (MP_TAC o SPEC `s:num`) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[]; + DISCH_THEN STRIP_ASSUME_TAC] THEN + ASM_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN + `adjacent_interval_cover (p:num->num) + ((q:num->num) (r:num)) (p(hi + 1))` + (LABEL_TAC "coversendpoint") THENL + [REWRITE_TAC[adjacent_interval_cover] THEN + ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `(p:num->num) (hi + 1) = q(r + 1)` + (LABEL_TAC "endpointvalue") THENL + [MATCH_MP_TAC(ISPECL + [`p:num->num`; `q:num->num`; `k:num`; `r:num`; + `(p:num->num) (hi + 1)`] + FINITE_PATH_NEXT_COVER) THEN + ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [ASM_ARITH_TAC; + X_GEN_TAC `s:num` THEN DISCH_TAC THEN + USE_THEN "range" (MP_TAC o SPEC `s:num`) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[]; + DISCH_THEN STRIP_ASSUME_TAC] THEN + ASM_ARITH_TAC]; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [X_GEN_TAC `s:num` THEN DISCH_TAC THEN + ASM_CASES_TAC `(s:num) <= r` THENL + [USE_THEN "range" (MP_TAC o SPEC `s:num`) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[]; + DISCH_THEN STRIP_ASSUME_TAC] THEN + ASM_ARITH_TAC; + SUBGOAL_THEN `(s:num) = r + 1` SUBST_ALL_TAC THENL + [ASM_ARITH_TAC; + ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC]]; + X_GEN_TAC `x:num` THEN STRIP_TAC THEN + ASM_CASES_TAC `(x:num) = lo - 1` THENL + [EXISTS_TAC `r + 1` THEN ASM_REWRITE_TAC[LE_REFL]; + USE_THEN "full" (MP_TAC o SPEC `x:num`) THEN + ANTS_TAC THENL + [ASM_ARITH_TAC; + DISCH_THEN(X_CHOOSE_THEN `s:num` STRIP_ASSUME_TAC)] THEN + EXISTS_TAC `s:num` THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC]]);; + +let FINITE_PATH_ZIGZAG_UP = prove + (`!p q k r a lo hi. + (!i. i <= k ==> p i <= k) /\ + (!i. i < k ==> q i < k) /\ + (!i j. i < j /\ j < k ==> ~(q i = q j)) /\ + (!i j. i + 1 < j /\ j < k + ==> ~adjacent_interval_cover p (q i) (q j)) /\ + r + 1 < k /\ + ~adjacent_interval_cover p (q r) a /\ + adjacent_interval_cover p (q r) (q(r + 1)) /\ + q r = lo /\ + p(lo + 1) = hi + 1 /\ + lo <= a /\ a <= hi /\ + (!s. s <= r ==> lo <= q s /\ q s <= hi) /\ + (!x. lo <= x /\ x <= hi ==> ?s. s <= r /\ q s = x) + ==> q(r + 1) = hi + 1 /\ + p lo = hi + 2 /\ + (!s. s <= r + 1 ==> lo <= q s /\ q s <= hi + 1) /\ + (!x. lo <= x /\ x <= hi + 1 + ==> ?s. s <= r + 1 /\ q s = x)`, + REPEAT GEN_TAC THEN + INTRO_TAC + ("pbound bound distinct chordless next nobase cover last " ^ + "endpoint alower aupper range full") THEN + SUBGOAL_THEN `(lo:num) < k` (LABEL_TAC "lobound") THENL + [USE_THEN "bound" (MP_TAC o SPEC `r:num`) THEN + USE_THEN "last" (fun th -> REWRITE_TAC[th]) THEN + USE_THEN "next" MP_TAC THEN ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `(q:num->num) (r + 1) < k` + (LABEL_TAC "nextbound") THENL + [USE_THEN "bound" (MP_TAC o SPEC `r + 1`) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[]; + SIMP_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN + `(q:num->num) (r + 1) < lo \/ hi < q(r + 1)` + (LABEL_TAC "outside") THENL + [MATCH_MP_TAC(ISPECL + [`q:num->num`; `k:num`; `r:num`; `lo:num`; `hi:num`] + FINITE_PATH_NEXT_OUTSIDE) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `a < (p:num->num) lo` + (LABEL_TAC "otherabove") THENL + [MP_TAC(ASSUME + `~adjacent_interval_cover (p:num->num) + ((q:num->num) (r:num)) a`) THEN + REWRITE_TAC[adjacent_interval_cover] THEN + ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `hi < (q:num->num) (r + 1)` + (LABEL_TAC "nextabove") THENL + [USE_THEN "outside" DISJ_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ASSUME + `adjacent_interval_cover (p:num->num) + ((q:num->num) (r:num)) (q(r + 1))`) THEN + REWRITE_TAC[adjacent_interval_cover] THEN + ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `hi + 1 <= (q:num->num) (r + 1) /\ + q(r + 1) + 1 <= (p:num->num) lo` + (LABEL_TAC "orientation") THENL + [MP_TAC(ASSUME + `adjacent_interval_cover (p:num->num) + ((q:num->num) (r:num)) (q(r + 1))`) THEN + REWRITE_TAC[adjacent_interval_cover] THEN + ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `adjacent_interval_cover (p:num->num) + ((q:num->num) (r:num)) (hi + 1)` + (LABEL_TAC "coverssuccessor") THENL + [REWRITE_TAC[adjacent_interval_cover] THEN + ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `(hi:num) + 1 = q(r + 1)` + (LABEL_TAC "nextvalue") THENL + [MATCH_MP_TAC(ISPECL + [`p:num->num`; `q:num->num`; `k:num`; `r:num`; `hi + 1`] + FINITE_PATH_NEXT_COVER) THEN + ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [ASM_ARITH_TAC; + X_GEN_TAC `s:num` THEN DISCH_TAC THEN + USE_THEN "range" (MP_TAC o SPEC `s:num`) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[]; + DISCH_THEN STRIP_ASSUME_TAC] THEN + ASM_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN `(p:num->num) lo <= k` + (LABEL_TAC "otherbound") THENL + [USE_THEN "pbound" (MP_TAC o SPEC `lo:num`) THEN + ANTS_TAC THENL + [ASM_ARITH_TAC; + SIMP_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN `(p:num->num) lo = hi + 2` + (LABEL_TAC "endpointvalue") THENL + [ASM_CASES_TAC `(p:num->num) lo = hi + 2` THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `hi + 2 < (p:num->num) lo` + (LABEL_TAC "gap") THENL + [ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `adjacent_interval_cover (p:num->num) + ((q:num->num) (r:num)) (hi + 2)` + (LABEL_TAC "coversgap") THENL + [REWRITE_TAC[adjacent_interval_cover] THEN + ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `(hi:num) + 2 = q(r + 1)` + (LABEL_TAC "gapvalue") THENL + [MATCH_MP_TAC(ISPECL + [`p:num->num`; `q:num->num`; `k:num`; `r:num`; `hi + 2`] + FINITE_PATH_NEXT_COVER) THEN + ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [ASM_ARITH_TAC; + X_GEN_TAC `s:num` THEN DISCH_TAC THEN + USE_THEN "range" (MP_TAC o SPEC `s:num`) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[]; + DISCH_THEN STRIP_ASSUME_TAC] THEN + ASM_ARITH_TAC]; + ASM_ARITH_TAC]; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [X_GEN_TAC `s:num` THEN DISCH_TAC THEN + ASM_CASES_TAC `(s:num) <= r` THENL + [USE_THEN "range" (MP_TAC o SPEC `s:num`) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[]; + DISCH_THEN STRIP_ASSUME_TAC] THEN + ASM_ARITH_TAC; + SUBGOAL_THEN `(s:num) = r + 1` SUBST_ALL_TAC THENL + [ASM_ARITH_TAC; + ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC]]; + X_GEN_TAC `x:num` THEN STRIP_TAC THEN + ASM_CASES_TAC `(x:num) = hi + 1` THENL + [EXISTS_TAC `r + 1` THEN ASM_REWRITE_TAC[LE_REFL]; + USE_THEN "full" (MP_TAC o SPEC `x:num`) THEN + ANTS_TAC THENL + [ASM_ARITH_TAC; + DISCH_THEN(X_CHOOSE_THEN `s:num` STRIP_ASSUME_TAC)] THEN + EXISTS_TAC `s:num` THEN ASM_REWRITE_TAC[] THEN + ASM_ARITH_TAC]]);; + +let FINITE_PATH_ZIGZAG_LEFT_START = prove + (`!p q k a. + (!i. i <= k ==> p i <= k) /\ + (!i. i < k ==> q i < k) /\ + (!i j. i < j /\ j < k ==> ~(q i = q j)) /\ + (!i j. i + 1 < j /\ j < k + ==> ~adjacent_interval_cover p (q i) (q j)) /\ + 1 < k /\ + q 0 = a /\ + p(a + 1) <= a /\ + a + 1 <= p a /\ + q 1 < a /\ + adjacent_interval_cover p (q 0) (q 1) + ==> 0 < a /\ + q 1 = a - 1 /\ + p(a + 1) = a - 1 /\ + p a = a + 1 /\ + (!s. s <= 1 ==> a - 1 <= q s /\ q s <= a) /\ + (!x. a - 1 <= x /\ x <= a + ==> ?s. s <= 1 /\ q s = x)`, + REPEAT GEN_TAC THEN + INTRO_TAC + ("pbound bound distinct chordless nontrivial base lower " ^ + "upper left cover") THEN + SUBGOAL_THEN `(a:num) < k` (LABEL_TAC "abound") THENL + [USE_THEN "bound" (MP_TAC o SPEC `0`) THEN + USE_THEN "base" (fun th -> REWRITE_TAC[th]) THEN + USE_THEN "nontrivial" MP_TAC THEN ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `(q:num->num) 1 < k` + (LABEL_TAC "q1bound") THENL + [USE_THEN "bound" (MP_TAC o SPEC `1`) THEN + USE_THEN "nontrivial" MP_TAC THEN ARITH_TAC; + ALL_TAC] THEN + ASSUME_TAC(MATCH_MP + (ISPECL + [`(p:num->num) a`; `(p:num->num) (a + 1)`; + `(q:num->num) 1`; `a:num`] + (ARITH_RULE + `!pa pa1 q a:num. + q < a /\ a + 1 <= pa + ==> ~(pa <= q /\ q + 1 <= pa1)`)) + (CONJ (ASSUME `(q:num->num) 1 < a`) + (ASSUME `(a:num) + 1 <= (p:num->num) a`))) THEN + SUBGOAL_THEN + `(p:num->num) (a + 1) <= q 1 /\ q 1 + 1 <= p a` + (LABEL_TAC "orientation") THENL + [MP_TAC(ASSUME + `adjacent_interval_cover (p:num->num) (q 0) (q 1)`) THEN + REWRITE_TAC[adjacent_interval_cover] THEN + USE_THEN "base" (fun th -> REWRITE_TAC[th]) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `0 < (a:num)` (LABEL_TAC "apos") THENL + [ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `adjacent_interval_cover (p:num->num) (q 0) (a - 1)` + (LABEL_TAC "coverspredecessor") THENL + [REWRITE_TAC[adjacent_interval_cover] THEN + ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `(a:num) - 1 = q 1` + (LABEL_TAC "nextvalue") THENL + [(MP_TAC(ISPECL + [`p:num->num`; `q:num->num`; `k:num`; `0`; `a - 1`] + FINITE_PATH_NEXT_COVER) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [USE_THEN "bound" ACCEPT_TAC; + USE_THEN "distinct" ACCEPT_TAC; + USE_THEN "chordless" ACCEPT_TAC; + ASM_ARITH_TAC; + ASM_ARITH_TAC; + USE_THEN "coverspredecessor" ACCEPT_TAC; + X_GEN_TAC `s:num` THEN DISCH_TAC THEN + SUBGOAL_THEN `(s:num) = 0` SUBST_ALL_TAC THENL + [ASM_ARITH_TAC; + USE_THEN "base" (fun th -> REWRITE_TAC[th]) THEN + ASM_ARITH_TAC]]; + DISCH_THEN(fun th -> + ACCEPT_TAC(REWRITE_RULE[ADD_CLAUSES] th))]); + ALL_TAC] THEN + SUBGOAL_THEN + `adjacent_interval_cover (p:num->num) (q 0) (p(a + 1))` + (LABEL_TAC "coverslower") THENL + [REWRITE_TAC[adjacent_interval_cover] THEN + ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `(p:num->num) (a + 1) = q 1` + (LABEL_TAC "lowervalue") THENL + [(MP_TAC(ISPECL + [`p:num->num`; `q:num->num`; `k:num`; `0`; + `(p:num->num) (a + 1)`] + FINITE_PATH_NEXT_COVER) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [USE_THEN "bound" ACCEPT_TAC; + USE_THEN "distinct" ACCEPT_TAC; + USE_THEN "chordless" ACCEPT_TAC; + ASM_ARITH_TAC; + ASM_ARITH_TAC; + USE_THEN "coverslower" ACCEPT_TAC; + X_GEN_TAC `s:num` THEN DISCH_TAC THEN + SUBGOAL_THEN `(s:num) = 0` SUBST_ALL_TAC THENL + [ASM_ARITH_TAC; + USE_THEN "base" (fun th -> REWRITE_TAC[th]) THEN + ASM_ARITH_TAC]]; + DISCH_THEN(fun th -> + ACCEPT_TAC(REWRITE_RULE[ADD_CLAUSES] th))]); + ALL_TAC] THEN + SUBGOAL_THEN `(p:num->num) a <= k` + (LABEL_TAC "pabound") THENL + [USE_THEN "pbound" (MP_TAC o SPEC `a:num`) THEN + ANTS_TAC THENL + [ASM_ARITH_TAC; + SIMP_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN `(p:num->num) a = a + 1` + (LABEL_TAC "uppervalue") THENL + [ASM_CASES_TAC `(p:num->num) a = a + 1` THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `(a:num) + 1 < p a` + (LABEL_TAC "gap") THENL + [ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `adjacent_interval_cover (p:num->num) (q 0) (a + 1)` + (LABEL_TAC "coversgap") THENL + [REWRITE_TAC[adjacent_interval_cover] THEN + ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `(a:num) + 1 = q 1` + (LABEL_TAC "gapvalue") THENL + [(MP_TAC(ISPECL + [`p:num->num`; `q:num->num`; `k:num`; `0`; `a + 1`] + FINITE_PATH_NEXT_COVER) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [USE_THEN "bound" ACCEPT_TAC; + USE_THEN "distinct" ACCEPT_TAC; + USE_THEN "chordless" ACCEPT_TAC; + ASM_ARITH_TAC; + ASM_ARITH_TAC; + USE_THEN "coversgap" ACCEPT_TAC; + X_GEN_TAC `s:num` THEN DISCH_TAC THEN + SUBGOAL_THEN `(s:num) = 0` SUBST_ALL_TAC THENL + [ASM_ARITH_TAC; + USE_THEN "base" (fun th -> REWRITE_TAC[th]) THEN + ASM_ARITH_TAC]]; + DISCH_THEN(fun th -> + ACCEPT_TAC(REWRITE_RULE[ADD_CLAUSES] th))]); + ASM_ARITH_TAC]; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [X_GEN_TAC `s:num` THEN DISCH_TAC THEN + ASM_CASES_TAC `(s:num) = 0` THENL + [ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; + SUBGOAL_THEN `(s:num) = 1` SUBST_ALL_TAC THENL + [ASM_ARITH_TAC; + ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC]]; + X_GEN_TAC `x:num` THEN STRIP_TAC THEN + ASM_CASES_TAC `(x:num) = a - 1` THENL + [EXISTS_TAC `1` THEN ASM_REWRITE_TAC[LE_REFL]; + EXISTS_TAC `0` THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC]]);; + +let FINITE_PATH_ZIGZAG_RIGHT_START = prove + (`!p q k a. + (!i. i <= k ==> p i <= k) /\ + (!i. i < k ==> q i < k) /\ + (!i j. i < j /\ j < k ==> ~(q i = q j)) /\ + (!i j. i + 1 < j /\ j < k + ==> ~adjacent_interval_cover p (q i) (q j)) /\ + 1 < k /\ + q 0 = a /\ + p(a + 1) <= a /\ + a + 1 <= p a /\ + a < q 1 /\ + adjacent_interval_cover p (q 0) (q 1) + ==> q 1 = a + 1 /\ + p(a + 1) = a /\ + p a = a + 2 /\ + (!s. s <= 1 ==> a <= q s /\ q s <= a + 1) /\ + (!x. a <= x /\ x <= a + 1 + ==> ?s. s <= 1 /\ q s = x)`, + REPEAT GEN_TAC THEN + INTRO_TAC + ("pbound bound distinct chordless nontrivial base lower " ^ + "upper right cover") THEN + SUBGOAL_THEN `(a:num) < k` (LABEL_TAC "abound") THENL + [USE_THEN "bound" (MP_TAC o SPEC `0`) THEN + USE_THEN "base" (fun th -> REWRITE_TAC[th]) THEN + USE_THEN "nontrivial" MP_TAC THEN ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `(q:num->num) 1 < k` + (LABEL_TAC "q1bound") THENL + [USE_THEN "bound" (MP_TAC o SPEC `1`) THEN + USE_THEN "nontrivial" MP_TAC THEN ARITH_TAC; + ALL_TAC] THEN + ASSUME_TAC(MATCH_MP + (ISPECL + [`(p:num->num) a`; `(p:num->num) (a + 1)`; + `(q:num->num) 1`; `a:num`] + (ARITH_RULE + `!pa pa1 q a:num. + pa1 <= a /\ a < q + ==> ~(pa <= q /\ q + 1 <= pa1)`)) + (CONJ (ASSUME `(p:num->num) (a + 1) <= a`) + (ASSUME `(a:num) < (q:num->num) 1`))) THEN + SUBGOAL_THEN + `(p:num->num) (a + 1) <= q 1 /\ q 1 + 1 <= p a` + (LABEL_TAC "orientation") THENL + [MP_TAC(ASSUME + `adjacent_interval_cover (p:num->num) (q 0) (q 1)`) THEN + REWRITE_TAC[adjacent_interval_cover] THEN + USE_THEN "base" (fun th -> REWRITE_TAC[th]) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `adjacent_interval_cover (p:num->num) (q 0) (a + 1)` + (LABEL_TAC "coverssuccessor") THENL + [REWRITE_TAC[adjacent_interval_cover] THEN + ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `(a:num) + 1 = q 1` + (LABEL_TAC "nextvalue") THENL + [(MP_TAC(ISPECL + [`p:num->num`; `q:num->num`; `k:num`; `0`; `a + 1`] + FINITE_PATH_NEXT_COVER) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [USE_THEN "bound" ACCEPT_TAC; + USE_THEN "distinct" ACCEPT_TAC; + USE_THEN "chordless" ACCEPT_TAC; + ASM_ARITH_TAC; + ASM_ARITH_TAC; + USE_THEN "coverssuccessor" ACCEPT_TAC; + X_GEN_TAC `s:num` THEN DISCH_TAC THEN + SUBGOAL_THEN `(s:num) = 0` SUBST_ALL_TAC THENL + [ASM_ARITH_TAC; + USE_THEN "base" (fun th -> REWRITE_TAC[th]) THEN + ASM_ARITH_TAC]]; + DISCH_THEN(fun th -> + ACCEPT_TAC(REWRITE_RULE[ADD_CLAUSES] th))]); + ALL_TAC] THEN + SUBGOAL_THEN `(p:num->num) (a + 1) = a` + (LABEL_TAC "lowervalue") THENL + [ASM_CASES_TAC `(p:num->num) (a + 1) = a` THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `(p:num->num) (a + 1) < a` + (LABEL_TAC "gap") THENL + [ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `adjacent_interval_cover (p:num->num) (q 0) (p(a + 1))` + (LABEL_TAC "coversgap") THENL + [REWRITE_TAC[adjacent_interval_cover] THEN + USE_THEN "base" (fun th -> REWRITE_TAC[th]) THEN + DISJ2_TAC THEN REWRITE_TAC[LE_REFL] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `(p:num->num) (a + 1) = q 1` + (LABEL_TAC "gapvalue") THENL + [(MP_TAC(ISPECL + [`p:num->num`; `q:num->num`; `k:num`; `0`; + `(p:num->num) (a + 1)`] + FINITE_PATH_NEXT_COVER) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [USE_THEN "bound" ACCEPT_TAC; + USE_THEN "distinct" ACCEPT_TAC; + USE_THEN "chordless" ACCEPT_TAC; + ASM_ARITH_TAC; + ASM_ARITH_TAC; + USE_THEN "coversgap" ACCEPT_TAC; + X_GEN_TAC `s:num` THEN DISCH_TAC THEN + SUBGOAL_THEN `(s:num) = 0` SUBST_ALL_TAC THENL + [ASM_ARITH_TAC; + USE_THEN "base" (fun th -> REWRITE_TAC[th]) THEN + ASM_ARITH_TAC]]; + DISCH_THEN(fun th -> + ACCEPT_TAC(REWRITE_RULE[ADD_CLAUSES] th))]); + ASM_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN `(p:num->num) a <= k` + (LABEL_TAC "pabound") THENL + [USE_THEN "pbound" (MP_TAC o SPEC `a:num`) THEN + ANTS_TAC THENL + [ASM_ARITH_TAC; + SIMP_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN `(p:num->num) a = a + 2` + (LABEL_TAC "uppervalue") THENL + [ASM_CASES_TAC `(p:num->num) a = a + 2` THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `(a:num) + 2 < p a` + (LABEL_TAC "gap") THENL + [ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `adjacent_interval_cover (p:num->num) (q 0) (a + 2)` + (LABEL_TAC "coversgap") THENL + [REWRITE_TAC[adjacent_interval_cover] THEN + USE_THEN "base" (fun th -> REWRITE_TAC[th]) THEN + DISJ2_TAC THEN + USE_THEN "lowervalue" (fun th -> REWRITE_TAC[th]) THEN + ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `(a:num) + 2 = q 1` + (LABEL_TAC "gapvalue") THENL + [(MP_TAC(ISPECL + [`p:num->num`; `q:num->num`; `k:num`; `0`; `a + 2`] + FINITE_PATH_NEXT_COVER) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [USE_THEN "bound" ACCEPT_TAC; + USE_THEN "distinct" ACCEPT_TAC; + USE_THEN "chordless" ACCEPT_TAC; + ASM_ARITH_TAC; + ASM_ARITH_TAC; + USE_THEN "coversgap" ACCEPT_TAC; + X_GEN_TAC `s:num` THEN DISCH_TAC THEN + SUBGOAL_THEN `(s:num) = 0` SUBST_ALL_TAC THENL + [ASM_ARITH_TAC; + USE_THEN "base" (fun th -> REWRITE_TAC[th]) THEN + ASM_ARITH_TAC]]; + DISCH_THEN(fun th -> + ACCEPT_TAC(REWRITE_RULE[ADD_CLAUSES] th))]); + ASM_ARITH_TAC]; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [X_GEN_TAC `s:num` THEN DISCH_TAC THEN + ASM_CASES_TAC `(s:num) = 0` THENL + [ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; + SUBGOAL_THEN `(s:num) = 1` SUBST_ALL_TAC THENL + [ASM_ARITH_TAC; + ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC]]; + X_GEN_TAC `x:num` THEN STRIP_TAC THEN + ASM_CASES_TAC `(x:num) = a + 1` THENL + [EXISTS_TAC `1` THEN ASM_REWRITE_TAC[LE_REFL]; + EXISTS_TAC `0` THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC]]);; + +let FINITE_PATH_ZIGZAG_LEFT = prove + (`!p q k a. + (!i. i <= k ==> p i <= k) /\ + (!i. i < k ==> q i < k) /\ + (!i j. i < j /\ j < k ==> ~(q i = q j)) /\ + (!i j. i + 1 < j /\ j < k + ==> ~adjacent_interval_cover p (q i) (q j)) /\ + (!r. 0 < r /\ r + 1 < k + ==> ~adjacent_interval_cover p (q r) (q 0)) /\ + (!r. r < k + ==> adjacent_interval_cover p (q r) (q(r + 1))) /\ + 1 < k /\ + q 0 = a /\ + p(a + 1) <= a /\ + a + 1 <= p a /\ + q 1 < a + ==> !t. 2 * t + 1 < k + ==> t < a /\ + q(2 * t) = a + t /\ + q(2 * t + 1) = a - t - 1 /\ + p(a - t) = a + t + 1 /\ + p(a + t + 1) = a - t - 1 /\ + (!s. s <= 2 * t + 1 + ==> a - t - 1 <= q s /\ q s <= a + t) /\ + (!x. a - t - 1 <= x /\ x <= a + t + ==> ?s. s <= 2 * t + 1 /\ q s = x)`, + REPEAT GEN_TAC THEN + INTRO_TAC + ("pbound bound distinct chordless nobase path nontrivial " ^ + "base lower upper left") THEN + INDUCT_TAC THENL + [DISCH_TAC THEN + MP_TAC(ISPECL + [`p:num->num`; `q:num->num`; `k:num`; `a:num`] + FINITE_PATH_ZIGZAG_LEFT_START) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN + USE_THEN "path" (MP_TAC o SPEC `0`) THEN + ANTS_TAC THENL + [MATCH_MP_TAC(ARITH_RULE `1 < k ==> 0 < k`) THEN + USE_THEN "nontrivial" ACCEPT_TAC; + DISCH_THEN(fun th -> + USE_THEN "base" (fun eth -> + ACCEPT_TAC(REWRITE_RULE[eth; ADD_CLAUSES] th)))]; + STRIP_TAC THEN + ASM_REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES; SUB_0]]; + POP_ASSUM(LABEL_TAC "induction") THEN + DISCH_THEN(LABEL_TAC "target") THEN + USE_THEN "induction" MP_TAC THEN + ANTS_TAC THENL + [USE_THEN "target" MP_TAC THEN ARITH_TAC; + INTRO_TAC "tlt qeven qodd plow phigh range full"] THEN + MP_TAC(ISPECL + [`p:num->num`; `q:num->num`; `k:num`; `2 * (t:num) + 1`; + `a:num`; `(a:num) - t - 1`; `(a:num) + t`] + FINITE_PATH_ZIGZAG_UP) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [USE_THEN "pbound" ACCEPT_TAC; + USE_THEN "bound" ACCEPT_TAC; + USE_THEN "distinct" ACCEPT_TAC; + USE_THEN "chordless" ACCEPT_TAC; + USE_THEN "target" MP_TAC THEN ARITH_TAC; + USE_THEN "base" (fun th -> REWRITE_TAC[GSYM th]) THEN + USE_THEN "nobase" MATCH_MP_TAC THEN + USE_THEN "target" MP_TAC THEN ARITH_TAC; + USE_THEN "path" MATCH_MP_TAC THEN + USE_THEN "target" MP_TAC THEN ARITH_TAC; + USE_THEN "qodd" ACCEPT_TAC; + SUBGOAL_THEN `(a - t - 1) + 1 = a - t` + SUBST1_TAC THENL + [USE_THEN "tlt" MP_TAC THEN ARITH_TAC; + USE_THEN "plow" (fun th -> REWRITE_TAC[th]) THEN + ARITH_TAC]; + ACCEPT_TAC(ARITH_RULE `(a:num) - t - 1 <= a`); + ACCEPT_TAC(ARITH_RULE `(a:num) <= a + t`); + USE_THEN "range" ACCEPT_TAC; + USE_THEN "full" ACCEPT_TAC]; + INTRO_TAC "qnext pnext nextrange nextfull"] THEN + MP_TAC(ISPECL + [`p:num->num`; `q:num->num`; `k:num`; `2 * (t:num) + 2`; + `a:num`; `(a:num) - t - 1`; `(a:num) + t + 1`] + FINITE_PATH_ZIGZAG_DOWN) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [USE_THEN "bound" ACCEPT_TAC; + USE_THEN "distinct" ACCEPT_TAC; + USE_THEN "chordless" ACCEPT_TAC; + USE_THEN "target" MP_TAC THEN ARITH_TAC; + USE_THEN "base" (fun th -> REWRITE_TAC[GSYM th]) THEN + USE_THEN "nobase" MATCH_MP_TAC THEN + USE_THEN "target" MP_TAC THEN ARITH_TAC; + USE_THEN "path" MATCH_MP_TAC THEN + USE_THEN "target" MP_TAC THEN ARITH_TAC; + TRANS_TAC EQ_TRANS `(q:num->num)((2 * t + 1) + 1)` THEN + CONJ_TAC THENL + [AP_TERM_TAC THEN ARITH_TAC; + USE_THEN "qnext" (fun th -> REWRITE_TAC[th]) THEN + ARITH_TAC]; + USE_THEN "phigh" ACCEPT_TAC; + ACCEPT_TAC(ARITH_RULE `(a:num) - t - 1 <= a`); + ACCEPT_TAC(ARITH_RULE `(a:num) <= a + t + 1`); + X_GEN_TAC `s:num` THEN DISCH_THEN(LABEL_TAC "sle") THEN + USE_THEN "nextrange" (MP_TAC o SPEC `s:num`) THEN + ANTS_TAC THENL + [USE_THEN "sle" MP_TAC THEN ARITH_TAC; + INTRO_TAC "slow shigh"] THEN + CONJ_TAC THENL + [USE_THEN "slow" ACCEPT_TAC; + MATCH_MP_TAC(ARITH_RULE + `x <= (a + t) + 1 ==> x <= a + t + 1`) THEN + USE_THEN "shigh" ACCEPT_TAC]; + X_GEN_TAC `x:num` THEN + INTRO_TAC "xlow xhigh" THEN + USE_THEN "nextfull" (MP_TAC o SPEC `x:num`) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [USE_THEN "xlow" ACCEPT_TAC; + MATCH_MP_TAC(ARITH_RULE + `x <= a + t + 1 ==> x <= (a + t) + 1`) THEN + USE_THEN "xhigh" ACCEPT_TAC]; + INTRO_TAC "@s. sle qs"] THEN + EXISTS_TAC `s:num` THEN CONJ_TAC THENL + [MATCH_MP_TAC(ARITH_RULE + `s <= (2 * t + 1) + 1 ==> s <= 2 * t + 2`) THEN + USE_THEN "sle" ACCEPT_TAC; + USE_THEN "qs" ACCEPT_TAC]]; + INTRO_TAC "lopos qoddnext phighnext finalrange finalfull"] THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC(ARITH_RULE + `0 < a - t - 1 ==> SUC t < a`) THEN + USE_THEN "lopos" ACCEPT_TAC; + TRANS_TAC EQ_TRANS + `(q:num->num)((2 * t + 1) + 1)` THEN + CONJ_TAC THENL + [AP_TERM_TAC THEN + ACCEPT_TAC(ARITH_RULE + `2 * SUC t = (2 * t + 1) + 1`); + USE_THEN "qnext" (fun th -> REWRITE_TAC[th]) THEN + ACCEPT_TAC(ARITH_RULE + `(a + t) + 1 = a + SUC t`)]; + TRANS_TAC EQ_TRANS + `(q:num->num)((2 * t + 2) + 1)` THEN + CONJ_TAC THENL + [AP_TERM_TAC THEN + ACCEPT_TAC(ARITH_RULE + `2 * SUC t + 1 = (2 * t + 2) + 1`); + USE_THEN "qoddnext" (fun th -> REWRITE_TAC[th]) THEN + ACCEPT_TAC(ARITH_RULE + `(a - t - 1) - 1 = a - SUC t - 1`)]; + TRANS_TAC EQ_TRANS `(p:num->num)(a - t - 1)` THEN + CONJ_TAC THENL + [AP_TERM_TAC THEN + ACCEPT_TAC(ARITH_RULE + `a - SUC t = a - t - 1`); + USE_THEN "pnext" (fun th -> REWRITE_TAC[th]) THEN + ACCEPT_TAC(ARITH_RULE + `(a + t) + 2 = a + SUC t + 1`)]; + TRANS_TAC EQ_TRANS `(p:num->num)((a + t + 1) + 1)` THEN + CONJ_TAC THENL + [AP_TERM_TAC THEN + ACCEPT_TAC(ARITH_RULE + `a + SUC t + 1 = (a + t + 1) + 1`); + USE_THEN "phighnext" (fun th -> REWRITE_TAC[th]) THEN + ACCEPT_TAC(ARITH_RULE + `(a - t - 1) - 1 = a - SUC t - 1`)]; + X_GEN_TAC `s:num` THEN DISCH_THEN(LABEL_TAC "sle") THEN + USE_THEN "finalrange" (MP_TAC o SPEC `s:num`) THEN + ANTS_TAC THENL + [MATCH_MP_TAC(ARITH_RULE + `s <= 2 * SUC t + 1 ==> s <= (2 * t + 2) + 1`) THEN + USE_THEN "sle" ACCEPT_TAC; + INTRO_TAC "slow shigh"] THEN + CONJ_TAC THENL + [MATCH_MP_TAC(ARITH_RULE + `(a - t - 1) - 1 <= x ==> a - SUC t - 1 <= x`) THEN + USE_THEN "slow" ACCEPT_TAC; + MATCH_MP_TAC(ARITH_RULE + `x <= a + t + 1 ==> x <= a + SUC t`) THEN + USE_THEN "shigh" ACCEPT_TAC]; + X_GEN_TAC `x:num` THEN + INTRO_TAC "xlow xhigh" THEN + USE_THEN "finalfull" (MP_TAC o SPEC `x:num`) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC(ARITH_RULE + `a - SUC t - 1 <= x ==> (a - t - 1) - 1 <= x`) THEN + USE_THEN "xlow" ACCEPT_TAC; + MATCH_MP_TAC(ARITH_RULE + `x <= a + SUC t ==> x <= a + t + 1`) THEN + USE_THEN "xhigh" ACCEPT_TAC]; + INTRO_TAC "@s. sle qs"] THEN + EXISTS_TAC `s:num` THEN CONJ_TAC THENL + [MATCH_MP_TAC(ARITH_RULE + `s <= (2 * t + 2) + 1 ==> s <= 2 * SUC t + 1`) THEN + USE_THEN "sle" ACCEPT_TAC; + USE_THEN "qs" ACCEPT_TAC]]]);; + +let FINITE_PATH_ZIGZAG_RIGHT = prove + (`!p q k a. + (!i. i <= k ==> p i <= k) /\ + (!i. i < k ==> q i < k) /\ + (!i j. i < j /\ j < k ==> ~(q i = q j)) /\ + (!i j. i + 1 < j /\ j < k + ==> ~adjacent_interval_cover p (q i) (q j)) /\ + (!r. 0 < r /\ r + 1 < k + ==> ~adjacent_interval_cover p (q r) (q 0)) /\ + (!r. r < k + ==> adjacent_interval_cover p (q r) (q(r + 1))) /\ + 1 < k /\ + q 0 = a /\ + p(a + 1) <= a /\ + a + 1 <= p a /\ + a < q 1 + ==> !t. 2 * t + 1 < k + ==> t <= a /\ + q(2 * t) = a - t /\ + q(2 * t + 1) = a + t + 1 /\ + p(a - t) = a + t + 2 /\ + p(a + t + 1) = a - t /\ + (!s. s <= 2 * t + 1 + ==> a - t <= q s /\ q s <= a + t + 1) /\ + (!x. a - t <= x /\ x <= a + t + 1 + ==> ?s. s <= 2 * t + 1 /\ q s = x)`, + REPEAT GEN_TAC THEN + INTRO_TAC + ("pbound bound distinct chordless nobase path nontrivial " ^ + "base lower upper right") THEN + INDUCT_TAC THENL + [DISCH_TAC THEN + MP_TAC(ISPECL + [`p:num->num`; `q:num->num`; `k:num`; `a:num`] + FINITE_PATH_ZIGZAG_RIGHT_START) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN + USE_THEN "path" (MP_TAC o SPEC `0`) THEN + ANTS_TAC THENL + [MATCH_MP_TAC(ARITH_RULE `1 < k ==> 0 < k`) THEN + USE_THEN "nontrivial" ACCEPT_TAC; + DISCH_THEN(fun th -> + USE_THEN "base" (fun eth -> + ACCEPT_TAC(REWRITE_RULE[eth; ADD_CLAUSES] th)))]; + STRIP_TAC THEN + ASM_REWRITE_TAC[MULT_CLAUSES; ADD_CLAUSES; SUB_0; LE_0]]; + POP_ASSUM(LABEL_TAC "induction") THEN + DISCH_THEN(LABEL_TAC "target") THEN + USE_THEN "induction" MP_TAC THEN + ANTS_TAC THENL + [USE_THEN "target" MP_TAC THEN ARITH_TAC; + INTRO_TAC "tle qeven qodd plow phigh range full"] THEN + MP_TAC(ISPECL + [`p:num->num`; `q:num->num`; `k:num`; `2 * (t:num) + 1`; + `a:num`; `(a:num) - t`; `(a:num) + t + 1`] + FINITE_PATH_ZIGZAG_DOWN) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [USE_THEN "bound" ACCEPT_TAC; + USE_THEN "distinct" ACCEPT_TAC; + USE_THEN "chordless" ACCEPT_TAC; + USE_THEN "target" MP_TAC THEN ARITH_TAC; + USE_THEN "base" (fun th -> REWRITE_TAC[GSYM th]) THEN + USE_THEN "nobase" MATCH_MP_TAC THEN + USE_THEN "target" MP_TAC THEN ARITH_TAC; + USE_THEN "path" MATCH_MP_TAC THEN + USE_THEN "target" MP_TAC THEN ARITH_TAC; + USE_THEN "qodd" ACCEPT_TAC; + USE_THEN "phigh" ACCEPT_TAC; + ACCEPT_TAC(ARITH_RULE `(a:num) - t <= a`); + ACCEPT_TAC(ARITH_RULE `(a:num) <= a + t + 1`); + USE_THEN "range" ACCEPT_TAC; + USE_THEN "full" ACCEPT_TAC]; + INTRO_TAC "lopos qnext phighnext nextrange nextfull"] THEN + MP_TAC(ISPECL + [`p:num->num`; `q:num->num`; `k:num`; `2 * (t:num) + 2`; + `a:num`; `(a:num) - t - 1`; `(a:num) + t + 1`] + FINITE_PATH_ZIGZAG_UP) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [USE_THEN "pbound" ACCEPT_TAC; + USE_THEN "bound" ACCEPT_TAC; + USE_THEN "distinct" ACCEPT_TAC; + USE_THEN "chordless" ACCEPT_TAC; + USE_THEN "target" MP_TAC THEN ARITH_TAC; + USE_THEN "base" (fun th -> REWRITE_TAC[GSYM th]) THEN + USE_THEN "nobase" MATCH_MP_TAC THEN + USE_THEN "target" MP_TAC THEN ARITH_TAC; + USE_THEN "path" MATCH_MP_TAC THEN + USE_THEN "target" MP_TAC THEN ARITH_TAC; + TRANS_TAC EQ_TRANS + `(q:num->num)((2 * t + 1) + 1)` THEN + CONJ_TAC THENL + [AP_TERM_TAC THEN ARITH_TAC; + USE_THEN "qnext" (fun th -> REWRITE_TAC[th]) THEN + ARITH_TAC]; + SUBGOAL_THEN `(a - t - 1) + 1 = a - t` + SUBST1_TAC THENL + [MATCH_MP_TAC(ARITH_RULE + `0 < a - t ==> (a - t - 1) + 1 = a - t`) THEN + USE_THEN "lopos" ACCEPT_TAC; + USE_THEN "plow" (fun th -> REWRITE_TAC[th]) THEN + ARITH_TAC]; + ACCEPT_TAC(ARITH_RULE `(a:num) - t - 1 <= a`); + ACCEPT_TAC(ARITH_RULE `(a:num) <= a + t + 1`); + X_GEN_TAC `s:num` THEN DISCH_THEN(LABEL_TAC "sle") THEN + USE_THEN "nextrange" (MP_TAC o SPEC `s:num`) THEN + ANTS_TAC THENL + [USE_THEN "sle" MP_TAC THEN ARITH_TAC; + INTRO_TAC "slow shigh"] THEN + CONJ_TAC THENL + [USE_THEN "slow" ACCEPT_TAC; + USE_THEN "shigh" ACCEPT_TAC]; + X_GEN_TAC `x:num` THEN STRIP_TAC THEN + USE_THEN "nextfull" (MP_TAC o SPEC `x:num`) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN ARITH_TAC; + INTRO_TAC "@s. sle qs"] THEN + EXISTS_TAC `s:num` THEN CONJ_TAC THENL + [MATCH_MP_TAC(ARITH_RULE + `s <= (2 * t + 1) + 1 ==> s <= 2 * t + 2`) THEN + USE_THEN "sle" ACCEPT_TAC; + USE_THEN "qs" ACCEPT_TAC]]; + INTRO_TAC "qoddnext plownext finalrange finalfull"] THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC(ARITH_RULE + `0 < a - t ==> SUC t <= a`) THEN + USE_THEN "lopos" ACCEPT_TAC; + TRANS_TAC EQ_TRANS + `(q:num->num)((2 * t + 1) + 1)` THEN + CONJ_TAC THENL + [AP_TERM_TAC THEN + ACCEPT_TAC(ARITH_RULE + `2 * SUC t = (2 * t + 1) + 1`); + USE_THEN "qnext" (fun th -> REWRITE_TAC[th]) THEN + ACCEPT_TAC(ARITH_RULE + `(a - t) - 1 = a - SUC t`)]; + TRANS_TAC EQ_TRANS + `(q:num->num)((2 * t + 2) + 1)` THEN + CONJ_TAC THENL + [AP_TERM_TAC THEN + ACCEPT_TAC(ARITH_RULE + `2 * SUC t + 1 = (2 * t + 2) + 1`); + USE_THEN "qoddnext" (fun th -> REWRITE_TAC[th]) THEN + ACCEPT_TAC(ARITH_RULE + `(a + t + 1) + 1 = a + SUC t + 1`)]; + TRANS_TAC EQ_TRANS `(p:num->num)(a - t - 1)` THEN + CONJ_TAC THENL + [AP_TERM_TAC THEN + ACCEPT_TAC(ARITH_RULE + `a - SUC t = a - t - 1`); + USE_THEN "plownext" (fun th -> REWRITE_TAC[th]) THEN + ACCEPT_TAC(ARITH_RULE + `(a + t + 1) + 2 = a + SUC t + 2`)]; + TRANS_TAC EQ_TRANS `(p:num->num)((a + t + 1) + 1)` THEN + CONJ_TAC THENL + [AP_TERM_TAC THEN + ACCEPT_TAC(ARITH_RULE + `a + SUC t + 1 = (a + t + 1) + 1`); + USE_THEN "phighnext" (fun th -> REWRITE_TAC[th]) THEN + ACCEPT_TAC(ARITH_RULE + `(a - t) - 1 = a - SUC t`)]; + X_GEN_TAC `s:num` THEN DISCH_THEN(LABEL_TAC "sle") THEN + USE_THEN "finalrange" (MP_TAC o SPEC `s:num`) THEN + ANTS_TAC THENL + [MATCH_MP_TAC(ARITH_RULE + `s <= 2 * SUC t + 1 ==> s <= (2 * t + 2) + 1`) THEN + USE_THEN "sle" ACCEPT_TAC; + INTRO_TAC "slow shigh"] THEN + CONJ_TAC THENL + [MATCH_MP_TAC(ARITH_RULE + `a - t - 1 <= x ==> a - SUC t <= x`) THEN + USE_THEN "slow" ACCEPT_TAC; + MATCH_MP_TAC(ARITH_RULE + `x <= (a + t + 1) + 1 ==> x <= a + SUC t + 1`) THEN + USE_THEN "shigh" ACCEPT_TAC]; + X_GEN_TAC `x:num` THEN + INTRO_TAC "xlow xhigh" THEN + USE_THEN "finalfull" (MP_TAC o SPEC `x:num`) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC(ARITH_RULE + `a - SUC t <= x ==> a - t - 1 <= x`) THEN + USE_THEN "xlow" ACCEPT_TAC; + MATCH_MP_TAC(ARITH_RULE + `x <= a + SUC t + 1 ==> x <= (a + t + 1) + 1`) THEN + USE_THEN "xhigh" ACCEPT_TAC]; + INTRO_TAC "@s. sle qs"] THEN + EXISTS_TAC `s:num` THEN CONJ_TAC THENL + [MATCH_MP_TAC(ARITH_RULE + `s <= (2 * t + 2) + 1 ==> s <= 2 * SUC t + 1`) THEN + USE_THEN "sle" ACCEPT_TAC; + USE_THEN "qs" ACCEPT_TAC]]]);; + +let FINITE_PATH_ZIGZAG_LEFT_TERMINAL = prove + (`!p q m a. + (!i. i <= 2 * m ==> p i <= 2 * m) /\ + (!i. i < 2 * m ==> q i < 2 * m) /\ + (!i j. i < j /\ j < 2 * m ==> ~(q i = q j)) /\ + (!i j. i + 1 < j /\ j < 2 * m + ==> ~adjacent_interval_cover p (q i) (q j)) /\ + (!r. 0 < r /\ r + 1 < 2 * m + ==> ~adjacent_interval_cover p (q r) (q 0)) /\ + (!r. r < 2 * m + ==> adjacent_interval_cover p (q r) (q(r + 1))) /\ + 0 < m /\ + q 0 = a /\ + q(2 * m) = q 0 /\ + p(a + 1) <= a /\ + a + 1 <= p a /\ + q 1 < a + ==> a = m /\ + q(2 * m - 1) = 0 /\ + p 1 = 2 * m /\ + (!r. r < m + ==> adjacent_interval_cover p + (q(2 * m - 1)) (q(2 * r)))`, + REPEAT GEN_TAC THEN + INTRO_TAC + ("pbound bound distinct chordless nobase path positive base " ^ + "closed lower upper left") THEN + MP_TAC(ISPECL + [`p:num->num`; `q:num->num`; `2 * (m:num)`; `a:num`] + FINITE_PATH_ZIGZAG_LEFT) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(ARITH_RULE `0 < m ==> 1 < 2 * m`) THEN + USE_THEN "positive" ACCEPT_TAC; + DISCH_THEN(LABEL_TAC "zigzag")] THEN + USE_THEN "zigzag" (MP_TAC o SPEC `m - 1`) THEN + ANTS_TAC THENL + [MATCH_MP_TAC(ARITH_RULE + `0 < m ==> 2 * (m - 1) + 1 < 2 * m`) THEN + USE_THEN "positive" ACCEPT_TAC; + INTRO_TAC "leftbound qeven qodd plow phigh range full"] THEN + SUBGOAL_THEN + `(q:num->num)(2 * (m - 1)) < 2 * m` + (LABEL_TAC "qevenbound") THENL + [USE_THEN "bound" MATCH_MP_TAC THEN + MATCH_MP_TAC(ARITH_RULE + `0 < m ==> 2 * (m - 1) < 2 * m`) THEN + USE_THEN "positive" ACCEPT_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `(a:num) + (m - 1) < 2 * m` + (LABEL_TAC "abound") THENL + [USE_THEN "qevenbound" MP_TAC THEN + USE_THEN "qeven" (fun th -> REWRITE_TAC[th]); + ALL_TAC] THEN + SUBGOAL_THEN `(a:num) = m` (LABEL_TAC "center") THENL + [MATCH_MP_TAC(ARITH_RULE + `m - 1 < a /\ a + (m - 1) < 2 * m ==> a = m`) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `(q:num->num)(2 * m - 1) = 0` + (LABEL_TAC "terminal") THENL + [SUBGOAL_THEN `2 * m - 1 = 2 * (m - 1) + 1` + (fun th -> REWRITE_TAC[th]) THENL + [MATCH_MP_TAC(ARITH_RULE + `0 < m ==> 2 * m - 1 = 2 * (m - 1) + 1`) THEN + USE_THEN "positive" ACCEPT_TAC; + USE_THEN "qodd" (fun th -> REWRITE_TAC[th]) THEN + USE_THEN "center" (fun th -> REWRITE_TAC[th]) THEN + MATCH_MP_TAC(ARITH_RULE + `0 < m ==> m - (m - 1) - 1 = 0`) THEN + USE_THEN "positive" ACCEPT_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN `(p:num->num) 1 = 2 * m` + (LABEL_TAC "pone") THENL + [SUBGOAL_THEN + `(p:num->num) 1 = p(a - (m - 1))` + (LABEL_TAC "parg") THENL + [AP_TERM_TAC THEN + USE_THEN "center" (fun th -> REWRITE_TAC[th]) THEN + MATCH_MP_TAC(ARITH_RULE `0 < m ==> 1 = m - (m - 1)`) THEN + USE_THEN "positive" ACCEPT_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `(a:num) + m - 1 + 1 = 2 * m` + (LABEL_TAC "prhs") THENL + [USE_THEN "center" (fun th -> REWRITE_TAC[th]) THEN + MATCH_MP_TAC(ARITH_RULE + `0 < m ==> m + m - 1 + 1 = 2 * m`) THEN + USE_THEN "positive" ACCEPT_TAC; + USE_THEN "parg" (fun th -> REWRITE_TAC[th]) THEN + USE_THEN "plow" (fun th -> REWRITE_TAC[th]) THEN + USE_THEN "prhs" ACCEPT_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN `(2 * m - 1) + 1 = 2 * m` + (LABEL_TAC "lastindex") THENL + [USE_THEN "positive" MP_TAC THEN ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `adjacent_interval_cover (p:num->num) 0 m` + (LABEL_TAC "lastedge") THENL + [SUBGOAL_THEN + `adjacent_interval_cover (p:num->num) + (q(2 * m - 1)) (q((2 * m - 1) + 1))` + (LABEL_TAC "rawedge") THENL + [USE_THEN "path" MATCH_MP_TAC THEN + MATCH_MP_TAC(ARITH_RULE `0 < m ==> 2 * m - 1 < 2 * m`) THEN + USE_THEN "positive" ACCEPT_TAC; + USE_THEN "rawedge" (fun th -> + USE_THEN "lastindex" (fun ith -> + USE_THEN "terminal" (fun qth -> + USE_THEN "closed" (fun cth -> + USE_THEN "base" (fun bth -> + USE_THEN "center" (fun ath -> + ACCEPT_TAC + (REWRITE_RULE[ith; qth; cth; bth; ath] th)))))))]; + ALL_TAC] THEN + SUBGOAL_THEN `(p:num->num) 0 <= m` + (LABEL_TAC "pzero") THENL + [USE_THEN "lastedge" MP_TAC THEN + REWRITE_TAC[adjacent_interval_cover; ADD_CLAUSES] THEN + USE_THEN "pone" (fun th -> REWRITE_TAC[th]) THEN + DISCH_THEN(LABEL_TAC "orientation") THEN + USE_THEN "positive" MP_TAC THEN ASM_ARITH_TAC; + ALL_TAC] THEN + REPEAT CONJ_TAC THENL + [USE_THEN "center" ACCEPT_TAC; + USE_THEN "terminal" ACCEPT_TAC; + USE_THEN "pone" ACCEPT_TAC; + X_GEN_TAC `r:num` THEN DISCH_THEN(LABEL_TAC "rlt") THEN + USE_THEN "zigzag" (MP_TAC o SPEC `r:num`) THEN + ANTS_TAC THENL + [MATCH_MP_TAC(ARITH_RULE + `r < m ==> 2 * r + 1 < 2 * m`) THEN + USE_THEN "rlt" ACCEPT_TAC; + INTRO_TAC "_ qreven _ _ _ _ _"] THEN + USE_THEN "terminal" (fun th -> REWRITE_TAC[th]) THEN + USE_THEN "qreven" (fun th -> REWRITE_TAC[th]) THEN + USE_THEN "center" (fun th -> REWRITE_TAC[th]) THEN + REWRITE_TAC[adjacent_interval_cover; ADD_CLAUSES] THEN + DISJ1_TAC THEN + CONJ_TAC THENL + [USE_THEN "pzero" MP_TAC THEN ARITH_TAC; + USE_THEN "pone" (fun th -> REWRITE_TAC[th]) THEN + USE_THEN "rlt" MP_TAC THEN ARITH_TAC]]);; + +let FINITE_PATH_ZIGZAG_RIGHT_TERMINAL = prove + (`!p q m a. + (!i. i <= 2 * m ==> p i <= 2 * m) /\ + (!i. i < 2 * m ==> q i < 2 * m) /\ + (!i j. i < j /\ j < 2 * m ==> ~(q i = q j)) /\ + (!i j. i + 1 < j /\ j < 2 * m + ==> ~adjacent_interval_cover p (q i) (q j)) /\ + (!r. 0 < r /\ r + 1 < 2 * m + ==> ~adjacent_interval_cover p (q r) (q 0)) /\ + (!r. r < 2 * m + ==> adjacent_interval_cover p (q r) (q(r + 1))) /\ + 0 < m /\ + q 0 = a /\ + q(2 * m) = q 0 /\ + p(a + 1) <= a /\ + a + 1 <= p a /\ + a < q 1 + ==> a = m - 1 /\ + q(2 * m - 1) = 2 * m - 1 /\ + p(2 * m - 1) = 0 /\ + (!r. r < m + ==> adjacent_interval_cover p + (q(2 * m - 1)) (q(2 * r)))`, + REPEAT GEN_TAC THEN + INTRO_TAC + ("pbound bound distinct chordless nobase path positive base " ^ + "closed lower upper right") THEN + MP_TAC(ISPECL + [`p:num->num`; `q:num->num`; `2 * (m:num)`; `a:num`] + FINITE_PATH_ZIGZAG_RIGHT) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(ARITH_RULE `0 < m ==> 1 < 2 * m`) THEN + USE_THEN "positive" ACCEPT_TAC; + DISCH_THEN(LABEL_TAC "zigzag")] THEN + USE_THEN "zigzag" (MP_TAC o SPEC `m - 1`) THEN + ANTS_TAC THENL + [MATCH_MP_TAC(ARITH_RULE + `0 < m ==> 2 * (m - 1) + 1 < 2 * m`) THEN + USE_THEN "positive" ACCEPT_TAC; + INTRO_TAC "leftbound qeven qodd plow phigh range full"] THEN + SUBGOAL_THEN + `(q:num->num)(2 * (m - 1) + 1) < 2 * m` + (LABEL_TAC "qoddbound") THENL + [USE_THEN "bound" MATCH_MP_TAC THEN + MATCH_MP_TAC(ARITH_RULE + `0 < m ==> 2 * (m - 1) + 1 < 2 * m`) THEN + USE_THEN "positive" ACCEPT_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `(a:num) + (m - 1) + 1 < 2 * m` + (LABEL_TAC "abound") THENL + [USE_THEN "qoddbound" MP_TAC THEN + USE_THEN "qodd" (fun th -> REWRITE_TAC[th]); + ALL_TAC] THEN + SUBGOAL_THEN `(a:num) = m - 1` (LABEL_TAC "center") THENL + [MATCH_MP_TAC(ARITH_RULE + `m - 1 <= a /\ a + (m - 1) + 1 < 2 * m + ==> a = m - 1`) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `(q:num->num)(2 * m - 1) = 2 * m - 1` + (LABEL_TAC "terminal") THENL + [SUBGOAL_THEN + `(q:num->num)(2 * m - 1) = + q(2 * (m - 1) + 1)` + (LABEL_TAC "qarg") THENL + [AP_TERM_TAC THEN + MATCH_MP_TAC(ARITH_RULE + `0 < m ==> 2 * m - 1 = 2 * (m - 1) + 1`) THEN + USE_THEN "positive" ACCEPT_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `(a:num) + (m - 1) + 1 = 2 * m - 1` + (LABEL_TAC "qrhs") THENL + [USE_THEN "center" (fun th -> REWRITE_TAC[th]) THEN + USE_THEN "positive" MP_TAC THEN ARITH_TAC; + USE_THEN "qarg" (fun th -> REWRITE_TAC[th]) THEN + USE_THEN "qodd" (fun th -> REWRITE_TAC[th]) THEN + USE_THEN "qrhs" ACCEPT_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN `(p:num->num)(2 * m - 1) = 0` + (LABEL_TAC "pterminal") THENL + [SUBGOAL_THEN + `(p:num->num)(2 * m - 1) = + p(a + (m - 1) + 1)` + (LABEL_TAC "parg") THENL + [AP_TERM_TAC THEN + MAP_EVERY (fun s -> USE_THEN s MP_TAC) ["center"; "positive"] THEN + ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `(a:num) - (m - 1) = 0` + (LABEL_TAC "prhs") THENL + [USE_THEN "center" MP_TAC THEN ARITH_TAC; + USE_THEN "parg" (fun th -> REWRITE_TAC[th]) THEN + USE_THEN "phigh" (fun th -> REWRITE_TAC[th]) THEN + USE_THEN "prhs" ACCEPT_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN `(2 * m - 1) + 1 = 2 * m` + (LABEL_TAC "lastindex") THENL + [USE_THEN "positive" MP_TAC THEN ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `adjacent_interval_cover (p:num->num) (2 * m - 1) (m - 1)` + (LABEL_TAC "lastedge") THENL + [SUBGOAL_THEN + `adjacent_interval_cover (p:num->num) + (q(2 * m - 1)) (q((2 * m - 1) + 1))` + (LABEL_TAC "rawedge") THENL + [USE_THEN "path" MATCH_MP_TAC THEN + MATCH_MP_TAC(ARITH_RULE `0 < m ==> 2 * m - 1 < 2 * m`) THEN + USE_THEN "positive" ACCEPT_TAC; + USE_THEN "rawedge" (fun th -> + USE_THEN "lastindex" (fun ith -> + USE_THEN "terminal" (fun qth -> + USE_THEN "closed" (fun cth -> + USE_THEN "base" (fun bth -> + USE_THEN "center" (fun ath -> + ACCEPT_TAC + (REWRITE_RULE[ith; qth; cth; bth; ath] th)))))))]; + ALL_TAC] THEN + SUBGOAL_THEN `(m:num) <= p(2 * m)` + (LABEL_TAC "ptop") THENL + [USE_THEN "lastedge" MP_TAC THEN + REWRITE_TAC[adjacent_interval_cover] THEN + USE_THEN "lastindex" (fun th -> REWRITE_TAC[th]) THEN + USE_THEN "pterminal" (fun th -> REWRITE_TAC[th]) THEN + DISCH_THEN(LABEL_TAC "orientation") THEN + USE_THEN "positive" MP_TAC THEN ASM_ARITH_TAC; + ALL_TAC] THEN + REPEAT CONJ_TAC THENL + [USE_THEN "center" ACCEPT_TAC; + USE_THEN "terminal" ACCEPT_TAC; + USE_THEN "pterminal" ACCEPT_TAC; + X_GEN_TAC `r:num` THEN DISCH_THEN(LABEL_TAC "rlt") THEN + USE_THEN "zigzag" (MP_TAC o SPEC `r:num`) THEN + ANTS_TAC THENL + [MATCH_MP_TAC(ARITH_RULE + `r < m ==> 2 * r + 1 < 2 * m`) THEN + USE_THEN "rlt" ACCEPT_TAC; + INTRO_TAC "_ qreven _ _ _ _ _"] THEN + USE_THEN "terminal" (fun th -> REWRITE_TAC[th]) THEN + USE_THEN "qreven" (fun th -> REWRITE_TAC[th]) THEN + USE_THEN "center" (fun th -> REWRITE_TAC[th]) THEN + REWRITE_TAC[adjacent_interval_cover] THEN + USE_THEN "lastindex" (fun th -> REWRITE_TAC[th]) THEN + USE_THEN "pterminal" (fun th -> REWRITE_TAC[th]) THEN + DISJ1_TAC THEN CONJ_TAC THENL + [ARITH_TAC; + USE_THEN "ptop" MP_TAC THEN + USE_THEN "positive" MP_TAC THEN ARITH_TAC]]);; + +let PATH_TERMINAL_TAIL_CYCLE = prove + (`!v e (q:num->A) k r. + 0 < k /\ + r < k /\ + (!i. i < k ==> v(q i)) /\ + (!i j. i < j /\ j < k ==> ~(q i = q j)) /\ + e (q(k - 1)) (q r) /\ + (!i. i < k ==> e (q i) (q(i + 1))) + ==> ?u. + (!i. i <= k - r ==> v(u i)) /\ + u 0 = u(k - r) /\ + (!i. 0 < i /\ i < k - r ==> ~(u i = u 0)) /\ + (!i. i < k - r ==> e (u i) (u(i + 1)))`, + REPEAT GEN_TAC THEN + INTRO_TAC "positive rlt bound distinct terminal path" THEN + EXISTS_TAC + `\i. if i = 0 then (q:num->A)(k - 1) + else q(r + i - 1)` THEN + REPEAT CONJ_TAC THENL + [X_GEN_TAC `i:num` THEN DISCH_THEN(LABEL_TAC "ile") THEN + BETA_TAC THEN COND_CASES_TAC THENL + [USE_THEN "bound" MATCH_MP_TAC THEN ASM_ARITH_TAC; + USE_THEN "bound" MATCH_MP_TAC THEN ASM_ARITH_TAC]; + BETA_TAC THEN REWRITE_TAC[] THEN + SUBGOAL_THEN `~((k:num) - r = 0)` ASSUME_TAC THENL + [ASM_ARITH_TAC; + ASM_REWRITE_TAC[] THEN AP_TERM_TAC THEN ASM_ARITH_TAC]; + X_GEN_TAC `i:num` THEN + INTRO_TAC "ipos ilt" THEN + SUBGOAL_THEN `~((i:num) = 0)` ASSUME_TAC THENL + [ASM_ARITH_TAC; + BETA_TAC THEN ASM_REWRITE_TAC[] THEN + USE_THEN "distinct" MATCH_MP_TAC THEN ASM_ARITH_TAC]; + X_GEN_TAC `i:num` THEN DISCH_THEN(LABEL_TAC "ilt") THEN + BETA_TAC THEN ASM_CASES_TAC `(i:num) = 0` THENL + [FIRST_X_ASSUM SUBST_ALL_TAC THEN + ASM_REWRITE_TAC[ADD_CLAUSES; ARITH_RULE `~(1 = 0)`; + ARITH_RULE `r + 1 - 1 = r`] THEN + USE_THEN "terminal" ACCEPT_TAC; + ASM_REWRITE_TAC[ARITH_RULE `~(i + 1 = 0)`] THEN + SUBGOAL_THEN + `r + (i + 1) - 1 = (r + i - 1) + 1` + SUBST1_TAC THENL + [ASM_ARITH_TAC; + USE_THEN "path" MATCH_MP_TAC THEN ASM_ARITH_TAC]]]);; + +let FINITE_PATH_TERMINAL_EVEN_CYCLES = prove + (`!v e (q:num->A) m. + 0 < m /\ + (!i. i < 2 * m ==> v(q i)) /\ + (!i j. i < j /\ j < 2 * m ==> ~(q i = q j)) /\ + (!i. i < 2 * m ==> e (q i) (q(i + 1))) /\ + (!r. r < m ==> e (q(2 * m - 1)) (q(2 * r))) + ==> !s. 0 < s /\ s <= m + ==> ?u. + (!i. i <= 2 * s ==> v(u i)) /\ + u 0 = u(2 * s) /\ + (!i. 0 < i /\ i < 2 * s + ==> ~(u i = u 0)) /\ + (!i. i < 2 * s ==> e (u i) (u(i + 1)))`, + REPEAT GEN_TAC THEN + INTRO_TAC "positive bound distinct path terminal" THEN + X_GEN_TAC `s:num` THEN + INTRO_TAC "spos sle" THEN + MP_TAC(BETA_RULE(ISPECL + [`v:A->bool`; `e:A->A->bool`; `q:num->A`; `2 * (m:num)`; + `2 * (m - s)`] + PATH_TERMINAL_TAIL_CYCLE)) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [MATCH_MP_TAC(ARITH_RULE `0 < m ==> 0 < 2 * m`) THEN + USE_THEN "positive" ACCEPT_TAC; + MATCH_MP_TAC(ARITH_RULE + `0 < s /\ s <= m ==> 2 * (m - s) < 2 * m`) THEN + ASM_REWRITE_TAC[]; + USE_THEN "bound" ACCEPT_TAC; + USE_THEN "distinct" ACCEPT_TAC; + USE_THEN "terminal" MATCH_MP_TAC THEN + MATCH_MP_TAC(ARITH_RULE + `0 < s /\ s <= m ==> m - s < m`) THEN + ASM_REWRITE_TAC[]; + USE_THEN "path" ACCEPT_TAC]; + DISCH_THEN(X_CHOOSE_THEN `u:num->A` STRIP_ASSUME_TAC)] THEN + SUBGOAL_THEN `2 * m - 2 * (m - s) = 2 * s` + (LABEL_TAC "length") THENL + [MATCH_MP_TAC(ARITH_RULE + `s <= m ==> 2 * m - 2 * (m - s) = 2 * s`) THEN + USE_THEN "sle" ACCEPT_TAC; + ALL_TAC] THEN + EXISTS_TAC `u:num->A` THEN + USE_THEN "length" (fun th -> RULE_ASSUM_TAC(REWRITE_RULE[th])) THEN + ASM_REWRITE_TAC[]);; + +let FINITE_INJECTIVE_INDEX_BOUND = prove + (`!q (k:num) (n:num). + (!i. i < k ==> q i < n) /\ + (!i j. i < j /\ j < k ==> ~(q i = q j)) + ==> k <= n`, + REPEAT GEN_TAC THEN + INTRO_TAC "bound distinct" THEN + SUBGOAL_THEN + `CARD(IMAGE (q:num->num) {i | i < k}) = k` + (LABEL_TAC "imagecard") THENL + [TRANS_TAC EQ_TRANS `CARD {i:num | i < k}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC CARD_IMAGE_INJ THEN CONJ_TAC THENL + [REWRITE_TAC[IN_ELIM_THM] THEN + MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN + INTRO_TAC "ibound jbound same" THEN + ASM_CASES_TAC `(i:num) = j` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `(i:num) < j` THENL + [USE_THEN "distinct" (MP_TAC o SPECL [`i:num`; `j:num`]) THEN + ASM_MESON_TAC[]; + SUBGOAL_THEN `(j:num) < i` (LABEL_TAC "ji") THENL + [ASM_ARITH_TAC; + USE_THEN "distinct" (MP_TAC o SPECL [`j:num`; `i:num`]) THEN + ASM_MESON_TAC[]]]; + REWRITE_TAC[FINITE_NUMSEG_LT]]; + REWRITE_TAC[CARD_NUMSEG_LT]]; + ALL_TAC] THEN + SUBGOAL_THEN + `IMAGE (q:num->num) {i | i < k} SUBSET {j | j < n}` + (LABEL_TAC "subset") THENL + [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN + USE_THEN "bound" ACCEPT_TAC; + ALL_TAC] THEN + MP_TAC(ISPECL + [`IMAGE (q:num->num) {i | i < k}`; `{j:num | j < n}`] + CARD_SUBSET) THEN + ASM_REWRITE_TAC[FINITE_NUMSEG_LT; CARD_NUMSEG_LT]);; + +let FINITE_SIMPLE_CYCLE_LENGTH = prove + (`!q (k:num) (n:num). + 0 < k /\ + (!i. i < k ==> q i + 1 < n) /\ + (!i j. i < j /\ j < k ==> ~(q i = q j)) + ==> k < n`, + REPEAT GEN_TAC THEN + INTRO_TAC "positive bound distinct" THEN + MP_TAC(ISPECL + [`q:num->num`; `k:num`; `n - 1`] + FINITE_INJECTIVE_INDEX_BOUND) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [X_GEN_TAC `i:num` THEN DISCH_TAC THEN + USE_THEN "bound" (MP_TAC o SPEC `i:num`) THEN + ASM_ARITH_TAC; + USE_THEN "distinct" ACCEPT_TAC]; + ASM_ARITH_TAC]);; + +let FINITE_ODD_CYCLIC_SHORTEST_CYCLE = prove + (`!p n. + ODD n /\ + 2 < n /\ + (!i. i < n ==> p i < n /\ minimal_period p n i) + ==> ?k q. + 1 < k /\ + k < n /\ + (!r. r <= k ==> q r + 1 < n) /\ + q 0 = q k /\ + p(q 0 + 1) <= q 0 /\ + q 0 + 1 <= p(q 0) /\ + adjacent_interval_cover p (q 0) (q 0) /\ + (!r s. r < s /\ s < k ==> ~(q r = q s)) /\ + (!r s. r + 1 < s /\ s < k + ==> ~adjacent_interval_cover p (q r) (q s)) /\ + (!r. 0 < r /\ r + 1 < k + ==> ~adjacent_interval_cover p (q r) (q 0)) /\ + (!r. r < k + ==> adjacent_interval_cover p (q r) (q(SUC r)))`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MP_TAC(ISPECL [`p:num->num`; `n:num`] + FINITE_ODD_CYCLIC_RETURN_CYCLE) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[]; + DISCH_THEN(X_CHOOSE_THEN `l:num` + (X_CHOOSE_THEN `u:num->num` STRIP_ASSUME_TAC))] THEN + ABBREV_TAC `a = (u:num->num) 0` THEN + SUBGOAL_THEN + `(p:num->num)(a + 1) <= a /\ + a + 1 <= p a /\ + adjacent_interval_cover p a a` + (LABEL_TAC "originalbase") THENL + [ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MP_TAC(BETA_RULE(ISPECL + [`\i:num. i + 1 < n`; + `adjacent_interval_cover (p:num->num)`; + `\i:num. i = a`] + PATH_SHORTEST_SIMPLE_CYCLE)) THEN + ANTS_TAC THENL + [MAP_EVERY EXISTS_TAC [`l:num`; `u:num->num`] THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; + DISCH_THEN(X_CHOOSE_THEN `k:num` + (X_CHOOSE_THEN `q:num->num` STRIP_ASSUME_TAC))] THEN + SUBGOAL_THEN `(k:num) < n` (LABEL_TAC "short") THENL + [MATCH_MP_TAC(ISPECL + [`q:num->num`; `k:num`; `n:num`] + FINITE_SIMPLE_CYCLE_LENGTH) THEN + REPEAT CONJ_TAC THENL + [ASM_ARITH_TAC; + X_GEN_TAC `i:num` THEN DISCH_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN `(q:num->num) k = a` (LABEL_TAC "basevalue") THENL + [ASM_MESON_TAC[]; + ALL_TAC] THEN + MAP_EVERY EXISTS_TAC [`k:num`; `q:num->num`] THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Compact level sets and interval covering. *) +(* ------------------------------------------------------------------------- *) + +let REAL_COMPACT_LEVELSET = prove + (`!f s y. + real_compact s /\ f real_continuous_on s + ==> real_compact {x | x IN s /\ f x = y}`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[REAL_COMPACT_EQ_BOUNDED_CLOSED] THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_BOUNDED_SUBSET THEN + EXISTS_TAC `s:real->bool` THEN + ASM_SIMP_TAC[REAL_COMPACT_IMP_BOUNDED] THEN SET_TAC[]; + REWRITE_TAC[REAL_CLOSED] THEN + SUBGOAL_THEN + `IMAGE lift {x | x IN s /\ (f:real->real) x = y} = + {x | x IN IMAGE lift s /\ (lift o f o drop) x = lift y}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM; o_THM] THEN + MESON_TAC[LIFT_DROP]; + MATCH_MP_TAC CONTINUOUS_CLOSED_PREIMAGE_CONSTANT THEN + CONJ_TAC THENL + [REWRITE_TAC[ETA_AX] THEN + ASM_REWRITE_TAC[GSYM REAL_CONTINUOUS_ON]; + REWRITE_TAC[GSYM REAL_CLOSED] THEN + MATCH_MP_TAC REAL_COMPACT_IMP_CLOSED THEN ASM_REWRITE_TAC[]]]]);; + +let REAL_INTERVAL_ENDPOINTS_COVER = prove + (`!f a b c d. + a <= b /\ + c <= d /\ + f real_continuous_on real_interval[a,b] /\ + ((f a <= c /\ d <= f b) \/ (f b <= c /\ d <= f a)) + ==> real_interval[c,d] SUBSET IMAGE f (real_interval[a,b])`, + REPEAT GEN_TAC THEN + INTRO_TAC "ab cd continuous ends" THEN + REWRITE_TAC[SUBSET] THEN X_GEN_TAC `y:real` THEN + REWRITE_TAC[IN_REAL_INTERVAL; IN_IMAGE] THEN DISCH_TAC THEN + USE_THEN "ends" DISJ_CASES_TAC THENL + [MP_TAC(ISPECL [`f:real->real`; `a:real`; `b:real`; `y:real`] + REAL_IVT_INCREASING) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + ALL_TAC]; + MP_TAC(ISPECL [`f:real->real`; `a:real`; `b:real`; `y:real`] + REAL_IVT_DECREASING) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + ALL_TAC]] THEN + DISCH_THEN(X_CHOOSE_THEN `x:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_REAL_INTERVAL]) THEN + ASM_REWRITE_TAC[]);; + +let REAL_INTERVAL_ADJACENT_INTERSECTION = prove + (`!z n i j x. + (!r s. r < s /\ s < n ==> z r < z s) /\ + i + 1 < n /\ + j + 1 < n /\ + ~(i = j) /\ + x IN real_interval[z i,z(i + 1)] /\ + x IN real_interval[z j,z(j + 1)] + ==> (i + 1 = j /\ x = z j) \/ + (j + 1 = i /\ x = z i)`, + REPEAT GEN_TAC THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN + INTRO_TAC "ordered ibound jbound distinct left right" THEN + ASM_CASES_TAC `(i:num) < j` THENL + [DISJ1_TAC THEN ASM_CASES_TAC `(i:num) + 1 = j` THENL + [CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + RULE_ASSUM_TAC(REWRITE_RULE[ASSUME `(i:num) + 1 = j`]) THEN + ASM_REAL_ARITH_TAC]; + SUBGOAL_THEN `(z:num->real) (i + 1) < z j` ASSUME_TAC THENL + [USE_THEN "ordered" MATCH_MP_TAC THEN ASM_ARITH_TAC; + ASM_REAL_ARITH_TAC]]; + DISJ2_TAC THEN + SUBGOAL_THEN `(j:num) < i` ASSUME_TAC THENL + [ASM_ARITH_TAC; + ALL_TAC] THEN + ASM_CASES_TAC `(j:num) + 1 = i` THENL + [CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + RULE_ASSUM_TAC(REWRITE_RULE[ASSUME `(j:num) + 1 = i`]) THEN + ASM_REAL_ARITH_TAC]; + SUBGOAL_THEN `(z:num->real) (j + 1) < z i` ASSUME_TAC THENL + [USE_THEN "ordered" MATCH_MP_TAC THEN ASM_ARITH_TAC; + ASM_REAL_ARITH_TAC]]]);; + +let REAL_INTERVAL_ORDERED_COVER = prove + (`!f z p n i j. + f real_continuous_on (:real) /\ + (!r s. r < s /\ s < n ==> z r < z s) /\ + i + 1 < n /\ + j + 1 < n /\ + p i < n /\ + p(i + 1) < n /\ + f(z i) = z(p i) /\ + f(z(i + 1)) = z(p(i + 1)) /\ + adjacent_interval_cover p i j + ==> real_interval[z j,z(j + 1)] + SUBSET IMAGE f (real_interval[z i,z(i + 1)])`, + REPEAT GEN_TAC THEN + INTRO_TAC + ("continuous ordered ibound jbound pibound psibound " ^ + "fi fsi straddles") THEN + SUBGOAL_THEN + `!r s. r <= s /\ s < n ==> (z:num->real) r <= z s` + (LABEL_TAC "monotone") THENL + [MAP_EVERY X_GEN_TAC [`r:num`; `s:num`] THEN STRIP_TAC THEN + ASM_CASES_TAC `(r:num) = s` THEN ASM_REWRITE_TAC[REAL_LE_REFL] THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN + USE_THEN "ordered" (MATCH_MP_TAC o SPECL [`r:num`; `s:num`]) THEN + ASM_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC REAL_INTERVAL_ENDPOINTS_COVER THEN + REPEAT CONJ_TAC THENL + [USE_THEN "monotone" + (MATCH_MP_TAC o SPECL [`i:num`; `i + 1`]) THEN + ASM_ARITH_TAC; + USE_THEN "monotone" + (MATCH_MP_TAC o SPECL [`j:num`; `j + 1`]) THEN + ASM_ARITH_TAC; + MATCH_MP_TAC REAL_CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `(:real)` THEN ASM_REWRITE_TAC[SUBSET_UNIV]; + USE_THEN "straddles" + (DISJ_CASES_TAC o REWRITE_RULE[adjacent_interval_cover]) THENL + [DISJ1_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [USE_THEN "monotone" + (MATCH_MP_TAC o SPECL [`(p:num->num) i`; `j:num`]) THEN + ASM_ARITH_TAC; + USE_THEN "monotone" + (MATCH_MP_TAC o + SPECL [`j + 1`; `(p:num->num) (i + 1)`]) THEN + ASM_ARITH_TAC]; + DISJ2_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [USE_THEN "monotone" + (MATCH_MP_TAC o + SPECL [`(p:num->num) (i + 1)`; `j:num`]) THEN + ASM_ARITH_TAC; + USE_THEN "monotone" + (MATCH_MP_TAC o SPECL [`j + 1`; `(p:num->num) i`]) THEN + ASM_ARITH_TAC]]]);; + +let REAL_INTERVAL_CYCLIC_SELFCOVER = prove + (`!f z p n. + f real_continuous_on (:real) /\ + 1 < n /\ + (!i j. i < j /\ j < n ==> z i < z j) /\ + (!i. i < n + ==> p i < n /\ + minimal_period p n i /\ + f(z i) = z(p i)) + ==> ?i. + i + 1 < n /\ + real_interval[z i,z(i + 1)] + SUBSET IMAGE f (real_interval[z i,z(i + 1)])`, + REPEAT GEN_TAC THEN + INTRO_TAC "continuous nontrivial ordered cycle" THEN + MP_TAC(ISPECL [`p:num->num`; `n:num`] FINITE_CYCLIC_CROSSING) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [USE_THEN "nontrivial" ACCEPT_TAC; + X_GEN_TAC `i:num` THEN DISCH_TAC THEN + USE_THEN "cycle" (MP_TAC o SPEC `i:num`) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[]; + DISCH_THEN(fun th -> + ACCEPT_TAC(CONJ (CONJUNCT1 th) + (CONJUNCT1(CONJUNCT2 th))))]]; + DISCH_THEN(X_CHOOSE_THEN `i:num` STRIP_ASSUME_TAC)] THEN + SUBGOAL_THEN + `(p:num->num) i < n /\ + minimal_period p n i /\ + (f:real->real)((z:num->real) i) = z(p i)` + STRIP_ASSUME_TAC THENL + [USE_THEN "cycle" (MATCH_MP_TAC o SPEC `i:num`) THEN + MP_TAC(ASSUME `(i:num) + 1 < n`) THEN ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `(p:num->num) (i + 1) < n /\ + minimal_period p n (i + 1) /\ + (f:real->real)((z:num->real) (i + 1)) = z(p(i + 1))` + STRIP_ASSUME_TAC THENL + [USE_THEN "cycle" (MATCH_MP_TAC o SPEC `i + 1`) THEN + ACCEPT_TAC(ASSUME `(i:num) + 1 < n`); + ALL_TAC] THEN + EXISTS_TAC `i:num` THEN CONJ_TAC THENL + [ACCEPT_TAC(ASSUME `(i:num) + 1 < n`); + MATCH_MP_TAC(ISPECL + [`f:real->real`; `z:num->real`; `p:num->num`; + `n:num`; `i:num`; `i:num`] + REAL_INTERVAL_ORDERED_COVER) THEN + ASM_REWRITE_TAC[adjacent_interval_cover]]);; + +let REAL_INTERVAL_ENDPOINTS_SUBINTERVAL = prove + (`!f x y c d. + x < y /\ + c < d /\ + f real_continuous_on real_interval[x,y] /\ + f x = c /\ + f y = d + ==> ?u v. + x <= u /\ u <= v /\ v <= y /\ + IMAGE f (real_interval[u,v]) = real_interval[c,d]`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `real_compact + {z | z IN real_interval[x,y] /\ (f:real->real) z = c}` + ASSUME_TAC THENL + [MATCH_MP_TAC REAL_COMPACT_LEVELSET THEN + ASM_REWRITE_TAC[REAL_COMPACT_INTERVAL]; + ALL_TAC] THEN + MP_TAC(SPEC + `{z | z IN real_interval[x,y] /\ (f:real->real) z = c}` + REAL_COMPACT_ATTAINS_SUP) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + EXISTS_TAC `x:real` THEN + ASM_REWRITE_TAC[IN_ELIM_THM; IN_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + INTRO_TAC "@u. ulevel umax" THEN + SUBGOAL_THEN + `(f:real->real) real_continuous_on real_interval[u,y]` + ASSUME_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `real_interval[x,y]` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[SUBSET; IN_REAL_INTERVAL] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_ELIM_THM; IN_REAL_INTERVAL]) THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `real_compact + {z | z IN real_interval[u,y] /\ (f:real->real) z = d}` + ASSUME_TAC THENL + [MATCH_MP_TAC REAL_COMPACT_LEVELSET THEN + ASM_REWRITE_TAC[REAL_COMPACT_INTERVAL]; + ALL_TAC] THEN + MP_TAC(SPEC + `{z | z IN real_interval[u,y] /\ (f:real->real) z = d}` + REAL_COMPACT_ATTAINS_INF) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + EXISTS_TAC `y:real` THEN + ASM_REWRITE_TAC[IN_ELIM_THM; IN_REAL_INTERVAL] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_ELIM_THM; IN_REAL_INTERVAL]) THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + INTRO_TAC "@v. vlevel vmin" THEN + MAP_EVERY EXISTS_TAC [`u:real`; `v:real`] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_ELIM_THM; IN_REAL_INTERVAL]) THEN + REPEAT CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; + ASM_REAL_ARITH_TAC; + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `!z. z IN real_interval[u,v] + ==> c <= (f:real->real) z /\ f z <= d` + (LABEL_TAC "bounds") THENL + [X_GEN_TAC `z:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN + STRIP_TAC THEN CONJ_TAC THENL + [ASM_CASES_TAC `c <= (f:real->real) z` THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`f:real->real`; `z:real`; `v:real`; `c:real`] + REAL_IVT_INCREASING) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `real_interval[u,y]` THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[SUBSET; IN_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC; + ASM_REAL_ARITH_TAC; + ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `w:real` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `(x <= w /\ w <= y) /\ (f:real->real) w = c` + (LABEL_TAC "wlower") THENL + [RULE_ASSUM_TAC(REWRITE_RULE[IN_REAL_INTERVAL]) THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + USE_THEN "umax" (fun th -> + USE_THEN "wlower" + (MP_TAC o MATCH_MP (SPEC `w:real` th))) THEN + DISCH_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_REAL_INTERVAL]) THEN + SUBGOAL_THEN `z:real = u` SUBST_ALL_TAC THEN + ASM_REAL_ARITH_TAC; + ASM_CASES_TAC `(f:real->real) z <= d` THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`f:real->real`; `u:real`; `z:real`; `d:real`] + REAL_IVT_INCREASING) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `real_interval[u,y]` THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[SUBSET; IN_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC; + ASM_REAL_ARITH_TAC; + ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `w:real` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `(u <= w /\ w <= y) /\ (f:real->real) w = d` + (LABEL_TAC "wupper") THENL + [RULE_ASSUM_TAC(REWRITE_RULE[IN_REAL_INTERVAL]) THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + USE_THEN "vmin" (fun th -> + USE_THEN "wupper" + (MP_TAC o MATCH_MP (SPEC `w:real` th))) THEN + DISCH_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_REAL_INTERVAL]) THEN + SUBGOAL_THEN `z:real = v` SUBST_ALL_TAC THEN + ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_REAL_INTERVAL] THEN + X_GEN_TAC `z:real` THEN STRIP_TAC THEN + USE_THEN "bounds" (MATCH_MP_TAC o SPEC `z:real`) THEN + ASM_REWRITE_TAC[IN_REAL_INTERVAL]; + MATCH_MP_TAC IS_REALINTERVAL_CONTAINS_INTERVAL THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC IS_REALINTERVAL_CONTINUOUS_IMAGE THEN + ASM_REWRITE_TAC[IS_REALINTERVAL_INTERVAL] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `real_interval[u,y]` THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[SUBSET; IN_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `u:real` THEN + ASM_REWRITE_TAC[IN_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `v:real` THEN + ASM_REWRITE_TAC[IN_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC]]);; + +let REAL_INTERVAL_COVER_SUBINTERVAL = prove + (`!f a b c d. + a <= b /\ + c <= d /\ + f real_continuous_on real_interval[a,b] /\ + real_interval[c,d] SUBSET IMAGE f (real_interval[a,b]) + ==> ?u v. + u <= v /\ + real_interval[u,v] SUBSET real_interval[a,b] /\ + IMAGE f (real_interval[u,v]) = real_interval[c,d]`, + REPEAT GEN_TAC THEN + INTRO_TAC "ab cd continuous cover" THEN + ASM_CASES_TAC `c:real = d` THENL + [FIRST_X_ASSUM SUBST_ALL_TAC THEN + USE_THEN "cover" (MP_TAC o REWRITE_RULE[SUBSET]) THEN + DISCH_THEN(MP_TAC o SPEC `d:real`) THEN + ANTS_TAC THENL + [REWRITE_TAC[IN_REAL_INTERVAL] THEN REAL_ARITH_TAC; + REWRITE_TAC[IN_IMAGE]] THEN + DISCH_THEN(X_CHOOSE_THEN `x:real` STRIP_ASSUME_TAC) THEN + MAP_EVERY EXISTS_TAC [`x:real`; `x:real`] THEN + ASM_REWRITE_TAC[REAL_LE_REFL; REAL_INTERVAL_SING; + IMAGE_CLAUSES; SING_SUBSET]; + ALL_TAC] THEN + SUBGOAL_THEN `c < d` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `c IN IMAGE (f:real->real) (real_interval[a,b]) /\ + d IN IMAGE f (real_interval[a,b])` + MP_TAC THENL + [CONJ_TAC THEN USE_THEN "cover" + (MATCH_MP_TAC o REWRITE_RULE[SUBSET]) THEN + REWRITE_TAC[IN_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[IN_IMAGE]] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `x:real` STRIP_ASSUME_TAC) + (X_CHOOSE_THEN `y:real` STRIP_ASSUME_TAC)) THEN + SUBGOAL_THEN `~(x:real = y)` ASSUME_TAC THENL + [DISCH_THEN SUBST_ALL_TAC THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_CASES_TAC `x < y` THENL + [MP_TAC(ISPECL [`f:real->real`; `x:real`; `y:real`; + `c:real`; `d:real`] + REAL_INTERVAL_ENDPOINTS_SUBINTERVAL) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `real_interval[a,b]` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[SUBSET; IN_REAL_INTERVAL] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_REAL_INTERVAL]) THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `u:real` + (X_CHOOSE_THEN `v:real` STRIP_ASSUME_TAC)) THEN + MAP_EVERY EXISTS_TAC [`u:real`; `v:real`] THEN + REPEAT CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; + REWRITE_TAC[SUBSET; IN_REAL_INTERVAL] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_REAL_INTERVAL]) THEN + ASM_REAL_ARITH_TAC; + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN `y < x` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(ISPECL + [`\z:real. --((f:real->real) z)`; `y:real`; `x:real`; + `--d:real`; `--c:real`] + REAL_INTERVAL_ENDPOINTS_SUBINTERVAL) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[REAL_LT_NEG2] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_NEG THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `real_interval[a,b]` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[SUBSET; IN_REAL_INTERVAL] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_REAL_INTERVAL]) THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + INTRO_TAC "@u v. uv uy vy negimage" THEN + MAP_EVERY EXISTS_TAC [`u:real`; `v:real`] THEN + REPEAT CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; + REWRITE_TAC[SUBSET; IN_REAL_INTERVAL] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_REAL_INTERVAL]) THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `IMAGE (\z:real. --z) (real_interval[--d,--c]) = + real_interval[c,d]` + ASSUME_TAC THENL + [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_REAL_INTERVAL] THEN + X_GEN_TAC `z:real` THEN EQ_TAC THENL + [DISCH_THEN(X_CHOOSE_THEN `w:real` STRIP_ASSUME_TAC) THEN + ASM_REAL_ARITH_TAC; + STRIP_TAC THEN EXISTS_TAC `--(z:real)` THEN + REWRITE_TAC[REAL_NEG_NEG] THEN ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + USE_THEN "negimage" + (MP_TAC o AP_TERM `IMAGE (\z:real. --z)`) THEN + ASM_REWRITE_TAC[GSYM IMAGE_o; o_DEF; REAL_NEG_NEG; IMAGE_ID; + ETA_AX]);; + +(* ------------------------------------------------------------------------- *) +(* Fixed points obtained from interval covering. *) +(* ------------------------------------------------------------------------- *) + +let REAL_CONTINUOUS_ON_FIXPOINT = prove + (`!f s. + is_realinterval s /\ + f real_continuous_on s /\ + (?x. x IN s /\ f x <= x) /\ + (?y. y IN s /\ y <= f y) + ==> ?x. x IN s /\ f x = x`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `is_realinterval (IMAGE (\z. (f:real->real) z - z) s)` + ASSUME_TAC THENL + [MATCH_MP_TAC IS_REALINTERVAL_CONTINUOUS_IMAGE THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_SUB THEN + ASM_REWRITE_TAC[REAL_CONTINUOUS_ON_ID]; + ALL_TAC] THEN + SUBGOAL_THEN + `&0 IN real_interval[(f:real->real) x - x,f y - y]` + ASSUME_TAC THENL + [REWRITE_TAC[IN_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(ISPECL + [`IMAGE (\z. (f:real->real) z - z) s`; + `(f:real->real) x - x`; + `(f:real->real) y - y`] + IS_REALINTERVAL_CONTAINS_INTERVAL) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + REWRITE_TAC[IN_IMAGE] THEN + EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[IN_IMAGE] THEN + EXISTS_TAC `y:real` THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + DISCH_THEN(fun th -> + MP_TAC(SPEC `&0` (REWRITE_RULE[SUBSET] th))) THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[IN_IMAGE] THEN + DISCH_THEN(X_CHOOSE_THEN `z:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `z:real` THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC);; + +let REAL_INTERVAL_COVER_FIXPOINT = prove + (`!f a b. + a <= b /\ + f real_continuous_on real_interval[a,b] /\ + real_interval[a,b] SUBSET IMAGE f (real_interval[a,b]) + ==> ?x. x IN real_interval[a,b] /\ f x = x`, + REPEAT GEN_TAC THEN + INTRO_TAC "endpoints continuous cover" THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_FIXPOINT THEN + ASM_REWRITE_TAC[IS_REALINTERVAL_INTERVAL] THEN + CONJ_TAC THENL + [USE_THEN "cover" (MP_TAC o REWRITE_RULE[SUBSET]) THEN + DISCH_THEN(MP_TAC o SPEC `a:real`) THEN + ANTS_TAC THENL + [REWRITE_TAC[IN_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[IN_IMAGE] THEN + DISCH_THEN(X_CHOOSE_THEN `x:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `x:real` THEN + REWRITE_TAC[IN_REAL_INTERVAL] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_REAL_INTERVAL]) THEN + ASM_REAL_ARITH_TAC; + USE_THEN "cover" (MP_TAC o REWRITE_RULE[SUBSET]) THEN + DISCH_THEN(MP_TAC o SPEC `b:real`) THEN + ANTS_TAC THENL + [REWRITE_TAC[IN_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[IN_IMAGE] THEN + DISCH_THEN(X_CHOOSE_THEN `x:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `x:real` THEN + REWRITE_TAC[IN_REAL_INTERVAL] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_REAL_INTERVAL]) THEN + ASM_REAL_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Finite chains of interval coverings. *) +(* ------------------------------------------------------------------------- *) + +let REAL_CONTINUOUS_ON_ITER = prove + (`!f n s. + f real_continuous_on (:real) + ==> ITER n f real_continuous_on s`, + GEN_TAC THEN INDUCT_TAC THENL + [REPEAT STRIP_TAC THEN + REWRITE_TAC[ITER_POINTLESS; I_DEF; REAL_CONTINUOUS_ON_ID]; + POP_ASSUM(LABEL_TAC "IH") THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[ITER_ALT_POINTLESS] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `(:real)` THEN ASM_REWRITE_TAC[SUBSET_UNIV]; + USE_THEN "IH" (MATCH_MP_TAC o SPEC `IMAGE (f:real->real) s`) THEN + ASM_REWRITE_TAC[]]]);; + +let REAL_INTERVAL_COVER_CHAIN = prove + (`!f n a b. + f real_continuous_on (:real) /\ + (!i. i <= n ==> a i <= b i) /\ + (!i. i < n + ==> real_interval[a(SUC i),b(SUC i)] + SUBSET IMAGE f (real_interval[a i,b i])) + ==> ?u v. + u <= v /\ + real_interval[u,v] SUBSET real_interval[a 0,b 0] /\ + IMAGE (ITER n f) (real_interval[u,v]) = + real_interval[a n,b n] /\ + !i. i <= n + ==> IMAGE (ITER i f) (real_interval[u,v]) + SUBSET real_interval[a i,b i]`, + GEN_TAC THEN INDUCT_TAC THENL + [MAP_EVERY X_GEN_TAC [`a:num->real`; `b:num->real`] THEN + INTRO_TAC "continuous endpoints covers" THEN + MAP_EVERY EXISTS_TAC [`(a:num->real) 0`; `(b:num->real) 0`] THEN + REPEAT CONJ_TAC THENL + [USE_THEN "endpoints" (MATCH_MP_TAC o SPEC `0`) THEN ARITH_TAC; + REWRITE_TAC[SUBSET_REFL]; + REWRITE_TAC[ITER_POINTLESS; I_DEF; IMAGE_ID]; + X_GEN_TAC `i:num` THEN DISCH_TAC THEN + SUBGOAL_THEN `i = 0` SUBST_ALL_TAC THENL + [ASM_ARITH_TAC; + REWRITE_TAC[ITER_POINTLESS; I_DEF; IMAGE_ID; SUBSET_REFL]]]; + POP_ASSUM(LABEL_TAC "IH") THEN + MAP_EVERY X_GEN_TAC [`a:num->real`; `b:num->real`] THEN + INTRO_TAC "continuous endpoints covers"] THEN + USE_THEN "IH" (MP_TAC o SPECL + [`\i. (a:num->real) (SUC i)`; `\i. (b:num->real) (SUC i)`]) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [X_GEN_TAC `i:num` THEN DISCH_TAC THEN + USE_THEN "endpoints" (MATCH_MP_TAC o SPEC `SUC i`) THEN + ASM_ARITH_TAC; + X_GEN_TAC `i:num` THEN DISCH_TAC THEN + USE_THEN "covers" (MATCH_MP_TAC o SPEC `SUC i`) THEN + ASM_ARITH_TAC]; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o BETA_RULE) THEN + INTRO_TAC "@u v. uv tailinitial tail_exact tail_itinerary" THEN + MP_TAC(ISPECL [`f:real->real`; `(a:num->real) 0`; `(b:num->real) 0`; + `u:real`; `v:real`] + REAL_INTERVAL_COVER_SUBINTERVAL) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [USE_THEN "endpoints" (MATCH_MP_TAC o SPEC `0`) THEN ARITH_TAC; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `(:real)` THEN ASM_REWRITE_TAC[SUBSET_UNIV]; + MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `real_interval[(a:num->real) 1,(b:num->real) 1]` THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[ONE]; + USE_THEN "covers" (MP_TAC o SPEC `0`) THEN + DISCH_THEN(fun th -> + MP_TAC(MATCH_MP th (ARITH_RULE `0 < SUC n`))) THEN + SIMP_TAC[ONE]]]; + ALL_TAC] THEN + INTRO_TAC "@p q. pq firstinitial first_exact" THEN + MAP_EVERY EXISTS_TAC [`p:real`; `q:real`] THEN + REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + REWRITE_TAC[ITER_ALT_POINTLESS; IMAGE_o] THEN + ASM_REWRITE_TAC[]; + X_GEN_TAC `i:num` THEN DISCH_TAC THEN + ASM_CASES_TAC `i = 0` THENL + [ASM_REWRITE_TAC[ITER_POINTLESS; I_DEF; IMAGE_ID]; + MP_TAC(SPEC `i:num` num_CASES) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `j:num` SUBST_ALL_TAC) THEN + REWRITE_TAC[ITER_ALT_POINTLESS; IMAGE_o] THEN + ASM_REWRITE_TAC[] THEN + USE_THEN "tail_itinerary" (MATCH_MP_TAC o SPEC `j:num`) THEN + ASM_ARITH_TAC]]);; + +let REAL_INTERVAL_COVER_CYCLE = prove + (`!f n a b. + f real_continuous_on (:real) /\ + (!i. i <= n ==> a i <= b i) /\ + (!i. i < n + ==> real_interval[a(SUC i),b(SUC i)] + SUBSET IMAGE f (real_interval[a i,b i])) /\ + a n = a 0 /\ + b n = b 0 + ==> ?x. + x IN real_interval[a 0,b 0] /\ + ITER n f x = x /\ + !i. i <= n ==> ITER i f x IN real_interval[a i,b i]`, + REPEAT GEN_TAC THEN + INTRO_TAC "continuous endpoints covers closeda closedb" THEN + MP_TAC(ISPECL [`f:real->real`; `n:num`; + `a:num->real`; `b:num->real`] + REAL_INTERVAL_COVER_CHAIN) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[]; + ALL_TAC] THEN + INTRO_TAC "@u v. uv initial exact itinerary" THEN + SUBGOAL_THEN + `real_interval[u,v] SUBSET + IMAGE (ITER n (f:real->real)) (real_interval[u,v])` + ASSUME_TAC THENL + [MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `real_interval[(a:num->real) 0,(b:num->real) 0]` THEN + ASM_REWRITE_TAC[] THEN + USE_THEN "exact" (fun th -> REWRITE_TAC[th]) THEN + ASM_REWRITE_TAC[SUBSET_REFL]; + ALL_TAC] THEN + MP_TAC(ISPECL [`ITER n (f:real->real)`; `u:real`; `v:real`] + REAL_INTERVAL_COVER_FIXPOINT) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_ITER THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `x:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `x:real` THEN + REPEAT CONJ_TAC THENL + [USE_THEN "initial" (MATCH_MP_TAC o REWRITE_RULE[SUBSET]) THEN + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + X_GEN_TAC `i:num` THEN DISCH_TAC THEN + SUBGOAL_THEN + `IMAGE (ITER i (f:real->real)) (real_interval[u,v]) + SUBSET real_interval[(a:num->real) i,(b:num->real) i]` + ASSUME_TAC THENL + [USE_THEN "itinerary" (MATCH_MP_TAC o SPEC `i:num`) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[SUBSET]) THEN + REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `x:real` THEN + ASM_REWRITE_TAC[]]);; + +let REAL_INTERVAL_COVER_CYCLE_MINIMAL_PERIOD_GEN = prove + (`!f n a b. + f real_continuous_on (:real) /\ + 0 < n /\ + (!i. i <= n ==> a i <= b i) /\ + (!i. i < n + ==> real_interval[a(SUC i),b(SUC i)] + SUBSET IMAGE f (real_interval[a i,b i])) /\ + a n = a 0 /\ + b n = b 0 /\ + (!i x. + 0 < i /\ i < n /\ + x IN real_interval[a 0,b 0] /\ + x IN real_interval[a i,b i] + ==> ~(ITER i f x = x)) + ==> ?x. + minimal_period f n x /\ + !i. i <= n ==> ITER i f x IN real_interval[a i,b i]`, + REPEAT GEN_TAC THEN + INTRO_TAC + "continuous positive endpoints covers closeda closedb separated" THEN + MP_TAC(ISPECL [`f:real->real`; `n:num`; + `a:num->real`; `b:num->real`] + REAL_INTERVAL_COVER_CYCLE) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[]; + ALL_TAC] THEN + INTRO_TAC "@x. initial periodn itinerary" THEN + MP_TAC(ISPECL [`f:real->real`; `x:real`; `n:num`] + PERIODIC_POINT_IMP_MINIMAL_PERIOD) THEN + ASM_REWRITE_TAC[periodic_point] THEN + INTRO_TAC "@d. divides minimal" THEN + SUBGOAL_THEN `(d:num) <= (n:num)` ASSUME_TAC THENL + [USE_THEN "divides" (MP_TAC o MATCH_MP DIVIDES_LE) THEN + ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `(d:num) = (n:num)` SUBST_ALL_TAC THENL + [ASM_CASES_TAC `(d:num) = (n:num)` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `0 < (d:num)` ASSUME_TAC THENL + [USE_THEN "minimal" (MP_TAC o MATCH_MP MINIMAL_PERIOD_POS) THEN + ARITH_TAC; + ALL_TAC] THEN + USE_THEN "minimal" + (MP_TAC o REWRITE_RULE[periodic_point] o + MATCH_MP MINIMAL_PERIOD_PERIODIC) THEN + DISCH_THEN(LABEL_TAC "periodd") THEN + SUBGOAL_THEN + `ITER d (f:real->real) x IN real_interval[(a:num->real) d,b d]` + (LABEL_TAC "visit") THENL + [USE_THEN "itinerary" (MATCH_MP_TAC o SPEC `d:num`) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `x IN real_interval[(a:num->real) d,b d]` + (LABEL_TAC "return") THENL + [USE_THEN "periodd" (fun th -> + USE_THEN "visit" (ACCEPT_TAC o REWRITE_RULE[th])); + ALL_TAC] THEN + SUBGOAL_THEN + `0 < (d:num) /\ d < n /\ + x IN real_interval[(a:num->real) 0,b 0] /\ + x IN real_interval[a d,b d]` + (LABEL_TAC "earlyconditions") THENL + [REPEAT CONJ_TAC THENL + [ASM_ARITH_TAC; + ASM_ARITH_TAC; + USE_THEN "initial" ACCEPT_TAC; + USE_THEN "return" ACCEPT_TAC]; + ALL_TAC] THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + EXISTS_TAC `x:real` THEN ASM_REWRITE_TAC[]);; + +let REAL_INTERVAL_ORDERED_FIRST_RETURN_CYCLE = prove + (`!f z p n k q. + f real_continuous_on (:real) /\ + (!i j. i < j /\ j < n ==> z i < z j) /\ + (!i. i < n ==> p i < n /\ f(z i) = z(p i)) /\ + (!i. i < n ==> minimal_period f n (z i)) /\ + 0 < k /\ + k < n /\ + (!r. r <= k ==> q r + 1 < n) /\ + q 0 = q k /\ + (!r. 0 < r /\ r < k ==> ~(q r = q 0)) /\ + (!r. r < k + ==> adjacent_interval_cover p (q r) (q(SUC r))) + ==> ?x. minimal_period f k x`, + REPEAT GEN_TAC THEN + INTRO_TAC + ("continuous ordered transition oldminimal positive short " ^ + "bound closed first covers") THEN + MP_TAC(BETA_RULE(ISPECL + [`f:real->real`; `k:num`; + `\i:num. (z:num->real)((q:num->num) i)`; + `\i:num. (z:num->real)((q:num->num) i + 1)`] + REAL_INTERVAL_COVER_CYCLE_MINIMAL_PERIOD_GEN)) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [USE_THEN "continuous" ACCEPT_TAC; + USE_THEN "positive" ACCEPT_TAC; + X_GEN_TAC `i:num` THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN + USE_THEN "ordered" MATCH_MP_TAC THEN CONJ_TAC THENL + [ARITH_TAC; + USE_THEN "bound" (MP_TAC o SPEC `i:num`) THEN + ASM_ARITH_TAC]; + X_GEN_TAC `i:num` THEN DISCH_TAC THEN + SUBGOAL_THEN + `((p:num->num) ((q:num->num) (i:num)) < n /\ + (f:real->real)(z(q i)) = z(p(q i))) /\ + (p(q i + 1) < n /\ f(z(q i + 1)) = z(p(q i + 1)))` + STRIP_ASSUME_TAC THENL + [CONJ_TAC THENL + [USE_THEN "transition" MATCH_MP_TAC THEN + USE_THEN "bound" (MP_TAC o SPEC `i:num`) THEN + ASM_ARITH_TAC; + USE_THEN "transition" MATCH_MP_TAC THEN + USE_THEN "bound" (MP_TAC o SPEC `i:num`) THEN + ASM_ARITH_TAC]; + ALL_TAC] THEN + MATCH_MP_TAC(ISPECL + [`f:real->real`; `z:num->real`; `p:num->num`; `n:num`; + `(q:num->num) i`; `(q:num->num)(SUC i)`] + REAL_INTERVAL_ORDERED_COVER) THEN + REPEAT CONJ_TAC THENL + [USE_THEN "continuous" ACCEPT_TAC; + USE_THEN "ordered" ACCEPT_TAC; + USE_THEN "bound" (MP_TAC o SPEC `i:num`) THEN + ASM_ARITH_TAC; + USE_THEN "bound" (MP_TAC o SPEC `SUC i`) THEN + ASM_ARITH_TAC; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + USE_THEN "covers" MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]; + USE_THEN "closed" (fun th -> REWRITE_TAC[th]); + USE_THEN "closed" (fun th -> REWRITE_TAC[th]); + MAP_EVERY X_GEN_TAC [`i:num`; `x:real`] THEN + INTRO_TAC "ipos ik left right" THEN + SUBGOAL_THEN + `?h. h < n /\ x = (z:num->real) h` + (DESTRUCT_TAC "@h. hbound endpoint") THENL + [MP_TAC(ISPECL + [`z:num->real`; `n:num`; `(q:num->num) 0`; + `(q:num->num) i`; `x:real`] + REAL_INTERVAL_ADJACENT_INTERSECTION) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [USE_THEN "ordered" ACCEPT_TAC; + USE_THEN "bound" (MP_TAC o SPEC `0`) THEN ASM_ARITH_TAC; + USE_THEN "bound" (MP_TAC o SPEC `i:num`) THEN + ASM_ARITH_TAC; + DISCH_THEN(LABEL_TAC "same") THEN ASM_MESON_TAC[]; + USE_THEN "left" ACCEPT_TAC; + USE_THEN "right" ACCEPT_TAC]; + DISCH_THEN(DISJ_CASES_THEN STRIP_ASSUME_TAC) THENL + [EXISTS_TAC `(q:num->num) i` THEN CONJ_TAC THENL + [USE_THEN "bound" (MP_TAC o SPEC `i:num`) THEN + ASM_ARITH_TAC; + ACCEPT_TAC + (ASSUME `x = (z:num->real)((q:num->num) i)`)]; + EXISTS_TAC `(q:num->num) 0` THEN CONJ_TAC THENL + [USE_THEN "bound" (MP_TAC o SPEC `0`) THEN + ASM_ARITH_TAC; + ACCEPT_TAC + (ASSUME `x = (z:num->real)((q:num->num) 0)`)]]]; + ALL_TAC] THEN + SUBGOAL_THEN `minimal_period (f:real->real) n x` + (LABEL_TAC "oldperiod") THENL + [USE_THEN "endpoint" (fun th -> REWRITE_TAC[th]) THEN + USE_THEN "oldminimal" MATCH_MP_TAC THEN + USE_THEN "hbound" ACCEPT_TAC; + ALL_TAC] THEN + DISCH_THEN(LABEL_TAC "earlyreturn") THEN + MP_TAC(ISPECL [`f:real->real`; `n:num`; `x:real`; `i:num`] + MINIMAL_PERIOD_DIVIDES) THEN + ASM_REWRITE_TAC[periodic_point] THEN + DISCH_THEN(MP_TAC o MATCH_MP DIVIDES_LE) THEN + ASM_ARITH_TAC]; + INTRO_TAC "@x. minimal itinerary" THEN + EXISTS_TAC `x:real` THEN USE_THEN "minimal" ACCEPT_TAC]);; + +let REAL_INTERVAL_ORDERED_FIRST_RETURN_CYCLE_NONMULTIPLE = prove + (`!f z p n k q. + f real_continuous_on (:real) /\ + (!i j. i < j /\ j < n ==> z i < z j) /\ + (!i. i < n ==> p i < n /\ f(z i) = z(p i)) /\ + (!i. i < n ==> minimal_period f n (z i)) /\ + 0 < k /\ + ~(n divides k) /\ + (!r. r <= k ==> q r + 1 < n) /\ + q 0 = q k /\ + (!r. 0 < r /\ r < k ==> ~(q r = q 0)) /\ + (!r. r < k + ==> adjacent_interval_cover p (q r) (q(SUC r))) + ==> ?x. minimal_period f k x`, + REPEAT GEN_TAC THEN + INTRO_TAC + ("continuous ordered transition oldminimal positive " ^ + "nonmultiple bound closed first covers") THEN + MP_TAC(BETA_RULE(ISPECL + [`f:real->real`; `k:num`; + `\i:num. (z:num->real)((q:num->num) i)`; + `\i:num. (z:num->real)((q:num->num) i + 1)`] + REAL_INTERVAL_COVER_CYCLE)) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [USE_THEN "continuous" ACCEPT_TAC; + X_GEN_TAC `i:num` THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN + USE_THEN "ordered" MATCH_MP_TAC THEN CONJ_TAC THENL + [ARITH_TAC; + USE_THEN "bound" (MP_TAC o SPEC `i:num`) THEN + ASM_ARITH_TAC]; + X_GEN_TAC `i:num` THEN DISCH_TAC THEN + SUBGOAL_THEN + `((p:num->num) ((q:num->num) (i:num)) < n /\ + (f:real->real)(z(q i)) = z(p(q i))) /\ + (p(q i + 1) < n /\ f(z(q i + 1)) = z(p(q i + 1)))` + STRIP_ASSUME_TAC THENL + [CONJ_TAC THENL + [USE_THEN "transition" MATCH_MP_TAC THEN + USE_THEN "bound" (MP_TAC o SPEC `i:num`) THEN + ASM_ARITH_TAC; + USE_THEN "transition" MATCH_MP_TAC THEN + USE_THEN "bound" (MP_TAC o SPEC `i:num`) THEN + ASM_ARITH_TAC]; + ALL_TAC] THEN + MATCH_MP_TAC(ISPECL + [`f:real->real`; `z:num->real`; `p:num->num`; `n:num`; + `(q:num->num) i`; `(q:num->num)(SUC i)`] + REAL_INTERVAL_ORDERED_COVER) THEN + REPEAT CONJ_TAC THENL + [USE_THEN "continuous" ACCEPT_TAC; + USE_THEN "ordered" ACCEPT_TAC; + USE_THEN "bound" (MP_TAC o SPEC `i:num`) THEN + ASM_ARITH_TAC; + USE_THEN "bound" (MP_TAC o SPEC `SUC i`) THEN + ASM_ARITH_TAC; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + USE_THEN "covers" MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]; + USE_THEN "closed" (fun th -> REWRITE_TAC[th]); + USE_THEN "closed" (fun th -> REWRITE_TAC[th])]; + INTRO_TAC "@x. initial periodk itinerary"] THEN + MP_TAC(ISPECL [`f:real->real`; `x:real`; `k:num`] + PERIODIC_POINT_IMP_MINIMAL_PERIOD) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[periodic_point]; + INTRO_TAC "@d. divides minimal"] THEN + SUBGOAL_THEN `(d:num) <= k` ASSUME_TAC THENL + [USE_THEN "divides" (MP_TAC o MATCH_MP DIVIDES_LE) THEN + ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `(d:num) = k` SUBST_ALL_TAC THENL + [ASM_CASES_TAC `(d:num) = k` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `0 < (d:num) /\ d < k` + STRIP_ASSUME_TAC THENL + [CONJ_TAC THENL + [USE_THEN "minimal" (MP_TAC o MATCH_MP MINIMAL_PERIOD_POS) THEN + ARITH_TAC; + ASM_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN `ITER d (f:real->real) x = x` + (LABEL_TAC "periodd") THENL + [USE_THEN "minimal" + (ACCEPT_TAC o REWRITE_RULE[periodic_point] o + MATCH_MP MINIMAL_PERIOD_PERIODIC); + ALL_TAC] THEN + SUBGOAL_THEN + `ITER d (f:real->real) x IN + real_interval[(z:num->real)((q:num->num) d),z(q d + 1)]` + (LABEL_TAC "visit") THENL + [USE_THEN "itinerary" (MATCH_MP_TAC o SPEC `d:num`) THEN + ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `x IN + real_interval[(z:num->real)((q:num->num) d),z(q d + 1)]` + (LABEL_TAC "return") THENL + [USE_THEN "periodd" (fun th -> + USE_THEN "visit" (ACCEPT_TAC o REWRITE_RULE[th])); + ALL_TAC] THEN + SUBGOAL_THEN `?h. h < n /\ x = (z:num->real) h` + (DESTRUCT_TAC "@h. hbound endpoint") THENL + [MP_TAC(ISPECL + [`z:num->real`; `n:num`; `(q:num->num) 0`; + `(q:num->num) d`; `x:real`] + REAL_INTERVAL_ADJACENT_INTERSECTION) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [USE_THEN "ordered" ACCEPT_TAC; + USE_THEN "bound" (MP_TAC o SPEC `0`) THEN ASM_ARITH_TAC; + USE_THEN "bound" (MP_TAC o SPEC `d:num`) THEN + ASM_ARITH_TAC; + DISCH_THEN(LABEL_TAC "same") THEN ASM_MESON_TAC[]; + ASM_REWRITE_TAC[ADD_CLAUSES]; + ASM_REWRITE_TAC[ADD_CLAUSES]]; + DISCH_THEN(DISJ_CASES_THEN STRIP_ASSUME_TAC) THENL + [EXISTS_TAC `(q:num->num) d` THEN CONJ_TAC THENL + [USE_THEN "bound" (MP_TAC o SPEC `d:num`) THEN + ASM_ARITH_TAC; + ASM_REWRITE_TAC[]]; + EXISTS_TAC `(q:num->num) 0` THEN CONJ_TAC THENL + [USE_THEN "bound" (MP_TAC o SPEC `0`) THEN + ASM_ARITH_TAC; + ASM_REWRITE_TAC[]]]]; + ALL_TAC] THEN + SUBGOAL_THEN `minimal_period (f:real->real) n x` + (LABEL_TAC "oldperiod") THENL + [USE_THEN "endpoint" (fun th -> REWRITE_TAC[th]) THEN + USE_THEN "oldminimal" MATCH_MP_TAC THEN + USE_THEN "hbound" ACCEPT_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `(d:num) = n` (LABEL_TAC "deqn") THENL + [MATCH_MP_TAC(ISPECL + [`f:real->real`; `d:num`; `n:num`; `x:real`] + MINIMAL_PERIOD_UNIQUE) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + EXISTS_TAC `x:real` THEN + USE_THEN "minimal" ACCEPT_TAC);; + +let REAL_INTERVAL_ORDERED_SIMPLE_CYCLE = prove + (`!f z p n k q. + f real_continuous_on (:real) /\ + (!i j. i < j /\ j < n ==> z i < z j) /\ + (!i. i < n ==> p i < n /\ f(z i) = z(p i)) /\ + (!i. i < n ==> minimal_period f n (z i)) /\ + 0 < k /\ + k < n /\ + (!r. r <= k ==> q r + 1 < n) /\ + q 0 = q k /\ + (!r s. r < s /\ s < k ==> ~(q r = q s)) /\ + (!r. r < k + ==> adjacent_interval_cover p (q r) (q(SUC r))) + ==> ?x. minimal_period f k x`, + REPEAT GEN_TAC THEN + INTRO_TAC + ("continuous ordered transition oldminimal positive short " ^ + "bound closed distinct covers") THEN + MATCH_MP_TAC(ISPECL + [`f:real->real`; `z:num->real`; `p:num->num`; `n:num`; + `k:num`; `q:num->num`] + REAL_INTERVAL_ORDERED_FIRST_RETURN_CYCLE) THEN + REPEAT CONJ_TAC THENL + [USE_THEN "continuous" ACCEPT_TAC; + USE_THEN "ordered" ACCEPT_TAC; + USE_THEN "transition" ACCEPT_TAC; + USE_THEN "oldminimal" ACCEPT_TAC; + USE_THEN "positive" ACCEPT_TAC; + USE_THEN "short" ACCEPT_TAC; + USE_THEN "bound" ACCEPT_TAC; + USE_THEN "closed" ACCEPT_TAC; + X_GEN_TAC `i:num` THEN + INTRO_TAC "ipos ik" THEN + DISCH_THEN(LABEL_TAC "same") THEN + USE_THEN "distinct" (MP_TAC o SPECL [`0`; `i:num`]) THEN + ASM_MESON_TAC[]; + USE_THEN "covers" ACCEPT_TAC]);; + +let REAL_INTERVAL_COVER_CYCLE_MINIMAL_PERIOD = prove + (`!f n a b. + f real_continuous_on (:real) /\ + 0 < n /\ + (!i. i <= n ==> a i <= b i) /\ + (!i. i < n + ==> real_interval[a(SUC i),b(SUC i)] + SUBSET IMAGE f (real_interval[a i,b i])) /\ + a n = a 0 /\ + b n = b 0 /\ + (!i. 0 < i /\ i < n + ==> DISJOINT (real_interval[a 0,b 0]) + (real_interval[a i,b i])) + ==> ?x. + minimal_period f n x /\ + !i. i <= n ==> ITER i f x IN real_interval[a i,b i]`, + REPEAT GEN_TAC THEN + INTRO_TAC + ("continuous positive endpoints covers closedleft closedright " ^ + "separated") THEN + MATCH_MP_TAC REAL_INTERVAL_COVER_CYCLE_MINIMAL_PERIOD_GEN THEN + ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC [`i:num`; `x:real`] THEN + INTRO_TAC "ipos ilt left right" THEN + SUBGOAL_THEN + `DISJOINT (real_interval[(a:num->real) 0,b 0]) + (real_interval[a i,b i])` + (LABEL_TAC "apart") THENL + [USE_THEN "separated" (MATCH_MP_TAC o SPEC `i:num`) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + USE_THEN "apart" (MP_TAC o MATCH_MP + (SET_RULE + `DISJOINT (s:real->bool) t + ==> ~((x:real) IN s /\ x IN t)`)) THEN + ASM_REWRITE_TAC[]);; + +let ODD_PERIOD_ORDERED_SIMPLE_CYCLE = prove + (`!f n. + ODD n /\ + 2 < n /\ + has_period f n + ==> ?z p k q. + (!i j. i < j /\ j < n ==> z i < z j) /\ + (!i. i < n ==> p i < n /\ f(z i) = z(p i)) /\ + (!i. i < n ==> minimal_period f n (z i)) /\ + (!i. i < n + ==> p i < n /\ minimal_period p n i) /\ + 1 < k /\ + k < n /\ + (!r. r <= k ==> q r + 1 < n) /\ + q 0 = q k /\ + p(q 0 + 1) <= q 0 /\ + q 0 + 1 <= p(q 0) /\ + adjacent_interval_cover p (q 0) (q 0) /\ + (!r s. r < s /\ s < k ==> ~(q r = q s)) /\ + (!r s. r + 1 < s /\ s < k + ==> ~adjacent_interval_cover p (q r) (q s)) /\ + (!r. 0 < r /\ r + 1 < k + ==> ~adjacent_interval_cover p (q r) (q 0)) /\ + (!r. r < k + ==> adjacent_interval_cover p (q r) (q(SUC r)))`, + REPEAT GEN_TAC THEN REWRITE_TAC[has_period] THEN + INTRO_TAC "odd nontrivial @x. minimal" THEN + MP_TAC(MATCH_MP + (ISPECL [`f:real->real`; `n:num`; `x:real`] + MINIMAL_PERIOD_ORDERED_ORBIT) + (ASSUME `minimal_period (f:real->real) n x`)) THEN + INTRO_TAC "@z. ordered enum" THEN + MP_TAC(ISPECL + [`f:real->real`; `n:num`; `x:real`; `z:num->real`] + MINIMAL_PERIOD_ORDERED_ORBIT_TRANSITION) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[]; + INTRO_TAC "@p. transition"] THEN + SUBGOAL_THEN + `!i. i < n ==> minimal_period (p:num->num) n i` + (LABEL_TAC "pminimal") THENL + [MATCH_MP_TAC(ISPECL + [`f:real->real`; `n:num`; `x:real`; `z:num->real`; + `p:num->num`] + MINIMAL_PERIOD_ORDERED_ORBIT_TRANSITION_MINIMAL) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `!i. i < n + ==> (p:num->num) i < n /\ minimal_period p n i` + (LABEL_TAC "cycle") THENL + [X_GEN_TAC `i:num` THEN DISCH_TAC THEN CONJ_TAC THENL + [USE_THEN "transition" (MP_TAC o SPEC `i:num`) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; SIMP_TAC[]]; + USE_THEN "pminimal" MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN + `!i. i < n + ==> minimal_period (f:real->real) n ((z:num->real) i)` + (LABEL_TAC "oldminimal") THENL + [X_GEN_TAC `i:num` THEN DISCH_TAC THEN + MATCH_MP_TAC(ISPECL + [`f:real->real`; `n:num`; `x:real`; `(z:num->real) i`] + MINIMAL_PERIOD_ORBIT_MINIMAL) THEN + CONJ_TAC THENL + [USE_THEN "minimal" ACCEPT_TAC; + USE_THEN "enum" (fun th -> REWRITE_TAC[GSYM th]) THEN + REWRITE_TAC[IN_IMAGE; IN_ELIM_THM] THEN + EXISTS_TAC `i:num` THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + MP_TAC(ISPECL [`p:num->num`; `n:num`] + FINITE_ODD_CYCLIC_SHORTEST_CYCLE) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[]; + INTRO_TAC + ("@k q. length short pathbound closed lower upper self " ^ + "distinct chordless nobase path")] THEN + MAP_EVERY EXISTS_TAC + [`z:num->real`; `p:num->num`; `k:num`; `q:num->num`] THEN + ASM_REWRITE_TAC[]);; + +let ODD_PERIOD_IMP_LARGER_NONMULTIPLE_PERIOD = prove + (`!f n m. + f real_continuous_on (:real) /\ + ODD n /\ + 2 < n /\ + has_period f n /\ + n < m /\ + ~(n divides m) + ==> has_period f m`, + REPEAT GEN_TAC THEN + INTRO_TAC "continuous odd nontrivial period larger nonmultiple" THEN + MP_TAC(ISPECL [`f:real->real`; `n:num`] + ODD_PERIOD_ORDERED_SIMPLE_CYCLE) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[]; + INTRO_TAC + ("@z p k q. ordered transition oldminimal pcycle length short " ^ + "pathbound closed lower upper self distinct chordless nobase path")] THEN + SUBGOAL_THEN `(k:num) < m` (LABEL_TAC "klt") THENL + [ASM_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(BETA_RULE(ISPECL + [`\i:num. i + 1 < n`; + `adjacent_interval_cover (p:num->num)`; + `k:num`; `q:num->num`; `m - k:num`] + PATH_SIMPLE_CYCLE_WAITS)) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; + DISCH_THEN(X_CHOOSE_THEN `r:num->num` STRIP_ASSUME_TAC)] THEN + SUBGOAL_THEN `(k:num) + (m - k) = m` + (LABEL_TAC "target") THENL + [ASM_ARITH_TAC; + ALL_TAC] THEN + USE_THEN "target" (fun th -> + RULE_ASSUM_TAC(REWRITE_RULE[th])) THEN + MP_TAC(ISPECL + [`f:real->real`; `z:num->real`; `p:num->num`; `n:num`; + `m:num`; `r:num->num`] + REAL_INTERVAL_ORDERED_FIRST_RETURN_CYCLE_NONMULTIPLE) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [USE_THEN "continuous" ACCEPT_TAC; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + ASM_ARITH_TAC; + USE_THEN "nonmultiple" ACCEPT_TAC; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]]; + INTRO_TAC "@x. minimal"] THEN + REWRITE_TAC[has_period] THEN + EXISTS_TAC `x:real` THEN + USE_THEN "minimal" ACCEPT_TAC);; + +let ODD_PERIOD_IMP_LARGER_PERIOD = prove + (`!f n m. + f real_continuous_on (:real) /\ + ODD n /\ + 2 < n /\ + has_period f n /\ + n < m + ==> has_period f m`, + REPEAT GEN_TAC THEN + INTRO_TAC "continuous odd nontrivial period larger" THEN + ASM_CASES_TAC `(n:num) divides m` THENL + [ALL_TAC; + MATCH_MP_TAC(ISPECL + [`f:real->real`; `n:num`; `m:num`] + ODD_PERIOD_IMP_LARGER_NONMULTIPLE_PERIOD) THEN + ASM_REWRITE_TAC[]] THEN + SUBGOAL_THEN `2 * (n:num) <= m` + (LABEL_TAC "double") THENL + [MP_TAC(ISPECL [`m:num`; `n:num`] DIVIDES_CASES) THEN + ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + ASM_CASES_TAC `EVEN m` THENL + [SUBGOAL_THEN `ODD(m - 1)` (LABEL_TAC "nearodd") THENL + [ASM_REWRITE_TAC[ODD_SUB; GSYM NOT_EVEN; ODD] THEN + ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `~((n:num) divides (m - 1))` + (LABEL_TAC "oldnonmultiple") THENL + [MATCH_MP_TAC(ISPECL [`n:num`; `m:num`; `1`] + DIVIDES_NOT_SUB) THEN + ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `~((m - 1) divides (m:num))` + (LABEL_TAC "newnonmultiple") THENL + [MATCH_MP_TAC(ISPECL [`m:num`; `1`] SUB_NOT_DIVIDES) THEN + ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `has_period (f:real->real) (m - 1)` + (LABEL_TAC "nearperiod") THENL + [MATCH_MP_TAC(ISPECL + [`f:real->real`; `n:num`; `m - 1:num`] + ODD_PERIOD_IMP_LARGER_NONMULTIPLE_PERIOD) THEN + ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(ISPECL + [`f:real->real`; `m - 1:num`; `m:num`] + ODD_PERIOD_IMP_LARGER_NONMULTIPLE_PERIOD) THEN + ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; + SUBGOAL_THEN `ODD m` (LABEL_TAC "modd") THENL + [ASM_REWRITE_TAC[GSYM NOT_EVEN]; + ALL_TAC] THEN + SUBGOAL_THEN `ODD(m - 2)` (LABEL_TAC "nearodd") THENL + [ASM_REWRITE_TAC[ODD_SUB; ODD] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `~((n:num) divides (m - 2))` + (LABEL_TAC "oldnonmultiple") THENL + [MATCH_MP_TAC(ISPECL [`n:num`; `m:num`; `2`] + DIVIDES_NOT_SUB) THEN + ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `~((m - 2) divides (m:num))` + (LABEL_TAC "newnonmultiple") THENL + [MATCH_MP_TAC(ISPECL [`m:num`; `2`] SUB_NOT_DIVIDES) THEN + ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `has_period (f:real->real) (m - 2)` + (LABEL_TAC "nearperiod") THENL + [MATCH_MP_TAC(ISPECL + [`f:real->real`; `n:num`; `m - 2:num`] + ODD_PERIOD_IMP_LARGER_NONMULTIPLE_PERIOD) THEN + ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(ISPECL + [`f:real->real`; `m - 2:num`; `m:num`] + ODD_PERIOD_IMP_LARGER_NONMULTIPLE_PERIOD) THEN + ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC]);; + +let LEAST_ODD_PERIOD_ORDERED_CYCLE = prove + (`!f n. + f real_continuous_on (:real) /\ + ODD n /\ + 2 < n /\ + has_period f n /\ + (!m. ODD m /\ 1 < m /\ m < n ==> ~has_period f m) + ==> ?z p q. + (!i j. i < j /\ j < n ==> z i < z j) /\ + (!i. i < n ==> p i < n /\ f(z i) = z(p i)) /\ + (!i. i < n ==> minimal_period f n (z i)) /\ + (!i. i < n + ==> p i < n /\ minimal_period p n i) /\ + (!r. r <= n - 1 ==> q r + 1 < n) /\ + q 0 = q(n - 1) /\ + p(q 0 + 1) <= q 0 /\ + q 0 + 1 <= p(q 0) /\ + adjacent_interval_cover p (q 0) (q 0) /\ + (!r s. r < s /\ s < n - 1 ==> ~(q r = q s)) /\ + (!r s. r + 1 < s /\ s < n - 1 + ==> ~adjacent_interval_cover p (q r) (q s)) /\ + (!r. 0 < r /\ r + 1 < n - 1 + ==> ~adjacent_interval_cover p (q r) (q 0)) /\ + (!r. r < n - 1 + ==> adjacent_interval_cover p (q r) (q(SUC r)))`, + REPEAT GEN_TAC THEN + INTRO_TAC "continuous odd nontrivial period least" THEN + MP_TAC(ISPECL [`f:real->real`; `n:num`] + ODD_PERIOD_ORDERED_SIMPLE_CYCLE) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[]; + INTRO_TAC + ("@z p k q. ordered transition oldminimal pcycle length short " ^ + "pathbound closed lower upper self distinct chordless nobase path")] THEN + MP_TAC(ISPECL + [`f:real->real`; `z:num->real`; `p:num->num`; `n:num`; + `k:num`; `q:num->num`] + REAL_INTERVAL_ORDERED_SIMPLE_CYCLE) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [USE_THEN "continuous" ACCEPT_TAC; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + ASM_ARITH_TAC; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]]; + INTRO_TAC "@y. kminimal"] THEN + SUBGOAL_THEN `has_period (f:real->real) k` + (LABEL_TAC "kperiod") THENL + [REWRITE_TAC[has_period] THEN EXISTS_TAC `y:real` THEN + USE_THEN "kminimal" ACCEPT_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `(k:num) = n - 1` (LABEL_TAC "klength") THENL + [ASM_CASES_TAC `ODD k` THENL + [USE_THEN "least" (MP_TAC o SPEC `k:num`) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[]; + DISCH_THEN(fun nth -> + USE_THEN "kperiod" (fun pth -> + CONTR_TAC(MP (NOT_ELIM nth) pth)))]; + ALL_TAC] THEN + ASM_CASES_TAC `(k:num) + 1 = n` THENL + [ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `(k:num) + 1 < n` + (LABEL_TAC "waitshort") THENL + [ASM_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(BETA_RULE(ISPECL + [`\i:num. i + 1 < n`; + `adjacent_interval_cover (p:num->num)`; + `k:num`; `q:num->num`] + PATH_SIMPLE_CYCLE_WAIT)) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[]; + DISCH_THEN(X_CHOOSE_THEN `r:num->num` STRIP_ASSUME_TAC)] THEN + MP_TAC(ISPECL + [`f:real->real`; `z:num->real`; `p:num->num`; `n:num`; + `(k:num) + 1`; `r:num->num`] + REAL_INTERVAL_ORDERED_FIRST_RETURN_CYCLE) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [USE_THEN "continuous" ACCEPT_TAC; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + ARITH_TAC; + USE_THEN "waitshort" ACCEPT_TAC; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]]; + INTRO_TAC "@w. waitminimal"] THEN + SUBGOAL_THEN `has_period (f:real->real) (k + 1)` + (LABEL_TAC "waitperiod") THENL + [REWRITE_TAC[has_period] THEN EXISTS_TAC `w:real` THEN + USE_THEN "waitminimal" ACCEPT_TAC; + ALL_TAC] THEN + USE_THEN "least" (MP_TAC o SPEC `(k:num) + 1`) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[ODD_ADD; ARITH]; + ASM_ARITH_TAC; + USE_THEN "waitshort" ACCEPT_TAC]; + DISCH_THEN(fun nth -> + USE_THEN "waitperiod" (fun pth -> + CONTR_TAC(MP (NOT_ELIM nth) pth)))]; + ALL_TAC] THEN + USE_THEN "klength" (fun th -> + RULE_ASSUM_TAC(REWRITE_RULE[th])) THEN + MAP_EVERY EXISTS_TAC + [`z:num->real`; `p:num->num`; `q:num->num`] THEN + ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Periods one, two and four. *) +(* ------------------------------------------------------------------------- *) + +let HAS_PERIOD_ORDERED_CYCLE = prove + (`!f n. + has_period (f:real->real) n + ==> ?z p. + (!i j. i < j /\ j < n ==> z i < z j) /\ + (!i. i < n ==> p i < n /\ f(z i) = z(p i)) /\ + (!i. i < n ==> minimal_period f n (z i)) /\ + (!i. i < n ==> p i < n /\ minimal_period p n i)`, + REPEAT GEN_TAC THEN REWRITE_TAC[has_period] THEN + INTRO_TAC "@x. minimal" THEN + MP_TAC(ISPECL [`f:real->real`; `n:num`; `x:real`] + MINIMAL_PERIOD_ORDERED_ORBIT) THEN + ASM_REWRITE_TAC[] THEN + INTRO_TAC "@z. ordered orbit" THEN + MP_TAC(ISPECL + [`f:real->real`; `n:num`; `x:real`; `z:num->real`] + MINIMAL_PERIOD_ORDERED_ORBIT_TRANSITION) THEN + ASM_REWRITE_TAC[] THEN + INTRO_TAC "@p. transition" THEN + MP_TAC(ISPECL + [`f:real->real`; `n:num`; `x:real`; `z:num->real`; + `p:num->num`] + MINIMAL_PERIOD_ORDERED_ORBIT_TRANSITION_MINIMAL) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(LABEL_TAC "pminimal") THEN + MAP_EVERY EXISTS_TAC [`z:num->real`; `p:num->num`] THEN + REPEAT CONJ_TAC THENL + [USE_THEN "ordered" ACCEPT_TAC; + USE_THEN "transition" ACCEPT_TAC; + X_GEN_TAC `i:num` THEN DISCH_THEN(LABEL_TAC "ibound") THEN + MATCH_MP_TAC(ISPECL + [`f:real->real`; `n:num`; `x:real`; `(z:num->real) i`] + MINIMAL_PERIOD_ORBIT_MINIMAL) THEN + ASM_REWRITE_TAC[] THEN + USE_THEN "orbit" (fun th -> REWRITE_TAC[GSYM th]) THEN + REWRITE_TAC[IN_IMAGE; IN_ELIM_THM] THEN + EXISTS_TAC `i:num` THEN ASM_REWRITE_TAC[]; + X_GEN_TAC `i:num` THEN DISCH_THEN(LABEL_TAC "ibound") THEN + CONJ_TAC THENL + [USE_THEN "transition" (MP_TAC o SPEC `i:num`) THEN + ANTS_TAC THENL + [USE_THEN "ibound" ACCEPT_TAC; + SIMP_TAC[]]; + USE_THEN "pminimal" MATCH_MP_TAC THEN + USE_THEN "ibound" ACCEPT_TAC]]);; + +let FINITE_CYCLIC_4_TWO_CYCLE = prove + (`!p. + (!i. i < 4 ==> p i < 4 /\ minimal_period p 4 i) + ==> (adjacent_interval_cover p 0 1 /\ + adjacent_interval_cover p 1 0) \/ + (adjacent_interval_cover p 0 2 /\ + adjacent_interval_cover p 2 0) \/ + (adjacent_interval_cover p 1 2 /\ + adjacent_interval_cover p 2 1)`, + GEN_TAC THEN DISCH_THEN(LABEL_TAC "cycle") THEN + SUBGOAL_THEN + `minimal_period (p:num->num) 4 0` + (LABEL_TAC "minimal") THENL + [USE_THEN "cycle" (MP_TAC o SPEC `0`) THEN + CONV_TAC NUM_REDUCE_CONV THEN SIMP_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `(p:num->num) (p (p (p 0))) = 0` + (LABEL_TAC "closed") THENL + [USE_THEN "minimal" + (MP_TAC o MATCH_MP MINIMAL_PERIOD_PERIODIC) THEN + REWRITE_TAC[periodic_point; num_CONV `4`; num_CONV `3`; + num_CONV `2`; num_CONV `1`; ITER]; + ALL_TAC] THEN + SUBGOAL_THEN + `~((p:num->num) 0 = 0)` + (LABEL_TAC "not1") THENL + [DISCH_THEN(LABEL_TAC "early") THEN + SUBGOAL_THEN `periodic_point (p:num->num) 1 0` + (LABEL_TAC "earlyperiod") THENL + [REWRITE_TAC[periodic_point; ITER_1] THEN + USE_THEN "early" ACCEPT_TAC; + ALL_TAC] THEN + MP_TAC(ISPECL [`p:num->num`; `4`; `0`; `1`] + MINIMAL_PERIOD_DIVIDES) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o MATCH_MP DIVIDES_LE) THEN ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `~((p:num->num) (p 0) = 0)` + (LABEL_TAC "not2") THENL + [DISCH_THEN(LABEL_TAC "early") THEN + SUBGOAL_THEN `periodic_point (p:num->num) 2 0` + (LABEL_TAC "earlyperiod") THENL + [REWRITE_TAC[periodic_point; num_CONV `2`; num_CONV `1`; + ITER] THEN + USE_THEN "early" ACCEPT_TAC; + ALL_TAC] THEN + MP_TAC(ISPECL [`p:num->num`; `4`; `0`; `2`] + MINIMAL_PERIOD_DIVIDES) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o MATCH_MP DIVIDES_LE) THEN ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `~((p:num->num) (p (p 0)) = 0)` + (LABEL_TAC "not3") THENL + [DISCH_THEN(LABEL_TAC "early") THEN + SUBGOAL_THEN `periodic_point (p:num->num) 3 0` + (LABEL_TAC "earlyperiod") THENL + [REWRITE_TAC[periodic_point; num_CONV `3`; num_CONV `2`; + num_CONV `1`; ITER] THEN + USE_THEN "early" ACCEPT_TAC; + ALL_TAC] THEN + MP_TAC(ISPECL [`p:num->num`; `4`; `0`; `3`] + MINIMAL_PERIOD_DIVIDES) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o MATCH_MP DIVIDES_LE) THEN ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `p 0 = 0 \/ p 0 = 1 \/ p 0 = 2 \/ p 0 = 3` + (LABEL_TAC "p0cases") THENL + [USE_THEN "cycle" (MP_TAC o SPEC `0`) THEN + CONV_TAC NUM_REDUCE_CONV THEN ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `p 1 = 0 \/ p 1 = 1 \/ p 1 = 2 \/ p 1 = 3` + (LABEL_TAC "p1cases") THENL + [USE_THEN "cycle" (MP_TAC o SPEC `1`) THEN + CONV_TAC NUM_REDUCE_CONV THEN ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `p 2 = 0 \/ p 2 = 1 \/ p 2 = 2 \/ p 2 = 3` + (LABEL_TAC "p2cases") THENL + [USE_THEN "cycle" (MP_TAC o SPEC `2`) THEN + CONV_TAC NUM_REDUCE_CONV THEN ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `p 3 = 0 \/ p 3 = 1 \/ p 3 = 2 \/ p 3 = 3` + (LABEL_TAC "p3cases") THENL + [USE_THEN "cycle" (MP_TAC o SPEC `3`) THEN + CONV_TAC NUM_REDUCE_CONV THEN ARITH_TAC; + ALL_TAC] THEN + USE_THEN "p0cases" + (REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THEN + USE_THEN "p1cases" + (REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THEN + USE_THEN "p2cases" + (REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THEN + USE_THEN "p3cases" + (REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC) THEN + UNDISCH_TAC `~((p:num->num) (p (p 0)) = 0)` THEN + UNDISCH_TAC `~((p:num->num) (p 0) = 0)` THEN + UNDISCH_TAC `~((p:num->num) 0 = 0)` THEN + UNDISCH_TAC `(p:num->num) (p (p (p 0))) = 0` THEN + ASM_REWRITE_TAC[adjacent_interval_cover] THEN + ASM_REWRITE_TAC[] THEN + CONV_TAC NUM_REDUCE_CONV THEN + ASM_ARITH_TAC);; + +let REAL_INTERVAL_ORDERED_TWO_CYCLE = prove + (`!f z p n i j. + f real_continuous_on (:real) /\ + (!r s. r < s /\ s < n ==> z r < z s) /\ + (!r. r < n ==> p r < n /\ f(z r) = z(p r)) /\ + (!r. r < n ==> minimal_period f n (z r)) /\ + i + 1 < n /\ + j + 1 < n /\ + ~(i = j) /\ + adjacent_interval_cover p i j /\ + adjacent_interval_cover p j i + ==> ?x. minimal_period f 2 x`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC(ISPECL + [`f:real->real`; `z:num->real`; `p:num->num`; `n:num`; + `2`; `\r:num. if r = 1 then (j:num) else (i:num)`] + REAL_INTERVAL_ORDERED_SIMPLE_CYCLE) THEN + (REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + ARITH_TAC; + ASM_ARITH_TAC; + X_GEN_TAC `r:num` THEN DISCH_TAC THEN + ASM_CASES_TAC `(r:num) = 1` THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[ARITH]; + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `(r:num) = 0 /\ s = 1` STRIP_ASSUME_TAC THENL + [ASM_ARITH_TAC; + ASM_REWRITE_TAC[ARITH]]; + X_GEN_TAC `r:num` THEN DISCH_TAC THEN + SUBGOAL_THEN `(r:num) = 0 \/ r = 1` + DISJ_CASES_TAC THENL + [ASM_ARITH_TAC; + ASM_REWRITE_TAC[ARITH]; + ASM_REWRITE_TAC[ARITH]]]));; + +let PERIOD_4_IMP_PERIOD_2 = prove + (`!f. f real_continuous_on (:real) /\ has_period f 4 + ==> has_period f 2`, + GEN_TAC THEN + INTRO_TAC "continuous period" THEN + MP_TAC(ISPECL [`f:real->real`; `4`] HAS_PERIOD_ORDERED_CYCLE) THEN + ASM_REWRITE_TAC[] THEN + INTRO_TAC "@z p. ordered transition oldminimal pcycle" THEN + MP_TAC(ISPEC `p:num->num` FINITE_CYCLIC_4_TWO_CYCLE) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(DISJ_CASES_THEN2 STRIP_ASSUME_TAC + (DISJ_CASES_THEN STRIP_ASSUME_TAC)) THEN + REWRITE_TAC[has_period] THENL + [MATCH_MP_TAC(ISPECL + [`f:real->real`; `z:num->real`; `p:num->num`; `4`; `0`; `1`] + REAL_INTERVAL_ORDERED_TWO_CYCLE) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV; + MATCH_MP_TAC(ISPECL + [`f:real->real`; `z:num->real`; `p:num->num`; `4`; `0`; `2`] + REAL_INTERVAL_ORDERED_TWO_CYCLE) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV; + MATCH_MP_TAC(ISPECL + [`f:real->real`; `z:num->real`; `p:num->num`; `4`; `1`; `2`] + REAL_INTERVAL_ORDERED_TWO_CYCLE) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV]);; + +let FINITE_REAL_CYCLE_DESCENT = prove + (`!x n. + 0 < n /\ x n = x 0 + ==> ?i. i < n /\ x(SUC i) <= x i`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + ASM_CASES_TAC `?i:num. i < n /\ (x:num->real)(SUC i) <= x i` THENL + [ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `!i. i < n ==> (x:num->real) i < x(SUC i)` + (LABEL_TAC "increasing") THENL + [X_GEN_TAC `i:num` THEN DISCH_TAC THEN + ASM_MESON_TAC[REAL_NOT_LE]; + ALL_TAC] THEN + SUBGOAL_THEN + `!k. 0 < k /\ k <= n ==> (x:num->real) 0 < x k` + (LABEL_TAC "chain") THENL + [INDUCT_TAC THENL + [ARITH_TAC; + INTRO_TAC "positive bound" THEN + ASM_CASES_TAC `(k:num) = 0` THENL + [ASM_REWRITE_TAC[] THEN + USE_THEN "increasing" MATCH_MP_TAC THEN ASM_ARITH_TAC; + MATCH_MP_TAC REAL_LT_TRANS THEN + EXISTS_TAC `(x:num->real) k` THEN CONJ_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; + USE_THEN "increasing" MATCH_MP_TAC THEN ASM_ARITH_TAC]]]; + USE_THEN "chain" (MP_TAC o SPEC `n:num`) THEN + ANTS_TAC THENL + [ASM_ARITH_TAC; + ASM_REWRITE_TAC[REAL_LT_REFL]]]);; + +let HAS_PERIOD_IMP_PERIOD_1 = prove + (`!f n. + f real_continuous_on (:real) /\ has_period f n + ==> has_period f 1`, + REPEAT GEN_TAC THEN + INTRO_TAC "continuous period" THEN + USE_THEN "period" (MP_TAC o REWRITE_RULE[has_period]) THEN + INTRO_TAC "@x. minimal" THEN + SUBGOAL_THEN + `0 < (n:num) /\ periodic_point (f:real->real) n x` + (DESTRUCT_TAC "positive orbit") THENL + [ASM_MESON_TAC[MINIMAL_PERIOD_POS; MINIMAL_PERIOD_PERIODIC]; + ALL_TAC] THEN + SUBGOAL_THEN + `?i. i < n /\ + (f:real->real)(ITER i f x) <= ITER i f x` + (LABEL_TAC "below") THENL + [MP_TAC(ISPECL [`\i:num. ITER i (f:real->real) x`; `n:num`] + FINITE_REAL_CYCLE_DESCENT) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [USE_THEN "positive" ACCEPT_TAC; + USE_THEN "orbit" (fun th -> + REWRITE_TAC[REWRITE_RULE[periodic_point] th; ITER])]; + REWRITE_TAC[ITER]]; + ALL_TAC] THEN + SUBGOAL_THEN + `?i. i < n /\ + ITER i (f:real->real) x <= f(ITER i f x)` + (LABEL_TAC "above") THENL + [MP_TAC(ISPECL + [`\i:num. --(ITER i (f:real->real) x)`; `n:num`] + FINITE_REAL_CYCLE_DESCENT) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [USE_THEN "positive" ACCEPT_TAC; + USE_THEN "orbit" (fun th -> + REWRITE_TAC[REWRITE_RULE[periodic_point] th; ITER])]; + REWRITE_TAC[REAL_LE_NEG2; ITER]]; + ALL_TAC] THEN + MP_TAC(ISPECL [`f:real->real`; `(:real)`] + REAL_CONTINUOUS_ON_FIXPOINT) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [REWRITE_TAC[IS_REALINTERVAL_UNIV]; + USE_THEN "continuous" ACCEPT_TAC; + ASM_MESON_TAC[IN_UNIV]; + ASM_MESON_TAC[IN_UNIV]]; + DISCH_THEN(X_CHOOSE_THEN `z:real` STRIP_ASSUME_TAC)] THEN + REWRITE_TAC[has_period] THEN EXISTS_TAC `z:real` THEN + REWRITE_TAC[MINIMAL_PERIOD_DIVISIBILITY; ARITH] THEN + X_GEN_TAC `m:num` THEN REWRITE_TAC[DIVIDES_1] THEN + REWRITE_TAC[periodic_point] THEN + MATCH_MP_TAC ITER_FIXPOINT THEN ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Even periods forced by odd periods. *) +(* ------------------------------------------------------------------------- *) + +let LEAST_ODD_PERIOD_IMP_EVEN_PERIODS_INDEXED = prove + (`!f m. + f real_continuous_on (:real) /\ + 0 < m /\ + has_period f (2 * m + 1) /\ + (!d. ODD d /\ 1 < d /\ d < 2 * m + 1 + ==> ~has_period f d) + ==> !s. 0 < s /\ s <= m ==> has_period f (2 * s)`, + REPEAT GEN_TAC THEN + INTRO_TAC "continuous positive period least" THEN + MP_TAC(ISPECL [`f:real->real`; `2 * (m:num) + 1`] + LEAST_ODD_PERIOD_ORDERED_CYCLE) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [USE_THEN "continuous" ACCEPT_TAC; + REWRITE_TAC[ODD_EXISTS] THEN + EXISTS_TAC `m:num` THEN ARITH_TAC; + MATCH_MP_TAC(ARITH_RULE `0 < m ==> 2 < 2 * m + 1`) THEN + USE_THEN "positive" ACCEPT_TAC; + USE_THEN "period" ACCEPT_TAC; + USE_THEN "least" ACCEPT_TAC]; + INTRO_TAC + ("@z p q. ordered transition oldminimal pcycle pathbound closed " ^ + "lower upper self distinct chordless nobase path")] THEN + SUBGOAL_THEN `(2 * m + 1) - 1 = 2 * m` + (LABEL_TAC "predecessor") THENL + [ARITH_TAC; + USE_THEN "predecessor" (fun th -> + RULE_ASSUM_TAC(REWRITE_RULE[th]))] THEN + SUBGOAL_THEN + `!i. i <= 2 * m ==> (p:num->num) i <= 2 * m` + (LABEL_TAC "pbound") THENL + [X_GEN_TAC `i:num` THEN DISCH_TAC THEN + USE_THEN "transition" (MP_TAC o SPEC `i:num`) THEN + ANTS_TAC THENL + [ASM_ARITH_TAC; + SIMP_TAC[] THEN ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN + `!i. i < 2 * m ==> (q:num->num) i < 2 * m` + (LABEL_TAC "qbound") THENL + [X_GEN_TAC `i:num` THEN DISCH_TAC THEN + USE_THEN "pathbound" (MP_TAC o SPEC `i:num`) THEN + ANTS_TAC THENL + [ASM_ARITH_TAC; + ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN `~((q:num->num) 0 = q 1)` + (LABEL_TAC "firstdifferent") THENL + [USE_THEN "distinct" (MATCH_MP_TAC o SPECL [`0`; `1`]) THEN + USE_THEN "positive" MP_TAC THEN ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `!r. r < m + ==> adjacent_interval_cover (p:num->num) + (q(2 * m - 1)) (q(2 * r))` + (LABEL_TAC "terminalcovers") THENL + [ASM_CASES_TAC `(q:num->num) 1 < q 0` THENL + [MP_TAC(ISPECL + [`p:num->num`; `q:num->num`; `m:num`; `(q:num->num) 0`] + FINITE_PATH_ZIGZAG_LEFT_TERMINAL) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [USE_THEN "pbound" ACCEPT_TAC; + USE_THEN "qbound" ACCEPT_TAC; + USE_THEN "distinct" ACCEPT_TAC; + USE_THEN "chordless" ACCEPT_TAC; + USE_THEN "nobase" ACCEPT_TAC; + REWRITE_TAC[GSYM ADD1] THEN USE_THEN "path" ACCEPT_TAC; + USE_THEN "positive" ACCEPT_TAC; + REFL_TAC; + USE_THEN "closed" (ACCEPT_TAC o SYM); + USE_THEN "lower" ACCEPT_TAC; + USE_THEN "upper" ACCEPT_TAC; + ASM_REWRITE_TAC[]]; + INTRO_TAC "_ _ _ terminalcover" THEN + USE_THEN "terminalcover" ACCEPT_TAC]; + SUBGOAL_THEN `(q:num->num) 0 < q 1` + (LABEL_TAC "right") THENL + [USE_THEN "firstdifferent" MP_TAC THEN ASM_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(ISPECL + [`p:num->num`; `q:num->num`; `m:num`; `(q:num->num) 0`] + FINITE_PATH_ZIGZAG_RIGHT_TERMINAL) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [USE_THEN "pbound" ACCEPT_TAC; + USE_THEN "qbound" ACCEPT_TAC; + USE_THEN "distinct" ACCEPT_TAC; + USE_THEN "chordless" ACCEPT_TAC; + USE_THEN "nobase" ACCEPT_TAC; + REWRITE_TAC[GSYM ADD1] THEN USE_THEN "path" ACCEPT_TAC; + USE_THEN "positive" ACCEPT_TAC; + REFL_TAC; + USE_THEN "closed" (ACCEPT_TAC o SYM); + USE_THEN "lower" ACCEPT_TAC; + USE_THEN "upper" ACCEPT_TAC; + USE_THEN "right" ACCEPT_TAC]; + INTRO_TAC "_ _ _ terminalcover" THEN + USE_THEN "terminalcover" ACCEPT_TAC]]; + ALL_TAC] THEN + X_GEN_TAC `s:num` THEN + INTRO_TAC "spos sle" THEN + MP_TAC(BETA_RULE(ISPECL + [`\i:num. i + 1 < 2 * m + 1`; + `adjacent_interval_cover (p:num->num)`; + `q:num->num`; `m:num`] + FINITE_PATH_TERMINAL_EVEN_CYCLES)) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [USE_THEN "positive" ACCEPT_TAC; + ALL_TAC] THEN + CONJ_TAC THENL + [X_GEN_TAC `i:num` THEN DISCH_THEN(LABEL_TAC "ilt") THEN + USE_THEN "pathbound" (fun bth -> + USE_THEN "ilt" (fun ith -> + ACCEPT_TAC(MATCH_MP (SPEC `i:num` bth) + (MATCH_MP + (ARITH_RULE `i < 2 * m ==> i <= 2 * m`) ith)))); + ALL_TAC] THEN + CONJ_TAC THENL + [USE_THEN "distinct" ACCEPT_TAC; + ALL_TAC] THEN + CONJ_TAC THENL + [REWRITE_TAC[GSYM ADD1] THEN USE_THEN "path" ACCEPT_TAC; + USE_THEN "terminalcovers" ACCEPT_TAC]; + DISCH_THEN(MP_TAC o SPEC `s:num`) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `u:num->num` STRIP_ASSUME_TAC)] THEN + MP_TAC(ISPECL + [`f:real->real`; `z:num->real`; `p:num->num`; + `2 * m + 1`; `2 * s`; `u:num->num`] + REAL_INTERVAL_ORDERED_FIRST_RETURN_CYCLE) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [USE_THEN "continuous" ACCEPT_TAC; + USE_THEN "ordered" ACCEPT_TAC; + USE_THEN "transition" ACCEPT_TAC; + USE_THEN "oldminimal" ACCEPT_TAC; + MATCH_MP_TAC(ARITH_RULE `0 < s ==> 0 < 2 * s`) THEN + USE_THEN "spos" ACCEPT_TAC; + MATCH_MP_TAC(ARITH_RULE + `s <= m ==> 2 * s < 2 * m + 1`) THEN + USE_THEN "sle" ACCEPT_TAC; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + REWRITE_TAC[ADD1] THEN ASM_REWRITE_TAC[]]; + INTRO_TAC "@x. minimal"] THEN + REWRITE_TAC[has_period] THEN + EXISTS_TAC `x:real` THEN USE_THEN "minimal" ACCEPT_TAC);; + +let LEAST_ODD_PERIOD_IMP_EVEN_PERIODS = prove + (`!f n. + f real_continuous_on (:real) /\ + ODD n /\ + 2 < n /\ + has_period f n /\ + (!d. ODD d /\ 1 < d /\ d < n ==> ~has_period f d) + ==> !s. 0 < s /\ 2 * s < n ==> has_period f (2 * s)`, + REPEAT GEN_TAC THEN + INTRO_TAC "continuous odd nontrivial period least" THEN + USE_THEN "odd" (MP_TAC o REWRITE_RULE[ODD_EXISTS]) THEN + DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST_ALL_TAC) THEN + MP_TAC(ISPECL [`f:real->real`; `m:num`] + LEAST_ODD_PERIOD_IMP_EVEN_PERIODS_INDEXED) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [USE_THEN "continuous" ACCEPT_TAC; + MATCH_MP_TAC(ARITH_RULE `2 < SUC(2 * m) ==> 0 < m`) THEN + USE_THEN "nontrivial" ACCEPT_TAC; + REWRITE_TAC[GSYM ADD1] THEN USE_THEN "period" ACCEPT_TAC; + REWRITE_TAC[GSYM ADD1] THEN USE_THEN "least" ACCEPT_TAC]; + DISCH_THEN(LABEL_TAC "even")] THEN + X_GEN_TAC `s:num` THEN STRIP_TAC THEN + USE_THEN "even" MATCH_MP_TAC THEN ASM_ARITH_TAC);; + +let ODD_PERIOD_IMP_EVEN_PERIOD = prove + (`!f n m. + f real_continuous_on (:real) /\ + ODD n /\ + 1 < n /\ + has_period f n /\ + EVEN m /\ + 0 < m + ==> has_period f m`, + REPEAT GEN_TAC THEN + INTRO_TAC "continuous odd nontrivial period even positive" THEN + MP_TAC(BETA_RULE(fst(EQ_IMP_RULE + (SPEC `\d:num. ODD d /\ 1 < d /\ has_period (f:real->real) d` + num_WOP)))) THEN + ANTS_TAC THENL + [EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC[]; + INTRO_TAC + "@d. (dodd dnontrivial dperiod) least"] THEN + SUBGOAL_THEN `2 < (d:num)` (LABEL_TAC "dlarge") THENL + [MATCH_MP_TAC(ARITH_RULE `1 < d /\ ~(d = 2) ==> 2 < d`) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN SUBST_ALL_TAC THEN + UNDISCH_TAC `ODD 2` THEN CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + SUBGOAL_THEN + `!e. ODD e /\ 1 < e /\ e < d + ==> ~has_period (f:real->real) e` + (LABEL_TAC "leastodd") THENL + [ASM_MESON_TAC[]; + ALL_TAC] THEN + ASM_CASES_TAC `(m:num) < d` THENL + [USE_THEN "even" (MP_TAC o REWRITE_RULE[EVEN_EXISTS]) THEN + DISCH_THEN(X_CHOOSE_THEN `s:num` SUBST_ALL_TAC) THEN + MP_TAC(ISPECL [`f:real->real`; `d:num`] + LEAST_ODD_PERIOD_IMP_EVEN_PERIODS) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[]; + DISCH_THEN(MP_TAC o SPEC `s:num`) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; + SIMP_TAC[]]]; + MATCH_MP_TAC(ISPECL + [`f:real->real`; `d:num`; `m:num`] + ODD_PERIOD_IMP_LARGER_PERIOD) THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `~((m:num) = d)` ASSUME_TAC THENL + [DISCH_THEN SUBST_ALL_TAC THEN + UNDISCH_TAC `EVEN d` THEN + ASM_REWRITE_TAC[GSYM NOT_ODD]; + ASM_ARITH_TAC]]);; + +(* ------------------------------------------------------------------------- *) +(* Transfer of periods between a map and its iterates. *) +(* ------------------------------------------------------------------------- *) + +let HAS_PERIOD_SQUARE_CASES = prove + (`!f:A->A m. + has_period (ITER 2 f) m + ==> (ODD m /\ has_period f m) \/ has_period f (2 * m)`, + REPEAT GEN_TAC THEN REWRITE_TAC[has_period] THEN + INTRO_TAC "@x. square" THEN + SUBGOAL_THEN `0 < (m:num)` (LABEL_TAC "positive") THENL + [USE_THEN "square" (MP_TAC o MATCH_MP MINIMAL_PERIOD_POS) THEN + ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `periodic_point (f:A->A) (m * 2) x` + (LABEL_TAC "periodic") THENL + [REWRITE_TAC[GSYM PERIODIC_POINT_ITER] THEN + MATCH_MP_TAC MINIMAL_PERIOD_PERIODIC THEN + USE_THEN "square" ACCEPT_TAC; + ALL_TAC] THEN + MP_TAC(ISPECL [`f:A->A`; `x:A`; `m * 2`] + PERIODIC_POINT_IMP_MINIMAL_PERIOD) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; + INTRO_TAC "@n. divides minimal"] THEN + SUBGOAL_THEN `m = n DIV gcd(n,2)` (LABEL_TAC "quotient") THENL + [MATCH_MP_TAC(ISPECL + [`ITER 2 (f:A->A)`; `m:num`; `n DIV gcd(n,2)`; + `x:A`] MINIMAL_PERIOD_UNIQUE) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MINIMAL_PERIOD_ITER THEN + USE_THEN "minimal" ACCEPT_TAC; + ALL_TAC] THEN + ASM_CASES_TAC `EVEN n` THENL + [DISJ2_TAC THEN EXISTS_TAC `x:A` THEN + SUBGOAL_THEN `(n:num) = 2 * m` SUBST_ALL_TAC THENL + [USE_THEN "quotient" MP_TAC THEN + ASM_REWRITE_TAC[GCD_2_CASES] THEN + SUBGOAL_THEN `n DIV 2 * 2 = n` ASSUME_TAC THENL + [ASM_SIMP_TAC[DOUBLE_HALF]; + ASM_ARITH_TAC]; + USE_THEN "minimal" ACCEPT_TAC]; + DISJ1_TAC THEN CONJ_TAC THENL + [USE_THEN "quotient" MP_TAC THEN + ASM_REWRITE_TAC[GCD_2_CASES; DIV_1; GSYM NOT_EVEN]; + EXISTS_TAC `x:A` THEN + SUBGOAL_THEN `(n:num) = m` SUBST_ALL_TAC THENL + [USE_THEN "quotient" MP_TAC THEN + ASM_REWRITE_TAC[GCD_2_CASES; DIV_1]; + USE_THEN "minimal" ACCEPT_TAC]]]);; + +let HAS_PERIOD_SQUARE_IMP_DOUBLE = prove + (`!f m. + f real_continuous_on (:real) /\ + 1 < m /\ + has_period (ITER 2 f) m + ==> has_period f (2 * m)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(ISPECL [`f:real->real`; `m:num`] + HAS_PERIOD_SQUARE_CASES) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(DISJ_CASES_THEN2 STRIP_ASSUME_TAC + (LABEL_TAC "double")) THENL + [SUBGOAL_THEN `2 < (m:num)` (LABEL_TAC "nontrivial") THENL + [MATCH_MP_TAC(ARITH_RULE `1 < m /\ ~(m = 2) ==> 2 < m`) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN SUBST_ALL_TAC THEN + UNDISCH_TAC `ODD 2` THEN CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + SUBGOAL_THEN `(m:num) < 2 * m` (LABEL_TAC "larger") THENL + [MATCH_MP_TAC(ARITH_RULE `1 < m ==> m < 2 * m`) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC(ISPECL + [`f:real->real`; `m:num`; `2 * m`] + ODD_PERIOD_IMP_LARGER_PERIOD) THEN + ASM_REWRITE_TAC[]; + USE_THEN "double" ACCEPT_TAC]);; + +let HAS_PERIOD_POWER2_MULTIPLE_IMP_ITER = prove + (`!f:A->A a m. + has_period f ((2 EXP a) * m) + ==> has_period (ITER (2 EXP a) f) m`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MP_TAC(ISPECL + [`f:A->A`; `(2 EXP a) * m`; `2 EXP a`] + HAS_PERIOD_ITER) THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `gcd((2 EXP a) * m,2 EXP a) = 2 EXP a` + SUBST1_TAC THENL + [SUBGOAL_THEN + `(2 EXP a) divides (2 EXP a) * m` + ASSUME_TAC THENL + [REWRITE_TAC[divides] THEN EXISTS_TAC `m:num` THEN REFL_TAC; + MP_TAC(SPECL [`(2 EXP a) * m`; `2 EXP a`] GCD) THEN + INTRO_TAC "(_ gcddivides) greatest" THEN + REWRITE_TAC[GSYM DIVIDES_ANTISYM] THEN + CONJ_TAC THENL + [USE_THEN "gcddivides" ACCEPT_TAC; + USE_THEN "greatest" (MP_TAC o SPEC `2 EXP a`) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[DIVIDES_REFL]; + SIMP_TAC[]]]]; + SUBGOAL_THEN `~(2 EXP a = 0)` (LABEL_TAC "nonzero") THENL + [REWRITE_TAC[EXP_EQ_0] THEN ARITH_TAC; + USE_THEN "nonzero" (fun th -> + REWRITE_TAC[MATCH_MP + (SPECL [`2 EXP a`; `m:num`] DIV_MULT) th])]]);; + +let HAS_PERIOD_ITER_POWER2_IMP_MULTIPLE = prove + (`!a f m. + f real_continuous_on (:real) /\ + 1 < m /\ + has_period (ITER (2 EXP a) f) m + ==> has_period f ((2 EXP a) * m)`, + INDUCT_TAC THENL + [REPEAT GEN_TAC THEN + SUBGOAL_THEN `ITER 1 (f:real->real) = f` + (fun th -> REWRITE_TAC[EXP; MULT_CLAUSES; th]) THEN + REWRITE_TAC[FUN_EQ_THM; ITER_1] THEN SIMP_TAC[]; + POP_ASSUM(LABEL_TAC "induction") THEN + MAP_EVERY X_GEN_TAC [`f:real->real`; `m:num`] THEN + INTRO_TAC "continuous nontrivial period" THEN + SUBGOAL_THEN + `ITER (2 EXP SUC a) (f:real->real) = + ITER (2 EXP a) (ITER 2 f)` + (LABEL_TAC "iterate") THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:real` THEN + REWRITE_TAC[ITER_MUL; EXP; MULT_SYM]; + ALL_TAC] THEN + USE_THEN "induction" + (MP_TAC o SPECL [`ITER 2 (f:real->real)`; `m:num`]) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_ON_ITER THEN + USE_THEN "continuous" ACCEPT_TAC; + USE_THEN "nontrivial" ACCEPT_TAC; + USE_THEN "iterate" (fun th -> + USE_THEN "period" (ACCEPT_TAC o REWRITE_RULE[th]))]; + DISCH_THEN(LABEL_TAC "squareperiod")] THEN + REWRITE_TAC[EXP] THEN REWRITE_TAC[GSYM MULT_ASSOC] THEN + MATCH_MP_TAC(ISPECL + [`f:real->real`; `(2 EXP a) * m`] + HAS_PERIOD_SQUARE_IMP_DOUBLE) THEN + REPEAT CONJ_TAC THENL + [USE_THEN "continuous" ACCEPT_TAC; + MATCH_MP_TAC LTE_TRANS THEN EXISTS_TAC `m:num` THEN + CONJ_TAC THENL + [USE_THEN "nontrivial" ACCEPT_TAC; + SUBGOAL_THEN `1 <= 2 EXP a` ASSUME_TAC THENL + [MATCH_MP_TAC(ARITH_RULE `0 < k ==> 1 <= k`) THEN + REWRITE_TAC[LT_NZ; EXP_EQ_0] THEN ARITH_TAC; + MP_TAC(SPECL [`1`; `2 EXP a`; `m:num`; `m:num`] + LE_MULT2) THEN + ASM_REWRITE_TAC[MULT_CLAUSES; LE_REFL]]]; + USE_THEN "squareperiod" ACCEPT_TAC]]);; + +let HAS_PERIOD_POWER2_SUC_IMP_POWER2 = prove + (`!f a. + f real_continuous_on (:real) /\ + has_period f (2 EXP (SUC a)) + ==> has_period f (2 EXP a)`, + REPEAT GEN_TAC THEN + INTRO_TAC "continuous period" THEN + ASM_CASES_TAC `(a:num) = 0` THENL + [POP_ASSUM SUBST_ALL_TAC THEN + REWRITE_TAC[EXP; MULT_CLAUSES] THEN + MATCH_MP_TAC(ISPECL [`f:real->real`; `2`] + HAS_PERIOD_IMP_PERIOD_1) THEN + CONJ_TAC THENL + [USE_THEN "continuous" ACCEPT_TAC; + USE_THEN "period" + (ACCEPT_TAC o REWRITE_RULE[EXP; MULT_CLAUSES])]; + MP_TAC(SPEC `a:num` num_CASES) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `b:num` SUBST_ALL_TAC)] THEN + SUBGOAL_THEN + `(ITER (2 EXP b) f) real_continuous_on (:real)` + (LABEL_TAC "itercontinuous") THENL + [MATCH_MP_TAC REAL_CONTINUOUS_ON_ITER THEN + USE_THEN "continuous" ACCEPT_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `has_period (ITER (2 EXP b) (f:real->real)) 4` + (LABEL_TAC "period4") THENL + [MATCH_MP_TAC(ISPECL + [`f:real->real`; `b:num`; `4`] + HAS_PERIOD_POWER2_MULTIPLE_IMP_ITER) THEN + SUBGOAL_THEN + `(2 EXP b) * 4 = 2 EXP SUC (SUC b)` + (fun th -> REWRITE_TAC[th]) THENL + [REWRITE_TAC[EXP] THEN ARITH_TAC; + USE_THEN "period" ACCEPT_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN + `has_period (ITER (2 EXP b) (f:real->real)) 2` + (LABEL_TAC "period2") THENL + [MATCH_MP_TAC PERIOD_4_IMP_PERIOD_2 THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MP_TAC(ISPECL [`b:num`; `f:real->real`; `2`] + HAS_PERIOD_ITER_POWER2_IMP_MULTIPLE) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN ARITH_TAC; + DISCH_THEN(LABEL_TAC "multiple")] THEN + SUBGOAL_THEN + `(2 EXP b) * 2 = 2 EXP SUC b` + (fun th -> REWRITE_TAC[GSYM th] THEN + USE_THEN "multiple" ACCEPT_TAC) THEN + REWRITE_TAC[EXP; MULT_SYM]);; + +let HAS_PERIOD_POWER2_MONO = prove + (`!f a b. + f real_continuous_on (:real) /\ + b <= a /\ + has_period f (2 EXP a) + ==> has_period f (2 EXP b)`, + GEN_TAC THEN INDUCT_TAC THENL + [X_GEN_TAC `b:num` THEN STRIP_TAC THEN + SUBGOAL_THEN `(b:num) = 0` SUBST_ALL_TAC THENL + [ASM_ARITH_TAC; + ASM_REWRITE_TAC[]]; + POP_ASSUM(LABEL_TAC "induction") THEN + X_GEN_TAC `b:num` THEN + INTRO_TAC "continuous le period" THEN + ASM_CASES_TAC `(b:num) = SUC a` THENL + [ASM_REWRITE_TAC[]; + ALL_TAC] THEN + USE_THEN "induction" (MP_TAC o SPEC `b:num`) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [USE_THEN "continuous" ACCEPT_TAC; + ASM_ARITH_TAC; + MATCH_MP_TAC HAS_PERIOD_POWER2_SUC_IMP_POWER2 THEN + ASM_REWRITE_TAC[]]; + SIMP_TAC[]]]);; + +(* ------------------------------------------------------------------------- *) +(* Sarkovskii's ordering and the full forcing theorem. *) +(* ------------------------------------------------------------------------- *) + +let ODD_POS = prove + (`!n. ODD n ==> 0 < n`, + REWRITE_TAC[ODD_EXISTS] THEN ARITH_TAC);; + +let ODD_GT_1_IMP_GT_2 = prove + (`!n. ODD n /\ 1 < n ==> 2 < n`, + GEN_TAC THEN + INTRO_TAC "odd large" THEN + MATCH_MP_TAC(ARITH_RULE `1 < n /\ ~(n = 2) ==> 2 < n`) THEN + CONJ_TAC THENL + [USE_THEN "large" ACCEPT_TAC; + DISCH_THEN(LABEL_TAC "eq") THEN + USE_THEN "odd" MP_TAC THEN + USE_THEN "eq" (fun th -> REWRITE_TAC[th]) THEN + CONV_TAC NUM_REDUCE_CONV]);; + +let EVEN_POS_IMP_GT_1 = prove + (`!n. EVEN n /\ 0 < n ==> 1 < n`, + GEN_TAC THEN + INTRO_TAC "even positive" THEN + MATCH_MP_TAC(ARITH_RULE `0 < n /\ ~(n = 1) ==> 1 < n`) THEN + CONJ_TAC THENL + [USE_THEN "positive" ACCEPT_TAC; + DISCH_THEN(LABEL_TAC "eq") THEN + USE_THEN "even" MP_TAC THEN + USE_THEN "eq" (fun th -> REWRITE_TAC[th]) THEN + CONV_TAC NUM_REDUCE_CONV]);; + +let POWER2_SPLIT = prove + (`!a b. a <= b + ==> 2 EXP a * 2 EXP (b - a) = 2 EXP b`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[GSYM EXP_ADD] THEN + AP_TERM_TAC THEN ASM_ARITH_TAC);; + +let ODD_FACTOR_PERIOD_IMP_LATER_PERIOD = prove + (`!f a u b v. + f real_continuous_on (:real) /\ + ODD u /\ + 1 < u /\ + ODD v /\ + has_period f (2 EXP a * u) /\ + (v = 1 \/ a < b \/ a = b /\ u < v) + ==> has_period f (2 EXP b * v)`, + REPEAT GEN_TAC THEN + INTRO_TAC "continuous uodd ularge vodd period later" THEN + SUBGOAL_THEN + `(ITER (2 EXP a) f) real_continuous_on (:real)` + (LABEL_TAC "itercontinuous") THENL + [MATCH_MP_TAC REAL_CONTINUOUS_ON_ITER THEN + USE_THEN "continuous" ACCEPT_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `has_period (ITER (2 EXP a) (f:real->real)) u` + (LABEL_TAC "oddperiod") THENL + [MATCH_MP_TAC(ISPECL + [`f:real->real`; `a:num`; `u:num`] + HAS_PERIOD_POWER2_MULTIPLE_IMP_ITER) THEN + USE_THEN "period" ACCEPT_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `2 < (u:num)` (LABEL_TAC "ugt2") THENL + [MATCH_MP_TAC ODD_GT_1_IMP_GT_2 THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + ASM_CASES_TAC `(v:num) = 1` THENL + [POP_ASSUM SUBST_ALL_TAC THEN REWRITE_TAC[MULT_CLAUSES] THEN + ASM_CASES_TAC `(a:num) < b` THENL + [SUBGOAL_THEN + `has_period (ITER (2 EXP a) (f:real->real)) + (2 EXP (b - a))` + (LABEL_TAC "iterpower") THENL + [MATCH_MP_TAC(ISPECL + [`ITER (2 EXP a) (f:real->real)`; `u:num`; + `2 EXP (b - a)`] + ODD_PERIOD_IMP_EVEN_PERIOD) THEN + REPEAT CONJ_TAC THENL + [USE_THEN "itercontinuous" ACCEPT_TAC; + USE_THEN "uodd" ACCEPT_TAC; + USE_THEN "ularge" ACCEPT_TAC; + USE_THEN "oddperiod" ACCEPT_TAC; + REWRITE_TAC[EVEN_EXP] THEN ASM_ARITH_TAC; + REWRITE_TAC[LT_NZ; EXP_EQ_0] THEN ARITH_TAC]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`a:num`; `f:real->real`; `2 EXP (b - a)`] + HAS_PERIOD_ITER_POWER2_IMP_MULTIPLE) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [USE_THEN "continuous" ACCEPT_TAC; + MATCH_MP_TAC EVEN_POS_IMP_GT_1 THEN + REWRITE_TAC[EVEN_EXP; LT_NZ; EXP_EQ_0] THEN + ASM_ARITH_TAC; + USE_THEN "iterpower" ACCEPT_TAC]; + DISCH_THEN(LABEL_TAC "lifted")] THEN + MP_TAC(SPECL [`a:num`; `b:num`] POWER2_SPLIT) THEN + ANTS_TAC THENL + [ASM_ARITH_TAC; + DISCH_THEN(fun th -> REWRITE_TAC[GSYM th]) THEN + USE_THEN "lifted" ACCEPT_TAC]; + SUBGOAL_THEN + `has_period (ITER (2 EXP a) (f:real->real)) 2` + (LABEL_TAC "iterperiod2") THENL + [MATCH_MP_TAC(ISPECL + [`ITER (2 EXP a) (f:real->real)`; `u:num`; `2`] + ODD_PERIOD_IMP_EVEN_PERIOD) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + MP_TAC(ISPECL [`a:num`; `f:real->real`; `2`] + HAS_PERIOD_ITER_POWER2_IMP_MULTIPLE) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN ARITH_TAC; + DISCH_THEN(LABEL_TAC "nextpower")] THEN + MATCH_MP_TAC(ISPECL + [`f:real->real`; `SUC a`; `b:num`] + HAS_PERIOD_POWER2_MONO) THEN + REPEAT CONJ_TAC THENL + [USE_THEN "continuous" ACCEPT_TAC; + ASM_ARITH_TAC; + REWRITE_TAC[EXP] THEN ONCE_REWRITE_TAC[MULT_SYM] THEN + USE_THEN "nextpower" ACCEPT_TAC]]; + POP_ASSUM(LABEL_TAC "vnotone")] THEN + SUBGOAL_THEN `1 < (v:num)` (LABEL_TAC "vlarge") THENL + [USE_THEN "vodd" (MP_TAC o REWRITE_RULE[ODD_EXISTS]) THEN + INTRO_TAC "@c. vform" THEN + ASM_ARITH_TAC; + ALL_TAC] THEN + USE_THEN "later" MP_TAC THEN + USE_THEN "vnotone" (fun th -> REWRITE_TAC[th]) THEN + (DISCH_THEN(DISJ_CASES_THEN2 (LABEL_TAC "ab") + (CONJUNCTS_THEN2 (LABEL_TAC "abeq") (LABEL_TAC "uv"))) THENL + [ABBREV_TAC `k:num = 2 EXP (b - a) * v` THEN + SUBGOAL_THEN `EVEN k /\ 0 < k` + (DESTRUCT_TAC "keven kpos") THENL + [EXPAND_TAC "k" THEN CONJ_TAC THENL + [REWRITE_TAC[EVEN_MULT; EVEN_EXP] THEN ASM_ARITH_TAC; + REWRITE_TAC[LT_NZ; MULT_EQ_0; EXP_EQ_0] THEN + MP_TAC(SPEC `v:num` ODD_POS) THEN ASM_REWRITE_TAC[] THEN + ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN + `has_period (ITER (2 EXP a) (f:real->real)) k` + (LABEL_TAC "iterperiod") THENL + [MATCH_MP_TAC(ISPECL + [`ITER (2 EXP a) (f:real->real)`; `u:num`; `k:num`] + ODD_PERIOD_IMP_EVEN_PERIOD) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MP_TAC(ISPECL [`a:num`; `f:real->real`; `k:num`] + HAS_PERIOD_ITER_POWER2_IMP_MULTIPLE) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC EVEN_POS_IMP_GT_1 THEN ASM_REWRITE_TAC[]; + DISCH_THEN(LABEL_TAC "lifted")] THEN + SUBGOAL_THEN + `2 EXP a * k = 2 EXP b * v` + (fun th -> USE_THEN "lifted" + (ACCEPT_TAC o REWRITE_RULE[th])) THEN + EXPAND_TAC "k" THEN + MP_TAC(SPECL [`a:num`; `b:num`] POWER2_SPLIT) THEN + ANTS_TAC THENL + [ASM_ARITH_TAC; + DISCH_THEN(fun th -> REWRITE_TAC[MULT_ASSOC; th])]; + USE_THEN "abeq" SUBST_ALL_TAC THEN + SUBGOAL_THEN + `has_period (ITER (2 EXP b) (f:real->real)) v` + (LABEL_TAC "iterperiod") THENL + [MATCH_MP_TAC(ISPECL + [`ITER (2 EXP b) (f:real->real)`; `u:num`; `v:num`] + ODD_PERIOD_IMP_LARGER_PERIOD) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC(ISPECL [`b:num`; `f:real->real`; `v:num`] + HAS_PERIOD_ITER_POWER2_IMP_MULTIPLE) THEN + ASM_REWRITE_TAC[]]));; + +let sarkovskii_precedes = new_definition + `sarkovskii_precedes m n <=> + ?a b u v. + ODD u /\ + ODD v /\ + m = 2 EXP a * u /\ + n = 2 EXP b * v /\ + ((1 < u /\ + (v = 1 \/ a < b \/ a = b /\ u < v)) \/ + (u = 1 /\ v = 1 /\ b < a))`;; + +let SARKOVSKII_PRECEDES_POS = prove + (`!m n. + sarkovskii_precedes m n + ==> 0 < m /\ 0 < n`, + REPEAT GEN_TAC THEN REWRITE_TAC[sarkovskii_precedes] THEN + INTRO_TAC "@a b u v. uodd vodd meq neq _" THEN + CONJ_TAC THENL + [USE_THEN "meq" SUBST1_TAC THEN + REWRITE_TAC[LT_MULT; EXP_LT_0] THEN + CONV_TAC NUM_REDUCE_CONV THEN + MATCH_MP_TAC ODD_POS THEN ASM_REWRITE_TAC[]; + USE_THEN "neq" SUBST1_TAC THEN + REWRITE_TAC[LT_MULT; EXP_LT_0] THEN + CONV_TAC NUM_REDUCE_CONV THEN + MATCH_MP_TAC ODD_POS THEN ASM_REWRITE_TAC[]]);; + +let ODD_POWER2_FACTOR_LE = prove + (`!a b u v. + ODD u /\ + 2 EXP a * u = 2 EXP b * v /\ + a <= b + ==> b <= a`, + REPEAT GEN_TAC THEN + INTRO_TAC "uodd eq le" THEN + USE_THEN "le" (MP_TAC o REWRITE_RULE[LE_EXISTS]) THEN + INTRO_TAC "@c. split" THEN + SUBGOAL_THEN + `u = 2 EXP c * v` + (LABEL_TAC "factors") THENL + [USE_THEN "eq" MP_TAC THEN + USE_THEN "split" (fun th -> REWRITE_TAC[th]) THEN + REWRITE_TAC[EXP_ADD; GSYM MULT_ASSOC; + EQ_MULT_LCANCEL; EXP_EQ_0] THEN + ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `(c:num) = 0` SUBST_ALL_TAC THENL + [ASM_CASES_TAC `(c:num) = 0` THEN ASM_REWRITE_TAC[] THEN + USE_THEN "uodd" MP_TAC THEN + USE_THEN "factors" (fun th -> REWRITE_TAC[th]) THEN + REWRITE_TAC[ODD_MULT; ODD_EXP] THEN + CONV_TAC NUM_REDUCE_CONV THEN + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[ADD_CLAUSES; LE_REFL]]);; + +let ODD_POWER2_FACTOR_UNIQUE = prove + (`!a b u v. + ODD u /\ + ODD v /\ + 2 EXP a * u = 2 EXP b * v + ==> a = b /\ u = v`, + REPEAT GEN_TAC THEN + INTRO_TAC "uodd vodd eq" THEN + SUBGOAL_THEN `(a:num) = b` (LABEL_TAC "exponents") THENL + [DISJ_CASES_TAC(SPECL [`a:num`; `b:num`] LE_CASES) THENL + [SUBGOAL_THEN `(b:num) <= a` MP_TAC THENL + [MATCH_MP_TAC(ISPECL + [`a:num`; `b:num`; `u:num`; `v:num`] + ODD_POWER2_FACTOR_LE) THEN + ASM_REWRITE_TAC[]; + ASM_ARITH_TAC]; + SUBGOAL_THEN `(a:num) <= b` MP_TAC THENL + [MATCH_MP_TAC(ISPECL + [`b:num`; `a:num`; `v:num`; `u:num`] + ODD_POWER2_FACTOR_LE) THEN + ASM_REWRITE_TAC[]; + ASM_ARITH_TAC]]; + ALL_TAC] THEN + CONJ_TAC THENL + [USE_THEN "exponents" ACCEPT_TAC; + USE_THEN "eq" MP_TAC THEN + USE_THEN "exponents" (fun th -> REWRITE_TAC[th]) THEN + REWRITE_TAC[EQ_MULT_LCANCEL; EXP_EQ_0] THEN + ARITH_TAC]);; + +let SARKOVSKII_PRECEDES_ODD_FACTORS = prove + (`!a b u v. + ODD u /\ + ODD v + ==> (sarkovskii_precedes (2 EXP a * u) (2 EXP b * v) <=> + (1 < u /\ + (v = 1 \/ a < b \/ a = b /\ u < v)) \/ + (u = 1 /\ v = 1 /\ b < a))`, + REPEAT GEN_TAC THEN + INTRO_TAC "uodd vodd" THEN + REWRITE_TAC[sarkovskii_precedes] THEN EQ_TAC THENL + [INTRO_TAC "@c d w x. wodd xodd first second order" THEN + SUBGOAL_THEN `(a:num) = c /\ (u:num) = w` + STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC ODD_POWER2_FACTOR_UNIQUE THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `(b:num) = d /\ (v:num) = x` + STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC ODD_POWER2_FACTOR_UNIQUE THEN + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]]; + DISCH_THEN(LABEL_TAC "order") THEN + MAP_EVERY EXISTS_TAC + [`a:num`; `b:num`; `u:num`; `v:num`] THEN + ASM_REWRITE_TAC[]]);; + +let SARKOVSKII_PRECEDES_IRREFLEXIVE = prove + (`!n. ~sarkovskii_precedes n n`, + GEN_TAC THEN REWRITE_TAC[sarkovskii_precedes] THEN + INTRO_TAC "@a b u v. uodd vodd first second order" THEN + SUBGOAL_THEN `(a:num) = b /\ (u:num) = v` + STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC ODD_POWER2_FACTOR_UNIQUE THEN + ASM_REWRITE_TAC[] THEN + USE_THEN "first" (fun th -> REWRITE_TAC[GSYM th]) THEN + USE_THEN "second" (fun th -> REWRITE_TAC[GSYM th]); + ASM_ARITH_TAC]);; + +let SARKOVSKII_PRECEDES_TRANSITIVE = prove + (`!m n p. + sarkovskii_precedes m n /\ + sarkovskii_precedes n p + ==> sarkovskii_precedes m p`, + REPEAT GEN_TAC THEN + INTRO_TAC "first second" THEN + USE_THEN "first" (MP_TAC o REWRITE_RULE[sarkovskii_precedes]) THEN + INTRO_TAC "@a b u v. uodd vodd meq neq order1" THEN + USE_THEN "second" (MP_TAC o REWRITE_RULE[sarkovskii_precedes]) THEN + INTRO_TAC "@c d w x. wodd xodd neqprime peq order2" THEN + SUBGOAL_THEN `(b:num) = c /\ (v:num) = w` + STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC ODD_POWER2_FACTOR_UNIQUE THEN + ASM_REWRITE_TAC[] THEN + USE_THEN "neq" (fun th -> REWRITE_TAC[GSYM th]) THEN + USE_THEN "neqprime" (fun th -> REWRITE_TAC[GSYM th]); + ALL_TAC] THEN + USE_THEN "meq" (fun th -> REWRITE_TAC[th]) THEN + USE_THEN "peq" (fun th -> REWRITE_TAC[th]) THEN + ASM_SIMP_TAC[SARKOVSKII_PRECEDES_ODD_FACTORS] THEN + ASM_ARITH_TAC);; + +let SARKOVSKII_PRECEDES_ASYMMETRIC = prove + (`!m n. + sarkovskii_precedes m n + ==> ~sarkovskii_precedes n m`, + MESON_TAC[SARKOVSKII_PRECEDES_TRANSITIVE; + SARKOVSKII_PRECEDES_IRREFLEXIVE]);; + +let SARKOVSKII_PRECEDES_TRICHOTOMY = prove + (`!m n. + 0 < m /\ + 0 < n + ==> m = n \/ + sarkovskii_precedes m n \/ + sarkovskii_precedes n m`, + REPEAT GEN_TAC THEN + INTRO_TAC "mpos npos" THEN + MP_TAC(SPEC `m:num` EVEN_ODD_DECOMPOSITION) THEN + ASM_REWRITE_TAC[GSYM LT_NZ] THEN + INTRO_TAC "@a u. uodd meq" THEN + MP_TAC(SPEC `n:num` EVEN_ODD_DECOMPOSITION) THEN + ASM_REWRITE_TAC[GSYM LT_NZ] THEN + INTRO_TAC "@b v. vodd neq" THEN + SUBGOAL_THEN `0 < u /\ 0 < v` STRIP_ASSUME_TAC THENL + [CONJ_TAC THEN MATCH_MP_TAC ODD_POS THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + USE_THEN "meq" SUBST_ALL_TAC THEN + USE_THEN "neq" SUBST_ALL_TAC THEN + ASM_SIMP_TAC[SARKOVSKII_PRECEDES_ODD_FACTORS] THEN + ASM_CASES_TAC `(u:num) = 1` THEN + ASM_CASES_TAC `(v:num) = 1` THEN + ASM_CASES_TAC `(a:num) = b` THEN + ASM_CASES_TAC `(u:num) = v` THEN + ASM_REWRITE_TAC[] THEN + ASM_ARITH_TAC);; + +let SARKOVSKII_PRECEDES_3 = prove + (`!n. ~sarkovskii_precedes n 3`, + GEN_TAC THEN REWRITE_TAC[sarkovskii_precedes] THEN + INTRO_TAC "@a b u v. uodd vodd _ three order" THEN + SUBGOAL_THEN `(b:num) = 0 /\ (v:num) = 3` + (CONJUNCTS_THEN2 SUBST_ALL_TAC SUBST_ALL_TAC) THENL + [MATCH_MP_TAC(ISPECL + [`b:num`; `0`; `v:num`; `3`] + ODD_POWER2_FACTOR_UNIQUE) THEN + REPEAT CONJ_TAC THENL + [USE_THEN "vodd" ACCEPT_TAC; + CONV_TAC NUM_REDUCE_CONV; + CONV_TAC NUM_REDUCE_CONV THEN + USE_THEN "three" (ACCEPT_TAC o SYM)]; + ALL_TAC] THEN + REMOVE_THEN "order" MP_TAC THEN + CONV_TAC NUM_REDUCE_CONV THEN + INTRO_TAC "ularge (aneg | _ usmall)" THENL + [ASM_ARITH_TAC; + MP_TAC(SPEC `u:num` ODD_GT_1_IMP_GT_2) THEN + ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC]);; + +let SARKOVSKII_3_PRECEDES = prove + (`!n. + 0 < n + ==> (sarkovskii_precedes 3 n <=> ~(n = 3))`, + GEN_TAC THEN DISCH_THEN(LABEL_TAC "npos") THEN EQ_TAC THENL + [DISCH_THEN(LABEL_TAC "precedes") THEN + DISCH_THEN SUBST_ALL_TAC THEN + USE_THEN "precedes" MP_TAC THEN + REWRITE_TAC[SARKOVSKII_PRECEDES_IRREFLEXIVE]; + DISCH_THEN(LABEL_TAC "neq") THEN + MP_TAC(SPECL [`3`; `n:num`] + SARKOVSKII_PRECEDES_TRICHOTOMY) THEN + ASM_REWRITE_TAC[SARKOVSKII_PRECEDES_3] THEN + ARITH_TAC]);; + +let SARKOVSKII_1_PRECEDES = prove + (`!n. ~sarkovskii_precedes 1 n`, + GEN_TAC THEN REWRITE_TAC[sarkovskii_precedes] THEN + INTRO_TAC "@a b u v. uodd _ one _ order" THEN + SUBGOAL_THEN `(a:num) = 0 /\ (u:num) = 1` + (CONJUNCTS_THEN2 SUBST_ALL_TAC SUBST_ALL_TAC) THENL + [MATCH_MP_TAC(ISPECL + [`a:num`; `0`; `u:num`; `1`] + ODD_POWER2_FACTOR_UNIQUE) THEN + REPEAT CONJ_TAC THENL + [USE_THEN "uodd" ACCEPT_TAC; + CONV_TAC NUM_REDUCE_CONV; + CONV_TAC NUM_REDUCE_CONV THEN + USE_THEN "one" (ACCEPT_TAC o SYM)]; + ALL_TAC] THEN + REMOVE_THEN "order" MP_TAC THEN + CONV_TAC NUM_REDUCE_CONV THEN + ARITH_TAC);; + +let SARKOVSKII_PRECEDES_1 = prove + (`!n. + 0 < n + ==> (sarkovskii_precedes n 1 <=> ~(n = 1))`, + GEN_TAC THEN DISCH_THEN(LABEL_TAC "npos") THEN EQ_TAC THENL + [DISCH_THEN(LABEL_TAC "precedes") THEN + DISCH_THEN SUBST_ALL_TAC THEN + USE_THEN "precedes" MP_TAC THEN + REWRITE_TAC[SARKOVSKII_PRECEDES_IRREFLEXIVE]; + DISCH_THEN(LABEL_TAC "neq") THEN + MP_TAC(SPECL [`n:num`; `1`] + SARKOVSKII_PRECEDES_TRICHOTOMY) THEN + ASM_REWRITE_TAC[SARKOVSKII_1_PRECEDES] THEN + ARITH_TAC]);; + +let SARKOVSKII_PRECEDES_IMP_PERIOD = prove + (`!f m n. + f real_continuous_on (:real) /\ + sarkovskii_precedes m n /\ + has_period f m + ==> has_period f n`, + REPEAT GEN_TAC THEN REWRITE_TAC[sarkovskii_precedes] THEN + INTRO_TAC + "continuous (@a b u v. uodd vodd meq neq order) period" THEN + USE_THEN "neq" SUBST1_TAC THEN + USE_THEN "order" + (DISJ_CASES_THEN2 + (CONJUNCTS_THEN2 (LABEL_TAC "ularge") (LABEL_TAC "later")) + (CONJUNCTS_THEN2 (LABEL_TAC "uone") + (CONJUNCTS_THEN2 (LABEL_TAC "vone") (LABEL_TAC "ba")))) + THENL + [MATCH_MP_TAC(ISPECL + [`f:real->real`; `a:num`; `u:num`; `b:num`; `v:num`] + ODD_FACTOR_PERIOD_IMP_LATER_PERIOD) THEN + REPEAT CONJ_TAC THENL + [USE_THEN "continuous" ACCEPT_TAC; + USE_THEN "uodd" ACCEPT_TAC; + USE_THEN "ularge" ACCEPT_TAC; + USE_THEN "vodd" ACCEPT_TAC; + USE_THEN "period" + (ACCEPT_TAC o REWRITE_RULE[ASSUME + `m = 2 EXP a * u`]); + USE_THEN "later" ACCEPT_TAC]; + USE_THEN "uone" SUBST_ALL_TAC THEN + USE_THEN "vone" SUBST_ALL_TAC THEN + REWRITE_TAC[MULT_CLAUSES] THEN + MATCH_MP_TAC(ISPECL + [`f:real->real`; `a:num`; `b:num`] + HAS_PERIOD_POWER2_MONO) THEN + REPEAT CONJ_TAC THENL + [USE_THEN "continuous" ACCEPT_TAC; + ASM_ARITH_TAC; + USE_THEN "period" + (ACCEPT_TAC o REWRITE_RULE + [ASSUME `m = 2 EXP a * 1`; MULT_CLAUSES])]]);; + +let SARKOVSKII_THEOREM = prove + (`!f m n. + f real_continuous_on (:real) /\ + (m = n \/ sarkovskii_precedes m n) /\ + has_period f m + ==> has_period f n`, + REPEAT GEN_TAC THEN + INTRO_TAC "continuous (eq | precedes) period" THENL + [USE_THEN "eq" (fun th -> + USE_THEN "period" (ACCEPT_TAC o REWRITE_RULE[th])); + MATCH_MP_TAC(ISPECL + [`f:real->real`; `m:num`; `n:num`] + SARKOVSKII_PRECEDES_IMP_PERIOD) THEN + REPEAT CONJ_TAC THENL + [USE_THEN "continuous" ACCEPT_TAC; + USE_THEN "precedes" ACCEPT_TAC; + USE_THEN "period" ACCEPT_TAC]]);; + +let PERIOD_3_IMP_ALL_PERIODS = prove + (`!f n. + f real_continuous_on (:real) /\ + 0 < n /\ + has_period f 3 + ==> has_period f n`, + REPEAT GEN_TAC THEN + INTRO_TAC "continuous npos period" THEN + MATCH_MP_TAC(ISPECL [`f:real->real`; `3`; `n:num`] + SARKOVSKII_THEOREM) THEN + ASM_SIMP_TAC[SARKOVSKII_3_PRECEDES] THEN + ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Localized periods and scalar homeomorphisms. *) +(* ------------------------------------------------------------------------- *) + +let has_period_on = new_definition + `has_period_on (f:A->A) n s <=> + ?x. x IN s /\ minimal_period f n x`;; + +let REAL_CONTINUOUS_ON_EQ_CONTINUOUS_MAP = prove + (`!f s. + f real_continuous_on s <=> + continuous_map + (subtopology euclideanreal s,euclideanreal) f`, + REWRITE_TAC[GSYM MTOPOLOGY_REAL_EUCLIDEAN_METRIC; + GSYM MTOPOLOGY_SUBMETRIC] THEN + REWRITE_TAC[METRIC_CONTINUOUS_MAP; real_continuous_on] THEN + REWRITE_TAC[SUBMETRIC; REAL_EUCLIDEAN_METRIC; IN_UNIV; IN_INTER] THEN + REPEAT GEN_TAC THEN + GEN_REWRITE_TAC (RAND_CONV o ONCE_DEPTH_CONV) [REAL_ABS_SUB] THEN + EQ_TAC THENL + [DISCH_TAC THEN MAP_EVERY X_GEN_TAC [`a:real`; `e:real`] THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `a:real`) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `e:real`) THEN + ASM_REWRITE_TAC[REAL_ABS_SUB]; + DISCH_TAC THEN X_GEN_TAC `a:real` THEN DISCH_TAC THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`a:real`; `e:real`]) THEN + ASM_REWRITE_TAC[REAL_ABS_SUB]]);; + +let REAL_HOMEOMORPHISM = prove + (`!s t h k. + homeomorphic_maps + (subtopology euclideanreal s, + subtopology euclideanreal t) (h,k) <=> + h real_continuous_on s /\ + IMAGE h s SUBSET t /\ + k real_continuous_on t /\ + IMAGE k t SUBSET s /\ + (!x. x IN s ==> k(h x) = x) /\ + (!y. y IN t ==> h(k y) = y)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[homeomorphic_maps; CONTINUOUS_MAP_IN_SUBTOPOLOGY; + TOPSPACE_EUCLIDEANREAL_SUBTOPOLOGY; + REAL_CONTINUOUS_ON_EQ_CONTINUOUS_MAP] THEN + ITAUT_TAC);; + +let ITER_CONJUGATE_ON = prove + (`!f h k s t. + homeomorphic_maps + (subtopology euclideanreal s, + subtopology euclideanreal t) (h,k) /\ + IMAGE f s SUBSET s + ==> !n x. + x IN s + ==> ITER n (h o f o k) (h x) = h(ITER n f x) /\ + ITER n f x IN s`, + REPEAT GEN_TAC THEN + REWRITE_TAC[REAL_HOMEOMORPHISM] THEN + INTRO_TAC "(_ _ _ _ leftinv _) invariant" THEN + INDUCT_TAC THENL + [SIMP_TAC[ITER]; + X_GEN_TAC `x:real` THEN DISCH_THEN(LABEL_TAC "inside") THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:real`) THEN + ASM_REWRITE_TAC[] THEN + INTRO_TAC "iterate iterinside" THEN + REWRITE_TAC[ITER; o_THM] THEN + USE_THEN "iterate" (fun th -> REWRITE_TAC[th]) THEN + USE_THEN "leftinv" (fun th -> ASM_SIMP_TAC[th]) THEN + USE_THEN "invariant" + (MATCH_MP_TAC o REWRITE_RULE[SUBSET; FORALL_IN_IMAGE]) THEN + USE_THEN "iterinside" ACCEPT_TAC]);; + +let MINIMAL_PERIOD_CONJUGATE_ON = prove + (`!f h k s t n x. + homeomorphic_maps + (subtopology euclideanreal s, + subtopology euclideanreal t) (h,k) /\ + IMAGE f s SUBSET s /\ + x IN s + ==> (minimal_period (h o f o k) n (h x) <=> + minimal_period f n x)`, + REPEAT GEN_TAC THEN + INTRO_TAC "homeomorphism invariant inside" THEN + SUBGOAL_THEN + `!m. periodic_point ((h:real->real) o f o k) m (h x) <=> + periodic_point f m x` + (LABEL_TAC "periodic") THENL + [X_GEN_TAC `m:num` THEN + MP_TAC(ISPECL + [`f:real->real`; `h:real->real`; `k:real->real`; + `s:real->bool`; `t:real->bool`] + ITER_CONJUGATE_ON) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPECL [`m:num`; `x:real`]) THEN + ASM_REWRITE_TAC[periodic_point] THEN + INTRO_TAC "iterate iterinside" THEN + USE_THEN "homeomorphism" + (MP_TAC o REWRITE_RULE[REAL_HOMEOMORPHISM]) THEN + INTRO_TAC "_ _ _ _ leftinv _" THEN + USE_THEN "iterate" (fun th -> REWRITE_TAC[th]) THEN + EQ_TAC THENL + [DISCH_THEN(LABEL_TAC "same") THEN + MP_TAC(BETA_RULE(AP_TERM `k:real->real` + (ASSUME `(h:real->real) (ITER m f x) = h x`))) THEN + ASM_SIMP_TAC[]; + DISCH_THEN SUBST1_TAC THEN REFL_TAC]; + REWRITE_TAC[minimal_period] THEN + USE_THEN "periodic" (fun th -> REWRITE_TAC[th])]);; + +let HAS_PERIOD_ON_CONJUGATE = prove + (`!f h k s t n. + homeomorphic_maps + (subtopology euclideanreal s, + subtopology euclideanreal t) (h,k) /\ + IMAGE f s SUBSET s + ==> (has_period_on f n s <=> + has_period_on (h o f o k) n t)`, + REPEAT GEN_TAC THEN + INTRO_TAC "homeomorphism invariant" THEN + USE_THEN "homeomorphism" + (MP_TAC o REWRITE_RULE[REAL_HOMEOMORPHISM]) THEN + INTRO_TAC "_ hinto _ kinto leftinv rightinv" THEN + REWRITE_TAC[has_period_on] THEN EQ_TAC THENL + [INTRO_TAC "@x. inside minimal" THEN + EXISTS_TAC `(h:real->real) x` THEN CONJ_TAC THENL + [USE_THEN "hinto" + (MATCH_MP_TAC o REWRITE_RULE[SUBSET; FORALL_IN_IMAGE]) THEN + USE_THEN "inside" ACCEPT_TAC; + MP_TAC(ISPECL + [`f:real->real`; `h:real->real`; `k:real->real`; + `s:real->bool`; `t:real->bool`; `n:num`; `x:real`] + MINIMAL_PERIOD_CONJUGATE_ON) THEN + ASM_REWRITE_TAC[]]; + INTRO_TAC "@y. inside minimal" THEN + EXISTS_TAC `(k:real->real) y` THEN CONJ_TAC THENL + [USE_THEN "kinto" + (MATCH_MP_TAC o REWRITE_RULE[SUBSET; FORALL_IN_IMAGE]) THEN + USE_THEN "inside" ACCEPT_TAC; + MP_TAC(ISPECL + [`f:real->real`; `h:real->real`; `k:real->real`; + `s:real->bool`; `t:real->bool`; `n:num`; + `(k:real->real) y`] + MINIMAL_PERIOD_CONJUGATE_ON) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN + USE_THEN "kinto" + (MATCH_MP_TAC o REWRITE_RULE[SUBSET; FORALL_IN_IMAGE]) THEN + USE_THEN "inside" ACCEPT_TAC; + DISCH_THEN(MP_TAC) THEN + USE_THEN "rightinv" (fun th -> ASM_SIMP_TAC[th])]]]);; + +(* ------------------------------------------------------------------------- *) +(* Extension from a closed real interval and transfer of periods. *) +(* ------------------------------------------------------------------------- *) + +let REAL_CONTINUOUS_EXTENSION_INTO_REALINTERVAL = prove + (`!f s. + real_closed s /\ + is_realinterval s /\ + ~(s = {}) /\ + f real_continuous_on s /\ + IMAGE f s SUBSET s + ==> ?g. + g real_continuous_on (:real) /\ + IMAGE g (:real) SUBSET s /\ + (!x. x IN s ==> g x = f x)`, + REPEAT GEN_TAC THEN + INTRO_TAC "closed interval nonempty continuous invariant" THEN + MP_TAC(ISPECL + [`euclideanreal`; `f:real->real`; + `s:real->bool`; `s:real->bool`] + TIETZE_EXTENSION_REALINTERVAL) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [REWRITE_TAC[GSYM MTOPOLOGY_REAL_EUCLIDEAN_METRIC] THEN + REWRITE_TAC[NORMAL_SPACE_MTOPOLOGY]; + ASM_REWRITE_TAC[GSYM REAL_CLOSED_IN]; + USE_THEN "interval" ACCEPT_TAC; + USE_THEN "nonempty" ACCEPT_TAC; + REWRITE_TAC[GSYM REAL_CONTINUOUS_ON_EQ_CONTINUOUS_MAP] THEN + USE_THEN "continuous" ACCEPT_TAC; + USE_THEN "invariant" + (ACCEPT_TAC o REWRITE_RULE[SUBSET; FORALL_IN_IMAGE])]; + INTRO_TAC "@g. continuousg intog agrees"] THEN + EXISTS_TAC `g:real->real` THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_MAP] THEN + REWRITE_TAC[GSYM TOPSPACE_EUCLIDEANREAL; + SUBTOPOLOGY_TOPSPACE] THEN + USE_THEN "continuousg" ACCEPT_TAC; + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_UNIV] THEN + X_GEN_TAC `x:real` THEN + USE_THEN "intog" MATCH_MP_TAC THEN + REWRITE_TAC[TOPSPACE_EUCLIDEANREAL; IN_UNIV]; + USE_THEN "agrees" ACCEPT_TAC]);; + +let ITER_EQ_ON_EXTENSION = prove + (`!f g s. + IMAGE f (:A) SUBSET s /\ + (!x. x IN s ==> f x = g x) + ==> !n x. + x IN s + ==> ITER n f x = ITER n g x /\ + ITER n f x IN s`, + REPEAT GEN_TAC THEN + INTRO_TAC "into agrees" THEN + INDUCT_TAC THENL + [SIMP_TAC[ITER]; + X_GEN_TAC `x:A` THEN DISCH_THEN(LABEL_TAC "inside") THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:A`) THEN + ASM_REWRITE_TAC[] THEN + INTRO_TAC "iterate iterinside" THEN + REWRITE_TAC[ITER] THEN + USE_THEN "iterate" (fun th -> REWRITE_TAC[th]) THEN + CONJ_TAC THENL + [USE_THEN "agrees" MATCH_MP_TAC THEN + USE_THEN "iterate" (fun th -> REWRITE_TAC[GSYM th]) THEN + USE_THEN "iterinside" ACCEPT_TAC; + USE_THEN "into" + (MATCH_MP_TAC o REWRITE_RULE[SUBSET; FORALL_IN_IMAGE]) THEN + REWRITE_TAC[IN_UNIV]]]);; + +let MINIMAL_PERIOD_EQ_ON_EXTENSION = prove + (`!f g s n x. + IMAGE f (:A) SUBSET s /\ + (!y. y IN s ==> f y = g y) /\ + x IN s + ==> (minimal_period f n x <=> minimal_period g n x)`, + REPEAT GEN_TAC THEN + INTRO_TAC "into agrees inside" THEN + SUBGOAL_THEN + `!m. periodic_point (f:A->A) m (x:A) <=> + periodic_point g m x` + (LABEL_TAC "periodic") THENL + [X_GEN_TAC `m:num` THEN + MP_TAC(ISPECL [`f:A->A`; `g:A->A`; `s:A->bool`] + ITER_EQ_ON_EXTENSION) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPECL [`m:num`; `x:A`]) THEN + ASM_REWRITE_TAC[periodic_point] THEN MESON_TAC[]; + REWRITE_TAC[minimal_period] THEN + USE_THEN "periodic" (fun th -> REWRITE_TAC[th])]);; + +let PERIODIC_POINT_IN_EXTENSION_RANGE = prove + (`!f:A->A s n x. + IMAGE f (:A) SUBSET s /\ + 0 < n /\ + periodic_point f n x + ==> x IN s`, + REPEAT GEN_TAC THEN + INTRO_TAC "into positive periodic" THEN + MP_TAC(SPEC `n:num` num_CASES) THEN + DISCH_THEN(DISJ_CASES_THEN2 SUBST_ALL_TAC + (X_CHOOSE_THEN `m:num` SUBST_ALL_TAC)) THENL + [ASM_ARITH_TAC; + ALL_TAC] THEN + USE_THEN "into" + (MP_TAC o REWRITE_RULE[SUBSET; FORALL_IN_IMAGE]) THEN + DISCH_THEN(MP_TAC o SPEC `ITER m (f:A->A) x`) THEN + REWRITE_TAC[IN_UNIV] THEN + USE_THEN "periodic" MP_TAC THEN + REWRITE_TAC[periodic_point; ITER] THEN MESON_TAC[]);; + +let HAS_PERIOD_EXTENSION_EQ = prove + (`!f g s n. + IMAGE f (:A) SUBSET s /\ + (!x. x IN s ==> f x = g x) + ==> (has_period f n <=> has_period_on g n s)`, + REPEAT GEN_TAC THEN + INTRO_TAC "into agrees" THEN + REWRITE_TAC[has_period; has_period_on] THEN EQ_TAC THENL + [INTRO_TAC "@x. minimal" THEN + SUBGOAL_THEN `(x:A) IN s` (LABEL_TAC "inside") THENL + [MATCH_MP_TAC(ISPECL [`f:A->A`; `s:A->bool`; `n:num`; `x:A`] + PERIODIC_POINT_IN_EXTENSION_RANGE) THEN + REPEAT CONJ_TAC THENL + [USE_THEN "into" ACCEPT_TAC; + USE_THEN "minimal" + (ACCEPT_TAC o MATCH_MP MINIMAL_PERIOD_POS); + USE_THEN "minimal" + (ACCEPT_TAC o MATCH_MP MINIMAL_PERIOD_PERIODIC)]; + ALL_TAC] THEN + EXISTS_TAC `x:A` THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL + [`f:A->A`; `g:A->A`; `s:A->bool`; `n:num`; `x:A`] + MINIMAL_PERIOD_EQ_ON_EXTENSION) THEN + ASM_REWRITE_TAC[]; + INTRO_TAC "@x. inside minimal" THEN + EXISTS_TAC `x:A` THEN + MP_TAC(ISPECL + [`f:A->A`; `g:A->A`; `s:A->bool`; `n:num`; `x:A`] + MINIMAL_PERIOD_EQ_ON_EXTENSION) THEN + ASM_REWRITE_TAC[]]);; + +let SARKOVSKII_THEOREM_CLOSED_REALINTERVAL = prove + (`!f s m n. + real_closed s /\ + is_realinterval s /\ + f real_continuous_on s /\ + IMAGE f s SUBSET s /\ + (m = n \/ sarkovskii_precedes m n) /\ + has_period_on f m s + ==> has_period_on f n s`, + REPEAT GEN_TAC THEN + INTRO_TAC "closed interval continuous invariant order period" THEN + SUBGOAL_THEN `~(s:real->bool = {})` + (LABEL_TAC "nonempty") THENL + [USE_THEN "period" MP_TAC THEN + REWRITE_TAC[has_period_on] THEN SET_TAC[]; + ALL_TAC] THEN + MP_TAC(ISPECL [`f:real->real`; `s:real->bool`] + REAL_CONTINUOUS_EXTENSION_INTO_REALINTERVAL) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[]; + INTRO_TAC "@g. continuousg intog agrees"] THEN + SUBGOAL_THEN `has_period (g:real->real) m` + (LABEL_TAC "periodg") THENL + [MP_TAC(ISPECL + [`g:real->real`; `f:real->real`; `s:real->bool`; `m:num`] + HAS_PERIOD_EXTENSION_EQ) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `has_period (g:real->real) n` + (LABEL_TAC "targetg") THENL + [MATCH_MP_TAC(ISPECL [`g:real->real`; `m:num`; `n:num`] + SARKOVSKII_THEOREM) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`g:real->real`; `f:real->real`; `s:real->bool`; `n:num`] + HAS_PERIOD_EXTENSION_EQ) THEN + ASM_REWRITE_TAC[]);; + +let SARKOVSKII_THEOREM_HOMEOMORPHIC_CLOSED = prove + (`!f s t h k m n. + homeomorphic_maps + (subtopology euclideanreal s, + subtopology euclideanreal t) (h,k) /\ + real_closed t /\ + is_realinterval t /\ + f real_continuous_on s /\ + IMAGE f s SUBSET s /\ + (m = n \/ sarkovskii_precedes m n) /\ + has_period_on f m s + ==> has_period_on f n s`, + REPEAT GEN_TAC THEN + INTRO_TAC + ("homeomorphism closed interval continuous invariant order " ^ + "period") THEN + USE_THEN "homeomorphism" + (MP_TAC o REWRITE_RULE[REAL_HOMEOMORPHISM]) THEN + INTRO_TAC "hcontinuous hinto kcontinuous kinto _ _" THEN + SUBGOAL_THEN + `((h:real->real) o (f:real->real) o (k:real->real)) + real_continuous_on (t:real->bool)` + (LABEL_TAC "conjugatecontinuous") THENL + [REWRITE_TAC[o_ASSOC] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL + [USE_THEN "kcontinuous" ACCEPT_TAC; + MATCH_MP_TAC REAL_CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `s:real->bool` THEN CONJ_TAC THENL + [USE_THEN "continuous" ACCEPT_TAC; + MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `IMAGE (k:real->real) t` THEN + REWRITE_TAC[SUBSET_REFL] THEN + USE_THEN "kinto" ACCEPT_TAC]; + MATCH_MP_TAC REAL_CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `s:real->bool` THEN CONJ_TAC THENL + [USE_THEN "hcontinuous" ACCEPT_TAC; + MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `IMAGE (f:real->real) s` THEN + CONJ_TAC THENL + [MATCH_MP_TAC IMAGE_SUBSET THEN + MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `IMAGE (k:real->real) t` THEN + REWRITE_TAC[SUBSET_REFL] THEN + USE_THEN "kinto" ACCEPT_TAC; + USE_THEN "invariant" ACCEPT_TAC]]]]; + ALL_TAC] THEN + SUBGOAL_THEN + `IMAGE ((h:real->real) o (f:real->real) o (k:real->real)) + (t:real->bool) SUBSET t` + (LABEL_TAC "conjugateinvariant") THENL + [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; o_THM] THEN + X_GEN_TAC `x:real` THEN DISCH_THEN(LABEL_TAC "inside") THEN + SUBGOAL_THEN `(k:real->real) x IN s` + (LABEL_TAC "kinside") THENL + [USE_THEN "kinto" + (MATCH_MP_TAC o REWRITE_RULE[SUBSET; FORALL_IN_IMAGE]) THEN + USE_THEN "inside" ACCEPT_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `(f:real->real)((k:real->real) x) IN s` + (LABEL_TAC "finside") THENL + [USE_THEN "invariant" + (MATCH_MP_TAC o REWRITE_RULE[SUBSET; FORALL_IN_IMAGE]) THEN + USE_THEN "kinside" ACCEPT_TAC; + ALL_TAC] THEN + USE_THEN "hinto" + (MATCH_MP_TAC o REWRITE_RULE[SUBSET; FORALL_IN_IMAGE]) THEN + USE_THEN "finside" ACCEPT_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `has_period_on + ((h:real->real) o (f:real->real) o (k:real->real)) + m (t:real->bool)` + (LABEL_TAC "conjugateperiod") THENL + [MP_TAC(ISPECL + [`f:real->real`; `h:real->real`; `k:real->real`; + `s:real->bool`; `t:real->bool`; `m:num`] + HAS_PERIOD_ON_CONJUGATE) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `has_period_on + ((h:real->real) o (f:real->real) o (k:real->real)) + n (t:real->bool)` + (LABEL_TAC "conjugatetarget") THENL + [MATCH_MP_TAC(ISPECL + [`(h:real->real) o (f:real->real) o (k:real->real)`; + `t:real->bool`; + `m:num`; `n:num`] + SARKOVSKII_THEOREM_CLOSED_REALINTERVAL) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`f:real->real`; `h:real->real`; `k:real->real`; + `s:real->bool`; `t:real->bool`; `n:num`] + HAS_PERIOD_ON_CONJUGATE) THEN + ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Canonical homeomorphisms for the interval classification. *) +(* ------------------------------------------------------------------------- *) + +let REAL_AFFINITY_HOMEOMORPHISM = prove + (`!s c d. + ~(c = &0) + ==> homeomorphic_maps + (subtopology euclideanreal s, + subtopology euclideanreal + (IMAGE (\x. c * x + d) s)) + ((\x. c * x + d),(\y. (y - d) / c))`, + REPEAT GEN_TAC THEN DISCH_THEN(LABEL_TAC "nonzero") THEN + REWRITE_TAC[REAL_HOMEOMORPHISM] THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_ON_ADD THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_CONST] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_LMUL THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_ID]; + REWRITE_TAC[SUBSET_REFL]; + MATCH_MP_TAC REAL_CONTINUOUS_ON_DIV THEN + ASM_REWRITE_TAC[REAL_CONTINUOUS_ON_CONST] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_SUB THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_ID; REAL_CONTINUOUS_ON_CONST]; + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + X_GEN_TAC `x:real` THEN DISCH_THEN(LABEL_TAC "inside") THEN + SUBGOAL_THEN + `(((c:real) * (x:real) + (d:real)) - d) / c = x` + SUBST1_TAC THENL + [USE_THEN "nonzero" MP_TAC THEN CONV_TAC REAL_FIELD; + USE_THEN "inside" ACCEPT_TAC]; + X_GEN_TAC `x:real` THEN DISCH_TAC THEN + USE_THEN "nonzero" MP_TAC THEN + CONV_TAC REAL_FIELD; + REWRITE_TAC[FORALL_IN_IMAGE] THEN + X_GEN_TAC `x:real` THEN DISCH_TAC THEN + USE_THEN "nonzero" MP_TAC THEN + CONV_TAC REAL_FIELD]);; + +let REAL_EXP_HOMEOMORPHISM = prove + (`homeomorphic_maps + (subtopology euclideanreal (:real), + subtopology euclideanreal {x | &0 < x}) + (exp,log)`, + REWRITE_TAC[REAL_HOMEOMORPHISM] THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[REAL_CONTINUOUS_ON_EXP]; + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN + REWRITE_TAC[REAL_EXP_POS_LT]; + MATCH_MP_TAC REAL_CONTINUOUS_ON_LOG THEN + REWRITE_TAC[IN_ELIM_THM]; + REWRITE_TAC[SUBSET_UNIV]; + REWRITE_TAC[IN_UNIV; LOG_EXP]; + REWRITE_TAC[IN_ELIM_THM] THEN + SIMP_TAC[EXP_LOG]]);; + +let REAL_SHRINK_NONNEGATIVE_HOMEOMORPHISM = prove + (`homeomorphic_maps + (subtopology euclideanreal {x | &0 <= x}, + subtopology euclideanreal {x | &0 <= x /\ x < &1}) + ((\x. x / (&1 + abs x)), + (\y. y / (&1 - abs y)))`, + REWRITE_TAC[REAL_HOMEOMORPHISM] THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_ON_DIV THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[REAL_CONTINUOUS_ON_ID]; + MATCH_MP_TAC REAL_CONTINUOUS_ON_ADD THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_CONST] THEN + MP_TAC(ISPECL + [`\x:real. x`; `{x:real | &0 <= x}`] + REAL_CONTINUOUS_ON_ABS) THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_ID; ETA_AX]; + REWRITE_TAC[IN_ELIM_THM] THEN REAL_ARITH_TAC]; + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN + X_GEN_TAC `x:real` THEN DISCH_THEN(LABEL_TAC "nonnegative") THEN + CONJ_TAC THENL + [MP_TAC(SPECL [`&0`; `x:real`] REAL_SHRINK_LE) THEN + ASM_REWRITE_TAC[REAL_ABS_NUM; real_div; REAL_MUL_LZERO]; + SUBGOAL_THEN `&0 <= x / (&1 + abs x)` + (LABEL_TAC "shrinknonnegative") THENL + [MP_TAC(SPECL [`&0`; `x:real`] REAL_SHRINK_LE) THEN + ASM_REWRITE_TAC[REAL_ABS_NUM; real_div; REAL_MUL_LZERO]; + ALL_TAC] THEN + SUBGOAL_THEN + `abs (x / (&1 + abs x)) = x / (&1 + abs x)` + (LABEL_TAC "absshrink") THENL + [REWRITE_TAC[REAL_ABS_REFL] THEN + USE_THEN "shrinknonnegative" ACCEPT_TAC; + ALL_TAC] THEN + MP_TAC(SPEC `x:real` REAL_SHRINK_RANGE) THEN + ASM_REWRITE_TAC[]]; + MATCH_MP_TAC REAL_CONTINUOUS_ON_DIV THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[REAL_CONTINUOUS_ON_ID]; + MATCH_MP_TAC REAL_CONTINUOUS_ON_SUB THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_CONST] THEN + MP_TAC(ISPECL + [`\x:real. x`; `{x:real | &0 <= x /\ x < &1}`] + REAL_CONTINUOUS_ON_ABS) THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_ID; ETA_AX]; + REWRITE_TAC[IN_ELIM_THM] THEN + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `abs y = y` ASSUME_TAC THENL + [REWRITE_TAC[REAL_ABS_REFL] THEN ASM_REWRITE_TAC[]; + ASM_REAL_ARITH_TAC]]; + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN + X_GEN_TAC `y:real` THEN STRIP_TAC THEN + SUBGOAL_THEN `abs y = y` ASSUME_TAC THENL + [REWRITE_TAC[REAL_ABS_REFL] THEN ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_DIV THEN ASM_REAL_ARITH_TAC]; + REWRITE_TAC[IN_ELIM_THM; REAL_GROW_SHRINK]; + REWRITE_TAC[IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_SHRINK_GROW THEN + SUBGOAL_THEN `abs y = y` (fun th -> REWRITE_TAC[th]) THEN + REWRITE_TAC[REAL_ABS_REFL] THEN ASM_REWRITE_TAC[]]);; + +let REAL_UNIT_OPEN_HOMEOMORPHIC_UNIV = prove + (`?h k. + homeomorphic_maps + (subtopology euclideanreal {x | &0 < x /\ x < &1}, + subtopology euclideanreal (:real)) (h,k)`, + MP_TAC(ISPECL + [`{x:real | &0 < x /\ x < &1}`; `&2`; `-- &1`] + REAL_AFFINITY_HOMEOMORPHISM) THEN + CONV_TAC NUM_REDUCE_CONV THEN + SUBGOAL_THEN + `IMAGE (\x:real. &2 * x + -- &1) + {x | &0 < x /\ x < &1} = + real_interval(-- &1,&1)` + (fun th -> REWRITE_TAC[th]) THENL + [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM; + IN_REAL_INTERVAL] THEN + X_GEN_TAC `y:real` THEN EQ_TAC THENL + [DISCH_THEN(X_CHOOSE_THEN `x:real` STRIP_ASSUME_TAC) THEN + ASM_REAL_ARITH_TAC; + STRIP_TAC THEN EXISTS_TAC `(y + &1) / &2` THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REAL_ARITH_TAC]; + DISCH_THEN(LABEL_TAC "affinity")] THEN + SUBGOAL_THEN + `homeomorphic_maps + (subtopology euclideanreal (real_interval(-- &1,&1)), + subtopology euclideanreal (:real)) + ((\y. y / (&1 - abs y)), + (\x. x / (&1 + abs x)))` + (LABEL_TAC "grow") THENL + [MP_TAC HOMEOMORPHIC_MAPS_REAL_SHRINK THEN + REWRITE_TAC[HOMEOMORPHIC_MAPS_SYM; SUBTOPOLOGY_UNIV]; + ALL_TAC] THEN + MAP_EVERY EXISTS_TAC + [`(\y. y / (&1 - abs y)) o + (\x:real. &2 * x + -- &1)`; + `(\x. (x - -- &1) / &2) o + (\y. y / (&1 + abs y))`] THEN + MATCH_MP_TAC HOMEOMORPHIC_MAPS_COMPOSE THEN + EXISTS_TAC + `subtopology euclideanreal (real_interval(-- &1,&1))` THEN + ASM_REWRITE_TAC[] THEN + USE_THEN "affinity" MATCH_MP_TAC THEN + REAL_ARITH_TAC);; + +let REAL_UNIT_HALFOPEN_HOMEOMORPHIC_NONNEGATIVE = prove + (`homeomorphic_maps + (subtopology euclideanreal {x | &0 <= x /\ x < &1}, + subtopology euclideanreal {x | &0 <= x}) + ((\y. y / (&1 - abs y)), + (\x. x / (&1 + abs x)))`, + MP_TAC REAL_SHRINK_NONNEGATIVE_HOMEOMORPHISM THEN + MESON_TAC[HOMEOMORPHIC_MAPS_SYM]);; + +let REAL_NORMALIZE_OPEN_INTERVAL = prove + (`!a b. + a < b + ==> ?h k. + homeomorphic_maps + (subtopology euclideanreal + {x | a < x /\ x < b}, + subtopology euclideanreal + {y | &0 < y /\ y < &1}) (h,k)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`{x:real | a < x /\ x < b}`; + `inv((b:real) - (a:real))`; + `--(inv((b:real) - (a:real)) * (a:real))`] + REAL_AFFINITY_HOMEOMORPHISM) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[REAL_INV_EQ_0] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `IMAGE + (\x:real. inv(b - a) * x + --(inv(b - a) * a)) + {x | a < x /\ x < b} = + {y | &0 < y /\ y < &1}` + (fun th -> REWRITE_TAC[th]) THENL + [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM] THEN + X_GEN_TAC `y:real` THEN EQ_TAC THENL + [DISCH_THEN(X_CHOOSE_THEN `x:real` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `inv((b:real) - (a:real)) * (x:real) + + --(inv(b - a) * a) = (x - a) / (b - a)` + (fun th -> RULE_ASSUM_TAC(REWRITE_RULE[th])) THENL + [REWRITE_TAC[real_div] THEN CONV_TAC REAL_RING; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < (x:real) - (a:real)` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < (b:real) - (a:real)` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_LDIV_EQ] THEN + ASM_REAL_ARITH_TAC; + STRIP_TAC THEN + EXISTS_TAC `(a:real) + ((b:real) - a) * (y:real)` THEN + CONJ_TAC THENL + [REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD; + CONJ_TAC THENL + [SUBGOAL_THEN + `&0 < ((b:real) - (a:real)) * (y:real)` + MP_TAC THENL + [MATCH_MP_TAC REAL_LT_MUL THEN ASM_REAL_ARITH_TAC; + REAL_ARITH_TAC]; + SUBGOAL_THEN + `((b:real) - (a:real)) * (y:real) < b - a` + MP_TAC THENL + [GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LT_LMUL THEN ASM_REAL_ARITH_TAC; + REAL_ARITH_TAC]]]]; + MESON_TAC[]]);; + +let REAL_NORMALIZE_RIGHT_OPEN_INTERVAL = prove + (`!a b. + a < b + ==> ?h k. + homeomorphic_maps + (subtopology euclideanreal + {x | a <= x /\ x < b}, + subtopology euclideanreal + {y | &0 <= y /\ y < &1}) (h,k)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`{x:real | a <= x /\ x < b}`; + `inv((b:real) - (a:real))`; + `--(inv((b:real) - (a:real)) * (a:real))`] + REAL_AFFINITY_HOMEOMORPHISM) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[REAL_INV_EQ_0] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `IMAGE + (\x:real. inv(b - a) * x + --(inv(b - a) * a)) + {x | a <= x /\ x < b} = + {y | &0 <= y /\ y < &1}` + (fun th -> REWRITE_TAC[th]) THENL + [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM] THEN + X_GEN_TAC `y:real` THEN EQ_TAC THENL + [DISCH_THEN(X_CHOOSE_THEN `x:real` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `inv((b:real) - (a:real)) * (x:real) + + --(inv(b - a) * a) = (x - a) / (b - a)` + (fun th -> RULE_ASSUM_TAC(REWRITE_RULE[th])) THENL + [REWRITE_TAC[real_div] THEN CONV_TAC REAL_RING; + ALL_TAC] THEN + SUBGOAL_THEN `&0 <= (x:real) - (a:real)` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < (b:real) - (a:real)` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `&0 <= (b:real) - (a:real)` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LE_DIV; REAL_LT_LDIV_EQ] THEN + ASM_REAL_ARITH_TAC; + STRIP_TAC THEN + EXISTS_TAC `(a:real) + ((b:real) - a) * (y:real)` THEN + CONJ_TAC THENL + [REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD; + CONJ_TAC THENL + [SUBGOAL_THEN + `&0 <= ((b:real) - (a:real)) * (y:real)` + MP_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN ASM_REAL_ARITH_TAC; + REAL_ARITH_TAC]; + SUBGOAL_THEN + `((b:real) - (a:real)) * (y:real) < b - a` + MP_TAC THENL + [GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LT_LMUL THEN ASM_REAL_ARITH_TAC; + REAL_ARITH_TAC]]]]; + MESON_TAC[]]);; + +let REAL_NORMALIZE_LEFT_OPEN_INTERVAL = prove + (`!a b. + a < b + ==> ?h k. + homeomorphic_maps + (subtopology euclideanreal + {x | a < x /\ x <= b}, + subtopology euclideanreal + {y | &0 <= y /\ y < &1}) (h,k)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`{x:real | a < x /\ x <= b}`; + `--inv((b:real) - (a:real))`; + `inv((b:real) - (a:real)) * (b:real)`] + REAL_AFFINITY_HOMEOMORPHISM) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[REAL_NEG_EQ_0; REAL_INV_EQ_0] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `IMAGE + (\x:real. --inv(b - a) * x + inv(b - a) * b) + {x | a < x /\ x <= b} = + {y | &0 <= y /\ y < &1}` + (fun th -> REWRITE_TAC[th]) THENL + [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM] THEN + X_GEN_TAC `y:real` THEN EQ_TAC THENL + [DISCH_THEN(X_CHOOSE_THEN `x:real` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `--inv((b:real) - (a:real)) * (x:real) + + inv(b - a) * b = (b - x) / (b - a)` + (fun th -> RULE_ASSUM_TAC(REWRITE_RULE[th])) THENL + [REWRITE_TAC[real_div] THEN CONV_TAC REAL_RING; + ALL_TAC] THEN + SUBGOAL_THEN `&0 <= (b:real) - (x:real)` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < (b:real) - (a:real)` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `&0 <= (b:real) - (a:real)` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LE_DIV; REAL_LT_LDIV_EQ] THEN + ASM_REAL_ARITH_TAC; + STRIP_TAC THEN + EXISTS_TAC `(b:real) - ((b:real) - a) * (y:real)` THEN + CONJ_TAC THENL + [REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD; + CONJ_TAC THENL + [SUBGOAL_THEN + `((b:real) - (a:real)) * (y:real) < b - a` + MP_TAC THENL + [GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LT_LMUL THEN ASM_REAL_ARITH_TAC; + REAL_ARITH_TAC]; + SUBGOAL_THEN + `&0 <= ((b:real) - (a:real)) * (y:real)` + MP_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN ASM_REAL_ARITH_TAC; + REAL_ARITH_TAC]]]]; + MESON_TAC[]]);; + +let REAL_OPEN_INTERVAL_HOMEOMORPHIC_UNIV = prove + (`!a b. + a < b + ==> ?h k. + homeomorphic_maps + (subtopology euclideanreal + {x | a < x /\ x < b}, + subtopology euclideanreal (:real)) (h,k)`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`a:real`; `b:real`] + REAL_NORMALIZE_OPEN_INTERVAL) THEN + ASM_REWRITE_TAC[] THEN + INTRO_TAC "@h k. normalize" THEN + MP_TAC REAL_UNIT_OPEN_HOMEOMORPHIC_UNIV THEN + INTRO_TAC "@h' k'. canonical" THEN + MAP_EVERY EXISTS_TAC + [`(h':real->real) o (h:real->real)`; + `(k:real->real) o (k':real->real)`] THEN + MATCH_MP_TAC HOMEOMORPHIC_MAPS_COMPOSE THEN + EXISTS_TAC + `subtopology euclideanreal {x:real | &0 < x /\ x < &1}` THEN + ASM_REWRITE_TAC[]);; + +let REAL_RIGHT_OPEN_INTERVAL_HOMEOMORPHIC_NONNEGATIVE = prove + (`!a b. + a < b + ==> ?h k. + homeomorphic_maps + (subtopology euclideanreal + {x | a <= x /\ x < b}, + subtopology euclideanreal {x | &0 <= x}) (h,k)`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`a:real`; `b:real`] + REAL_NORMALIZE_RIGHT_OPEN_INTERVAL) THEN + ASM_REWRITE_TAC[] THEN + INTRO_TAC "@h k. normalize" THEN + MAP_EVERY EXISTS_TAC + [`(\y. y / (&1 - abs y)) o (h:real->real)`; + `(k:real->real) o (\x. x / (&1 + abs x))`] THEN + MATCH_MP_TAC HOMEOMORPHIC_MAPS_COMPOSE THEN + EXISTS_TAC + `subtopology euclideanreal {x:real | &0 <= x /\ x < &1}` THEN + ASM_REWRITE_TAC[REAL_UNIT_HALFOPEN_HOMEOMORPHIC_NONNEGATIVE]);; + +let REAL_LEFT_OPEN_INTERVAL_HOMEOMORPHIC_NONNEGATIVE = prove + (`!a b. + a < b + ==> ?h k. + homeomorphic_maps + (subtopology euclideanreal + {x | a < x /\ x <= b}, + subtopology euclideanreal {x | &0 <= x}) (h,k)`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`a:real`; `b:real`] + REAL_NORMALIZE_LEFT_OPEN_INTERVAL) THEN + ASM_REWRITE_TAC[] THEN + INTRO_TAC "@h k. normalize" THEN + MAP_EVERY EXISTS_TAC + [`(\y. y / (&1 - abs y)) o (h:real->real)`; + `(k:real->real) o (\x. x / (&1 + abs x))`] THEN + MATCH_MP_TAC HOMEOMORPHIC_MAPS_COMPOSE THEN + EXISTS_TAC + `subtopology euclideanreal {x:real | &0 <= x /\ x < &1}` THEN + ASM_REWRITE_TAC[REAL_UNIT_HALFOPEN_HOMEOMORPHIC_NONNEGATIVE]);; + +let REAL_OPEN_UPPER_RAY_HOMEOMORPHIC_UNIV = prove + (`!a. + ?h k. + homeomorphic_maps + (subtopology euclideanreal {x | a < x}, + subtopology euclideanreal (:real)) (h,k)`, + GEN_TAC THEN + MP_TAC(ISPECL + [`{x:real | a < x}`; `&1`; `--(a:real)`] + REAL_AFFINITY_HOMEOMORPHISM) THEN + CONV_TAC NUM_REDUCE_CONV THEN + SUBGOAL_THEN + `IMAGE (\x:real. &1 * x + --a) {x | a < x} = + {x | &0 < x}` + (fun th -> REWRITE_TAC[th]) THENL + [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM] THEN + X_GEN_TAC `y:real` THEN EQ_TAC THENL + [DISCH_THEN(X_CHOOSE_THEN `x:real` STRIP_ASSUME_TAC) THEN + ASM_REAL_ARITH_TAC; + DISCH_TAC THEN + EXISTS_TAC `(y:real) + (a:real)` THEN + ASM_REAL_ARITH_TAC]; + DISCH_THEN(LABEL_TAC "affinity")] THEN + SUBGOAL_THEN + `homeomorphic_maps + (subtopology euclideanreal {x:real | &0 < x}, + subtopology euclideanreal (:real)) (log,exp)` + (LABEL_TAC "logarithm") THENL + [MP_TAC REAL_EXP_HOMEOMORPHISM THEN + MESON_TAC[HOMEOMORPHIC_MAPS_SYM]; + ALL_TAC] THEN + MAP_EVERY EXISTS_TAC + [`log o (\x:real. &1 * x + --a)`; + `(\y:real. (y - --(a:real)) / &1) o exp`] THEN + MATCH_MP_TAC HOMEOMORPHIC_MAPS_COMPOSE THEN + EXISTS_TAC `subtopology euclideanreal {x:real | &0 < x}` THEN + ASM_REWRITE_TAC[] THEN + USE_THEN "affinity" MATCH_MP_TAC THEN + REAL_ARITH_TAC);; + +let REAL_OPEN_LOWER_RAY_HOMEOMORPHIC_UNIV = prove + (`!b. + ?h k. + homeomorphic_maps + (subtopology euclideanreal {x | x < b}, + subtopology euclideanreal (:real)) (h,k)`, + GEN_TAC THEN + MP_TAC(ISPECL + [`{x:real | x < b}`; `-- &1`; `(b:real)`] + REAL_AFFINITY_HOMEOMORPHISM) THEN + CONV_TAC NUM_REDUCE_CONV THEN + SUBGOAL_THEN + `IMAGE (\x:real. -- &1 * x + b) {x | x < b} = + {x | &0 < x}` + (fun th -> REWRITE_TAC[th]) THENL + [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM] THEN + X_GEN_TAC `y:real` THEN EQ_TAC THENL + [DISCH_THEN(X_CHOOSE_THEN `x:real` STRIP_ASSUME_TAC) THEN + ASM_REAL_ARITH_TAC; + DISCH_TAC THEN + EXISTS_TAC `(b:real) - (y:real)` THEN + ASM_REAL_ARITH_TAC]; + DISCH_THEN(LABEL_TAC "affinity")] THEN + SUBGOAL_THEN + `homeomorphic_maps + (subtopology euclideanreal {x:real | &0 < x}, + subtopology euclideanreal (:real)) (log,exp)` + (LABEL_TAC "logarithm") THENL + [MP_TAC REAL_EXP_HOMEOMORPHISM THEN + MESON_TAC[HOMEOMORPHIC_MAPS_SYM]; + ALL_TAC] THEN + MAP_EVERY EXISTS_TAC + [`log o (\x:real. -- &1 * x + b)`; + `(\y:real. (y - (b:real)) / -- &1) o exp`] THEN + MATCH_MP_TAC HOMEOMORPHIC_MAPS_COMPOSE THEN + EXISTS_TAC `subtopology euclideanreal {x:real | &0 < x}` THEN + ASM_REWRITE_TAC[] THEN + USE_THEN "affinity" MATCH_MP_TAC THEN + REAL_ARITH_TAC);; + +let IS_REALINTERVAL_HOMEOMORPHIC_CLOSED = prove + (`!s. + is_realinterval s /\ + ~(s = {}) + ==> ?t h k. + real_closed t /\ + is_realinterval t /\ + homeomorphic_maps + (subtopology euclideanreal s, + subtopology euclideanreal t) (h,k)`, + GEN_TAC THEN + INTRO_TAC "interval nonempty" THEN + MP_TAC(SPEC `s:real->bool` IS_REAL_INTERVAL_CASES) THEN + ASM_REWRITE_TAC[] THEN + INTRO_TAC + ("univ | (@a. upperopen) | (@a. upperclosed) | " ^ + "(@b. lowerclosed) | (@b. loweropen) | (@a b. boundedopen) | " ^ + "(@a b. leftopen) | (@a b. rightopen) | " ^ + "(@a b. boundedclosed)") THENL + [USE_THEN "univ" SUBST_ALL_TAC THEN + MAP_EVERY EXISTS_TAC + [`(:real)`; `I:real->real`; `I:real->real`] THEN + REWRITE_TAC[REAL_CLOSED_UNIV; IS_REALINTERVAL_CLAUSES; + HOMEOMORPHIC_MAPS_I]; + USE_THEN "upperopen" SUBST_ALL_TAC THEN + MP_TAC(SPEC `a:real` + REAL_OPEN_UPPER_RAY_HOMEOMORPHIC_UNIV) THEN + INTRO_TAC "@h k. homeomorphism" THEN + MAP_EVERY EXISTS_TAC + [`(:real)`; `h:real->real`; `k:real->real`] THEN + ASM_REWRITE_TAC[REAL_CLOSED_UNIV; IS_REALINTERVAL_CLAUSES]; + USE_THEN "upperclosed" SUBST_ALL_TAC THEN + MAP_EVERY EXISTS_TAC + [`{x:real | a <= x}`; `I:real->real`; `I:real->real`] THEN + REWRITE_TAC[GSYM real_ge; REAL_CLOSED_HALFSPACE_GE; + IS_REALINTERVAL_CLAUSES; + HOMEOMORPHIC_MAPS_I]; + USE_THEN "lowerclosed" SUBST_ALL_TAC THEN + MAP_EVERY EXISTS_TAC + [`{x:real | x <= b}`; `I:real->real`; `I:real->real`] THEN + REWRITE_TAC[REAL_CLOSED_HALFSPACE_LE; IS_REALINTERVAL_CLAUSES; + HOMEOMORPHIC_MAPS_I]; + USE_THEN "loweropen" SUBST_ALL_TAC THEN + MP_TAC(SPEC `b:real` + REAL_OPEN_LOWER_RAY_HOMEOMORPHIC_UNIV) THEN + INTRO_TAC "@h k. homeomorphism" THEN + MAP_EVERY EXISTS_TAC + [`(:real)`; `h:real->real`; `k:real->real`] THEN + ASM_REWRITE_TAC[REAL_CLOSED_UNIV; IS_REALINTERVAL_CLAUSES]; + USE_THEN "boundedopen" SUBST_ALL_TAC THEN + SUBGOAL_THEN `(a:real) < b` (LABEL_TAC "ordered") THENL + [ASM_CASES_TAC `(a:real) < b` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `{x:real | a < x /\ x < b} = {}` + (fun th -> USE_THEN "nonempty" + (fun nth -> CONTR_TAC(MP (NOT_ELIM nth) th))) THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(SPECL [`a:real`; `b:real`] + REAL_OPEN_INTERVAL_HOMEOMORPHIC_UNIV) THEN + ASM_REWRITE_TAC[] THEN + INTRO_TAC "@h k. homeomorphism" THEN + MAP_EVERY EXISTS_TAC + [`(:real)`; `h:real->real`; `k:real->real`] THEN + ASM_REWRITE_TAC[REAL_CLOSED_UNIV; IS_REALINTERVAL_CLAUSES]; + USE_THEN "leftopen" SUBST_ALL_TAC THEN + SUBGOAL_THEN `(a:real) < b` (LABEL_TAC "ordered") THENL + [ASM_CASES_TAC `(a:real) < b` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `{x:real | a < x /\ x <= b} = {}` + (fun th -> USE_THEN "nonempty" + (fun nth -> CONTR_TAC(MP (NOT_ELIM nth) th))) THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(SPECL [`a:real`; `b:real`] + REAL_LEFT_OPEN_INTERVAL_HOMEOMORPHIC_NONNEGATIVE) THEN + ASM_REWRITE_TAC[] THEN + INTRO_TAC "@h k. homeomorphism" THEN + MAP_EVERY EXISTS_TAC + [`{x:real | &0 <= x}`; `h:real->real`; `k:real->real`] THEN + ASM_REWRITE_TAC[GSYM real_ge; REAL_CLOSED_HALFSPACE_GE; + IS_REALINTERVAL_CLAUSES]; + USE_THEN "rightopen" SUBST_ALL_TAC THEN + SUBGOAL_THEN `(a:real) < b` (LABEL_TAC "ordered") THENL + [ASM_CASES_TAC `(a:real) < b` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `{x:real | a <= x /\ x < b} = {}` + (fun th -> USE_THEN "nonempty" + (fun nth -> CONTR_TAC(MP (NOT_ELIM nth) th))) THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(SPECL [`a:real`; `b:real`] + REAL_RIGHT_OPEN_INTERVAL_HOMEOMORPHIC_NONNEGATIVE) THEN + ASM_REWRITE_TAC[] THEN + INTRO_TAC "@h k. homeomorphism" THEN + MAP_EVERY EXISTS_TAC + [`{x:real | &0 <= x}`; `h:real->real`; `k:real->real`] THEN + ASM_REWRITE_TAC[GSYM real_ge; REAL_CLOSED_HALFSPACE_GE; + IS_REALINTERVAL_CLAUSES]; + USE_THEN "boundedclosed" SUBST_ALL_TAC THEN + SUBGOAL_THEN + `{x:real | a <= x /\ x <= b} = real_interval[a,b]` + SUBST_ALL_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_REAL_INTERVAL]; + ALL_TAC] THEN + MAP_EVERY EXISTS_TAC + [`real_interval[a,b]`; `I:real->real`; `I:real->real`] THEN + REWRITE_TAC[REAL_CLOSED_REAL_INTERVAL; IS_REALINTERVAL_CLAUSES; + HOMEOMORPHIC_MAPS_I; IS_REALINTERVAL_INTERVAL]]);; + +let SARKOVSKII_THEOREM_ON_REALINTERVAL = prove + (`!f s m n. + is_realinterval s /\ + f real_continuous_on s /\ + IMAGE f s SUBSET s /\ + (m = n \/ sarkovskii_precedes m n) /\ + has_period_on f m s + ==> has_period_on f n s`, + REPEAT GEN_TAC THEN + INTRO_TAC "interval continuous invariant order period" THEN + SUBGOAL_THEN `~(s:real->bool = {})` + (LABEL_TAC "nonempty") THENL + [USE_THEN "period" MP_TAC THEN + REWRITE_TAC[has_period_on] THEN SET_TAC[]; + ALL_TAC] THEN + MP_TAC(SPEC `s:real->bool` + IS_REALINTERVAL_HOMEOMORPHIC_CLOSED) THEN + ASM_REWRITE_TAC[] THEN + INTRO_TAC "@t h k. closed targetinterval homeomorphism" THEN + MATCH_MP_TAC(ISPECL + [`f:real->real`; `s:real->bool`; `t:real->bool`; + `h:real->real`; `k:real->real`; `m:num`; `n:num`] + SARKOVSKII_THEOREM_HOMEOMORPHIC_CLOSED) THEN + ASM_REWRITE_TAC[]);; + +let PERIOD_3_IMP_ALL_PERIODS_ON_REALINTERVAL = prove + (`!f s n. + is_realinterval s /\ + f real_continuous_on s /\ + IMAGE f s SUBSET s /\ + 0 < n /\ + has_period_on f 3 s + ==> has_period_on f n s`, + REPEAT GEN_TAC THEN + INTRO_TAC "interval continuous invariant positive period" THEN + MATCH_MP_TAC(ISPECL + [`f:real->real`; `s:real->bool`; `3`; `n:num`] + SARKOVSKII_THEOREM_ON_REALINTERVAL) THEN + ASM_SIMP_TAC[SARKOVSKII_3_PRECEDES] THEN + ARITH_TAC);; diff --git a/Autoformalization/three_squares.ml b/Autoformalization/three_squares.ml new file mode 100644 index 00000000..be42269b --- /dev/null +++ b/Autoformalization/three_squares.ml @@ -0,0 +1,2084 @@ +(* ========================================================================= *) +(* Legendre's three-square theorem and Gauss's triangular number theorem. *) +(* *) +(* Main results: LEGENDRE_THREE_SQUARES characterizes the natural numbers *) +(* that are sums of three squares; GAUSS_TRIANGULAR and *) +(* GAUSS_TRIANGULAR_SUM state that every natural number is a sum of three *) +(* triangular numbers. *) +(* *) +(* The development follows the self-contained elementary proof of Nathanson, *) +(* "Additive Number Theory: The Classical Bases", section 1.5: *) +(* (A) reduction theory of integral quadratic forms -- a positive-definite *) +(* ternary form of discriminant 1 represents only sums of three *) +(* squares (Nathanson Thm 1.3, here TSQ_DISC1); *) +(* (B) Lemma 1.7 (LEMMA_1_7 / LEMMA_1_7_CONG) -- if -d' is a quadratic *) +(* residue mod d'n - 1 then n is a sum of three squares (an explicit *) +(* discriminant-1 form representing n); *) +(* (C) Lemmas 1.8/1.9 -- Dirichlet's theorem on primes in arithmetic *) +(* progressions together with quadratic reciprocity supply the needed *) +(* residue for each class n = 1,2,3,5,6 (mod 8); *) +(* (D) the 4^a descent and parity assemble the full iff and Gauss's *) +(* theorem. *) +(* ========================================================================= *) + +needs "Library/jacobi.ml";; +needs "100/dirichlet.ml";; + +prioritize_int();; + +(* ------------------------------------------------------------------------- *) +(* Nearest-integer approximation and the resulting square bound. *) +(* ------------------------------------------------------------------------- *) + +let INT_BALANCED_REM = prove + (`!x q:int. &0 < q ==> ?b. abs(x - q * b) * &2 <= q`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`x:int`; `q:int`] INT_DIVISION) THEN + ANTS_TAC THENL [ASM_INT_ARITH_TAC; ALL_TAC] THEN + ABBREV_TAC `r = x rem q` THEN ABBREV_TAC `d = x div q` THEN STRIP_TAC THEN + ASM_CASES_TAC `r * &2 <= q` THENL + [EXISTS_TAC `d:int`; EXISTS_TAC `d + &1`] THEN ASM_INT_ARITH_TAC);; + +let SQ_BOUND = prove + (`!a q:int. abs a * &2 <= q ==> &4 * a pow 2 <= q pow 2`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(abs a * &2) pow 2 <= q pow 2` MP_TAC THENL + [MATCH_MP_TAC INT_POW_LE2 THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC INT_LE_MUL THEN REWRITE_TAC[INT_ABS_POS] THEN INT_ARITH_TAC; + REWRITE_TAC[INT_POW_MUL; INT_POW2_ABS] THEN INT_ARITH_TAC]);; + +(* ========================================================================= *) +(* QUADRATIC FORM REDUCTION THEORY (Nathanson sec 1.4-1.5). Forms are *) +(* encoded by their integer matrix entries; a binary form is (A11,A12,A22) *) +(* |-> A11 x^2 + 2 A12 x y + A22 y^2 with discriminant A11 A22 - A12^2, and *) +(* similarly for ternary forms. *) +(* ========================================================================= *) + +(* ------------------------------------------------------------------------- *) +(* Binary forms: positive-definiteness criterion (Nathanson Lemma 1.1, hard *) +(* direction) and the discriminant-1 reduction theorem (Nathanson Thm 1.2): *) +(* a positive-definite binary form of discriminant 1 represents only sums of *) +(* two squares. Proved by the classical reduce-and-swap descent on A11. *) +(* ------------------------------------------------------------------------- *) + +let POSDEF_BINARY_CRITERION = prove + (`!A11 A12 A22:int. + &0 < A11 /\ &0 < A11 * A22 - A12 pow 2 + ==> !x y. ~(x = &0 /\ y = &0) + ==> &0 < A11 * x pow 2 + &2 * A12 * x * y + A22 * y pow 2`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `y = &0` THENL + [SUBGOAL_THEN `~(x = &0)` ASSUME_TAC THENL + [UNDISCH_TAC `~(x = &0 /\ y = &0)` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `A11*x pow 2 + &2*A12*x*y + A22*y pow 2 = A11 * x pow 2` SUBST1_TAC THENL + [ASM_REWRITE_TAC[] THEN CONV_TAC INT_RING; ALL_TAC] THEN + MATCH_MP_TAC INT_LT_MUL THEN ASM_SIMP_TAC[INT_LT_POW_2]; + SUBGOAL_THEN + `&0 < A11 * + (A11*x pow 2 + &2*A12*x*y + A22*y pow 2)` MP_TAC THENL + [SUBGOAL_THEN + `A11 * (A11*x pow 2 + &2*A12*x*y + A22*y pow 2) = + (A11*x + A12*y) pow 2 + (A11*A22 - A12 pow 2) * y pow 2` + SUBST1_TAC THENL [CONV_TAC INT_RING; ALL_TAC] THEN + MATCH_MP_TAC(INT_ARITH `&0 <= a /\ &0 < b ==> &0 < a + b`) THEN + REWRITE_TAC[INT_LE_POW_2] THEN + MATCH_MP_TAC INT_LT_MUL THEN ASM_SIMP_TAC[INT_LT_POW_2]; + ASM_SIMP_TAC[INT_LT_MUL_EQ]]]);; + +let BINARY_DISC1 = prove + (`!A11. &0 < A11 + ==> !A12 A22. A11 * A22 - A12 pow 2 = &1 + ==> !n. (?x y. A11 * x pow 2 + &2 * A12 * x * y + A22 * y pow 2 = n) + ==> ?u v:int. u pow 2 + v pow 2 = n`, + MATCH_MP_TAC WF_INT_MEASURE THEN EXISTS_TAC `abs:int->int` THEN + REWRITE_TAC[INT_ABS_POS] THEN + GEN_TAC THEN DISCH_TAC THEN STRIP_TAC THEN REPEAT GEN_TAC THEN DISCH_TAC THEN + GEN_TAC THEN DISCH_THEN(X_CHOOSE_THEN `x:int` (X_CHOOSE_TAC `y:int`)) THEN + ASM_CASES_TAC `A11 = &1` THENL + [MAP_EVERY EXISTS_TAC [`x + A12 * y:int`; `y:int`] THEN + UNDISCH_TAC `A11 * x pow 2 + &2*A12*x*y + A22*y pow 2 = n` THEN + SUBGOAL_THEN `A22 = &1 + A12 pow 2` SUBST1_TAC THENL + [UNDISCH_TAC `A11 * A22 - A12 pow 2 = &1` THEN ASM_REWRITE_TAC[] THEN + INT_ARITH_TAC; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN CONV_TAC INT_RING; + ALL_TAC] THEN + MP_TAC(SPECL [`A12:int`;`A11:int`] INT_BALANCED_REM) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `b:int`) THEN ABBREV_TAC `r = --b:int` THEN + ABBREV_TAC `A12' = A12 + A11 * r` THEN + ABBREV_TAC `A22' = A11*r pow 2 + &2*A12*r + A22` THEN + SUBGOAL_THEN `abs A12' * &2 <= A11` ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["A12'";"r"] THEN + UNDISCH_TAC `abs (A12 - A11 * b) * &2 <= A11` THEN + REWRITE_TAC[INT_ARITH `A12 + A11 * --b = A12 - A11 * b`]; + ALL_TAC] THEN + SUBGOAL_THEN `A11 * A22' - A12' pow 2 = &1` ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["A12'";"A22'"] THEN + UNDISCH_TAC `A11 * A22 - A12 pow 2 = &1` THEN INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < A22'` ASSUME_TAC THENL + [SUBGOAL_THEN `&0 < A11 * A22'` MP_TAC THENL + [SUBGOAL_THEN `A11 * A22' = &1 + A12' pow 2` SUBST1_TAC THENL + [ASM_INT_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPEC `A12':int` INT_LE_POW_2) THEN INT_ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[INT_LT_MUL_EQ]; + ALL_TAC] THEN + SUBGOAL_THEN `A22' < A11` ASSUME_TAC THENL + [SUBGOAL_THEN `&4 * (A11 * A22') <= &4 + A11 pow 2` ASSUME_TAC THENL + [SUBGOAL_THEN `A11 * A22' = &1 + A12' pow 2` + (fun th -> REWRITE_TAC[th]) THENL + [ASM_INT_ARITH_TAC; ALL_TAC] THEN + MP_TAC(MATCH_MP SQ_BOUND (ASSUME `abs A12' * &2 <= A11`)) THEN + INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `&2 <= A11` ASSUME_TAC THENL [ASM_INT_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `&4 <= A11 * A11` ASSUME_TAC THENL + [MATCH_MP_TAC INT_LE_TRANS THEN EXISTS_TAC `&2 * A11` THEN CONJ_TAC THENL + [ASM_INT_ARITH_TAC; MATCH_MP_TAC INT_LE_RMUL THEN ASM_INT_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN `A11 * (&4 * A22') < A11 * (&4 * A11)` MP_TAC THENL + [MATCH_MP_TAC INT_LET_TRANS THEN EXISTS_TAC `&4 + A11 pow 2` THEN + CONJ_TAC THENL + [UNDISCH_TAC `&4 * (A11*A22') <= &4 + A11 pow 2` THEN INT_ARITH_TAC; + REWRITE_TAC[INT_POW_2] THEN + UNDISCH_TAC `&4 <= A11 * A11` THEN INT_ARITH_TAC]; + ALL_TAC] THEN + ASM_SIMP_TAC[INT_LT_LMUL_EQ] THEN INT_ARITH_TAC; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `A22':int`) THEN + ANTS_TAC THENL [ASM_INT_ARITH_TAC; ALL_TAC] THEN + ANTS_TAC THENL [FIRST_ASSUM ACCEPT_TAC; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPECL [`A12':int`; `A11:int`]) THEN + ANTS_TAC THENL [UNDISCH_TAC `A11 * A22' - A12' pow 2 = &1` THEN + INT_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN MATCH_MP_TAC THEN + MAP_EVERY EXISTS_TAC [`y:int`; `x - r * y:int`] THEN + MAP_EVERY EXPAND_TAC ["A12'";"A22'"] THEN + UNDISCH_TAC `A11 * x pow 2 + &2*A12*x*y + A22*y pow 2 = n` THEN + CONV_TAC INT_RING);; + +(* ------------------------------------------------------------------------- *) +(* Ternary forms: completion of the square (Nathanson Lemma 1.3) and the *) +(* discriminant-1 representation theorem. TERNARY_COMPLETE expresses a11*F = *) +(* (a11 x1 + a12 x2 + a13 x3)^2 + G(x2,x3) with G the "lower" binary form. *) +(* TSQ_DISC1_A11_1 handles the reduced case a11 = 1 by completing the square *) +(* and applying the binary theorem BINARY_DISC1 to G. *) +(* ------------------------------------------------------------------------- *) + +let TERNARY_COMPLETE = INT_RING + `!a11 a12 a13 a22 a23 a33 x1 x2 x3:int. + a11 * (a11 * x1 pow 2 + a22 * x2 pow 2 + a33 * x3 pow 2 + + &2 * a12 * x1 * x2 + &2 * a13 * x1 * x3 + &2 * a23 * x2 * x3) = + (a11 * x1 + a12 * x2 + a13 * x3) pow 2 + + ((a11 * a22 - a12 pow 2) * x2 pow 2 + + &2 * (a11 * a23 - a12 * a13) * x2 * x3 + + (a11 * a33 - a13 pow 2) * x3 pow 2)`;; + +let TSQ_DISC1_A11_1 = prove + (`!a12 a13 a22 a23 a33 n:int. + &0 < &1 * a22 - a12 pow 2 /\ + &1 * (a22 * a33 - a23 pow 2) - a12 * (a12 * a33 - a23 * a13) + + a13 * (a12 * a23 - a22 * a13) = &1 /\ + (?x1 x2 x3. &1 * x1 pow 2 + a22 * x2 pow 2 + a33 * x3 pow 2 + + &2 * a12 * x1 * x2 + &2 * a13 * x1 * x3 + + &2 * a23 * x2 * x3 = n) + ==> ?u v w:int. u pow 2 + v pow 2 + w pow 2 = n`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + ABBREV_TAC `G11 = a22 - a12 pow 2` THEN + ABBREV_TAC `G12 = a23 - a12 * a13` THEN + ABBREV_TAC `G22 = a33 - a13 pow 2` THEN + SUBGOAL_THEN `G11 * G22 - G12 pow 2 = &1` ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["G11";"G12";"G22"] THEN + UNDISCH_TAC + `&1*(a22*a33 - a23 pow 2) - a12*(a12*a33 - a23*a13) + + a13*(a12*a23 - a22*a13) = &1` THEN + INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < G11` ASSUME_TAC THENL + [EXPAND_TAC "G11" THEN UNDISCH_TAC `&0 < &1*a22 - a12 pow 2` THEN + INT_ARITH_TAC; + ALL_TAC] THEN + ABBREV_TAC `L = x1 + a12*x2 + a13*x3` THEN + MP_TAC(ISPECL [`G11:int`] BINARY_DISC1) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPECL [`G12:int`; `G22:int`]) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `n - L pow 2`) THEN + ANTS_TAC THENL + [MAP_EVERY EXISTS_TAC [`x2:int`; `x3:int`] THEN + MP_TAC(SPECL [`&1:int`;`a12:int`;`a13:int`;`a22:int`;`a23:int`;`a33:int`; + `x1:int`;`x2:int`;`x3:int`] TERNARY_COMPLETE) THEN + ASM_REWRITE_TAC[INT_MUL_LID] THEN + MAP_EVERY EXPAND_TAC ["G11";"G12";"G22";"L"] THEN INT_ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `u:int` (X_CHOOSE_TAC `v:int`)) THEN + MAP_EVERY EXISTS_TAC [`L:int`; `u:int`; `v:int`] THEN + UNDISCH_TAC `u pow 2 + v pow 2 = n - L pow 2` THEN INT_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* SL3 extension (Nathanson Lemma 1.5): a primitive integer vector *) +(* (u1,u2,u3) [i.e. exists x y z. u1 x + u2 y + u3 z = 1] occurs as the *) +(* first column of a 3x3 integer matrix of determinant 1. We expose only the *) +(* cofactor identity needed downstream (the determinant expanded along the *) +(* first column equals 1, with the first column = (u1,u2,u3)). Built from *) +(* two Bezout steps; the explicit second/third columns are c2 = (-y', x', *) +(* 0), c3 = (-u1' z, -u2' z, u1' x + u2' y) where a = gcd(u1,u2) = u1 x' + *) +(* u2 y', u1 = a u1', u2 = a u2'. *) +(* ------------------------------------------------------------------------- *) + +let SL3_EXTEND = prove + (`!u1 u2 u3:int. (?x y z. u1 * x + u2 * y + u3 * z = &1) + ==> ?c12 c13 c22 c23 c32 c33. + u1 * (c22 * c33 - c23 * c32) - + c12 * (u2 * c33 - c23 * u3) + + c13 * (u2 * c32 - c22 * u3) = &1`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `u1 = &0 /\ u2 = &0` THENL + [POP_ASSUM STRIP_ASSUME_TAC THEN + MAP_EVERY EXISTS_TAC [`z:int`;`&0:int`;`&0:int`;`&1:int`;`&0:int`; + `&0:int`] THEN + UNDISCH_TAC `u1*x+u2*y+u3*z = &1` THEN ASM_REWRITE_TAC[] THEN + CONV_TAC INT_RING; + ALL_TAC] THEN + MP_TAC(SPECL [`u1:int`;`u2:int`] int_gcd) THEN + ABBREV_TAC `a = gcd(u1,u2)` THEN STRIP_TAC THEN + SUBGOAL_THEN `&0 < a` ASSUME_TAC THENL + [REWRITE_TAC[INT_LT_LE] THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + UNDISCH_TAC `~(u1 = &0 /\ u2 = &0)` THEN REWRITE_TAC[] THEN + ASM_MESON_TAC[INT_GCD_EQ_0]; + ALL_TAC] THEN + FIRST_ASSUM(X_CHOOSE_TAC `u1':int` o REWRITE_RULE[int_divides] o + check (fun th -> rand(concl th) = `u1:int`)) THEN + FIRST_ASSUM(X_CHOOSE_TAC `u2':int` o REWRITE_RULE[int_divides] o + check (fun th -> rand(concl th) = `u2:int`)) THEN + SUBGOAL_THEN `u1' * x' + u2' * y' = &1` ASSUME_TAC THENL + [SUBGOAL_THEN `a * (u1'*x' + u2'*y') = a * &1` MP_TAC THENL + [MP_TAC(ASSUME `a = u1 * x' + u2 * y'`) THEN + MP_TAC(ASSUME `u1 = a * u1'`) THEN + MP_TAC(ASSUME `u2 = a * u2'`) THEN CONV_TAC INT_RING; + REWRITE_TAC[INT_EQ_MUL_LCANCEL] THEN ASM_INT_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN `a * (u1'*x + u2'*y) + u3 * z = &1` ASSUME_TAC THENL + [MP_TAC(ASSUME `u1 * x + u2 * y + u3 * z = &1`) THEN + MP_TAC(ASSUME `u1 = a * u1'`) THEN MP_TAC(ASSUME `u2 = a * u2'`) THEN + CONV_TAC INT_RING; + ALL_TAC] THEN + MAP_EVERY EXISTS_TAC + [`--y':int`; `--(u1' * z):int`; `x':int`; `--(u2' * z):int`; `&0:int`; + `u1'*x + u2'*y:int`] THEN + MP_TAC(ASSUME `u1 = a * u1'`) THEN MP_TAC(ASSUME `u2 = a * u2'`) THEN + MP_TAC(ASSUME `u1' * x' + u2' * y' = &1`) THEN + MP_TAC(ASSUME `a * (u1' * x + u2' * y) + u3 * z = &1`) THEN + CONV_TAC INT_RING);; + +(* ------------------------------------------------------------------------- *) +(* Binary Hermite bound (the short-vector half of Nathanson Lemma 1.6 in the *) +(* binary case): a positive-definite binary form of discriminant D > 0 *) +(* represents, at some nonzero integer vector, a value m with 3 m^2 <= 4 D. *) +(* Proved by the same reduce-and-swap descent as BINARY_DISC1, terminating *) +(* once 3 A11^2 <= 4 D (the reduced regime), where the witness is (1,0). *) +(* ------------------------------------------------------------------------- *) + +let BINARY_HERMITE = prove + (`!D. &0 < D ==> + !A11. &0 < A11 + ==> !A12 A22. A11 * A22 - A12 pow 2 = D + ==> ?x y. ~(x = &0 /\ y = &0) /\ + &3 * (A11 * x pow 2 + &2 * A12 * x * y + + A22 * y pow 2) pow 2 + <= &4 * D`, + GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC WF_INT_MEASURE THEN EXISTS_TAC `abs:int->int` THEN + REWRITE_TAC[INT_ABS_POS] THEN + GEN_TAC THEN DISCH_TAC THEN STRIP_TAC THEN REPEAT GEN_TAC THEN DISCH_TAC THEN + MP_TAC(SPECL [`A12:int`;`A11:int`] INT_BALANCED_REM) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `b:int`) THEN ABBREV_TAC `r = --b:int` THEN + ABBREV_TAC `A12' = A12 + A11 * r` THEN + ABBREV_TAC `A22' = A11*r pow 2 + &2*A12*r + A22` THEN + SUBGOAL_THEN `abs A12' * &2 <= A11` ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["A12'";"r"] THEN + UNDISCH_TAC `abs (A12 - A11 * b) * &2 <= A11` THEN + REWRITE_TAC[INT_ARITH `A12 + A11 * --b = A12 - A11 * b`]; + ALL_TAC] THEN + SUBGOAL_THEN `A11 * A22' - A12' pow 2 = D` ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["A12'";"A22'"] THEN + UNDISCH_TAC `A11 * A22 - A12 pow 2 = D` THEN INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < A22'` ASSUME_TAC THENL + [SUBGOAL_THEN `&0 < A11 * A22'` MP_TAC THENL + [SUBGOAL_THEN `A11 * A22' = D + A12' pow 2` SUBST1_TAC THENL + [ASM_INT_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPEC `A12':int` INT_LE_POW_2) THEN ASM_INT_ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[INT_LT_MUL_EQ]; + ALL_TAC] THEN + ASM_CASES_TAC `&3 * A11 pow 2 <= &4 * D` THENL + [MAP_EVERY EXISTS_TAC [`&1:int`; `&0:int`] THEN CONJ_TAC THENL + [INT_ARITH_TAC; + SUBGOAL_THEN + `A11 * (&1:int) pow 2 + &2*A12*(&1)*(&0) + A22*(&0) pow 2 = A11` + SUBST1_TAC THENL [CONV_TAC INT_RING; FIRST_ASSUM ACCEPT_TAC]]; + ALL_TAC] THEN + SUBGOAL_THEN `A22' < A11` ASSUME_TAC THENL + [SUBGOAL_THEN `&4 * (A11 * A22') <= &4 * D + A11 pow 2` ASSUME_TAC THENL + [SUBGOAL_THEN `A11 * A22' = D + A12' pow 2` + (fun th -> REWRITE_TAC[th]) THENL + [ASM_INT_ARITH_TAC; ALL_TAC] THEN + MP_TAC(MATCH_MP SQ_BOUND (ASSUME `abs A12' * &2 <= A11`)) THEN + INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `&4 * D < &3 * A11 pow 2` ASSUME_TAC THENL + [ASM_INT_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `A11 * (&4 * A22') < A11 * (&4 * A11)` MP_TAC THENL + [MATCH_MP_TAC INT_LET_TRANS THEN EXISTS_TAC `&4 * D + A11 pow 2` THEN + CONJ_TAC THENL + [UNDISCH_TAC `&4 * (A11*A22') <= &4 * D + A11 pow 2` THEN INT_ARITH_TAC; + REWRITE_TAC[INT_POW_2] THEN + UNDISCH_TAC `&4 * D < &3 * A11 pow 2` THEN REWRITE_TAC[INT_POW_2] THEN + INT_ARITH_TAC]; + ALL_TAC] THEN + ASM_SIMP_TAC[INT_LT_LMUL_EQ] THEN INT_ARITH_TAC; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `A22':int`) THEN + ANTS_TAC THENL [ASM_INT_ARITH_TAC; ALL_TAC] THEN + ANTS_TAC THENL [FIRST_ASSUM ACCEPT_TAC; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPECL [`A12':int`; `A11:int`]) THEN + ANTS_TAC THENL [UNDISCH_TAC `A11 * A22' - A12' pow 2 = D` THEN + INT_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `x':int` + (X_CHOOSE_THEN `y':int` STRIP_ASSUME_TAC)) THEN + EXISTS_TAC `y' + r * x':int` THEN EXISTS_TAC `x':int` THEN CONJ_TAC THENL + [ASM_CASES_TAC `x' = &0` THENL + [UNDISCH_TAC `~(x' = &0 /\ y' = &0)` THEN + ASM_REWRITE_TAC[INT_MUL_RZERO; INT_ADD_RID] THEN + MESON_TAC[]; + ASM_MESON_TAC[]]; + SUBGOAL_THEN + `A11*(y'+r*x') pow 2 + &2*A12*(y'+r*x')*x' + A22*x' pow 2 = + A22' * x' pow 2 + &2 * A12' * x' * y' + A11 * y' pow 2` + ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["A22'";"A12'"] THEN + CONV_TAC INT_RING; ALL_TAC] THEN + ASM_REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* The minimal represented value of a positive-definite ternary form, and *) +(* its primitivity (Nathanson, start of Lemma 1.6). TERNARY_MIN: the form *) +(* attains a least value over nonzero integer vectors (well-ordering of the *) +(* nonnegative integers, INT_WOP). MIN_PRIMITIVE: that minimizing vector is *) +(* primitive -- if a common divisor g divided all coordinates then F scales *) +(* by g^2, giving a strictly smaller value, so g is a unit. A determinant-1 *) +(* integer matrix is injective, which transfers nonzeroness through *) +(* conjugation. *) +(* ------------------------------------------------------------------------- *) + +let INT_GCD3_EXISTS = prove + (`!a b c:int. ?d. d divides a /\ d divides b /\ d divides c /\ + (?x y z. d = a * x + b * y + c * z)`, + REPEAT GEN_TAC THEN + MP_TAC(SPECL [`a:int`;`b:int`] INT_GCD_EXISTS) THEN + DISCH_THEN(X_CHOOSE_THEN `e:int` STRIP_ASSUME_TAC) THEN + MP_TAC(SPECL [`e:int`;`c:int`] INT_GCD_EXISTS) THEN + DISCH_THEN(X_CHOOSE_THEN `d:int` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `d:int` THEN + REPEAT CONJ_TAC THENL + [ASM_MESON_TAC[INT_DIVIDES_TRANS]; + ASM_MESON_TAC[INT_DIVIDES_TRANS]; + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + UNDISCH_TAC `e = a * x + b * y` THEN + UNDISCH_TAC `d = e * x' + c * y'` THEN + REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(CONJUNCTS_THEN ASSUME_TAC) THEN + MAP_EVERY EXISTS_TAC [`x * x':int`; `y * x':int`; `y':int`] THEN + ASM_REWRITE_TAC[] THEN INT_ARITH_TAC);; + +let TERNARY_MIN = prove + (`!a11 a12 a13 a22 a23 a33:int. + (!x y z. ~(x = &0 /\ y = &0 /\ z = &0) + ==> &0 < a11 * x pow 2 + a22 * y pow 2 + a33 * z pow 2 + + &2 * a12 * x * y + &2 * a13 * x * z + &2 * a23 * y * z) + ==> ?v1 v2 v3. + ~(v1 = &0 /\ v2 = &0 /\ v3 = &0) /\ + (!x y z. ~(x = &0 /\ y = &0 /\ z = &0) + ==> a11 * v1 pow 2 + a22 * v2 pow 2 + a33 * v3 pow 2 + + &2 * a12 * v1 * v2 + &2 * a13 * v1 * v3 + + &2 * a23 * v2 * v3 + <= a11 * x pow 2 + a22 * y pow 2 + a33 * z pow 2 + + &2 * a12 * x * y + &2 * a13 * x * z + + &2 * a23 * y * z)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC + `\v:int. ?x y z. ~(x = &0 /\ y = &0 /\ z = &0) /\ + v = a11*x pow 2 + a22*y pow 2 + a33*z pow 2 + + &2*a12*x*y + &2*a13*x*z + &2*a23*y*z` + (GEN `P:int->bool` INT_WOP)) THEN + REWRITE_TAC[] THEN + SUBGOAL_THEN + `?v. &0 <= v /\ + (?x y z. ~(x = &0 /\ y = &0 /\ z = &0) /\ + v = a11*x pow 2 + a22*y pow 2 + a33*z pow 2 + + &2*a12*x*y + &2*a13*x*z + &2*a23*y*z)` + (fun th -> REWRITE_TAC[th]) THENL + [EXISTS_TAC `a11*(&1) pow 2 + a22*(&0) pow 2 + a33*(&0) pow 2 + + &2*a12*(&1)*(&0) + &2*a13*(&1)*(&0) + &2*a23*(&0)*(&0)` THEN + CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPECL [`&1:int`;`&0:int`;`&0:int`]) THEN + ANTS_TAC THENL [INT_ARITH_TAC; ALL_TAC] THEN INT_ARITH_TAC; + MAP_EVERY EXISTS_TAC [`&1:int`;`&0:int`;`&0:int`] THEN + REWRITE_TAC[] THEN INT_ARITH_TAC]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `mn:int` STRIP_ASSUME_TAC) THEN + MAP_EVERY EXISTS_TAC [`x':int`;`y:int`;`z:int`] THEN + ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC [`p:int`;`q:int`;`s:int`] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC + `a11*p pow 2 + a22*q pow 2 + a33*s pow 2 + + &2*a12*p*q + &2*a13*p*s + &2*a23*q*s`) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC INT_LT_IMP_LE THEN ASM_SIMP_TAC[]; + MAP_EVERY EXISTS_TAC [`p:int`;`q:int`;`s:int`] THEN ASM_REWRITE_TAC[]]; + UNDISCH_TAC `mn = a11*x' pow 2 + a22*y pow 2 + a33*z pow 2 + + &2*a12*x'*y + &2*a13*x'*z + &2*a23*y*z` THEN + DISCH_THEN(fun th -> REWRITE_TAC[SYM th])]);; + +let MIN_PRIMITIVE = prove + (`!a11 a12 a13 a22 a23 a33 v1 v2 v3:int. + (!x y z. ~(x = &0 /\ y = &0 /\ z = &0) + ==> &0 < a11 * x pow 2 + a22 * y pow 2 + a33 * z pow 2 + + &2 * a12 * x * y + &2 * a13 * x * z + + &2 * a23 * y * z) /\ + ~(v1 = &0 /\ v2 = &0 /\ v3 = &0) /\ + (!x y z. ~(x = &0 /\ y = &0 /\ z = &0) + ==> a11 * v1 pow 2 + a22 * v2 pow 2 + a33 * v3 pow 2 + + &2 * a12 * v1 * v2 + &2 * a13 * v1 * v3 + + &2 * a23 * v2 * v3 + <= a11 * x pow 2 + a22 * y pow 2 + a33 * z pow 2 + + &2 * a12 * x * y + &2 * a13 * x * z + &2 * a23 * y * z) + ==> ?x y z. v1 * x + v2 * y + v3 * z = &1`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (CONJUNCTS_THEN2 ASSUME_TAC ASSUME_TAC)) THEN + MP_TAC(SPECL [`v1:int`;`v2:int`;`v3:int`] INT_GCD3_EXISTS) THEN + DISCH_THEN(X_CHOOSE_THEN `g:int` STRIP_ASSUME_TAC) THEN + FIRST_ASSUM(X_CHOOSE_TAC `w1:int` o REWRITE_RULE[int_divides] o + check (fun th -> rand(concl th) = `v1:int`)) THEN + FIRST_ASSUM(X_CHOOSE_TAC `w2:int` o REWRITE_RULE[int_divides] o + check (fun th -> rand(concl th) = `v2:int`)) THEN + FIRST_ASSUM(X_CHOOSE_TAC `w3:int` o REWRITE_RULE[int_divides] o + check (fun th -> rand(concl th) = `v3:int`)) THEN + REPEAT(FIRST_X_ASSUM(SUBST_ALL_TAC o + check (fun th -> is_eq(concl th) && + (let l = lhand(concl th) in l = `v1:int` || l = `v2:int` + || l = `v3:int`)))) THEN + SUBGOAL_THEN `~(g = &0)` ASSUME_TAC THENL + [DISCH_TAC THEN + UNDISCH_TAC `~(g * w1 = &0 /\ g * w2 = &0 /\ g * w3 = &0)` THEN + ASM_REWRITE_TAC[INT_MUL_LZERO]; + ALL_TAC] THEN + SUBGOAL_THEN `w1 * x + w2 * y + w3 * z = &1` ASSUME_TAC THENL + [SUBGOAL_THEN `g * (w1*x+w2*y+w3*z) = g * &1` MP_TAC THENL + [REWRITE_TAC[INT_MUL_RID] THEN + MP_TAC(ASSUME `g = (g*w1)*x + (g*w2)*y + (g*w3)*z`) THEN + CONV_TAC INT_RING; + ASM_SIMP_TAC[INT_EQ_MUL_LCANCEL]]; + ALL_TAC] THEN + SUBGOAL_THEN `~(w1 = &0 /\ w2 = &0 /\ w3 = &0)` ASSUME_TAC THENL + [STRIP_TAC THEN UNDISCH_TAC `w1 * x + w2 * y + w3 * z = &1` THEN + ASM_REWRITE_TAC[] THEN INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `g pow 2 = &1` ASSUME_TAC THENL + [ABBREV_TAC `Fw = a11*w1 pow 2 + a22*w2 pow 2 + a33*w3 pow 2 + + &2*a12*w1*w2 + &2*a13*w1*w3 + &2*a23*w2*w3` THEN + SUBGOAL_THEN `&0 < Fw` ASSUME_TAC THENL + [EXPAND_TAC "Fw" THEN ASM_SIMP_TAC[]; ALL_TAC] THEN + UNDISCH_TAC + `!x y z. ~(x = &0 /\ y = &0 /\ z = &0) + ==> a11*(g*w1) pow 2 + a22*(g*w2) pow 2 + + a33*(g*w3) pow 2 + &2*a12*(g*w1)*(g*w2) + + &2*a13*(g*w1)*(g*w3) + &2*a23*(g*w2)*(g*w3) + <= a11*x pow 2 + a22*y pow 2 + a33*z pow 2 + + &2*a12*x*y + &2*a13*x*z + &2*a23*y*z` THEN + DISCH_THEN(MP_TAC o SPECL [`w1:int`;`w2:int`;`w3:int`]) THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `a11*(g*w1) pow 2 + a22*(g*w2) pow 2 + a33*(g*w3) pow 2 + + &2*a12*(g*w1)*(g*w2) + &2*a13*(g*w1)*(g*w3) + + &2*a23*(g*w2)*(g*w3) = g pow 2 * Fw` + SUBST1_TAC THENL + [EXPAND_TAC "Fw" THEN CONV_TAC INT_RING; ALL_TAC] THEN + GEN_REWRITE_TAC (LAND_CONV + o RAND_CONV) [GSYM(INT_ARITH `&1 * Fw = Fw`)] THEN + ASM_SIMP_TAC[INT_LE_RMUL_EQ] THEN + SUBGOAL_THEN `&1 <= g pow 2` MP_TAC THENL + [REWRITE_TAC[INT_ARITH `&1 <= x <=> &0 < x`] THEN + ASM_SIMP_TAC[INT_LT_POW_2]; ALL_TAC] THEN + INT_ARITH_TAC; + ALL_TAC] THEN + MAP_EVERY EXISTS_TAC [`g*x:int`;`g*y:int`;`g*z:int`] THEN + MP_TAC(ASSUME `g = (g*w1)*x + (g*w2)*y + (g*w3)*z`) THEN + MP_TAC(ASSUME `g pow 2 = &1`) THEN REWRITE_TAC[INT_POW_2] THEN + CONV_TAC INT_RING);; + +(* ------------------------------------------------------------------------- *) +(* Hermite reduction arithmetic (Nathanson Lemma 1.6, ternary case). With *) +(* a11 the minimal value of a positive-definite form of discriminant 1, the *) +(* completed binary form G has discriminant a11 (DISC_G with det = 1), so *) +(* BINARY_HERMITE gives a nonzero vector with 3 G^2 <= 4 a11; minimality and *) +(* a balanced first coordinate give 3 a11^2 <= 4 G (HERMITE_LOWER); together *) +(* these force 27 a11^3 <= 64 (HERMITE_CUBE), hence a11 = 1 (CUBE_GE_8). *) +(* ------------------------------------------------------------------------- *) + +let DISC_G = INT_RING + `!a11 a12 a13 a22 a23 a33:int. + (a11 * a22 - a12 pow 2) * (a11 * a33 - a13 pow 2) - + (a11 * a23 - a12 * a13) pow 2 = + a11 * (a11 * (a22 * a33 - a23 pow 2) - + a12 * (a12 * a33 - a23 * a13) + + a13 * (a12 * a23 - a22 * a13))`;; + +let CUBE_GE_8 = prove + (`!a:int. &2 <= a ==> &8 <= a pow 3`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC INT_LE_TRANS THEN EXISTS_TAC `&2 pow 3` THEN + CONJ_TAC THENL [INT_ARITH_TAC; MATCH_MP_TAC INT_POW_LE2 THEN + ASM_INT_ARITH_TAC]);; + +let HERMITE_LOWER = prove + (`!a11 a12 a13 a22 a23 a33 x1 s t Gst:int. + &0 < a11 /\ + a11 <= a11 * x1 pow 2 + a22 * s pow 2 + a33 * t pow 2 + + &2 * a12 * x1 * s + &2 * a13 * x1 * t + &2 * a23 * s * t /\ + &4 * (a11 * x1 + a12 * s + a13 * t) pow 2 <= a11 pow 2 /\ + a11 * (a11 * x1 pow 2 + a22 * s pow 2 + a33 * t pow 2 + + &2 * a12 * x1 * s + &2 * a13 * x1 * t + &2 * a23 * s * t) = + (a11 * x1 + a12 * s + a13 * t) pow 2 + Gst + ==> &3 * a11 pow 2 <= &4 * Gst`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `a11 * a11 <= a11 * (a11*x1 pow 2 + a22*s pow 2 + a33*t pow 2 + + &2*a12*x1*s + &2*a13*x1*t + &2*a23*s*t)` MP_TAC THENL + [MATCH_MP_TAC INT_LE_LMUL THEN ASM_SIMP_TAC[INT_LT_IMP_LE]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(ASSUME `&4 * (a11*x1 + a12*s + a13*t) pow 2 <= a11 pow 2`) THEN + REWRITE_TAC[INT_POW_2] THEN INT_ARITH_TAC);; + +let HERMITE_CUBE = prove + (`!a G:int. + &0 < a /\ &0 < G /\ + &3 * a pow 2 <= &4 * G /\ &3 * G pow 2 <= &4 * a + ==> &27 * a pow 3 <= &64`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(&3 * a pow 2) pow 2 <= (&4 * G) pow 2` MP_TAC THENL + [MATCH_MP_TAC INT_POW_LE2 THEN CONJ_TAC THENL + [MATCH_MP_TAC INT_LE_MUL THEN REWRITE_TAC[INT_LE_POW_2] THEN + INT_ARITH_TAC; + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + REWRITE_TAC[INT_POW_MUL] THEN DISCH_TAC THEN + MATCH_MP_TAC INT_LE_RCANCEL_IMP THEN EXISTS_TAC `a:int` THEN + CONJ_TAC THENL [FIRST_ASSUM ACCEPT_TAC; ALL_TAC] THEN + MATCH_MP_TAC INT_LE_TRANS THEN EXISTS_TAC `&16 * (&3 * G pow 2)` THEN + CONJ_TAC THENL + [MP_TAC(ASSUME `&3 pow 2 * a pow 2 pow 2 <= &4 pow 2 * G pow 2`) THEN + REWRITE_TAC[INT_ARITH `a pow 2 pow 2 = a pow 3 * a`; INT_POW_2] THEN + INT_ARITH_TAC; + MP_TAC(ASSUME `&3 * G pow 2 <= &4 * a`) THEN INT_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* Positive-definiteness of a ternary form from its principal minors *) +(* (Nathanson Lemma 1.3, the "if" direction), and surjectivity over Z of a *) +(* determinant-1 integer matrix (ADJ_PREIMAGE: every target has an integer *) +(* preimage, via the adjugate -- used to transfer "represents n" through a *) +(* change of variables). *) +(* ------------------------------------------------------------------------- *) + +let TERNARY_POSDEF = prove + (`!a11 a12 a13 a22 a23 a33:int. + &0 < a11 /\ &0 < a11 * a22 - a12 pow 2 /\ + &0 < a11 * (a22 * a33 - a23 pow 2) - + a12 * (a12 * a33 - a23 * a13) + + a13 * (a12 * a23 - a22 * a13) + ==> !x y z. ~(x = &0 /\ y = &0 /\ z = &0) + ==> &0 < a11 * x pow 2 + a22 * y pow 2 + a33 * z pow 2 + + &2 * a12 * x * y + &2 * a13 * x * z + + &2 * a23 * y * z`, + REPEAT GEN_TAC THEN STRIP_TAC THEN REPEAT GEN_TAC THEN DISCH_TAC THEN + ABBREV_TAC `G11 = a11*a22 - a12 pow 2` THEN + ABBREV_TAC `G12 = a11*a23 - a12*a13` THEN + ABBREV_TAC `G22 = a11*a33 - a13 pow 2` THEN + SUBGOAL_THEN `&0 < G11 * G22 - G12 pow 2` ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["G11";"G12";"G22"] THEN + SUBGOAL_THEN + `(a11*a22 - a12 pow 2)*(a11*a33 - a13 pow 2) - (a11*a23 - a12*a13) pow 2 = + a11 * (a11*(a22*a33 - a23 pow 2) - a12*(a12*a33 - a23*a13) + + a13*(a12*a23 - a22*a13))` + SUBST1_TAC THENL [REWRITE_TAC[DISC_G]; ALL_TAC] THEN + MATCH_MP_TAC INT_LT_MUL THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `&0 < a11 * + (a11*x pow 2 + a22*y pow 2 + a33*z pow 2 + + &2*a12*x*y + &2*a13*x*z + &2*a23*y*z)` MP_TAC THENL + [SUBGOAL_THEN + `a11 * (a11*x pow 2 + a22*y pow 2 + a33*z pow 2 + + &2*a12*x*y + &2*a13*x*z + &2*a23*y*z) = + (a11*x + a12*y + a13*z) pow 2 + (G11*y pow 2 + &2*G12*y*z + G22*z pow 2)` + SUBST1_TAC THENL + [MAP_EVERY EXPAND_TAC ["G11";"G12";"G22"] THEN + MP_TAC(SPECL [`a11:int`;`a12:int`;`a13:int`;`a22:int`;`a23:int`;`a33:int`; + `x:int`;`y:int`;`z:int`] TERNARY_COMPLETE) THEN + INT_ARITH_TAC; + ALL_TAC] THEN + ASM_CASES_TAC `y = &0 /\ z = &0` THENL + [POP_ASSUM STRIP_ASSUME_TAC THEN + SUBGOAL_THEN `~(x = &0)` ASSUME_TAC THENL + [UNDISCH_TAC `~(x = &0 /\ y = &0 /\ z = &0)` THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[INT_MUL_RZERO; INT_ADD_RID; INT_MUL_LZERO; + INT_POW_ZERO; ARITH_EQ] THEN + REWRITE_TAC[INT_ADD_RID] THEN + REWRITE_TAC[INT_LT_POW_2] THEN + REWRITE_TAC[INT_ENTIRE; DE_MORGAN_THM] THEN + CONJ_TAC THENL [ASM_INT_ARITH_TAC; FIRST_ASSUM ACCEPT_TAC]; + MATCH_MP_TAC(INT_ARITH `&0 <= a /\ &0 < b ==> &0 < a + b`) THEN + REWRITE_TAC[INT_LE_POW_2] THEN + MP_TAC(SPECL [`G11:int`;`G12:int`;`G22:int`] POSDEF_BINARY_CRITERION) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[]] THEN + ALL_TAC; + ASM_SIMP_TAC[INT_LT_MUL_EQ]]);; + +let ADJ_PREIMAGE = prove + (`!u1 u2 u3 c12 c22 c32 c13 c23 c33 X1 X2 X3:int. + u1 * (c22 * c33 - c23 * c32) - + c12 * (u2 * c33 - c23 * u3) + + c13 * (u2 * c32 - c22 * u3) = &1 + ==> ?y1 y2 y3. + u1 * y1 + c12 * y2 + c13 * y3 = X1 /\ + u2 * y1 + c22 * y2 + c23 * y3 = X2 /\ + u3 * y1 + c32 * y2 + c33 * y3 = X3`, + REPEAT STRIP_TAC THEN + MAP_EVERY EXISTS_TAC + [`(c22*c33 - c23*c32)*X1 + (c13*c32 - c12*c33)*X2 + (c12*c23 - c13*c22)*X3`; + `(c23*u3 - u2*c33)*X1 + (u1*c33 - c13*u3)*X2 + (c13*u2 - u1*c23)*X3`; + `(u2*c32 - u3*c22)*X1 + (u3*c12 - u1*c32)*X2 + (u1*c22 - u2*c12)*X3`] THEN + MP_TAC(ASSUME + `u1*(c22*c33 - c23*c32) - c12*(u2*c33 - c23*u3) + + c13*(u2*c32 - c22*u3) = &1`) THEN + CONV_TAC INT_RING);; + +(* ------------------------------------------------------------------------- *) +(* The Hermite reduction packaged: a positive-definite ternary form of *) +(* discriminant 1 whose leading coefficient b11 is the MINIMAL value it *) +(* represents must have b11 = 1 (Nathanson Lemma 1.6 + Theorem 1.3, the a11 *) +(* = 1 conclusion). Completing the square gives a binary form G of *) +(* discriminant b11; the short vector from BINARY_HERMITE plus minimality *) +(* (with a balanced first coordinate, HERMITE_LOWER) bound 27 b11^3 <= 64, *) +(* so b11 = 1. *) +(* ------------------------------------------------------------------------- *) + +let HERMITE_A1 = prove + (`!b11 b12 b13 b22 b23 b33:int. + &0 < b11 /\ + b11 * (b22 * b33 - b23 pow 2) - b12 * (b12 * b33 - b13 * b23) + + b13 * (b12 * b23 - b13 * b22) = &1 /\ + &0 < b11 * b22 - b12 pow 2 /\ + (!x y z. ~(x = &0 /\ y = &0 /\ z = &0) + ==> b11 <= b11 * x pow 2 + b22 * y pow 2 + b33 * z pow 2 + + &2 * b12 * x * y + &2 * b13 * x * z + + &2 * b23 * y * z) + ==> b11 = &1`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + ABBREV_TAC `G11 = b11*b22 - b12 pow 2` THEN + ABBREV_TAC `G12 = b11*b23 - b12*b13` THEN + ABBREV_TAC `G22 = b11*b33 - b13 pow 2` THEN + SUBGOAL_THEN `G11 * G22 - G12 pow 2 = b11` ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["G11";"G12";"G22"] THEN + REWRITE_TAC[DISC_G] THEN + MP_TAC(ASSUME `b11*(b22*b33 - b23 pow 2) - b12*(b12*b33 - b13*b23) + + b13*(b12*b23 - b13*b22) = &1`) THEN CONV_TAC INT_RING; + ALL_TAC] THEN + MP_TAC(SPEC `b11:int` BINARY_HERMITE) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `G11:int`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPECL [`G12:int`;`G22:int`]) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `s:int` + (X_CHOOSE_THEN `t:int` STRIP_ASSUME_TAC)) THEN + ABBREV_TAC `Gst = G11 * s pow 2 + &2 * G12 * s * t + G22 * t pow 2` THEN + MP_TAC(SPECL [`b12*s + b13*t`;`b11:int`] INT_BALANCED_REM) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `bb:int`) THEN + ABBREV_TAC `x1 = --bb:int` THEN + SUBGOAL_THEN + `&4 * (b11*x1 + b12*s + b13*t) pow 2 <= b11 pow 2` + ASSUME_TAC THENL + [MP_TAC(MATCH_MP SQ_BOUND + (ASSUME `abs ((b12*s + b13*t) - b11 * bb) * &2 <= b11`)) THEN + EXPAND_TAC "x1" THEN + REWRITE_TAC + [INT_ARITH + `b11 * --bb + b12*s + b13*t = (b12*s + b13*t) - b11*bb`] THEN + INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `&3 * b11 pow 2 <= &4 * Gst` ASSUME_TAC THENL + [MATCH_MP_TAC HERMITE_LOWER THEN + MAP_EVERY EXISTS_TAC [`b12:int`;`b13:int`;`b22:int`;`b23:int`; + `b33:int`] THEN + MAP_EVERY EXISTS_TAC [`x1:int`;`s:int`;`t:int`] THEN + ASM_REWRITE_TAC[] THEN + REPEAT CONJ_TAC THENL + [FIRST_X_ASSUM(fun th -> MP_TAC(SPECL [`x1:int`;`s:int`;`t:int`] th) THEN + ANTS_TAC THENL [UNDISCH_TAC `~(s = &0 /\ t = &0)` THEN + MESON_TAC[]; ALL_TAC] THEN + DISCH_THEN(fun th2 -> ACCEPT_TAC th2 ORELSE MP_TAC th2)); + EXPAND_TAC "Gst" THEN + MP_TAC(SPECL [`b11:int`;`b12:int`;`b13:int`;`b22:int`;`b23:int`; + `b33:int`; + `x1:int`;`s:int`;`t:int`] TERNARY_COMPLETE) THEN + MAP_EVERY (fun e -> UNDISCH_TAC e) + [`b11 * b22 - b12 pow 2 = G11`; `b11 * b23 - b12 * b13 = G12`; + `b11 * b33 - b13 pow 2 = G22`] THEN + CONV_TAC INT_RING]; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < Gst` ASSUME_TAC THENL + [EXPAND_TAC "Gst" THEN + MP_TAC(SPECL [`G11:int`;`G12:int`;`G22:int`] POSDEF_BINARY_CRITERION) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPECL [`s:int`;`t:int`]) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; REWRITE_TAC[]]; + ALL_TAC] THEN + MP_TAC(SPECL [`b11:int`;`Gst:int`] HERMITE_CUBE) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + SUBGOAL_THEN `~(&2 <= b11)` ASSUME_TAC THENL + [DISCH_TAC THEN MP_TAC(SPEC `b11:int` CUBE_GE_8) THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `&27 * b11 pow 3 <= &64` THEN INT_ARITH_TAC; + ALL_TAC] THEN + ASM_INT_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Minimality transfers through the conjugation: if A's minimal value is *) +(* attained at the primitive vector v, and the matrix U (columns v, c2, c3) *) +(* has determinant 1, then the conjugated form B, with entries the b_ij *) +(* below and satisfying B(p) = A(U p), attains the same minimal value. *) +(* Injectivity of U ensures that a nonzero p maps to a nonzero point where *) +(* A's minimality applies. *) +(* ------------------------------------------------------------------------- *) + +let CONJ_MIN = prove + (`!a11 a12 a13 a22 a23 a33 v1 v2 v3 c12 c13 c22 c23 c32 c33 + b11 b12 b13 b22 b23 b33:int. + (!x y z. ~(x = &0 /\ y = &0 /\ z = &0) + ==> a11 * v1 pow 2 + a22 * v2 pow 2 + a33 * v3 pow 2 + + &2 * a12 * v1 * v2 + &2 * a13 * v1 * v3 + + &2 * a23 * v2 * v3 + <= a11 * x pow 2 + a22 * y pow 2 + a33 * z pow 2 + + &2 * a12 * x * y + &2 * a13 * x * z + &2 * a23 * y * z) /\ + v1 * (c22 * c33 - c23 * c32) - + c12 * (v2 * c33 - c23 * v3) + + c13 * (v2 * c32 - c22 * v3) = &1 /\ + b11 = a11 * v1 pow 2 + &2 * a12 * v1 * v2 + &2 * a13 * v1 * v3 + + a22 * v2 pow 2 + &2 * a23 * v2 * v3 + a33 * v3 pow 2 /\ + b22 = a11 * c12 pow 2 + &2 * a12 * c12 * c22 + &2 * a13 * c12 * c32 + + a22 * c22 pow 2 + &2 * a23 * c22 * c32 + a33 * c32 pow 2 /\ + b33 = a11 * c13 pow 2 + &2 * a12 * c13 * c23 + &2 * a13 * c13 * c33 + + a22 * c23 pow 2 + &2 * a23 * c23 * c33 + a33 * c33 pow 2 /\ + b12 = a11 * v1 * c12 + a12 * (v1 * c22 + v2 * c12) + + a13 * (v1 * c32 + v3 * c12) + + a22 * v2 * c22 + a23 * (v2 * c32 + v3 * c22) + a33 * v3 * c32 /\ + b13 = a11 * v1 * c13 + a12 * (v1 * c23 + v2 * c13) + + a13 * (v1 * c33 + v3 * c13) + + a22 * v2 * c23 + a23 * (v2 * c33 + v3 * c23) + a33 * v3 * c33 /\ + b23 = a11 * c12 * c13 + a12 * (c12 * c23 + c22 * c13) + + a13 * (c12 * c33 + c32 * c13) + + a22 * c22 * c23 + a23 * (c22 * c33 + c32 * c23) + a33 * c32 * c33 + ==> !x y z. ~(x = &0 /\ y = &0 /\ z = &0) + ==> b11 <= b11 * x pow 2 + b22 * y pow 2 + b33 * z pow 2 + + &2 * b12 * x * y + &2 * b13 * x * z + + &2 * b23 * y * z`, + REPEAT GEN_TAC THEN STRIP_TAC THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`x*v1 + y*c12 + z*c13`; `x*v2 + y*c22 + z*c23`; + `x*v3 + y*c32 + z*c33`]) THEN + ANTS_TAC THENL + [DISCH_TAC THEN UNDISCH_TAC `~(x = &0 /\ y = &0 /\ z = &0)` THEN + REWRITE_TAC[] THEN + POP_ASSUM_LIST(MAP_EVERY MP_TAC) THEN CONV_TAC INT_RING; + ALL_TAC] THEN + MATCH_MP_TAC(INT_ARITH `lhs1 = lhs2 /\ rhs1 = rhs2 ==> lhs2 <= rhs2 + ==> lhs1 <= rhs1`) THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[] THEN CONV_TAC INT_RING; + ASM_REWRITE_TAC[] THEN CONV_TAC INT_RING]);; + +(* A positive-definite ternary form has positive leading 2x2 minor b11 b22 - *) +(* b12^2 (evaluate the form at (-b12, b11, 0) and divide by b11). *) + +let POSDEF_MINOR2 = prove + (`!b11 b12 b13 b22 b23 b33:int. + &0 < b11 /\ + (!x y z. ~(x = &0 /\ y = &0 /\ z = &0) + ==> &0 < b11 * x pow 2 + b22 * y pow 2 + b33 * z pow 2 + + &2 * b12 * x * y + &2 * b13 * x * z + &2 * b23 * y * z) + ==> &0 < b11 * b22 - b12 pow 2`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `&0 < b11 * (b11*b22 - b12 pow 2)` MP_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPECL [`--b12:int`;`b11:int`;`&0:int`]) THEN + ANTS_TAC THENL + [SUBGOAL_THEN `~(b11 = &0)` MP_TAC THENL + [ASM_INT_ARITH_TAC; MESON_TAC[]]; + MATCH_MP_TAC(INT_ARITH `a = b ==> &0 < a ==> &0 < b`) THEN + CONV_TAC INT_RING] THEN + ALL_TAC; + ASM_SIMP_TAC[INT_LT_MUL_EQ]]);; + +(* Representation transfers through the conjugation: the conjugated form B *) +(* represents every integer A represents. Given U has determinant 1, the *) +(* adjugate (ADJ_PREIMAGE) supplies an integer preimage y of the *) +(* representing vector X; expanding the b_ij definitions gives *) +(* B(y) = A(U y) = A(X). *) + +let CONJ_REPS = prove + (`!a11 a12 a13 a22 a23 a33 v1 v2 v3 c12 c13 c22 c23 c32 c33 + b11 b12 b13 b22 b23 b33 n:int. + v1 * (c22 * c33 - c23 * c32) - + c12 * (v2 * c33 - c23 * v3) + + c13 * (v2 * c32 - c22 * v3) = &1 /\ + b11 = a11 * v1 pow 2 + &2 * a12 * v1 * v2 + &2 * a13 * v1 * v3 + + a22 * v2 pow 2 + &2 * a23 * v2 * v3 + a33 * v3 pow 2 /\ + b22 = a11 * c12 pow 2 + &2 * a12 * c12 * c22 + &2 * a13 * c12 * c32 + + a22 * c22 pow 2 + &2 * a23 * c22 * c32 + a33 * c32 pow 2 /\ + b33 = a11 * c13 pow 2 + &2 * a12 * c13 * c23 + &2 * a13 * c13 * c33 + + a22 * c23 pow 2 + &2 * a23 * c23 * c33 + a33 * c33 pow 2 /\ + b12 = a11 * v1 * c12 + a12 * (v1 * c22 + v2 * c12) + + a13 * (v1 * c32 + v3 * c12) + + a22 * v2 * c22 + a23 * (v2 * c32 + v3 * c22) + a33 * v3 * c32 /\ + b13 = a11 * v1 * c13 + a12 * (v1 * c23 + v2 * c13) + + a13 * (v1 * c33 + v3 * c13) + + a22 * v2 * c23 + a23 * (v2 * c33 + v3 * c23) + a33 * v3 * c33 /\ + b23 = a11 * c12 * c13 + a12 * (c12 * c23 + c22 * c13) + + a13 * (c12 * c33 + c32 * c13) + + a22 * c22 * c23 + a23 * (c22 * c33 + c32 * c23) + + a33 * c32 * c33 /\ + (?x1 x2 x3. a11 * x1 pow 2 + a22 * x2 pow 2 + a33 * x3 pow 2 + + &2 * a12 * x1 * x2 + &2 * a13 * x1 * x3 + + &2 * a23 * x2 * x3 = n) + ==> ?y1 y2 y3. b11 * y1 pow 2 + b22 * y2 pow 2 + b33 * y3 pow 2 + + &2 * b12 * y1 * y2 + &2 * b13 * y1 * y3 + + &2 * b23 * y2 * y3 = n`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(SPECL [`v1:int`;`v2:int`;`v3:int`;`c12:int`;`c22:int`;`c32:int`; + `c13:int`;`c23:int`;`c33:int`;`x1:int`;`x2:int`; + `x3:int`] ADJ_PREIMAGE) THEN + ANTS_TAC THENL [FIRST_ASSUM ACCEPT_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `y1:int` (X_CHOOSE_THEN `y2:int` + (X_CHOOSE_THEN `y3:int` STRIP_ASSUME_TAC))) THEN + MAP_EVERY EXISTS_TAC [`y1:int`;`y2:int`;`y3:int`] THEN + POP_ASSUM_LIST(MAP_EVERY MP_TAC) THEN CONV_TAC INT_RING);; + +(* ========================================================================= *) +(* THE TERNARY DISCRIMINANT-1 REPRESENTATION THEOREM (Nathanson Theorem *) +(* 1.3): every positive-definite ternary quadratic form of discriminant 1 *) +(* represents only sums of three integer squares. This is the crux of the *) +(* elementary three-squares proof. Assembly: *) +(* - TERNARY_POSDEF: the form is positive-definite (from the principal *) +(* minors a11 > 0, d' > 0, det = 1 > 0); *) +(* - TERNARY_MIN + MIN_PRIMITIVE: it attains a least value at a PRIMITIVE *) +(* vector v; *) +(* - SL3_EXTEND: v is the first column of a determinant-1 matrix U; *) +(* - the conjugated form B = U^T A U has b11 equal to the minimal value, *) +(* discriminant 1, is positive-definite, and represents the same n; *) +(* - HERMITE_A1 forces b11 = 1, so by TSQ_DISC1_A11_1 (the a11 = 1 case, *) +(* which completes the square and invokes the binary theorem) n is a sum *) +(* of three squares. *) +(* ========================================================================= *) + +let TSQ_DISC1 = prove + (`!a11 a12 a13 a22 a23 a33 n:int. + &0 < a11 /\ + &0 < a11 * a22 - a12 pow 2 /\ + a11 * (a22 * a33 - a23 pow 2) - a12 * (a12 * a33 - a23 * a13) + + a13 * (a12 * a23 - a22 * a13) = &1 /\ + (?x1 x2 x3. a11 * x1 pow 2 + a22 * x2 pow 2 + a33 * x3 pow 2 + + &2 * a12 * x1 * x2 + &2 * a13 * x1 * x3 + + &2 * a23 * x2 * x3 = n) + ==> ?u v w:int. u pow 2 + v pow 2 + w pow 2 = n`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN + `!x y z. ~(x = &0 /\ y = &0 /\ z = &0) + ==> &0 < a11*x pow 2 + a22*y pow 2 + a33*z pow 2 + + &2*a12*x*y + &2*a13*x*z + &2*a23*y*z` + ASSUME_TAC THENL + [MATCH_MP_TAC TERNARY_POSDEF THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `a11*(a22*a33 - a23 pow 2) - a12*(a12*a33 - a23*a13) + + a13*(a12*a23 - a22*a13) = &1` THEN INT_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(SPECL [`a11:int`;`a12:int`;`a13:int`;`a22:int`;`a23:int`; + `a33:int`] TERNARY_MIN) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `v1:int` (X_CHOOSE_THEN `v2:int` + (X_CHOOSE_THEN `v3:int` STRIP_ASSUME_TAC))) THEN + SUBGOAL_THEN `?p q s. v1*p + v2*q + v3*s = &1` STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC MIN_PRIMITIVE THEN + MAP_EVERY EXISTS_TAC [`a11:int`;`a12:int`;`a13:int`;`a22:int`;`a23:int`; + `a33:int`] THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MP_TAC(SPECL [`v1:int`;`v2:int`;`v3:int`] SL3_EXTEND) THEN + ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `c12:int` (X_CHOOSE_THEN `c13:int` + (X_CHOOSE_THEN `c22:int` (X_CHOOSE_THEN `c23:int` + (X_CHOOSE_THEN `c32:int` (X_CHOOSE_THEN `c33:int` ASSUME_TAC)))))) THEN + ABBREV_TAC `b11 = a11*v1 pow 2 + &2*a12*v1*v2 + &2*a13*v1*v3 + + a22*v2 pow 2 + &2*a23*v2*v3 + a33*v3 pow 2` THEN + ABBREV_TAC `b22 = a11*c12 pow 2 + &2*a12*c12*c22 + &2*a13*c12*c32 + + a22*c22 pow 2 + &2*a23*c22*c32 + a33*c32 pow 2` THEN + ABBREV_TAC `b33 = a11*c13 pow 2 + &2*a12*c13*c23 + &2*a13*c13*c33 + + a22*c23 pow 2 + &2*a23*c23*c33 + a33*c33 pow 2` THEN + ABBREV_TAC `b12 = a11*v1*c12 + a12*(v1*c22+v2*c12) + a13*(v1*c32+v3*c12) + + a22*v2*c22 + a23*(v2*c32+v3*c22) + a33*v3*c32` THEN + ABBREV_TAC `b13 = a11*v1*c13 + a12*(v1*c23+v2*c13) + a13*(v1*c33+v3*c13) + + a22*v2*c23 + a23*(v2*c33+v3*c23) + a33*v3*c33` THEN + ABBREV_TAC + `b23 = a11*c12*c13 + a12*(c12*c23+c22*c13) + + a13*(c12*c33+c32*c13) + a22*c22*c23 + + a23*(c22*c33+c32*c23) + a33*c32*c33` THEN + SUBGOAL_THEN + `!x y z. ~(x = &0 /\ y = &0 /\ z = &0) + ==> b11 <= b11*x pow 2 + b22*y pow 2 + b33*z pow 2 + + &2*b12*x*y + &2*b13*x*z + &2*b23*y*z` + ASSUME_TAC THENL + [MATCH_MP_TAC CONJ_MIN THEN + MAP_EVERY EXISTS_TAC + [`a11:int`;`a12:int`;`a13:int`;`a22:int`;`a23:int`;`a33:int`; + `v1:int`;`v2:int`;`v3:int`;`c12:int`;`c13:int`;`c22:int`;`c23:int`; + `c32:int`;`c33:int`] THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < b11` ASSUME_TAC THENL + [FIRST_X_ASSUM(fun th -> MP_TAC(SPECL [`v1:int`;`v2:int`;`v3:int`] th) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + DISCH_THEN(fun t -> if rand(rator(concl t)) = `&0` then MP_TAC t + else NO_TAC)) THEN + MP_TAC(ASSUME + `a11 * v1 pow 2 + &2 * a12 * v1 * v2 + &2 * a13 * v1 * v3 + + a22 * v2 pow 2 + &2 * a23 * v2 * v3 + a33 * v3 pow 2 = b11`) THEN + INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `b11*(b22*b33 - b23 pow 2) - b12*(b12*b33 - b13*b23) + + b13*(b12*b23 - b13*b22) = &1` + ASSUME_TAC THENL + [MAP_EVERY EXPAND_TAC ["b11";"b12";"b13";"b22";"b23";"b33"] THEN + MP_TAC(ASSUME `v1 * (c22 * c33 - c23 * c32) - c12 * (v2 * c33 - c23 * v3) + + c13 * (v2 * c32 - c22 * v3) = &1`) THEN + MP_TAC(ASSUME + `a11 * (a22 * a33 - a23 pow 2) - + a12 * (a12 * a33 - a23 * a13) + + a13 * (a12 * a23 - a22 * a13) = &1`) THEN + CONV_TAC INT_RING; + ALL_TAC] THEN + SUBGOAL_THEN + `!x y z. ~(x = &0 /\ y = &0 /\ z = &0) + ==> &0 < b11*x pow 2 + b22*y pow 2 + b33*z pow 2 + + &2*b12*x*y + &2*b13*x*z + &2*b23*y*z` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN + MATCH_MP_TAC INT_LTE_TRANS THEN EXISTS_TAC `b11:int` THEN + ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < b11*b22 - b12 pow 2` ASSUME_TAC THENL + [MATCH_MP_TAC POSDEF_MINOR2 THEN + MAP_EVERY EXISTS_TAC [`b13:int`;`b23:int`;`b33:int`] THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `b11 = &1` ASSUME_TAC THENL + [MATCH_MP_TAC HERMITE_A1 THEN + MAP_EVERY EXISTS_TAC [`b12:int`;`b13:int`;`b22:int`;`b23:int`; + `b33:int`] THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `?y1 y2 y3. b11*y1 pow 2 + b22*y2 pow 2 + b33*y3 pow 2 + + &2*b12*y1*y2 + &2*b13*y1*y3 + &2*b23*y2*y3 = n` + STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC CONJ_REPS THEN + MAP_EVERY EXISTS_TAC + [`a11:int`;`a12:int`;`a13:int`;`a22:int`;`a23:int`;`a33:int`; + `v1:int`;`v2:int`;`v3:int`;`c12:int`;`c13:int`;`c22:int`;`c23:int`; + `c32:int`;`c33:int`] THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC TSQ_DISC1_A11_1 THEN + MAP_EVERY EXISTS_TAC [`b12:int`;`b13:int`;`b22:int`;`b23:int`;`b33:int`] THEN + SUBST1_TAC(ASSUME `b11 = &1`) THEN + REPEAT CONJ_TAC THENL + [UNDISCH_TAC `&0 < b11*b22 - b12 pow 2` THEN + SUBST1_TAC(ASSUME `b11 = &1`) THEN REWRITE_TAC[INT_MUL_LID]; + UNDISCH_TAC + `b11 * (b22 * b33 - b23 pow 2) - + b12 * (b12 * b33 - b13 * b23) + + b13 * (b12 * b23 - b13 * b22) = &1` THEN + SUBST1_TAC(ASSUME `b11 = &1`) THEN REWRITE_TAC[INT_MUL_LID] THEN + CONV_TAC INT_RING; + MAP_EVERY EXISTS_TAC [`y1:int`;`y2:int`;`y3:int`] THEN + UNDISCH_TAC + `b11 * y1 pow 2 + b22 * y2 pow 2 + b33 * y3 pow 2 + + &2 * b12 * y1 * y2 + &2 * b13 * y1 * y3 + + &2 * b23 * y2 * y3 = n` THEN + SUBST1_TAC(ASSUME `b11 = &1`) THEN REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Nathanson Lemma 1.7: if 1 < n, 0 < d', and (d'n - 1) divides (t^2 + d') *) +(* (i.e. -d' is a quadratic residue mod d'n - 1, witnessed by t), then n is *) +(* a sum of three squares. Build the explicit discriminant-1 matrix A = *) +(* [[a11, t, 1], [t, a22, 0], [1, 0, n]] with a22 = d'n - 1, a11 = (t^2 + *) +(* d')/a22 (so a11 a22 - t^2 = d'); then det A = 1 and FA is *) +(* positive-definite and represents n at (0, 0, 1). TSQ_DISC1 finishes. *) +(* ------------------------------------------------------------------------- *) + +let LEMMA_1_7 = prove + (`!n d' t:int. + &1 < n /\ &0 < d' /\ (d' * n - &1) divides (t pow 2 + d') + ==> ?u v w:int. u pow 2 + v pow 2 + w pow 2 = n`, + REPEAT STRIP_TAC THEN + ABBREV_TAC `a22 = d'*n - &1` THEN + UNDISCH_TAC `a22 divides (t pow 2 + d')` THEN + REWRITE_TAC[int_divides] THEN + DISCH_THEN(X_CHOOSE_TAC `a11:int`) THEN + SUBGOAL_THEN `&0 < a22` ASSUME_TAC THENL + [EXPAND_TAC "a22" THEN + SUBGOAL_THEN `&1 * &2 <= d' * n` MP_TAC THENL + [MATCH_MP_TAC INT_LE_MUL2 THEN ASM_INT_ARITH_TAC; INT_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN `a11 * a22 - t pow 2 = d'` ASSUME_TAC THENL + [MP_TAC(ASSUME `t pow 2 + d' = a22 * a11`) THEN INT_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < a11` ASSUME_TAC THENL + [SUBGOAL_THEN `&0 < a11 * a22` MP_TAC THENL + [SUBGOAL_THEN `a11 * a22 = t pow 2 + d'` SUBST1_TAC THENL + [ASM_INT_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPEC `t:int` INT_LE_POW_2) THEN ASM_INT_ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[INT_LT_MUL_EQ]; + ALL_TAC] THEN + MATCH_MP_TAC TSQ_DISC1 THEN + MAP_EVERY EXISTS_TAC [`a11:int`;`t:int`;`&1:int`;`a22:int`;`&0:int`; + `n:int`] THEN + REPEAT CONJ_TAC THENL + [FIRST_ASSUM ACCEPT_TAC; + MP_TAC(ASSUME `a11 * a22 - t pow 2 = d'`) THEN ASM_INT_ARITH_TAC; + MP_TAC(ASSUME `a11 * a22 - t pow 2 = d'`) THEN + MP_TAC(ASSUME `d' * n - &1 = a22`) THEN CONV_TAC INT_RING; + MAP_EVERY EXISTS_TAC [`&0:int`;`&0:int`;`&1:int`] THEN + CONV_TAC INT_RING]);; + +(* ------------------------------------------------------------------------- *) +(* Congruence-form interface to Lemma 1.7: it suffices that -d' is a *) +(* quadratic residue modulo d'n - 1 (the form in which Dirichlet's theorem + *) +(* quadratic reciprocity will supply the hypothesis). *) +(* ------------------------------------------------------------------------- *) + +let LEMMA_1_7_CONG = prove + (`!n d':int. + &1 < n /\ &0 < d' /\ (?x:int. (x pow 2 + d' == &0) (mod (d' * n - &1))) + ==> ?u v w:int. u pow 2 + v pow 2 + w pow 2 = n`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC LEMMA_1_7 THEN + MAP_EVERY EXISTS_TAC [`d':int`;`x:int`] THEN + ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `(x pow 2 + d' == &0) (mod (d'*n - &1))` THEN + REWRITE_TAC[int_congruent] THEN + REWRITE_TAC[int_divides] THEN STRIP_TAC THEN EXISTS_TAC `d:int` THEN + POP_ASSUM MP_TAC THEN INT_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Quadratic-residue endgame (Nathanson Lemmas 1.8/1.9): Dirichlet's theorem *) +(* and quadratic reciprocity supply an integer d' with -d' a quadratic *) +(* residue modulo d'n - 1. This part is natural-number number theory; its *) +(* terms carry explicit :num annotations and num-only operators (EXP, DIV, *) +(* MOD, jacobi, coprime, ...), so it runs under the file-wide *) +(* prioritize_int() with no priority switch. *) +(* ------------------------------------------------------------------------- *) + +let CONG_1_MOD_8 = prove + (`!d:num. (d == 1) (mod 8) ==> ?q. d = 8 * q + 1`, + MESON_TAC[CONG_CASE; MULT_SYM; ARITH_RULE `1 < 8`]);; + +let CONG_MOD_8_IMP_MOD_4 = prove + (`!x a:num. (x == a) (mod 8) ==> (x == a) (mod 4)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(SPECL [`x:num`;`a:num`;`8`;`4`] CONG_DIVIDES_MODULUS) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC DIVIDES_CONV);; + +let JACOBI_2_1MOD8 = prove + (`!d:num. (d == 1) (mod 8) ==> jacobi(2, d) = &1`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(X_CHOOSE_TAC `q:num` o MATCH_MP CONG_1_MOD_8) THEN + ASM_SIMP_TAC[JACOBI_OF_2] THEN + ASM_REWRITE_TAC[EVEN_ADD; EVEN_MULT; ARITH] THEN + ASM_REWRITE_TAC + [ARITH_RULE `((8 * q + 1) EXP 2 - 1) DIV 8 = 8*q*q + 2*q`] THEN + REWRITE_TAC[INT_POW_NEG; EVEN_ADD; EVEN_MULT; ARITH; INT_POW_ONE]);; + +let CONG_1_MOD_4 = prove + (`!d:num. (d == 1) (mod 4) ==> ?q. d = 4 * q + 1`, + MESON_TAC[CONG_CASE; MULT_SYM; ARITH_RULE `1 < 4`]);; + +let ODD_OF_1MOD4 = prove + (`!p:num. (p == 1) (mod 4) ==> ODD p`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(X_CHOOSE_THEN `q:num` SUBST1_TAC o + MATCH_MP CONG_1_MOD_4) THEN + REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH]);; + +let JACOBI_M1_1MOD4 = prove + (`!p:num. (p == 1) (mod 4) ==> jacobi(p - 1, p) = &1`, + SIMP_TAC[JACOBI_MINUS1_CASES; ODD_OF_1MOD4]);; + +let CONG_3_MOD_8 = prove + (`!d:num. (d == 3) (mod 8) ==> ?q. d = 8 * q + 3`, + MESON_TAC[CONG_CASE; MULT_SYM; ARITH_RULE `3 < 8`]);; + +let CONG_3_MOD_4 = prove + (`!d:num. (d == 3) (mod 4) ==> ?q. d = 4 * q + 3`, + MESON_TAC[CONG_CASE; MULT_SYM; ARITH_RULE `3 < 4`]);; + +let ODD_OF_3MOD4 = prove + (`!p:num. (p == 3) (mod 4) ==> ODD p`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(X_CHOOSE_TAC `q:num` o MATCH_MP CONG_3_MOD_4) THEN + ASM_REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH]);; + +let JACOBI_M1_3MOD4 = prove + (`!p:num. (p == 3) (mod 4) ==> jacobi(p - 1, p) = -- &1`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(X_CHOOSE_TAC `q:num` o MATCH_MP CONG_3_MOD_4) THEN + SUBGOAL_THEN `ODD p` ASSUME_TAC THENL + [MATCH_MP_TAC ODD_OF_3MOD4 THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_SIMP_TAC[JACOBI_MINUS1] THEN + ASM_REWRITE_TAC[ARITH_RULE `((4 * q + 3) - 1) DIV 2 = 2 * q + 1`] THEN + REWRITE_TAC[INT_POW_NEG; INT_POW_ONE; EVEN_ADD; EVEN_MULT; ARITH]);; + +let JACOBI_2_3MOD8 = prove + (`!d:num. (d == 3) (mod 8) ==> jacobi(2, d) = -- &1`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(X_CHOOSE_TAC `q:num` o MATCH_MP CONG_3_MOD_8) THEN + ASM_SIMP_TAC[JACOBI_OF_2] THEN + ASM_REWRITE_TAC[EVEN_ADD; EVEN_MULT; ARITH] THEN + ASM_REWRITE_TAC + [ARITH_RULE `((8 * q + 3) EXP 2 - 1) DIV 8 = 8*q*q + 6*q + 1`] THEN + REWRITE_TAC[INT_POW_NEG; INT_POW_ONE; EVEN_ADD; EVEN_MULT; ARITH]);; + +let JACOBI_P_DPRIME = prove + (`!p d':num. + ((d' == 1) (mod 8) \/ (d' == 3) (mod 8)) /\ + (2 * p == d' - 1) (mod d') + ==> jacobi(p, d') = &1`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP CONG_MOD_8_IMP_MOD_4 o + check (fun th -> can (find_term (fun t -> t = `8`)) (concl th))) THEN + FIRST_ASSUM(ASSUME_TAC o + MATCH_MP(SPECL [`2*p`;`d' - 1`;`d':num`] JACOBI_CONG) o + check (fun th -> concl th = `(2*p == d' - 1) (mod d')`)) THEN + MP_TAC(SPECL [`2`;`p:num`;`d':num`] JACOBI_LMUL) THEN + ASM_SIMP_TAC[JACOBI_M1_1MOD4; JACOBI_M1_3MOD4; + JACOBI_2_1MOD8; JACOBI_2_3MOD8] THEN + INT_ARITH_TAC);; + +let JACOBI_FLIP_1MOD4 = prove + (`!p d':num. + ODD p /\ ODD d' /\ coprime(p,d') /\ (p == 1) (mod 4) + ==> jacobi(d', p) = jacobi(p, d')`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`p:num`;`d':num`] JACOBI_RECIPROCITY) THEN + ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(X_CHOOSE_TAC `qp:num` o MATCH_MP CONG_1_MOD_4) THEN + SUBGOAL_THEN `(p - 1) DIV 2 = 2 * qp` SUBST1_TAC THENL + [ASM_REWRITE_TAC[ARITH_RULE `((4 * qp + 1) - 1) DIV 2 = 2 * qp`]; + ALL_TAC] THEN + REWRITE_TAC[ARITH_RULE `(2 * qp) * m = 2 * (qp * m)`] THEN + REWRITE_TAC[INT_POW_NEG; EVEN_MULT; ARITH; INT_POW_ONE; INT_MUL_LID]);; + +let JACOBI_NEG_1MOD4 = prove + (`!p d:num. + ODD p /\ ODD d /\ coprime(p,d) /\ + (p == 1) (mod 4) /\ jacobi(p,d) = &1 + ==> jacobi(d * (p - 1),p) = &1`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[JACOBI_LMUL] THEN + ASM_SIMP_TAC[JACOBI_M1_1MOD4] THEN + REWRITE_TAC[INT_MUL_RID] THEN + SUBGOAL_THEN `jacobi(d,p) = jacobi(p,d)` SUBST1_TAC THENL + [MATCH_MP_TAC JACOBI_FLIP_1MOD4 THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[]);; + +let JACOBI_NEGATIVE_SQUARE = prove + (`!p d:num. + prime p /\ jacobi(d * (p - 1),p) = &1 + ==> ?x. (x EXP 2 + d == 0) (mod p)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `?x:num. (x EXP 2 == d * (p - 1)) (mod p)` + STRIP_ASSUME_TAC THENL + [MP_TAC(SPECL [`d * (p - 1)`; `p:num`] JACOBI_PRIME) THEN + ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `p divides d * (p - 1)` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `?x:num. (x EXP 2 == d * (p - 1)) (mod p)` THEN + ASM_REWRITE_TAC[] THEN INT_ARITH_TAC; + ALL_TAC] THEN + EXISTS_TAC `x:num` THEN + MATCH_MP_TAC CONG_TRANS THEN EXISTS_TAC `d * (p - 1) + d:num` THEN + CONJ_TAC THENL + [MATCH_MP_TAC CONG_ADD THEN ASM_REWRITE_TAC[CONG_REFL]; + ALL_TAC] THEN + SUBGOAL_THEN `d * (p - 1) + d = d * p:num` SUBST1_TAC THENL + [GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) + [ARITH_RULE `d = d * 1`] THEN + REWRITE_TAC[GSYM LEFT_ADD_DISTRIB] THEN AP_TERM_TAC THEN + MATCH_MP_TAC SUB_ADD THEN + MP_TAC(SPEC `p:num` PRIME_GE_2) THEN ASM_REWRITE_TAC[] THEN ARITH_TAC; + REWRITE_TAC[CONG_0_DIVIDES] THEN + MATCH_MP_TAC DIVIDES_LMUL THEN REWRITE_TAC[DIVIDES_REFL]]);; + +let QR_MOD_P_1MOD4 = prove + (`!p d:num. + prime p /\ ODD d /\ coprime(p,d) /\ + (p == 1) (mod 4) /\ jacobi(p,d) = &1 + ==> ?x. (x EXP 2 + d == 0) (mod p)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `ODD p` ASSUME_TAC THENL + [MATCH_MP_TAC ODD_OF_1MOD4 THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC JACOBI_NEGATIVE_SQUARE THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC JACOBI_NEG_1MOD4 THEN ASM_REWRITE_TAC[]);; + +let QR_MOD_P = prove + (`!p d':num. + prime p /\ ODD d' /\ coprime(p,d') /\ + (p == 1) (mod 4) /\ + ((d' == 1) (mod 8) \/ (d' == 3) (mod 8)) /\ + (2 * p == d' - 1) (mod d') + ==> ?x. (x EXP 2 + d' == 0) (mod p)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC QR_MOD_P_1MOD4 THEN + ASM_SIMP_TAC[JACOBI_P_DPRIME]);; + +let QR_LIFT_2P = prove + (`!p d' x:num. + ODD p /\ ODD d' /\ (x EXP 2 + d' == 0) (mod p) + ==> ?z. (z EXP 2 + d' == 0) (mod (2 * p))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `?z. ODD z /\ (z == x) (mod p)` STRIP_ASSUME_TAC THENL + [ASM_CASES_TAC `ODD x` THENL + [EXISTS_TAC `x:num` THEN ASM_REWRITE_TAC[CONG_REFL]; + EXISTS_TAC `x + p:num` THEN + ASM_REWRITE_TAC[ODD_ADD; NUMBER_RULE `!x p:num. (x + p == x) (mod p)`]]; + ALL_TAC] THEN + EXISTS_TAC `z:num` THEN + REWRITE_TAC[CONG_0_DIVIDES] THEN + MATCH_MP_TAC DIVIDES_MUL THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[DIVIDES_2; EVEN_ADD; EVEN_EXP; ARITH] THEN + REWRITE_TAC[GSYM NOT_ODD] THEN ASM_REWRITE_TAC[]; + SUBGOAL_THEN `(z EXP 2 + d' == 0) (mod p)` MP_TAC THENL + [MATCH_MP_TAC CONG_TRANS THEN EXISTS_TAC `x EXP 2 + d'` THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC CONG_ADD THEN REWRITE_TAC[CONG_REFL] THEN + ASM_SIMP_TAC[CONG_EXP]; + REWRITE_TAC[CONG_0_DIVIDES]]; + ONCE_REWRITE_TAC[COPRIME_SYM] THEN + ASM_REWRITE_TAC[COPRIME_2; GSYM NOT_EVEN; NOT_ODD]]);; + +let LEGENDRE_TAIL = prove + (`!q d m x:num. + (x EXP 2 + d == 0) (mod q) /\ + q + 1 = d * m /\ + 1 < m /\ 1 <= d + ==> ?u v w:int. u pow 2 + v pow 2 + w pow 2 = &m`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`&m:int`; `&d:int`] LEMMA_1_7_CONG) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [REWRITE_TAC[INT_OF_NUM_LT] THEN ASM_ARITH_TAC; + REWRITE_TAC[INT_OF_NUM_LT] THEN ASM_ARITH_TAC; + EXISTS_TAC `&x:int` THEN + SUBGOAL_THEN `&d * &m - &1:int = &q` SUBST1_TAC THENL + [REWRITE_TAC[INT_OF_NUM_MUL; + GSYM(ASSUME `q + 1 = d * m`); GSYM INT_OF_NUM_ADD] THEN + INT_ARITH_TAC; + UNDISCH_TAC `(x EXP 2 + d == 0) (mod q)` THEN + REWRITE_TAC[num_congruent; GSYM INT_OF_NUM_POW; + GSYM INT_OF_NUM_ADD]]]; + MESON_TAC[]]);; + +let LEGENDRE_TAIL_2P = prove + (`!p d m:num. + ODD p /\ ODD d /\ + (?x. (x EXP 2 + d == 0) (mod p)) /\ + 2 * p + 1 = d * m /\ + 1 < m + ==> ?u v w:int. u pow 2 + v pow 2 + w pow 2 = &m`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`p:num`;`d:num`;`x:num`] QR_LIFT_2P) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `z:num`) THEN + MATCH_MP_TAC(SPECL [`2 * p`;`d:num`;`m:num`;`z:num`] LEGENDRE_TAIL) THEN + ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o REWRITE_RULE[ODD_EXISTS] o + check (fun th -> concl th = `ODD d`)) THEN + ARITH_TAC);; + +(* The remaining number theory (Dirichlet, the residue computation, the *) +(* assembly of Lemma 1.9) is natural-number; only the explicitly &-coerced *) +(* subterms touch the integers. *) + +(* ------------------------------------------------------------------------- *) +(* Dirichlet's theorem supplies the prime. For m = 8k+3 (the case needed for *) +(* Gauss's triangular theorem), choose a prime p = 4mj + (m-1)/2 = 4mj+4k+1 *) +(* (Dirichlet: the residue 4k+1 is coprime to the modulus 4m), and set d' = *) +(* 8j+1. Then d'm - 1 = 2p, d' = 1 (mod 8), p = 1 (mod 4), and the *) +(* reciprocity computation above makes -d' a quadratic residue mod 2p, so *) +(* Lemma 1.7 represents m as a sum of three squares. *) +(* ------------------------------------------------------------------------- *) + +let COPRIME_DIRICHLET = prove + (`!a b c:num. ODD a /\ c * b = 2 * a + 1 ==> coprime(a,4 * b)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[COPRIME_RMUL] THEN CONJ_TAC THENL + [REWRITE_TAC[ARITH_RULE `4 = 2 * 2`; COPRIME_RMUL; COPRIME_2] THEN + ASM_REWRITE_TAC[GSYM NOT_EVEN]; + REWRITE_TAC[COPRIME_BEZOUT] THEN + MAP_EVERY EXISTS_TAC [`c:num`;`2`] THEN DISJ2_TAC THEN ASM_ARITH_TAC]);; + +let DIRICHLET_PRIME_CONG = prove + (`!m a:num. 1 < m /\ coprime(a,m) + ==> ?p. prime p /\ (p == a) (mod m)`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`m:num`;`a:num`] DIRICHLET) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(MP_TAC o MATCH_MP INFINITE_NONEMPTY) THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN MESON_TAC[]);; + +let DIRICHLET_PRIME = prove + (`!k:num. ?p. prime p /\ (p == 4 * k + 1) (mod (4 * (8 * k + 3)))`, + GEN_TAC THEN MATCH_MP_TAC DIRICHLET_PRIME_CONG THEN + CONJ_TAC THENL [ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC(SPECL [`4*k+1`;`8*k+3`;`1`] COPRIME_DIRICHLET) THEN + REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH] THEN ARITH_TAC);; + +let COPRIME_FROM_MULTP1 = NUMBER_RULE + `!p c d m:num. prime p /\ c * p + 1 = d * m ==> coprime(p,d)`;; + +(* ========================================================================= *) +(* Legendre/Gauss three squares for n = 3 (mod 8): every 8k+3 is a sum of *) +(* three squares (Nathanson Lemma 1.9, c = 1 case), assembled from *) +(* Dirichlet, quadratic reciprocity, the residue lift to mod 2p, and Lemma *) +(* 1.7. *) +(* ========================================================================= *) + +let THREE_SQ_3MOD8 = prove + (`!k:num. ?u v w:int. u pow 2 + v pow 2 + w pow 2 = &(8 * k + 3)`, + GEN_TAC THEN + MP_TAC(SPEC `k:num` DIRICHLET_PRIME) THEN + DISCH_THEN(X_CHOOSE_THEN `p:num` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `?j. p = 4*(8*k+3)*j + (4*k+1)` + (X_CHOOSE_TAC `j:num`) THENL + [MP_TAC(SPECL [`4*(8*k+3)`; `4*k+1`; `p:num`] CONG_CASE) THEN + ANTS_TAC THENL [ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN ARITH_TAC; + ALL_TAC] THEN + ABBREV_TAC `d' = 8*j+1` THEN + ABBREV_TAC `m = 8*k+3` THEN + SUBGOAL_THEN `2 * p = d' * m - 1 /\ 2 * p + 1 = d' * m` + STRIP_ASSUME_TAC THENL + [UNDISCH_TAC `p = 4 * m * j + 4 * k + 1` THEN + MAP_EVERY EXPAND_TAC ["d'";"m"] THEN ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `(d' == 1) (mod 8)` ASSUME_TAC THENL + [EXPAND_TAC "d'" THEN REWRITE_TAC[CONG; ARITH_RULE `8*j+1 = j*8+1`] THEN + SIMP_TAC[MOD_MULT_ADD] THEN CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + SUBGOAL_THEN `ODD d'` ASSUME_TAC THENL + [EXPAND_TAC "d'" THEN REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH]; ALL_TAC] THEN + SUBGOAL_THEN `(p == 1) (mod 4)` ASSUME_TAC THENL + [ASM_REWRITE_TAC[CONG; ARITH_RULE `4*m*j+4*k+1 = (m*j+k)*4+1`] THEN + SIMP_TAC[MOD_MULT_ADD] THEN CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + SUBGOAL_THEN `ODD p` ASSUME_TAC THENL + [ASM_REWRITE_TAC[ARITH_RULE `4*m*j+4*k+1 = 2*(2*m*j+2*k)+1`; ODD_ADD; + ODD_MULT; ARITH]; + ALL_TAC] THEN + SUBGOAL_THEN `(2 * p == d' - 1) (mod d')` ASSUME_TAC THENL + [REWRITE_TAC[CONG_MINUS1] THEN DISJ2_TAC THEN + REWRITE_TAC[ASSUME `2 * p + 1 = d' * m`] THEN + MATCH_MP_TAC DIVIDES_RMUL THEN REWRITE_TAC[DIVIDES_REFL]; + ALL_TAC] THEN + SUBGOAL_THEN `coprime(p:num,d')` ASSUME_TAC THENL + [MATCH_MP_TAC + (SPECL [`p:num`;`2`;`d':num`;`m:num`] COPRIME_FROM_MULTP1) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC(SPECL [`p:num`;`d':num`;`m:num`] LEGENDRE_TAIL_2P) THEN + ASM_SIMP_TAC[QR_MOD_P] THEN + MAP_EVERY EXPAND_TAC ["d'";"m"] THEN ARITH_TAC);; + +(* ========================================================================= *) +(* Supporting results for the full Legendre three-square theorem. *) +(* (1) THREE_SQ_3MOD8_NUM: the natural-number form of THREE_SQ_3MOD8. *) +(* (2) The easy "impossibility" direction: 4^a(8m+7) is never a sum of three *) +(* squares (squares are 0,1,4 mod 8, so a sum of three is never 7 mod 8; *) +(* and 4 | a sum of three squares forces all three even, giving *) +(* descent). *) +(* (3) THREE_SQ_DOUBLE: if n is a sum of three squares then so is 4n. These *) +(* feed the strict iff (?u v w. u^2+v^2+w^2 = n) <=> ~(?a m. n=4^a(8m+7)). *) +(* ========================================================================= *) + +let THREE_SQ_INT_TO_NUM = prove + (`!n:num. + (?u v w:int. u pow 2 + v pow 2 + w pow 2 = &n) + ==> (?x y z:num. x EXP 2 + y EXP 2 + z EXP 2 = n)`, + GEN_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `u:int` (X_CHOOSE_THEN `v:int` + (X_CHOOSE_TAC `w:int`))) THEN + MAP_EVERY EXISTS_TAC [`num_of_int(abs u)`; `num_of_int(abs v)`; + `num_of_int(abs w)`] THEN + REWRITE_TAC[GSYM INT_OF_NUM_EQ; GSYM INT_OF_NUM_ADD; + GSYM INT_OF_NUM_POW] THEN + ASM_SIMP_TAC[INT_OF_NUM_OF_INT; INT_ABS_POS] THEN + REWRITE_TAC[INT_POW2_ABS] THEN ASM_REWRITE_TAC[]);; + +let THREE_SQ_3MOD8_NUM = prove + (`!k:num. ?u v w:num. u EXP 2 + v EXP 2 + w EXP 2 = 8 * k + 3`, + GEN_TAC THEN MATCH_MP_TAC THREE_SQ_INT_TO_NUM THEN + REWRITE_TAC[THREE_SQ_3MOD8]);; + +let SQUARE_MOD_8 = prove + (`!n. (n EXP 2 == 0) (mod 8) \/ + (n EXP 2 == 1) (mod 8) \/ + (n EXP 2 == 4) (mod 8)`, + GEN_TAC THEN SIMP_TAC[CONG; ARITH_EQ] THEN + ONCE_REWRITE_TAC[GSYM MOD_EXP_MOD] THEN + MP_TAC(SPECL [`n:num`; `8`] DIVISION) THEN REWRITE_TAC[ARITH] THEN + DISCH_THEN(MP_TAC o CONJUNCT2) THEN SIMP_TAC[LT; ARITH; ARITH_RULE + `~(m = 0) ==> (n < m <=> n = m - 1 \/ n < m - 1)`] THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST1_TAC) THEN + CONV_TAC NUM_REDUCE_CONV);; + +let THREE_SQUARES_MOD_8 = prove + (`!x y z. ~((x EXP 2 + y EXP 2 + z EXP 2 == 7) (mod 8))`, + REPEAT GEN_TAC THEN + MAP_EVERY (MP_TAC o C SPEC SQUARE_MOD_8) [`z:num`; `y:num`; `x:num`] THEN + REWRITE_TAC[IMP_IMP; TAUT `a ==> ~b <=> ~(a /\ b)`; + LEFT_OR_DISTRIB; RIGHT_OR_DISTRIB; GSYM DISJ_ASSOC; + GSYM CONJ_ASSOC] THEN + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN (MP_TAC o MATCH_MP (NUMBER_RULE + `(x:num == a) (mod n) /\ (y == b) (mod n) /\ (z == c) (mod n) /\ + (x + y + z == d) (mod n) + ==> (a + b + c == d) (mod n)`))) THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC(RAND_CONV CONG_CONV) THEN + REWRITE_TAC[]);; + +let THREE_SQUARES_4_LEMMA = prove + (`!x y z. + 4 divides (x EXP 2 + y EXP 2 + z EXP 2) + ==> EVEN x /\ EVEN y /\ EVEN z`, + REPEAT GEN_TAC THEN + MAP_EVERY (MP_TAC o C SPEC EVEN_OR_ODD) [`x:num`; `y:num`; `z:num`] THEN + REWRITE_TAC[EVEN_EXISTS; ODD_EXISTS] THEN + REPEAT(DISCH_THEN DISJ_CASES_TAC) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC(TAUT `~p ==> p ==> q`) THEN + REPEAT(FIRST_X_ASSUM(CHOOSE_THEN SUBST1_TAC)) THEN + REWRITE_TAC[ARITH_RULE `SUC(2 * n) EXP 2 = 4 * (n EXP 2 + n) + 1`; + ARITH_RULE `(2 * n) EXP 2 = 4 * n EXP 2`] THEN + REWRITE_TAC[NUMBER_RULE `p:num divides (p * x + y) <=> p divides y`; + NUMBER_RULE `p divides (1 + p * q) <=> p divides 1`; + NUMBER_RULE `p divides (1 + p * q + r) <=> p divides (r + 1)`; + GSYM ADD_ASSOC] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC(RAND_CONV DIVIDES_CONV) THEN + REWRITE_TAC[]);; + +let NOT_THREE_SQUARES = prove + (`!a m x y z. ~(4 EXP a * (8 * m + 7) = x EXP 2 + y EXP 2 + z EXP 2)`, + INDUCT_TAC THENL + [REPEAT GEN_TAC THEN + DISCH_THEN(MP_TAC o SPEC `8` o MATCH_MP EQ_IMP_CONG) THEN + MP_TAC(SPECL [`x:num`; `y:num`; `z:num`] THREE_SQUARES_MOD_8) THEN + REWRITE_TAC[CONTRAPOS_THM; ARITH; MULT_CLAUSES] THEN + SPEC_TAC(`8`,`e:num`) THEN NUMBER_TAC; + REWRITE_TAC[EXP; GSYM MULT_ASSOC] THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `EVEN x /\ EVEN y /\ EVEN z` MP_TAC THENL + [MATCH_MP_TAC THREE_SQUARES_4_LEMMA THEN ASM_MESON_TAC[divides]; + ALL_TAC] THEN + REWRITE_TAC[EVEN_EXISTS] THEN STRIP_TAC THEN + UNDISCH_TAC `4 * 4 EXP a * (8 * m + 7) = x EXP 2 + y EXP 2 + z EXP 2` THEN + ASM_REWRITE_TAC[ARITH_RULE `(2 * x) EXP 2 = 4 * x EXP 2`] THEN + ASM_REWRITE_TAC[GSYM LEFT_ADD_DISTRIB; EQ_MULT_LCANCEL; ARITH]]);; + +let THREE_SQ_DOUBLE = prove + (`!n. + (?x y z. x EXP 2 + y EXP 2 + z EXP 2 = n) + ==> (?x y z. x EXP 2 + y EXP 2 + z EXP 2 = 4 * n)`, + GEN_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `x:num` (X_CHOOSE_THEN `y:num` + (X_CHOOSE_TAC `z:num`))) THEN + MAP_EVERY EXISTS_TAC [`2 * x`; `2 * y`; `2 * z`] THEN + REWRITE_TAC[ARITH_RULE `(2 * m) EXP 2 = 4 * m EXP 2`] THEN + REWRITE_TAC[GSYM LEFT_ADD_DISTRIB] THEN ASM_REWRITE_TAC[]);; + +(* ========================================================================= *) +(* The n = 2 (mod 4) case (Nathanson Lemma 1.8). Here d' = 4j+1 and the *) +(* Dirichlet prime p = d'n - 1 directly (NO 2p lift), with p = 1 (mod 4); -d' *) +(* is a QR mod p by reciprocity (d' = 1 mod 4). *) +(* ========================================================================= *) + +let ODD_PRED_EVEN = prove + (`!n:num. 1 <= n /\ EVEN n ==> ODD(n - 1)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[ODD_SUB; ARITH] THEN ASM_REWRITE_TAC[GSYM NOT_EVEN] THEN + ASM_CASES_TAC `n = 1` THENL + [UNDISCH_TAC `EVEN n` THEN ASM_REWRITE_TAC[ARITH]; + ASM_ARITH_TAC]);; + +let CONG_2_MOD_4 = prove + (`!n:num. (n == 2) (mod 4) ==> ?t. n = 4 * t + 2`, + MESON_TAC[CONG_CASE; MULT_SYM; ARITH_RULE `2 < 4`]);; + +let QR_MOD_P_18 = prove + (`!p d':num. + prime p /\ ODD d' /\ coprime(p,d') /\ + (p == 1) (mod 4) /\ (d' == 1) (mod 4) /\ + (p == d' - 1) (mod d') + ==> ?x. (x EXP 2 + d' == 0) (mod p)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC QR_MOD_P_1MOD4 THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC EQ_TRANS THEN EXISTS_TAC `jacobi(d' - 1,d')` THEN + CONJ_TAC THENL + [MATCH_MP_TAC JACOBI_CONG THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC JACOBI_M1_1MOD4 THEN ASM_REWRITE_TAC[]]);; + +let COPRIME_DIRICHLET_18 = prove + (`!n:num. 1 <= n /\ EVEN n ==> coprime(n - 1, 4 * n)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[COPRIME_RMUL] THEN CONJ_TAC THENL + [REWRITE_TAC[ARITH_RULE `4 = 2 * 2`; COPRIME_RMUL] THEN + ONCE_REWRITE_TAC[COPRIME_SYM] THEN REWRITE_TAC[COPRIME_2] THEN + ASM_SIMP_TAC[ODD_PRED_EVEN]; + MATCH_MP_TAC COPRIME_MINUS1 THEN + UNDISCH_TAC `1 <= n` THEN ARITH_TAC]);; + +let DIRICHLET_PRIME_18 = prove + (`!n:num. 1 <= n /\ EVEN n ==> ?p. prime p /\ (p == n - 1) (mod (4 * n))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC DIRICHLET_PRIME_CONG THEN + ASM_SIMP_TAC[COPRIME_DIRICHLET_18] THEN ASM_ARITH_TAC);; + +let THREE_SQ_2MOD4 = prove + (`!n:num. + 1 < n /\ (n == 2) (mod 4) + ==> ?u v w:int. u pow 2 + v pow 2 + w pow 2 = &n`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(X_CHOOSE_THEN `t:num` SUBST_ALL_TAC o MATCH_MP CONG_2_MOD_4) THEN + SUBGOAL_THEN `1 <= 4 * t + 2 /\ EVEN(4 * t + 2)` STRIP_ASSUME_TAC THENL + [REWRITE_TAC[EVEN_ADD; EVEN_MULT; ARITH] THEN ARITH_TAC; ALL_TAC] THEN + MP_TAC(SPEC `4 * t + 2` DIRICHLET_PRIME_18) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `p:num` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `?j. p = 4 * (4 * t + 2) * j + ((4 * t + 2) - 1)` + (X_CHOOSE_TAC `j:num`) THENL + [MP_TAC(SPECL [`4*(4*t+2)`; `(4*t+2)-1`; `p:num`] CONG_CASE) THEN + ANTS_TAC THENL [ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN ARITH_TAC; + ALL_TAC] THEN + ABBREV_TAC `d' = 4 * j + 1` THEN + SUBGOAL_THEN `p = d' * (4 * t + 2) - 1` ASSUME_TAC THENL + [EXPAND_TAC "d'" THEN + UNDISCH_TAC `p = 4 * (4 * t + 2) * j + (4 * t + 2) - 1` THEN ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `ODD d'` ASSUME_TAC THENL + [EXPAND_TAC "d'" THEN REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH]; ALL_TAC] THEN + SUBGOAL_THEN `(d' == 1)(mod 4)` ASSUME_TAC THENL + [EXPAND_TAC "d'" THEN REWRITE_TAC[CONG; ARITH_RULE `4*j+1 = j*4+1`] THEN + SIMP_TAC[MOD_MULT_ADD] THEN CONV_TAC NUM_REDUCE_CONV; ALL_TAC] THEN + SUBGOAL_THEN `(p == 1)(mod 4)` ASSUME_TAC THENL + [UNDISCH_TAC `p = 4 * (4 * t + 2) * j + (4 * t + 2) - 1` THEN + DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC + [CONG; + ARITH_RULE + `4 * (4 * t + 2) * j + (4 * t + 2) - 1 = + (((4*t+2)*j + t) * 4) + 1`] THEN + SIMP_TAC[MOD_MULT_ADD] THEN CONV_TAC NUM_REDUCE_CONV; ALL_TAC] THEN + SUBGOAL_THEN `p + 1 = d' * (4 * t + 2)` ASSUME_TAC THENL + [UNDISCH_TAC `p = d' * (4 * t + 2) - 1` THEN + SUBGOAL_THEN `1 <= d' * (4 * t + 2)` MP_TAC THENL + [EXPAND_TAC "d'" THEN ARITH_TAC; ARITH_TAC]; ALL_TAC] THEN + SUBGOAL_THEN `(p == d' - 1)(mod d')` ASSUME_TAC THENL + [REWRITE_TAC[CONG_MINUS1] THEN DISJ2_TAC THEN + REWRITE_TAC[ASSUME `p + 1 = d' * (4 * t + 2)`] THEN + MATCH_MP_TAC DIVIDES_RMUL THEN REWRITE_TAC[DIVIDES_REFL]; + ALL_TAC] THEN + SUBGOAL_THEN `coprime(p:num,d')` ASSUME_TAC THENL + [MATCH_MP_TAC + (SPECL [`p:num`;`1`;`d':num`;`4*t+2`] COPRIME_FROM_MULTP1) THEN + CONJ_TAC THENL + [FIRST_ASSUM ACCEPT_TAC; + REWRITE_TAC[MULT_CLAUSES] THEN FIRST_ASSUM ACCEPT_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN `?x. (x EXP 2 + d' == 0) (mod p)` + (X_CHOOSE_TAC `x:num`) THENL + [MATCH_MP_TAC QR_MOD_P_18 THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC + (SPECL [`p:num`;`d':num`;`4 * t + 2`;`x:num`] LEGENDRE_TAIL) THEN + ASM_REWRITE_TAC[] THEN EXPAND_TAC "d'" THEN ARITH_TAC);; + +(* ========================================================================= *) +(* Legendre three squares for n = 1 (mod 8): every 8k+1 is a sum of three *) +(* squares (Nathanson Lemma 1.9, c = 3 case). Mirrors the n = 3 (mod 8) *) +(* assembly but with d' = 8j+3 (so d' = 3 (mod 8)) and the prime in the *) +(* residue class 12k+1 (mod 4(8k+1)); the Jacobi computation flips sign *) +(* twice (jacobi(-1,d') = jacobi(2,d') = -1 for d' = 3 (mod 8)), so *) +(* jacobi(p,d') = 1 again and -d' is a quadratic residue mod p, lifted to *) +(* mod 2p = d'(8k+1)-1. *) +(* ========================================================================= *) + +let DIRICHLET_PRIME_1MOD8 = prove + (`!k:num. ?p. prime p /\ (p == 12 * k + 1) (mod (4 * (8 * k + 1)))`, + GEN_TAC THEN MATCH_MP_TAC DIRICHLET_PRIME_CONG THEN + CONJ_TAC THENL [ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC(SPECL [`12*k+1`;`8*k+1`;`3`] COPRIME_DIRICHLET) THEN + REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH] THEN ARITH_TAC);; + +let THREE_SQ_1MOD8 = prove + (`!k:num. ?u v w:int. u pow 2 + v pow 2 + w pow 2 = &(8 * k + 1)`, + GEN_TAC THEN ASM_CASES_TAC `k = 0` THENL + [ASM_REWRITE_TAC[] THEN + MAP_EVERY EXISTS_TAC [`&1:int`;`&0:int`;`&0:int`] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC INT_REDUCE_CONV; + ALL_TAC] THEN + MP_TAC(SPEC `k:num` DIRICHLET_PRIME_1MOD8) THEN + DISCH_THEN(X_CHOOSE_THEN `p:num` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `?j. p = 4*(8*k+1)*j + (12*k+1)` + (X_CHOOSE_TAC `j:num`) THENL + [MP_TAC(SPECL [`4*(8*k+1)`; `12*k+1`; `p:num`] CONG_CASE) THEN + ANTS_TAC THENL [ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN ARITH_TAC; + ALL_TAC] THEN + ABBREV_TAC `d' = 8*j+3` THEN + ABBREV_TAC `m = 8*k+1` THEN + SUBGOAL_THEN `2 * p = d' * m - 1 /\ 2 * p + 1 = d' * m` + STRIP_ASSUME_TAC THENL + [UNDISCH_TAC `p = 4 * m * j + 12 * k + 1` THEN + MAP_EVERY EXPAND_TAC ["d'";"m"] THEN ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `(d' == 3) (mod 8)` ASSUME_TAC THENL + [EXPAND_TAC "d'" THEN REWRITE_TAC[CONG; ARITH_RULE `8*j+3 = j*8+3`] THEN + SIMP_TAC[MOD_MULT_ADD] THEN CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + SUBGOAL_THEN `ODD d'` ASSUME_TAC THENL + [EXPAND_TAC "d'" THEN REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH]; ALL_TAC] THEN + SUBGOAL_THEN `(p == 1) (mod 4)` ASSUME_TAC THENL + [ASM_REWRITE_TAC[CONG; ARITH_RULE `4*m*j+12*k+1 = (m*j+3*k)*4+1`] THEN + SIMP_TAC[MOD_MULT_ADD] THEN CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + SUBGOAL_THEN `ODD p` ASSUME_TAC THENL + [ASM_MESON_TAC[ODD_OF_1MOD4]; ALL_TAC] THEN + SUBGOAL_THEN `(2 * p == d' - 1) (mod d')` ASSUME_TAC THENL + [REWRITE_TAC[CONG_MINUS1] THEN DISJ2_TAC THEN + REWRITE_TAC[ASSUME `2 * p + 1 = d' * m`] THEN + MATCH_MP_TAC DIVIDES_RMUL THEN REWRITE_TAC[DIVIDES_REFL]; + ALL_TAC] THEN + SUBGOAL_THEN `coprime(p:num,d')` ASSUME_TAC THENL + [MATCH_MP_TAC + (SPECL [`p:num`;`2`;`d':num`;`m:num`] COPRIME_FROM_MULTP1) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC(SPECL [`p:num`;`d':num`;`m:num`] LEGENDRE_TAIL_2P) THEN + ASM_SIMP_TAC[QR_MOD_P] THEN + MAP_EVERY EXPAND_TAC ["d'";"m"] THEN ASM_ARITH_TAC);; + +(* ========================================================================= *) +(* Legendre three squares for n = 5 (mod 8): every 8k+5 is a sum of three *) +(* squares (Nathanson Lemma 1.9, c = 3 case, p = 3 (mod 4) branch). Same d' *) +(* = 8j+3 as the n = 1 (mod 8) case, but the prime sits in class 12k+7 (mod *) +(* 4(8k+5)), so p = 3 (mod 4). Then jacobi(-1,p) = -1 and the reciprocity *) +(* flip also contributes -1 (both (p-1)/2 and (d'-1)/2 odd), and the two *) +(* signs cancel: jacobi(d'(p-1),p) = 1 again, so -d' is a quadratic residue *) +(* mod p. *) +(* ========================================================================= *) + +let JACOBI_FLIP_3MOD4 = prove + (`!p d':num. + ODD p /\ ODD d' /\ coprime(p,d') /\ + (p == 3) (mod 4) /\ (d' == 3) (mod 8) + ==> jacobi(d', p) = -- jacobi(p, d')`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`p:num`;`d':num`] JACOBI_RECIPROCITY) THEN + ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(X_CHOOSE_TAC `qp:num` o MATCH_MP CONG_3_MOD_4) THEN + FIRST_ASSUM(X_CHOOSE_TAC `qd:num` o MATCH_MP CONG_3_MOD_8) THEN + SUBGOAL_THEN `(p - 1) DIV 2 = 2 * qp + 1` SUBST1_TAC THENL + [ASM_REWRITE_TAC[ARITH_RULE `((4 * qp + 3) - 1) DIV 2 = 2 * qp + 1`]; + ALL_TAC] THEN + SUBGOAL_THEN `(d' - 1) DIV 2 = 4 * qd + 1` SUBST1_TAC THENL + [ASM_REWRITE_TAC[ARITH_RULE `((8 * qd + 3) - 1) DIV 2 = 4 * qd + 1`]; + ALL_TAC] THEN + REWRITE_TAC[INT_POW_NEG; INT_POW_ONE; EVEN_MULT; EVEN_ADD; ARITH] THEN + INT_ARITH_TAC);; + +let JACOBI_NEG_3MOD4 = prove + (`!p d:num. + ODD p /\ ODD d /\ coprime(p,d) /\ + (p == 3) (mod 4) /\ (d == 3) (mod 8) /\ + jacobi(p,d) = &1 + ==> jacobi(d * (p - 1),p) = &1`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[JACOBI_LMUL] THEN + ASM_SIMP_TAC[JACOBI_M1_3MOD4] THEN + SUBGOAL_THEN `jacobi(d,p) = -- jacobi(p,d)` SUBST1_TAC THENL + [MATCH_MP_TAC JACOBI_FLIP_3MOD4 THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN INT_ARITH_TAC);; + +let QR_MOD_P_5MOD8 = prove + (`!p d':num. + prime p /\ ODD d' /\ coprime(p,d') /\ + (p == 3) (mod 4) /\ (d' == 3) (mod 8) /\ + (2 * p == d' - 1) (mod d') + ==> ?x. (x EXP 2 + d' == 0) (mod p)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `ODD p` ASSUME_TAC THENL + [MATCH_MP_TAC ODD_OF_3MOD4 THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC JACOBI_NEGATIVE_SQUARE THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC JACOBI_NEG_3MOD4 THEN + ASM_SIMP_TAC[JACOBI_P_DPRIME]);; + +let DIRICHLET_PRIME_5MOD8 = prove + (`!k:num. ?p. prime p /\ (p == 12 * k + 7) (mod (4 * (8 * k + 5)))`, + GEN_TAC THEN MATCH_MP_TAC DIRICHLET_PRIME_CONG THEN + CONJ_TAC THENL [ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC(SPECL [`12*k+7`;`8*k+5`;`3`] COPRIME_DIRICHLET) THEN + REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH] THEN ARITH_TAC);; + +let THREE_SQ_5MOD8 = prove + (`!k:num. ?u v w:int. u pow 2 + v pow 2 + w pow 2 = &(8 * k + 5)`, + GEN_TAC THEN + MP_TAC(SPEC `k:num` DIRICHLET_PRIME_5MOD8) THEN + DISCH_THEN(X_CHOOSE_THEN `p:num` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `?j. p = 4*(8*k+5)*j + (12*k+7)` + (X_CHOOSE_TAC `j:num`) THENL + [MP_TAC(SPECL [`4*(8*k+5)`; `12*k+7`; `p:num`] CONG_CASE) THEN + ANTS_TAC THENL [ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN ARITH_TAC; + ALL_TAC] THEN + ABBREV_TAC `d' = 8*j+3` THEN + ABBREV_TAC `m = 8*k+5` THEN + SUBGOAL_THEN `2 * p = d' * m - 1 /\ 2 * p + 1 = d' * m` + STRIP_ASSUME_TAC THENL + [UNDISCH_TAC `p = 4 * m * j + 12 * k + 7` THEN + MAP_EVERY EXPAND_TAC ["d'";"m"] THEN ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `(d' == 3) (mod 8)` ASSUME_TAC THENL + [EXPAND_TAC "d'" THEN REWRITE_TAC[CONG; ARITH_RULE `8*j+3 = j*8+3`] THEN + SIMP_TAC[MOD_MULT_ADD] THEN CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + SUBGOAL_THEN `ODD d'` ASSUME_TAC THENL + [EXPAND_TAC "d'" THEN REWRITE_TAC[ODD_ADD; ODD_MULT; ARITH]; ALL_TAC] THEN + SUBGOAL_THEN `(p == 3) (mod 4)` ASSUME_TAC THENL + [ASM_REWRITE_TAC[CONG; ARITH_RULE `4*m*j+12*k+7 = (m*j+3*k+1)*4+3`] THEN + SIMP_TAC[MOD_MULT_ADD] THEN CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + SUBGOAL_THEN `ODD p` ASSUME_TAC THENL + [ASM_MESON_TAC[ODD_OF_3MOD4]; ALL_TAC] THEN + SUBGOAL_THEN `(2 * p == d' - 1) (mod d')` ASSUME_TAC THENL + [REWRITE_TAC[CONG_MINUS1] THEN DISJ2_TAC THEN + REWRITE_TAC[ASSUME `2 * p + 1 = d' * m`] THEN + MATCH_MP_TAC DIVIDES_RMUL THEN REWRITE_TAC[DIVIDES_REFL]; + ALL_TAC] THEN + SUBGOAL_THEN `coprime(p:num,d')` ASSUME_TAC THENL + [MATCH_MP_TAC + (SPECL [`p:num`;`2`;`d':num`;`m:num`] COPRIME_FROM_MULTP1) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC(SPECL [`p:num`;`d':num`;`m:num`] LEGENDRE_TAIL_2P) THEN + ASM_SIMP_TAC[QR_MOD_P_5MOD8] THEN + MAP_EVERY EXPAND_TAC ["d'";"m"] THEN ARITH_TAC);; + +(* ========================================================================= *) +(* FINAL ASSEMBLY: the full Legendre three-square theorem (?x y z. x^2 + y^2 *) +(* + z^2 = n) <=> ~(?a m. n = 4^a (8m+7)). Backward direction by complete *) +(* induction on n: if n is not of the excluded form then n MOD 8 in *) +(* {1,2,3,5,6} (handled by the residue cases above), or n MOD 8 in {0,4} *) +(* (so 4 | n; descend to n DIV 4, which is also not of the excluded form, *) +(* and lift by THREE_SQ_DOUBLE), the case n MOD 8 = 7 being excluded by *) +(* hypothesis. Forward direction is NOT_THREE_SQUARES. *) +(* ========================================================================= *) + +let THREE_SQ_1MOD8_NUM = prove + (`!k:num. ?x y z:num. x EXP 2 + y EXP 2 + z EXP 2 = 8 * k + 1`, + GEN_TAC THEN MATCH_MP_TAC THREE_SQ_INT_TO_NUM THEN + REWRITE_TAC[THREE_SQ_1MOD8]);; + +let THREE_SQ_5MOD8_NUM = prove + (`!k:num. ?x y z:num. x EXP 2 + y EXP 2 + z EXP 2 = 8 * k + 5`, + GEN_TAC THEN MATCH_MP_TAC THREE_SQ_INT_TO_NUM THEN + REWRITE_TAC[THREE_SQ_5MOD8]);; + +let THREE_SQ_2MOD4_NUM = prove + (`!n:num. + 1 < n /\ (n == 2) (mod 4) + ==> ?x y z:num. x EXP 2 + y EXP 2 + z EXP 2 = n`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC THREE_SQ_INT_TO_NUM THEN + MATCH_MP_TAC THREE_SQ_2MOD4 THEN ASM_REWRITE_TAC[]);; + +let THREE_SQ_RESIDUE_NUM = prove + (`!n:num. + (n MOD 8 = 1 \/ n MOD 8 = 2 \/ n MOD 8 = 3 \/ + n MOD 8 = 5 \/ n MOD 8 = 6) + ==> ?x y z:num. x EXP 2 + y EXP 2 + z EXP 2 = n`, + GEN_TAC THEN + MP_TAC(SPECL [`n:num`;`8`] (CONJUNCT1 DIVISION_SIMP)) THEN + ABBREV_TAC `k = n DIV 8` THEN + DISCH_THEN(fun th -> GEN_REWRITE_TAC (RAND_CONV + o ONCE_DEPTH_CONV) [SYM th]) THEN + STRIP_TAC THEN ASM_REWRITE_TAC[ARITH_RULE `k * 8 + r = 8 * k + r`] THEN + REWRITE_TAC[THREE_SQ_1MOD8_NUM; THREE_SQ_3MOD8_NUM; THREE_SQ_5MOD8_NUM] THEN + MATCH_MP_TAC THREE_SQ_2MOD4_NUM THEN + (CONJ_TAC THENL [ARITH_TAC; ALL_TAC]) THENL + [REWRITE_TAC[CONG; ARITH_RULE `8*k+2 = (2*k)*4+2`]; + REWRITE_TAC[CONG; ARITH_RULE `8*k+6 = (2*k+1)*4+2`]] THEN + SIMP_TAC[MOD_MULT_ADD] THEN CONV_TAC NUM_REDUCE_CONV);; + +let MOD8_04_DIV4 = prove + (`!n:num. (n MOD 8 = 0 \/ n MOD 8 = 4) ==> 4 divides n`, + GEN_TAC THEN REWRITE_TAC[DIVIDES_MOD] THEN + SUBGOAL_THEN `n MOD 4 = n MOD 8 MOD 4` SUBST1_TAC THENL + [REWRITE_TAC[ARITH_RULE `8 = 4 * 2`; MOD_MOD]; + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV]);; + +let DESCENT_NOT_FORM = prove + (`!n:num. + 4 divides n /\ ~(?a m. n = 4 EXP a * (8 * m + 7)) + ==> ~(?a m. n DIV 4 = 4 EXP a * (8 * m + 7))`, + GEN_TAC THEN STRIP_TAC THEN + REWRITE_TAC[NOT_EXISTS_THM] THEN MAP_EVERY X_GEN_TAC [`a:num`;`m:num`] THEN + DISCH_TAC THEN + UNDISCH_TAC `~(?a m. n = 4 EXP a * (8 * m + 7))` THEN + REWRITE_TAC[] THEN MAP_EVERY EXISTS_TAC [`SUC a`; `m:num`] THEN + REWRITE_TAC[EXP; GSYM MULT_ASSOC] THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + FIRST_ASSUM(MP_TAC o REWRITE_RULE[divides]) THEN + DISCH_THEN(X_CHOOSE_TAC `c:num`) THEN + ASM_REWRITE_TAC[ARITH_RULE `4 * c = c * 4`; DIV_MULT; ARITH] THEN + SUBGOAL_THEN `(c * 4) DIV 4 = c` SUBST1_TAC THENL + [REWRITE_TAC[ARITH_RULE `c * 4 = 4 * c`] THEN SIMP_TAC[DIV_MULT; ARITH]; + REFL_TAC]);; + +let DIV4_LESS = prove + (`!n:num. ~(n = 0) /\ 4 divides n ==> n DIV 4 < n`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o REWRITE_RULE[divides]) THEN + DISCH_THEN(X_CHOOSE_THEN `c:num` SUBST_ALL_TAC) THEN + SUBGOAL_THEN `(4 * c) DIV 4 = c` SUBST1_TAC THENL + [SIMP_TAC[DIV_MULT; ARITH]; ASM_ARITH_TAC]);; + +let MOD8_7_FORM = prove + (`!n:num. n MOD 8 = 7 ==> ?a m. n = 4 EXP a * (8 * m + 7)`, + GEN_TAC THEN DISCH_TAC THEN + MAP_EVERY EXISTS_TAC [`0:num`; `n DIV 8`] THEN + REWRITE_TAC[EXP; MULT_CLAUSES] THEN + MP_TAC(SPECL [`n:num`;`8`] (CONJUNCT1 DIVISION_SIMP)) THEN + ASM_REWRITE_TAC[] THEN ARITH_TAC);; + +let THREE_SQ_NOT_FORM = prove + (`!n:num. + ~(?a m. n = 4 EXP a * (8 * m + 7)) + ==> ?x y z:num. x EXP 2 + y EXP 2 + z EXP 2 = n`, + MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN STRIP_TAC THEN DISCH_TAC THEN + ASM_CASES_TAC `n = 0` THENL + [MAP_EVERY EXISTS_TAC [`0:num`;`0`;`0`] THEN ASM_REWRITE_TAC[] THEN + CONV_TAC NUM_REDUCE_CONV; + ALL_TAC] THEN + DISJ_CASES_TAC(ARITH_RULE + `(n MOD 8 = 1 \/ n MOD 8 = 2 \/ n MOD 8 = 3 \/ n MOD 8 = 5 + \/ n MOD 8 = 6) \/ + (n MOD 8 = 0 \/ n MOD 8 = 4) \/ n MOD 8 = 7`) + THENL + [MATCH_MP_TAC THREE_SQ_RESIDUE_NUM THEN FIRST_X_ASSUM ACCEPT_TAC; + ALL_TAC] THEN + FIRST_X_ASSUM DISJ_CASES_TAC THENL + [ALL_TAC; + MP_TAC(SPEC `n:num` MOD8_7_FORM) THEN ASM_REWRITE_TAC[]] THEN + SUBGOAL_THEN `4 divides n` ASSUME_TAC THENL + [MATCH_MP_TAC MOD8_04_DIV4 THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `?x y z:num. x EXP 2 + y EXP 2 + z EXP 2 = n DIV 4` MP_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `n DIV 4`) THEN + ANTS_TAC THENL [MATCH_MP_TAC DIV4_LESS THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + DISCH_THEN MATCH_MP_TAC THEN + MATCH_MP_TAC DESCENT_NOT_FORM THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o MATCH_MP THREE_SQ_DOUBLE) THEN + SUBGOAL_THEN `4 * (n DIV 4) = n` SUBST1_TAC THENL + [FIRST_ASSUM(X_CHOOSE_THEN `c:num` SUBST1_TAC o REWRITE_RULE[divides]) THEN + SIMP_TAC[DIV_MULT; ARITH]; + REWRITE_TAC[]]);; + +let LEGENDRE_THREE_SQUARES = prove + (`!n:num. + (?x y z:num. x EXP 2 + y EXP 2 + z EXP 2 = n) <=> + ~(?a m. n = 4 EXP a * (8 * m + 7))`, + MESON_TAC[NOT_THREE_SQUARES; THREE_SQ_NOT_FORM]);; + +(* ========================================================================= *) +(* Gauss's triangular number theorem: every natural number is a sum of three *) +(* triangular numbers. This is the corollary that 8n + 3 is a sum of three *) +(* squares iff n = T_a + T_b + T_c. A number congruent to 3 mod 8 that is a *) +(* sum of three squares has all three summands odd (squares are 0, 1, 4 mod *) +(* 8, and only 1 + 1 + 1 = 3 mod 8), and 8 T_k + 1 = (2k+1)^2. Here we *) +(* package the reduction (the corollary), which together with *) +(* three-squares-for-(8n+3) yields the theorem. *) +(* ========================================================================= *) + +let REM_8_CASES = prove + (`!x:int. x rem &8 = &0 \/ x rem &8 = &1 \/ x rem &8 = &2 \/ x rem &8 = &3 \/ + x rem &8 = &4 \/ x rem &8 = &5 \/ x rem &8 = &6 \/ x rem &8 = &7`, + GEN_TAC THEN MP_TAC(SPECL [`x:int`;`&8:int`] INT_DIVISION) THEN + INT_ARITH_TAC);; + +let SQ_MOD_8 = prove + (`!x:int. + (x pow 2) rem &8 = &0 \/ + (x pow 2) rem &8 = &1 \/ + (x pow 2) rem &8 = &4`, + GEN_TAC THEN ONCE_REWRITE_TAC[GSYM INT_POW_REM] THEN + MP_TAC(SPEC `x:int` REM_8_CASES) THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONV_TAC INT_REDUCE_CONV);; + +let ODD_SQ_MOD_8 = prove + (`!x:int. (x pow 2 rem &8 = &1) <=> ~(&2 divides x)`, + GEN_TAC THEN ONCE_REWRITE_TAC[GSYM INT_POW_REM] THEN + REWRITE_TAC[GSYM INT_REM_EQ_0] THEN + SUBGOAL_THEN `x rem &2 = (x rem &8) rem &2` SUBST1_TAC THENL + [MESON_TAC[INT_REM_REM_MUL; INT_ARITH `&8 = &2 * &4`]; ALL_TAC] THEN + MP_TAC(SPEC `x:int` REM_8_CASES) THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONV_TAC INT_REDUCE_CONV);; + +let SUM3_MOD8_CORE = prove + (`!pu pv pw:int. + (pu = &0 \/ pu = &1 \/ pu = &4) /\ + (pv = &0 \/ pv = &1 \/ pv = &4) /\ + (pw = &0 \/ pw = &1 \/ pw = &4) /\ + (pu + pv + pw) rem &8 = &3 + ==> pu = &1 /\ pv = &1 /\ pw = &1`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN POP_ASSUM MP_TAC THEN ASM_REWRITE_TAC[] THEN + CONV_TAC INT_REDUCE_CONV);; + +let THREE_SQ_ALL_ODD = prove + (`!u v w n:int. + u pow 2 + v pow 2 + w pow 2 = &8 * n + &3 + ==> ~(&2 divides u) /\ ~(&2 divides v) /\ ~(&2 divides w)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[GSYM ODD_SQ_MOD_8] THEN + MATCH_MP_TAC SUM3_MOD8_CORE THEN + REWRITE_TAC[SQ_MOD_8] THEN + SUBGOAL_THEN + `(u pow 2 rem &8 + v pow 2 rem &8 + w pow 2 rem &8) rem &8 = + (u pow 2 + v pow 2 + w pow 2) rem &8` SUBST1_TAC THENL + [CONV_TAC INT_REM_DOWN_CONV THEN REFL_TAC; + ASM_REWRITE_TAC[] THEN REWRITE_TAC[INT_REM_MUL_ADD] THEN + CONV_TAC INT_REDUCE_CONV]);; + +(* An odd integer has the form 2a + 1; an integer triangular term a(a+1) is *) +(* a natural triangular term k(k+1) (k = a or -a-1, whichever is *) +(* nonnegative). *) + +let INT_ODD_FORM = prove + (`!u:int. ~(&2 divides u) ==> ?a. u = &2 * a + &1`, + REPEAT STRIP_TAC THEN EXISTS_TAC `u div &2` THEN + MP_TAC(SPECL [`u:int`;`&2:int`] INT_DIVISION) THEN + REWRITE_TAC[INT_ARITH `~(&2 = &0)`] THEN + SUBGOAL_THEN `u rem &2 = &1` SUBST1_TAC THENL + [ASM_REWRITE_TAC[INT_REM_2_DIVIDES]; INT_ARITH_TAC]);; + +let INT_TRI_NAT = prove + (`!a:int. ?k:num. a * (a + &1) = &(k * (k + 1))`, + GEN_TAC THEN DISJ_CASES_TAC(INT_ARITH `&0 <= a \/ a < &0`) THENL + [EXISTS_TAC `num_of_int a` THEN + SUBGOAL_THEN `&(num_of_int a) = a` ASSUME_TAC THENL + [MATCH_MP_TAC INT_OF_NUM_OF_INT THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[GSYM INT_OF_NUM_MUL; GSYM INT_OF_NUM_ADD] THEN + ASM_REWRITE_TAC[] THEN INT_ARITH_TAC; + EXISTS_TAC `num_of_int(--a - &1)` THEN + SUBGOAL_THEN `&(num_of_int(--a - &1)) = --a - &1` ASSUME_TAC THENL + [MATCH_MP_TAC INT_OF_NUM_OF_INT THEN ASM_INT_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[GSYM INT_OF_NUM_MUL; GSYM INT_OF_NUM_ADD] THEN + ASM_REWRITE_TAC[] THEN INT_ARITH_TAC]);; + +let GAUSS_TRI_FROM_3SQ = prove + (`!n. + (?u v w:int. u pow 2 + v pow 2 + w pow 2 = &8 * &n + &3) + ==> ?a b c:num. 2 * n = a * (a + 1) + b * (b + 1) + c * (c + 1)`, + GEN_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `u:int` (X_CHOOSE_THEN `v:int` + (X_CHOOSE_TAC `w:int`))) THEN + MP_TAC(SPECL [`u:int`; `v:int`; `w:int`; `&n:int`] THREE_SQ_ALL_ODD) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + MP_TAC(SPEC `u:int` INT_ODD_FORM) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `r:int`) THEN + MP_TAC(SPEC `v:int` INT_ODD_FORM) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `s:int`) THEN + MP_TAC(SPEC `w:int` INT_ODD_FORM) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `t:int`) THEN + SUBGOAL_THEN + `&2 * &n = r * (r + &1) + s * (s + &1) + t * (t + &1)` + ASSUME_TAC THENL + [UNDISCH_TAC `u pow 2 + v pow 2 + w pow 2 = &8 * &n + &3` THEN + ASM_REWRITE_TAC[] THEN INT_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(SPEC `r:int` INT_TRI_NAT) THEN DISCH_THEN(X_CHOOSE_TAC `a:num`) THEN + MP_TAC(SPEC `s:int` INT_TRI_NAT) THEN DISCH_THEN(X_CHOOSE_TAC `b:num`) THEN + MP_TAC(SPEC `t:int` INT_TRI_NAT) THEN DISCH_THEN(X_CHOOSE_TAC `c:num`) THEN + MAP_EVERY EXISTS_TAC [`a:num`; `b:num`; `c:num`] THEN + UNDISCH_TAC + `&2 * &n = r * (r + &1) + s * (s + &1) + t * (t + &1)` THEN + ASM_REWRITE_TAC[INT_OF_NUM_CLAUSES]);; + +let GAUSS_TRIANGULAR = prove + (`!n:num. ?a b c. 2 * n = a * (a + 1) + b * (b + 1) + c * (c + 1)`, + GEN_TAC THEN MATCH_MP_TAC GAUSS_TRI_FROM_3SQ THEN + REWRITE_TAC[INT_OF_NUM_CLAUSES; THREE_SQ_3MOD8]);; + +let triangular = new_definition + `triangular t <=> ?k. t = (k * (k + 1)) DIV 2`;; + +let GAUSS_TRIANGULAR_SUM = prove + (`!n:num. + ?a b c. triangular a /\ triangular b /\ triangular c /\ + n = a + b + c`, + GEN_TAC THEN + MP_TAC(SPEC `n:num` GAUSS_TRIANGULAR) THEN + DISCH_THEN(X_CHOOSE_THEN `a:num` (X_CHOOSE_THEN `b:num` + (X_CHOOSE_TAC `c:num`))) THEN + SUBGOAL_THEN + `EVEN(a * (a + 1)) /\ EVEN(b * (b + 1)) /\ EVEN(c * (c + 1))` + MP_TAC THENL + [REWRITE_TAC[EVEN_MULT; EVEN_ADD; ARITH; GSYM NOT_EVEN] THEN + MESON_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[EVEN_EXISTS] THEN + DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `ka:num`) + (CONJUNCTS_THEN2 (X_CHOOSE_TAC `kb:num`) (X_CHOOSE_TAC `kc:num`))) THEN + MAP_EVERY EXISTS_TAC [`ka:num`;`kb:num`;`kc:num`] THEN + REWRITE_TAC[triangular] THEN + REPEAT CONJ_TAC THENL + [EXISTS_TAC `a:num` THEN ASM_REWRITE_TAC[ARITH_RULE `(2 * x) DIV 2 = x`]; + EXISTS_TAC `b:num` THEN ASM_REWRITE_TAC[ARITH_RULE `(2 * x) DIV 2 = x`]; + EXISTS_TAC `c:num` THEN ASM_REWRITE_TAC[ARITH_RULE `(2 * x) DIV 2 = x`]; + UNDISCH_TAC `2 * n = a * (a + 1) + b * (b + 1) + c * (c + 1)` THEN + ASM_REWRITE_TAC[] THEN ARITH_TAC]);; + +(* Restore the real overload priority established by 100/dirichlet.ml. *) + +prioritize_real();; diff --git a/CHANGES b/CHANGES index 0637a191..72af016a 100644 --- a/CHANGES +++ b/CHANGES @@ -8,6 +8,1235 @@ * page: https://github.com/jrh13/hol-light/commits/master * * ***************************************************************** +Sun 16th Aug 2026 Multivariate/realanalysis.ml, Multivariate/lpspaces.ml, 100/fourier.ml, Autoformalization/fifteen_theorem.ml [new file], Autoformalization/carleson.ml [new file], Autoformalization/fourier_transform.ml [new file] + +Added two more substantial fully autonomous formalizations. + +The carleson.ml formalization, produced by Claude Opus 4.8, proves +Carleson's theorem that the Fourier series of a square-integrable periodic +function converges almost everywhere. The development follows Fremlin's +presentation of the Lacey-Thiele time-frequency proof in "Measure Theory" +volume 2 (sec 286), including the Hardy-Littlewood maximal estimates, tile and +tree arguments, and the Carleson maximal inequality. Its supporting +Fourier-transform library develops Fourier analysis on the real line, including +inversion, Schwartz functions, Plancherel's theorem and the L2 transform, again +following Fremlin's, "Measure Theory" volume 2, the earlier sections 283-285. +A few small additions and tweaks are made to existing files as part of this +formalization (e.g. adding the complex inner product to lpspaces.ml). + +The fifteen_theorem.ml formalization, produced by GPT-5.6-sol (xhigh), +proves the Conway-Schneeberger Fifteen Theorem: a positive-definite integral +quadratic form is universal exactly when it represents every positive integer +up to 15. The proof follows Bhargava's treatment using truants, escalator +lattices, the nine ternary escalators and a finite rank-four analysis, together +with classical ternary-form results and checked finite computations. + +Sat 8th Aug 2026 Autoformalization/three_squares.ml [new file], Autoformalization/sarkovskii.ml [new file] + +Added a new subdirectory Autoformalization as a home for miscellaneous +results formalized entirely autonomously by AI systems. Initially this +contains two such formalizations: + + 1. three_squares.ml is a formalization by Claude Opus 4.8 of the + classic Legendre three-squares theorem characterizing those + integers representable as a sum of three integer squares, as + well as the corollary that every integer is a sum of three + triangular numbers. + + 2. sarkovskii.ml is a formalization by GPT-5.6-sol of Sarkovskii's + theorem on periodic points of functions on real intervals. It + is initially proved for functions real->real, then that core + result is generalized using elementary topological machinery + to arbitrary intervals. + +Mon 3rd Aug 2026 Examples/sos.ml + +Added a fix to handle degenerate SDPs with an empty constraint in REAL_SOS. +This Claude-written change was based on a bug report and suggested fix from +Daniel Nezamabadi. The issue is that real_positivnullstellensatz_general +eliminates the linear monoid-matching equations in an essentially +arbitrary order (via choose), then treats the remaining free variables as +the SDP decision variables. Depending on that order, a free variable can +turn out not to occur in any semidefinite block, so its constraint matrix +mk_matrix is identically zero. CSDP rejects such a problem outright with +"Constraint k is empty" and return code 206, rather than solving it. +This is order-dependent: HOL Light's choose happens to pick an order that +avoids it on the existing examples, but a differently-ordered dictionary +implementation (e.g. Candle's) can hit it, e.g. on + + `a1 >= &0 /\ a2 >= &0 /\ + (a1 * a1 + a2 * a2 = b1 * b1 + b2 * b2 + &2) /\ + (a1 * b1 + a2 * b2 = &0) + ==> a1 * a2 - b1 * b2 >= &0`;; + +The elimination is otherwise fine: the number of free variables (the affine +solution dimension) is invariant across orders, so feasibility and the +optimum are unchanged. Only the split of the free variables into "occurs in +a block" vs "does not" varies, and an unlucky order leaves one decoupled. + +The fix is that before calling CSDP, we now drop any free variable whose +constraint matrix is zero, solve the reduced SDP, and set the dropped +variable to zero in the result. This is lossless: a variable absent from +every block also has a zero objective coefficient (the objective is built +from diagonal block entries), so it is genuinely unconstrained and +irrelevant to the optimum. When no matrix is empty the reduced problem is +identical to the original. + +This update also separately makes the "deepen" iterative deepending search +function robust to genuinely malformed problems: CSDP return codes are now +classified so that infeasibility (1,2) and numerical trouble (4-9) remain +retryable Failures for the iterative deepening / tryfind search (some +proofs, e.g. the Chebyshev and Zeng examples, legitimately rely on +retrying past a numerical failure), while a structural rejection raises a +new Csdp_error that deepen does not catch. Previously such a rejection was +either swallowed as "no certificate at this degree", causing "deepen" to +loop to ever higher degrees, or surfaced as a confusing +missing-output-file error. + +Sun 2nd Aug 2026 WZ [new directory] + +Added a formal implementation of the Wilf-Zeilberger algorithm for +hypergeometric summation, one which largely avoids akwardnesses over zero +denominators and special cases by an interpretion using real gamma function +limits. This was fully implemented back in 2014 and described in the paper: + + John Harrison + "Formal Proofs of Hypergeometric Sums" + Journal of Automated Reasoning 55 (2015) + https://www.cl.cam.ac.uk/~jrh13/papers/wz.html + +The setup has belatedly been made available having been cleaned up and +extended, mainly with a cleaner Maxima certificate-generation interface +and a few more examples, by Codex using gpt-5.6-sol (xhigh). Among the +automatic examples is the A recurrence that is proved more manually in +the recently added Examples/apery.ml proof. + +Sat 1st Aug 2026 Examples/apery.ml [new file] + +Added a proof of Apery's theorem, the irrationality of zeta(3). This +originates in 2014, when I was inspired by a presentation from Assia +Mahboubi of a proof project in Coq, which was eventually completed and +published as A. Mahboubi and T. Sibut-Pinote, "A Formal Proof of the +Irrationality of zeta(3)" (2021). At that time the A and B recurrences +had been proved in Coq following Bruno Salvy's computer algebra proof + + http://algo.inria.fr/libraries/autocomb/Apery2-html/apery.html + +but there was no machinery to provide the lcm(1..n) estimate needed +for the full result. I decided to derive them from the HOL Light proof +of the Prime Number Theorem (which is overkill). At that time I also +formalized almost all other parts of the Apery proof including the A +recurrence, but ground to a halt on the B recurrence which seemed to +require much more work. I eventually revived this in 2026 and had +Claude Opus 4.8 complete the B recurrence proof, following Salvy again. + +Fri 10th Jul 2026 nets.ml + +Made an optimization from June Lee to the discrimination nets in nets.ml, +using balanced trees to speed lookup. The original code is conceptually +ancient, little changed from Cambridge LCF days. + +Mon 15th Jun 2026 iterate.ml + +Added a simple but useful generalization of CARD_UNIONS whose proof is +no more difficult than that special cases, which is now derived from it. + + CARD_UNIONS_IMAGE = + |- !f s. FINITE s /\ (!t. t IN s ==> FINITE(f t)) /\ + (!t u. t IN s /\ u IN s /\ ~(t = u) ==> f t INTER f u = {}) + ==> CARD(UNIONS(IMAGE f s)) = nsum s (\i. CARD(f i)) + +Mon 8th Jun 2026 Library/ringtheory.ml, Library/rabin_test.ml, 100/transcendence.ml + +Extended the ring theory library with the Hilbert Basis Theorem for +polynomial and power series rings (the latter via Cohen's prime-ideal +criterion and Kaplansky's lemma), prime ideal correspondence under +localization, and the preservation by localization of the Noetherian, +Bezout, PID and von Neumann regular properties. Also added a ring +definition of multiplicative order ("ring_order") with many elementary +properties, and many other miscellaneous technical lemmas, as well as +streamlining rabin_test.ml. New definition: + + ring_order + +and new theorems: + + BEZOUT_RING + BEZOUT_RING_LOCALIZATION + COEFF_POWSER_SUM + FINITELY_GENERATED_IDEAL_LOCALIZATION + FINITELY_GENERATED_IDEAL_SUBSET + IDEAL_GENERATED_BY_HOMOMORPHIC_IMAGE + IDEAL_GENERATED_EXPLICIT + IDEAL_GENERATED_FINITARY + IDEAL_GENERATED_FINITARY_ALT + IDEAL_GENERATED_FINITE + IDEAL_GENERATED_FINITE_IMAGE + IDEAL_GENERATED_RING_LOCALIZATION + IDEAL_GENERATED_SCALE + IDEAL_GENERATED_SETADD_SUBSET + IDEAL_LOCALIZATION_CONTRACTION + KAPLANSKY_LEMMA + LOCALEQUIV_MUL_LCANCEL + LOCALEQUIV_MUL_RCANCEL + MAXIMAL_NONFG_IMP_PRIME_IDEAL + NOETHERIAN_LOCAL_RING_LOCALIZATION + NOETHERIAN_POLY_RING + NOETHERIAN_POLY_RING_1 + NOETHERIAN_POWSER_RING + NOETHERIAN_POWSER_RING_1 + NOETHERIAN_RING_EQ_FG_PRIME_IDEALS + NOETHERIAN_RING_LOCALIZATION + PID_RING_LOCALIZATION + POLY_ADD_RZERO + POLY_DEG_EQ_FROM_LE + POLY_DEG_LT_FROM_LE + POLY_DEG_MUL_VAR + POLY_DEG_MUL_VARPOW + POLY_DEG_VARPOW_MUL + POLY_DEG_VAR_MUL + POLY_MUL_VAR + POLY_RING_EPIMORPHISM_COEFF_0 + POLY_RING_HOMOMORPHISM_COEFF_0 + POLY_VAR_MUL + POWSER_EVALUATE_AT_0 + POWSER_EVAL_AT_0 + POWSER_EXTEND_AT_0 + POWSER_MUL_0 + POWSER_MUL_MONOMIAL_1 + POWSER_MUL_VAR + POWSER_RING_EPIMORPHISM_COEFF_0 + POWSER_RING_HOMOMORPHISM_COEFF_0 + POWSER_VARPOW_MUL_EQ_0 + POWSER_VAR_MUL + POWSER_VAR_MUL_EQ_0 + PRIME_IDEAL_LOCALIZATION + PRIME_IDEAL_LOCALIZATION_CONTRACTION + PRIME_IDEAL_LOCALIZATION_EXISTS + PRINCIPAL_IDEAL_LOCALIZATION + PROPER_IDEAL_LOCALIZATION + RING_EPIMORPHISM_POWSER_EVALUATE_AT_0 + RING_EPIMORPHISM_POWSER_EVAL_AT_0 + RING_GEOM_SERIES + RING_GEOM_SERIES_GEN + RING_HOMOMORPHISM_IN_CARRIER + RING_HOMOMORPHISM_POWSER_EVALUATE_AT_0 + RING_HOMOMORPHISM_POWSER_EVAL_AT_0 + RING_HOMOMORPHISM_POWSER_EXTEND_AT_0 + RING_IDEAL + RING_IDEAL_LOCALIZATION + RING_IDEAL_SCALE + RING_LOCALEQUIV_IN_LOCALIZED_IDEAL + RING_LOCALEQUIV_REFL + RING_LOCALEQUIV_SPLIT + RING_LOCALEQUIV_SPLIT_EXPLICIT + RING_LOCALIZATION_HOMOMORPHISM_UNIQUE + RING_LOCALIZATION_PRIME_IDEAL_CORRESPONDENCE + RING_LOCALIZATION_UNIQUE + RING_MUL_LCANCEL + RING_MUL_RCANCEL + RING_NEG_SUB + RING_ORDER_1 + RING_ORDER_EQ_0 + RING_ORDER_EQ_1 + RING_ORDER_MUL + RING_ORDER_MUL_DIVIDES + RING_ORDER_MUL_DIVIDES_GEN + RING_ORDER_MUL_DIVIDES_LCM + RING_ORDER_POW + RING_ORDER_POW_DIVIDES + RING_ORDER_POW_GEN + RING_ORDER_UNIQUE + RING_ORDER_UNIQUE_PRIME + RING_POW_COPRIME_EQ_1 + RING_POW_EQ_1 + RING_POW_GCD_EQ_1 + RING_POW_MOD_ORDER + RING_POW_MOD_ORDER_GEN + RING_POW_RING_ORDER + RING_PRODUCT_0 + RING_PRODUCT_CASES + RING_PRODUCT_NSUM + RING_SCALE_SETMUL + RING_SUM_DIFFS + RING_SUM_DIFFS_ALT + RING_UNIT_IDEMPOTENT_EQ_1 + VNREGULAR_RING_LOCALIZATION + +The following are incompatible changes to existing theorems: + + COEFF_POLY_SUM -> COEFF_POWSER_SUM + (COEFF_POLY_SUM is now re-used for the polynomial case) + + LOCALEQUIV_MUL_CANCEL -> LOCALEQUIV_MUL_RCANCEL + (now with a dual LOCALEQUIV_MUL_LCANCEL) + + POLY_DEG_EQ_COEFF_FROM_LE -> POLY_DEG_EQ_FROM_LE + (old name removed) + + POLY_EVALUATE_AT_0 (additional quantification) + +Sat 6th Jun 2026 Probability/* + +Substantially extended the probability theory library. The main themes +are: (1) reworking measurability of random variables around the new general +Borel sigma-algebra "borel_in" (Multivariate/metric.ml), in place of the +previous hand-rolled half-line level-set lemmas; (2) building out the +GENERAL conditional expectation "gen_cond_exp" into a usable calculus +(linearity, monotone and dominated convergence, "taking out what is known", +Cauchy-Schwarz, Jensen) and adding conditional variance; (3) adding the +law/distribution (pushforward) of a random variable and the joint +distribution function of a pair; (4) the Levy inversion theorem and +characteristic-function uniqueness; (5) a new file ergodic.ml with the +Birkhoff/maximal-ergodic material; and (6) a much fuller distributions.ml +with densities, CDFs and characteristic functions for the standard +distributions. As with everying in the Probability subdirectory, this +was entirely generated (statements and proofs) by Claude Code, a mix +of Opus 4.6 and 4.8. New definitions: + + cond_variance + distribution + ergodic + exponential_cdf + exponential_density + exponential_distributed + fejer_kernel_real + geometric_distributed + has_density + has_pmf + invariant_event + joint_distribution_fn + measure_preserving + normal_cdf + normal_density + normal_distributed + poisson_distributed + real_halflines + uniform_cdf + uniform_density + uniform_distributed + +and theorems: + + ABEL_SUMMATION_CONVERGENCE + ABS_CONT + ABS_LIM + ABS_MUL_GE_SPLIT + ABS_MUL_GE_SPLIT_BOUND + ABS_MUL_LT_SQRT + ADAPTIVE_SELECTOR_DEP + ARCHIMEDEAN_INV_BOUND + AS_IMP_IN_DIST + AS_IMP_IN_PROB + ATN_PI2_BOUND + AVG_GT_IMP_MAXSUM_POS + AVG_GT_IMP_SUM_POS + AVG_LT_IMP_SUM_POS + AVG_SHIFT_DIFF + BERNOULLI_CHAR_FN_IM + BERNOULLI_CHAR_FN_RE + BINOMIAL_CHAR_FN_IM + BINOMIAL_CHAR_FN_RE + BIRKHOFF_ERGODIC + BIRKHOFF_ERGODIC_BOUNDED + BIRKHOFF_ERGODIC_BOUNDED_L1 + BIRKHOFF_ERGODIC_L1 + BIRKHOFF_ERGODIC_THEOREM + BIRKHOFF_ERGODIC_THEOREM_BOUNDED + BIRKHOFF_LIMIT_INVARIANT + BIRKHOFF_OSCILLATION_CONTAINMENT + BOREL_IN_EUCLIDEANREAL_EQ_SIGMA_GENERATED + BOREL_IN_SIGMA_ALGEBRA + BOUNDED_LIMSUP_LIMINF_CONVERGE + CDF_MONO + CDF_RIGHT_CONTINUOUS + CHAR_FN_IM_BINOMIAL_RV + CHAR_FN_IM_CONTINUOUS + CHAR_FN_IM_EXPONENTIAL_DIST + CHAR_FN_IM_GEOMETRIC_DIST + CHAR_FN_IM_NORMAL_DIST + CHAR_FN_IM_POISSON_DIST + CHAR_FN_IM_UNIFORM_DIST + CHAR_FN_RE_BINOMIAL_RV + CHAR_FN_RE_CONTINUOUS + CHAR_FN_RE_EXPONENTIAL_DIST + CHAR_FN_RE_GEOMETRIC_DIST + CHAR_FN_RE_NORMAL_DIST + CHAR_FN_RE_POISSON_DIST + CHAR_FN_RE_UNIFORM_DIST + CHAR_FN_UNIQUENESS + COND_EXP_INDICATOR_BOUNDED_AE + COND_EXP_L2_CONTRACTION + COND_EXP_TAKE_OUT + CONTINUOUS_COMPOSE_SEQ + CONTINUOUS_MAP_EUCLIDEANREAL + CONVERGES_AS_FROM_RATE + CONVERGES_IN_PROB_ABS + CONVERGES_IN_PROB_ADD + CONVERGES_IN_PROB_AE_SUBSEQUENCE + CONVERGES_IN_PROB_BOUNDED_MUL + CONVERGES_IN_PROB_CMUL + CONVERGES_IN_PROB_CONST + CONVERGES_IN_PROB_CONTINUOUS_COMPOSE + CONVERGES_IN_PROB_DIFF_ZERO + CONVERGES_IN_PROB_MAX + CONVERGES_IN_PROB_MIN + CONVERGES_IN_PROB_MUL + CONVERGES_IN_PROB_NEG + CONVERGES_IN_PROB_NULL_ADD + CONVERGES_IN_PROB_NULL_MUL + CONVERGES_IN_PROB_SUB + CONVERGES_IN_PROB_SUBSEQUENCE + CONVERGES_IN_PROB_SUBSEQUENCE_PRINCIPLE + CONVERGES_IN_PROB_UNIQUE + CONVEX_AFFINE_MINORANT_SUP + CONVEX_CONT_AT + COS_DIFF_HAS_REAL_INTEGRAL_HALFLINE + COS_DIFF_HAS_REAL_INTEGRAL_HALFLINE_FULL + COS_DIFF_HAS_REAL_INTEGRAL_HALFLINE_GEN + COS_HAS_REAL_INTEGRAL + DECOMPOSITION_UNBOUNDED_IFF + DECR_INTEGRAL_TENDS_0 + DECR_INTEGRAL_TENDS_0_AE + DIRICHLET_INTEGRAL + DIRICHLET_INTEGRAL_SCALED + DIRICHLET_INTEGRAL_SCALED_NEG + DIRICHLET_TAIL_BOUND + DISCRIMINANT_NONNEG + DISTRIBUTION_CDF + DISTRIBUTION_COUNTABLY_ADDITIVE + DISTRIBUTION_EMPTY + DISTRIBUTION_FN_CONTINUOUS_PROB_ZERO + DISTRIBUTION_IN_EVENTS + DISTRIBUTION_LE_1 + DISTRIBUTION_MONO + DISTRIBUTION_POS + DISTRIBUTION_UNIV + DYADIC_APPROX_BOUND + DYADIC_BOUND + DYADIC_CONV + DYADIC_LEVEL + DYADIC_MEASURABLE + DYADIC_SIMPLE + ERGODIC_AVG_BOUNDED + ERGODIC_AVG_DIFF_BOUND + ERGODIC_AVG_EXPECTATION + ERGODIC_AVG_INTEGRABLE + ERGODIC_AVG_INTEGRABLE_POW2 + ERGODIC_AVG_VARIANCE_BOUND + ERGODIC_LIMINF_NULL + ERGODIC_LIMINF_SHIFT + ERGODIC_LIMSUP_NULL + ERGODIC_LIMSUP_SHIFT + ERGODIC_MAXSUM_GE_SUM + ERGODIC_MAXSUM_INTEGRABLE + ERGODIC_MAXSUM_KEY_INEQ + ERGODIC_MAXSUM_MONO + ERGODIC_MAXSUM_POS + ERGODIC_MAXSUM_POS_EVENT + ERGODIC_MAXSUM_RV + ERGODIC_OSCILLATION_INVARIANT + ERGODIC_OSCILLATION_MEASURABLE + ERGODIC_OSCILLATION_NULL + ERGODIC_SUM_EXPECTATION + ERGODIC_SUM_INTEGRABLE + ERGODIC_SUM_SHIFT + ERGODIC_TRUNCATION_ABS_BOUND + ERGODIC_TRUNCATION_INTEGRABLE + ERGODIC_TRUNCATION_L1 + ERGODIC_TRUNCATION_POINTWISE + ERROR_INTEGRAL_BOUND + EXPECTATION_ABS_FROM_SQUARE + EXPECTATION_AE_ZERO + EXPECTATION_COMP_PRESERVED + EXPECTATION_EQ_TAIL_SUM + EXPECTATION_EXPONENTIAL_DIST + EXPECTATION_GEOMETRIC_DIST + EXPECTATION_ITER_COMP_PRESERVED + EXPECTATION_MONO_AE + EXPECTATION_MUL_INDICATOR_CONULL + EXPECTATION_NONNEG_ZERO_AE_ZERO + EXPECTATION_NORMAL_DIST + EXPECTATION_POISSON_DIST + EXPECTATION_SQ_ORTHOGONAL + EXPECTATION_UNIFORM_DIST + EXPECTATION_ZERO_AE_BOUNDED_MEASURABLE + EXPECTATION_ZERO_BOUNDED_MEASURABLE + EXPECTATION_ZERO_HALVING + EXPONENTIAL_CDF_LE_1 + EXPONENTIAL_CDF_NONNEG + EXPONENTIAL_CDF_ZERO + EXPONENTIAL_CHAR_FN_IM + EXPONENTIAL_CHAR_FN_RE + EXPONENTIAL_DENSITY_INTEGRABLE_NONNEG + EXPONENTIAL_DENSITY_INTEGRAL + EXPONENTIAL_DENSITY_NONNEG + EXPONENTIAL_DENSITY_POS + EXPONENTIAL_DENSITY_ZERO + EXPONENTIAL_HAS_REAL_DERIVATIVE + EXPONENTIAL_HAS_REAL_DERIVATIVE_WITHIN + EXPONENTIAL_INTEGRABLE_INTERVAL + EXPONENTIAL_INTEGRAL_INTERVAL + EXPONENTIAL_INTEGRAL_SEQ_TENDS_1 + EXPONENTIAL_LIMIT_POSINFINITY + EXPONENTIAL_LINEAR_DECAY_SEQ + EXPONENTIAL_MEAN + EXPONENTIAL_MEAN_ANTIDERIV + EXPONENTIAL_MEAN_INTEGRAL + EXPONENTIAL_MEAN_INTEGRAL_INTERVAL + EXPONENTIAL_MEAN_SEQ_TENDS + EXPONENTIAL_MEMORYLESS + EXPONENTIAL_PRODUCT_DECAY_SEQ + EXPONENTIAL_QUADRATIC_DECAY_SEQ + EXPONENTIAL_REAL_CONTINUOUS + EXPONENTIAL_SECOND_MOMENT + EXPONENTIAL_SECOND_MOMENT_ANTIDERIV + EXPONENTIAL_SECOND_MOMENT_INTEGRAL + EXPONENTIAL_SECOND_MOMENT_INTEGRAL_INTERVAL + EXPONENTIAL_SECOND_MOMENT_SEQ_TENDS + EXPONENTIAL_VARIANCE_INTEGRAL + EXP_AFFINE_DECOMP + EXP_COS_ANTIDERIV + EXP_COS_INTEGRAL_INTERVAL + EXP_DECAY_INTEGRAL + EXP_INTEGRAL_REP + EXP_SIMPLE_MUL_DECOMP + EXP_SIN_ANTIDERIV + EXP_SIN_INTEGRAL_INTERVAL + FEJER_KERNEL_REAL_COSINE + FEJER_KERNEL_REAL_EQ_SINC_SQUARED + FEJER_KERNEL_REAL_INTEGRAL + FEJER_KERNEL_REAL_POS + FEJER_KERNEL_REAL_TAIL_BOUND + GAUSSIAN_FT_HALFLINE + GEN_COND_EXP_ABS_BOUND + GEN_COND_EXP_AFFINE + GEN_COND_EXP_CAUCHY_SCHWARZ + GEN_COND_EXP_DCT + GEN_COND_EXP_DECR_TENDS_0 + GEN_COND_EXP_JENSEN + GEN_COND_EXP_JENSEN_EXP + GEN_COND_EXP_L2_CONTRACTION + GEN_COND_EXP_LINEAR3 + GEN_COND_EXP_MCT + GEN_COND_EXP_SEQ_MONO_AE + GEN_COND_EXP_SUB + GEN_COND_EXP_TAKE_OUT_AFFINE + GEN_COND_EXP_TAKE_OUT_BOUNDED + GEN_COND_EXP_TAKE_OUT_INDICATOR + GEN_COND_EXP_TAKE_OUT_SIMPLE + GEN_COND_EXP_TRIANGLE + GEOMETRIC_CHAR_FN_IM + GEOMETRIC_CHAR_FN_RE + HALFLINES_SUBSET_UNIV + HAS_DENSITY_INTEGRABLE + HAS_DENSITY_INTEGRAL_ONE + HAS_DENSITY_INTERVAL_PROB + HAS_DENSITY_NONNEG + HAS_DENSITY_RV + HAS_PMF_NONNEG + HAS_PMF_PROB + HAS_PMF_RV + HAS_PMF_SUMS_ONE + HAS_REAL_INTEGRAL_AFFINITY_UNIV + IDENTITY_HAS_REAL_INTEGRAL + IID_SLLN_L1_VIA_BIRKHOFF + IID_SLLN_VIA_BIRKHOFF + INDEP_RV_JOINT_DISTRIBUTION + INDICATOR_SUM_BOUNDED + INDICATOR_SUM_COMPENSATOR_IDENTITY + INDICATOR_SUM_COND_EXP_STEP + INDICATOR_SUM_SUBMARTINGALE + INF_PERTURB_BOUND + INF_SUBSET_LE + INNER_INTEGRAL_T + INNER_INTEGRAL_U + INTEGRABLE_ABS_INDICATOR + INTEGRABLE_AFFINE_IND_MUL + INTEGRABLE_BOUNDED_POW2 + INTEGRABLE_COMP_MP + INTEGRABLE_MUL_BOUNDED + INTEGRABLE_PRODUCT_INDICATOR + INTEGRABLE_TRUNCATION + INTEGRAL_EXPECTATION_EXCHANGE + INTEGRAL_GAP_TENDS_0 + INTEGRAL_INV_ONE_PLUS_SQ + INTEGRAL_SPLIT_NUMSEG + INVARIANT_EVENTS_SUB_SIGMA_ALGEBRA + INVERSION_FUBINI + INVERSION_KERNEL_BOUNDED + INVERSION_KERNEL_BOUNDED_NZ + INVERSION_KERNEL_CONVERGES_AT_A + INVERSION_KERNEL_CONVERGES_AT_B + INVERSION_KERNEL_CONVERGES_INSIDE + INVERSION_KERNEL_CONVERGES_OUTSIDE + INVERSION_KERNEL_RV + INVERSION_KERNEL_UNIFORM_BOUND + INVERSION_SINC_EVEN + INVERSION_TRIG_IDENTITY + IN_SIGMA_GENERATED_GEN + ITER_1 + ITER_ADD + ITER_IN_INVARIANT + JOINT_DISTRIBUTION_LE_MARGINAL_X + JOINT_DISTRIBUTION_SYM + JOINT_RECTANGLE_IN_EVENTS + KOLMOGOROV_SLLN' + KRONECKER_RESCALED + L2_IMP_IN_DIST + LAPLACE_SIN + LAW_OF_TOTAL_VARIANCE + LEVY_CONDITIONAL_BOREL_CANTELLI + LEVY_INVERSION + LHS_INTEGRABLE + LIFT_INTEGRAL_BRIDGE + LIMSUP_EVENTS_IFF_SUM_UNBOUNDED + LOTUS_BOUNDED_CONTINUOUS + LOTUS_CONTINUOUS + LOTUS_COS + LOTUS_NONNEG_CONTINUOUS + LOTUS_PMF_COS + LOTUS_PMF_INTEGRABLE + LOTUS_PMF_SIN + LOTUS_SIN + MARTINGALE_DIFF_ORTHOGONAL + MAXIMAL_ERGODIC_INFINITE + MAXIMAL_ERGODIC_LEMMA + MEAN_ERGODIC_BOUNDED + MEAN_ERGODIC_THEOREM + MEASURABLE_WRT_INDICATOR + MEASURABLE_WRT_INV_GE_ONE + MEASURABLE_WRT_MAX_CONST + MEASURABLE_WRT_MIN_CONST + MEASURABLE_WRT_MUL + MEASURABLE_WRT_MUL_INDICATOR + MEASURABLE_WRT_POW2 + MEASURABLE_WRT_REALLIM + MEASURABLE_WRT_SUM + MEASURE_AGREE_LAMBDA_SYSTEM + MEASURE_PRESERVING_CARRIER + MEASURE_PRESERVING_EVENTS + MEASURE_PRESERVING_ITER + MEASURE_PRESERVING_PROB + MEASURE_UNIQUE_ON_PI_SYSTEM + MEL_INVARIANT_SET + MWRT_AFFINE + NN_EXPECTATION_COMP_PRESERVED + NN_EXPECTATION_COMP_PRESERVED_BOUNDED + NORMAL_CDF_BOUNDS + NORMAL_CDF_COMPLEMENT + NORMAL_CDF_CONTINUOUS + NORMAL_CDF_LIMIT_NEG + NORMAL_CDF_LIMIT_POS + NORMAL_CDF_MEAN + NORMAL_CDF_MONO + NORMAL_CDF_STANDARD + NORMAL_CHAR_FN_IM + NORMAL_CHAR_FN_RE + NORMAL_DENSITY_INTEGRABLE + NORMAL_DENSITY_INTEGRAL + NORMAL_DENSITY_NONNEG + NORMAL_DENSITY_POS + NORMAL_DENSITY_STANDARD + NORMAL_DENSITY_STANDARDIZE + NORMAL_DENSITY_SYM + NORMAL_MEAN + NORMAL_MEAN_HELPER + NORMAL_MEAN_INTEGRAL + NORMAL_SHIFTED_COS_INTEGRAL + NORMAL_SHIFTED_SIN_INTEGRAL + NORMAL_VARIANCE + NORMAL_VARIANCE_INTEGRAL + NOT_CONVERGENT_OSCILLATION + OFF_LIMSUP_CONVERGES + ONE_MINUS_COS_HAS_REAL_INTEGRAL_HALFLINE + ONE_MINUS_COS_HAS_REAL_INTEGRAL_UNIV + ONE_MINUS_COS_SCALED_HAS_REAL_INTEGRAL_HALFLINE + POISSON_CHAR_FN_IM + POISSON_CHAR_FN_RE + POISSON_MEAN_SERIES + POISSON_PMF_RECURSION + POISSON_SECOND_FACTORIAL_MOMENT + POISSON_SECOND_MOMENT + POISSON_VARIANCE_SERIES + POW2_SHRINK_ZERO + PROB_ABS_GE_TENDS_TO_ZERO + PROB_STRICT_INEQ_LIMIT + RADON_NIKODYM_UNIQUE + RANDOM_VARIABLE_BOREL_MEASURABLE_COMPOSE + RANDOM_VARIABLE_COMP_MP + RANDOM_VARIABLE_CONTINUOUS_MAP_COMPOSE + RANDOM_VARIABLE_DIV_POS + RANDOM_VARIABLE_GT_SUFFICIENT + RANDOM_VARIABLE_ITER_COMP_MP + RANDOM_VARIABLE_LIMIT + RANDOM_VARIABLE_PREIMAGE_BOREL_IN + RANDOM_VARIABLE_REAL_LIMSUP_DOMINATED + RANDOM_VARIABLE_SUP_SEQ_FN + RANDOM_VARIABLE_TRUNCATION + RATIONAL_DISCRIMINANT + RATIONAL_DISCRIMINANT_DENSITY + REALLIM_AT_POSINFINITY_FROM_SUBSEQUENCES + REALLIM_AT_POSINFINITY_IMP_SEQUENTIALLY + REAL_ABS_DIV_LE + REAL_CONTINUOUS_ATREAL_SEQUENTIALLY + REAL_CONVEX_SUPPORTING_LINE + REAL_DIV_ABS_LE_1 + REAL_EQ_EPSILON + REAL_EQ_FROM_APPROX + REAL_EXP_QUADRATIC_BOUND + REAL_HALFLINE_LE_IN_SIGMA + REAL_HALFLINE_LT_IN_SIGMA + REAL_INTEGRAL_EVEN_SYMMETRIC + REAL_INTERVAL_IN_SIGMA + REAL_LE_EPSILON + REAL_LIMINF_LE_LIMSUP_ABS + REAL_LIMINF_LE_PERTURB + REAL_LIMINF_LT_EXISTS_BOUNDED + REAL_LIMINF_PERTURB_NULL + REAL_LIMSUP_GT_EXISTS_BOUNDED + REAL_LIMSUP_LE_PERTURB + REAL_LIMSUP_LE_SUP' + REAL_LIMSUP_NEG + REAL_LIMSUP_PERTURB_NULL + REAL_OPEN_COUNTABLE_UNION_REAL_INTERVAL + REAL_OPEN_IN_SIGMA + RESCALED_INDICATOR_CONVERGENCE + RESCALED_INDICATOR_CONVERGENCE_MAX + RESCALED_MAX_L2_BOUNDED + RESCALED_MAX_MARTINGALE + RESCALED_TRUNCATED_L2 + REVERSE_FATOU_DOMINATED + RHS_INTEGRABLE + RIEMANN_SUM_CONVERGES + RIGHT_CONTINUOUS_MONOTONE_AGREE + RV_LEVEL_SET_EVENT + RV_LIMIT_GT_EQ + RV_PREIMAGE_GE + RV_PREIMAGE_GT + RV_PREIMAGE_LE + RV_PREIMAGE_LT + RV_PREIMAGE_LT_EQ_UNIONS + RV_PREIMAGE_REAL_INTERVAL + RV_PREIMAGE_REAL_OPEN + RV_STRICT_INEQ_EVENT + SHIFTED_FILTRATION + SIGMA_ALGEBRA_INTERS_COUNTABLE + SIGMA_ALGEBRA_SIGMA_GENERATED_HALFLINES + SIGMA_ALGEBRA_SYM_DIFF + SIMPLE_CHAR_FN_IM_CONTINUOUS + SIMPLE_CHAR_FN_RE_CONTINUOUS + SIMPLE_EXPECTATION_COMP_PRESERVED + SIMPLE_EXPECTATION_TRAPEZOIDAL_FOURIER + SIMPLE_RV_COMP_MP + SIMPLE_RV_SUM_INDICATOR + SIN2X_INV_X_SUBSTITUTION + SINC_DECOMPOSITION + SINC_EXP_DECAY_BOUND + SINC_EXP_DECAY_INTEGRABLE + SINC_EXP_EQ + SINC_INTEGRAL_BOUND + SINC_INTEGRAL_BOUND_ALL + SINC_INTEGRAL_IDENTITY + SINC_INTEGRAL_SPLIT + SINC_INTEGRAL_UNIFORM_BOUND + SINC_INV_INTEGRABLE + SINC_LE_ONE + SINC_MUL_INTEGRABLE + SINC_SCALED_DIFF_INTEGRABLE + SINC_SCALED_INTEGRABLE + SINC_SCALED_INTEGRABLE_NZ + SINC_SCALED_NEG_INTEGRABLE + SINC_SQUARED_CONTINUOUS + SINC_SQUARED_HAS_REAL_INTEGRAL_HALFLINE + SINC_SQUARED_HAS_REAL_INTEGRAL_UNIV + SINC_SQUARED_IDENTITY + SINC_SQUARED_INTEGRABLE + SINC_SQUARED_INTEGRAL + SINC_SQUARED_INTEGRAL_BOUND + SINC_SQUARED_LE_ONE + SIN_EXP_2D_CONTINUOUS + SIN_EXP_FUBINI + SIN_HAS_REAL_INTEGRAL + SIN_SQUARED_IBP + SIN_SQUARED_INV_LE + SIN_TAYLOR2_BOUND + SMOOTHING_INTEGRAND_INTEGRABLE + SMOOTHING_INTEGRAND_MEASURABLE + SQUARE_HAS_REAL_INTEGRAL + SQ_SUM_BOUND + STD_NORMAL_CDF_COMPLEMENT + STD_NORMAL_CDF_LIMIT_NEG + STD_NORMAL_CDF_LIMIT_POS + STD_NORMAL_CDF_SEQ_TENDS_1 + STD_NORMAL_CDF_ZERO + STD_NORMAL_INTEGRAL_INTERVAL_TENDS_1 + SUMMATION_BY_PARTS + SUM_INDICATOR_EQ_NAT + SUM_SQUARE_CAUCHY_SCHWARZ + SUM_TRIG_FACTOR + SUPPORTING_SLOPE + SUP_PERTURB_BOUND + SUP_SEQ_VIA_INF + SUP_SUBSET_GE + SUP_TAIL_TENDS_0 + TAIL_SUM_EQ_NN_EXPECTATION + TELESCOPING_STEP + TELESCOPING_SUM_BOUND + TELESCOPING_SUM_BOUND_SIMPLE + TELESCOPING_VARIANCE_BOUND + TELESCOPING_VARIANCE_BOUND_SIMPLE + THREE_SLOPES + TO_POINTWISE + TRAPEZOIDAL_ALG_IDENTITY + TRAPEZOIDAL_FOURIER_IDENTITY + TRIG_COS_DIFF_EXPAND + TRUNCATED_DIFF_EXPECTATION_ZERO + TRUNCATED_DIFF_SQ_BOUND + TRUNCATION_ABS_DIFF + TRUNCATION_L2_CONVERGENCE + TRUNCATION_PRESERVES_LIMIT + T_COS_HAS_REAL_INTEGRAL + UI_MARTINGALE_CLOSURE + UI_POINTWISE_L1_AE + UNIFORM_CDF_BOUNDS + UNIFORM_CDF_LEFT + UNIFORM_CDF_MONO + UNIFORM_CDF_RIGHT + UNIFORM_CHAR_FN_IM + UNIFORM_CHAR_FN_RE + UNIFORM_DENSITY_INTEGRABLE + UNIFORM_DENSITY_INTEGRAL + UNIFORM_DENSITY_NONNEG + UNIFORM_DENSITY_POS + UNIFORM_DENSITY_VALUE + UNIFORM_DENSITY_ZERO + UNIFORM_MEAN + UNIFORM_MEAN_INTEGRAL + UNIFORM_SECOND_MOMENT + UNIFORM_SECOND_MOMENT_INTEGRAL + UNIFORM_VARIANCE_INTEGRAL + UNIONS_SIGMA_GENERATED_HALFLINES + VARIANCE_EXPONENTIAL_DIST + VARIANCE_GEOMETRIC_DIST + VARIANCE_NORMAL_DIST + VARIANCE_POISSON_DIST + VARIANCE_UNIFORM_DIST + WIENER_MAXIMAL_INEQUALITY + X2_CONVEX + +One existing theorem name THREE_SERIES_CONDITION1 now resolves to a +strictly more general statement, by de-duplication. Eight theorems +present previously are removed. Four are the bespoke half-line +measurability lemmas, now subsumed by the single Borel-preimage +characterization RANDOM_VARIABLE_PREIMAGE_BOREL_IN + + RANDOM_VARIABLE_GE + RANDOM_VARIABLE_GT + RANDOM_VARIABLE_STRICT_LT + RANDOM_VARIABLE_OPEN_HALFLINE + +(The specific direction still needed in one place is retained/restated as +RANDOM_VARIABLE_GT_SUFFICIENT.) The other four were ad-hoc analytic +utilities, now removed as redundant with library facts or with local +replacements: + + COS_TAYLOR_CONVERGES + SIN_TAYLOR_CONVERGES + POW_2_LE_SQRT + REAL_CONTINUOUS_OPEN_PREIMAGE_UNIV + +Numerous existing proofs were also streamlined to go through +RANDOM_VARIABLE_PREIMAGE_BOREL_IN and the general Borel machinery rather +than re-deriving measurability of level sets by hand, but those leave the +theorem statements untouched. + +Fri 5th Jun 2026 Multivariate/metric.ml, Multivariate/topology.ml + +Added a general "Borel sets of a topological space" theory, +complementing the existing Euclidean-specific "borel" (on real^N) +already in topology.ml. In metric.ml, defined "borel_in top" +inductively as the smallest family of subsets of the topspace +containing the open sets and closed under countable union and under +complement (relative to the topspace). Developed the basic +sigma-algebra calculus and its behaviour under subtopologies, +continuous maps and homeomorphisms: + + borel_in_RULES + borel_in_INDUCT + borel_in_CASES + OPEN_IMP_BOREL_IN + BOREL_IN_COMPLEMENT + BOREL_IN_COMPLEMENT_EQ + BOREL_IN_UNIONS + BOREL_IN_SUBSET_TOPSPACE + BOREL_IN_TOPSPACE + BOREL_IN_EMPTY + BOREL_IN_INTERS + BOREL_IN_UNION + BOREL_IN_INTER + BOREL_IN_DIFF + CLOSED_IMP_BOREL_IN + FSIGMA_IMP_BOREL_IN + GDELTA_IMP_BOREL_IN + OPEN_IN_SUBTOPOLOGY_BOREL_IN + CLOSED_IN_SUBTOPOLOGY_BOREL_IN + BOREL_IN_SUBTOPOLOGY + BOREL_FROM_SUBTOPOLOGY + BOREL_IN_INTER_SUBTOPOLOGY + BOREL_IN_SUBTOPOLOGY_EQ + BOREL_IN_CONTINUOUS_MAP_PREIMAGE + BOREL_IN_HOMEOMORPHIC_MAP_IMAGE + BOREL_IN_HOMEOMORPHIC_MAPS_IMAGE_EQ + BOREL_IN_HOMEOMORPHIC_MAP_IMAGE_EQ + +Also in metric.ml, defined "borel_measurable_map (top1,top2) f" +as a function mapping top1 into top2 where the preimage of every +"borel_in top2" set is "borel_in top1", with the expected closure +properties, the most non-trivial being closure under pointwise +sequential limits, assuming a metrizable codomain: + + borel_measurable_map + BOREL_MEASURABLE_MAP_OPEN_IN + BOREL_MEASURABLE_MAP_CLOSED_IN + BOREL_MEASURABLE_MAP_IMAGE_SUBSET_TOPSPACE + CONTINUOUS_IMP_BOREL_MEASURABLE_MAP + BOREL_MEASURABLE_MAP_ID + BOREL_MEASURABLE_MAP_CONST + BOREL_MEASURABLE_MAP_EQ + BOREL_MEASURABLE_MAP_COMPOSE + BOREL_MEASURABLE_MAP_FROM_SUBTOPOLOGY + BOREL_MEASURABLE_MAP_INTO_SUBTOPOLOGY + BOREL_MEASURABLE_MAP_LIMIT + +In topology.ml, connected the general notions back to the existing +Euclidean ones. BOREL_IN_EUCLIDEAN shows "borel_in euclidean = borel", +so all the existing real^N results about "borel" transfer to the +general theory as the Euclidean instance, and vice versa. The +identification for the measurable maps is a little more delicate than +for the sets, because the existing Euclidean Borel-measurability +predicate "f borel_measurable_on s" (topology.ml) is defined quite +differently, as a Baire function, i.e. inductively as the closure of +the continuous functions under pointwise sequential limits. These are +proved equivalent but only under the assumption that the domain is a +Borel set, including the special case of the whole of real^N. + + BOREL_IN_EUCLIDEAN + BOREL_MEASURABLE_MAP_EUCLIDEAN + BOREL_MEASURABLE_MAP_EUCLIDEAN_SUBTOPOLOGY + +Wed 3rd Jun 2026 pa_j/chooser.sh + +Added an update from Matthias Kannwischer to accept camlp5 8.05 +with OCaml 5.4 - the actual pa_j_5.4_8.04.00.ml still works so it +only needs to improve the selector. + +Mon 1st Jun 2026 printer.ml, UnitTests/printer_tests.ml + +Made a fix authored by Balaji Rao and June Lee to the printing of +names with their type annotations under print_types_of_subterms := 2 +(or := 1 with invented type variables). This now inserts an extra +space where needed for symbolic identifers, which otherwise might +generate text that does not correctly parse back owing to lexical +conventions, absorbing the colon into the name. For example `&3:int` +now prints with a space between "&" and its type. + +Mon 18th May 2026 mcp/make_checkpoint.py + +Tweaked this script to detect failures when building the checkpoint, which can +easily happen if checkpointing material under development. It also now rejects +expressions containing ';;' immediately. + +Mon 18th May 2026 printer.ml + +Adopted a refactoring from June Lee of the printer, decomposing pp_print_term's +special-form chain into separate functions. This also adds unit tests for the +printer, now placed in a special UnitTests subdirectory. + +Sun 17th May 2026 Probability/clt.ml + +Replaced List.filteri (OCaml >= 4.14) with subtract/el for compatibility with +older OCamls. + +Sat 16th May 2026 Library/grouptheory.ml, Library/symmetric_group.ml, + +Added the theorems ABELIAN_QUOTIENT_GROUP_DIV and +SOLVABLE_GROUP_MONOMORPHIC_PREIMAGE, as well as slightly incompatibly +tweaking the statement of ABELIAN_QUOTIENT_COMMUTATOR to make its +quantifier structure more harmonious with the library. + +Fri 15th May 2026 Library/ringtheory.ml, Library/fieldtheory.ml, 100/transcendence.ml, + +Extended the ring theory library with material on squarefree elements, +monic and reciprocal polynomials, formal (univariate) polynomial +derivatives plus actual division and remainder functions for polynomials. +Much of this material was adopted from the existing formalization in +100/transcendence.ml into the main libraries, though with some notable +differences as described below (in particular ring_squarefree). New +definitions: + + monic + poly_deriv + poly_div + poly_recip + poly_rem + ring_squarefree + +New theorems in Library/ringtheory.ml: + + COEFF_0 + COEFF_0_POLY_RECIP_EQ_0 + COEFF_ABOVE_DEG + COEFF_COMPOSE + COEFF_POLY_DERIV + COEFF_POLY_LMUL + COEFF_POLY_MUL_ALT + COEFF_POLY_MUL_VAR + COEFF_POLY_MUL_VARPOW + COEFF_POLY_RECIP + COEFF_POLY_RMUL + COEFF_POLY_VAR + COEFF_POLY_VARPOW + COEFF_POLY_VARPOW_MUL + COEFF_POLY_VAR_MUL + FIELD_MONIC_ASSOCIATE + FIELD_MONIC_IRREDUCIBLE_ASSOCIATE + FUN_ONE_EQ_ONE + FUN_ONE_NUM_EQ + INTEGER_RING_POW + INTEGRAL_DOMAIN_PRIME_PRODUCT_DIVIDES + INTEGRAL_DOMAIN_PRIMES_COPRIME_OR_ASSOCIATES + INTEGRAL_DOMAIN_PRIMES_DIVIDES_EQ_ASSOCIATES + IRREDUCIBLE_IMP_POLY_DEG_NZ + ISOMORPHIC_RING_EQ + MONIC_ASSOCIATES_EQ + MONIC_CMUL + MONIC_DEG_0 + MONIC_IMP_NONZERO + MONIC_IN_TRIVIAL_RING + MONIC_POLY_0 + MONIC_POLY_1 + MONIC_POLY_CONST + MONIC_POLY_MUL + MONIC_POLY_POW + MONIC_POLY_PRODUCT + MONIC_POLY_VAR + MONIC_SUBRING_GENERATED + MONOMIAL_DIVISORS_1 + MONOMIAL_MUL_EQ_VAR + MONOMIAL_UNIV_1 + MONOMIAL_VAR_DIVIDES_MUL + POLY_CONST_DIVIDES_CONST + POLY_CONST_EQ_0 + POLY_CONST_EQ_1 + POLY_CONST_OF_NUM + POLY_DEG_CMUL + POLY_DEG_DERIV + POLY_DEG_DERIV_LE + POLY_DEG_DIVIDES_LE + POLY_DEG_DIVIDES_LE_MONIC + POLY_DEG_DIVIDES_LE_UNIVARIATE + POLY_DEG_EQ_COEFF_EQ + POLY_DEG_GE_COEFF + POLY_DEG_GE_COEFF_EQ + POLY_DEG_LE_COEFF_EQ + POLY_DEG_MUL_MONIC + POLY_DEG_MUL_UNIVARIATE + POLY_DEG_RECIP + POLY_DEG_RECIP_LE + POLY_DEG_REM + POLY_DEG_REM_ALT + POLY_DERIV_0 + POLY_DERIV_1 + POLY_DERIV_ADD + POLY_DERIV_CMUL + POLY_DERIV_CONST + POLY_DERIV_HOMOMORPHIC_IMAGE + POLY_DERIV_IN_CARRIER + POLY_DERIV_MUL + POLY_DERIV_NEG + POLY_DERIV_NONZERO_CHAR0 + POLY_DERIV_POW + POLY_DERIV_PRODUCT + POLY_DERIV_SUB + POLY_DERIV_SUBRING_GENERATED + POLY_DERIV_SUM + POLY_DERIV_VAR + POLY_DERIV_VAR_POW + POLY_DIV + POLY_DIV_REM + POLY_DIV_REM_SIMP + POLY_DIVIDES_RECIP + POLY_DIVIDES_RECIP_EQ + POLY_DIVIDES_RECIP_GALOIS + POLY_DIVIDES_RECIP_RECIP + POLY_DIVIDES_REM + POLY_EVALUATE_RING_SUM + POLY_EVAL_RECIP + POLY_EVAL_RING_SUM + POLY_EXTEND_RING_SUM + POLY_IN_POWSER_RING + POLY_IRREDUCIBLE_IMP_SEPARABLE + POLY_MUL_LEADING_COEFF + POLY_MUL_RID + POLY_NONCONSTANT_IRREDUCIBLE_IMP_SEPARABLE + POLY_RECIP_0 + POLY_RECIP_1 + POLY_RECIP_CONST + POLY_RECIP_EQ_0 + POLY_RECIP_IN_CARRIER + POLY_RECIP_MUL + POLY_RECIP_MUL_GEN + POLY_RECIP_NEG + POLY_RECIP_RECIP + POLY_RECIP_RECIP_EQ + POLY_REM + POLY_REM_UNIQUE + POLY_ROOT_COUNT_IMP_SQUAREFREE + POLY_SEPARABLE_EQ_SQUAREFREE + POLY_SEPARABLE_IMP_SQUAREFREE + POLY_SQUARE_DIVIDES_DERIV + POLY_SQUARE_DIVIDES_DERIV_EQ + POLY_SQUAREFREE_IMP_SEPARABLE + POLY_VARPOW_RECIP_RECIP + POWSER_CLAUSES + POWSER_DERIV_IN_CARRIER + REPEATED_ROOT_POLY_DERIV_ZERO + RING_AUTOMORPHISM_I + RING_AUTOMORPHISM_ID + RING_COPRIME_DISTINCT_MONIC_IRREDUCIBLES + RING_COPRIME_DIVISORS + RING_COPRIME_HOMOMORPHIC_IMAGE + RING_COPRIME_LPOW + RING_COPRIME_PRODUCT + RING_COPRIME_PRODUCT_DIVIDES + RING_COPRIME_PRODUCT_DIVIDES_ALT + RING_COPRIME_PRODUCT_EQ + RING_COPRIME_RPOW + RING_COPRIME_UNIT + RING_DIVIDES_ALT + RING_DIVIDES_MUL_EQ + RING_DIVIDES_PRODUCTS + RING_IRREDUCIBLE_IMP_NONTRIVIAL_RING + RING_IRREDUCIBLE_IMP_SQUAREFREE + RING_IRREDUCIBLE_NEG + RING_IRREDUCIBLE_POLY_CONST + RING_IRREDUCIBLE_POLY_RECIP + RING_IRREDUCIBLE_POLY_RECIP_EQ + RING_IRREDUCIBLE_POLY_VAR + RING_IRREDUCIBLES_COPRIME_OR_ASSOCIATES + RING_OF_NUM_POLY_RING + RING_OF_NUM_POWSER_RING + RING_POLYNOMIAL_DIV + RING_POLYNOMIAL_POLY_DERIV + RING_POLYNOMIAL_POWERSERIES_COEFF + RING_POLYNOMIAL_RECIP + RING_POLYNOMIAL_REM + RING_POWERSERIES_POLY_DERIV + RING_POWERSERIES_RECIP + RING_PRIME_DIVIDES_POW + RING_PRIME_IMP_NONTRIVIAL_RING + RING_PRIME_IMP_SQUAREFREE + RING_PRIME_MUL_DIVIDES + RING_PRIME_MUL_DIVIDES_EQ + RING_PRIME_NEG + RING_PRIME_POLY_RECIP + RING_PRIME_POLY_RECIP_EQ + RING_PRIME_POLY_VAR + RING_PRIME_PRODUCT_DIVIDES + RING_SQUAREFREE_0 + RING_SQUAREFREE_1 + RING_SQUAREFREE_ALT + RING_SQUAREFREE_ASSOCIATES + RING_SQUAREFREE_COPRIME + RING_SQUAREFREE_COPRIME_DIVISORS + RING_SQUAREFREE_DECOMPOSITION + RING_SQUAREFREE_DIVIDES + RING_SQUAREFREE_DIVIDES_SQUARE + RING_SQUAREFREE_DIVISOR + RING_SQUAREFREE_DIVPOW + RING_SQUAREFREE_DIVPOW_EQ + RING_SQUAREFREE_GCD + RING_SQUAREFREE_IMP_NONZERO + RING_SQUAREFREE_IMP_NO_PRIME_SQUARE + RING_SQUAREFREE_IN_CARRIER + RING_SQUAREFREE_MUL_EQ + RING_SQUAREFREE_MUL_IMP + RING_SQUAREFREE_POW + RING_SQUAREFREE_PRIME_DIVISOR_EQ + RING_SQUAREFREE_PRIME_EQ + RING_SQUAREFREE_PRODUCT + RING_SUM_CONST + RING_UNIT_IMP_SQUAREFREE + RING_UNIT_POLY_RECIP + RING_UNIT_POLY_RECIP_EQ + RING_UNIT_POLY_RING_1 + RING_UNIT_POLY_VAR + TRIVIAL_RING_POLY_0 + TRIVIAL_RING_POWSER_0 + +New theorems in Library/fieldtheory.ml: + + ALGEBRAICALLY_CLOSED_FIELD_EQ_SPLITS_ALT + ALGEBRAICALLY_CLOSED_FIELD_SPLITS + COPRIME_POLY_NO_COMMON_ROOT + COPRIME_POLY_NO_COMMON_ROOT_I + FIELD_EXTENSION_TRANS_I + IRREDUCIBLE_ALGEBRAICALLY_CLOSED_FIELD + POLY_SQUAREFREE_EXPLICIT_EQ + POLY_SQUAREFREE_ROOT_COUNT + POLY_SQUAREFREE_ROOT_COUNT_EQ + POLY_SQUAREFREE_ROOT_COUNT_EXPLICIT + +Changed theorems: + + ALGEBRAICALLY_CLOSED_FIELD_EQ_SPLITS [strengthened, old = _ALT] + COEFF_POLY_CONST_MUL [renamed to COEFF_POLY_LMUL] + COEFF_POLY_MUL_CONST [renamed to COEFF_POLY_RMUL] + POLY_MUL_VAR_COEFF_UNIVARIATE [removed, see COEFF_POLY_VAR_MUL] + POLY_VAR_DIVIDES_UNIVARIATE [==> became <=>, lost hyps] + RING_PRIME_POLY_CONST [==> became <=>, lost hyps] + RING_PRIME_POLY_RING_MONO [lost integral_domain hyp] + RING_PRIME_POLY_VAR_UNIVARIATE [==> became <=>] + +Incompatible changes to existing theorem statements: + + RING_PRIME_POLY_CONST (ringtheory.ml): strengthened from + integral_domain r /\ ring_prime r p ==> ring_prime ... (poly_const ...) + to the unconditional equivalence + ring_prime (poly_ring r s) (poly_const r p) <=> ring_prime r p + + RING_PRIME_POLY_VAR_UNIVARIATE (ringtheory.ml): strengthened from + integral_domain r ==> ring_prime (poly_ring r (:1)) (poly_var r one) + to the equivalence + ring_prime (poly_ring r (:1)) (poly_var r one) <=> integral_domain r + + RING_PRIME_POLY_RING_MONO (ringtheory.ml): lost integral_domain r + hypothesis (primality in a sub-polynomial-ring now unconditionally + lifts to the larger polynomial ring). + + POLY_VAR_DIVIDES_UNIVARIATE (ringtheory.ml): strengthened from + integral_domain r /\ f IN carrier ==> (x divides f <=> f(0) = 0) + to the unconditional equivalence + ring_divides ... (poly_var r one) p <=> + ring_polynomial r p /\ coeff 0 p = ring_0 r + + COEFF_POLY_CONST_MUL renamed to COEFF_POLY_LMUL (same statement). + COEFF_POLY_MUL_CONST renamed to COEFF_POLY_RMUL (same statement). + POLY_MUL_VAR_COEFF_UNIVARIATE removed, subsumed by COEFF_POLY_VAR_MUL. + + ALGEBRAICALLY_CLOSED_FIELD_EQ_SPLITS (fieldtheory.ml): hypothesis + strengthened from ~(poly_deg k p = 0) to ~(p = poly_0 k). The old + statement (with the degree condition) is preserved as + ALGEBRAICALLY_CLOSED_FIELD_EQ_SPLITS_ALT. + + ring_squarefree (100/transcendence.ml): definition changed from + "a | b^2 ==> a | b" to "no non-unit has its square dividing a". + Some downstream theorems in that file have gained hypotheses: + ring_squarefree_if_prime now requires integral_domain r; + ring_squarefree_if_product_coprime_primes(_indexed) now require + UFD r. + Mon 27th Apr 2026 Probability/* Substantially extended the probability theory library with new results, diff --git a/Examples/apery.ml b/Examples/apery.ml new file mode 100644 index 00000000..d6480e04 --- /dev/null +++ b/Examples/apery.ml @@ -0,0 +1,2561 @@ +(* ========================================================================= *) +(* Apery's theorem: the irrationality of zeta(3). *) +(* *) +(* The proof follows John Harrison's HOL Light development apart from the *) +(* recurrence for bb. The order-4 recurrence and its telescoping certificate *) +(* originate in Bruno Salvy's Maple/Algolib worksheet. They were later *) +(* formally checked by Chyzak, Mahboubi, Sibut-Pinote and Tassi. The exact *) +(* operators and contiguity data used here are translated from the later *) +(* Coq development by Mahboubi and Sibut-Pinote. *) +(* *) +(* Thus the recurrence data were generated in Maple by creative telescoping, *) +(* using algorithms derived from Zeilberger's work, not generated by Coq. *) +(* Both Coq and HOL check the data a posteriori. Here P_flat is factored *) +(* through the order-2 Apery operator. The interior telescoping *) +(* identity is checked by triangular rational reduction to three factorized *) +(* polynomial identities. Only the boundary step retains a large cofactor *) +(* certificate generated offline for this HOL development. *) +(* *) +(* References: *) +(* C. Schneider, "Apery's Double Sum is Plain Sailing Indeed" (2007): *) +(* http://www.risc.jku.at/publications/download/risc_3027/Apery.pdf *) +(* B. Salvy, "An Algolib-aided version of Apery's proof of the *) +(* irrationality of zeta(3)" (2003): *) +(* http://algo.inria.fr/libraries/autocomb/Apery2-html/apery.html *) +(* F. Chyzak, A. Mahboubi, T. Sibut-Pinote and E. Tassi, "A *) +(* Computer-Algebra-Based Formal Proof of the Irrationality of zeta(3)" *) +(* (2014), doi:10.1007/978-3-319-08970-6_11. *) +(* A. Mahboubi and T. Sibut-Pinote, "A Formal Proof of the *) +(* Irrationality of zeta(3)" (2021), doi:10.23638/LMCS-17(1:16)2021; *) +(* https://github.com/rocq-community/apery *) +(* ========================================================================= *) + +needs "100/pnt.ml";; + +(* ------------------------------------------------------------------------- *) +(* LCMs over sets. *) +(* ------------------------------------------------------------------------- *) + +let LCM_DEF = define + `LCM (s:num->bool) = iterate(\m n. lcm(m,n)) s I`;; + +let LCM_CLAUSES = prove + (`(LCM {} = 1) /\ + (!x s. FINITE s + ==> LCM (x INSERT s) = if x IN s then LCM s else lcm(x,LCM s))`, + ASM_SIMP_TAC[LCM_DEF; MONOIDAL_LCM; ITERATE_CLAUSES; I_THM; NEUTRAL_LCM]);; + +let LCM_CLAUSES_NUMSEG = prove + (`(!m. LCM(m..0) = if m = 0 then 0 else 1) /\ + (!m n. LCM(m..SUC n) = + if m <= SUC n then lcm(LCM(m..n),SUC n) else 1)`, + REWRITE_TAC[NUMSEG_CLAUSES] THEN REPEAT STRIP_TAC THEN + COND_CASES_TAC THEN + ASM_SIMP_TAC[LCM_CLAUSES; FINITE_NUMSEG; IN_NUMSEG; FINITE_EMPTY] THEN + REWRITE_TAC[ARITH_RULE `~(SUC n <= n)`; LCM_1; NOT_IN_EMPTY] THEN + REWRITE_TAC[LCM_SYM] THEN + MATCH_MP_TAC(MESON[LCM_CLAUSES] `s = {} ==> LCM s = 1`) THEN + REWRITE_TAC[NUMSEG_EMPTY] THEN ASM_ARITH_TAC);; + +let LCM_EQ_0 = prove + (`!s. FINITE s ==> (LCM s = 0 <=> 0 IN s)`, + SIMP_TAC[LCM_DEF; ITERATE_LCM_EQ_0; I_THM] THEN SET_TAC[]);; + +let LCM_NONZERO = prove + (`!n. ~(LCM(1..n) = 0)`, + SIMP_TAC[LCM_EQ_0; FINITE_NUMSEG; IN_NUMSEG; ARITH]);; + +let DIVIDES_LCM_SET = prove + (`!s n. FINITE s /\ n IN s ==> n divides LCM s`, + REPEAT STRIP_TAC THEN REWRITE_TAC[LCM_DEF] THEN + MP_TAC(ISPECL [`I:num->num`; `s:num->bool`; `n:num`] + DIVIDES_ITERATE_LCM) THEN + ASM_REWRITE_TAC[I_THM]);; + +let DIVIDES_LCM_NUMSEG = prove + (`!m n. 1 <= m /\ m <= n ==> m divides LCM(1..n)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC DIVIDES_LCM_SET THEN + ASM_SIMP_TAC[IN_NUMSEG; FINITE_NUMSEG; LE_1]);; + +let PRIMEPOW_DIVIDES_SET_LCM = prove + (`!s p k. FINITE s /\ prime p + ==> (p EXP k divides LCM(s) <=> + s = {} /\ k = 0 \/ ?n. n IN s /\ p EXP k divides n)`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[LCM_DEF; PRIMEPOW_DIVIDES_ITERATE_LCM; I_THM] THEN + ASM_CASES_TAC `s:num->bool = {}` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY] THEN + ASM_MESON_TAC[MEMBER_NOT_EMPTY; EXP; DIVIDES_1]);; + +let PRIMEPOW_DIVIDES_NUMSEG_LCM = prove + (`!n p k. prime p + ==> (p EXP k divides LCM(1..n) <=> n = 0 /\ k = 0 \/ + ?m. 1 <= m /\ m <= n /\ p EXP k divides m)`, + SIMP_TAC[PRIMEPOW_DIVIDES_SET_LCM; FINITE_NUMSEG] THEN + REWRITE_TAC[NUMSEG_EMPTY; ARITH_RULE `n < 1 <=> n = 0`] THEN + REWRITE_TAC[IN_NUMSEG; GSYM CONJ_ASSOC]);; + + +let PRIMEPOW_DIVIDES_NUMSEG_LCM_SIMPLE = prove + (`!n p k. prime p + ==> (p EXP k divides LCM(1..n) <=> n = 0 /\ k = 0 \/ p EXP k <= n)`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[PRIMEPOW_DIVIDES_NUMSEG_LCM] THEN + AP_TERM_TAC THEN EQ_TAC THENL + [DISCH_THEN(X_CHOOSE_THEN `m:num` STRIP_ASSUME_TAC) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP DIVIDES_LE) THEN + ASM_MESON_TAC[LE_TRANS; LE_1]; + DISCH_TAC THEN EXISTS_TAC `p EXP k` THEN ASM_REWRITE_TAC[DIVIDES_REFL] THEN + ASM_SIMP_TAC[ARITH_RULE `1 <= p <=> ~(p = 0)`; PRIME_IMP_NZ; EXP_EQ_0]]);; + +let BINOM_MULTIPLE_DIVIDES_LCM = prove + (`!m. 1 <= m /\ m <= n ==> (m * binom(n,m)) divides LCM(1..n)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC DIVIDES_CMUL2 THEN + EXISTS_TAC `FACT m * FACT(n - m)` THEN + MP_TAC(SPECL [`n - m:num`; `m:num`] BINOM_FACT) THEN + ASM_SIMP_TAC[MULT_EQ_0; FACT_NZ; SUB_ADD] THEN + SIMP_TAC[ARITH_RULE `(m * k) * x * b:num = x * k * m * b`] THEN + DISCH_TAC THEN REWRITE_TAC[GSYM MULT_ASSOC] THEN + ONCE_REWRITE_TAC[PRIMEPOW_DIVISORS_DIVIDES] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + X_GEN_TAC `p:num` THEN DISCH_TAC THEN + SUBGOAL_THEN `~(p = 0) /\ ~(p = 1) /\ 2 <= p /\ ~(p <= 1)` + STRIP_ASSUME_TAC THENL + [FIRST_ASSUM(MP_TAC o MATCH_MP PRIME_GE_2) THEN ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[PRIMEPOW_DIVIDES_INDEX; MULT_EQ_0; FACT_NZ; + INDEX_FACT_UNBOUNDED; LE_1; LCM_NONZERO; INDEX_MUL] THEN + MATCH_MP_TAC(ARITH_RULE `a:num <= b ==> !k. k <= a ==> k <= b`) THEN + ASM_SIMP_TAC[index_def; LE_1; LCM_NONZERO] THEN + ONCE_REWRITE_TAC[ARITH_RULE `CARD s = CARD s * 1`] THEN + ASM_SIMP_TAC[GSYM NSUM_CONST; FINITE_INDICES; LE_1; LCM_NONZERO] THEN + ONCE_REWRITE_TAC[SET_RULE + `{x | P x /\ Q x} = {x | x IN {x | P x} /\ Q x}`] THEN + REWRITE_TAC[NSUM_RESTRICT_SET] THEN + REPLICATE_TAC 2 + (ASM_SIMP_TAC[CONV_RULE(RAND_CONV SYM_CONV) (SPEC_ALL NSUM_ADD_GEN); + IN_ELIM_THM; DIV_EQ_0; EXP_EQ_0; + NOT_LT; FINITE_EXP_LE; FINITE_INDICES; LCM_NONZERO; + MESON[ARITH] `((if p then 1 else 0) = 0) <=> ~p`; + ADD_EQ_0; DE_MORGAN_THM; FINITE_UNION; LE_1; + SET_RULE `{x | P x /\ (Q x \/ R x)} = + {x | P x /\ Q x} UNION {x | P x /\ R x}`] THEN + TRY(MATCH_MP_TAC NSUM_LE_GEN)) THEN + X_GEN_TAC `j:num` THEN DISCH_TAC THEN + ASM_SIMP_TAC[PRIMEPOW_DIVIDES_NUMSEG_LCM_SIMPLE] THEN + ASM_CASES_TAC `p EXP j divides m` THEN ASM_REWRITE_TAC[] THENL + [COND_CASES_TAC THENL + [ALL_TAC; ASM_MESON_TAC[DIVIDES_LE; LE_TRANS; LE_1]] THEN + REWRITE_TAC[ARITH_RULE `1 + a <= b + c + 1 <=> a <= b + c`] THEN + ASM_SIMP_TAC[LE_LDIV_EQ; EXP_EQ_0; PRIME_IMP_NZ] THEN + RULE_ASSUM_TAC(REWRITE_RULE[DIVIDES_DIV_MULT]) THEN + ASM_SIMP_TAC[ARITH_RULE `p * ((d + e) + 1):num = d * p + e * p + p`] THEN + MATCH_MP_TAC(ARITH_RULE `m:num <= n /\ n - m < p ==> n < m + p`) THEN + ASM_REWRITE_TAC[] THEN MP_TAC(SPECL [`n - m:num`; `p EXP j`] DIVISION) THEN + ASM_SIMP_TAC[EXP_EQ_0; PRIME_IMP_NZ] THEN ASM_ARITH_TAC; + REWRITE_TAC[ADD_CLAUSES] THEN + COND_CASES_TAC THEN ASM_SIMP_TAC[GSYM NOT_LE; DIV_LT; LE_0] THEN + ASM_SIMP_TAC[LE_LDIV_EQ; EXP_EQ_0; PRIME_IMP_NZ] THEN + MATCH_MP_TAC(ARITH_RULE + `!m:num. m <= n /\ m + (n - m) < x ==> n < x`) THEN + EXISTS_TAC `m:num` THEN ASM_REWRITE_TAC[] THEN + MP_TAC(SPECL [`n - m:num`; `p EXP j`] DIVISION) THEN + MP_TAC(SPECL [`m:num`; `p EXP j`] DIVISION) THEN + ASM_SIMP_TAC[EXP_EQ_0; PRIME_IMP_NZ] THEN ASM_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* The real zeta function. *) +(* ------------------------------------------------------------------------- *) + +let ZETA = new_definition + `ZETA x = Re(zeta(Cx x))`;; + +(* ------------------------------------------------------------------------- *) +(* The key sequences. *) +(* ------------------------------------------------------------------------- *) + +let cc = new_definition + `cc n k = &(binom(n + k,k)) pow 2 * &(binom(n,k)) pow 2`;; + +let zz = new_definition + `zz n = sum(1..n) (\k. &1 / &k pow 3)`;; + +let aa = new_definition + `aa n = sum(0..n) (\k. cc n k)`;; + +let bb = new_definition + `bb n = aa n * zz n + + sum (1..n) + (\k. sum (1..k) + (\m. --(&1) pow (m + 1) / + (&2 * &m pow 3 * &(binom(n,m)) * &(binom(n+m,m))) * + cc n k))`;; + +(* ------------------------------------------------------------------------- *) +(* Cosmetically different form for b from Schneider's paper. *) +(* ------------------------------------------------------------------------- *) + +let BB_ALT = prove + (`!n. bb n = + sum (0..n) + (\k. &(binom(n + k,k)) pow 2 * &(binom(n,k)) pow 2 * + (zz n + + sum (1..k) + (\m. --(&1) pow (m - 1) / + (&2 * &m pow 3 * + &(binom(n+m,m)) * &(binom(n,m))))))`, + GEN_TAC THEN REWRITE_TAC[REAL_ADD_LDISTRIB; SUM_ADD_NUMSEG] THEN + REWRITE_TAC[bb; aa; cc; GSYM SUM_RMUL; REAL_POW_MUL] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN AP_TERM_TAC THEN + SIMP_TAC[ISPECL [`f:num->real`; `0`; `n:num`] SUM_CLAUSES_LEFT; LE_0] THEN + REWRITE_TAC[SUM_CLAUSES_NUMSEG; ARITH_EQ; REAL_MUL_RZERO; REAL_ADD_LID] THEN + REWRITE_TAC[ADD_CLAUSES] THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN + X_GEN_TAC `k:num` THEN STRIP_TAC THEN REWRITE_TAC[GSYM SUM_LMUL] THEN + MATCH_MP_TAC SUM_EQ_NUMSEG THEN X_GEN_TAC `m:num` THEN STRIP_TAC THEN + REWRITE_TAC[] THEN + ASM_SIMP_TAC[ARITH_RULE `1 <= m ==> m + 1 = SUC(SUC(m - 1))`] THEN + REWRITE_TAC[real_pow; REAL_MUL_LNEG; REAL_MUL_LID; REAL_MUL_RNEG] THEN + REWRITE_TAC[REAL_NEG_NEG; REAL_MUL_AC]);; + +(* ========================================================================= *) +(* *** Part 0: estimation of LCM(1..n) *) +(* ========================================================================= *) + +let DIVIDES_NPRODUCT_FROM_MEMBER = prove + (`!s n x:A. FINITE s /\ n divides (f x) /\ x IN s + ==> n divides nproduct s f`, + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[NOT_IN_EMPTY] THEN + SIMP_TAC[IN_INSERT; NPRODUCT_CLAUSES] THEN + MESON_TAC[DIVIDES_LMUL; DIVIDES_RMUL]);; + +let LOG_LCM_BOUND = prove + (`!n. ~(n = 0) + ==> log(&(LCM(1..n))) <= log(&n) * &(CARD {p | prime p /\ p <= n})`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[LCM_CLAUSES_NUMSEG; ARITH; LOG_1; REAL_ADD_LID; REAL_POS] THEN + ABBREV_TAC `a = \p. @k. floor(log(&n) / log(&p)) = &k` THEN + SUBGOAL_THEN `!p. prime p ==> floor(log(&n) / log(&p)) = &(a p)` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN EXPAND_TAC "a" THEN CONV_TAC SELECT_CONV THEN + MATCH_MP_TAC FLOOR_POS THEN MATCH_MP_TAC REAL_LE_DIV THEN + ASM_SIMP_TAC[LOG_POS; LE_1; PRIME_IMP_NZ; REAL_OF_NUM_LE]; + ALL_TAC] THEN + TRANS_TAC REAL_LE_TRANS + `log(&(nproduct {p | p IN 1..n /\ prime p} (\p. p EXP (a p))))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC LOG_MONO_LE_IMP THEN + ASM_SIMP_TAC[REAL_OF_NUM_LT; LCM_NONZERO; LE_1; REAL_OF_NUM_LE] THEN + MATCH_MP_TAC(MESON[DIVIDES_LE] `~(n = 0) /\ m divides n ==> m <= n`) THEN + CONJ_TAC THENL + [SIMP_TAC[NPRODUCT_EQ_0; FINITE_NUMSEG; FINITE_RESTRICT] THEN + REWRITE_TAC[IN_ELIM_THM; EXP_EQ_0] THEN MESON_TAC[PRIME_IMP_NZ]; + ALL_TAC] THEN + ONCE_REWRITE_TAC[PRIMEPOW_DIVISORS_DIVIDES] THEN + ASM_SIMP_TAC[IMP_CONJ; PRIMEPOW_DIVIDES_NUMSEG_LCM] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN REPEAT STRIP_TAC THEN + ASM_CASES_TAC `k = 0` THEN ASM_REWRITE_TAC[EXP; DIVIDES_1] THEN + MATCH_MP_TAC DIVIDES_NPRODUCT_FROM_MEMBER THEN EXISTS_TAC `p:num` THEN + ASM_SIMP_TAC[IN_ELIM_THM; FINITE_RESTRICT; FINITE_NUMSEG; IN_NUMSEG] THEN + ASM_SIMP_TAC[PRIME_GE_2; DIVIDES_EXP_LE; ARITH_RULE + `2 <= p ==> 1 <= p`] THEN + MATCH_MP_TAC(TAUT `b /\ (b ==> a) ==> a /\ b`) THEN CONJ_TAC THENL + [SUBGOAL_THEN `p divides m` MP_TAC THENL + [TRANS_TAC DIVIDES_TRANS `p EXP k` THEN ASM_REWRITE_TAC[] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM EXP_1] THEN + ASM_SIMP_TAC[DIVIDES_EXP_LE; PRIME_GE_2; LE_1]; + DISCH_THEN(MP_TAC o MATCH_MP DIVIDES_LE) THEN ASM_ARITH_TAC]; + DISCH_TAC THEN REWRITE_TAC[ARITH_RULE `m <= n <=> m < n + 1`] THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP DIVIDES_LE) THEN + ASM_SIMP_TAC[LE_1] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `p:num`) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_LT; GSYM REAL_OF_NUM_ADD] THEN + MATCH_MP_TAC(REAL_ARITH + `x < floor x + &1 /\ k <= x ==> floor x = a ==> k < a + &1`) THEN + REWRITE_TAC[FLOOR] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ; LOG_POS_LT; REAL_OF_NUM_LT; PRIME_GE_2; + ARITH_RULE `1 < p <=> 2 <= p`; GSYM LOG_POW; + PRIME_IMP_NZ; LE_1] THEN + MATCH_MP_TAC LOG_MONO_LE_IMP THEN + ASM_REWRITE_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_LE; REAL_OF_NUM_POW] THEN + CONJ_TAC THENL [REWRITE_TAC[REAL_OF_NUM_LT]; ASM_ARITH_TAC] THEN + REWRITE_TAC[EXP_LT_0] THEN ASM_MESON_TAC[PRIME_IMP_NZ]]; + SIMP_TAC[LOG_PRODUCT; LE_1; EXP_EQ_0; PRIME_IMP_NZ; FINITE_RESTRICT; + REAL_OF_NUM_NPRODUCT; FINITE_NUMSEG; REAL_OF_NUM_LT; FORALL_IN_GSPEC] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_POW] THEN + TRANS_TAC REAL_LE_TRANS `sum {p | p IN 1..n /\ prime p} (\p. log(&n))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE THEN + SIMP_TAC[FINITE_RESTRICT; FINITE_NUMSEG; FORALL_IN_GSPEC] THEN + X_GEN_TAC `p:num` THEN REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN + ASM_SIMP_TAC[LOG_POW; REAL_OF_NUM_LT; LE_1] THEN + ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ; LOG_POS_LT; REAL_OF_NUM_LT; + PRIME_GE_2; ARITH_RULE `1 < n <=> 2 <= n`] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `p:num`) THEN ASM_REWRITE_TAC[] THEN + MESON_TAC[FLOOR]; + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + SIMP_TAC[SUM_CONST; FINITE_RESTRICT; FINITE_NUMSEG] THEN + MATCH_MP_TAC REAL_EQ_IMP_LE THEN AP_THM_TAC THEN AP_TERM_TAC THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_NUMSEG; ARITH_RULE `1 <= n <=> ~(n = 0)`] THEN + REWRITE_TAC[IN_ELIM_THM] THEN MESON_TAC[PRIME_0]]]);; + +let LCM_BOUND = prove + (`!e. &0 < e + ==> eventually (\n. &(LCM(1..n)) < exp((&1 + e) * &n)) sequentially`, + REPEAT STRIP_TAC THEN MP_TAC PNT THEN + REWRITE_TAC[REALLIM_SEQUENTIALLY; EVENTUALLY_SEQUENTIALLY] THEN + DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `N + 1` THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN DISCH_TAC THEN + W(MP_TAC o PART_MATCH (rand o rand) LOG_MONO_LT o snd) THEN + SIMP_TAC[REAL_EXP_POS_LT; REAL_OF_NUM_LT; LCM_NONZERO; LE_1; LOG_EXP] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + TRANS_TAC REAL_LET_TRANS `log(&n) * &(CARD {p | prime p /\ p <= n})` THEN + CONJ_TAC THENL [MATCH_MP_TAC LOG_LCM_BOUND THEN ASM_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `&0 < &n` ASSUME_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_LT] THEN ASM_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (REAL_ARITH `abs(x - &1) < e ==> y = x ==> y < &1 + e`)) THEN + REWRITE_TAC[real_div; REAL_INV_MUL; REAL_INV_INV; REAL_MUL_AC]);; + +let LCM_BOUND_SIMPLE = prove + (`?N. !n. N <= n ==> LCM(1..n) < 3 EXP n`, + MP_TAC(SPEC `&1 / &16` LCM_BOUND) THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN + MATCH_MP_TAC MONO_EXISTS THEN GEN_TAC THEN + MATCH_MP_TAC MONO_FORALL THEN GEN_TAC THEN + MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[GSYM REAL_OF_NUM_LT] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] REAL_LTE_TRANS) THEN + TRANS_TAC REAL_LE_TRANS `exp(log(&3) * &n)` THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_EXP_MONO_LE] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_POS] THEN + ONCE_REWRITE_TAC[GSYM REAL_EXP_MONO_LE] THEN + SIMP_TAC[EXP_LOG; REAL_OF_NUM_LT; ARITH] THEN + MP_TAC(ISPECL [`8`; `Cx(&17 / &16)`] TAYLOR_CEXP) THEN + SIMP_TAC[RE_CX; REAL_ABS_NUM; GSYM CX_EXP; GSYM CX_DIV; GSYM CX_SUB; + COMPLEX_POW_ONE; COMPLEX_NORM_CX] THEN + CONV_TAC(ONCE_DEPTH_CONV EXPAND_VSUM_CONV) THEN + REWRITE_TAC[GSYM CX_ADD; GSYM CX_SUB; GSYM CX_DIV; GSYM CX_POW; + COMPLEX_NORM_CX] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REAL_ARITH_TAC; + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN REWRITE_TAC[REAL_EXP_N] THEN + SIMP_TAC[EXP_LOG; REAL_OF_NUM_LT; ARITH; GSYM REAL_OF_NUM_POW] THEN + REWRITE_TAC[REAL_LE_REFL]]);; + +(* ========================================================================= *) +(* *** Part 1: b^n / a^n ---> zeta(3) *) +(* ========================================================================= *) + +let CC_EQ_0 = prove + (`!n k. cc n k = &0 <=> n + 1 <= k`, + REWRITE_TAC[cc; BINOM_EQ_0; REAL_ENTIRE; REAL_POW_EQ_0; REAL_OF_NUM_EQ; + ARITH_EQ] THEN + ARITH_TAC);; + +let CC_POS_LT = prove + (`!n k. k <= n ==> &0 < cc n k`, + REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_LT_LE] THEN + CONV_TAC(ONCE_DEPTH_CONV SYM_CONV) THEN REWRITE_TAC[CC_EQ_0] THEN + CONJ_TAC THENL [REWRITE_TAC[cc]; ASM_ARITH_TAC] THEN + SIMP_TAC[REAL_POS; REAL_POW_LE; REAL_LE_MUL]);; + +let AA_POS_LT = prove + (`!n. &0 < aa n`, + GEN_TAC THEN REWRITE_TAC[aa] THEN MATCH_MP_TAC SUM_POS_LT THEN + SIMP_TAC[FINITE_NUMSEG; IN_NUMSEG; REAL_LT_IMP_LE; CC_POS_LT] THEN + EXISTS_TAC `0` THEN SIMP_TAC[LE_0; CC_POS_LT]);; + +let AA_NONZERO = prove + (`!n. ~(aa n = &0)`, + SIMP_TAC[REAL_LT_IMP_NZ; AA_POS_LT]);; + +(* The summand's real part (k >= 1 so the cpow base is nonzero). *) +let RE_SUMMAND = prove + (`!k. 1 <= k ==> Re(Cx(&1) / Cx(&k) cpow Cx(&3)) = &1 / &k pow 3`, + REPEAT STRIP_TAC THEN REWRITE_TAC[CPOW_N] THEN + COND_CASES_TAC THENL + [FIRST_X_ASSUM(MP_TAC o REWRITE_RULE[CX_INJ; REAL_OF_NUM_EQ]) THEN + ASM_ARITH_TAC; + REWRITE_TAC[GSYM CX_POW; GSYM CX_DIV; RE_CX]]);; + +(* Take real parts of the complex zeta series at s = 3. *) +let ZZ_SUMS = prove + (`((\k. &1 / &k pow 3) real_sums ZETA(&3)) (from 1)`, + MATCH_MP_TAC REAL_SUMS_EQ THEN + EXISTS_TAC `\k. Re(Cx(&1) / Cx(&k) cpow Cx(&3))` THEN CONJ_TAC THENL + [SIMP_TAC[IN_FROM; RE_SUMMAND]; + MP_TAC(SPEC `Cx(&3)` ZETA_CONVERGES) THEN + REWRITE_TAC[REAL_ARITH `&1 < &3`; RE_CX] THEN + DISCH_THEN(MP_TAC o MATCH_MP REAL_SUMS_RE) THEN + REWRITE_TAC[ZETA; o_DEF]]);; + +let ZZ_LIM = prove + (`(zz ---> ZETA(&3)) sequentially`, + SUBGOAL_THEN `zz = \n. sum(from 1 INTER (0..n)) (\k. &1 / &k pow 3)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; zz; FROM_INTER_NUMSEG]; + MP_TAC ZZ_SUMS THEN REWRITE_TAC[real_sums]]);; + +let ZETA3_POS = prove + (`&0 < ZETA(&3)`, + MP_TAC(ISPECL [`\n. inv(&n pow 3)`; `from 1`; `{1}`] + REAL_PARTIAL_SUMS_LE_INFSUM_GEN) THEN + REWRITE_TAC[FINITE_SING; SING_SUBSET; SUM_SING; IN_FROM] THEN + REWRITE_TAC[LE_REFL; REAL_LE_INV_EQ; REAL_POS] THEN + SUBGOAL_THEN `((\n. inv(&n pow 3)) real_sums ZETA(&3)) (from 1)` + ASSUME_TAC THENL + [MP_TAC ZZ_LIM THEN + REWRITE_TAC[real_sums; REWRITE_RULE[GSYM FUN_EQ_THM; ETA_AX] zz; + FROM_INTER_NUMSEG; real_div; REAL_MUL_LID]; + FIRST_ASSUM(ASSUME_TAC o MATCH_MP REAL_SUMS_SUMMABLE) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP REAL_INFSUM_UNIQUE) THEN + ASM_SIMP_TAC[REAL_POW_LE; REAL_POS] THEN ASM_REAL_ARITH_TAC]);; + +let BB_OVER_AA_LIM = prove + (`((\n. bb n / aa n) ---> ZETA(&3)) sequentially`, + REWRITE_TAC[bb; REAL_ARITH `(a * z + s) / a:real = (a / a) * z + s / a`] THEN + SIMP_TAC[REAL_DIV_REFL; AA_NONZERO; REAL_MUL_LID] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM REAL_ADD_RID] THEN + MATCH_MP_TAC REALLIM_ADD THEN REWRITE_TAC[ZZ_LIM] THEN + MATCH_MP_TAC REALLIM_NULL_COMPARISON THEN EXISTS_TAC + `\n. sum(1..n) (\k. sum(1..k) (\m. cc n k / (&2 * &n pow 2))) / aa n` THEN + CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN + SIMP_TAC[REAL_ABS_DIV; AA_POS_LT; REAL_ARITH `&0 < x ==> abs x = x`; + REAL_LE_DIV2_EQ] THEN + MATCH_MP_TAC SUM_ABS_LE THEN REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN + X_GEN_TAC `k:num` THEN STRIP_TAC THEN MATCH_MP_TAC SUM_ABS_LE THEN + REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN X_GEN_TAC `m:num` THEN + STRIP_TAC THEN + REWRITE_TAC[real_div; REAL_ABS_MUL; REAL_ABS_POW; REAL_ABS_NEG; + REAL_ABS_NUM; REAL_POW_ONE; REAL_MUL_LID] THEN + ASM_SIMP_TAC[CC_POS_LT; REAL_ARITH `&0 < x ==> abs x = x`] THEN + GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN + ASM_SIMP_TAC[REAL_LE_RMUL_EQ; CC_POS_LT; REAL_ABS_INV] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + ASM_SIMP_TAC[REAL_LT_MUL; REAL_POW_LT; REAL_OF_NUM_LT; LE_1; ARITH] THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_POW; REAL_ABS_NUM] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_POS] THEN + REWRITE_TAC[REAL_OF_NUM_POW; REAL_OF_NUM_MUL; REAL_OF_NUM_LE] THEN + ASM_CASES_TAC `m:num = n` THENL + [REWRITE_TAC[ARITH_RULE + `n <= m EXP 3 * x <=> n * 1 <= m EXP 2 * m * x`] THEN + ASM_REWRITE_TAC[LE_MULT_LCANCEL] THEN DISJ2_TAC THEN + REWRITE_TAC[ARITH_RULE `1 <= n <=> ~(n = 0)`; MULT_EQ_0] THEN + REWRITE_TAC[BINOM_EQ_0] THEN ASM_ARITH_TAC; + MATCH_MP_TAC(ARITH_RULE + `n * n <= b * c /\ 1 * b * c <= m * b * c + ==> n EXP 2 <= m * b * c`) THEN + REWRITE_TAC[LE_MULT_RCANCEL; ARITH_RULE `1 <= n <=> ~(n = 0)`] THEN + ASM_SIMP_TAC[EXP_EQ_0; LE_1] THEN MATCH_MP_TAC LE_MULT2 THEN + MATCH_MP_TAC(ARITH_RULE + `n <= binom(n,m) /\ n + m <= binom(n + m,m) + ==> n <= binom(n,m) /\ n <= binom(n + m,m)`) THEN + CONJ_TAC THEN MATCH_MP_TAC BINOM_GE_TOP THEN ASM_ARITH_TAC]; + ALL_TAC] THEN + MATCH_MP_TAC REALLIM_NULL_COMPARISON THEN EXISTS_TAC + `\n. sum(1..n) (\k. &k * cc n k / (&2 * &n pow 2)) / aa n` THEN + CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN + REWRITE_TAC[real_div; SUM_RMUL; REAL_ABS_MUL; REAL_ABS_INV; + REAL_ABS_POW; REAL_ABS_NUM; REAL_MUL_ASSOC] THEN + SIMP_TAC[AA_POS_LT; REAL_ARITH `&0 < x ==> abs x = x`] THEN + ASM_SIMP_TAC[GSYM real_div; REAL_LE_DIV2_EQ; REAL_POW_LT; + REAL_ARITH `&0 < &2 * x <=> &0 < x`; + REAL_OF_NUM_LT; AA_POS_LT; LE_1; ARITH] THEN + SIMP_TAC[SUM_CONST; CARD_NUMSEG_1; FINITE_NUMSEG] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> abs x <= x`) THEN + MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_MUL THEN + ASM_SIMP_TAC[CC_POS_LT; REAL_LT_IMP_LE; REAL_POS]; + ALL_TAC] THEN + MATCH_MP_TAC REALLIM_NULL_COMPARISON THEN + EXISTS_TAC `\n. inv(&2) * inv(&n)` THEN + SIMP_TAC[REALLIM_1_OVER_N; REALLIM_NULL_LMUL] THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN REWRITE_TAC[REAL_ABS_DIV] THEN + SIMP_TAC[AA_POS_LT; REAL_ARITH `&0 < x ==> abs x = x`; REAL_LE_LDIV_EQ] THEN + REWRITE_TAC[real_div; REAL_MUL_ASSOC; SUM_RMUL; REAL_ABS_MUL] THEN + REWRITE_TAC[REAL_ABS_INV; REAL_ABS_MUL; REAL_ABS_POW; REAL_ABS_NUM] THEN + ASM_SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ; REAL_POW_LT; + REAL_ARITH `&0 < &2 * x <=> &0 < x`; REAL_OF_NUM_LT; LE_1] THEN + ASM_SIMP_TAC[LE_1; REAL_OF_NUM_LT; REAL_FIELD + `&0 < x ==> (inv(&2) / x * a) * &2 * x pow 2 = x * a`] THEN + TRANS_TAC REAL_LE_TRANS `sum(1..n) (\k. &n * cc n k)` THEN CONJ_TAC THENL + [MATCH_MP_TAC SUM_ABS_LE THEN + SIMP_TAC[FINITE_NUMSEG; REAL_LE_RMUL_EQ; CC_POS_LT; REAL_ABS_MUL; + REAL_ARITH `&0 < x ==> abs x = x`; IN_NUMSEG; REAL_ABS_NUM; + REAL_OF_NUM_LE]; + REWRITE_TAC[SUM_LMUL] THEN MATCH_MP_TAC REAL_LE_LMUL THEN + REWRITE_TAC[REAL_POS; aa] THEN MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN + SIMP_TAC[IN_NUMSEG; IN_DIFF; FINITE_NUMSEG; REAL_LT_IMP_LE; CC_POS_LT] THEN + REWRITE_TAC[SUBSET; IN_NUMSEG] THEN ARITH_TAC]);; + +(* ========================================================================= *) +(* *** Part 2: integer nature of a_n and scaled b_n. *) +(* ========================================================================= *) + +let AA_INTEGER = prove + (`!n. integer(aa n)`, + GEN_TAC THEN REWRITE_TAC[aa; cc] THEN + MATCH_MP_TAC INTEGER_SUM THEN SIMP_TAC[INTEGER_CLOSED]);; + +let BB_INTEGER = prove + (`!n. integer(&2 * &(LCM(1..n)) pow 3 * bb n)`, + GEN_TAC THEN REWRITE_TAC[bb; REAL_ADD_LDISTRIB; GSYM SUM_LMUL] THEN + MATCH_MP_TAC INTEGER_ADD THEN CONJ_TAC THENL + [MATCH_MP_TAC INTEGER_MUL THEN REWRITE_TAC[INTEGER_CLOSED] THEN + ONCE_REWRITE_TAC[REAL_ARITH `a * b * c:real = b * a * c`] THEN + MATCH_MP_TAC INTEGER_MUL THEN REWRITE_TAC[AA_INTEGER] THEN + REWRITE_TAC[zz; GSYM SUM_LMUL] THEN MATCH_MP_TAC INTEGER_SUM THEN + X_GEN_TAC `k:num` THEN REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN + REWRITE_TAC[real_div; REAL_MUL_LID; REAL_OF_NUM_POW] THEN + REWRITE_TAC[GSYM real_div; INTEGER_DIV] THEN DISJ2_TAC THEN + MATCH_MP_TAC DIVIDES_EXP THEN ASM_SIMP_TAC[DIVIDES_LCM_NUMSEG]; + ALL_TAC] THEN + MATCH_MP_TAC INTEGER_SUM THEN X_GEN_TAC `k:num` THEN + REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN + MATCH_MP_TAC INTEGER_SUM THEN X_GEN_TAC `m:num` THEN + REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN + REWRITE_TAC[real_div] THEN ONCE_REWRITE_TAC[REAL_INV_MUL] THEN + REWRITE_TAC[REAL_ARITH + `&2 * l * (s * inv(&2) * inv y) * c = s * l * c / y`] THEN + MATCH_MP_TAC INTEGER_MUL THEN SIMP_TAC[INTEGER_CLOSED] THEN + MATCH_MP_TAC(MESON[] `!y. integer y /\ x = y ==> integer x`) THEN + EXISTS_TAC + `&(LCM (1..n)) pow 3 * + (&(binom(n,k)) * &(binom(n+k,k)) * &(binom(n-m,n-k)) * &(binom(n+k,k-m))) / + (&m pow 3 * &(binom(k,m)) pow 2)` THEN + CONJ_TAC THENL + [ONCE_REWRITE_TAC[REAL_ARITH `a * b / c:real = b * a / c`] THEN + MATCH_MP_TAC INTEGER_MUL THEN SIMP_TAC[INTEGER_CLOSED] THEN + REWRITE_TAC[real_div; REAL_INV_MUL; REAL_INV_POW] THEN + REWRITE_TAC[REAL_ARITH + `x pow 3 * y pow 3 * (z:real) pow 2 = + (x * y) * (x * y * z) * (x * y * z)`] THEN + REWRITE_TAC[GSYM REAL_INV_MUL] THEN REWRITE_TAC[GSYM real_div] THEN + MATCH_MP_TAC INTEGER_MUL THEN REWRITE_TAC[INTEGER_DIV] THEN + CONJ_TAC THENL + [DISJ2_TAC THEN MATCH_MP_TAC(NUMBER_RULE + `m * binom(k,m) divides LCM(1..n) ==> m divides LCM(1..n)`); + MATCH_MP_TAC INTEGER_MUL THEN + REWRITE_TAC[INTEGER_DIV; REAL_OF_NUM_MUL] THEN DISJ2_TAC] THEN + TRANS_TAC DIVIDES_TRANS `LCM(1..k)` THEN + ASM_SIMP_TAC[BINOM_MULTIPLE_DIVIDES_LCM] THEN + ONCE_REWRITE_TAC[PRIMEPOW_DIVISORS_DIVIDES] THEN + ASM_SIMP_TAC[IMP_CONJ; PRIMEPOW_DIVIDES_NUMSEG_LCM; LE_1] THEN + ASM_MESON_TAC[LE_TRANS]; + ALL_TAC] THEN + AP_TERM_TAC THEN REWRITE_TAC[cc] THEN REWRITE_TAC[real_div] THEN + ONCE_REWRITE_TAC[REAL_INV_MUL] THEN + ONCE_REWRITE_TAC[REAL_ARITH `a * b * c:real = b * a * c`] THEN + AP_TERM_TAC THEN REWRITE_TAC[GSYM real_div] THEN + SUBGOAL_THEN `m:num <= n` ASSUME_TAC THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[REAL_OF_NUM_BINOM; LE_ADD; + ONCE_REWRITE_RULE[ADD_SYM] LE_ADD] THEN + REPEAT(COND_CASES_TAC THENL [ALL_TAC; ASM_ARITH_TAC]) THEN + REWRITE_TAC[ADD_SUB] THEN + SUBGOAL_THEN + `n - m - (n - k):num = k - m /\ (n + k) - (k - m) = n + m` + (fun th -> REWRITE_TAC[th]) + THENL [ASM_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[real_div; REAL_INV_MUL; REAL_POW_2; REAL_INV_INV] THEN + REWRITE_TAC[ADD_SYM] THEN + MAP_EVERY (MP_TAC o C SPEC FACT_NZ) + [`k:num`; `m:num`; `n:num`; `k + n:num`; `m + n:num`; + `k - m:num`; `n - k:num`; `n - m:num`] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_EQ] THEN CONV_TAC REAL_FIELD);; + +(* ========================================================================= *) +(* *** Part 3: a_n and b_n both satisfy the same recurrence of order 2. *) +(* ========================================================================= *) + +let pp = new_definition + `pp n k = -- &4 * &k pow 4 * + (&12 * &n + &4 * &n pow 2 + &8 + &3 * &k - &2 * &k pow 2) * + (&2 * &n + &3) * cc n k`;; + +let qq = new_definition + `qq n k = (&n + &1 - &k) pow 2 * (&n + &2 - &k) pow 2`;; + +(* ------------------------------------------------------------------------- *) +(* Pointwise telescoping identity for the aa recurrence. *) +(* ------------------------------------------------------------------------- *) + +let CC_STEP_K = prove + (`!n k. cc n (k + 1) = + (&n pow 2 - &k pow 2 + &n - &k) pow 2 / (&k + &1) pow 4 * + cc n k`, + REPEAT GEN_TAC THEN REWRITE_TAC[cc; ADD_ASSOC; BINOM_BOTH_STEP_REAL] THEN + REWRITE_TAC[BINOM_BOTTOM_STEP_REAL] THEN + ONCE_REWRITE_TAC[REAL_ARITH + `(a * b) pow 2 * (c * d:real) pow 2 = + (a * c) pow 2 * b pow 2 * d pow 2`] THEN + REWRITE_TAC[REAL_ARITH + `(a / c) * (b / c):real = (a * b) * inv(c) * inv(c)`] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_POW_2] THEN + REWRITE_TAC[REAL_POW_MUL; REAL_POW_POW] THEN + CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[GSYM REAL_ADD_ASSOC] THEN + REWRITE_TAC[REAL_POW_INV; REAL_MUL_ASSOC; real_div] THEN + REAL_ARITH_TAC);; + +let CC_STEP_N = prove + (`!n k. cc (n + 1) k = + if k = n + 1 then &4 * &(binom(2 * n + 1,n + 1)) pow 2 + else (&n + &1 + &k) pow 2/ (&n + &1 - &k) pow 2 * cc n k`, + REWRITE_TAC[ARITH_RULE `2 * n + 1 = 1 + 2 * n`] THEN + REWRITE_TAC[cc; BINOM_TOP_STEP_REAL; + ARITH_RULE `(n + 1) + k = (n + k) + 1`] THEN + REPEAT GEN_TAC THEN REWRITE_TAC[ARITH_RULE `~(k = (n + k) + 1)`] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THENL + [REWRITE_TAC[REAL_POW_ONE; REAL_MUL_RID; REAL_FIELD + `((&n + &n + &1) + &1) / ((&n + &n + &1) + &1 - (&n + &1)) = &2`] THEN + REWRITE_TAC[ARITH_RULE `n + n + 1 = 1 + 2 * n`] THEN REAL_ARITH_TAC; + REWRITE_TAC[REAL_ARITH + `(x * b:real) pow 2 * (y * c) pow 2 = + (x * y) pow 2 * b pow 2 * c pow 2`] THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN + REPLICATE_TAC 2 (AP_THM_TAC THEN AP_TERM_TAC) THEN + POP_ASSUM MP_TAC THEN + REWRITE_TAC[GSYM REAL_OF_NUM_EQ; GSYM REAL_OF_NUM_ADD] THEN + CONV_TAC REAL_FIELD]);; + +let AA_LEMMA = prove + (`!n k. + k <= n + ==> ((-- &3 * &n pow 2 - &3 * &n - &n pow 3 - &1) * cc n k + + (&34 * &n pow 3 + &153 * &n pow 2 + &231 * &n + &117) * cc (n + 1) k + + (-- &n pow 3 - &6 * &n pow 2 - &12 * &n - &8) * cc (n + 2) k) * + qq n k * qq n (k + 1) = + pp n k * qq n (k + 1) - pp n (k + 1) * qq n k`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[CC_STEP_N; ARITH_RULE `n + 2 = (n + 1) + 1`] THEN + REPEAT(COND_CASES_TAC THENL [ASM_ARITH_TAC; ASM_REWRITE_TAC[]]) THEN + REWRITE_TAC[pp; qq; CC_STEP_K] THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [GSYM + REAL_OF_NUM_EQ])) THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN CONV_TAC REAL_FIELD);; + +let TELESCOPING_RATIONAL_SUM = prove + (`!a p q n. + (!k. k <= n + ==> a k * q k * q (k + 1) = p k * q(k + 1) - p(k + 1) * q k) /\ + (!k. k <= n ==> ~(p k = &0 /\ q k = &0)) + ==> sum(0..n) (\k. a k) * q 0 * q (n + 1) = + p 0 * q (n + 1) - p(n + 1) * q 0`, + REWRITE_TAC[AND_FORALL_THM; TAUT + `(p ==> r) /\ (q ==> r) <=> p \/ q ==> r`] THEN + REPLICATE_TAC 3 GEN_TAC THEN INDUCT_TAC THENL + [DISCH_THEN(MP_TAC o SPEC `0`) THEN SIMP_TAC[LE_REFL; SUM_CLAUSES_NUMSEG]; + REWRITE_TAC[LE; TAUT `p \/ q ==> r <=> (p ==> r) /\ (q ==> r)`] THEN + REWRITE_TAC[FORALL_AND_THM; FORALL_UNWIND_THM2; SUM_CLAUSES_NUMSEG] THEN + REWRITE_TAC[ADD1; ARITH_RULE `(n + 1) + 1 = n + 2`] THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o check (is_imp o concl)) THEN + ASM_REWRITE_TAC[LE_0] THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `n:num`)) THEN + REWRITE_TAC[LE_REFL] THEN REPEAT(POP_ASSUM MP_TAC) THEN + CONV_TAC REAL_RING]);; + +(* ------------------------------------------------------------------------- *) +(* Truncated form omitting the last summand. *) +(* ------------------------------------------------------------------------- *) + +let AA_LEMMA' = prove + (`!n k. + k < n + ==> ((-- &3 * &n pow 2 - &3 * &n - &n pow 3 - &1) * cc n k + + (&34 * &n pow 3 + &153 * &n pow 2 + &231 * &n + &117) * cc (n + 1) k + + (-- &n pow 3 - &6 * &n pow 2 - &12 * &n - &8) * cc (n + 2) k) * + qq n k * qq n (k + 1) = + pp n k * qq n (k + 1) - pp n (k + 1) * qq n k`, + MESON_TAC[AA_LEMMA; LT_IMP_LE]);; + +let TELESCOPING_RATIONAL_SUM' = prove + (`!a p q n. + (!k. k < n + ==> a k * q k * q (k + 1) = p k * q(k + 1) - p(k + 1) * q k) /\ + (!k. k < n ==> ~(p k = &0 /\ q k = &0)) + ==> (sum(0..n) (\k. a k) - a n) * q 0 * q n = + p 0 * q n - p n * q 0`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `n = 0` THENL + [ASM_REWRITE_TAC[SUM_CLAUSES_NUMSEG] THEN REAL_ARITH_TAC; + ASM_SIMP_TAC[ARITH_RULE `~(n = 0) ==> (k < n <=> k <= n - 1)`] THEN + ASM_SIMP_TAC[SUM_CLAUSES_RIGHT; LE_1; LE_0] THEN + DISCH_THEN(MP_TAC o MATCH_MP TELESCOPING_RATIONAL_SUM) THEN + ASM_SIMP_TAC[ARITH_RULE `~(n = 0) ==> n - 1 + 1 = n`] THEN + REAL_ARITH_TAC]);; + +(* ------------------------------------------------------------------------- *) +(* The recurrence for aa. *) +(* ------------------------------------------------------------------------- *) + +let AA_RECURRENCE = + let raw = prove + (`!n. (-- &3 * &n pow 2 - &3 * &n - &n pow 3 - &1) * aa n + + (&34 * &n pow 3 + &153 * &n pow 2 + &231 * &n + &117) * aa (n + 1) + + (-- &n pow 3 - &6 * &n pow 2 - &12 * &n - &8) * aa (n + 2) = &0`, + REPEAT STRIP_TAC THEN REWRITE_TAC[aa] THEN + REWRITE_TAC[GSYM ADD1; ARITH_RULE `n + 2 = SUC(SUC n)`] THEN + REWRITE_TAC[SUM_CLAUSES_NUMSEG; LE_0; GSYM REAL_ADD_ASSOC] THEN + REWRITE_TAC[REAL_ARITH + `a * s1 + b * (s2 + x) + c * (s3 + y + z):real = + (a * s1 + b * s2 + c * s3) + (b * x + c * y + c * z)`] THEN + REWRITE_TAC[GSYM SUM_LMUL; GSYM SUM_ADD_NUMSEG] THEN + REWRITE_TAC[ADD1; ARITH_RULE `(n + 1) + 1 = n + 2`] THEN + MP_TAC(MATCH_MP (ONCE_REWRITE_RULE[IMP_CONJ] TELESCOPING_RATIONAL_SUM') + (SPEC `n:num` AA_LEMMA')) THEN + ANTS_TAC THENL + [REWRITE_TAC[pp; qq; REAL_ENTIRE; REAL_POW_EQ_0; ARITH; REAL_OF_NUM_EQ] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_EQ; GSYM REAL_OF_NUM_LT] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[pp; qq] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_RZERO; + REAL_ARITH `x + y - x:real = y`] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[REAL_RING + `x * ((&n + &1) pow 2 * (&n + &2) pow 2) * &4 = + &0 - y * (&n + &1) pow 2 * (&n + &2) pow 2 <=> + (x + y / &4) * (&n + &1) pow 2 * (&n + &2) pow 2 = &0`] THEN + REWRITE_TAC[REAL_ENTIRE; REAL_POW_EQ_0; + REAL_ARITH `~(&n + &1 = &0) /\ ~(&n + &2 = &0)`] THEN + REWRITE_TAC[REAL_ARITH + `(s - a) + (-- &4 * x) / &4 = &0 <=> s = a + x`] THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[REAL_ARITH + `(a * cn + b * cn1 + c * cn2) + x * y * z * cn:real = + (a + x * y * z) * cn + b * cn1 + c * cn2`] THEN + REWRITE_TAC[cc; BINOM_REFL] THEN + REWRITE_TAC[num_CONV `2`; num_CONV `1`; ADD_CLAUSES] THEN + REWRITE_TAC[ARITH_RULE `n + n = 2 * n`] THEN + CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[ADD1; BINOM_TOP_STEP_REAL; BINOM_BOTTOM_STEP_REAL] THEN + ASM_CASES_TAC `n = 0` THENL + [ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[BINOM_REFL] THEN + CONV_TAC REAL_RAT_REDUCE_CONV; + ALL_TAC] THEN + ASM_CASES_TAC `n = 1` THENL + [ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[num_CONV `2`; num_CONV `1`; BINOM] THEN + CONV_TAC NUM_REDUCE_CONV THEN + CONV_TAC REAL_RAT_REDUCE_CONV; + ALL_TAC] THEN + REPEAT(COND_CASES_TAC THENL + [TRY(FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (TAUT `p ==> ~p ==> q`)) THEN + ASM_ARITH_TAC); + ASM_REWRITE_TAC[] THEN POP_ASSUM(K ALL_TAC)]) THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN + UNDISCH_TAC `~(n = 0)` THEN UNDISCH_TAC `~(n = 1)` THEN + REWRITE_TAC[GSYM REAL_OF_NUM_EQ] THEN + REWRITE_TAC[BINOM_REFL] THEN + W(fun (asl,w) -> + REWRITE_TAC(map (REAL_POLY_CONV o rand) + (find_terms (is_binop `(/):real->real->real`) w))) THEN + CONV_TAC REAL_FIELD) in + prove + (`!n. (&n + &2) pow 3 * aa(n + 2) - + (&2 * &n + &3) * (&17 * &n pow 2 + &51 * &n + &39) * aa(n + 1) + + (&n + &1) pow 3 * aa(n) = &0`, + MP_TAC raw THEN MATCH_MP_TAC MONO_FORALL THEN CONV_TAC REAL_RING);; + +(* ------------------------------------------------------------------------- *) +(* Split bb n = aa n * zz n + ww n. Here ss is the inner harmonic sum in *) +(* BB_ALT and ww = sum_{k=0}^n cc(n,k) * ss(n,k). The order-4 operator *) +(* below is shown to annihilate both aa * zz and ww; its factorisation then *) +(* yields the order-2 recurrence for bb. *) +(* ------------------------------------------------------------------------- *) + +let ss = new_definition + `ss n k = sum(1..k) (\m. --(&1) pow (m - 1) / + (&2 * &m pow 3 * &(binom(n+m,m)) * &(binom(n,m))))`;; + +let ww = new_definition + `ww n = sum(0..n) (\k. cc n k * ss n k)`;; + +(* ------------------------------------------------------------------------- *) +(* Contiguity for the harmonic summand and partial sum ss. The single term *) +(* d_term n m has a clean n-shift, yielding the mixed (n,k)-contiguity *) +(* SS_SNSK. *) +(* ------------------------------------------------------------------------- *) + +let d_term = new_definition + `d_term n m = --(&1) pow (m - 1) / + (&2 * &m pow 3 * &(binom(n+m,m)) * &(binom(n,m)))`;; + +let D_STEP_N = prove + (`!n m. 1 <= m /\ m <= n + ==> d_term (n+1) m = (&n + &1 - &m) / (&n + &1 + &m) * d_term n m`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&m <= &n /\ &1 <= &m` STRIP_ASSUME_TAC THENL + [ASM_REWRITE_TAC[REAL_OF_NUM_LE]; ALL_TAC] THEN + REWRITE_TAC[d_term] THEN + SUBGOAL_THEN `(n + 1) + m = (n + m) + 1` SUBST1_TAC THENL [ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPECL [`n+m:num`; `m:num`] BINOM_TOP_STEP_REAL) THEN + MP_TAC(ISPECL [`n:num`; `m:num`] BINOM_TOP_STEP_REAL) THEN + REWRITE_TAC[ARITH_RULE `~(m = (n + m) + 1)`] THEN + ASM_SIMP_TAC[ARITH_RULE `m <= n ==> ~(m = n + 1)`] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN + SUBGOAL_THEN `~(&n + &1 - &m = &0) /\ ~(&n + &1 + &m = &0) /\ + ~((&n + &m) + &1 - &m = &0) /\ + ~(&(binom(n+m,m)) = &0) /\ ~(&(binom(n,m)) = &0) /\ ~(&m = &0)` + STRIP_ASSUME_TAC THENL + [REPEAT CONJ_TAC THEN + TRY(REWRITE_TAC[REAL_OF_NUM_EQ; BINOM_EQ_0; NOT_LT] THEN ASM_ARITH_TAC) THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + REPEAT(DISCH_THEN(fun th -> REWRITE_TAC[th])) THEN CONV_TAC REAL_FIELD);; + +let SS_AS_DTERM = prove + (`!n k. ss n k = sum(1..k) (\m. d_term n m)`, + REWRITE_TAC[ss; d_term]);; + +let SS_DIFF_K = prove + (`!n k. ss n (k+1) = ss n k + d_term n (k+1)`, + REPEAT GEN_TAC THEN REWRITE_TAC[SS_AS_DTERM] THEN + SUBGOAL_THEN `k + 1 = SUC k` SUBST1_TAC THENL [ARITH_TAC; ALL_TAC] THEN + SIMP_TAC[SUM_CLAUSES_NUMSEG; ARITH_RULE `1 <= SUC k`] THEN REWRITE_TAC[ADD1]);; + +let SS_SNSK = prove + (`!n k. k < n + ==> ss (n+1) (k+1) = + (-- &n + &k) / (&n + &2 + &k) * ss n k + ss (n+1) k + + (&n - &k) / (&n + &2 + &k) * ss n (k+1)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[SS_DIFF_K] THEN + MP_TAC(SPECL [`n:num`; `k+1`] D_STEP_N) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; DISCH_THEN SUBST1_TAC] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN + SUBGOAL_THEN `~(&n + &2 + &k = &0)` MP_TAC THENL + [REAL_ARITH_TAC; CONV_TAC REAL_FIELD]);; + +let BB_AS_AAZZ_WW = prove + (`!n. bb n = aa n * zz n + ww n`, + GEN_TAC THEN REWRITE_TAC[BB_ALT; ww; aa] THEN + REWRITE_TAC[GSYM SUM_RMUL; GSYM SUM_ADD_NUMSEG] THEN + MATCH_MP_TAC SUM_EQ_NUMSEG THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN + REWRITE_TAC[cc; ss; REAL_ADD_LDISTRIB] THEN + BINOP_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[GSYM SUM_LMUL] THEN + MATCH_MP_TAC SUM_EQ_NUMSEG THEN X_GEN_TAC `m:num` THEN STRIP_TAC THEN + REWRITE_TAC[] THEN REAL_ARITH_TAC);; + +let ZZ_STEP = prove + (`!n. zz(n + 1) = zz n + &1 / &(n + 1) pow 3`, + GEN_TAC THEN REWRITE_TAC[zz] THEN + SUBGOAL_THEN `n + 1 = SUC n` SUBST1_TAC THENL [ARITH_TAC; ALL_TAC] THEN + SIMP_TAC[SUM_CLAUSES_NUMSEG; ARITH_RULE `1 <= SUC n`] THEN REWRITE_TAC[ADD1]);; + +(* ------------------------------------------------------------------------- *) +(* The b-recurrence via the Apery operator factorisation P_flat = M o L. *) +(* *) +(* L is the order-2 Apery operator, whose vanishing on bb is the goal. The *) +(* order-4 operator P_flat, recorded in include/ann_v.v and used in *) +(* theories/ops_for_b.v of the Coq development cited above, factors as the *) +(* composite M o L for an explicit order-2 M with polynomial coefficients *) +(* m0c,m1c,m2c. Since P_flat[bb] = 0, this gives M[L bb] = 0. As L bb *) +(* vanishes at n = 0,1 and m2c is never zero, this forces L bb = 0. *) +(* ------------------------------------------------------------------------- *) + +(* Harrison's original prelude relies on type inference, so enable this only *) +(* for the new development below. *) +type_invention_error := true;; + +let lop = new_definition + `lop (f:num->real) n = (&n + &2) pow 3 * f(n+2) - + (&2 * &n + &3) * (&17 * &n pow 2 + &51 * &n + &39) * f(n+1) + + (&n + &1) pow 3 * f(n)`;; + +(* Salvy's order-4 creative-telescoping operator for the bb summand. *) +let pflat = new_definition + `pflat (f:num->real) n = + (&2 * &n + &7) * + (&928 + &1266 * &n + &643 * &n pow 2 + &144 * &n pow 3 + &12 * &n pow 4) * + (&n + &1) pow 6 * f n + + (--(&1) * (&2 * &n + &3) * (&2 * &n + &7) * + (&408 * &n pow 9 + &7956 * &n pow 8 + &68086 * &n pow 7 + &336284 * &n pow 6 + + &1058890 * &n pow 5 + &2209767 * &n pow 4 + &3063206 * &n pow 3 + + &2724789 * &n pow 2 + &1413006 * &n + &325664)) * f(n+1) + + (&2 * &n + &5) * + (&13896 * &n pow 10 + &347400 * &n pow 9 + &3868998 * &n pow 8 + + &25269960 * &n pow 7 + &107159724 * &n pow 6 + &308199360 * &n pow 5 + + &608681313 * &n pow 4 + &814935630 * &n pow 3 + &707785777 * &n pow 2 + + &360083510 * &n + &81495208) * f(n+2) + + (--(&1) * (&2 * &n + &3) * (&2 * &n + &7) * + (&408 * &n pow 9 + &10404 * &n pow 8 + &117046 * &n pow 7 + &761526 * &n pow 6 + + &3153520 * &n pow 5 + &8607233 * &n pow 4 + &15461616 * &n pow 3 + + &17602001 * &n pow 2 + &11509566 * &n + &3291016)) * f(n+3) + + (&2 * &n + &3) * + (&12 * &n pow 4 + &96 * &n pow 3 + &283 * &n pow 2 + &364 * &n + &173) * + (&n + &4) pow 6 * f(n+4)`;; + +(* The order-2 "reducer" M coefficients. *) +let m0c = new_definition + `m0c n = (&n + &1) pow 3 * (&2 * &n + &7) * + (&12 * &n pow 4 + &144 * &n pow 3 + &643 * &n pow 2 + &1266 * &n + &928)`;; +let m1c = new_definition + `m1c n = --(&1) * (&2 * &n + &3) * (&2 * &n + &7) * + (&204 * &n pow 6 + &3060 * &n pow 5 + &18743 * &n pow 4 + &59930 * &n pow 3 + + &105413 * &n pow 2 + &96690 * &n + &36184)`;; +let m2c = new_definition + `m2c n = (&n + &4) pow 3 * (&2 * &n + &3) * + (&12 * &n pow 4 + &96 * &n pow 3 + &283 * &n pow 2 + &364 * &n + &173)`;; + +(* P_flat = M o L : a pure polynomial operator identity. *) +let MOL_FACTOR = prove + (`!f n. pflat f n = m0c n * lop f n + m1c n * lop f (n+1) + m2c n * lop f (n+2)`, + REPEAT GEN_TAC THEN REWRITE_TAC[pflat; lop; m0c; m1c; m2c] THEN + REWRITE_TAC[ARITH_RULE `(n+1)+2 = n+3`; ARITH_RULE `(n+1)+1 = n+2`; + ARITH_RULE `(n+2)+2 = n+4`; ARITH_RULE `(n+2)+1 = n+3`; + GSYM REAL_OF_NUM_ADD] THEN + CONV_TAC REAL_RING);; + +let M2C_NONZERO = prove + (`!n. ~(m2c n = &0)`, + GEN_TAC THEN REWRITE_TAC[m2c; REAL_ENTIRE; DE_MORGAN_THM] THEN + REPEAT CONJ_TAC THEN MATCH_MP_TAC(REAL_ARITH `&0 < x ==> ~(x = &0)`) THENL + [MATCH_MP_TAC REAL_POW_LT THEN REAL_ARITH_TAC; + REAL_ARITH_TAC; + MATCH_MP_TAC(REAL_ARITH + `&0 <= &12 * x pow 4 /\ &0 <= &96 * x pow 3 /\ &0 <= &283 * x pow 2 /\ &0 <= &364 * x + ==> &0 < &12 * x pow 4 + &96 * x pow 3 + &283 * x pow 2 + &364 * x + &173`) THEN + REPEAT CONJ_TAC THEN MATCH_MP_TAC REAL_LE_MUL THEN + REWRITE_TAC[REAL_POS] THEN SIMP_TAC[REAL_POW_LE; REAL_POS]]);; + +(* A sequence killed by M and zero at 0 and 1 vanishes, since m2c is never *) +(* zero. *) +let M_KERNEL_TRIVIAL = prove + (`!g:num->real. (!n. m0c n * g n + m1c n * g(n+1) + m2c n * g(n+2) = &0) /\ + g 0 = &0 /\ g 1 = &0 + ==> !n. g n = &0`, + GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC STRIP_ASSUME_TAC) THEN + MATCH_MP_TAC num_WF THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `n = 1` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `g (n - 2):real = &0 /\ g (n - 1):real = &0` STRIP_ASSUME_TAC THENL + [CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; ALL_TAC] THEN + FIRST_X_ASSUM(fun th -> + if can (fun () -> find_term (fun t -> + (try fst(dest_const(fst(strip_comb t)))="m0c" with _ -> false)) (concl th)) () + then MP_TAC(SPEC `n - 2` th) else fail()) THEN + SUBGOAL_THEN `n - 2 + 1 = n - 1 /\ n - 2 + 2 = n` (fun th -> REWRITE_TAC[th]) THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[REAL_MUL_RZERO; REAL_ADD_LID; REAL_ADD_RID] THEN + REWRITE_TAC[REAL_ENTIRE; M2C_NONZERO]);; + +(* Base cases: L bb vanishes at 0 and 1 (finite evaluation of bb 0..3). *) +let LOP_BB_0 = prove + (`lop bb 0 = &0`, + REWRITE_TAC[lop] THEN CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[bb; aa; cc; zz; GSYM ADD1] THEN + REWRITE_TAC[num_CONV `2`; num_CONV `1`; SUM_CLAUSES_NUMSEG] THEN + CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[num_CONV `2`; num_CONV `1`; BINOM] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RAT_REDUCE_CONV);; + +let LOP_BB_1 = prove + (`lop bb 1 = &0`, + REWRITE_TAC[lop] THEN CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[bb; aa; cc; zz; GSYM ADD1] THEN + REWRITE_TAC[num_CONV `3`; num_CONV `2`; num_CONV `1`; SUM_CLAUSES_NUMSEG] THEN + CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[num_CONV `3`; num_CONV `2`; num_CONV `1`; BINOM] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RAT_REDUCE_CONV);; + +(* ------------------------------------------------------------------------- *) +(* PFLAT decomposes over bb = aa*zz + ww. The aa*zz part is killed *) +(* algebraically using P_flat = M o L and AA_RECURRENCE. The harmonic kernel *) +(* P_flat[ww] is handled by creative telescoping below. *) +(* ------------------------------------------------------------------------- *) + +let LOP_AAZZ = prove + (`!n. lop (\m. aa m * zz m) n = + (&n + &2) pow 3 * aa(n+2) / (&n + &1) pow 3 + aa(n+2) - + (&2 * &n + &3) * (&17 * &n pow 2 + &51 * &n + &39) * aa(n+1) / (&n + &1) pow 3`, + GEN_TAC THEN REWRITE_TAC[lop] THEN BETA_TAC THEN + MP_TAC(SPEC `n:num` AA_RECURRENCE) THEN + REWRITE_TAC[ARITH_RULE `n + 2 = (n + 1) + 1`; ZZ_STEP; + GSYM REAL_OF_NUM_ADD] THEN + SUBGOAL_THEN `~(&n + &1 = &0) /\ ~(&n + &2 = &0)` MP_TAC THENL + [REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC; ALL_TAC] THEN + CONV_TAC REAL_FIELD);; + +(* The aa 3-term recurrence in the explicit (m+2)^3-leading form, at row m. *) +let AA_REC_ROW = prove + (`!m. (&m + &2) pow 3 * aa(m+2) = + (&2 * &m + &3) * (&17 * &m pow 2 + &51 * &m + &39) * aa(m+1) - + (&m + &1) pow 3 * aa(m)`, + GEN_TAC THEN MP_TAC(SPEC `m:num` AA_RECURRENCE) THEN + REWRITE_TAC[ARITH_RULE `(m+1)+1 = m+2`] THEN REAL_ARITH_TAC);; + +(* P_flat[aa*zz] = 0 follows from MOL_FACTOR and LOP_AAZZ at three rows, *) +(* together with the aa recurrence at the same rows. *) +let PFLAT_AAZZ = prove + (`!n. pflat (\m. aa m * zz m) n = &0`, + GEN_TAC THEN REWRITE_TAC[MOL_FACTOR] THEN + REWRITE_TAC[LOP_AAZZ; ARITH_RULE `(n+1)+1 = n+2`; ARITH_RULE `(n+2)+1 = n+3`; + ARITH_RULE `(n+1)+2 = n+3`; ARITH_RULE `(n+2)+2 = n+4`] THEN + REWRITE_TAC[m0c; m1c; m2c] THEN + MP_TAC(SPEC `n:num` AA_REC_ROW) THEN + MP_TAC(SPEC `n+1` AA_REC_ROW) THEN + MP_TAC(SPEC `n+2` AA_REC_ROW) THEN + REWRITE_TAC[ARITH_RULE `(n+1)+1 = n+2`; ARITH_RULE `(n+1)+2 = n+3`; + ARITH_RULE `(n+2)+1 = n+3`; ARITH_RULE `(n+2)+2 = n+4`; + GSYM REAL_OF_NUM_ADD] THEN + SUBGOAL_THEN `~(&n + &1 = &0) /\ ~(&n + &2 = &0) /\ ~(&n + &3 = &0)` + MP_TAC THENL + [REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC; ALL_TAC] THEN + REPEAT(DISCH_THEN(fun th -> if is_imp(concl th) then ALL_TAC else + ASSUME_TAC th) ORELSE STRIP_TAC) THEN + POP_ASSUM_LIST(MP_TAC o end_itlist CONJ) THEN + CONV_TAC REAL_FIELD);; + +(* The harmonic kernel uses order-2 recurrences for vv = cc * ss and the *) +(* degree-20 certificate Q_flat recorded in include/ann_v.v. Its interior *) +(* identity is checked below by triangular rational reduction; the boundary *) +(* is handled separately. *) +prioritize_real();; + +(* ---- ss order-2 recurrences (D_STEP_K, SS_SK2, SS_SN2) ---- *) +let D_STEP_K = prove + (`!n m. 1 <= m /\ m + 1 <= n + ==> d_term n (m+1) = + --(&m pow 3) / ((&m + &1) * (&n + &m + &1) * (&n - &m)) * d_term n m`, + REPEAT STRIP_TAC THEN REWRITE_TAC[d_term] THEN + SUBGOAL_THEN `(m + 1) - 1 = SUC(m - 1)` SUBST1_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[real_pow] THEN + SUBGOAL_THEN `n + m + 1 = (n + m) + 1` SUBST1_TAC THENL [ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPECL [`n + m:num`; `m:num`] BINOM_BOTH_STEP_REAL) THEN + MP_TAC(ISPECL [`n:num`; `m:num`] BINOM_BOTTOM_STEP_REAL) THEN + DISCH_THEN SUBST1_TAC THEN DISCH_THEN SUBST1_TAC THEN + SUBGOAL_THEN `&m < &n /\ &1 <= &m` STRIP_ASSUME_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_LT; REAL_OF_NUM_LE] THEN ASM_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN + REWRITE_TAC[REAL_ARITH `(&n + &m) + &1 = &n + &m + &1`] THEN + SUBGOAL_THEN + `~(&(binom(n+m,m)) = &0) /\ ~(&(binom(n,m)) = &0) /\ + ~(&m + &1 = &0) /\ ~(&n - &m = &0) /\ ~(&n + &m + &1 = &0) /\ ~(&m = &0)` + MP_TAC THENL + [REPEAT CONJ_TAC THEN + TRY(REWRITE_TAC[REAL_OF_NUM_EQ; BINOM_EQ_0; NOT_LT] THEN ASM_ARITH_TAC) THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN CONV_TAC REAL_FIELD]);; + +(* The order-2 k-recurrence recorded as Sk2 in annotated_recs_s.v. *) +let SS_SK2 = prove + (`!n k. k + 1 < n + ==> ss n (k+2) = + (--(&1) * (&k + &1) pow 3) / + ((&k + &2) * (&n + &2 + &k) * (--(&n) + &k + &1)) * ss n k + + (&2 * &k pow 3 + &8 * &k pow 2 + &11 * &k + &5 - &k * &n - &k * &n pow 2 - + &2 * &n pow 2 - &2 * &n) / + ((&k + &2) * (&n + &2 + &k) * (--(&n) + &k + &1)) * ss n (k+1)`, + REPEAT STRIP_TAC THEN + SUBST1_TAC(ARITH_RULE `k + 2 = (k + 1) + 1`) THEN + REWRITE_TAC[SS_DIFF_K] THEN + MP_TAC(SPECL [`n:num`; `k+1`] D_STEP_K) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[ARITH_RULE `(k+1)+1 = k+2`] THEN + SUBGOAL_THEN `&(k + 1) = &k + &1` SUBST1_TAC THENL + [REWRITE_TAC[GSYM REAL_OF_NUM_ADD]; ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN + SUBGOAL_THEN + `~(&k + &2 = &0) /\ ~(&n + &2 + &k = &0) /\ ~(--(&n) + &k + &1 = &0) /\ + ~((&k + &1) + &1 = &0)` + MP_TAC THENL + [REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN + SUBGOAL_THEN `&k + &1 < &n` MP_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LT] THEN ASM_ARITH_TAC; + REAL_ARITH_TAC]; + REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN CONV_TAC REAL_FIELD]);; + +(* ------------------------------------------------------------------------- *) +(* SS_SN2 (order 2 in n) replaces the full d-tower of the Coq proof with a *) +(* direct m-telescoping certificate. For R from D_STEP_K, solve *) +(* rho(m) = sigma(m + 1) R(m) - sigma(m). The lower boundary sigma(n,1) *) +(* vanishes and sigma(n,k + 1) = c01(n,k), so summing gives SS_SN2. Its *) +(* c00, c10 and c01 coefficients are those of s_Sn2 in annotated_recs_s.v. *) +(* ------------------------------------------------------------------------- *) + +(* The k-independent m-telescoping certificate for SS_SN2. *) +let SIGMA_DEF = new_definition + `sigma_s n m = ((&4 * &n + &6) / (&n + &2) pow 3 * &m pow 3 - (&4 * &n + &6) / (&n + &2) pow 2 * &m pow 2 + (&4 * &n pow 2 + &10 * &n + &6) / (&n + &2) pow 3 * &m) / (&n + &m + &1)`;; + +(* Reduce d(n+1,m), d(n+2,m) and d(n,m+1) to d_term n m using D_STEP_N and *) +(* D_STEP_K. REAL_FIELD then treats d_term n m as an atom. *) +let SSN2_SUMMAND = prove + (`!n k m. 1 <= m /\ m <= k /\ k < n ==> ((((--(&2) - &9 * &n pow 2 + &3 * &k * &n - &6 * &k pow 2 - &n pow 4 - &5 * &n pow 3 - &6 * &k pow 3 - &k * &n pow 3 + &k * &n pow 2 + &4 * &k pow 2 * &n pow 2 + &2 * &k pow 2 * &n - &4 * &k pow 3 * &n - &k - &7 * &n) / ((&n + &2) pow 3 * (&n + &2 + &k))) + (&2 * &k * (&2 * &n + &3) * (&k + &1) * (--(&n) + &k) / ((&n + &2) pow 3 * (&n + &2 + &k)))) * d_term n m + ((&2 * &n + &3) * (&n pow 2 + &3 * &n + &3) / (&n + &2) pow 3) * d_term (n+1) m - d_term (n+2) m = sigma_s n m * d_term n m - sigma_s n (m+1) * d_term n (m+1))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[SIGMA_DEF] THEN + SUBGOAL_THEN `d_term (n+1) m = (&n + &1 - &m) / (&n + &1 + &m) * d_term n m` + SUBST1_TAC THENL [MATCH_MP_TAC D_STEP_N THEN ASM_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `d_term (n+2) m = (&n + &2 - &m) / (&n + &2 + &m) * ((&n + &1 - &m) / (&n + &1 + &m) * d_term n m)` + SUBST1_TAC THENL + [SUBST1_TAC(ARITH_RULE `n + 2 = (n + 1) + 1`) THEN + MP_TAC(SPECL [`n+1`; `m:num`] D_STEP_N) THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN + MP_TAC(SPECL [`n:num`; `m:num`] D_STEP_N) THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `d_term n (m+1) = --(&m pow 3) / ((&m + &1) * (&n + &m + &1) * (&n - &m)) * d_term n m` + SUBST1_TAC THENL [MATCH_MP_TAC D_STEP_K THEN ASM_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN + SUBGOAL_THEN + `~(&n + &2 = &0) /\ ~(&n + &2 + &k = &0) /\ ~(&n + &1 + &m = &0) /\ ~(&n + &2 + &m = &0) /\ ~(&m + &1 = &0) /\ ~(&n + &m + &1 = &0) /\ ~(&n - &m = &0) /\ ~(&n + (&m + &1) + &1 = &0)` + MP_TAC THENL + [SUBGOAL_THEN `&m < &n` ASSUME_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_LT] THEN ASM_ARITH_TAC; ALL_TAC] THEN + REPEAT CONJ_TAC THEN ASM_REAL_ARITH_TAC; + CONV_TAC REAL_FIELD]);; + +let SIGMA_1 = prove + (`!n. sigma_s n 1 = &0`, + GEN_TAC THEN REWRITE_TAC[SIGMA_DEF] THEN + SUBGOAL_THEN `~(&n + &2 = &0) /\ ~(&n + &1 + &1 = &0)` MP_TAC THENL + [REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC; + REWRITE_TAC[REAL_MUL_RID; REAL_POW_ONE] THEN CONV_TAC REAL_FIELD]);; + +let SIGMA_KP1 = prove + (`!n k. sigma_s n (k+1) = &2 * &k * (&2 * &n + &3) * (&k + &1) * (--(&n) + &k) / ((&n + &2) pow 3 * (&n + &2 + &k))`, + REPEAT GEN_TAC THEN REWRITE_TAC[SIGMA_DEF] THEN + SUBGOAL_THEN `~(&n + &2 = &0) /\ ~(&n + (&k + &1) + &1 = &0) /\ ~(&n + &2 + &k = &0)` MP_TAC THENL + [REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN + SUBGOAL_THEN `&0 <= &n /\ &0 <= &k` MP_TAC THENL + [REWRITE_TAC[REAL_POS]; REAL_ARITH_TAC]; + REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN CONV_TAC REAL_FIELD]);; + +(* Sum the per-m identity over m=1..k. The right side telescopes, and the *) +(* boundary terms are SIGMA_1 and SIGMA_KP1. *) +let SSN2_SUMEQ = prove + (`!n k. 1 <= k /\ k < n ==> sum(1..k) (\m. (((--(&2) - &9 * &n pow 2 + &3 * &k * &n - &6 * &k pow 2 - &n pow 4 - &5 * &n pow 3 - &6 * &k pow 3 - &k * &n pow 3 + &k * &n pow 2 + &4 * &k pow 2 * &n pow 2 + &2 * &k pow 2 * &n - &4 * &k pow 3 * &n - &k - &7 * &n) / ((&n + &2) pow 3 * (&n + &2 + &k))) + (&2 * &k * (&2 * &n + &3) * (&k + &1) * (--(&n) + &k) / ((&n + &2) pow 3 * (&n + &2 + &k)))) * d_term n m + ((&2 * &n + &3) * (&n pow 2 + &3 * &n + &3) / (&n + &2) pow 3) * d_term (n+1) m - d_term (n+2) m) = sum(1..k) (\m. sigma_s n m * d_term n m - sigma_s n (m+1) * d_term n (m+1))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN REPEAT STRIP_TAC THEN BETA_TAC THEN + MATCH_MP_TAC SSN2_SUMMAND THEN ASM_ARITH_TAC);; + +let SSN2_LHS = prove + (`!n k. sum(1..k) (\m. (((--(&2) - &9 * &n pow 2 + &3 * &k * &n - &6 * &k pow 2 - &n pow 4 - &5 * &n pow 3 - &6 * &k pow 3 - &k * &n pow 3 + &k * &n pow 2 + &4 * &k pow 2 * &n pow 2 + &2 * &k pow 2 * &n - &4 * &k pow 3 * &n - &k - &7 * &n) / ((&n + &2) pow 3 * (&n + &2 + &k))) + (&2 * &k * (&2 * &n + &3) * (&k + &1) * (--(&n) + &k) / ((&n + &2) pow 3 * (&n + &2 + &k)))) * d_term n m + ((&2 * &n + &3) * (&n pow 2 + &3 * &n + &3) / (&n + &2) pow 3) * d_term (n+1) m - d_term (n+2) m) = (((--(&2) - &9 * &n pow 2 + &3 * &k * &n - &6 * &k pow 2 - &n pow 4 - &5 * &n pow 3 - &6 * &k pow 3 - &k * &n pow 3 + &k * &n pow 2 + &4 * &k pow 2 * &n pow 2 + &2 * &k pow 2 * &n - &4 * &k pow 3 * &n - &k - &7 * &n) / ((&n + &2) pow 3 * (&n + &2 + &k))) + (&2 * &k * (&2 * &n + &3) * (&k + &1) * (--(&n) + &k) / ((&n + &2) pow 3 * (&n + &2 + &k)))) * ss n k + ((&2 * &n + &3) * (&n pow 2 + &3 * &n + &3) / (&n + &2) pow 3) * ss (n+1) k - ss (n+2) k`, + REPEAT GEN_TAC THEN REWRITE_TAC[SUM_SUB_NUMSEG; SUM_ADD_NUMSEG; SUM_LMUL] THEN + REWRITE_TAC[GSYM SS_AS_DTERM]);; + +let SS_SN2 = prove + (`!n k. 1 <= k /\ k < n ==> ss (n+2) k = ((--(&2) - &9 * &n pow 2 + &3 * &k * &n - &6 * &k pow 2 - &n pow 4 - &5 * &n pow 3 - &6 * &k pow 3 - &k * &n pow 3 + &k * &n pow 2 + &4 * &k pow 2 * &n pow 2 + &2 * &k pow 2 * &n - &4 * &k pow 3 * &n - &k - &7 * &n) / ((&n + &2) pow 3 * (&n + &2 + &k))) * ss n k + ((&2 * &n + &3) * (&n pow 2 + &3 * &n + &3) / (&n + &2) pow 3) * ss (n+1) k + (&2 * &k * (&2 * &n + &3) * (&k + &1) * (--(&n) + &k) / ((&n + &2) pow 3 * (&n + &2 + &k))) * ss n (k+1)`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`n:num`; `k:num`] SSN2_SUMEQ) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[SSN2_LHS] THEN + MP_TAC(SPECL [`1`; `k:num`] + (INST [`\m. sigma_s n m * d_term n m`,`f:num->real`] SUM_DIFFS)) THEN + ASM_REWRITE_TAC[] THEN BETA_TAC THEN + DISCH_THEN(fun th -> DISCH_THEN(MP_TAC o CONV_RULE(RAND_CONV(REWRITE_CONV[th])))) THEN + REWRITE_TAC[SIGMA_1; SIGMA_KP1; REAL_MUL_LZERO; REAL_SUB_LZERO] THEN + REWRITE_TAC[SS_DIFF_K] THEN REWRITE_TAC[REAL_ADD_LDISTRIB] THEN + DISCH_THEN(fun th -> MP_TAC th) THEN REAL_ARITH_TAC);; + +(* ---- v=cc*ss recurrences (vv, V_SK2, V_SNSK, V_SN2) ---- *) +let vv = new_definition `vv n k = cc n k * ss n k`;; + +(* The order-2 k-recurrence recorded as Sk2 in include/ann_v.v. *) +let V_SK2 = prove + (`!n k. k + 1 < n ==> vv n (k+2) = (--(&1) * (&n + &2 + &k) * (--(&n) + &k + &1) * (&n + &1 + &k) pow 2 * (--(&n) + &k) pow 2 / ((&k + &1) * (&k + &2) pow 5)) * vv n k + ((&n + &2 + &k) * (--(&n) + &k + &1) * (&2 * &k pow 3 + &8 * &k pow 2 + &11 * &k + &5 - &k * &n - &k * &n pow 2 - &2 * &n pow 2 - &2 * &n) / (&k + &2) pow 5) * vv n (k+1)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[vv] THEN + MP_TAC(SPECL[`n:num`;`k:num`] SS_SK2) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + SUBST1_TAC(ARITH_RULE `k + 2 = (k + 1) + 1`) THEN REWRITE_TAC[CC_STEP_K] THEN + MP_TAC(SPECL[`n:num`;`k+1`] CC_STEP_K) THEN REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + MP_TAC(SPECL[`n:num`;`k:num`] CC_STEP_K) THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN + SUBGOAL_THEN `~(&k + &1 = &0) /\ ~(&k + &2 = &0) /\ ~(&n + &2 + &k = &0) /\ ~(--(&n) + &k + &1 = &0)` MP_TAC THENL + [REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN + SUBGOAL_THEN `&k + &1 < &n` MP_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LT] THEN ASM_ARITH_TAC; REAL_ARITH_TAC]; + REWRITE_TAC[GSYM REAL_OF_NUM_ADD; REAL_ARITH `(&k + &1) + &1 = &k + &2`] THEN CONV_TAC REAL_FIELD]);; + +(* Clean cc ratio helpers for k < n, avoiding the conditional in CC_STEP_N. *) +let CC_NR = prove + (`!n k. k < n ==> cc (n+1) k = (&n + &1 + &k) pow 2 / (&n + &1 - &k) pow 2 * cc n k`, + REPEAT STRIP_TAC THEN REWRITE_TAC[CC_STEP_N] THEN COND_CASES_TAC THENL [ASM_ARITH_TAC; REWRITE_TAC[]]);; + +let CC_N2R = prove + (`!n k. k < n ==> cc (n+2) k = (&n + &2 + &k) pow 2 / (&n + &2 - &k) pow 2 * ((&n + &1 + &k) pow 2 / (&n + &1 - &k) pow 2 * cc n k)`, + REPEAT STRIP_TAC THEN SUBST1_TAC(ARITH_RULE `n + 2 = (n + 1) + 1`) THEN + MP_TAC(SPECL[`n+1`;`k:num`] CC_NR) THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN MP_TAC(SPECL[`n:num`;`k:num`] CC_NR) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN + REWRITE_TAC[REAL_ARITH `(&n + &1) + &1 = &n + &2`; REAL_ARITH `(&n + &1) + &1 + &k = &n + &2 + &k`; + REAL_ARITH `(&n + &1) + &1 - &k = &n + &2 - &k`]);; + +(* V_SNSK is order 2 in (n,k). Reduce the cc ratios to cc n k and use *) +(* SS_SNSK; the remaining atoms are ss n k, ss(n+1) k and ss n (k+1). *) +let V_SNSK = prove + (`!n k. k < n ==> vv (n+1) (k+1) = ((&n + &2 + &k) * (--(&n) + &k) * (&n + &1 + &k) pow 2 / (&k + &1) pow 4) * vv n k + ((&n + &2 + &k) pow 2 * (--(&n) - &1 + &k) pow 2 / (&k + &1) pow 4) * vv (n+1) k + ((--(&n) - &2 - &k) / (--(&n) + &k)) * vv n (k+1)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[vv] THEN + MP_TAC(SPECL[`n:num`;`k:num`] SS_SNSK) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[CC_STEP_K] THEN + MP_TAC(SPECL[`n:num`;`k:num`] CC_NR) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[CC_STEP_K; GSYM REAL_OF_NUM_ADD] THEN + SUBGOAL_THEN `~(&k + &1 = &0) /\ ~(&n + &2 + &k = &0) /\ ~(&n + &1 - &k = &0) /\ ~(--(&n) + &k = &0)` MP_TAC THENL + [REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN + SUBGOAL_THEN `&k < &n` MP_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_LT] THEN ASM_ARITH_TAC; REAL_ARITH_TAC]; + REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN CONV_TAC REAL_FIELD]);; + +(* V_SN2 is order 2 in n. Normalize sign-equal squared denominators before *) +(* REAL_FIELD to reduce the denominator set. *) +let V_SN2 = prove + (`!n k. 1 <= k /\ k < n ==> vv (n+2) k = (--(&1) * (&n + &2 + &k) * (&2 + &9 * &n pow 2 - &3 * &k * &n + &6 * &k pow 2 + &n pow 4 + &5 * &n pow 3 + &6 * &k pow 3 + &k * &n pow 3 - &k * &n pow 2 - &4 * &k pow 2 * &n pow 2 - &2 * &k pow 2 * &n + &4 * &k pow 3 * &n + &k + &7 * &n) * (&n + &1 + &k) pow 2 / ((&n + &2) pow 3 * (--(&n) - &1 + &k) pow 2 * (&k - &n - &2) pow 2)) * vv n k + ((&2 * &n + &3) * (&n pow 2 + &3 * &n + &3) * (&n + &2 + &k) pow 2 / ((&n + &2) pow 3 * (&k - &n - &2) pow 2)) * vv (n+1) k + (&2 * &k * (&2 * &n + &3) * (&k + &1) pow 5 * (&n + &2 + &k) / ((&n + &2) pow 3 * (--(&n) + &k) * (--(&n) - &1 + &k) pow 2 * (&k - &n - &2) pow 2)) * vv n (k+1)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[vv] THEN + MP_TAC(SPECL[`n:num`;`k:num`] SS_SN2) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + MP_TAC(SPECL[`n:num`;`k:num`] CC_N2R) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + MP_TAC(SPECL[`n:num`;`k:num`] CC_NR) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[CC_STEP_K] THEN + REWRITE_TAC[REAL_ARITH `(--(&n) - &1 + &k) pow 2 = (&n + &1 - &k) pow 2`; + REAL_ARITH `(&k - &n - &2) pow 2 = (&n + &2 - &k) pow 2`] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN + SUBGOAL_THEN `~(&k + &1 = &0) /\ ~(&n + &2 = &0) /\ ~(&n + &2 - &k = &0) /\ ~(&n + &1 - &k = &0) /\ ~(&n + &2 + &k = &0) /\ ~(--(&n) + &k = &0)` MP_TAC THENL + [REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN + SUBGOAL_THEN `&k < &n` MP_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_LT] THEN ASM_ARITH_TAC; REAL_ARITH_TAC]; + REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN CONV_TAC REAL_FIELD]);; + +(* ---- qc certificate coefficients ---- *) +let qc00 = new_definition `qc00 n k = ( &4 * &k * ( &2 * &n + &5 ) * ( &2 * &n + &3 ) * ( &2 * &n + &7 ) * ( &1744402215 * &k pow 2 * &n pow 14 + -- &390926048 * &k * &n pow 15 + -- &1797543582 * &k * &n pow 14 + -- &27184619520 * &n pow 2 + &25107052032 * &k * &n + &2077567488 * &k pow 2 + -- &332796611328 * &n pow 4 + -- &120646983168 * &n pow 3 + -- &6189000960 * &k pow 3 + -- &3452904576 * &k pow 4 + &258088741728 * &k * &n pow 3 + &102524693760 * &k * &n pow 2 + &121546930272 * &k pow 2 * &n pow 2 + &23906184192 * &k pow 2 * &n + -- &47918897056 * &k pow 3 * &n + -- &453776761464 * &k pow 4 * &n pow 6 + -- &34208713762 * &k pow 6 * &n pow 4 + -- &29608827881 * &k pow 6 * &n pow 3 + &5592448786 * &k pow 8 * &n + &14155092397 * &k pow 8 * &n pow 2 + -- &616679187165 * &k pow 3 * &n pow 7 + &2863226880 * &k + -- &2863226880 * &n + -- &673265061944 * &k pow 3 * &n pow 4 + -- &30134039386 * &k pow 7 * &n pow 2 + -- &328103820800 * &n pow 10 + -- &859845193968 * &n pow 8 + -- &591626761600 * &n pow 9 + -- &998105211488 * &n pow 7 + -- &10833443724 * &k pow 7 * &n + -- &911577929600 * &n pow 6 + -- &639897370880 * &n pow 5 + &255690672 * &k pow 9 + -- &409497350480 * &k pow 3 * &n pow 3 + -- &176289543184 * &k pow 3 * &n pow 2 + &445980429568 * &k * &n pow 4 + &779418105800 * &k pow 2 * &n pow 4 + &372081953600 * &k pow 2 * &n pow 3 + -- &27857118128 * &k pow 4 * &n + &555594416928 * &k * &n pow 5 + -- &405743014925 * &k pow 4 * &n pow 4 + -- &247666013854 * &k pow 4 * &n pow 3 + &182888462394 * &k pow 5 * &n pow 3 + &81436213660 * &k pow 5 * &n pow 2 + -- &18444006265 * &k pow 6 * &n pow 2 + -- &7247159210 * &k pow 6 * &n + -- &105299641272 * &k pow 4 * &n pow 2 + &22679880432 * &k pow 5 * &n + -- &1333959512 * &k pow 6 + -- &1822888416 * &k pow 7 + &1023021688 * &k pow 8 + &2997847184 * &k pow 5 + &63848152 * &k pow 11 * &n + -- &1719699936 * &k pow 10 * &n pow 3 + &139771620 * &k pow 11 * &n pow 3 + &123447892 * &k pow 11 * &n pow 2 + &102640379 * &k pow 11 * &n pow 4 + &17466166 * &k pow 11 * &n pow 6 + &51093252 * &k pow 11 * &n pow 5 + -- &87428804 * &k pow 10 * &n pow 7 + -- &311211346 * &k pow 10 * &n pow 6 + -- &783589496 * &k pow 10 * &n pow 5 + -- &1394901560 * &k pow 10 * &n pow 4 + -- &674057028 * &k pow 10 * &n + -- &1397856374 * &k pow 10 * &n pow 2 + &2124 * &k pow 11 * &n pow 10 + -- &5808 * &k pow 10 * &n pow 11 + -- &900 * &k pow 9 * &n pow 12 + &14016 * &k pow 8 * &n pow 13 + -- &9660 * &k pow 7 * &n pow 14 + -- &7440 * &k pow 6 * &n pow 15 + &13044 * &k pow 5 * &n pow 16 + -- &3456 * &k pow 4 * &n pow 17 + -- &3648 * &k pow 3 * &n pow 18 + &3072 * &k pow 2 * &n pow 19 + &53916 * &k pow 11 * &n pow 9 + -- &168060 * &k pow 10 * &n pow 10 + -- &7968 * &k pow 9 * &n pow 11 + &439032 * &k pow 8 * &n pow 12 + -- &342996 * &k pow 7 * &n pow 13 + -- &234732 * &k pow 6 * &n pow 14 + &482568 * &k pow 5 * &n pow 15 + -- &147696 * &k pow 4 * &n pow 16 + -- &144048 * &k pow 3 * &n pow 17 + &128928 * &k pow 2 * &n pow 18 + -- &32256 * &k * &n pow 19 + &610071 * &k pow 11 * &n pow 8 + -- &2193376 * &k pow 10 * &n pow 9 + &154863 * &k pow 9 * &n pow 10 + &6305692 * &k pow 8 * &n pow 11 + -- &5568967 * &k pow 7 * &n pow 12 + -- &3398600 * &k pow 6 * &n pow 13 + &8280997 * &k pow 5 * &n pow 14 + -- &2912340 * &k pow 4 * &n pow 15 + -- &2673124 * &k pow 3 * &n pow 16 + &2543776 * &k pow 2 * &n pow 17 + -- &631552 * &k * &n pow 18 + &4050412 * &k pow 11 * &n pow 7 + -- &17034532 * &k pow 10 * &n pow 8 + &3467507 * &k pow 9 * &n pow 9 + &55016357 * &k pow 8 * &n pow 10 + -- &54855522 * &k pow 7 * &n pow 11 + -- &29964918 * &k pow 6 * &n pow 12 + &87494875 * &k pow 5 * &n pow 13 + -- &35252851 * &k pow 4 * &n pow 14 + -- &31003896 * &k pow 3 * &n pow 15 + &31367368 * &k pow 2 * &n pow 16 + -- &7645312 * &k * &n pow 17 + -- &252131679 * &k pow 3 * &n pow 14 + &271060288 * &k pow 2 * &n pow 15 + -- &63952392 * &k * &n pow 16 + -- &3685794720 * &n pow 14 + -- &681771968 * &n pow 15 + -- &97183888 * &n pow 16 + -- &10296800 * &n pow 17 + -- &768 * &n pow 20 + -- &35328 * &n pow 19 + -- &763360 * &n pow 18 + &325582047 * &k pow 8 * &n pow 9 + -- &366581765 * &k pow 7 * &n pow 10 + -- &180195424 * &k pow 6 * &n pow 11 + &637095193 * &k pow 5 * &n pow 12 + -- &293786083 * &k pow 4 * &n pow 13 + &1381460896 * &k pow 8 * &n pow 8 + -- &1759973356 * &k pow 7 * &n pow 9 + -- &785707110 * &k pow 6 * &n pow 10 + &3390299217 * &k pow 5 * &n pow 11 + -- &1790786379 * &k pow 4 * &n pow 12 + -- &1528641105 * &k pow 3 * &n pow 13 + &4329005311 * &k pow 8 * &n pow 7 + -- &6267925410 * &k pow 7 * &n pow 8 + -- &2584329138 * &k pow 6 * &n pow 9 + &13641244822 * &k pow 5 * &n pow 10 + -- &8275822234 * &k pow 4 * &n pow 11 + -- &7171164950 * &k pow 3 * &n pow 12 + &8671244945 * &k pow 2 * &n pow 13 + &10157899122 * &k pow 8 * &n pow 6 + -- &16846739030 * &k pow 7 * &n pow 7 + -- &6608736882 * &k pow 6 * &n pow 8 + &42343375448 * &k pow 5 * &n pow 9 + -- &29644875275 * &k pow 4 * &n pow 10 + -- &26657515127 * &k pow 3 * &n pow 11 + &34074345499 * &k pow 2 * &n pow 12 + -- &6281404994 * &k * &n pow 13 + &17873852947 * &k pow 8 * &n pow 5 + -- &34403563419 * &k pow 7 * &n pow 6 + -- &13486898969 * &k pow 6 * &n pow 7 + &102510705804 * &k pow 5 * &n pow 8 + -- &83411422057 * &k pow 4 * &n pow 9 + -- &79729894768 * &k pow 3 * &n pow 10 + &107414839637 * &k pow 2 * &n pow 11 + -- &16511136494 * &k * &n pow 12 + &23326085212 * &k pow 8 * &n pow 4 + -- &53241708152 * &k pow 7 * &n pow 5 + -- &22441935459 * &k pow 6 * &n pow 6 + &194292424443 * &k pow 5 * &n pow 7 + -- &185590186906 * &k pow 4 * &n pow 8 + -- &193594433821 * &k pow 3 * &n pow 9 + &273992904577 * &k pow 2 * &n pow 10 + -- &31057152218 * &k * &n pow 11 + -- &383034928990 * &k pow 3 * &n pow 8 + &567647259943 * &k pow 2 * &n pow 9 + -- &34242238930 * &k * &n pow 10 + -- &15710071840 * &n pow 13 + -- &147311006048 * &n pow 11 + -- &53560818048 * &n pow 12 + -- &146056688 * &k pow 10 + &954502237105 * &k pow 2 * &n pow 8 + &9342208346 * &k * &n pow 9 + -- &768 * &k * &n pow 20 + &134837704206 * &k * &n pow 8 + -- &490926362370 * &k pow 4 * &n pow 5 + &286016170951 * &k pow 5 * &n pow 4 + &506405609304 * &k * &n pow 6 + &1197029877604 * &k pow 2 * &n pow 5 + -- &802371636049 * &k pow 3 * &n pow 6 + -- &832398382758 * &k pow 3 * &n pow 5 + &329600901794 * &k * &n pow 7 + &1295827185263 * &k pow 2 * &n pow 7 + &1405464163068 * &k pow 2 * &n pow 6 + &1211927256 * &k pow 9 * &n + &3251918342 * &k pow 9 * &n pow 3 + &2579633352 * &k pow 9 * &n pow 2 + &2693929255 * &k pow 9 * &n pow 4 + &31316929 * &k pow 9 * &n pow 8 + &169665992 * &k pow 9 * &n pow 7 + &612974365 * &k pow 9 * &n pow 6 + &1536374559 * &k pow 9 * &n pow 5 + &14685520 * &k pow 11 + -- &61627367257 * &k pow 7 * &n pow 4 + -- &326900137446 * &k pow 4 * &n pow 7 + -- &51889742508 * &k pow 7 * &n pow 3 + &329102354583 * &k pow 5 * &n pow 5 + &21970944881 * &k pow 8 * &n pow 3 + &287538055025 * &k pow 5 * &n pow 6 + -- &30741445978 * &k pow 6 * &n pow 5 ) ) / ( ( ( -- &n + -- &1 + &k ) pow 2 * ( -- &n + -- &4 + &k ) pow 2 * ( &n + &3 ) pow 3 * ( &n + &2 ) pow 3 * ( &k + -- &n + -- &3 ) pow 2 * ( -- &n + -- &2 + &k ) pow 2 ) )`;; +let qc10 = new_definition `qc10 n k = ( -- &4 * ( &2 * &n + &5 ) * ( &2 * &n + &3 ) * ( &2 * &n + &7 ) * ( -- &768 * &k pow 2 * &n pow 14 + &3456 * &k * &n pow 15 + &128352 * &k * &n pow 14 + -- &67908067008 * &n pow 2 + &9099997808 * &k * &n + &310664672 * &k pow 2 + -- &175893838000 * &n pow 4 + -- &131207942960 * &n pow 3 + -- &169882072 * &k pow 3 + &16459280 * &k pow 4 + &52615736598 * &k * &n pow 3 + &27869086208 * &k * &n pow 2 + &4186382212 * &k pow 2 * &n pow 2 + &1686931392 * &k pow 2 * &n + -- &944024994 * &k pow 3 * &n + &114305270 * &k pow 4 * &n pow 6 + -- &693288259 * &k pow 3 * &n pow 7 + &1381092384 * &k + -- &21794233216 * &n + -- &3964985038 * &k pow 3 * &n pow 4 + -- &3448870336 * &n pow 10 + -- &34419976280 * &n pow 8 + -- &12314690524 * &n pow 9 + -- &75583675964 * &n pow 7 + -- &130014624048 * &n pow 6 + -- &173414173068 * &n pow 5 + -- &3754252403 * &k pow 3 * &n pow 3 + -- &2412870465 * &k pow 3 * &n pow 2 + &68467857071 * &k * &n pow 4 + &6286099260 * &k pow 2 * &n pow 4 + &6267688586 * &k pow 2 * &n pow 3 + &88023212 * &k pow 4 * &n + &65027372713 * &k * &n pow 5 + &316850268 * &k pow 4 * &n pow 4 + &318395514 * &k pow 4 * &n pow 3 + &215308166 * &k pow 4 * &n pow 2 + -- &1240448 * &n pow 14 + -- &63984 * &n pow 15 + -- &1536 * &n pow 16 + &768 * &k pow 4 * &n pow 12 + -- &1728 * &k pow 3 * &n pow 13 + &21912 * &k pow 4 * &n pow 11 + -- &57072 * &k pow 3 * &n pow 12 + -- &20472 * &k pow 2 * &n pow 13 + &284200 * &k pow 4 * &n pow 10 + -- &861540 * &k pow 3 * &n pow 11 + -- &229168 * &k pow 2 * &n pow 12 + &2207580 * &k * &n pow 13 + &2216476 * &k pow 4 * &n pow 9 + -- &7872580 * &k pow 3 * &n pow 10 + -- &1284268 * &k pow 2 * &n pow 11 + &23327476 * &k * &n pow 12 + &11581872 * &k pow 4 * &n pow 8 + -- &48600970 * &k pow 3 * &n pow 9 + -- &2229148 * &k pow 2 * &n pow 10 + &169390270 * &k * &n pow 11 + -- &214150124 * &k pow 3 * &n pow 8 + &19636326 * &k pow 2 * &n pow 9 + &895491960 * &k * &n pow 10 + -- &14858072 * &n pow 13 + -- &747916132 * &n pow 11 + -- &123087048 * &n pow 12 + &178983116 * &k pow 2 * &n pow 8 + &3561379481 * &k * &n pow 9 + &10853226951 * &k * &n pow 8 + &223378412 * &k pow 4 * &n pow 5 + &46548168958 * &k * &n pow 6 + &4425270962 * &k pow 2 * &n pow 5 + -- &1670758425 * &k pow 3 * &n pow 6 + -- &2999441626 * &k pow 3 * &n pow 5 + &25562116926 * &k * &n pow 7 + &780005826 * &k pow 2 * &n pow 7 + &2218767840 * &k pow 2 * &n pow 6 + -- &3268333056 + &42741626 * &k pow 4 * &n pow 7 ) * &k pow 4 ) / ( ( ( -- &n + -- &2 + &k ) pow 2 * ( -- &n + -- &4 + &k ) pow 2 * ( &n + &2 ) pow 3 * ( &n + &3 ) pow 3 * ( &k + -- &n + -- &3 ) pow 2 ) )`;; +let qc01 = new_definition `qc01 n k = ( -- &4 * &k * ( &2 * &n + &5 ) * ( &2 * &n + &3 ) * ( &2 * &n + &7 ) * ( &k + &1 ) pow 5 * ( &285984 * &k pow 2 * &n pow 14 + -- &157920 * &k * &n pow 15 + -- &3026048 * &k * &n pow 14 + &74867424768 * &n pow 2 + -- &44680889088 * &k * &n + &5162764032 * &k pow 2 + &241822754048 * &n pow 4 + &161603596032 * &n pow 3 + -- &1744849824 * &k pow 3 + -- &744986544 * &k pow 4 + -- &281708015936 * &k * &n pow 3 + -- &142716403296 * &k * &n pow 2 + &96887337056 * &k pow 2 * &n pow 2 + &32825580096 * &k pow 2 * &n + -- &10344114032 * &k pow 3 * &n + -- &3469900135 * &k pow 4 * &n pow 6 + -- &1842594317 * &k pow 6 * &n pow 4 + -- &2262462688 * &k pow 6 * &n pow 3 + -- &13217484828 * &k pow 3 * &n pow 7 + -- &6512113152 * &k + &21458165760 * &n + -- &54560718080 * &k pow 3 * &n pow 4 + &123447892 * &k pow 7 * &n pow 2 + &10042207744 * &n pow 10 + &75468444096 * &n pow 8 + &30900177104 * &n pow 9 + &146266755504 * &n pow 7 + &63848152 * &k pow 7 * &n + &223624806496 * &n pow 6 + &266328825472 * &n pow 5 + -- &47534432700 * &k pow 3 * &n pow 3 + -- &28334986440 * &k pow 3 * &n pow 2 + -- &384634123200 * &k * &n pow 4 + &220377639732 * &k pow 2 * &n pow 4 + &176090065112 * &k pow 2 * &n pow 3 + -- &3766672224 * &k pow 4 * &n + -- &385205224120 * &k * &n pow 5 + -- &11108830969 * &k pow 4 * &n pow 4 + -- &11977447248 * &k pow 4 * &n pow 3 + &11326819614 * &k pow 5 * &n pow 3 + &8499441560 * &k pow 5 * &n pow 2 + -- &1832048202 * &k pow 6 * &n pow 2 + -- &880287004 * &k pow 6 * &n + -- &8659675144 * &k pow 4 * &n pow 2 + &3824239688 * &k pow 5 * &n + -- &190113248 * &k pow 6 + &14685520 * &k pow 7 + &780109264 * &k pow 5 + -- &6720 * &k pow 3 * &n pow 14 + &7488 * &k pow 2 * &n pow 15 + -- &3840 * &k * &n pow 16 + &8872992 * &n pow 14 + &695008 * &n pow 15 + &33792 * &n pow 16 + &768 * &n pow 17 + &2124 * &k pow 7 * &n pow 10 + -- &7932 * &k pow 6 * &n pow 11 + &8772 * &k pow 5 * &n pow 12 + -- &372 * &k pow 4 * &n pow 13 + &53916 * &k pow 7 * &n pow 9 + -- &228348 * &k pow 6 * &n pow 10 + &285576 * &k pow 5 * &n pow 11 + -- &24444 * &k pow 4 * &n pow 12 + -- &236508 * &k pow 3 * &n pow 13 + &610071 * &k pow 7 * &n pow 8 + -- &2965195 * &k pow 6 * &n pow 9 + &4228061 * &k pow 5 * &n pow 10 + -- &563929 * &k pow 4 * &n pow 11 + -- &3845816 * &k pow 3 * &n pow 12 + &5069472 * &k pow 2 * &n pow 13 + &4050412 * &k pow 7 * &n pow 7 + -- &22915157 * &k pow 6 * &n pow 8 + &37634766 * &k pow 5 * &n pow 9 + -- &7062201 * &k pow 4 * &n pow 10 + -- &38297128 * &k pow 3 * &n pow 11 + &55326472 * &k pow 2 * &n pow 12 + -- &35860680 * &k * &n pow 13 + &17466166 * &k pow 7 * &n pow 6 + -- &117046206 * &k pow 6 * &n pow 7 + &224250307 * &k pow 5 * &n pow 8 + -- &56308591 * &k pow 4 * &n pow 9 + -- &260924075 * &k pow 3 * &n pow 10 + &415735739 * &k pow 2 * &n pow 11 + -- &294146400 * &k * &n pow 12 + &51093252 * &k pow 7 * &n pow 5 + -- &414703096 * &k pow 6 * &n pow 6 + &942042570 * &k pow 5 * &n pow 7 + -- &308693091 * &k pow 4 * &n pow 8 + -- &1286667926 * &k pow 3 * &n pow 9 + &2278300097 * &k pow 2 * &n pow 10 + -- &1770637850 * &k * &n pow 11 + -- &4735827930 * &k pow 3 * &n pow 8 + &9406632852 * &k pow 2 * &n pow 9 + -- &8090727306 * &k * &n pow 10 + &78742896 * &n pow 13 + &2576225456 * &n pow 11 + &515413184 * &n pow 12 + &29795852850 * &k pow 2 * &n pow 8 + -- &28624383652 * &k * &n pow 9 + -- &79238310868 * &k * &n pow 8 + -- &7286006265 * &k pow 4 * &n pow 5 + &10083400273 * &k pow 5 * &n pow 4 + -- &292723611810 * &k * &n pow 6 + &201162981114 * &k pow 2 * &n pow 5 + -- &28108959555 * &k pow 3 * &n pow 6 + -- &45328273270 * &k pow 3 * &n pow 5 + -- &172186812834 * &k * &n pow 7 + &73002514895 * &k pow 2 * &n pow 7 + &138352054849 * &k pow 2 * &n pow 6 + &102640379 * &k pow 7 * &n pow 4 + -- &1211427691 * &k pow 4 * &n pow 7 + &139771620 * &k pow 7 * &n pow 3 + &6319292362 * &k pow 5 * &n pow 5 + &2859841811 * &k pow 5 * &n pow 6 + -- &1039509631 * &k pow 6 * &n pow 5 + &2863226880 ) ) / ( ( ( -- &n + &k ) * ( &k + -- &n + -- &3 ) pow 2 * ( -- &n + -- &4 + &k ) pow 2 * ( -- &n + -- &1 + &k ) pow 2 * ( &n + &3 ) pow 3 * ( &n + &2 ) pow 3 * ( -- &n + -- &2 + &k ) pow 2 ) )`;; + + +(* The two-index operator applies pflat to a fixed column. *) +let pflat2 = new_definition + `pflat2 (f:num->num->real) n k = pflat (\m. f m k) n`;; +let qflat = new_definition + `qflat (f:num->num->real) n k = qc00 n k * f n k + qc10 n k * f (n+1) k + qc01 n k * f n (k+1)`;; + +(* ------------------------------------------------------------------------- *) +(* CLEARED (division-free) v-recurrences. Each multiplies the rational *) +(* recurrence through by its denominator, giving a polynomial relation *) +(* den * vv(higher) = (polys) * (base atoms). Proven from the rational *) +(* V_SN2/V_SNSK/V_SK2 by REAL_FIELD (few denominator factors each). *) +(* This avoids expanding the degree-20 certificate inside REAL_FIELD. *) +(* ------------------------------------------------------------------------- *) + +let V_SN2_CL = prove + (`1 <= k /\ (k:num) < n ==> ((&n + &2) pow 3 * (&n + &1 - &k) pow 2 * (&n + &2 - &k) pow 2 * (-- &n + &k)) * vv (n + 2) k = (&n pow 8 + &3 * &n pow 7 * &k - &2 * &n pow 6 * &k pow 2 - &6 * &n pow 5 * &k pow 3 + &5 * &n pow 4 * &k pow 4 + &7 * &n pow 3 * &k pow 5 - &4 * &n pow 2 * &k pow 6 - &4 * &n * &k pow 7 + &9 * &n pow 7 + &17 * &n pow 6 * &k - &20 * &n pow 5 * &k pow 2 - &16 * &n pow 4 * &k pow 3 + &37 * &n pow 3 * &k pow 4 + &5 * &n pow 2 * &k pow 5 - &26 * &n * &k pow 6 - &6 * &k pow 7 + &34 * &n pow 6 + &36 * &n pow 5 * &k - &57 * &n pow 4 * &k pow 2 + &9 * &n pow 3 * &k pow 3 + &53 * &n pow 2 * &k pow 4 - &45 * &n * &k pow 5 - &30 * &k pow 6 + &70 * &n pow 5 + &34 * &n pow 4 * &k - &67 * &n pow 3 * &k pow 2 + &37 * &n pow 2 * &k pow 3 - &19 * &n * &k pow 4 - &55 * &k pow 5 + &85 * &n pow 4 + &9 * &n pow 3 * &k - &41 * &n pow 2 * &k pow 2 - &5 * &n * &k pow 3 - &48 * &k pow 4 + &61 * &n pow 3 - &11 * &n pow 2 * &k - &25 * &n * &k pow 2 - &25 * &k pow 3 + &24 * &n pow 2 - &12 * &n * &k - &12 * &k pow 2 + &4 * &n - &4 * &k) * vv n k + (-- &2 * &n pow 8 + &2 * &n pow 7 * &k + &4 * &n pow 6 * &k pow 2 - &4 * &n pow 5 * &k pow 3 - &2 * &n pow 4 * &k pow 4 + &2 * &n pow 3 * &k pow 5 - &21 * &n pow 7 + &25 * &n pow 6 * &k + &26 * &n pow 5 * &k pow 2 - &34 * &n pow 4 * &k pow 3 - &5 * &n pow 3 * &k pow 4 + &9 * &n pow 2 * &k pow 5 - &95 * &n pow 6 + &125 * &n pow 5 * &k + &60 * &n pow 4 * &k pow 2 - &108 * &n pow 3 * &k pow 3 + &3 * &n pow 2 * &k pow 4 + &15 * &n * &k pow 5 - &240 * &n pow 5 + &332 * &n pow 4 * &k + &43 * &n pow 3 * &k pow 2 - &165 * &n pow 2 * &k pow 3 + &21 * &n * &k pow 4 + &9 * &k pow 5 - &365 * &n pow 4 + &509 * &n pow 3 * &k - &45 * &n pow 2 * &k pow 2 - &117 * &n * &k pow 3 + &18 * &k pow 4 - &333 * &n pow 3 + &447 * &n pow 2 * &k - &87 * &n * &k pow 2 - &27 * &k pow 3 - &168 * &n pow 2 + &204 * &n * &k - &36 * &k pow 2 - &36 * &n + &36 * &k) * vv (n + 1) k + (&4 * &n pow 2 * &k pow 6 + &4 * &n * &k pow 7 + &20 * &n pow 2 * &k pow 5 + &34 * &n * &k pow 6 + &6 * &k pow 7 + &40 * &n pow 2 * &k pow 4 + &110 * &n * &k pow 5 + &42 * &k pow 6 + &40 * &n pow 2 * &k pow 3 + &180 * &n * &k pow 4 + &120 * &k pow 5 + &20 * &n pow 2 * &k pow 2 + &160 * &n * &k pow 3 + &180 * &k pow 4 + &4 * &n pow 2 * &k + &74 * &n * &k pow 2 + &150 * &k pow 3 + &14 * &n * &k + &66 * &k pow 2 + &12 * &k) * vv n (k + 1)`, + STRIP_TAC THEN MP_TAC(SPECL[`n:num`;`k:num`]V_SN2) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN SUBGOAL_THEN `~(&n + &2 = &0) /\ ~(&n + &1 - &k = &0) /\ ~(&n + &2 - &k = &0) /\ ~(-- &n + &k = &0)` MP_TAC THENL [SUBGOAL_THEN `&k < &n` MP_TAC THENL [REWRITE_TAC[REAL_OF_NUM_LT] THEN ASM_ARITH_TAC; ALL_TAC] THEN STRIP_TAC THEN REPEAT CONJ_TAC THEN ASM_REAL_ARITH_TAC; REWRITE_TAC[REAL_RING `(&k - &n - &2) pow 2 = (&n + &2 - &k) pow 2`] THEN CONV_TAC REAL_FIELD]);; + +let V_SNSK_CL = prove + (`(k:num) < n ==> ((&k + &1) pow 4 * (-- &n + &k)) * vv (n + 1) (k + 1) = (&n pow 5 + &n pow 4 * &k - &2 * &n pow 3 * &k pow 2 - &2 * &n pow 2 * &k pow 3 + &n * &k pow 4 + &k pow 5 + &4 * &n pow 4 - &8 * &n pow 2 * &k pow 2 + &4 * &k pow 4 + &5 * &n pow 3 - &5 * &n pow 2 * &k - &5 * &n * &k pow 2 + &5 * &k pow 3 + &2 * &n pow 2 - &4 * &n * &k + &2 * &k pow 2) * vv n k + (-- &n pow 5 + &n pow 4 * &k + &2 * &n pow 3 * &k pow 2 - &2 * &n pow 2 * &k pow 3 - &n * &k pow 4 + &k pow 5 - &6 * &n pow 4 + &8 * &n pow 3 * &k + &4 * &n pow 2 * &k pow 2 - &8 * &n * &k pow 3 + &2 * &k pow 4 - &13 * &n pow 3 + &19 * &n pow 2 * &k - &3 * &n * &k pow 2 - &3 * &k pow 3 - &12 * &n pow 2 + &16 * &n * &k - &4 * &k pow 2 - &4 * &n + &4 * &k) * vv (n + 1) k + (-- &n * &k pow 4 - &k pow 5 - &4 * &n * &k pow 3 - &6 * &k pow 4 - &6 * &n * &k pow 2 - &14 * &k pow 3 - &4 * &n * &k - &16 * &k pow 2 - &n - &9 * &k - &2) * vv n (k + 1)`, + STRIP_TAC THEN MP_TAC(SPECL[`n:num`;`k:num`]V_SNSK) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN SUBGOAL_THEN `~(&k + &1 = &0) /\ ~(-- &n + &k = &0)` MP_TAC THENL [SUBGOAL_THEN `&k < &n` MP_TAC THENL [REWRITE_TAC[REAL_OF_NUM_LT] THEN ASM_ARITH_TAC; ALL_TAC] THEN STRIP_TAC THEN REPEAT CONJ_TAC THEN ASM_REAL_ARITH_TAC; CONV_TAC REAL_FIELD]);; + +let V_SK2_CL = prove + (`(k:num) + 1 < n ==> ((&k + &1) * (&k + &2) pow 5) * vv n (k + 2) = (&n pow 6 - &3 * &n pow 4 * &k pow 2 + &3 * &n pow 2 * &k pow 4 - &k pow 6 + &3 * &n pow 5 - &5 * &n pow 4 * &k - &6 * &n pow 3 * &k pow 2 + &10 * &n pow 2 * &k pow 3 + &3 * &n * &k pow 4 - &5 * &k pow 5 + &n pow 4 - &10 * &n pow 3 * &k + &8 * &n pow 2 * &k pow 2 + &10 * &n * &k pow 3 - &9 * &k pow 4 - &3 * &n pow 3 - &n pow 2 * &k + &11 * &n * &k pow 2 - &7 * &k pow 3 - &2 * &n pow 2 + &4 * &n * &k - &2 * &k pow 2) * vv n k + (&n pow 4 * &k pow 2 - &3 * &n pow 2 * &k pow 4 + &2 * &k pow 6 + &3 * &n pow 4 * &k + &2 * &n pow 3 * &k pow 2 - &16 * &n pow 2 * &k pow 3 - &3 * &n * &k pow 4 + &16 * &k pow 5 + &2 * &n pow 4 + &6 * &n pow 3 * &k - &31 * &n pow 2 * &k pow 2 - &16 * &n * &k pow 3 + &53 * &k pow 4 + &4 * &n pow 3 - &25 * &n pow 2 * &k - &32 * &n * &k pow 2 + &93 * &k pow 3 - &7 * &n pow 2 - &28 * &n * &k + &91 * &k pow 2 - &9 * &n + &47 * &k + &10) * vv n (k + 1)`, + STRIP_TAC THEN MP_TAC(SPECL[`n:num`;`k:num`]V_SK2) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN SUBGOAL_THEN `~(&k + &1 = &0) /\ ~(&k + &2 = &0)` MP_TAC THENL [REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN STRIP_TAC THEN REPEAT CONJ_TAC THEN REAL_ARITH_TAC; CONV_TAC REAL_FIELD]);; + +(* ------------------------------------------------------------------------- *) +(* Reduce the interior telescoping identity triangularly through the *) +(* rational recurrences to three base values of vv. *) +(* ------------------------------------------------------------------------- *) + +let CANCEL_LEM = prove + (`!d a b:real. ~(d = &0) /\ d * a = d * b ==> a = b`, + MESON_TAC[REAL_EQ_MUL_LCANCEL]);; + + +(* Rational-clearing certificate infrastructure. *) +let RAT_ADD = prove + (`!a b c d:real. + ~(b = &0) /\ ~(d = &0) + ==> a / b + c / d = (a * d + c * b) / (b * d)`, + CONV_TAC REAL_FIELD);; + +let RAT_SUB = prove + (`!a b c d:real. + ~(b = &0) /\ ~(d = &0) + ==> a / b - c / d = (a * d - c * b) / (b * d)`, + CONV_TAC REAL_FIELD);; + +let RAT_MUL = prove + (`!a b c d:real. + ~(b = &0) /\ ~(d = &0) + ==> (a / b) * (c / d) = (a * c) / (b * d)`, + CONV_TAC REAL_FIELD);; + +let RAT_NEG = prove + (`!a b:real. --(a / b) = (--a) / b`, + REWRITE_TAC[real_div; REAL_MUL_LNEG]);; + +let RAT_INV = prove + (`!a b:real. ~(a = &0) /\ ~(b = &0) ==> inv(a / b) = b / a`, + CONV_TAC REAL_FIELD);; + +let RAT_DIV = prove + (`!a b c d:real. + ~(b = &0) /\ ~(c = &0) /\ ~(d = &0) + ==> (a / b) / (c / d) = (a * d) / (b * c)`, + CONV_TAC REAL_FIELD);; + +let RAT_EQ_CROSS = prove + (`!a b c d:real. + ~(b = &0) /\ ~(d = &0) + ==> (a / b = c / d <=> a * d = c * b)`, + CONV_TAC REAL_FIELD);; +let REAL_POW_NZ = prove(`!x n. ~(x = &0) ==> ~(x pow n = &0)`, SIMP_TAC[REAL_POW_EQ_0]);; +let REAL_MUL_NZ = prove(`!x y. ~(x = &0) /\ ~(y = &0) ==> ~(x * y = &0)`, REWRITE_TAC[REAL_ENTIRE; DE_MORGAN_THM]);; +let div_tm = `(/):real->real->real` and inv_tm = `inv:real->real` +and mul_tm = `( * ):real->real->real` and add_tm = `(+):real->real->real` +and sub_tm = `(-):real->real->real` and pow_tm = `(pow):real->num->real` +and neg_tm = `(--):real->real`;; +let DIV1 = GSYM REAL_DIV_1;; +let dest_div = dest_binop div_tm;; +let is_binop_op op t = is_comb t && is_comb(rator t) && rator(rator t) = op;; +let has_div t = can (find_term (fun s -> is_binop_op div_tm s || (is_comb s && rator s = inv_tm))) t;; +let rec PROVE_NZ nz_thms d = + if is_binop_op mul_tm d then let a,b = dest_binop mul_tm d in + MATCH_MP REAL_MUL_NZ (CONJ (PROVE_NZ nz_thms a) (PROVE_NZ nz_thms b)) + else if is_binop_op pow_tm d then let a,n = dest_binop pow_tm d in + MATCH_MP (SPECL[a;n] REAL_POW_NZ) (PROVE_NZ nz_thms a) + else try find (fun th -> concl th = mk_neg(mk_eq(d,`&0`))) nz_thms + with Failure _ -> (try EQT_ELIM(REAL_RAT_REDUCE_CONV (mk_neg(mk_eq(d,`&0`)))) + with _ -> failwith ("PROVE_NZ: "^string_of_term d));; +let rec RATIONALIZE_CONV nz t = + if not (has_div t) then SPEC t DIV1 + else if is_binop_op add_tm t then + let a,b = dest_binop add_tm t in + let tha = RATIONALIZE_CONV nz a and thb = RATIONALIZE_CONV nz b in + let na,da = dest_div (rhs(concl tha)) and nb,db = dest_div (rhs(concl thb)) in + TRANS (MK_COMB(AP_TERM add_tm tha, thb)) (MP (SPECL [na;da;nb;db] RAT_ADD) (CONJ (PROVE_NZ nz da)(PROVE_NZ nz db))) + else if is_binop_op sub_tm t then + let a,b = dest_binop sub_tm t in + let tha = RATIONALIZE_CONV nz a and thb = RATIONALIZE_CONV nz b in + let na,da = dest_div (rhs(concl tha)) and nb,db = dest_div (rhs(concl thb)) in + TRANS (MK_COMB(AP_TERM sub_tm tha, thb)) (MP (SPECL [na;da;nb;db] RAT_SUB) (CONJ (PROVE_NZ nz da)(PROVE_NZ nz db))) + else if is_binop_op mul_tm t then + let a,b = dest_binop mul_tm t in + let tha = RATIONALIZE_CONV nz a and thb = RATIONALIZE_CONV nz b in + let na,da = dest_div (rhs(concl tha)) and nb,db = dest_div (rhs(concl thb)) in + TRANS (MK_COMB(AP_TERM mul_tm tha, thb)) (MP (SPECL [na;da;nb;db] RAT_MUL) (CONJ (PROVE_NZ nz da)(PROVE_NZ nz db))) + else if is_binop_op div_tm t then + let a,b = dest_div t in + let tha = RATIONALIZE_CONV nz a and thb = RATIONALIZE_CONV nz b in + let na,da = dest_div (rhs(concl tha)) and nb,db = dest_div (rhs(concl thb)) in + TRANS (MK_COMB(AP_TERM div_tm tha, thb)) (MP (SPECL [na;da;nb;db] RAT_DIV) (CONJ (PROVE_NZ nz da)(CONJ (PROVE_NZ nz nb)(PROVE_NZ nz db)))) + else if is_binop_op pow_tm t then + let a,nn = dest_binop pow_tm t in + let tha = RATIONALIZE_CONV nz a in + let na,da = dest_div (rhs(concl tha)) in + TRANS (AP_THM (AP_TERM pow_tm tha) nn) (SPECL [na;da;nn] REAL_POW_DIV) + else if is_comb t && rator t = inv_tm then + let a = rand t in let tha = RATIONALIZE_CONV nz a in + let na,da = dest_div (rhs(concl tha)) in + TRANS (AP_TERM inv_tm tha) (MP (SPECL [na;da] RAT_INV) (CONJ (PROVE_NZ nz na)(PROVE_NZ nz da))) + else if is_comb t && rator t = neg_tm then + let a = rand t in let tha = RATIONALIZE_CONV nz a in + let na,da = dest_div (rhs(concl tha)) in + TRANS (AP_TERM neg_tm tha) (SPECL[na;da] RAT_NEG) + else SPEC t DIV1;; +let prove_rat_eq nz tm = + let l,r = dest_eq tm in + let thl = RATIONALIZE_CONV nz l and thr = RATIONALIZE_CONV nz r in + let nl,dl = dest_div(rhs(concl thl)) and nr,dr = dest_div(rhs(concl thr)) in + let cross = MP (SPECL [nl;dl;nr;dr] RAT_EQ_CROSS) (CONJ (PROVE_NZ nz dl)(PROVE_NZ nz dr)) in + let polygoal = rhs(concl cross) in + let pl,pr = dest_eq polygoal in + let polyth = TRANS (REAL_POLY_CONV pl) (SYM(REAL_POLY_CONV pr)) in + let step1 = MK_COMB(AP_TERM `(=):real->real->bool` thl, thr) in + EQ_MP (SYM (TRANS step1 cross)) polyth;; +let prove_factor_nz_imp f = + prove(mk_imp(`1 <= k /\ k + 1 < n`, mk_neg(mk_eq(f, `&0`))), + REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_LT; GSYM REAL_OF_NUM_LE] THEN + STRIP_TAC THEN REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN ASM_REAL_ARITH_TAC);; +let rec denom_factors t acc = + if is_binop_op div_tm t then let a,b = dest_div t in denom_factors a (factor_collect b (denom_factors b acc)) + else match t with Comb(f,x) -> denom_factors f (denom_factors x acc) | Abs(_,b) -> denom_factors b acc | _ -> acc +and factor_collect d acc = + if is_binop_op mul_tm d then let a,b=dest_binop mul_tm d in factor_collect a (factor_collect b acc) + else if is_binop_op pow_tm d then let a,_=dest_binop pow_tm d in factor_collect a acc + else if mem d acc then acc else d::acc;; +let hyp_thm = ASSUME `1 <= k /\ k + 1 < n`;; +let nz_for t = map (fun f -> MP (prove_factor_nz_imp f) hyp_thm) (denom_factors t []);; + +(* The telescoping identity reduces via rational recurrences to three base *) +(* values of vv. The displayed rational reductions are untrusted generated *) +(* data; HOL checks every reduction and the final polynomial identities. *) + +let V_SN2_CL_G = GEN `n:num` (GEN `k:num` V_SN2_CL);; +let V_SNSK_CL_G = GEN `n:num` (GEN `k:num` V_SNSK_CL);; +let V_SK2_CL_G = GEN `n:num` (GEN `k:num` V_SK2_CL);; + +let idx_norm = + [ARITH_RULE `(n+1)+2 = n+3`; + ARITH_RULE `(n+1)+1 = n+2`; + ARITH_RULE `(n+2)+2 = n+4`; + ARITH_RULE `(n+2)+1 = n+3`];; + +let apery_hyp = `1 <= k /\ k + 1 < n`;; + +let apery_lift_recurrence th = + let _,eq = dest_imp(concl th) in + prove + (mk_imp(apery_hyp,eq), + DISCH_TAC THEN MATCH_MP_TAC th THEN ASM_ARITH_TAC);; + +let apery_recurrences = + map UNDISCH + [apery_lift_recurrence + (REWRITE_RULE idx_norm (SPECL [`n+2`; `k:num`] V_SN2)); + apery_lift_recurrence + (REWRITE_RULE idx_norm (SPECL [`n+1`; `k:num`] V_SNSK)); + apery_lift_recurrence + (REWRITE_RULE idx_norm (SPECL [`n+1`; `k:num`] V_SN2)); + apery_lift_recurrence (SPECL [`n:num`; `k:num`] V_SN2); + apery_lift_recurrence (SPECL [`n:num`; `k:num`] V_SNSK); + apery_lift_recurrence (SPECL [`n:num`; `k:num`] V_SK2)];; + +let apery_target = + `pflat2 vv n k - (qflat vv n (k+1) - qflat vv n k):real`;; + +let apery_reduced = + let expanded = + REWRITE_CONV + [pflat2; pflat; qflat; + ARITH_RULE `(n+1)+1 = n+2`; + ARITH_RULE `(n+2)+1 = n+3`; + ARITH_RULE `(n+3)+1 = n+4`] + apery_target in + TRANS expanded + (REWRITE_CONV apery_recurrences (rhs(concl expanded)));; + +let apery_atoms = + [`vv n k`; `vv (n+1) k`; `vv n (k+1)`] +and apery_zero = `&0:real` +and apery_one = `&1:real`;; + +let apery_has_atom tm = + can (find_term (fun t -> mem t apery_atoms)) tm;; + +let apery_add x y = + if x = apery_zero then y + else if y = apery_zero then x + else mk_binop add_tm x y +and apery_sub x y = + if y = apery_zero then x + else if x = apery_zero then mk_comb(neg_tm,y) + else mk_binop sub_tm x y +and apery_neg x = + if x = apery_zero then apery_zero else mk_comb(neg_tm,x) +and apery_mul x y = + if x = apery_zero || y = apery_zero then apery_zero + else if x = apery_one then y + else if y = apery_one then x + else mk_binop mul_tm x y;; + +let apery_vec_add xs ys = map2 apery_add xs ys +and apery_vec_sub xs ys = map2 apery_sub xs ys +and apery_vec_neg xs = map apery_neg xs +and apery_vec_scale c xs = map (apery_mul c) xs;; + +let rec apery_linearize tm = + if mem tm apery_atoms then + apery_zero :: + map (fun a -> if tm = a then apery_one else apery_zero) + apery_atoms + else if not (apery_has_atom tm) then + [tm; apery_zero; apery_zero; apery_zero] + else if is_binop_op add_tm tm then + let l,r = dest_binop add_tm tm in + apery_vec_add (apery_linearize l) (apery_linearize r) + else if is_binop_op sub_tm tm then + let l,r = dest_binop sub_tm tm in + apery_vec_sub (apery_linearize l) (apery_linearize r) + else if is_comb tm && rator tm = neg_tm then + apery_vec_neg (apery_linearize(rand tm)) + else if is_binop_op mul_tm tm then + let l,r = dest_binop mul_tm tm in + if not (apery_has_atom l) then + apery_vec_scale l (apery_linearize r) + else if not (apery_has_atom r) then + apery_vec_scale r (apery_linearize l) + else failwith "apery_linearize: nonlinear product" + else failwith "apery_linearize: unsupported term";; + +let apery_coeffs = apery_linearize(rhs(concl apery_reduced));; + +let apery_unfold_coeff tm = + REWRITE_CONV + [qc00; qc10; qc01; GSYM REAL_OF_NUM_ADD] tm;; + +let apery_normalize_denoms tm = + REWRITE_CONV + (map REAL_POLY_CONV (denom_factors tm [])) tm;; + +let apery_normalize_coeff tm = + let unfolded = apery_unfold_coeff tm in + TRANS unfolded + (apery_normalize_denoms(rhs(concl unfolded)));; + +let apery_normalized_coeffs = + map (fun tm -> rhs(concl(apery_normalize_coeff tm))) + apery_coeffs;; + +let rec apery_rational_summands tm = + if not (has_div tm) then [tm] + else if is_binop_op add_tm tm then + let l,r = dest_binop add_tm tm in + apery_rational_summands l @ apery_rational_summands r + else if is_binop_op sub_tm tm then + let l,r = dest_binop sub_tm tm in + apery_rational_summands l @ + map apery_neg (apery_rational_summands r) + else if is_comb tm && rator tm = neg_tm then + map apery_neg (apery_rational_summands(rand tm)) + else if is_binop_op mul_tm tm then + let l,r = dest_binop mul_tm tm in + flat + (map + (fun x -> + map (apery_mul x) (apery_rational_summands r)) + (apery_rational_summands l)) + else [tm];; + +let apery_sum terms = + end_itlist (fun x y -> mk_binop add_tm x y) terms;; + +let rec apery_rational_leaves tm = + if not (has_div tm) then [tm] + else if is_binop_op add_tm tm || + is_binop_op sub_tm tm || + is_binop_op mul_tm tm then + let op = + if is_binop_op add_tm tm then add_tm + else if is_binop_op sub_tm tm then sub_tm + else mul_tm in + let l,r = dest_binop op tm in + apery_rational_leaves l @ apery_rational_leaves r + else if is_comb tm && rator tm = neg_tm then + apery_rational_leaves(rand tm) + else [tm];; + +let apery_abstract_identity leaves eq = + let leaves = + filter + (fun t -> t <> apery_zero && t <> apery_one) + (setify leaves) in + let vars = map (fun t -> genvar(type_of t)) leaves in + let abstract = map2 (fun t v -> v,t) leaves vars + and concrete = map2 (fun t v -> t,v) leaves vars in + INST concrete + (prove(subst abstract eq,CONV_TAC REAL_RING));; + +let apery_make_raw terms = + map + (fun tm -> + let th = RATIONALIZE_CONV (nz_for tm) tm in + let num,den = dest_div(rhs(concl th)) in + th,num,den) + terms;; + +let APERY_RAT_CANCEL = prove + (`!g n d:real. ~(g = &0) + ==> (g * n) / (g * d) = n / d`, + CONV_TAC REAL_FIELD);; + +let APERY_RAT_SCALE = prove + (`!d D q n:real. + ~(d = &0) /\ D = q * d + ==> D * (n / d) = q * n`, + CONV_TAC REAL_FIELD);; + +let apery_prove_poly_eq l r = + TRANS (REAL_POLY_CONV l) (SYM(REAL_POLY_CONV r));; + +let apery_prove_nz_product tm = + let nz = + map + (fun f -> MP (prove_factor_nz_imp f) hyp_thm) + (factor_collect tm []) in + PROVE_NZ nz tm;; + +let rec apery_sum_theorems thms = + match thms with + [th] -> th + | th::rest -> + MK_COMB(AP_TERM add_tm th,apery_sum_theorems rest) + | [] -> failwith "apery_sum_theorems";; + +let apery_reduce_fractions raws reduced = + map2 + (fun (rawth,raw_num,raw_den) (num,den,_,common) -> + let num_th = + apery_prove_poly_eq raw_num (mk_binop mul_tm common num) + and den_th = + apery_prove_poly_eq raw_den (mk_binop mul_tm common den) in + let fraction_th = + MK_COMB(AP_TERM div_tm num_th,den_th) in + let cancel_th = + MATCH_MP (SPECL [common; num; den] APERY_RAT_CANCEL) + (apery_prove_nz_product common) in + TRANS rawth (TRANS fraction_th cancel_th)) + raws reduced;; + +let apery_bigd = + `((&k - &n) pow 2 * (&n + &2) pow 3 * (&n + &3) pow 3 * + (&k - &n - &4) pow 2 * (&k - &n - &3) pow 2 * + (&k - &n - &2) pow 2 * (&k - &n - &1) pow 2 * + (&k - &n + &1)):real`;; + +let apery_bigd_poly = REAL_POLY_CONV apery_bigd +and apery_bigd_nz = apery_prove_nz_product apery_bigd;; + +let apery_scale_fractions reduced = + map + (fun (num,den,cofactor,_) -> + let decomp = + TRANS apery_bigd_poly + (SYM(REAL_POLY_CONV(mk_binop mul_tm cofactor den))) in + MATCH_MP + (SPECL [den; apery_bigd; cofactor; num] + APERY_RAT_SCALE) + (CONJ (apery_prove_nz_product den) decomp)) + reduced;; + +let rec apery_scale_sum fractions scale_thms = + match fractions,scale_thms with + [fraction],[scale_th] -> scale_th + | fraction::rest,scale_th::scale_rest -> + let distribute = + SPECL [apery_bigd; fraction; apery_sum rest] + REAL_ADD_LDISTRIB in + TRANS distribute + (MK_COMB + (AP_TERM add_tm scale_th, + apery_scale_sum rest scale_rest)) + | _ -> failwith "apery_scale_sum";; + +let apery_prove_coefficient coeff reduced = + let summands = apery_rational_summands coeff in + let collected = + apery_abstract_identity + (apery_rational_leaves coeff) + (mk_eq(coeff,apery_sum summands)) in + let reductions = apery_reduce_fractions + (apery_make_raw summands) reduced in + let reduced_th = + TRANS collected (apery_sum_theorems reductions) in + let scaled = + apery_scale_sum + (map (fun (num,den,_,_) -> mk_binop div_tm num den) + reduced) + (apery_scale_fractions reduced) in + let scaled_zero = + TRANS scaled (REAL_POLY_CONV(rhs(concl scaled))) in + let coeff_scaled = + AP_TERM (mk_comb(mul_tm,apery_bigd)) reduced_th in + let cancel_eq = + TRANS (TRANS coeff_scaled scaled_zero) + (SYM(SPEC apery_bigd REAL_MUL_RZERO)) in + MATCH_MP (SPECL [apery_bigd; coeff; apery_zero] CANCEL_LEM) + (CONJ apery_bigd_nz cancel_eq);; + +(* Each row is (numerator, denominator, BIGD cofactor, common factor). *) +let tri_k0_reduced = [ + (`((&2 * &n + &7) * (&n + &1) pow 6 * (&12 * &n pow 4 + &144 * &n pow 3 + &643 * &n pow 2 + &1266 * &n + &928)):real`, + `(&1):real`, + `((-- &1 * &n + &k + &1) * (-- &1 * &n + &k) pow 2 * (-- &1 * &n + &k + -- &4) pow 2 * (-- &1 * &n + &k + -- &3) pow 2 * (-- &1 * &n + &k + -- &2) pow 2 * (-- &1 * &n + &k + -- &1) pow 2 * (&n + &2) pow 3 * (&n + &3) pow 3):real`, + `(&1):real`); + (`(-- &1 * (&n + &k + &2) * (&2 * &n + &5) * (&n + &k + &1) pow 2 * (&n pow 4 + &n pow 3 * &k + -- &4 * &n pow 2 * &k pow 2 + &4 * &n * &k pow 3 + &5 * &n pow 3 + -- &1 * &n pow 2 * &k + -- &2 * &n * &k pow 2 + &6 * &k pow 3 + &9 * &n pow 2 + -- &3 * &n * &k + &6 * &k pow 2 + &7 * &n + &k + &2) * (&13896 * &n pow 10 + &347400 * &n pow 9 + &3868998 * &n pow 8 + &25269960 * &n pow 7 + &107159724 * &n pow 6 + &308199360 * &n pow 5 + &608681313 * &n pow 4 + &814935630 * &n pow 3 + &707785777 * &n pow 2 + &360083510 * &n + &81495208)):real`, + `((-- &1 * &n + &k + -- &2) pow 2 * (-- &1 * &n + &k + -- &1) pow 2 * (&n + &2) pow 3):real`, + `((-- &1 * &n + &k + &1) * (-- &1 * &n + &k) pow 2 * (-- &1 * &n + &k + -- &4) pow 2 * (-- &1 * &n + &k + -- &3) pow 2 * (&n + &3) pow 3):real`, + `(&1):real`); + (`((&n + &k + &2) * (&2 * &n + &3) * (&2 * &n + &5) * (&2 * &n + &7) * (&n + &k + &1) pow 2 * (&n + &k + &3) pow 2 * (&n pow 2 + &5 * &n + &7) * (&n pow 4 + &n pow 3 * &k + -- &4 * &n pow 2 * &k pow 2 + &4 * &n * &k pow 3 + &5 * &n pow 3 + -- &1 * &n pow 2 * &k + -- &2 * &n * &k pow 2 + &6 * &k pow 3 + &9 * &n pow 2 + -- &3 * &n * &k + &6 * &k pow 2 + &7 * &n + &k + &2) * (&408 * &n pow 9 + &10404 * &n pow 8 + &117046 * &n pow 7 + &761526 * &n pow 6 + &3153520 * &n pow 5 + &8607233 * &n pow 4 + &15461616 * &n pow 3 + &17602001 * &n pow 2 + &11509566 * &n + &3291016)):real`, + `((-- &1 * &n + &k + -- &3) pow 2 * (-- &1 * &n + &k + -- &2) pow 2 * (-- &1 * &n + &k + -- &1) pow 2 * (&n + &2) pow 3 * (&n + &3) pow 3):real`, + `((-- &1 * &n + &k + &1) * (-- &1 * &n + &k) pow 2 * (-- &1 * &n + &k + -- &4) pow 2):real`, + `(&1):real`); + (`(-- &2 * (&k) * (&k + &1) * (-- &1 * &n + &k) * (&n + &k + &2) * (&n + &k + &3) * (&2 * &n + &3) * (&2 * &n + &5) * (&2 * &n + &7) * (&n + &k + &1) pow 2 * (&408 * &n pow 9 + &10404 * &n pow 8 + &117046 * &n pow 7 + &761526 * &n pow 6 + &3153520 * &n pow 5 + &8607233 * &n pow 4 + &15461616 * &n pow 3 + &17602001 * &n pow 2 + &11509566 * &n + &3291016)):real`, + `((-- &1 * &n + &k + -- &1) * (-- &1 * &n + &k + -- &3) pow 2 * (-- &1 * &n + &k + -- &2) pow 2 * (&n + &3) pow 3):real`, + `((-- &1 * &n + &k + -- &1) * (-- &1 * &n + &k + &1) * (-- &1 * &n + &k) pow 2 * (-- &1 * &n + &k + -- &4) pow 2 * (&n + &2) pow 3):real`, + `((&k + &1) pow 4):real`); + (`((&n + &k + &2) * (&n + &k + &4) * (&2 * &n + &3) * (&n + &k + &1) pow 2 * (&n + &k + &3) pow 2 * (&n + &4) pow 3 * (&n pow 4 + &n pow 3 * &k + -- &4 * &n pow 2 * &k pow 2 + &4 * &n * &k pow 3 + &5 * &n pow 3 + -- &1 * &n pow 2 * &k + -- &2 * &n * &k pow 2 + &6 * &k pow 3 + &9 * &n pow 2 + -- &3 * &n * &k + &6 * &k pow 2 + &7 * &n + &k + &2) * (&n pow 4 + &n pow 3 * &k + -- &4 * &n pow 2 * &k pow 2 + &4 * &n * &k pow 3 + &13 * &n pow 3 + &5 * &n pow 2 * &k + -- &18 * &n * &k pow 2 + &14 * &k pow 3 + &63 * &n pow 2 + &5 * &n * &k + -- &14 * &k pow 2 + &135 * &n + -- &1 * &k + &108) * (&12 * &n pow 4 + &96 * &n pow 3 + &283 * &n pow 2 + &364 * &n + &173)):real`, + `((-- &1 * &n + &k + -- &4) pow 2 * (-- &1 * &n + &k + -- &3) pow 2 * (-- &1 * &n + &k + -- &2) pow 2 * (-- &1 * &n + &k + -- &1) pow 2 * (&n + &2) pow 3):real`, + `((-- &1 * &n + &k + &1) * (-- &1 * &n + &k) pow 2 * (&n + &3) pow 3):real`, + `((&n + &4) pow 3):real`); + (`(-- &1 * (&n + &k + &2) * (&2 * &n + &3) * (&2 * &n + &5) * (&2 * &n + &7) * (&n + &k + &1) pow 2 * (&n + &k + &3) pow 2 * (&n + &k + &4) pow 2 * (&n + &4) pow 3 * (&n pow 2 + &5 * &n + &7) * (&n pow 2 + &7 * &n + &13) * (&n pow 4 + &n pow 3 * &k + -- &4 * &n pow 2 * &k pow 2 + &4 * &n * &k pow 3 + &5 * &n pow 3 + -- &1 * &n pow 2 * &k + -- &2 * &n * &k pow 2 + &6 * &k pow 3 + &9 * &n pow 2 + -- &3 * &n * &k + &6 * &k pow 2 + &7 * &n + &k + &2) * (&12 * &n pow 4 + &96 * &n pow 3 + &283 * &n pow 2 + &364 * &n + &173)):real`, + `((-- &1 * &n + &k + -- &4) pow 2 * (-- &1 * &n + &k + -- &3) pow 2 * (-- &1 * &n + &k + -- &2) pow 2 * (-- &1 * &n + &k + -- &1) pow 2 * (&n + &2) pow 3 * (&n + &3) pow 3):real`, + `((-- &1 * &n + &k + &1) * (-- &1 * &n + &k) pow 2):real`, + `((&n + &4) pow 3):real`); + (`(&2 * (&k) * (&k + &1) * (-- &1 * &n + &k) * (&n + &k + &2) * (&n + &k + &3) * (&2 * &n + &3) * (&2 * &n + &5) * (&2 * &n + &7) * (&n + &k + &1) pow 2 * (&n + &k + &4) pow 2 * (&n + &4) pow 3 * (&n pow 2 + &7 * &n + &13) * (&12 * &n pow 4 + &96 * &n pow 3 + &283 * &n pow 2 + &364 * &n + &173)):real`, + `((-- &1 * &n + &k + -- &1) * (-- &1 * &n + &k + -- &4) pow 2 * (-- &1 * &n + &k + -- &3) pow 2 * (-- &1 * &n + &k + -- &2) pow 2 * (&n + &3) pow 3):real`, + `((-- &1 * &n + &k + -- &1) * (-- &1 * &n + &k + &1) * (-- &1 * &n + &k) pow 2 * (&n + &2) pow 3):real`, + `((&n + &4) pow 3 * (&k + &1) pow 4):real`); + (`(-- &2 * (&k) * (&k + &1) * (&n + &k + &2) * (&n + &k + &4) * (&2 * &n + &3) * (&2 * &n + &7) * (&n + &k + &1) pow 2 * (&n + &k + &3) pow 2 * (&n + &4) pow 3 * (&n pow 4 + &n pow 3 * &k + -- &4 * &n pow 2 * &k pow 2 + &4 * &n * &k pow 3 + &5 * &n pow 3 + -- &1 * &n pow 2 * &k + -- &2 * &n * &k pow 2 + &6 * &k pow 3 + &9 * &n pow 2 + -- &3 * &n * &k + &6 * &k pow 2 + &7 * &n + &k + &2) * (&12 * &n pow 4 + &96 * &n pow 3 + &283 * &n pow 2 + &364 * &n + &173)):real`, + `((-- &1 * &n + &k + -- &2) * (-- &1 * &n + &k + -- &4) pow 2 * (-- &1 * &n + &k + -- &3) pow 2 * (-- &1 * &n + &k + -- &1) pow 2 * (&n + &2) pow 3):real`, + `((-- &1 * &n + &k + -- &2) * (-- &1 * &n + &k + &1) * (-- &1 * &n + &k) pow 2 * (&n + &3) pow 3):real`, + `((-- &1 * &n + &k + -- &2) pow 2 * (&n + &4) pow 3 * (&k + &1) pow 4):real`); + (`(-- &2 * (&k) * (&k + &1) * (-- &1 * &n + &k) * (&n + &k + &2) * (&n + &k + &3) * (&n + &k + &4) * (&2 * &n + &3) * (&2 * &n + &7) * (&n + &k + &1) pow 2 * (&n + &4) pow 3 * (&12 * &n pow 4 + &96 * &n pow 3 + &283 * &n pow 2 + &364 * &n + &173)):real`, + `((-- &1 * &n + &k + -- &2) * (-- &1 * &n + &k + -- &1) * (-- &1 * &n + &k + -- &4) pow 2 * (-- &1 * &n + &k + -- &3) pow 2):real`, + `((-- &1 * &n + &k + -- &2) * (-- &1 * &n + &k + -- &1) * (-- &1 * &n + &k + &1) * (-- &1 * &n + &k) pow 2 * (&n + &2) pow 3 * (&n + &3) pow 3):real`, + `((&n + &4) pow 3 * (&k + &1) pow 4):real`); + (`(&4 * (-- &1 * &n + &k) * (&n + &k + &2) * (&2 * &n + &3) * (&2 * &n + &5) * (&2 * &n + &7) * (&n + &k + &1) pow 2 * (-- &1536 * &n pow 16 + &3456 * &n pow 15 * &k + -- &768 * &n pow 14 * &k pow 2 + -- &1728 * &n pow 13 * &k pow 3 + &768 * &n pow 12 * &k pow 4 + -- &60528 * &n pow 15 + &126816 * &n pow 14 * &k + -- &25656 * &n pow 13 * &k pow 2 + -- &54000 * &n pow 12 * &k pow 3 + &21912 * &n pow 11 * &k pow 4 + -- &1112864 * &n pow 14 + &2161452 * &n pow 13 * &k + -- &395776 * &n pow 12 * &k pow 2 + -- &773892 * &n pow 11 * &k pow 3 + &284200 * &n pow 10 * &k pow 4 + -- &12672692 * &n pow 13 + &22700996 * &n pow 12 * &k + -- &3737416 * &n pow 11 * &k pow 2 + -- &6735780 * &n pow 10 * &k pow 3 + &2216476 * &n pow 9 * &k pow 4 + -- &100045044 * &n pow 12 + &164324762 * &n pow 11 * &k + -- &24141688 * &n pow 10 * &k pow 2 + -- &39735066 * &n pow 9 * &k pow 3 + &11581872 * &n pow 8 * &k pow 4 + -- &580649758 * &n pow 11 + &868552724 * &n pow 10 * &k + -- &112867728 * &n pow 9 * &k pow 2 + -- &167822636 * &n pow 8 * &k pow 3 + &42741626 * &n pow 7 * &k pow 4 + -- &2563195904 * &n pow 10 + &3463715127 * &n pow 9 * &k + -- &393976024 * &n pow 8 * &k pow 2 + -- &522321755 * &n pow 7 * &k pow 3 + &114305270 * &n pow 6 * &k pow 4 + -- &8780059211 * &n pow 9 + &10615070299 * &n pow 8 * &k + -- &1043409195 * &n pow 7 * &k pow 2 + -- &1213537345 * &n pow 6 * &k pow 3 + &223378412 * &n pow 5 * &k pow 4 + -- &23590334465 * &n pow 8 + &25213230305 * &n pow 7 * &k + -- &2107675815 * &n pow 6 * &k pow 2 + -- &2105927978 * &n pow 5 * &k pow 3 + &316850268 * &n pow 4 * &k pow 4 + -- &49892099845 * &n pow 7 + &46430650443 * &n pow 6 * &k + -- &3232783444 * &n pow 5 * &k pow 2 + -- &2697583966 * &n pow 4 * &k pow 3 + &318395514 * &n pow 3 * &k pow 4 + -- &82804140405 * &n pow 6 + &65773103407 * &n pow 5 * &k + -- &3707754246 * &n pow 4 * &k pow 2 + -- &2480670347 * &n pow 3 * &k pow 3 + &215308166 * &n pow 2 * &k pow 4 + -- &106737592607 * &n pow 5 + &70412501549 * &n pow 4 * &k + -- &3084695539 * &n pow 3 * &k pow 2 + -- &1551637801 * &n pow 2 * &k pow 3 + &88023212 * &n * &k pow 4 + -- &104788016439 * &n pow 4 + &55161938617 * &n pow 3 * &k + -- &1760380187 * &n pow 2 * &k pow 2 + -- &591932146 * &n * &k pow 3 + &16459280 * &k pow 4 + -- &75760374665 * &n pow 3 + &29864471901 * &n pow 2 * &k + -- &617004318 * &n * &k pow 2 + -- &104044952 * &k pow 3 + -- &38050160887 * &n pow 2 + &9993878458 * &n * &k + -- &100225864 * &k pow 2 + -- &11863305798 * &n + &1558612632 * &k + -- &1729998792)):real`, + `((-- &1 * &n + &k + -- &3) pow 2 * (-- &1 * &n + &k + -- &2) pow 2 * (-- &1 * &n + &k + -- &1) pow 2 * (&n + &2) pow 3 * (&n + &3) pow 3):real`, + `((-- &1 * &n + &k + &1) * (-- &1 * &n + &k) pow 2 * (-- &1 * &n + &k + -- &4) pow 2):real`, + `((&k + &1) pow 4):real`); + (`(&4 * (&n + &k + &2) * (&2 * &n + &3) * (&2 * &n + &5) * (&2 * &n + &7) * (&n + &k + &1) pow 2 * (&768 * &n pow 17 + -- &3840 * &n pow 16 * &k + &7488 * &n pow 15 * &k pow 2 + -- &6720 * &n pow 14 * &k pow 3 + -- &372 * &n pow 13 * &k pow 4 + &8772 * &n pow 12 * &k pow 5 + -- &7932 * &n pow 11 * &k pow 6 + &2124 * &n pow 10 * &k pow 7 + &29952 * &n pow 16 + -- &142944 * &n pow 15 * &k + &265824 * &n pow 14 * &k pow 2 + -- &237996 * &n pow 13 * &k pow 3 + &19416 * &n pow 12 * &k pow 4 + &237984 * &n pow 11 * &k pow 5 + -- &213480 * &n pow 10 * &k pow 6 + &53916 * &n pow 9 * &k pow 7 + &544576 * &n pow 15 + -- &2474240 * &n pow 14 * &k + &4357716 * &n pow 13 * &k pow 2 + -- &3855872 * &n pow 12 * &k pow 3 + &744971 * &n pow 11 * &k pow 4 + &2902577 * &n pow 10 * &k pow 5 + -- &2587783 * &n pow 9 * &k pow 6 + &610071 * &n pow 8 * &k pow 7 + &6126208 * &n pow 14 + -- &26432748 * &n pow 13 * &k + &43730080 * &n pow 12 * &k pow 2 + -- &37855724 * &n pow 11 * &k pow 3 + &10727224 * &n pow 10 * &k pow 4 + &20975832 * &n pow 9 * &k pow 5 + -- &18644660 * &n pow 8 * &k pow 6 + &4050412 * &n pow 7 * &k pow 7 + &47714808 * &n pow 13 + -- &195084820 * &n pow 12 * &k + &300197561 * &n pow 11 * &k pow 2 + -- &251384889 * &n pow 10 * &k pow 3 + &89274374 * &n pow 9 * &k pow 4 + &99570856 * &n pow 8 * &k pow 5 + -- &88693322 * &n pow 7 * &k pow 6 + &17466166 * &n pow 6 * &k pow 7 + &272731768 * &n pow 12 + -- &1054933184 * &n pow 11 * &k + &1492054660 * &n pow 10 * &k pow 2 + -- &1192971470 * &n pow 9 * &k pow 3 + &490183574 * &n pow 8 * &k pow 4 + &324823986 * &n pow 7 * &k pow 5 + -- &292439934 * &n pow 6 * &k pow 6 + &51093252 * &n pow 5 * &k pow 7 + &1182739932 * &n pow 11 + -- &4325363056 * &n pow 10 * &k + &5541779499 * &n pow 9 * &k pow 2 + -- &4165047879 * &n pow 8 * &k pow 3 + &1884856489 * &n pow 7 * &k pow 4 + &738412721 * &n pow 6 * &k pow 5 + -- &681856867 * &n pow 5 * &k pow 6 + &102640379 * &n pow 4 * &k pow 7 + &3965796096 * &n pow 10 + -- &13725596018 * &n pow 9 * &k + &15647797720 * &n pow 8 * &k pow 2 + -- &10841929592 * &n pow 7 * &k pow 3 + &5220078290 * &n pow 6 * &k pow 4 + &1155192868 * &n pow 5 * &k pow 5 + -- &1124111664 * &n pow 4 * &k pow 6 + &139771620 * &n pow 3 * &k pow 7 + &10374173274 * &n pow 9 + -- &34100830232 * &n pow 8 * &k + &33831285527 * &n pow 7 * &k pow 2 + -- &21072888095 * &n pow 6 * &k pow 3 + &10506074900 * &n pow 5 * &k pow 4 + &1183282330 * &n pow 4 * &k pow 5 + -- &1284061348 * &n pow 3 * &k pow 6 + &123447892 * &n pow 2 * &k pow 7 + &21183410278 * &n pow 8 + -- &66643659794 * &n pow 7 * &k + &55950436530 * &n pow 6 * &k pow 2 + -- &30281303510 * &n pow 5 * &k pow 3 + &15261668906 * &n pow 4 * &k pow 4 + &687247506 * &n pow 3 * &k pow 5 + -- &967912958 * &n pow 2 * &k pow 6 + &63848152 * &n * &k pow 7 + &33482591822 * &n pow 7 + -- &102292727676 * &n pow 6 * &k + &70135361161 * &n pow 5 * &k pow 2 + -- &31421512301 * &n pow 4 * &k pow 3 + &15611717202 * &n pow 3 * &k pow 4 + &99558080 * &n pow 2 * &k pow 5 + -- &433349940 * &n * &k pow 6 + &14685520 * &k pow 7 + &40136994726 * &n pow 6 + -- &122291049974 * &n pow 5 * &k + &65393035612 * &n pow 4 * &k pow 2 + -- &22533272612 * &n pow 3 * &k pow 3 + &10677485846 * &n pow 2 * &k pow 4 + -- &116671144 * &n * &k pow 5 + -- &87314608 * &k pow 6 + &35003178914 * &n pow 5 + -- &111916403736 * &n pow 4 * &k + &43888543364 * &n pow 3 * &k pow 2 + -- &10299559236 * &n pow 2 * &k pow 3 + &4384906476 * &n * &k pow 4 + -- &52174304 * &k pow 5 + &20240167866 * &n pow 4 + -- &76003249522 * &n pow 3 * &k + &20030425174 * &n pow 2 * &k pow 2 + -- &2539460808 * &n * &k pow 3 + &817854256 * &k pow 4 + &5677893806 * &n pow 3 + -- &36216335248 * &n pow 2 * &k + &5572107668 * &n * &k pow 2 + -- &211975120 * &k pow 3 + -- &1165461806 * &n pow 2 + -- &10842346408 * &n * &k + &716085136 * &k pow 2 + -- &1500128652 * &n + -- &1538415264 * &k + -- &371277072)):real`, + `(-- &1 * (-- &1 * &n + &k + -- &3) pow 2 * (-- &1 * &n + &k + -- &2) pow 2 * (-- &1 * &n + &k + -- &1) pow 2 * (&n + &2) pow 3 * (&n + &3) pow 3):real`, + `(-- &1 * (-- &1 * &n + &k + &1) * (-- &1 * &n + &k) pow 2 * (-- &1 * &n + &k + -- &4) pow 2):real`, + `(-- &1 * (&k + &1) * (-- &1 * &n + &k + &1) * (-- &1 * &n + &k) pow 2 * (&k + &2) pow 5):real`); + (`(&4 * (&k) * (&2 * &n + &3) * (&2 * &n + &5) * (&2 * &n + &7) * (-- &768 * &n pow 20 * &k + &3072 * &n pow 19 * &k pow 2 + -- &3648 * &n pow 18 * &k pow 3 + -- &3456 * &n pow 17 * &k pow 4 + &13044 * &n pow 16 * &k pow 5 + -- &7440 * &n pow 15 * &k pow 6 + -- &9660 * &n pow 14 * &k pow 7 + &14016 * &n pow 13 * &k pow 8 + -- &900 * &n pow 12 * &k pow 9 + -- &5808 * &n pow 11 * &k pow 10 + &2124 * &n pow 10 * &k pow 11 + -- &768 * &n pow 20 + -- &32256 * &n pow 19 * &k + &128928 * &n pow 18 * &k pow 2 + -- &144048 * &n pow 17 * &k pow 3 + -- &147696 * &n pow 16 * &k pow 4 + &482568 * &n pow 15 * &k pow 5 + -- &234732 * &n pow 14 * &k pow 6 + -- &342996 * &n pow 13 * &k pow 7 + &439032 * &n pow 12 * &k pow 8 + -- &7968 * &n pow 11 * &k pow 9 + -- &168060 * &n pow 10 * &k pow 10 + &53916 * &n pow 9 * &k pow 11 + -- &35328 * &n pow 19 + -- &631552 * &n pow 18 * &k + &2543776 * &n pow 17 * &k pow 2 + -- &2673124 * &n pow 16 * &k pow 3 + -- &2912340 * &n pow 15 * &k pow 4 + &8280997 * &n pow 14 * &k pow 5 + -- &3398600 * &n pow 13 * &k pow 6 + -- &5568967 * &n pow 12 * &k pow 7 + &6305692 * &n pow 11 * &k pow 8 + &154863 * &n pow 10 * &k pow 9 + -- &2193376 * &n pow 9 * &k pow 10 + &610071 * &n pow 8 * &k pow 11 + -- &763360 * &n pow 18 + -- &7645312 * &n pow 17 * &k + &31367368 * &n pow 16 * &k pow 2 + -- &31003896 * &n pow 15 * &k pow 3 + -- &35252851 * &n pow 14 * &k pow 4 + &87494875 * &n pow 13 * &k pow 5 + -- &29964918 * &n pow 12 * &k pow 6 + -- &54855522 * &n pow 11 * &k pow 7 + &55016357 * &n pow 10 * &k pow 8 + &3467507 * &n pow 9 * &k pow 9 + -- &17034532 * &n pow 8 * &k pow 10 + &4050412 * &n pow 7 * &k pow 11 + -- &10296800 * &n pow 17 + -- &63952392 * &n pow 16 * &k + &271060288 * &n pow 15 * &k pow 2 + -- &252131679 * &n pow 14 * &k pow 3 + -- &293786083 * &n pow 13 * &k pow 4 + &637095193 * &n pow 12 * &k pow 5 + -- &180195424 * &n pow 11 * &k pow 6 + -- &366581765 * &n pow 10 * &k pow 7 + &325582047 * &n pow 9 * &k pow 8 + &31316929 * &n pow 8 * &k pow 9 + -- &87428804 * &n pow 7 * &k pow 10 + &17466166 * &n pow 6 * &k pow 11 + -- &97183888 * &n pow 16 + -- &390926048 * &n pow 15 * &k + &1744402215 * &n pow 14 * &k pow 2 + -- &1528641105 * &n pow 13 * &k pow 3 + -- &1790786379 * &n pow 12 * &k pow 4 + &3390299217 * &n pow 11 * &k pow 5 + -- &785707110 * &n pow 10 * &k pow 6 + -- &1759973356 * &n pow 9 * &k pow 7 + &1381460896 * &n pow 8 * &k pow 8 + &169665992 * &n pow 7 * &k pow 9 + -- &311211346 * &n pow 6 * &k pow 10 + &51093252 * &n pow 5 * &k pow 11 + -- &681771968 * &n pow 15 + -- &1797543582 * &n pow 14 * &k + &8671244945 * &n pow 13 * &k pow 2 + -- &7171164950 * &n pow 12 * &k pow 3 + -- &8275822234 * &n pow 11 * &k pow 4 + &13641244822 * &n pow 10 * &k pow 5 + -- &2584329138 * &n pow 9 * &k pow 6 + -- &6267925410 * &n pow 8 * &k pow 7 + &4329005311 * &n pow 7 * &k pow 8 + &612974365 * &n pow 6 * &k pow 9 + -- &783589496 * &n pow 5 * &k pow 10 + &102640379 * &n pow 4 * &k pow 11 + -- &3685794720 * &n pow 14 + -- &6281404994 * &n pow 13 * &k + &34074345499 * &n pow 12 * &k pow 2 + -- &26657515127 * &n pow 11 * &k pow 3 + -- &29644875275 * &n pow 10 * &k pow 4 + &42343375448 * &n pow 9 * &k pow 5 + -- &6608736882 * &n pow 8 * &k pow 6 + -- &16846739030 * &n pow 7 * &k pow 7 + &10157899122 * &n pow 6 * &k pow 8 + &1536374559 * &n pow 5 * &k pow 9 + -- &1394901560 * &n pow 4 * &k pow 10 + &139771620 * &n pow 3 * &k pow 11 + -- &15710071840 * &n pow 13 + -- &16511136494 * &n pow 12 * &k + &107414839637 * &n pow 11 * &k pow 2 + -- &79729894768 * &n pow 10 * &k pow 3 + -- &83411422057 * &n pow 9 * &k pow 4 + &102510705804 * &n pow 8 * &k pow 5 + -- &13486898969 * &n pow 7 * &k pow 6 + -- &34403563419 * &n pow 6 * &k pow 7 + &17873852947 * &n pow 5 * &k pow 8 + &2693929255 * &n pow 4 * &k pow 9 + -- &1719699936 * &n pow 3 * &k pow 10 + &123447892 * &n pow 2 * &k pow 11 + -- &53560818048 * &n pow 12 + -- &31057152218 * &n pow 11 * &k + &273992904577 * &n pow 10 * &k pow 2 + -- &193594433821 * &n pow 9 * &k pow 3 + -- &185590186906 * &n pow 8 * &k pow 4 + &194292424443 * &n pow 7 * &k pow 5 + -- &22441935459 * &n pow 6 * &k pow 6 + -- &53241708152 * &n pow 5 * &k pow 7 + &23326085212 * &n pow 4 * &k pow 8 + &3251918342 * &n pow 3 * &k pow 9 + -- &1397856374 * &n pow 2 * &k pow 10 + &63848152 * &n * &k pow 11 + -- &147311006048 * &n pow 11 + -- &34242238930 * &n pow 10 * &k + &567647259943 * &n pow 9 * &k pow 2 + -- &383034928990 * &n pow 8 * &k pow 3 + -- &326900137446 * &n pow 7 * &k pow 4 + &287538055025 * &n pow 6 * &k pow 5 + -- &30741445978 * &n pow 5 * &k pow 6 + -- &61627367257 * &n pow 4 * &k pow 7 + &21970944881 * &n pow 3 * &k pow 8 + &2579633352 * &n pow 2 * &k pow 9 + -- &674057028 * &n * &k pow 10 + &14685520 * &k pow 11 + -- &328103820800 * &n pow 10 + &9342208346 * &n pow 9 * &k + &954502237105 * &n pow 8 * &k pow 2 + -- &616679187165 * &n pow 7 * &k pow 3 + -- &453776761464 * &n pow 6 * &k pow 4 + &329102354583 * &n pow 5 * &k pow 5 + -- &34208713762 * &n pow 4 * &k pow 6 + -- &51889742508 * &n pow 3 * &k pow 7 + &14155092397 * &n pow 2 * &k pow 8 + &1211927256 * &n * &k pow 9 + -- &146056688 * &k pow 10 + -- &591626761600 * &n pow 9 + &134837704206 * &n pow 8 * &k + &1295827185263 * &n pow 7 * &k pow 2 + -- &802371636049 * &n pow 6 * &k pow 3 + -- &490926362370 * &n pow 5 * &k pow 4 + &286016170951 * &n pow 4 * &k pow 5 + -- &29608827881 * &n pow 3 * &k pow 6 + -- &30134039386 * &n pow 2 * &k pow 7 + &5592448786 * &n * &k pow 8 + &255690672 * &k pow 9 + -- &859845193968 * &n pow 8 + &329600901794 * &n pow 7 * &k + &1405464163068 * &n pow 6 * &k pow 2 + -- &832398382758 * &n pow 5 * &k pow 3 + -- &405743014925 * &n pow 4 * &k pow 4 + &182888462394 * &n pow 3 * &k pow 5 + -- &18444006265 * &n pow 2 * &k pow 6 + -- &10833443724 * &n * &k pow 7 + &1023021688 * &k pow 8 + -- &998105211488 * &n pow 7 + &506405609304 * &n pow 6 * &k + &1197029877604 * &n pow 5 * &k pow 2 + -- &673265061944 * &n pow 4 * &k pow 3 + -- &247666013854 * &n pow 3 * &k pow 4 + &81436213660 * &n pow 2 * &k pow 5 + -- &7247159210 * &n * &k pow 6 + -- &1822888416 * &k pow 7 + -- &911577929600 * &n pow 6 + &555594416928 * &n pow 5 * &k + &779418105800 * &n pow 4 * &k pow 2 + -- &409497350480 * &n pow 3 * &k pow 3 + -- &105299641272 * &n pow 2 * &k pow 4 + &22679880432 * &n * &k pow 5 + -- &1333959512 * &k pow 6 + -- &639897370880 * &n pow 5 + &445980429568 * &n pow 4 * &k + &372081953600 * &n pow 3 * &k pow 2 + -- &176289543184 * &n pow 2 * &k pow 3 + -- &27857118128 * &n * &k pow 4 + &2997847184 * &k pow 5 + -- &332796611328 * &n pow 4 + &258088741728 * &n pow 3 * &k + &121546930272 * &n pow 2 * &k pow 2 + -- &47918897056 * &n * &k pow 3 + -- &3452904576 * &k pow 4 + -- &120646983168 * &n pow 3 + &102524693760 * &n pow 2 * &k + &23906184192 * &n * &k pow 2 + -- &6189000960 * &k pow 3 + -- &27184619520 * &n pow 2 + &25107052032 * &n * &k + &2077567488 * &k pow 2 + -- &2863226880 * &n + &2863226880 * &k)):real`, + `((-- &1 * &n + &k + -- &4) pow 2 * (-- &1 * &n + &k + -- &3) pow 2 * (-- &1 * &n + &k + -- &2) pow 2 * (-- &1 * &n + &k + -- &1) pow 2 * (&n + &2) pow 3 * (&n + &3) pow 3):real`, + `((-- &1 * &n + &k + &1) * (-- &1 * &n + &k) pow 2):real`, + `(&1):real`); +];; + +let tri_k1_reduced = [ + (`(-- &1 * (&2 * &n + &3) * (&2 * &n + &7) * (&408 * &n pow 9 + &7956 * &n pow 8 + &68086 * &n pow 7 + &336284 * &n pow 6 + &1058890 * &n pow 5 + &2209767 * &n pow 4 + &3063206 * &n pow 3 + &2724789 * &n pow 2 + &1413006 * &n + &325664)):real`, + `(&1):real`, + `((-- &1 * &n + &k + &1) * (-- &1 * &n + &k) pow 2 * (-- &1 * &n + &k + -- &4) pow 2 * (-- &1 * &n + &k + -- &3) pow 2 * (-- &1 * &n + &k + -- &2) pow 2 * (-- &1 * &n + &k + -- &1) pow 2 * (&n + &2) pow 3 * (&n + &3) pow 3):real`, + `(&1):real`); + (`((&2 * &n + &3) * (&2 * &n + &5) * (&n + &k + &2) pow 2 * (&n pow 2 + &3 * &n + &3) * (&13896 * &n pow 10 + &347400 * &n pow 9 + &3868998 * &n pow 8 + &25269960 * &n pow 7 + &107159724 * &n pow 6 + &308199360 * &n pow 5 + &608681313 * &n pow 4 + &814935630 * &n pow 3 + &707785777 * &n pow 2 + &360083510 * &n + &81495208)):real`, + `((-- &1 * &n + &k + -- &2) pow 2 * (&n + &2) pow 3):real`, + `((-- &1 * &n + &k + &1) * (-- &1 * &n + &k) pow 2 * (-- &1 * &n + &k + -- &4) pow 2 * (-- &1 * &n + &k + -- &3) pow 2 * (-- &1 * &n + &k + -- &1) pow 2 * (&n + &3) pow 3):real`, + `(&1):real`); + (`((&n + &k + &3) * (&2 * &n + &3) * (&2 * &n + &7) * (&n + &k + &2) pow 2 * (&n pow 4 + &n pow 3 * &k + -- &4 * &n pow 2 * &k pow 2 + &4 * &n * &k pow 3 + &9 * &n pow 3 + &2 * &n pow 2 * &k + -- &10 * &n * &k pow 2 + &10 * &k pow 3 + &30 * &n pow 2 + -- &2 * &n * &k + &44 * &n + -- &2 * &k + &24) * (&408 * &n pow 9 + &10404 * &n pow 8 + &117046 * &n pow 7 + &761526 * &n pow 6 + &3153520 * &n pow 5 + &8607233 * &n pow 4 + &15461616 * &n pow 3 + &17602001 * &n pow 2 + &11509566 * &n + &3291016)):real`, + `((-- &1 * &n + &k + -- &3) pow 2 * (-- &1 * &n + &k + -- &2) pow 2 * (&n + &3) pow 3):real`, + `((-- &1 * &n + &k + &1) * (-- &1 * &n + &k) pow 2 * (-- &1 * &n + &k + -- &4) pow 2 * (-- &1 * &n + &k + -- &1) pow 2 * (&n + &2) pow 3):real`, + `(&1):real`); + (`(-- &1 * (&2 * &n + &5) * (&2 * &n + &7) * (&n + &k + &2) pow 2 * (&n + &k + &3) pow 2 * (&2 * &n + &3) pow 2 * (&n pow 2 + &3 * &n + &3) * (&n pow 2 + &5 * &n + &7) * (&408 * &n pow 9 + &10404 * &n pow 8 + &117046 * &n pow 7 + &761526 * &n pow 6 + &3153520 * &n pow 5 + &8607233 * &n pow 4 + &15461616 * &n pow 3 + &17602001 * &n pow 2 + &11509566 * &n + &3291016)):real`, + `((-- &1 * &n + &k + -- &3) pow 2 * (-- &1 * &n + &k + -- &2) pow 2 * (&n + &2) pow 3 * (&n + &3) pow 3):real`, + `((-- &1 * &n + &k + &1) * (-- &1 * &n + &k) pow 2 * (-- &1 * &n + &k + -- &4) pow 2 * (-- &1 * &n + &k + -- &1) pow 2):real`, + `(&1):real`); + (`(&2 * (&k) * (&k + &1) * (-- &1 * &n + &k + -- &1) * (&n + &k + &3) * (&2 * &n + &3) * (&2 * &n + &5) * (&2 * &n + &7) * (&n + &k + &2) pow 2 * (&408 * &n pow 9 + &10404 * &n pow 8 + &117046 * &n pow 7 + &761526 * &n pow 6 + &3153520 * &n pow 5 + &8607233 * &n pow 4 + &15461616 * &n pow 3 + &17602001 * &n pow 2 + &11509566 * &n + &3291016)):real`, + `(-- &1 * (-- &1 * &n + &k + -- &3) pow 2 * (-- &1 * &n + &k + -- &2) pow 2 * (&n + &3) pow 3):real`, + `(-- &1 * (-- &1 * &n + &k + &1) * (-- &1 * &n + &k) pow 2 * (-- &1 * &n + &k + -- &4) pow 2 * (-- &1 * &n + &k + -- &1) pow 2 * (&n + &2) pow 3):real`, + `(-- &1 * (-- &1 * &n + &k + -- &1) * (&k + &1) pow 4):real`); + (`(-- &1 * (&n + &k + &4) * (&n + &k + &2) pow 2 * (&n + &k + &3) pow 2 * (&2 * &n + &3) pow 2 * (&n + &4) pow 3 * (&n pow 2 + &3 * &n + &3) * (&n pow 4 + &n pow 3 * &k + -- &4 * &n pow 2 * &k pow 2 + &4 * &n * &k pow 3 + &13 * &n pow 3 + &5 * &n pow 2 * &k + -- &18 * &n * &k pow 2 + &14 * &k pow 3 + &63 * &n pow 2 + &5 * &n * &k + -- &14 * &k pow 2 + &135 * &n + -- &1 * &k + &108) * (&12 * &n pow 4 + &96 * &n pow 3 + &283 * &n pow 2 + &364 * &n + &173)):real`, + `((-- &1 * &n + &k + -- &4) pow 2 * (-- &1 * &n + &k + -- &3) pow 2 * (-- &1 * &n + &k + -- &2) pow 2 * (&n + &2) pow 3):real`, + `((-- &1 * &n + &k + &1) * (-- &1 * &n + &k) pow 2 * (-- &1 * &n + &k + -- &1) pow 2 * (&n + &3) pow 3):real`, + `((&n + &4) pow 3):real`); + (`(-- &1 * (&n + &k + &3) * (&2 * &n + &3) * (&2 * &n + &7) * (&n + &k + &2) pow 2 * (&n + &k + &4) pow 2 * (&n + &4) pow 3 * (&n pow 2 + &7 * &n + &13) * (&n pow 4 + &n pow 3 * &k + -- &4 * &n pow 2 * &k pow 2 + &4 * &n * &k pow 3 + &9 * &n pow 3 + &2 * &n pow 2 * &k + -- &10 * &n * &k pow 2 + &10 * &k pow 3 + &30 * &n pow 2 + -- &2 * &n * &k + &44 * &n + -- &2 * &k + &24) * (&12 * &n pow 4 + &96 * &n pow 3 + &283 * &n pow 2 + &364 * &n + &173)):real`, + `((-- &1 * &n + &k + -- &4) pow 2 * (-- &1 * &n + &k + -- &3) pow 2 * (-- &1 * &n + &k + -- &2) pow 2 * (&n + &3) pow 3):real`, + `((-- &1 * &n + &k + &1) * (-- &1 * &n + &k) pow 2 * (-- &1 * &n + &k + -- &1) pow 2 * (&n + &2) pow 3):real`, + `((&n + &4) pow 3):real`); + (`((&2 * &n + &5) * (&2 * &n + &7) * (&n + &k + &2) pow 2 * (&n + &k + &3) pow 2 * (&n + &k + &4) pow 2 * (&2 * &n + &3) pow 2 * (&n + &4) pow 3 * (&n pow 2 + &3 * &n + &3) * (&n pow 2 + &5 * &n + &7) * (&n pow 2 + &7 * &n + &13) * (&12 * &n pow 4 + &96 * &n pow 3 + &283 * &n pow 2 + &364 * &n + &173)):real`, + `((-- &1 * &n + &k + -- &4) pow 2 * (-- &1 * &n + &k + -- &3) pow 2 * (-- &1 * &n + &k + -- &2) pow 2 * (&n + &2) pow 3 * (&n + &3) pow 3):real`, + `((-- &1 * &n + &k + &1) * (-- &1 * &n + &k) pow 2 * (-- &1 * &n + &k + -- &1) pow 2):real`, + `((&n + &4) pow 3):real`); + (`(-- &2 * (&k) * (&k + &1) * (-- &1 * &n + &k + -- &1) * (&n + &k + &3) * (&2 * &n + &3) * (&2 * &n + &5) * (&2 * &n + &7) * (&n + &k + &2) pow 2 * (&n + &k + &4) pow 2 * (&n + &4) pow 3 * (&n pow 2 + &7 * &n + &13) * (&12 * &n pow 4 + &96 * &n pow 3 + &283 * &n pow 2 + &364 * &n + &173)):real`, + `(-- &1 * (-- &1 * &n + &k + -- &4) pow 2 * (-- &1 * &n + &k + -- &3) pow 2 * (-- &1 * &n + &k + -- &2) pow 2 * (&n + &3) pow 3):real`, + `(-- &1 * (-- &1 * &n + &k + &1) * (-- &1 * &n + &k) pow 2 * (-- &1 * &n + &k + -- &1) pow 2 * (&n + &2) pow 3):real`, + `(-- &1 * (-- &1 * &n + &k + -- &1) * (&n + &4) pow 3 * (&k + &1) pow 4):real`); + (`(&2 * (&k) * (&k + &1) * (-- &1 * &n + &k + -- &1) * (&n + &k + &3) * (&n + &k + &4) * (&2 * &n + &3) * (&2 * &n + &7) * (&n + &k + &2) pow 2 * (&n + &4) pow 3 * (&12 * &n pow 4 + &96 * &n pow 3 + &283 * &n pow 2 + &364 * &n + &173)):real`, + `((-- &1 * &n + &k + -- &2) * (-- &1 * &n + &k + -- &4) pow 2 * (-- &1 * &n + &k + -- &3) pow 2):real`, + `((-- &1 * &n + &k + -- &2) * (-- &1 * &n + &k + &1) * (-- &1 * &n + &k) pow 2 * (-- &1 * &n + &k + -- &1) pow 2 * (&n + &2) pow 3 * (&n + &3) pow 3):real`, + `((&n + &4) pow 3 * (&k + &1) pow 4):real`); + (`(&2 * (&k) * (&k + &1) * (&n + &k + &4) * (&2 * &n + &7) * (&n + &k + &2) pow 2 * (&n + &k + &3) pow 2 * (&2 * &n + &3) pow 2 * (&n + &4) pow 3 * (&n pow 2 + &3 * &n + &3) * (&12 * &n pow 4 + &96 * &n pow 3 + &283 * &n pow 2 + &364 * &n + &173)):real`, + `((-- &1 * &n + &k + -- &2) * (-- &1 * &n + &k + -- &4) pow 2 * (-- &1 * &n + &k + -- &3) pow 2 * (&n + &2) pow 3):real`, + `((-- &1 * &n + &k + -- &2) * (-- &1 * &n + &k + &1) * (-- &1 * &n + &k) pow 2 * (-- &1 * &n + &k + -- &1) pow 2 * (&n + &3) pow 3):real`, + `((-- &1 * &n + &k + -- &2) pow 2 * (&n + &4) pow 3 * (&k + &1) pow 4):real`); + (`(&2 * (&k) * (&k + &1) * (-- &1 * &n + &k + -- &1) * (&n + &k + &3) * (&n + &k + &4) * (&2 * &n + &3) * (&2 * &n + &7) * (&n + &k + &2) pow 2 * (&n + &4) pow 3 * (&12 * &n pow 4 + &96 * &n pow 3 + &283 * &n pow 2 + &364 * &n + &173)):real`, + `(-- &1 * (-- &1 * &n + &k + -- &2) * (-- &1 * &n + &k + -- &4) pow 2 * (-- &1 * &n + &k + -- &3) pow 2):real`, + `(-- &1 * (-- &1 * &n + &k + -- &2) * (-- &1 * &n + &k + &1) * (-- &1 * &n + &k) pow 2 * (-- &1 * &n + &k + -- &1) pow 2 * (&n + &2) pow 3 * (&n + &3) pow 3):real`, + `(-- &1 * (-- &1 * &n + &k + -- &1) * (&n + &4) pow 3 * (&k + &1) pow 4):real`); + (`(&4 * (&2 * &n + &3) * (&2 * &n + &5) * (&2 * &n + &7) * (&n + &k + &2) pow 2 * (-- &1536 * &n pow 16 + &3456 * &n pow 15 * &k + -- &768 * &n pow 14 * &k pow 2 + -- &1728 * &n pow 13 * &k pow 3 + &768 * &n pow 12 * &k pow 4 + -- &60528 * &n pow 15 + &126816 * &n pow 14 * &k + -- &25656 * &n pow 13 * &k pow 2 + -- &54000 * &n pow 12 * &k pow 3 + &21912 * &n pow 11 * &k pow 4 + -- &1112864 * &n pow 14 + &2161452 * &n pow 13 * &k + -- &395776 * &n pow 12 * &k pow 2 + -- &773892 * &n pow 11 * &k pow 3 + &284200 * &n pow 10 * &k pow 4 + -- &12672692 * &n pow 13 + &22700996 * &n pow 12 * &k + -- &3737416 * &n pow 11 * &k pow 2 + -- &6735780 * &n pow 10 * &k pow 3 + &2216476 * &n pow 9 * &k pow 4 + -- &100045044 * &n pow 12 + &164324762 * &n pow 11 * &k + -- &24141688 * &n pow 10 * &k pow 2 + -- &39735066 * &n pow 9 * &k pow 3 + &11581872 * &n pow 8 * &k pow 4 + -- &580649758 * &n pow 11 + &868552724 * &n pow 10 * &k + -- &112867728 * &n pow 9 * &k pow 2 + -- &167822636 * &n pow 8 * &k pow 3 + &42741626 * &n pow 7 * &k pow 4 + -- &2563195904 * &n pow 10 + &3463715127 * &n pow 9 * &k + -- &393976024 * &n pow 8 * &k pow 2 + -- &522321755 * &n pow 7 * &k pow 3 + &114305270 * &n pow 6 * &k pow 4 + -- &8780059211 * &n pow 9 + &10615070299 * &n pow 8 * &k + -- &1043409195 * &n pow 7 * &k pow 2 + -- &1213537345 * &n pow 6 * &k pow 3 + &223378412 * &n pow 5 * &k pow 4 + -- &23590334465 * &n pow 8 + &25213230305 * &n pow 7 * &k + -- &2107675815 * &n pow 6 * &k pow 2 + -- &2105927978 * &n pow 5 * &k pow 3 + &316850268 * &n pow 4 * &k pow 4 + -- &49892099845 * &n pow 7 + &46430650443 * &n pow 6 * &k + -- &3232783444 * &n pow 5 * &k pow 2 + -- &2697583966 * &n pow 4 * &k pow 3 + &318395514 * &n pow 3 * &k pow 4 + -- &82804140405 * &n pow 6 + &65773103407 * &n pow 5 * &k + -- &3707754246 * &n pow 4 * &k pow 2 + -- &2480670347 * &n pow 3 * &k pow 3 + &215308166 * &n pow 2 * &k pow 4 + -- &106737592607 * &n pow 5 + &70412501549 * &n pow 4 * &k + -- &3084695539 * &n pow 3 * &k pow 2 + -- &1551637801 * &n pow 2 * &k pow 3 + &88023212 * &n * &k pow 4 + -- &104788016439 * &n pow 4 + &55161938617 * &n pow 3 * &k + -- &1760380187 * &n pow 2 * &k pow 2 + -- &591932146 * &n * &k pow 3 + &16459280 * &k pow 4 + -- &75760374665 * &n pow 3 + &29864471901 * &n pow 2 * &k + -- &617004318 * &n * &k pow 2 + -- &104044952 * &k pow 3 + -- &38050160887 * &n pow 2 + &9993878458 * &n * &k + -- &100225864 * &k pow 2 + -- &11863305798 * &n + &1558612632 * &k + -- &1729998792)):real`, + `((-- &1 * &n + &k + -- &3) pow 2 * (-- &1 * &n + &k + -- &2) pow 2 * (&n + &2) pow 3 * (&n + &3) pow 3):real`, + `((-- &1 * &n + &k + &1) * (-- &1 * &n + &k) pow 2 * (-- &1 * &n + &k + -- &4) pow 2 * (-- &1 * &n + &k + -- &1) pow 2):real`, + `((-- &1 * &n + &k + -- &1) pow 2 * (&k + &1) pow 4):real`); + (`(-- &4 * (&2 * &n + &3) * (&2 * &n + &5) * (&2 * &n + &7) * (&k) pow 4 * (-- &1536 * &n pow 16 + &3456 * &n pow 15 * &k + -- &768 * &n pow 14 * &k pow 2 + -- &1728 * &n pow 13 * &k pow 3 + &768 * &n pow 12 * &k pow 4 + -- &63984 * &n pow 15 + &128352 * &n pow 14 * &k + -- &20472 * &n pow 13 * &k pow 2 + -- &57072 * &n pow 12 * &k pow 3 + &21912 * &n pow 11 * &k pow 4 + -- &1240448 * &n pow 14 + &2207580 * &n pow 13 * &k + -- &229168 * &n pow 12 * &k pow 2 + -- &861540 * &n pow 11 * &k pow 3 + &284200 * &n pow 10 * &k pow 4 + -- &14858072 * &n pow 13 + &23327476 * &n pow 12 * &k + -- &1284268 * &n pow 11 * &k pow 2 + -- &7872580 * &n pow 10 * &k pow 3 + &2216476 * &n pow 9 * &k pow 4 + -- &123087048 * &n pow 12 + &169390270 * &n pow 11 * &k + -- &2229148 * &n pow 10 * &k pow 2 + -- &48600970 * &n pow 9 * &k pow 3 + &11581872 * &n pow 8 * &k pow 4 + -- &747916132 * &n pow 11 + &895491960 * &n pow 10 * &k + &19636326 * &n pow 9 * &k pow 2 + -- &214150124 * &n pow 8 * &k pow 3 + &42741626 * &n pow 7 * &k pow 4 + -- &3448870336 * &n pow 10 + &3561379481 * &n pow 9 * &k + &178983116 * &n pow 8 * &k pow 2 + -- &693288259 * &n pow 7 * &k pow 3 + &114305270 * &n pow 6 * &k pow 4 + -- &12314690524 * &n pow 9 + &10853226951 * &n pow 8 * &k + &780005826 * &n pow 7 * &k pow 2 + -- &1670758425 * &n pow 6 * &k pow 3 + &223378412 * &n pow 5 * &k pow 4 + -- &34419976280 * &n pow 8 + &25562116926 * &n pow 7 * &k + &2218767840 * &n pow 6 * &k pow 2 + -- &2999441626 * &n pow 5 * &k pow 3 + &316850268 * &n pow 4 * &k pow 4 + -- &75583675964 * &n pow 7 + &46548168958 * &n pow 6 * &k + &4425270962 * &n pow 5 * &k pow 2 + -- &3964985038 * &n pow 4 * &k pow 3 + &318395514 * &n pow 3 * &k pow 4 + -- &130014624048 * &n pow 6 + &65027372713 * &n pow 5 * &k + &6286099260 * &n pow 4 * &k pow 2 + -- &3754252403 * &n pow 3 * &k pow 3 + &215308166 * &n pow 2 * &k pow 4 + -- &173414173068 * &n pow 5 + &68467857071 * &n pow 4 * &k + &6267688586 * &n pow 3 * &k pow 2 + -- &2412870465 * &n pow 2 * &k pow 3 + &88023212 * &n * &k pow 4 + -- &175893838000 * &n pow 4 + &52615736598 * &n pow 3 * &k + &4186382212 * &n pow 2 * &k pow 2 + -- &944024994 * &n * &k pow 3 + &16459280 * &k pow 4 + -- &131207942960 * &n pow 3 + &27869086208 * &n pow 2 * &k + &1686931392 * &n * &k pow 2 + -- &169882072 * &k pow 3 + -- &67908067008 * &n pow 2 + &9099997808 * &n * &k + &310664672 * &k pow 2 + -- &21794233216 * &n + &1381092384 * &k + -- &3268333056)):real`, + `((-- &1 * &n + &k + -- &4) pow 2 * (-- &1 * &n + &k + -- &3) pow 2 * (-- &1 * &n + &k + -- &2) pow 2 * (&n + &2) pow 3 * (&n + &3) pow 3):real`, + `((-- &1 * &n + &k + &1) * (-- &1 * &n + &k) pow 2 * (-- &1 * &n + &k + -- &1) pow 2):real`, + `(&1):real`); +];; + +let tri_k2_reduced = [ + (`(&2 * (&k) * (&n + &k + &2) * (&2 * &n + &3) * (&2 * &n + &5) * (&k + &1) pow 5 * (&13896 * &n pow 10 + &347400 * &n pow 9 + &3868998 * &n pow 8 + &25269960 * &n pow 7 + &107159724 * &n pow 6 + &308199360 * &n pow 5 + &608681313 * &n pow 4 + &814935630 * &n pow 3 + &707785777 * &n pow 2 + &360083510 * &n + &81495208)):real`, + `((-- &1 * &n + &k) * (-- &1 * &n + &k + -- &2) pow 2 * (-- &1 * &n + &k + -- &1) pow 2 * (&n + &2) pow 3):real`, + `((-- &1 * &n + &k) * (-- &1 * &n + &k + &1) * (-- &1 * &n + &k + -- &4) pow 2 * (-- &1 * &n + &k + -- &3) pow 2 * (&n + &3) pow 3):real`, + `(&1):real`); + (`(-- &2 * (&k) * (&n + &k + &2) * (&2 * &n + &5) * (&2 * &n + &7) * (&n + &k + &3) pow 2 * (&2 * &n + &3) pow 2 * (&k + &1) pow 5 * (&n pow 2 + &5 * &n + &7) * (&408 * &n pow 9 + &10404 * &n pow 8 + &117046 * &n pow 7 + &761526 * &n pow 6 + &3153520 * &n pow 5 + &8607233 * &n pow 4 + &15461616 * &n pow 3 + &17602001 * &n pow 2 + &11509566 * &n + &3291016)):real`, + `((-- &1 * &n + &k) * (-- &1 * &n + &k + -- &3) pow 2 * (-- &1 * &n + &k + -- &2) pow 2 * (-- &1 * &n + &k + -- &1) pow 2 * (&n + &2) pow 3 * (&n + &3) pow 3):real`, + `((-- &1 * &n + &k) * (-- &1 * &n + &k + &1) * (-- &1 * &n + &k + -- &4) pow 2):real`, + `(&1):real`); + (`(&2 * (&k) * (&n + &k + &2) * (&n + &k + &3) * (&2 * &n + &3) * (&2 * &n + &5) * (&2 * &n + &7) * (&k + &1) pow 5 * (&408 * &n pow 9 + &10404 * &n pow 8 + &117046 * &n pow 7 + &761526 * &n pow 6 + &3153520 * &n pow 5 + &8607233 * &n pow 4 + &15461616 * &n pow 3 + &17602001 * &n pow 2 + &11509566 * &n + &3291016)):real`, + `((-- &1 * &n + &k) * (-- &1 * &n + &k + -- &1) * (-- &1 * &n + &k + -- &3) pow 2 * (-- &1 * &n + &k + -- &2) pow 2 * (&n + &3) pow 3):real`, + `((-- &1 * &n + &k) * (-- &1 * &n + &k + -- &1) * (-- &1 * &n + &k + &1) * (-- &1 * &n + &k + -- &4) pow 2 * (&n + &2) pow 3):real`, + `(&1):real`); + (`(-- &2 * (&k) * (&n + &k + &2) * (&n + &k + &4) * (&n + &k + &3) pow 2 * (&2 * &n + &3) pow 2 * (&n + &4) pow 3 * (&k + &1) pow 5 * (&n pow 4 + &n pow 3 * &k + -- &4 * &n pow 2 * &k pow 2 + &4 * &n * &k pow 3 + &13 * &n pow 3 + &5 * &n pow 2 * &k + -- &18 * &n * &k pow 2 + &14 * &k pow 3 + &63 * &n pow 2 + &5 * &n * &k + -- &14 * &k pow 2 + &135 * &n + -- &1 * &k + &108) * (&12 * &n pow 4 + &96 * &n pow 3 + &283 * &n pow 2 + &364 * &n + &173)):real`, + `((-- &1 * &n + &k) * (-- &1 * &n + &k + -- &4) pow 2 * (-- &1 * &n + &k + -- &3) pow 2 * (-- &1 * &n + &k + -- &2) pow 2 * (-- &1 * &n + &k + -- &1) pow 2 * (&n + &2) pow 3):real`, + `((-- &1 * &n + &k) * (-- &1 * &n + &k + &1) * (&n + &3) pow 3):real`, + `((&n + &4) pow 3):real`); + (`(&2 * (&k) * (&n + &k + &2) * (&2 * &n + &5) * (&2 * &n + &7) * (&n + &k + &3) pow 2 * (&n + &k + &4) pow 2 * (&2 * &n + &3) pow 2 * (&n + &4) pow 3 * (&k + &1) pow 5 * (&n pow 2 + &5 * &n + &7) * (&n pow 2 + &7 * &n + &13) * (&12 * &n pow 4 + &96 * &n pow 3 + &283 * &n pow 2 + &364 * &n + &173)):real`, + `((-- &1 * &n + &k) * (-- &1 * &n + &k + -- &4) pow 2 * (-- &1 * &n + &k + -- &3) pow 2 * (-- &1 * &n + &k + -- &2) pow 2 * (-- &1 * &n + &k + -- &1) pow 2 * (&n + &2) pow 3 * (&n + &3) pow 3):real`, + `((-- &1 * &n + &k) * (-- &1 * &n + &k + &1)):real`, + `((&n + &4) pow 3):real`); + (`(-- &2 * (&k) * (&n + &k + &2) * (&n + &k + &3) * (&2 * &n + &3) * (&2 * &n + &5) * (&2 * &n + &7) * (&n + &k + &4) pow 2 * (&n + &4) pow 3 * (&k + &1) pow 5 * (&n pow 2 + &7 * &n + &13) * (&12 * &n pow 4 + &96 * &n pow 3 + &283 * &n pow 2 + &364 * &n + &173)):real`, + `((-- &1 * &n + &k) * (-- &1 * &n + &k + -- &1) * (-- &1 * &n + &k + -- &4) pow 2 * (-- &1 * &n + &k + -- &3) pow 2 * (-- &1 * &n + &k + -- &2) pow 2 * (&n + &3) pow 3):real`, + `((-- &1 * &n + &k) * (-- &1 * &n + &k + -- &1) * (-- &1 * &n + &k + &1) * (&n + &2) pow 3):real`, + `((&n + &4) pow 3):real`); + (`(&4 * (&n + &k + &2) * (&n + &k + &4) * (&2 * &n + &7) * (&k) pow 2 * (&n + &k + &3) pow 2 * (&2 * &n + &3) pow 2 * (&n + &4) pow 3 * (&k + &1) pow 6 * (&12 * &n pow 4 + &96 * &n pow 3 + &283 * &n pow 2 + &364 * &n + &173)):real`, + `((-- &1 * &n + &k) * (-- &1 * &n + &k + -- &2) * (-- &1 * &n + &k + -- &4) pow 2 * (-- &1 * &n + &k + -- &3) pow 2 * (-- &1 * &n + &k + -- &1) pow 2 * (&n + &2) pow 3):real`, + `((-- &1 * &n + &k) * (-- &1 * &n + &k + -- &2) * (-- &1 * &n + &k + &1) * (&n + &3) pow 3):real`, + `((-- &1 * &n + &k + -- &2) pow 2 * (&n + &4) pow 3 * (&k + &1) pow 4):real`); + (`(&2 * (&k) * (&n + &k + &2) * (&n + &k + &3) * (&n + &k + &4) * (&2 * &n + &3) * (&2 * &n + &7) * (&n + &4) pow 3 * (&k + &1) pow 5 * (&12 * &n pow 4 + &96 * &n pow 3 + &283 * &n pow 2 + &364 * &n + &173)):real`, + `((-- &1 * &n + &k) * (-- &1 * &n + &k + -- &2) * (-- &1 * &n + &k + -- &1) * (-- &1 * &n + &k + -- &4) pow 2 * (-- &1 * &n + &k + -- &3) pow 2):real`, + `((-- &1 * &n + &k) * (-- &1 * &n + &k + -- &2) * (-- &1 * &n + &k + -- &1) * (-- &1 * &n + &k + &1) * (&n + &2) pow 3 * (&n + &3) pow 3):real`, + `((&n + &4) pow 3):real`); + (`(-- &4 * (&k + &1) * (&2 * &n + &3) * (&2 * &n + &5) * (&2 * &n + &7) * (-- &768 * &n pow 20 * &k + &3072 * &n pow 19 * &k pow 2 + -- &3648 * &n pow 18 * &k pow 3 + -- &3456 * &n pow 17 * &k pow 4 + &13044 * &n pow 16 * &k pow 5 + -- &7440 * &n pow 15 * &k pow 6 + -- &9660 * &n pow 14 * &k pow 7 + &14016 * &n pow 13 * &k pow 8 + -- &900 * &n pow 12 * &k pow 9 + -- &5808 * &n pow 11 * &k pow 10 + &2124 * &n pow 10 * &k pow 11 + -- &1536 * &n pow 20 + -- &26112 * &n pow 19 * &k + &117984 * &n pow 18 * &k pow 2 + -- &157872 * &n pow 17 * &k pow 3 + -- &82476 * &n pow 16 * &k pow 4 + &437928 * &n pow 15 * &k pow 5 + -- &302352 * &n pow 14 * &k pow 6 + -- &230868 * &n pow 13 * &k pow 7 + &430932 * &n pow 12 * &k pow 8 + -- &66048 * &n pow 11 * &k pow 9 + -- &144696 * &n pow 10 * &k pow 10 + &53916 * &n pow 9 * &k pow 11 + -- &64512 * &n pow 19 + -- &384640 * &n pow 18 * &k + &2090896 * &n pow 17 * &k pow 2 + -- &3133468 * &n pow 16 * &k pow 3 + -- &611100 * &n pow 15 * &k pow 4 + &6669745 * &n pow 14 * &k pow 5 + -- &5407124 * &n pow 13 * &k pow 6 + -- &2089111 * &n pow 12 * &k pow 7 + &5972620 * &n pow 11 * &k pow 8 + -- &1408917 * &n pow 10 * &k pow 9 + -- &1600300 * &n pow 9 * &k pow 10 + &610071 * &n pow 8 * &k pow 11 + -- &1269632 * &n pow 18 + -- &3003728 * &n pow 17 * &k + &22592260 * &n pow 16 * &k pow 2 + -- &37976376 * &n pow 15 * &k pow 3 + &2293054 * &n pow 14 * &k pow 4 + &60685255 * &n pow 13 * &k pow 5 + -- &56730391 * &n pow 12 * &k pow 6 + -- &5393794 * &n pow 11 * &k pow 7 + &49197884 * &n pow 10 * &k pow 8 + -- &15500873 * &n pow 9 * &k pow 9 + -- &10323751 * &n pow 8 * &k pow 10 + &4050412 * &n pow 7 * &k pow 11 + -- &15545840 * &n pow 17 + -- &9762592 * &n pow 16 * &k + &165288640 * &n pow 15 * &k pow 2 + -- &315365853 * &n pow 14 * &k pow 3 + &81685552 * &n pow 13 * &k pow 4 + &364829770 * &n pow 12 * &k pow 5 + -- &389513694 * &n pow 11 * &k pow 6 + &59657879 * &n pow 10 * &k pow 7 + &266983830 * &n pow 9 * &k pow 8 + -- &105474486 * &n pow 8 * &k pow 9 + -- &42874272 * &n pow 7 * &k pow 10 + &17466166 * &n pow 6 * &k pow 11 + -- &132576688 * &n pow 16 + &48901680 * &n pow 15 * &k + &855576202 * &n pow 14 * &k pow 2 + -- &1908028651 * &n pow 13 * &k pow 3 + &780920811 * &n pow 12 * &k pow 4 + &1507811879 * &n pow 11 * &k pow 5 + -- &1832624289 * &n pow 10 * &k pow 6 + &724100432 * &n pow 9 * &k pow 7 + &997421032 * &n pow 8 * &k pow 8 + -- &481849388 * &n pow 7 * &k pow 9 + -- &119083520 * &n pow 6 * &k pow 10 + &51093252 * &n pow 5 * &k pow 11 + -- &835078836 * &n pow 15 + &833783380 * &n pow 14 * &k + &3139764414 * &n pow 13 * &k pow 2 + -- &8733060549 * &n pow 12 * &k pow 3 + &4491974013 * &n pow 11 * &k pow 4 + &4287843995 * &n pow 10 * &k pow 5 + -- &5932274494 * &n pow 9 * &k pow 6 + &4068350792 * &n pow 8 * &k pow 7 + &2590021039 * &n pow 7 * &k pow 8 + -- &1538499965 * &n pow 6 * &k pow 9 + -- &221563724 * &n pow 5 * &k pow 10 + &102640379 * &n pow 4 * &k pow 11 + -- &4018284012 * &n pow 14 + &5714811180 * &n pow 13 * &k + &7632922724 * &n pow 12 * &k pow 2 + -- &31029911163 * &n pow 11 * &k pow 3 + &17781446458 * &n pow 10 * &k pow 4 + &8019639098 * &n pow 9 * &k pow 5 + -- &12468086546 * &n pow 8 * &k pow 6 + &14738458650 * &n pow 7 * &k pow 7 + &4552075227 * &n pow 6 * &k pow 8 + -- &3489391541 * &n pow 5 * &k pow 9 + -- &265857391 * &n pow 4 * &k pow 10 + &139771620 * &n pow 3 * &k pow 11 + -- &15058891782 * &n pow 13 + &25931121982 * &n pow 12 * &k + &8011466868 * &n pow 11 * &k pow 2 + -- &87367343879 * &n pow 10 * &k pow 3 + &50726283145 * &n pow 9 * &k pow 4 + &8528744870 * &n pow 8 * &k pow 5 + -- &12438738639 * &n pow 7 * &k pow 6 + &37345179957 * &n pow 6 * &k pow 7 + &4870083238 * &n pow 5 * &k pow 8 + -- &5609865500 * &n pow 4 * &k pow 9 + -- &182212116 * &n pow 3 * &k pow 10 + &123447892 * &n pow 2 * &k pow 11 + -- &44357560932 * &n pow 12 + &86233343370 * &n pow 11 * &k + -- &24598819688 * &n pow 10 * &k pow 2 + -- &198822461549 * &n pow 9 * &k pow 3 + &105727167018 * &n pow 8 * &k pow 4 + &3230955143 * &n pow 7 * &k pow 5 + &15359128716 * &n pow 6 * &k pow 6 + &67888633188 * &n pow 5 * &k pow 7 + &1736540842 * &n pow 4 * &k pow 8 + -- &6257641918 * &n pow 3 * &k pow 9 + -- &39929562 * &n pow 2 * &k pow 10 + &63848152 * &n * &k pow 11 + -- &102725115803 * &n pow 11 + &217340161302 * &n pow 10 * &k + -- &156749805900 * &n pow 9 * &k pow 2 + -- &373791795477 * &n pow 8 * &k pow 3 + &160007508066 * &n pow 7 * &k pow 4 + &6132840794 * &n pow 6 * &k pow 5 + &85141230694 * &n pow 5 * &k pow 6 + &88445905489 * &n pow 4 * &k pow 7 + -- &3085969861 * &n pow 3 * &k pow 8 + -- &4609296328 * &n pow 2 * &k pow 9 + &28272644 * &n * &k pow 10 + &14685520 * &k pow 11 + -- &185183963965 * &n pow 10 + &416713350716 * &n pow 9 * &k + -- &474718785604 * &n pow 8 * &k pow 2 + -- &593876235705 * &n pow 7 * &k pow 3 + &171856922761 * &n pow 6 * &k pow 4 + &47237296421 * &n pow 5 * &k pow 5 + &168310686293 * &n pow 4 * &k pow 6 + &80707519132 * &n pow 3 * &k pow 7 + -- &5162842085 * &n pow 2 * &k pow 8 + -- &2016994664 * &n * &k pow 9 + &15484032 * &k pow 10 + -- &253317166141 * &n pow 9 + &592572178670 * &n pow 8 * &k + -- &1005163359743 * &n pow 7 * &k pow 2 + -- &809192807138 * &n pow 6 * &k pow 3 + &127063815279 * &n pow 5 * &k pow 4 + &128189695962 * &n pow 4 * &k pow 5 + &198948073839 * &n pow 3 * &k pow 6 + &48968539942 * &n pow 2 * &k pow 7 + -- &3297827090 * &n * &k pow 8 + -- &397172608 * &k pow 9 + -- &248099971677 * &n pow 8 + &571560019140 * &n pow 7 * &k + -- &1614590246181 * &n pow 6 * &k pow 2 + -- &938978116240 * &n pow 5 * &k pow 3 + &67452327845 * &n pow 4 * &k pow 4 + &186875631436 * &n pow 3 * &k pow 5 + &147132594281 * &n pow 2 * &k pow 6 + &17718574580 * &n * &k pow 7 + -- &825202424 * &k pow 8 + -- &147882369687 * &n pow 7 + &241185676502 * &n pow 6 * &k + -- &2010571491742 * &n pow 5 * &k pow 2 + -- &895109236742 * &n pow 4 * &k pow 3 + &39198392923 * &n pow 3 * &k pow 4 + &160449445404 * &n pow 2 * &k pow 5 + &63255060578 * &n * &k pow 6 + &2885568320 * &k pow 7 + -- &14686870287 * &n pow 6 + -- &273330960216 * &n pow 5 * &k + -- &1928992389138 * &n pow 4 * &k pow 2 + -- &659361948312 * &n pow 3 * &k pow 3 + &33608190505 * &n pow 2 * &k pow 4 + &77210048408 * &n * &k pow 5 + &12141251048 * &k pow 6 + &53199110239 * &n pow 5 + -- &646479529420 * &n pow 4 * &k + -- &1384782108947 * &n pow 3 * &k pow 2 + -- &344696962382 * &n pow 2 * &k pow 3 + &21356529098 * &n * &k pow 4 + &16198097440 * &k pow 5 + &28501690389 * &n pow 4 + -- &653966998214 * &n pow 3 * &k + -- &701136846375 * &n pow 2 * &k pow 2 + -- &112035156548 * &n * &k pow 3 + &5728704056 * &k pow 4 + -- &22606825262 * &n pow 3 + -- &395033082912 * &n pow 2 * &k + -- &223007088454 * &n * &k pow 2 + -- &16838893008 * &k pow 3 + -- &36383694668 * &n pow 2 + -- &138574707448 * &n * &k + -- &33433816328 * &k pow 2 + -- &18832561176 * &n + -- &21948636000 * &k + -- &3712770720)):real`, + `((-- &1 * &n + &k) pow 2 * (-- &1 * &n + &k + -- &3) pow 2 * (-- &1 * &n + &k + -- &2) pow 2 * (-- &1 * &n + &k + -- &1) pow 2 * (&n + &2) pow 3 * (&n + &3) pow 3):real`, + `((-- &1 * &n + &k + &1) * (-- &1 * &n + &k + -- &4) pow 2):real`, + `(&1):real`); + (`(-- &4 * (&n + &k + &2) * (&2 * &n + &3) * (&2 * &n + &5) * (&2 * &n + &7) * (&k + &1) pow 4 * (-- &1536 * &n pow 16 + &3456 * &n pow 15 * &k + -- &768 * &n pow 14 * &k pow 2 + -- &1728 * &n pow 13 * &k pow 3 + &768 * &n pow 12 * &k pow 4 + -- &60528 * &n pow 15 + &126816 * &n pow 14 * &k + -- &25656 * &n pow 13 * &k pow 2 + -- &54000 * &n pow 12 * &k pow 3 + &21912 * &n pow 11 * &k pow 4 + -- &1112864 * &n pow 14 + &2161452 * &n pow 13 * &k + -- &395776 * &n pow 12 * &k pow 2 + -- &773892 * &n pow 11 * &k pow 3 + &284200 * &n pow 10 * &k pow 4 + -- &12672692 * &n pow 13 + &22700996 * &n pow 12 * &k + -- &3737416 * &n pow 11 * &k pow 2 + -- &6735780 * &n pow 10 * &k pow 3 + &2216476 * &n pow 9 * &k pow 4 + -- &100045044 * &n pow 12 + &164324762 * &n pow 11 * &k + -- &24141688 * &n pow 10 * &k pow 2 + -- &39735066 * &n pow 9 * &k pow 3 + &11581872 * &n pow 8 * &k pow 4 + -- &580649758 * &n pow 11 + &868552724 * &n pow 10 * &k + -- &112867728 * &n pow 9 * &k pow 2 + -- &167822636 * &n pow 8 * &k pow 3 + &42741626 * &n pow 7 * &k pow 4 + -- &2563195904 * &n pow 10 + &3463715127 * &n pow 9 * &k + -- &393976024 * &n pow 8 * &k pow 2 + -- &522321755 * &n pow 7 * &k pow 3 + &114305270 * &n pow 6 * &k pow 4 + -- &8780059211 * &n pow 9 + &10615070299 * &n pow 8 * &k + -- &1043409195 * &n pow 7 * &k pow 2 + -- &1213537345 * &n pow 6 * &k pow 3 + &223378412 * &n pow 5 * &k pow 4 + -- &23590334465 * &n pow 8 + &25213230305 * &n pow 7 * &k + -- &2107675815 * &n pow 6 * &k pow 2 + -- &2105927978 * &n pow 5 * &k pow 3 + &316850268 * &n pow 4 * &k pow 4 + -- &49892099845 * &n pow 7 + &46430650443 * &n pow 6 * &k + -- &3232783444 * &n pow 5 * &k pow 2 + -- &2697583966 * &n pow 4 * &k pow 3 + &318395514 * &n pow 3 * &k pow 4 + -- &82804140405 * &n pow 6 + &65773103407 * &n pow 5 * &k + -- &3707754246 * &n pow 4 * &k pow 2 + -- &2480670347 * &n pow 3 * &k pow 3 + &215308166 * &n pow 2 * &k pow 4 + -- &106737592607 * &n pow 5 + &70412501549 * &n pow 4 * &k + -- &3084695539 * &n pow 3 * &k pow 2 + -- &1551637801 * &n pow 2 * &k pow 3 + &88023212 * &n * &k pow 4 + -- &104788016439 * &n pow 4 + &55161938617 * &n pow 3 * &k + -- &1760380187 * &n pow 2 * &k pow 2 + -- &591932146 * &n * &k pow 3 + &16459280 * &k pow 4 + -- &75760374665 * &n pow 3 + &29864471901 * &n pow 2 * &k + -- &617004318 * &n * &k pow 2 + -- &104044952 * &k pow 3 + -- &38050160887 * &n pow 2 + &9993878458 * &n * &k + -- &100225864 * &k pow 2 + -- &11863305798 * &n + &1558612632 * &k + -- &1729998792)):real`, + `((-- &1 * &n + &k) * (-- &1 * &n + &k + -- &3) pow 2 * (-- &1 * &n + &k + -- &2) pow 2 * (-- &1 * &n + &k + -- &1) pow 2 * (&n + &2) pow 3 * (&n + &3) pow 3):real`, + `((-- &1 * &n + &k) * (-- &1 * &n + &k + &1) * (-- &1 * &n + &k + -- &4) pow 2):real`, + `(&1):real`); + (`(-- &4 * (&k + &1) * (&n + &k + &2) * (&2 * &n + &3) * (&2 * &n + &5) * (&2 * &n + &7) * (-- &1 * &n pow 2 * &k + &2 * &k pow 3 + -- &2 * &n pow 2 + -- &1 * &n * &k + &8 * &k pow 2 + -- &2 * &n + &11 * &k + &5) * (&768 * &n pow 17 + -- &3840 * &n pow 16 * &k + &7488 * &n pow 15 * &k pow 2 + -- &6720 * &n pow 14 * &k pow 3 + -- &372 * &n pow 13 * &k pow 4 + &8772 * &n pow 12 * &k pow 5 + -- &7932 * &n pow 11 * &k pow 6 + &2124 * &n pow 10 * &k pow 7 + &29952 * &n pow 16 + -- &142944 * &n pow 15 * &k + &265824 * &n pow 14 * &k pow 2 + -- &237996 * &n pow 13 * &k pow 3 + &19416 * &n pow 12 * &k pow 4 + &237984 * &n pow 11 * &k pow 5 + -- &213480 * &n pow 10 * &k pow 6 + &53916 * &n pow 9 * &k pow 7 + &544576 * &n pow 15 + -- &2474240 * &n pow 14 * &k + &4357716 * &n pow 13 * &k pow 2 + -- &3855872 * &n pow 12 * &k pow 3 + &744971 * &n pow 11 * &k pow 4 + &2902577 * &n pow 10 * &k pow 5 + -- &2587783 * &n pow 9 * &k pow 6 + &610071 * &n pow 8 * &k pow 7 + &6126208 * &n pow 14 + -- &26432748 * &n pow 13 * &k + &43730080 * &n pow 12 * &k pow 2 + -- &37855724 * &n pow 11 * &k pow 3 + &10727224 * &n pow 10 * &k pow 4 + &20975832 * &n pow 9 * &k pow 5 + -- &18644660 * &n pow 8 * &k pow 6 + &4050412 * &n pow 7 * &k pow 7 + &47714808 * &n pow 13 + -- &195084820 * &n pow 12 * &k + &300197561 * &n pow 11 * &k pow 2 + -- &251384889 * &n pow 10 * &k pow 3 + &89274374 * &n pow 9 * &k pow 4 + &99570856 * &n pow 8 * &k pow 5 + -- &88693322 * &n pow 7 * &k pow 6 + &17466166 * &n pow 6 * &k pow 7 + &272731768 * &n pow 12 + -- &1054933184 * &n pow 11 * &k + &1492054660 * &n pow 10 * &k pow 2 + -- &1192971470 * &n pow 9 * &k pow 3 + &490183574 * &n pow 8 * &k pow 4 + &324823986 * &n pow 7 * &k pow 5 + -- &292439934 * &n pow 6 * &k pow 6 + &51093252 * &n pow 5 * &k pow 7 + &1182739932 * &n pow 11 + -- &4325363056 * &n pow 10 * &k + &5541779499 * &n pow 9 * &k pow 2 + -- &4165047879 * &n pow 8 * &k pow 3 + &1884856489 * &n pow 7 * &k pow 4 + &738412721 * &n pow 6 * &k pow 5 + -- &681856867 * &n pow 5 * &k pow 6 + &102640379 * &n pow 4 * &k pow 7 + &3965796096 * &n pow 10 + -- &13725596018 * &n pow 9 * &k + &15647797720 * &n pow 8 * &k pow 2 + -- &10841929592 * &n pow 7 * &k pow 3 + &5220078290 * &n pow 6 * &k pow 4 + &1155192868 * &n pow 5 * &k pow 5 + -- &1124111664 * &n pow 4 * &k pow 6 + &139771620 * &n pow 3 * &k pow 7 + &10374173274 * &n pow 9 + -- &34100830232 * &n pow 8 * &k + &33831285527 * &n pow 7 * &k pow 2 + -- &21072888095 * &n pow 6 * &k pow 3 + &10506074900 * &n pow 5 * &k pow 4 + &1183282330 * &n pow 4 * &k pow 5 + -- &1284061348 * &n pow 3 * &k pow 6 + &123447892 * &n pow 2 * &k pow 7 + &21183410278 * &n pow 8 + -- &66643659794 * &n pow 7 * &k + &55950436530 * &n pow 6 * &k pow 2 + -- &30281303510 * &n pow 5 * &k pow 3 + &15261668906 * &n pow 4 * &k pow 4 + &687247506 * &n pow 3 * &k pow 5 + -- &967912958 * &n pow 2 * &k pow 6 + &63848152 * &n * &k pow 7 + &33482591822 * &n pow 7 + -- &102292727676 * &n pow 6 * &k + &70135361161 * &n pow 5 * &k pow 2 + -- &31421512301 * &n pow 4 * &k pow 3 + &15611717202 * &n pow 3 * &k pow 4 + &99558080 * &n pow 2 * &k pow 5 + -- &433349940 * &n * &k pow 6 + &14685520 * &k pow 7 + &40136994726 * &n pow 6 + -- &122291049974 * &n pow 5 * &k + &65393035612 * &n pow 4 * &k pow 2 + -- &22533272612 * &n pow 3 * &k pow 3 + &10677485846 * &n pow 2 * &k pow 4 + -- &116671144 * &n * &k pow 5 + -- &87314608 * &k pow 6 + &35003178914 * &n pow 5 + -- &111916403736 * &n pow 4 * &k + &43888543364 * &n pow 3 * &k pow 2 + -- &10299559236 * &n pow 2 * &k pow 3 + &4384906476 * &n * &k pow 4 + -- &52174304 * &k pow 5 + &20240167866 * &n pow 4 + -- &76003249522 * &n pow 3 * &k + &20030425174 * &n pow 2 * &k pow 2 + -- &2539460808 * &n * &k pow 3 + &817854256 * &k pow 4 + &5677893806 * &n pow 3 + -- &36216335248 * &n pow 2 * &k + &5572107668 * &n * &k pow 2 + -- &211975120 * &k pow 3 + -- &1165461806 * &n pow 2 + -- &10842346408 * &n * &k + &716085136 * &k pow 2 + -- &1500128652 * &n + -- &1538415264 * &k + -- &371277072)):real`, + `(-- &1 * (-- &1 * &n + &k) pow 2 * (-- &1 * &n + &k + -- &3) pow 2 * (-- &1 * &n + &k + -- &2) pow 2 * (-- &1 * &n + &k + -- &1) pow 2 * (&n + &2) pow 3 * (&n + &3) pow 3):real`, + `(-- &1 * (-- &1 * &n + &k + &1) * (-- &1 * &n + &k + -- &4) pow 2):real`, + `(-- &1 * (-- &1 * &n + &k + &1) * (&k + &2) pow 5):real`); + (`(-- &4 * (&k) * (&2 * &n + &3) * (&2 * &n + &5) * (&2 * &n + &7) * (&k + &1) pow 5 * (&768 * &n pow 17 + -- &3840 * &n pow 16 * &k + &7488 * &n pow 15 * &k pow 2 + -- &6720 * &n pow 14 * &k pow 3 + -- &372 * &n pow 13 * &k pow 4 + &8772 * &n pow 12 * &k pow 5 + -- &7932 * &n pow 11 * &k pow 6 + &2124 * &n pow 10 * &k pow 7 + &33792 * &n pow 16 + -- &157920 * &n pow 15 * &k + &285984 * &n pow 14 * &k pow 2 + -- &236508 * &n pow 13 * &k pow 3 + -- &24444 * &n pow 12 * &k pow 4 + &285576 * &n pow 11 * &k pow 5 + -- &228348 * &n pow 10 * &k pow 6 + &53916 * &n pow 9 * &k pow 7 + &695008 * &n pow 15 + -- &3026048 * &n pow 14 * &k + &5069472 * &n pow 13 * &k pow 2 + -- &3845816 * &n pow 12 * &k pow 3 + -- &563929 * &n pow 11 * &k pow 4 + &4228061 * &n pow 10 * &k pow 5 + -- &2965195 * &n pow 9 * &k pow 6 + &610071 * &n pow 8 * &k pow 7 + &8872992 * &n pow 14 + -- &35860680 * &n pow 13 * &k + &55326472 * &n pow 12 * &k pow 2 + -- &38297128 * &n pow 11 * &k pow 3 + -- &7062201 * &n pow 10 * &k pow 4 + &37634766 * &n pow 9 * &k pow 5 + -- &22915157 * &n pow 8 * &k pow 6 + &4050412 * &n pow 7 * &k pow 7 + &78742896 * &n pow 13 + -- &294146400 * &n pow 12 * &k + &415735739 * &n pow 11 * &k pow 2 + -- &260924075 * &n pow 10 * &k pow 3 + -- &56308591 * &n pow 9 * &k pow 4 + &224250307 * &n pow 8 * &k pow 5 + -- &117046206 * &n pow 7 * &k pow 6 + &17466166 * &n pow 6 * &k pow 7 + &515413184 * &n pow 12 + -- &1770637850 * &n pow 11 * &k + &2278300097 * &n pow 10 * &k pow 2 + -- &1286667926 * &n pow 9 * &k pow 3 + -- &308693091 * &n pow 8 * &k pow 4 + &942042570 * &n pow 7 * &k pow 5 + -- &414703096 * &n pow 6 * &k pow 6 + &51093252 * &n pow 5 * &k pow 7 + &2576225456 * &n pow 11 + -- &8090727306 * &n pow 10 * &k + &9406632852 * &n pow 9 * &k pow 2 + -- &4735827930 * &n pow 8 * &k pow 3 + -- &1211427691 * &n pow 7 * &k pow 4 + &2859841811 * &n pow 6 * &k pow 5 + -- &1039509631 * &n pow 5 * &k pow 6 + &102640379 * &n pow 4 * &k pow 7 + &10042207744 * &n pow 10 + -- &28624383652 * &n pow 9 * &k + &29795852850 * &n pow 8 * &k pow 2 + -- &13217484828 * &n pow 7 * &k pow 3 + -- &3469900135 * &n pow 6 * &k pow 4 + &6319292362 * &n pow 5 * &k pow 5 + -- &1842594317 * &n pow 4 * &k pow 6 + &139771620 * &n pow 3 * &k pow 7 + &30900177104 * &n pow 9 + -- &79238310868 * &n pow 8 * &k + &73002514895 * &n pow 7 * &k pow 2 + -- &28108959555 * &n pow 6 * &k pow 3 + -- &7286006265 * &n pow 5 * &k pow 4 + &10083400273 * &n pow 4 * &k pow 5 + -- &2262462688 * &n pow 3 * &k pow 6 + &123447892 * &n pow 2 * &k pow 7 + &75468444096 * &n pow 8 + -- &172186812834 * &n pow 7 * &k + &138352054849 * &n pow 6 * &k pow 2 + -- &45328273270 * &n pow 5 * &k pow 3 + -- &11108830969 * &n pow 4 * &k pow 4 + &11326819614 * &n pow 3 * &k pow 5 + -- &1832048202 * &n pow 2 * &k pow 6 + &63848152 * &n * &k pow 7 + &146266755504 * &n pow 7 + -- &292723611810 * &n pow 6 * &k + &201162981114 * &n pow 5 * &k pow 2 + -- &54560718080 * &n pow 4 * &k pow 3 + -- &11977447248 * &n pow 3 * &k pow 4 + &8499441560 * &n pow 2 * &k pow 5 + -- &880287004 * &n * &k pow 6 + &14685520 * &k pow 7 + &223624806496 * &n pow 6 + -- &385205224120 * &n pow 5 * &k + &220377639732 * &n pow 4 * &k pow 2 + -- &47534432700 * &n pow 3 * &k pow 3 + -- &8659675144 * &n pow 2 * &k pow 4 + &3824239688 * &n * &k pow 5 + -- &190113248 * &k pow 6 + &266328825472 * &n pow 5 + -- &384634123200 * &n pow 4 * &k + &176090065112 * &n pow 3 * &k pow 2 + -- &28334986440 * &n pow 2 * &k pow 3 + -- &3766672224 * &n * &k pow 4 + &780109264 * &k pow 5 + &241822754048 * &n pow 4 + -- &281708015936 * &n pow 3 * &k + &96887337056 * &n pow 2 * &k pow 2 + -- &10344114032 * &n * &k pow 3 + -- &744986544 * &k pow 4 + &161603596032 * &n pow 3 + -- &142716403296 * &n pow 2 * &k + &32825580096 * &n * &k pow 2 + -- &1744849824 * &k pow 3 + &74867424768 * &n pow 2 + -- &44680889088 * &n * &k + &5162764032 * &k pow 2 + &21458165760 * &n + -- &6512113152 * &k + &2863226880)):real`, + `((-- &1 * &n + &k) * (-- &1 * &n + &k + -- &4) pow 2 * (-- &1 * &n + &k + -- &3) pow 2 * (-- &1 * &n + &k + -- &2) pow 2 * (-- &1 * &n + &k + -- &1) pow 2 * (&n + &2) pow 3 * (&n + &3) pow 3):real`, + `((-- &1 * &n + &k) * (-- &1 * &n + &k + &1)):real`, + `(&1):real`); +];; + +let apery_k0_zero = + apery_prove_coefficient + (el 1 apery_normalized_coeffs) tri_k0_reduced +and apery_k1_zero = + apery_prove_coefficient + (el 2 apery_normalized_coeffs) tri_k1_reduced +and apery_k2_zero = + apery_prove_coefficient + (el 3 apery_normalized_coeffs) tri_k2_reduced;; + +let rec apery_scalar_leaves tm = + if mem tm apery_atoms then [] + else if not (apery_has_atom tm) then [tm] + else if is_binop_op add_tm tm || + is_binop_op sub_tm tm then + let op = + if is_binop_op add_tm tm then add_tm else sub_tm in + let l,r = dest_binop op tm in + apery_scalar_leaves l @ apery_scalar_leaves r + else if is_comb tm && rator tm = neg_tm then + apery_scalar_leaves(rand tm) + else if is_binop_op mul_tm tm then + let l,r = dest_binop mul_tm tm in + if not (apery_has_atom l) then l::apery_scalar_leaves r + else if not (apery_has_atom r) then r::apery_scalar_leaves l + else failwith "apery_scalar_leaves: nonlinear product" + else failwith "apery_scalar_leaves: unsupported term";; + +let apery_linear_form = + apery_sum + (map2 + (fun c a -> mk_binop mul_tm c a) + (tl apery_coeffs) apery_atoms);; + +let apery_reconstruction = + apery_abstract_identity + (apery_atoms @ + apery_scalar_leaves(rhs(concl apery_reduced))) + (mk_eq(rhs(concl apery_reduced),apery_linear_form));; + +let apery_original_zero i zero_th = + TRANS (apery_normalize_coeff(el i apery_coeffs)) + zero_th;; + +let apery_linear_form_zero = + REWRITE_CONV + [apery_original_zero 1 apery_k0_zero; + apery_original_zero 2 apery_k1_zero; + apery_original_zero 3 apery_k2_zero; + REAL_MUL_LZERO; REAL_ADD_LID; REAL_ADD_RID] + apery_linear_form;; + +let apery_target_zero = + TRANS apery_reduced + (TRANS apery_reconstruction apery_linear_form_zero);; + +let APERY_SUB_EQ_ZERO = prove + (`!a b:real. a - b = &0 <=> a = b`, + REAL_ARITH_TAC);; + +let P_EQ_DELTA_Q = + let l,r = dest_binop sub_tm apery_target in + let eq = EQ_MP (SPECL [l;r] APERY_SUB_EQ_ZERO) + apery_target_zero in + GEN `n:num` (GEN `k:num` (DISCH apery_hyp eq));; + +let VV_SUPPORT = prove + (`!m k. m < k ==> vv m k = &0`, + REPEAT STRIP_TAC THEN REWRITE_TAC[vv; cc] THEN + SUBGOAL_THEN `binom(m,k) = 0` SUBST1_TAC THENL + [ASM_REWRITE_TAC[BINOM_EQ_0]; REWRITE_TAC[ARITH] THEN CONV_TAC REAL_RING]);; + +let VV_ZERO_K = prove + (`!m. vv m 0 = &0`, + GEN_TAC THEN REWRITE_TAC[vv; ss] THEN + REWRITE_TAC[SUM_CLAUSES_NUMSEG; ARITH] THEN REWRITE_TAC[REAL_MUL_RZERO]);; + +let WW_EXT = prove + (`!n i. i <= 4 ==> ww (n+i) = sum(0..n+4) (\j. vv (n+i) j)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[ww; GSYM vv] THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC SUM_SUPERSET THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET; IN_NUMSEG] THEN ASM_ARITH_TAC; + X_GEN_TAC `j:num` THEN REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN + REWRITE_TAC[] THEN MATCH_MP_TAC VV_SUPPORT THEN ASM_ARITH_TAC]);; + +let INTERIOR_TELE = prove + (`!n. 3 <= n ==> sum(1..n-2) (\j. pflat2 vv n j) = qflat vv n (n-1) - qflat vv n 1`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `sum(1..n-2) (\j. pflat2 vv n j) = sum(1..n-2)(\j. qflat vv n (j+1) - qflat vv n j)` SUBST1_TAC THENL + [MATCH_MP_TAC SUM_EQ_NUMSEG THEN REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN + MATCH_MP_TAC P_EQ_DELTA_Q THEN ASM_ARITH_TAC; ALL_TAC] THEN + ONCE_REWRITE_TAC[REAL_ARITH `a - b = --(b - a)`] THEN + REWRITE_TAC[SUM_NEG; SUM_DIFFS] THEN + SUBGOAL_THEN `1 <= n - 2` ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `(n-2)+1 = n-1` SUBST1_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + REAL_ARITH_TAC);; + +let PFLAT_WW_DECOMP = prove + (`!n. pflat ww n = sum(0..n+4) (\j. pflat2 vv n j)`, + GEN_TAC THEN + REWRITE_TAC[pflat; + REWRITE_RULE[ADD_CLAUSES] (MP (SPECL[`n:num`;`0`] WW_EXT) (ARITH_RULE `0<=4`)); + MP (SPECL[`n:num`;`1`] WW_EXT) (ARITH_RULE `1<=4`); + MP (SPECL[`n:num`;`2`] WW_EXT) (ARITH_RULE `2<=4`); + MP (SPECL[`n:num`;`3`] WW_EXT) (ARITH_RULE `3<=4`); + MP (SPECL[`n:num`;`4`] WW_EXT) (ARITH_RULE `4<=4`)] THEN + REWRITE_TAC[GSYM SUM_LMUL] THEN REWRITE_TAC[GSYM SUM_ADD_NUMSEG] THEN + MATCH_MP_TAC SUM_EQ_NUMSEG THEN + REPEAT STRIP_TAC THEN + REWRITE_TAC[pflat2; pflat] THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* The j=0 edge group, called "around_n_0" in the Coq development. Here *) +(* qflat vv n 1 = 0 for 3 <= n. The terms vv(n+1) 1 and vv n 2 reduce via *) +(* V_SNSK and V_SK2 at k=0 to multiples of vv n 1, while column 0 vanishes. *) +(* ------------------------------------------------------------------------- *) + +let VSNSK_K0 = prove + (`!n. 0 < n ==> vv (n+1) 1 = (-- &n - &2 - &0) / (-- &n + &0) * vv n 1`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`n:num`; `0`] V_SNSK) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[ADD_CLAUSES] THEN REWRITE_TAC[VV_ZERO_K] THEN + REWRITE_TAC[REAL_MUL_RZERO; REAL_ADD_LID]);; + +let VSK2_K0 = prove + (`!n. 0 + 1 < n ==> vv n 2 = + ((&n + &2 + &0) * (-- &n + &0 + &1) * + (&2 * &0 pow 3 + &8 * &0 pow 2 + &11 * &0 + &5 - &0 * &n - &0 * &n pow 2 - &2 * &n pow 2 - &2 * &n) / + (&0 + &2) pow 5) * vv n 1`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`n:num`; `0`] V_SK2) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[ARITH_RULE `0+2 = 2`; ARITH_RULE `0+1 = 1`] THEN + REWRITE_TAC[VV_ZERO_K] THEN + REWRITE_TAC[REAL_MUL_RZERO; REAL_ADD_LID]);; + +(* The bracket coefficient (after the two substitutions) is identically 0, + proven by clearing the qc denominators with the certificate machinery. *) +let QFLAT_N1_BRACKET = + let bracket_tm = + `qc00 n 1 + + qc10 n 1 * (-- &n - &2 - &0) / (-- &n + &0) + + qc01 n 1 * ((&n + &2 + &0) * (-- &n + &0 + &1) * + (&2 * &0 pow 3 + &8 * &0 pow 2 + &11 * &0 + &5 - &0 * &n - &0 * &n pow 2 - &2 * &n pow 2 - &2 * &n) / + (&0 + &2) pow 5)` in + let bracket_unf = rhs(concl(REWRITE_CONV[qc00;qc01;qc10] bracket_tm)) in + let dfs = denom_factors bracket_unf [] in + let hyp3 = ASSUME `3 <= n` in + let prove_nz_3 f = + prove(mk_imp(`3 <= n`, mk_neg(mk_eq(f,`&0`))), + REWRITE_TAC[GSYM REAL_OF_NUM_LE] THEN STRIP_TAC THEN ASM_REAL_ARITH_TAC) in + let nz3 = map (fun f -> MP (prove_nz_3 f) hyp3) dfs in + DISCH `3 <= n` (prove_rat_eq nz3 (mk_eq(bracket_unf, `&0`)));; + +let QFLAT_N1_ZERO = prove + (`!n. 3 <= n ==> qflat vv n 1 = &0`, + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[qflat; ARITH_RULE `1+1 = 2`] THEN + MP_TAC(SPEC `n:num` VSNSK_K0) THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN + MP_TAC(SPEC `n:num` VSK2_K0) THEN ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN + MP_TAC QFLAT_N1_BRACKET THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[qc00; qc01; qc10] THEN + CONV_TAC REAL_RING);; + +let INTERIOR_FULL = + let col0 = prove + (`!n. pflat2 vv n 0 = &0`, + GEN_TAC THEN REWRITE_TAC[pflat2; pflat; VV_ZERO_K] THEN REAL_ARITH_TAC) in + prove + (`!n. 3 <= n + ==> sum(0..n-2) (\j. pflat2 vv n j) = qflat vv n (n-1)`, + GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN `0 <= n - 2` ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[SUM_CLAUSES_LEFT] THEN + REWRITE_TAC[col0] THEN + SUBGOAL_THEN `0 + 1 = 1` SUBST1_TAC THENL [ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_ADD_LID] THEN + ASM_SIMP_TAC[INTERIOR_TELE] THEN + ASM_SIMP_TAC[QFLAT_N1_ZERO] THEN REAL_ARITH_TAC);; + +(* Boundary cofactor-certificate data, parameterized by n = p + 1. *) +let bdry_target_tm = `&86400 * &p pow 30 * vv (p + 5) (p + 5) + &8078400 * &p pow 29 * vv (p + 5) (p + 5) + &362887200 * &p pow 28 * vv (p + 5) (p + 5) + &10428570000 * &p pow 27 * vv (p + 5) (p + 5) + &215392683600 * &p pow 26 * vv (p + 5) (p + 5) + &3405403544400 * &p pow 25 * vv (p + 5) (p + 5) + &42861452187600 * &p pow 24 * vv (p + 5) (p + 5) + &440966497496400 * &p pow 23 * vv (p + 5) (p + 5) + &3778529254779600 * &p pow 22 * vv (p + 5) (p + 5) + &27338261118368400 * &p pow 21 * vv (p + 5) (p + 5) + &168724467724827600 * &p pow 20 * vv (p + 5) (p + 5) + &895057507693364400 * &p pow 19 * vv (p + 5) (p + 5) + &4104216831896967600 * &p pow 18 * vv (p + 5) (p + 5) + &16332677083169564400 * &p pow 17 * vv (p + 5) (p + 5) + &56556428408403519600 * &p pow 16 * vv (p + 5) (p + 5) + &170659353088829228400 * &p pow 15 * vv (p + 5) (p + 5) + &448891109951332287600 * &p pow 14 * vv (p + 5) (p + 5) + &1028439709562976476400 * &p pow 13 * vv (p + 5) (p + 5) + &2048425921871487291600 * &p pow 12 * vv (p + 5) (p + 5) + &3536036211260748614400 * &p pow 11 * vv (p + 5) (p + 5) + &5266547855879921467200 * &p pow 10 * vv (p + 5) (p + 5) + &6726728254681418688000 * &p pow 9 * vv (p + 5) (p + 5) + &7308645420971257286400 * &p pow 8 * vv (p + 5) (p + 5) + &6683234045544602726400 * &p pow 7 * vv (p + 5) (p + 5) + &5070923003829241728000 * &p pow 6 * vv (p + 5) (p + 5) + &3131718550216865280000 * &p pow 5 * vv (p + 5) (p + 5) + &1532406867052032000000 * &p pow 4 * vv (p + 5) (p + 5) + &570965862021120000000 * &p pow 3 * vv (p + 5) (p + 5) + &152016410603520000000 * &p pow 2 * vv (p + 5) (p + 5) + &25730522726400000000 * &p * vv (p + 5) (p + 5) + &2078244864000000000 * vv (p + 5) (p + 5) + &86400 * &p pow 30 * vv (p + 5) (p + 4) + &8078400 * &p pow 29 * vv (p + 5) (p + 4) + &362887200 * &p pow 28 * vv (p + 5) (p + 4) + &10428570000 * &p pow 27 * vv (p + 5) (p + 4) + &215392683600 * &p pow 26 * vv (p + 5) (p + 4) + &3405403544400 * &p pow 25 * vv (p + 5) (p + 4) + &42861452187600 * &p pow 24 * vv (p + 5) (p + 4) + &440966497496400 * &p pow 23 * vv (p + 5) (p + 4) + &3778529254779600 * &p pow 22 * vv (p + 5) (p + 4) + &27338261118368400 * &p pow 21 * vv (p + 5) (p + 4) + &168724467724827600 * &p pow 20 * vv (p + 5) (p + 4) + &895057507693364400 * &p pow 19 * vv (p + 5) (p + 4) + &4104216831896967600 * &p pow 18 * vv (p + 5) (p + 4) + &16332677083169564400 * &p pow 17 * vv (p + 5) (p + 4) + &56556428408403519600 * &p pow 16 * vv (p + 5) (p + 4) + &170659353088829228400 * &p pow 15 * vv (p + 5) (p + 4) + &448891109951332287600 * &p pow 14 * vv (p + 5) (p + 4) + &1028439709562976476400 * &p pow 13 * vv (p + 5) (p + 4) + &2048425921871487291600 * &p pow 12 * vv (p + 5) (p + 4) + &3536036211260748614400 * &p pow 11 * vv (p + 5) (p + 4) + &5266547855879921467200 * &p pow 10 * vv (p + 5) (p + 4) + &6726728254681418688000 * &p pow 9 * vv (p + 5) (p + 4) + &7308645420971257286400 * &p pow 8 * vv (p + 5) (p + 4) + &6683234045544602726400 * &p pow 7 * vv (p + 5) (p + 4) + &5070923003829241728000 * &p pow 6 * vv (p + 5) (p + 4) + &3131718550216865280000 * &p pow 5 * vv (p + 5) (p + 4) + &1532406867052032000000 * &p pow 4 * vv (p + 5) (p + 4) + &570965862021120000000 * &p pow 3 * vv (p + 5) (p + 4) + &152016410603520000000 * &p pow 2 * vv (p + 5) (p + 4) + &25730522726400000000 * &p * vv (p + 5) (p + 4) + &2078244864000000000 * vv (p + 5) (p + 4) + &86400 * &p pow 30 * vv (p + 5) (p + 3) + &8078400 * &p pow 29 * vv (p + 5) (p + 3) + &362887200 * &p pow 28 * vv (p + 5) (p + 3) + &10428570000 * &p pow 27 * vv (p + 5) (p + 3) + &215392683600 * &p pow 26 * vv (p + 5) (p + 3) + &3405403544400 * &p pow 25 * vv (p + 5) (p + 3) + &42861452187600 * &p pow 24 * vv (p + 5) (p + 3) + &440966497496400 * &p pow 23 * vv (p + 5) (p + 3) + &3778529254779600 * &p pow 22 * vv (p + 5) (p + 3) + &27338261118368400 * &p pow 21 * vv (p + 5) (p + 3) + &168724467724827600 * &p pow 20 * vv (p + 5) (p + 3) + &895057507693364400 * &p pow 19 * vv (p + 5) (p + 3) + &4104216831896967600 * &p pow 18 * vv (p + 5) (p + 3) + &16332677083169564400 * &p pow 17 * vv (p + 5) (p + 3) + &56556428408403519600 * &p pow 16 * vv (p + 5) (p + 3) + &170659353088829228400 * &p pow 15 * vv (p + 5) (p + 3) + &448891109951332287600 * &p pow 14 * vv (p + 5) (p + 3) + &1028439709562976476400 * &p pow 13 * vv (p + 5) (p + 3) + &2048425921871487291600 * &p pow 12 * vv (p + 5) (p + 3) + &3536036211260748614400 * &p pow 11 * vv (p + 5) (p + 3) + &5266547855879921467200 * &p pow 10 * vv (p + 5) (p + 3) + &6726728254681418688000 * &p pow 9 * vv (p + 5) (p + 3) + &7308645420971257286400 * &p pow 8 * vv (p + 5) (p + 3) + &6683234045544602726400 * &p pow 7 * vv (p + 5) (p + 3) + &5070923003829241728000 * &p pow 6 * vv (p + 5) (p + 3) + &3131718550216865280000 * &p pow 5 * vv (p + 5) (p + 3) + &1532406867052032000000 * &p pow 4 * vv (p + 5) (p + 3) + &570965862021120000000 * &p pow 3 * vv (p + 5) (p + 3) + &152016410603520000000 * &p pow 2 * vv (p + 5) (p + 3) + &25730522726400000000 * &p * vv (p + 5) (p + 3) + &2078244864000000000 * vv (p + 5) (p + 3) + &86400 * &p pow 30 * vv (p + 5) (p + 2) + &8078400 * &p pow 29 * vv (p + 5) (p + 2) + &362887200 * &p pow 28 * vv (p + 5) (p + 2) + &10428570000 * &p pow 27 * vv (p + 5) (p + 2) + &215392683600 * &p pow 26 * vv (p + 5) (p + 2) + &3405403544400 * &p pow 25 * vv (p + 5) (p + 2) + &42861452187600 * &p pow 24 * vv (p + 5) (p + 2) + &440966497496400 * &p pow 23 * vv (p + 5) (p + 2) + &3778529254779600 * &p pow 22 * vv (p + 5) (p + 2) + &27338261118368400 * &p pow 21 * vv (p + 5) (p + 2) + &168724467724827600 * &p pow 20 * vv (p + 5) (p + 2) + &895057507693364400 * &p pow 19 * vv (p + 5) (p + 2) + &4104216831896967600 * &p pow 18 * vv (p + 5) (p + 2) + &16332677083169564400 * &p pow 17 * vv (p + 5) (p + 2) + &56556428408403519600 * &p pow 16 * vv (p + 5) (p + 2) + &170659353088829228400 * &p pow 15 * vv (p + 5) (p + 2) + &448891109951332287600 * &p pow 14 * vv (p + 5) (p + 2) + &1028439709562976476400 * &p pow 13 * vv (p + 5) (p + 2) + &2048425921871487291600 * &p pow 12 * vv (p + 5) (p + 2) + &3536036211260748614400 * &p pow 11 * vv (p + 5) (p + 2) + &5266547855879921467200 * &p pow 10 * vv (p + 5) (p + 2) + &6726728254681418688000 * &p pow 9 * vv (p + 5) (p + 2) + &7308645420971257286400 * &p pow 8 * vv (p + 5) (p + 2) + &6683234045544602726400 * &p pow 7 * vv (p + 5) (p + 2) + &5070923003829241728000 * &p pow 6 * vv (p + 5) (p + 2) + &3131718550216865280000 * &p pow 5 * vv (p + 5) (p + 2) + &1532406867052032000000 * &p pow 4 * vv (p + 5) (p + 2) + &570965862021120000000 * &p pow 3 * vv (p + 5) (p + 2) + &152016410603520000000 * &p pow 2 * vv (p + 5) (p + 2) + &25730522726400000000 * &p * vv (p + 5) (p + 2) + &2078244864000000000 * vv (p + 5) (p + 2) + &86400 * &p pow 30 * vv (p + 5) (p + 1) + &8078400 * &p pow 29 * vv (p + 5) (p + 1) + &362887200 * &p pow 28 * vv (p + 5) (p + 1) + &10428570000 * &p pow 27 * vv (p + 5) (p + 1) + &215392683600 * &p pow 26 * vv (p + 5) (p + 1) + &3405403544400 * &p pow 25 * vv (p + 5) (p + 1) + &42861452187600 * &p pow 24 * vv (p + 5) (p + 1) + &440966497496400 * &p pow 23 * vv (p + 5) (p + 1) + &3778529254779600 * &p pow 22 * vv (p + 5) (p + 1) + &27338261118368400 * &p pow 21 * vv (p + 5) (p + 1) + &168724467724827600 * &p pow 20 * vv (p + 5) (p + 1) + &895057507693364400 * &p pow 19 * vv (p + 5) (p + 1) + &4104216831896967600 * &p pow 18 * vv (p + 5) (p + 1) + &16332677083169564400 * &p pow 17 * vv (p + 5) (p + 1) + &56556428408403519600 * &p pow 16 * vv (p + 5) (p + 1) + &170659353088829228400 * &p pow 15 * vv (p + 5) (p + 1) + &448891109951332287600 * &p pow 14 * vv (p + 5) (p + 1) + &1028439709562976476400 * &p pow 13 * vv (p + 5) (p + 1) + &2048425921871487291600 * &p pow 12 * vv (p + 5) (p + 1) + &3536036211260748614400 * &p pow 11 * vv (p + 5) (p + 1) + &5266547855879921467200 * &p pow 10 * vv (p + 5) (p + 1) + &6726728254681418688000 * &p pow 9 * vv (p + 5) (p + 1) + &7308645420971257286400 * &p pow 8 * vv (p + 5) (p + 1) + &6683234045544602726400 * &p pow 7 * vv (p + 5) (p + 1) + &5070923003829241728000 * &p pow 6 * vv (p + 5) (p + 1) + &3131718550216865280000 * &p pow 5 * vv (p + 5) (p + 1) + &1532406867052032000000 * &p pow 4 * vv (p + 5) (p + 1) + &570965862021120000000 * &p pow 3 * vv (p + 5) (p + 1) + &152016410603520000000 * &p pow 2 * vv (p + 5) (p + 1) + &25730522726400000000 * &p * vv (p + 5) (p + 1) + &2078244864000000000 * vv (p + 5) (p + 1) + &86400 * &p pow 30 * vv (p + 5) p + &8078400 * &p pow 29 * vv (p + 5) p + &362887200 * &p pow 28 * vv (p + 5) p + &10428570000 * &p pow 27 * vv (p + 5) p + &215392683600 * &p pow 26 * vv (p + 5) p + &3405403544400 * &p pow 25 * vv (p + 5) p + &42861452187600 * &p pow 24 * vv (p + 5) p + &440966497496400 * &p pow 23 * vv (p + 5) p + &3778529254779600 * &p pow 22 * vv (p + 5) p + &27338261118368400 * &p pow 21 * vv (p + 5) p + &168724467724827600 * &p pow 20 * vv (p + 5) p + &895057507693364400 * &p pow 19 * vv (p + 5) p + &4104216831896967600 * &p pow 18 * vv (p + 5) p + &16332677083169564400 * &p pow 17 * vv (p + 5) p + &56556428408403519600 * &p pow 16 * vv (p + 5) p + &170659353088829228400 * &p pow 15 * vv (p + 5) p + &448891109951332287600 * &p pow 14 * vv (p + 5) p + &1028439709562976476400 * &p pow 13 * vv (p + 5) p + &2048425921871487291600 * &p pow 12 * vv (p + 5) p + &3536036211260748614400 * &p pow 11 * vv (p + 5) p + &5266547855879921467200 * &p pow 10 * vv (p + 5) p + &6726728254681418688000 * &p pow 9 * vv (p + 5) p + &7308645420971257286400 * &p pow 8 * vv (p + 5) p + &6683234045544602726400 * &p pow 7 * vv (p + 5) p + &5070923003829241728000 * &p pow 6 * vv (p + 5) p + &3131718550216865280000 * &p pow 5 * vv (p + 5) p + &1532406867052032000000 * &p pow 4 * vv (p + 5) p + &570965862021120000000 * &p pow 3 * vv (p + 5) p + &152016410603520000000 * &p pow 2 * vv (p + 5) p + &25730522726400000000 * &p * vv (p + 5) p + &2078244864000000000 * vv (p + 5) p - &5875200 * &p pow 30 * vv (p + 4) (p + 4) - &531705600 * &p pow 29 * vv (p + 4) (p + 4) - &23143161600 * &p pow 28 * vv (p + 4) (p + 4) - &645118344000 * &p pow 27 * vv (p + 4) (p + 4) - &12937723063200 * &p pow 26 * vv (p + 4) (p + 4) - &198813883658400 * &p pow 25 * vv (p + 4) (p + 4) - &2434588099596000 * &p pow 24 * vv (p + 4) (p + 4) - &24392951581460400 * &p pow 23 * vv (p + 4) (p + 4) - &203747287422438000 * &p pow 22 * vv (p + 4) (p + 4) - &1438304928191420400 * &p pow 21 * vv (p + 4) (p + 4) - &8668833730765808400 * &p pow 20 * vv (p + 4) (p + 4) - &44948837666429517600 * &p pow 19 * vv (p + 4) (p + 4) - &201630497138837870400 * &p pow 18 * vv (p + 4) (p + 4) - &785609015217746025600 * &p pow 17 * vv (p + 4) (p + 4) - &2665695137627519942400 * &p pow 16 * vv (p + 4) (p + 4) - &7888347224039849295600 * &p pow 15 * vv (p + 4) (p + 4) - &20364058389551739692400 * &p pow 14 * vv (p + 4) (p + 4) - &45824930112674566479600 * &p pow 13 * vv (p + 4) (p + 4) - &89715535994909135120400 * &p pow 12 * vv (p + 4) (p + 4) - &152337250801809675993600 * &p pow 11 * vv (p + 4) (p + 4) - &223340858390707585243200 * &p pow 10 * vv (p + 4) (p + 4) - &280997791316050973760000 * &p pow 9 * vv (p + 4) (p + 4) - &300947436653714406316800 * &p pow 8 * vv (p + 4) (p + 4) - &271448229099226849689600 * &p pow 7 * vv (p + 4) (p + 4) - &203291888645926062259200 * &p pow 6 * vv (p + 4) (p + 4) - &124002094822877552947200 * &p pow 5 * vv (p + 4) (p + 4) - &59966518938292688486400 * &p pow 4 * vv (p + 4) (p + 4) - &22095468783012475699200 * &p pow 3 * vv (p + 4) (p + 4) - &5821117997491283558400 * &p pow 2 * vv (p + 4) (p + 4) - &975542934487774003200 * &p * vv (p + 4) (p + 4) - &78060170476781568000 * vv (p + 4) (p + 4) - &5875200 * &p pow 30 * vv (p + 4) (p + 3) - &531705600 * &p pow 29 * vv (p + 4) (p + 3) - &23143161600 * &p pow 28 * vv (p + 4) (p + 3) - &645118344000 * &p pow 27 * vv (p + 4) (p + 3) - &12937723063200 * &p pow 26 * vv (p + 4) (p + 3) - &198813883658400 * &p pow 25 * vv (p + 4) (p + 3) - &2434588099596000 * &p pow 24 * vv (p + 4) (p + 3) - &24392951581460400 * &p pow 23 * vv (p + 4) (p + 3) - &203747287422438000 * &p pow 22 * vv (p + 4) (p + 3) - &1438304928191420400 * &p pow 21 * vv (p + 4) (p + 3) - &8668833730765808400 * &p pow 20 * vv (p + 4) (p + 3) - &44948837666429517600 * &p pow 19 * vv (p + 4) (p + 3) - &201630497138837870400 * &p pow 18 * vv (p + 4) (p + 3) - &785609015217746025600 * &p pow 17 * vv (p + 4) (p + 3) - &2665695137627519942400 * &p pow 16 * vv (p + 4) (p + 3) - &7888347224039849295600 * &p pow 15 * vv (p + 4) (p + 3) - &20364058389551739692400 * &p pow 14 * vv (p + 4) (p + 3) - &45824930112674566479600 * &p pow 13 * vv (p + 4) (p + 3) - &89715535994909135120400 * &p pow 12 * vv (p + 4) (p + 3) - &152337250801809675993600 * &p pow 11 * vv (p + 4) (p + 3) - &223340858390707585243200 * &p pow 10 * vv (p + 4) (p + 3) - &280997791316050973760000 * &p pow 9 * vv (p + 4) (p + 3) - &300947436653714406316800 * &p pow 8 * vv (p + 4) (p + 3) - &271448229099226849689600 * &p pow 7 * vv (p + 4) (p + 3) - &203291888645926062259200 * &p pow 6 * vv (p + 4) (p + 3) - &124002094822877552947200 * &p pow 5 * vv (p + 4) (p + 3) - &59966518938292688486400 * &p pow 4 * vv (p + 4) (p + 3) - &22095468783012475699200 * &p pow 3 * vv (p + 4) (p + 3) - &5821117997491283558400 * &p pow 2 * vv (p + 4) (p + 3) - &975542934487774003200 * &p * vv (p + 4) (p + 3) - &78060170476781568000 * vv (p + 4) (p + 3) - &5875200 * &p pow 30 * vv (p + 4) (p + 2) - &531705600 * &p pow 29 * vv (p + 4) (p + 2) - &23143161600 * &p pow 28 * vv (p + 4) (p + 2) - &645118344000 * &p pow 27 * vv (p + 4) (p + 2) - &12937723063200 * &p pow 26 * vv (p + 4) (p + 2) - &198813883658400 * &p pow 25 * vv (p + 4) (p + 2) - &2434588099596000 * &p pow 24 * vv (p + 4) (p + 2) - &24392951581460400 * &p pow 23 * vv (p + 4) (p + 2) - &203747287422438000 * &p pow 22 * vv (p + 4) (p + 2) - &1438304928191420400 * &p pow 21 * vv (p + 4) (p + 2) - &8668833730765808400 * &p pow 20 * vv (p + 4) (p + 2) - &44948837666429517600 * &p pow 19 * vv (p + 4) (p + 2) - &201630497138837870400 * &p pow 18 * vv (p + 4) (p + 2) - &785609015217746025600 * &p pow 17 * vv (p + 4) (p + 2) - &2665695137627519942400 * &p pow 16 * vv (p + 4) (p + 2) - &7888347224039849295600 * &p pow 15 * vv (p + 4) (p + 2) - &20364058389551739692400 * &p pow 14 * vv (p + 4) (p + 2) - &45824930112674566479600 * &p pow 13 * vv (p + 4) (p + 2) - &89715535994909135120400 * &p pow 12 * vv (p + 4) (p + 2) - &152337250801809675993600 * &p pow 11 * vv (p + 4) (p + 2) - &223340858390707585243200 * &p pow 10 * vv (p + 4) (p + 2) - &280997791316050973760000 * &p pow 9 * vv (p + 4) (p + 2) - &300947436653714406316800 * &p pow 8 * vv (p + 4) (p + 2) - &271448229099226849689600 * &p pow 7 * vv (p + 4) (p + 2) - &203291888645926062259200 * &p pow 6 * vv (p + 4) (p + 2) - &124002094822877552947200 * &p pow 5 * vv (p + 4) (p + 2) - &59966518938292688486400 * &p pow 4 * vv (p + 4) (p + 2) - &22095468783012475699200 * &p pow 3 * vv (p + 4) (p + 2) - &5821117997491283558400 * &p pow 2 * vv (p + 4) (p + 2) - &975542934487774003200 * &p * vv (p + 4) (p + 2) - &78060170476781568000 * vv (p + 4) (p + 2) - &5875200 * &p pow 30 * vv (p + 4) (p + 1) - &531705600 * &p pow 29 * vv (p + 4) (p + 1) - &23143161600 * &p pow 28 * vv (p + 4) (p + 1) - &645118344000 * &p pow 27 * vv (p + 4) (p + 1) - &12937723063200 * &p pow 26 * vv (p + 4) (p + 1) - &198813883658400 * &p pow 25 * vv (p + 4) (p + 1) - &2434588099596000 * &p pow 24 * vv (p + 4) (p + 1) - &24392951581460400 * &p pow 23 * vv (p + 4) (p + 1) - &203747287422438000 * &p pow 22 * vv (p + 4) (p + 1) - &1438304928191420400 * &p pow 21 * vv (p + 4) (p + 1) - &8668833730765808400 * &p pow 20 * vv (p + 4) (p + 1) - &44948837666429517600 * &p pow 19 * vv (p + 4) (p + 1) - &201630497138837870400 * &p pow 18 * vv (p + 4) (p + 1) - &785609015217746025600 * &p pow 17 * vv (p + 4) (p + 1) - &2665695137627519942400 * &p pow 16 * vv (p + 4) (p + 1) - &7888347224039849295600 * &p pow 15 * vv (p + 4) (p + 1) - &20364058389551739692400 * &p pow 14 * vv (p + 4) (p + 1) - &45824930112674566479600 * &p pow 13 * vv (p + 4) (p + 1) - &89715535994909135120400 * &p pow 12 * vv (p + 4) (p + 1) - &152337250801809675993600 * &p pow 11 * vv (p + 4) (p + 1) - &223340858390707585243200 * &p pow 10 * vv (p + 4) (p + 1) - &280997791316050973760000 * &p pow 9 * vv (p + 4) (p + 1) - &300947436653714406316800 * &p pow 8 * vv (p + 4) (p + 1) - &271448229099226849689600 * &p pow 7 * vv (p + 4) (p + 1) - &203291888645926062259200 * &p pow 6 * vv (p + 4) (p + 1) - &124002094822877552947200 * &p pow 5 * vv (p + 4) (p + 1) - &59966518938292688486400 * &p pow 4 * vv (p + 4) (p + 1) - &22095468783012475699200 * &p pow 3 * vv (p + 4) (p + 1) - &5821117997491283558400 * &p pow 2 * vv (p + 4) (p + 1) - &975542934487774003200 * &p * vv (p + 4) (p + 1) - &78060170476781568000 * vv (p + 4) (p + 1) - &5875200 * &p pow 30 * vv (p + 4) p - &531705600 * &p pow 29 * vv (p + 4) p - &23143161600 * &p pow 28 * vv (p + 4) p - &645118344000 * &p pow 27 * vv (p + 4) p - &12937723063200 * &p pow 26 * vv (p + 4) p - &198813883658400 * &p pow 25 * vv (p + 4) p - &2434588099596000 * &p pow 24 * vv (p + 4) p - &24392951581460400 * &p pow 23 * vv (p + 4) p - &203747287422438000 * &p pow 22 * vv (p + 4) p - &1438304928191420400 * &p pow 21 * vv (p + 4) p - &8668833730765808400 * &p pow 20 * vv (p + 4) p - &44948837666429517600 * &p pow 19 * vv (p + 4) p - &201630497138837870400 * &p pow 18 * vv (p + 4) p - &785609015217746025600 * &p pow 17 * vv (p + 4) p - &2665695137627519942400 * &p pow 16 * vv (p + 4) p - &7888347224039849295600 * &p pow 15 * vv (p + 4) p - &20364058389551739692400 * &p pow 14 * vv (p + 4) p - &45824930112674566479600 * &p pow 13 * vv (p + 4) p - &89715535994909135120400 * &p pow 12 * vv (p + 4) p - &152337250801809675993600 * &p pow 11 * vv (p + 4) p - &223340858390707585243200 * &p pow 10 * vv (p + 4) p - &280997791316050973760000 * &p pow 9 * vv (p + 4) p - &300947436653714406316800 * &p pow 8 * vv (p + 4) p - &271448229099226849689600 * &p pow 7 * vv (p + 4) p - &203291888645926062259200 * &p pow 6 * vv (p + 4) p - &124002094822877552947200 * &p pow 5 * vv (p + 4) p - &59966518938292688486400 * &p pow 4 * vv (p + 4) p - &22095468783012475699200 * &p pow 3 * vv (p + 4) p - &5821117997491283558400 * &p pow 2 * vv (p + 4) p - &975542934487774003200 * &p * vv (p + 4) p - &78060170476781568000 * vv (p + 4) p + &100051200 * &p pow 30 * vv (p + 3) (p + 3) + &8754480000 * &p pow 29 * vv (p + 3) (p + 3) + &368531121600 * &p pow 28 * vv (p + 3) (p + 3) + &9938659672800 * &p pow 27 * vv (p + 3) (p + 3) + &192903118509600 * &p pow 26 * vv (p + 3) (p + 3) + &2870042040460800 * &p pow 25 * vv (p + 3) (p + 3) + &34041230378229600 * &p pow 24 * vv (p + 3) (p + 3) + &330499602498906000 * &p pow 23 * vv (p + 3) (p + 3) + &2676234486822346800 * &p pow 22 * vv (p + 3) (p + 3) + &18323900138719414800 * &p pow 21 * vv (p + 3) (p + 3) + &107171867178462949200 * &p pow 20 * vv (p + 3) (p + 3) + &539535096905776272000 * &p pow 19 * vv (p + 3) (p + 3) + &2351124315094488696000 * &p pow 18 * vv (p + 3) (p + 3) + &8904095421382345428000 * &p pow 17 * vv (p + 3) (p + 3) + &29384085997286989920000 * &p pow 16 * vv (p + 3) (p + 3) + &84619170854511220746000 * &p pow 15 * vv (p + 3) (p + 3) + &212715365862162701214000 * &p pow 14 * vv (p + 3) (p + 3) + &466408774454909389074000 * &p pow 13 * vv (p + 3) (p + 3) + &890326223697581454330000 * &p pow 12 * vv (p + 3) (p + 3) + &1475020089467688277728000 * &p pow 11 * vv (p + 3) (p + 3) + &2111403896600435550244800 * &p pow 10 * vv (p + 3) (p + 3) + &2595526711983247684320000 * &p pow 9 * vv (p + 3) (p + 3) + &2717989800773944583750400 * &p pow 8 * vv (p + 3) (p + 3) + &2398836674899685209651200 * &p pow 7 * vv (p + 3) (p + 3) + &1759214135097125512934400 * &p pow 6 * vv (p + 3) (p + 3) + &1051592446215753746227200 * &p pow 5 * vv (p + 3) (p + 3) + &498755575720787082854400 * &p pow 4 * vv (p + 3) (p + 3) + &180380146074985857024000 * &p pow 3 * vv (p + 3) (p + 3) + &46681981418812126003200 * &p pow 2 * vv (p + 3) (p + 3) + &7691324341654860595200 * &p * vv (p + 3) (p + 3) + &605554271057136844800 * vv (p + 3) (p + 3) + &100051200 * &p pow 30 * vv (p + 3) (p + 2) + &8754480000 * &p pow 29 * vv (p + 3) (p + 2) + &368531121600 * &p pow 28 * vv (p + 3) (p + 2) + &9938659672800 * &p pow 27 * vv (p + 3) (p + 2) + &192903118509600 * &p pow 26 * vv (p + 3) (p + 2) + &2870042040460800 * &p pow 25 * vv (p + 3) (p + 2) + &34041230378229600 * &p pow 24 * vv (p + 3) (p + 2) + &330499602498906000 * &p pow 23 * vv (p + 3) (p + 2) + &2676234486822346800 * &p pow 22 * vv (p + 3) (p + 2) + &18323900138719414800 * &p pow 21 * vv (p + 3) (p + 2) + &107171867178462949200 * &p pow 20 * vv (p + 3) (p + 2) + &539535096905776272000 * &p pow 19 * vv (p + 3) (p + 2) + &2351124315094488696000 * &p pow 18 * vv (p + 3) (p + 2) + &8904095421382345428000 * &p pow 17 * vv (p + 3) (p + 2) + &29384085997286989920000 * &p pow 16 * vv (p + 3) (p + 2) + &84619170854511220746000 * &p pow 15 * vv (p + 3) (p + 2) + &212715365862162701214000 * &p pow 14 * vv (p + 3) (p + 2) + &466408774454909389074000 * &p pow 13 * vv (p + 3) (p + 2) + &890326223697581454330000 * &p pow 12 * vv (p + 3) (p + 2) + &1475020089467688277728000 * &p pow 11 * vv (p + 3) (p + 2) + &2111403896600435550244800 * &p pow 10 * vv (p + 3) (p + 2) + &2595526711983247684320000 * &p pow 9 * vv (p + 3) (p + 2) + &2717989800773944583750400 * &p pow 8 * vv (p + 3) (p + 2) + &2398836674899685209651200 * &p pow 7 * vv (p + 3) (p + 2) + &1759214135097125512934400 * &p pow 6 * vv (p + 3) (p + 2) + &1051592446215753746227200 * &p pow 5 * vv (p + 3) (p + 2) + &498755575720787082854400 * &p pow 4 * vv (p + 3) (p + 2) + &180380146074985857024000 * &p pow 3 * vv (p + 3) (p + 2) + &46681981418812126003200 * &p pow 2 * vv (p + 3) (p + 2) + &7691324341654860595200 * &p * vv (p + 3) (p + 2) + &605554271057136844800 * vv (p + 3) (p + 2) + &100051200 * &p pow 30 * vv (p + 3) (p + 1) + &8754480000 * &p pow 29 * vv (p + 3) (p + 1) + &368531121600 * &p pow 28 * vv (p + 3) (p + 1) + &9938659672800 * &p pow 27 * vv (p + 3) (p + 1) + &192903118509600 * &p pow 26 * vv (p + 3) (p + 1) + &2870042040460800 * &p pow 25 * vv (p + 3) (p + 1) + &34041230378229600 * &p pow 24 * vv (p + 3) (p + 1) + &330499602498906000 * &p pow 23 * vv (p + 3) (p + 1) + &2676234486822346800 * &p pow 22 * vv (p + 3) (p + 1) + &18323900138719414800 * &p pow 21 * vv (p + 3) (p + 1) + &107171867178462949200 * &p pow 20 * vv (p + 3) (p + 1) + &539535096905776272000 * &p pow 19 * vv (p + 3) (p + 1) + &2351124315094488696000 * &p pow 18 * vv (p + 3) (p + 1) + &8904095421382345428000 * &p pow 17 * vv (p + 3) (p + 1) + &29384085997286989920000 * &p pow 16 * vv (p + 3) (p + 1) + &84619170854511220746000 * &p pow 15 * vv (p + 3) (p + 1) + &212715365862162701214000 * &p pow 14 * vv (p + 3) (p + 1) + &466408774454909389074000 * &p pow 13 * vv (p + 3) (p + 1) + &890326223697581454330000 * &p pow 12 * vv (p + 3) (p + 1) + &1475020089467688277728000 * &p pow 11 * vv (p + 3) (p + 1) + &2111403896600435550244800 * &p pow 10 * vv (p + 3) (p + 1) + &2595526711983247684320000 * &p pow 9 * vv (p + 3) (p + 1) + &2717989800773944583750400 * &p pow 8 * vv (p + 3) (p + 1) + &2398836674899685209651200 * &p pow 7 * vv (p + 3) (p + 1) + &1759214135097125512934400 * &p pow 6 * vv (p + 3) (p + 1) + &1051592446215753746227200 * &p pow 5 * vv (p + 3) (p + 1) + &498755575720787082854400 * &p pow 4 * vv (p + 3) (p + 1) + &180380146074985857024000 * &p pow 3 * vv (p + 3) (p + 1) + &46681981418812126003200 * &p pow 2 * vv (p + 3) (p + 1) + &7691324341654860595200 * &p * vv (p + 3) (p + 1) + &605554271057136844800 * vv (p + 3) (p + 1) + &100051200 * &p pow 30 * vv (p + 3) p + &8754480000 * &p pow 29 * vv (p + 3) p + &368531121600 * &p pow 28 * vv (p + 3) p + &9938659672800 * &p pow 27 * vv (p + 3) p + &192903118509600 * &p pow 26 * vv (p + 3) p + &2870042040460800 * &p pow 25 * vv (p + 3) p + &34041230378229600 * &p pow 24 * vv (p + 3) p + &330499602498906000 * &p pow 23 * vv (p + 3) p + &2676234486822346800 * &p pow 22 * vv (p + 3) p + &18323900138719414800 * &p pow 21 * vv (p + 3) p + &107171867178462949200 * &p pow 20 * vv (p + 3) p + &539535096905776272000 * &p pow 19 * vv (p + 3) p + &2351124315094488696000 * &p pow 18 * vv (p + 3) p + &8904095421382345428000 * &p pow 17 * vv (p + 3) p + &29384085997286989920000 * &p pow 16 * vv (p + 3) p + &84619170854511220746000 * &p pow 15 * vv (p + 3) p + &212715365862162701214000 * &p pow 14 * vv (p + 3) p + &466408774454909389074000 * &p pow 13 * vv (p + 3) p + &890326223697581454330000 * &p pow 12 * vv (p + 3) p + &1475020089467688277728000 * &p pow 11 * vv (p + 3) p + &2111403896600435550244800 * &p pow 10 * vv (p + 3) p + &2595526711983247684320000 * &p pow 9 * vv (p + 3) p + &2717989800773944583750400 * &p pow 8 * vv (p + 3) p + &2398836674899685209651200 * &p pow 7 * vv (p + 3) p + &1759214135097125512934400 * &p pow 6 * vv (p + 3) p + &1051592446215753746227200 * &p pow 5 * vv (p + 3) p + &498755575720787082854400 * &p pow 4 * vv (p + 3) p + &180380146074985857024000 * &p pow 3 * vv (p + 3) p + &46681981418812126003200 * &p pow 2 * vv (p + 3) p + &7691324341654860595200 * &p * vv (p + 3) p + &605554271057136844800 * vv (p + 3) p - &5875200 * &p pow 30 * vv (p + 2) (p + 2) - &496454400 * &p pow 29 * vv (p + 2) (p + 2) - &20182060800 * &p pow 28 * vv (p + 2) (p + 2) - &525618187200 * &p pow 27 * vv (p + 2) (p + 2) - &9852752455200 * &p pow 26 * vv (p + 2) (p + 2) - &141586844400000 * &p pow 25 * vv (p + 2) (p + 2) - &1622232668800800 * &p pow 24 * vv (p + 2) (p + 2) - &15216881838073200 * &p pow 23 * vv (p + 2) (p + 2) - &119073794633478000 * &p pow 22 * vv (p + 2) (p + 2) - &788051854021597200 * &p pow 21 * vv (p + 2) (p + 2) - &4456431820361307600 * &p pow 20 * vv (p + 2) (p + 2) - &21698902868784314400 * &p pow 19 * vv (p + 2) (p + 2) - &91488093769366401600 * &p pow 18 * vv (p + 2) (p + 2) - &335371585401421898400 * &p pow 17 * vv (p + 2) (p + 2) - &1071741009953880273600 * &p pow 16 * vv (p + 2) (p + 2) - &2990187354937999316400 * &p pow 15 * vv (p + 2) (p + 2) - &7286317532356332927600 * &p pow 14 * vv (p + 2) (p + 2) - &15495293033114667080400 * &p pow 13 * vv (p + 2) (p + 2) - &28705606152407588235600 * &p pow 12 * vv (p + 2) (p + 2) - &46182416910666822374400 * &p pow 11 * vv (p + 2) (p + 2) - &64239717512203855070400 * &p pow 10 * vv (p + 2) (p + 2) - &76792560532261627104000 * &p pow 9 * vv (p + 2) (p + 2) - &78257413215454645036800 * &p pow 8 * vv (p + 2) (p + 2) - &67266599790575125555200 * &p pow 7 * vv (p + 2) (p + 2) - &48082785202227797222400 * &p pow 6 * vv (p + 2) (p + 2) - &28038494276947532390400 * &p pow 5 * vv (p + 2) (p + 2) - &12983983325854385356800 * &p pow 4 * vv (p + 2) (p + 2) - &4588914693828752179200 * &p pow 3 * vv (p + 2) (p + 2) - &1161635825544796569600 * &p pow 2 * vv (p + 2) (p + 2) - &187382292824929075200 * &p * vv (p + 2) (p + 2) - &14457776783228928000 * vv (p + 2) (p + 2) - &5875200 * &p pow 30 * vv (p + 2) (p + 1) - &496454400 * &p pow 29 * vv (p + 2) (p + 1) - &20182060800 * &p pow 28 * vv (p + 2) (p + 1) - &525618187200 * &p pow 27 * vv (p + 2) (p + 1) - &9852752455200 * &p pow 26 * vv (p + 2) (p + 1) - &141586844400000 * &p pow 25 * vv (p + 2) (p + 1) - &1622232668800800 * &p pow 24 * vv (p + 2) (p + 1) - &15216881838073200 * &p pow 23 * vv (p + 2) (p + 1) - &119073794633478000 * &p pow 22 * vv (p + 2) (p + 1) - &788051854021597200 * &p pow 21 * vv (p + 2) (p + 1) - &4456431820361307600 * &p pow 20 * vv (p + 2) (p + 1) - &21698902868784314400 * &p pow 19 * vv (p + 2) (p + 1) - &91488093769366401600 * &p pow 18 * vv (p + 2) (p + 1) - &335371585401421898400 * &p pow 17 * vv (p + 2) (p + 1) - &1071741009953880273600 * &p pow 16 * vv (p + 2) (p + 1) - &2990187354937999316400 * &p pow 15 * vv (p + 2) (p + 1) - &7286317532356332927600 * &p pow 14 * vv (p + 2) (p + 1) - &15495293033114667080400 * &p pow 13 * vv (p + 2) (p + 1) - &28705606152407588235600 * &p pow 12 * vv (p + 2) (p + 1) - &46182416910666822374400 * &p pow 11 * vv (p + 2) (p + 1) - &64239717512203855070400 * &p pow 10 * vv (p + 2) (p + 1) - &76792560532261627104000 * &p pow 9 * vv (p + 2) (p + 1) - &78257413215454645036800 * &p pow 8 * vv (p + 2) (p + 1) - &67266599790575125555200 * &p pow 7 * vv (p + 2) (p + 1) - &48082785202227797222400 * &p pow 6 * vv (p + 2) (p + 1) - &28038494276947532390400 * &p pow 5 * vv (p + 2) (p + 1) - &12983983325854385356800 * &p pow 4 * vv (p + 2) (p + 1) - &4588914693828752179200 * &p pow 3 * vv (p + 2) (p + 1) - &1161635825544796569600 * &p pow 2 * vv (p + 2) (p + 1) - &187382292824929075200 * &p * vv (p + 2) (p + 1) - &14457776783228928000 * vv (p + 2) (p + 1) - &6144 * &p pow 36 * vv (p + 2) p - &620544 * &p pow 35 * vv (p + 2) p - &28987904 * &p pow 34 * vv (p + 2) p - &834080512 * &p pow 33 * vv (p + 2) p - &16536232576 * &p pow 32 * vv (p + 2) p - &237992445312 * &p pow 31 * vv (p + 2) p - &2524448111840 * &p pow 30 * vv (p + 2) p - &19094043856880 * &p pow 29 * vv (p + 2) p - &84930052439712 * &p pow 28 * vv (p + 2) p + &118658072299224 * &p pow 27 * vv (p + 2) p + &6431501826725016 * &p pow 26 * vv (p + 2) p + &71678736688287948 * &p pow 25 * vv (p + 2) p + &540910526248772544 * &p pow 24 * vv (p + 2) p + &3188730795997568056 * &p pow 23 * vv (p + 2) p + &15435386921408029448 * &p pow 22 * vv (p + 2) p + &62797485945725990384 * &p pow 21 * vv (p + 2) p + &217325630001711612952 * &p pow 20 * vv (p + 2) p + &643374836522472875904 * &p pow 19 * vv (p + 2) p + &1630470160060555356048 * &p pow 18 * vv (p + 2) p + &3521020120832964747652 * &p pow 17 * vv (p + 2) p + &6398130758709710542648 * &p pow 16 * vv (p + 2) p + &9502157509633529151984 * &p pow 15 * vv (p + 2) p + &10688372791664183883728 * &p pow 14 * vv (p + 2) p + &6638329791127933431984 * &p pow 13 * vv (p + 2) p - &5554811960251988017744 * &p pow 12 * vv (p + 2) p - &25822534213178540481024 * &p pow 11 * vv (p + 2) p - &49390971012287656118464 * &p pow 10 * vv (p + 2) p - &67980001135054126118656 * &p pow 9 * vv (p + 2) p - &74113229191144003251968 * &p pow 8 * vv (p + 2) p - &65782169606130748581888 * &p pow 7 * vv (p + 2) p - &47702630539562001196032 * &p pow 6 * vv (p + 2) p - &27976556011639155793920 * &p pow 5 * vv (p + 2) p - &12979163376076643942400 * &p pow 4 * vv (p + 2) p - &4588914693828752179200 * &p pow 3 * vv (p + 2) p - &1161635825544796569600 * &p pow 2 * vv (p + 2) p - &187382292824929075200 * &p * vv (p + 2) p - &14457776783228928000 * vv (p + 2) p + &2304 * &p pow 39 * vv (p + 1) (p + 1) + &230784 * &p pow 38 * vv (p + 1) (p + 1) + &10764096 * &p pow 37 * vv (p + 1) (p + 1) + &312068384 * &p pow 36 * vv (p + 1) (p + 1) + &6317830480 * &p pow 35 * vv (p + 1) (p + 1) + &94877232680 * &p pow 34 * vv (p + 1) (p + 1) + &1092254723116 * &p pow 33 * vv (p + 1) (p + 1) + &9773469084190 * &p pow 32 * vv (p + 1) (p + 1) + &67476088586106 * &p pow 31 * vv (p + 1) (p + 1) + &342141389214020 * &p pow 30 * vv (p + 1) (p + 1) + &1027139502314288 * &p pow 29 * vv (p + 1) (p + 1) - &1297555270421814 * &p pow 28 * vv (p + 1) (p + 1) - &41263951052723926 * &p pow 27 * vv (p + 1) (p + 1) - &318826850532591560 * &p pow 26 * vv (p + 1) (p + 1) - &1656699426673743740 * &p pow 25 * vv (p + 1) (p + 1) - &6497196792270769814 * &p pow 24 * vv (p + 1) (p + 1) - &19307638051713569558 * &p pow 23 * vv (p + 1) (p + 1) - &39123357908632644740 * &p pow 22 * vv (p + 1) (p + 1) - &20955766889623745456 * &p pow 21 * vv (p + 1) (p + 1) + &241387928982110219350 * &p pow 20 * vv (p + 1) (p + 1) + &1363019725448586314998 * &p pow 19 * vv (p + 1) (p + 1) + &4717398751624442875400 * &p pow 18 * vv (p + 1) (p + 1) + &12638719031598643956984 * &p pow 17 * vv (p + 1) (p + 1) + &27968295012528167990264 * &p pow 16 * vv (p + 1) (p + 1) + &52494117416637223144140 * &p pow 15 * vv (p + 1) (p + 1) + &84600469751306467276824 * &p pow 14 * vv (p + 1) (p + 1) + &117698725049716974432472 * &p pow 13 * vv (p + 1) (p + 1) + &141520574973996777178880 * &p pow 12 * vv (p + 1) (p + 1) + &146800849357163126187680 * &p pow 11 * vv (p + 1) (p + 1) + &130798754783636058640000 * &p pow 10 * vv (p + 1) (p + 1) + &99414862782326354652800 * &p pow 9 * vv (p + 1) (p + 1) + &63832457918049064872960 * &p pow 8 * vv (p + 1) (p + 1) + &34166598062862273010176 * &p pow 7 * vv (p + 1) (p + 1) + &14971506147769068859392 * &p pow 6 * vv (p + 1) (p + 1) + &5237154433747425853440 * &p pow 5 * vv (p + 1) (p + 1) + &1410141886982406144000 * &p pow 4 * vv (p + 1) (p + 1) + &276260933972430028800 * &p pow 3 * vv (p + 1) (p + 1) + &35751560630737305600 * &p pow 2 * vv (p + 1) (p + 1) + &2501285852794060800 * &p * vv (p + 1) (p + 1) + &49418312299315200 * vv (p + 1) (p + 1) + &4608 * &p pow 38 * vv (p + 1) p + &458496 * &p pow 37 * vv (p + 1) p + &21237888 * &p pow 36 * vv (p + 1) p + &611281728 * &p pow 35 * vv (p + 1) p + &12277378592 * &p pow 34 * vv (p + 1) p + &182627316240 * &p pow 33 * vv (p + 1) p + &2075431882936 * &p pow 32 * vv (p + 1) p + &18189450912748 * &p pow 31 * vv (p + 1) p + &120558124892188 * &p pow 30 * vv (p + 1) p + &549012426950680 * &p pow 29 * vv (p + 1) p + &896051073904368 * &p pow 28 * vv (p + 1) p - &11731671400316872 * &p pow 27 * vv (p + 1) p - &148681143742913604 * &p pow 26 * vv (p + 1) p - &1072503852383283124 * &p pow 25 * vv (p + 1) p - &5880307899901461712 * &p pow 24 * vv (p + 1) p - &26499042287527473748 * &p pow 23 * vv (p + 1) p - &101680990614354132460 * &p pow 22 * vv (p + 1) p - &339237467181816330544 * &p pow 21 * vv (p + 1) p - &998716848028472920912 * &p pow 20 * vv (p + 1) p - &2624909353059633378208 * &p pow 19 * vv (p + 1) p - &6217148865380344557868 * &p pow 18 * vv (p + 1) p - &13361464334559953528740 * &p pow 17 * vv (p + 1) p - &26150214104994046450440 * &p pow 16 * vv (p + 1) p - &46596490032954618364336 * &p pow 15 * vv (p + 1) p - &75285000846286601127392 * &p pow 14 * vv (p + 1) p - &109490843962042027787744 * &p pow 13 * vv (p + 1) p - &141989074943144168196608 * &p pow 12 * vv (p + 1) p - &162431161027925879313536 * &p pow 11 * vv (p + 1) p - &162020406972445279257088 * &p pow 10 * vv (p + 1) p - &139148817967626079041024 * &p pow 9 * vv (p + 1) p - &101447522175348867205120 * &p pow 8 * vv (p + 1) p - &61737529205943750936576 * &p pow 7 * vv (p + 1) p - &30703843886562149400576 * &p pow 6 * vv (p + 1) p - &12128037469898724311040 * &p pow 5 * vv (p + 1) p - &3651112853877414297600 * &p pow 4 * vv (p + 1) p - &784342373170426675200 * &p pow 3 * vv (p + 1) p - &106346735428593254400 * &p pow 2 * vv (p + 1) p - &6631869355602739200 * &p * vv (p + 1) p + &49418312299315200 * vv (p + 1) p`;; +let bdry_Dcom_tm = `&p pow 13 + &28 * &p pow 12 + &355 * &p pow 11 + &2698 * &p pow 10 + &13711 * &p pow 9 + &49192 * &p pow 8 + &128165 * &p pow 7 + &245474 * &p pow 6 + &345560 * &p pow 5 + &353072 * &p pow 4 + &254480 * &p pow 3 + &122528 * &p pow 2 + &35328 * &p + &4608`;; +let bdry_BIGD_tm = `&3600 * &p pow 6 + &75600 * &p pow 5 + &658800 * &p pow 4 + &3049200 * &p pow 3 + &7905600 * &p pow 2 + &10886400 * &p + &6220800`;; +let bdry_gen0_tm = `&p pow 6 * vv (p + 5) (p + 5) + &29 * &p pow 5 * vv (p + 5) (p + 5) + &350 * &p pow 4 * vv (p + 5) (p + 5) + &2250 * &p pow 3 * vv (p + 5) (p + 5) + &8125 * &p pow 2 * vv (p + 5) (p + 5) + &15625 * &p * vv (p + 5) (p + 5) + &12500 * vv (p + 5) (p + 5) + &2 * &p pow 5 * vv (p + 5) (p + 4) + &38 * &p pow 4 * vv (p + 5) (p + 4) + &276 * &p pow 3 * vv (p + 5) (p + 4) + &932 * &p pow 2 * vv (p + 5) (p + 4) + &1372 * &p * vv (p + 5) (p + 4) + &560 * vv (p + 5) (p + 4) - &32 * &p pow 3 * vv (p + 5) (p + 3) - &448 * &p pow 2 * vv (p + 5) (p + 3) - &2088 * &p * vv (p + 5) (p + 3) - &3240 * vv (p + 5) (p + 3)`;; +let bdry_cof0_tm = `&86400 * &p pow 24 + &5572800 * &p pow 23 + &171036000 * &p pow 22 + &3323646000 * &p pow 21 + &45903549600 * &p pow 20 + &479464506000 * &p pow 19 + &3934713153600 * &p pow 18 + &26017531092000 * &p pow 17 + &141039851601600 * &p pow 16 + &634427295372000 * &p pow 15 + &2387711492229600 * &p pow 14 + &7559015462406000 * &p pow 13 + &20188314624333600 * &p pow 12 + &45521094882690000 * &p pow 11 + &86541238302249600 * &p pow 10 + &138232174085640000 * &p pow 9 + &184413435334617600 * &p pow 8 + &203667621093216000 * &p pow 7 + &183865247998617600 * &p pow 6 + &133273231173504000 * &p pow 5 + &75586956624691200 * &p pow 4 + &32269475406643200 * &p pow 3 + &9739972450713600 * &p pow 2 + &1850617331712000 * &p + &166259589120000`;; +let bdry_gen1_tm = `&p pow 6 * vv (p + 5) (p + 4) + &23 * &p pow 5 * vv (p + 5) (p + 4) + &220 * &p pow 4 * vv (p + 5) (p + 4) + &1120 * &p pow 3 * vv (p + 5) (p + 4) + &3200 * &p pow 2 * vv (p + 5) (p + 4) + &4864 * &p * vv (p + 5) (p + 4) + &3072 * vv (p + 5) (p + 4) + &4 * &p pow 5 * vv (p + 5) (p + 3) + &50 * &p pow 4 * vv (p + 5) (p + 3) + &176 * &p pow 3 * vv (p + 5) (p + 3) - &120 * &p pow 2 * vv (p + 5) (p + 3) - &1728 * &p * vv (p + 5) (p + 3) - &2430 * vv (p + 5) (p + 3) - &144 * &p pow 3 * vv (p + 5) (p + 2) - &1800 * &p pow 2 * vv (p + 5) (p + 2) - &7488 * &p * vv (p + 5) (p + 2) - &10368 * vv (p + 5) (p + 2)`;; +let bdry_cof1_tm = `&86400 * &p pow 24 + &5918400 * &p pow 23 + &193327200 * &p pow 22 + &4005543600 * &p pow 21 + &59062831200 * &p pow 20 + &659229267600 * &p pow 19 + &5783757768000 * &p pow 18 + &40889117214000 * &p pow 17 + &236913848740800 * &p pow 16 + &1138279266378000 * &p pow 15 + &4571338080664800 * &p pow 14 + &15423332668318800 * &p pow 13 + &43834703604127200 * &p pow 12 + &105002760362583600 * &p pow 11 + &211675895497987200 * &p pow 10 + &357804524525187600 * &p pow 9 + &504074584662480000 * &p pow 8 + &586578303090342000 * &p pow 7 + &556685038496620800 * &p pow 6 + &423193274103384000 * &p pow 5 + &251126130195302400 * &p pow 4 + &111902467801478400 * &p pow 3 + &35168900889600000 * &p pow 2 + &6941058376320000 * &p + &646204262400000`;; +let bdry_gen2_tm = `&p pow 6 * vv (p + 5) (p + 3) + &17 * &p pow 5 * vv (p + 5) (p + 3) + &120 * &p pow 4 * vv (p + 5) (p + 3) + &450 * &p pow 3 * vv (p + 5) (p + 3) + &945 * &p pow 2 * vv (p + 5) (p + 3) + &1053 * &p * vv (p + 5) (p + 3) + &486 * vv (p + 5) (p + 3) + &6 * &p pow 5 * vv (p + 5) (p + 2) + &36 * &p pow 4 * vv (p + 5) (p + 2) - &132 * &p pow 3 * vv (p + 5) (p + 2) - &1464 * &p pow 2 * vv (p + 5) (p + 2) - &3744 * &p * vv (p + 5) (p + 2) - &3072 * vv (p + 5) (p + 2) - &384 * &p pow 3 * vv (p + 5) (p + 1) - &4224 * &p pow 2 * vv (p + 5) (p + 1) - &15456 * &p * vv (p + 5) (p + 1) - &18816 * vv (p + 5) (p + 1)`;; +let bdry_cof2_tm = `&86400 * &p pow 24 + &6264000 * &p pow 23 + &218037600 * &p pow 22 + &4849700400 * &p pow 21 + &77380048800 * &p pow 20 + &942306872400 * &p pow 19 + &9095079456000 * &p pow 18 + &71307344959200 * &p pow 17 + &461631695990400 * &p pow 16 + &2494712072779200 * &p pow 15 + &11332137341980800 * &p pow 14 + &43436016990644400 * &p pow 13 + &140682638388160800 * &p pow 12 + &384730387847989200 * &p pow 11 + &885924535940812800 * &p pow 10 + &1709487751124217600 * &p pow 9 + &2744547052390689600 * &p pow 8 + &3629995817349160800 * &p pow 7 + &3901969749583533600 * &p pow 6 + &3345736959544392000 * &p pow 5 + &2228711629265107200 * &p pow 4 + &1109011381600204800 * &p pow 3 + &387041984377920000 * &p pow 2 + &84330893197440000 * &p + &8615642572800000`;; +let bdry_gen3_tm = `&p pow 6 * vv (p + 5) (p + 2) + &11 * &p pow 5 * vv (p + 5) (p + 2) + &50 * &p pow 4 * vv (p + 5) (p + 2) + &120 * &p pow 3 * vv (p + 5) (p + 2) + &160 * &p pow 2 * vv (p + 5) (p + 2) + &112 * &p * vv (p + 5) (p + 2) + &32 * vv (p + 5) (p + 2) + &8 * &p pow 5 * vv (p + 5) (p + 1) - &4 * &p pow 4 * vv (p + 5) (p + 1) - &480 * &p pow 3 * vv (p + 5) (p + 1) - &2056 * &p pow 2 * vv (p + 5) (p + 1) - &3128 * &p * vv (p + 5) (p + 1) - &1540 * vv (p + 5) (p + 1) - &800 * &p pow 3 * vv (p + 5) p - &7600 * &p pow 2 * vv (p + 5) p - &24000 * &p * vv (p + 5) p - &25200 * vv (p + 5) p`;; +let bdry_cof3_tm = `&86400 * &p pow 24 + &6609600 * &p pow 23 + &245167200 * &p pow 22 + &5880999600 * &p pow 21 + &102649903200 * &p pow 20 + &1390261986000 * &p pow 19 + &15203947795200 * &p pow 18 + &137803555580400 * &p pow 17 + &1053039909312000 * &p pow 16 + &6857151796177200 * &p pow 15 + &38269679901998400 * &p pow 14 + &183406045247082000 * &p pow 13 + &753974599720140000 * &p pow 12 + &2649636189587012400 * &p pow 11 + &7916434797448656000 * &p pow 10 + &19961137388207221200 * &p pow 9 + &42077243021888923200 * &p pow 8 + &73264451084069821200 * &p pow 7 + &103751526448340920800 * &p pow 6 + &117071099940357648000 * &p pow 5 + &102333926203011417600 * &p pow 4 + &66514117469410022400 * &p pow 3 + &30130014255788160000 * &p pow 2 + &8453029904478720000 * &p + &1101417020006400000`;; +let bdry_gen4_tm = `&p pow 6 * vv (p + 4) (p + 4) + &23 * &p pow 5 * vv (p + 4) (p + 4) + &220 * &p pow 4 * vv (p + 4) (p + 4) + &1120 * &p pow 3 * vv (p + 4) (p + 4) + &3200 * &p pow 2 * vv (p + 4) (p + 4) + &4864 * &p * vv (p + 4) (p + 4) + &3072 * vv (p + 4) (p + 4) + &2 * &p pow 5 * vv (p + 4) (p + 3) + &28 * &p pow 4 * vv (p + 4) (p + 3) + &144 * &p pow 3 * vv (p + 4) (p + 3) + &312 * &p pow 2 * vv (p + 4) (p + 3) + &194 * &p * vv (p + 4) (p + 3) - &120 * vv (p + 4) (p + 3) - &32 * &p pow 3 * vv (p + 4) (p + 2) - &352 * &p pow 2 * vv (p + 4) (p + 2) - &1288 * &p * vv (p + 4) (p + 2) - &1568 * vv (p + 4) (p + 2)`;; +let bdry_cof4_tm = `--(&5875200 * &p pow 24) - &396576000 * &p pow 23 - &12729369600 * &p pow 22 - &258515899200 * &p pow 21 - &3728430309600 * &p pow 20 - &40631974588800 * &p pow 19 - &347579231839200 * &p pow 18 - &2393368080224400 * &p pow 17 - &13497076085356800 * &p pow 16 - &63090896366545200 * &p pow 15 - &246472921508990400 * &p pow 14 - &809013389162436000 * &p pow 13 - &2237593310030066400 * &p pow 12 - &5218678186679858400 * &p pow 11 - &10249528775479048800 * &p pow 10 - &16891984723036597200 * &p pow 9 - &23222309377146120000 * &p pow 8 - &26394940526826438000 * &p pow 7 - &24491980062840384000 * &p pow 6 - &18223374931146993600 * &p pow 5 - &10595665431478656000 * &p pow 4 - &4631290441640121600 * &p pow 3 - &1429325580842496000 * &p pow 2 - &277326713725977600 * &p - &25410211743744000`;; +let bdry_gen5_tm = `&p pow 6 * vv (p + 4) (p + 3) + &17 * &p pow 5 * vv (p + 4) (p + 3) + &120 * &p pow 4 * vv (p + 4) (p + 3) + &450 * &p pow 3 * vv (p + 4) (p + 3) + &945 * &p pow 2 * vv (p + 4) (p + 3) + &1053 * &p * vv (p + 4) (p + 3) + &486 * vv (p + 4) (p + 3) + &4 * &p pow 5 * vv (p + 4) (p + 2) + &30 * &p pow 4 * vv (p + 4) (p + 2) + &16 * &p pow 3 * vv (p + 4) (p + 2) - &388 * &p pow 2 * vv (p + 4) (p + 2) - &1140 * &p * vv (p + 4) (p + 2) - &952 * vv (p + 4) (p + 2) - &144 * &p pow 3 * vv (p + 4) (p + 1) - &1368 * &p pow 2 * vv (p + 4) (p + 1) - &4320 * &p * vv (p + 4) (p + 1) - &4536 * vv (p + 4) (p + 1)`;; +let bdry_cof5_tm = `--(&5875200 * &p pow 24) - &420076800 * &p pow 23 - &14339174400 * &p pow 22 - &310890427200 * &p pow 21 - &4804904095200 * &p pow 20 - &56314668614400 * &p pow 19 - &519819752095200 * &p pow 18 - &3874127371722000 * &p pow 17 - &23710326337274400 * &p pow 16 - &120557851362097200 * &p pow 15 - &513264746248833600 * &p pow 14 - &1838603198165281200 * &p pow 13 - &5555043900825213600 * &p pow 12 - &14159529767722489200 * &p pow 11 - &30393169644219674400 * &p pow 10 - &54718596712115812800 * &p pow 9 - &82099778352288098400 * &p pow 8 - &101706498599132541600 * &p pow 7 - &102676408304005080000 * &p pow 6 - &82937495975517273600 * &p pow 5 - &52218528806537395200 * &p pow 4 - &24645034491682060800 * &p pow 3 - &8186950602323942400 * &p pow 2 - &1704023733820723200 * &p - &166891761082368000`;; +let bdry_gen6_tm = `&p pow 6 * vv (p + 4) (p + 2) + &11 * &p pow 5 * vv (p + 4) (p + 2) + &50 * &p pow 4 * vv (p + 4) (p + 2) + &120 * &p pow 3 * vv (p + 4) (p + 2) + &160 * &p pow 2 * vv (p + 4) (p + 2) + &112 * &p * vv (p + 4) (p + 2) + &32 * vv (p + 4) (p + 2) + &6 * &p pow 5 * vv (p + 4) (p + 1) + &6 * &p pow 4 * vv (p + 4) (p + 1) - &216 * &p pow 3 * vv (p + 4) (p + 1) - &912 * &p pow 2 * vv (p + 4) (p + 1) - &1326 * &p * vv (p + 4) (p + 1) - &630 * vv (p + 4) (p + 1) - &384 * &p pow 3 * vv (p + 4) p - &3072 * &p pow 2 * vv (p + 4) p - &8160 * &p * vv (p + 4) p - &7200 * vv (p + 4) p`;; +let bdry_cof6_tm = `--(&5875200 * &p pow 24) - &443577600 * &p pow 23 - &16113484800 * &p pow 22 - &375121108800 * &p pow 21 - &6288127192800 * &p pow 20 - &80831613859200 * &p pow 19 - &828332713519200 * &p pow 18 - &6942396645450000 * &p pow 17 - &48421656244800000 * &p pow 16 - &284371588151420400 * &p pow 15 - &1416839907808929600 * &p pow 14 - &6014249925372093600 * &p pow 13 - &21782883134165320800 * &p pow 12 - &67255223519620267200 * &p pow 11 - &176459237187003172800 * &p pow 10 - &391313513746203253200 * &p pow 9 - &727704985151434723200 * &p pow 8 - &1122679386922915789200 * &p pow 7 - &1416156700293713656800 * &p pow 6 - &1431972812161303747200 * &p pow 5 - &1129083241734007488000 * &p pow 4 - &666618600750094310400 * &p pow 3 - &276306952606179148800 * &p pow 2 - &71464424685075763200 * &p - &8649510595043328000`;; +let bdry_gen7_tm = `&p pow 6 * vv (p + 3) (p + 3) + &17 * &p pow 5 * vv (p + 3) (p + 3) + &120 * &p pow 4 * vv (p + 3) (p + 3) + &450 * &p pow 3 * vv (p + 3) (p + 3) + &945 * &p pow 2 * vv (p + 3) (p + 3) + &1053 * &p * vv (p + 3) (p + 3) + &486 * vv (p + 3) (p + 3) + &2 * &p pow 5 * vv (p + 3) (p + 2) + &18 * &p pow 4 * vv (p + 3) (p + 2) + &52 * &p pow 3 * vv (p + 3) (p + 2) + &28 * &p pow 2 * vv (p + 3) (p + 2) - &100 * &p * vv (p + 3) (p + 2) - &120 * vv (p + 3) (p + 2) - &32 * &p pow 3 * vv (p + 3) (p + 1) - &256 * &p pow 2 * vv (p + 3) (p + 1) - &680 * &p * vv (p + 3) (p + 1) - &600 * vv (p + 3) (p + 1)`;; +let bdry_cof7_tm = `&100051200 * &p pow 24 + &7053609600 * &p pow 23 + &236613614400 * &p pow 22 + &5024772036000 * &p pow 21 + &75819687465600 * &p pow 20 + &864887567760000 * &p pow 19 + &7747555872837600 * &p pow 18 + &55884793405698000 * &p pow 17 + &330231204867470400 * &p pow 16 + &1617795382867765200 * &p pow 15 + &6624428776259299200 * &p pow 14 + &22790678114460718800 * &p pow 13 + &66062923496887636800 * &p pow 12 + &161441293752631033200 * &p pow 11 + &332111935068037365600 * &p pow 10 + &573034258799269776000 * &p pow 9 + &824249921378693126400 * &p pow 8 + &979493352855501024000 * &p pow 7 + &949387893620182617600 * &p pow 6 + &737117357341177036800 * &p pow 5 + &446694844675927449600 * &p pow 4 + &203229177076054425600 * &p pow 3 + &65190781050686668800 * &p pow 2 + &13126111291559116800 * &p + &1245996442504396800`;; +let bdry_gen8_tm = `&p pow 6 * vv (p + 3) (p + 2) + &11 * &p pow 5 * vv (p + 3) (p + 2) + &50 * &p pow 4 * vv (p + 3) (p + 2) + &120 * &p pow 3 * vv (p + 3) (p + 2) + &160 * &p pow 2 * vv (p + 3) (p + 2) + &112 * &p * vv (p + 3) (p + 2) + &32 * vv (p + 3) (p + 2) + &4 * &p pow 5 * vv (p + 3) (p + 1) + &10 * &p pow 4 * vv (p + 3) (p + 1) - &64 * &p pow 3 * vv (p + 3) (p + 1) - &296 * &p pow 2 * vv (p + 3) (p + 1) - &416 * &p * vv (p + 3) (p + 1) - &190 * vv (p + 3) (p + 1) - &144 * &p pow 3 * vv (p + 3) p - &936 * &p pow 2 * vv (p + 3) p - &2016 * &p * vv (p + 3) p - &1440 * vv (p + 3) p`;; +let bdry_cof8_tm = `&100051200 * &p pow 24 + &7453814400 * &p pow 23 + &265628462400 * &p pow 22 + &6026654858400 * &p pow 21 + &97739847763200 * &p pow 20 + &1205915065142400 * &p pow 19 + &11760909637788000 * &p pow 18 + &92988910271358000 * &p pow 17 + &606487496576169600 * &p pow 16 + &3302403373019898000 * &p pow 15 + &15135344153788305600 * &p pow 14 + &58686176951844148800 * &p pow 13 + &193016927859720098400 * &p pow 12 + &538674960005803706400 * &p pow 11 + &1273334772475467158400 * &p pow 10 + &2539085405212065279600 * &p pow 9 + &4243008074001502356000 * &p pow 8 + &5885275873225479138000 * &p pow 7 + &6685115223237495674400 * &p pow 6 + &6102838859661581184000 * &p pow 5 + &4359222393175599091200 * &p pow 4 + &2341335639791658700800 * &p pow 3 + &887130720333750067200 * &p pow 2 + &210884340198142771200 * &p + &23596057629927014400`;; +let bdry_gen9_tm = `&p pow 6 * vv (p + 2) (p + 2) + &11 * &p pow 5 * vv (p + 2) (p + 2) + &50 * &p pow 4 * vv (p + 2) (p + 2) + &120 * &p pow 3 * vv (p + 2) (p + 2) + &160 * &p pow 2 * vv (p + 2) (p + 2) + &112 * &p * vv (p + 2) (p + 2) + &32 * vv (p + 2) (p + 2) + &2 * &p pow 5 * vv (p + 2) (p + 1) + &8 * &p pow 4 * vv (p + 2) (p + 1) - &40 * &p pow 2 * vv (p + 2) (p + 1) - &62 * &p * vv (p + 2) (p + 1) - &28 * vv (p + 2) (p + 1) - &32 * &p pow 3 * vv (p + 2) p - &160 * &p pow 2 * vv (p + 2) p - &264 * &p * vv (p + 2) p - &144 * vv (p + 2) p`;; +let bdry_cof9_tm = `--(&5875200 * &p pow 24) - &431827200 * &p pow 23 - &15138201600 * &p pow 22 - &336801585600 * &p pow 21 - &5338265637600 * &p pow 20 - &64139508540000 * &p pow 19 - &606897937800000 * &p pow 18 - &4637839668015600 * &p pow 17 - &29123591668452000 * &p pow 16 - &152101624963294800 * &p pow 15 - &666135482675709600 * &p pow 14 - &2459420930783152800 * &p pow 13 - &7676860957591197600 * &p pow 12 - &20272297277305641600 * &p pow 11 - &45223166172586982400 * &p pow 10 - &84912573279507361200 * &p pow 9 - &133376011467798405600 * &p pow 8 - &173670840878900994000 * &p pow 7 - &185054102493806311200 * &p pow 6 - &158438514229394227200 * &p pow 5 - &106176465846730944000 * &p pow 4 - &53551227259301990400 * &p pow 3 - &19081771322998579200 * &p pow 2 - &4274377315113369600 * &p - &451805524475904000`;; +let bdry_gen10_tm = `&2 * &p pow 4 * vv (p + 5) (p + 1) + &8 * &p pow 3 * vv (p + 5) (p + 1) + &12 * &p pow 2 * vv (p + 5) (p + 1) + &8 * &p * vv (p + 5) (p + 1) + &2 * vv (p + 5) (p + 1) - &200 * &p pow 2 * vv (p + 5) p - &1200 * &p * vv (p + 5) p - &1800 * vv (p + 5) p - &p pow 5 * vv (p + 4) (p + 1) - &7 * &p pow 4 * vv (p + 4) (p + 1) - &18 * &p pow 3 * vv (p + 4) (p + 1) - &22 * &p pow 2 * vv (p + 4) (p + 1) - &13 * &p * vv (p + 4) (p + 1) - &3 * vv (p + 4) (p + 1) + &64 * &p pow 3 * vv (p + 4) p + &512 * &p pow 2 * vv (p + 4) p + &1360 * &p * vv (p + 4) p + &1200 * vv (p + 4) p`;; +let bdry_cof10_tm = `&43200 * &p pow 26 + &3520800 * &p pow 25 + &140835600 * &p pow 24 + &3699520200 * &p pow 23 + &72065745000 * &p pow 22 + &1114367607000 * &p pow 21 + &14284908801000 * &p pow 20 + &156243816342000 * &p pow 19 + &1485697050558000 * &p pow 18 + &12417308909305200 * &p pow 17 + &91682907278176800 * &p pow 16 + &598457327971869000 * &p pow 15 + &3445995694377227400 * &p pow 14 + &17433266444106852600 * &p pow 13 + &77082529644165493800 * &p pow 12 + &296073100097928165600 * &p pow 11 + &981056771754051045600 * &p pow 10 + &2782102935278761696800 * &p pow 9 + &6688574695581481396800 * &p pow 8 + &13475795237472428330400 * &p pow 7 + &22421284647096937406400 * &p pow 6 + &30215414570375159942400 * &p pow 5 + &32107172033099394432000 * &p pow 4 + &25861795513307727206400 * &p pow 3 + &14824848005395534080000 * &p pow 2 + &5383536463458616320000 * &p + &930186193161830400000`;; +let bdry_gen11_tm = `&600 * &p pow 3 * vv (p + 5) p + &9000 * &p pow 2 * vv (p + 5) p + &45000 * &p * vv (p + 5) p + &75000 * vv (p + 5) p - &192 * &p pow 5 * vv (p + 4) p - &3552 * &p pow 4 * vv (p + 4) p - &25968 * &p pow 3 * vv (p + 4) p - &93384 * &p pow 2 * vv (p + 4) p - &164520 * &p * vv (p + 4) p - &113400 * vv (p + 4) p + &4 * &p pow 8 * vv (p + 3) (p + 1) + &48 * &p pow 7 * vv (p + 3) (p + 1) + &225 * &p pow 6 * vv (p + 3) (p + 1) + &545 * &p pow 5 * vv (p + 3) (p + 1) + &750 * &p pow 4 * vv (p + 3) (p + 1) + &594 * &p pow 3 * vv (p + 3) (p + 1) + &253 * &p pow 2 * vv (p + 3) (p + 1) + &45 * &p * vv (p + 3) (p + 1) + &24 * &p pow 7 * vv (p + 3) p + &360 * &p pow 6 * vv (p + 3) p + &2742 * &p pow 5 * vv (p + 3) p + &13884 * &p pow 4 * vv (p + 3) p + &45492 * &p pow 3 * vv (p + 3) p + &88512 * &p pow 2 * vv (p + 3) p + &91440 * &p * vv (p + 3) p + &38400 * vv (p + 3) p`;; +let bdry_cof11_tm = `&144 * &p pow 27 + &11304 * &p pow 26 + &438852 * &p pow 25 + &11307570 * &p pow 24 + &219070956 * &p pow 23 + &3426158184 * &p pow 22 + &45257871936 * &p pow 21 + &519859760154 * &p pow 20 + &5283062665056 * &p pow 19 + &47900218749024 * &p pow 18 + &388309892568036 * &p pow 17 + &2809557236557734 * &p pow 16 + &18070994225044236 * &p pow 15 + &102797044719442584 * &p pow 14 + &514218851471291256 * &p pow 13 + &2248179315971572974 * &p pow 12 + &8534875727807013336 * &p pow 11 + &27935359807564723704 * &p pow 10 + &78200336444397809376 * &p pow 9 + &185463560511454442784 * &p pow 8 + &368380150569879245952 * &p pow 7 + &603899044300460803200 * &p pow 6 + &801418217125160722944 * &p pow 5 + &838192023811692048384 * &p pow 4 + &664221449269259550720 * &p pow 3 + &374433899685374361600 * &p pow 2 + &133664125302816768000 * &p + &22694572464537600000`;; +let bdry_gen12_tm = `&3 * &p pow 4 * vv (p + 4) (p + 1) + &12 * &p pow 3 * vv (p + 4) (p + 1) + &18 * &p pow 2 * vv (p + 4) (p + 1) + &12 * &p * vv (p + 4) (p + 1) + &3 * vv (p + 4) (p + 1) - &192 * &p pow 2 * vv (p + 4) p - &960 * &p * vv (p + 4) p - &1200 * vv (p + 4) p - &2 * &p pow 5 * vv (p + 3) (p + 1) - &13 * &p pow 4 * vv (p + 3) (p + 1) - &32 * &p pow 3 * vv (p + 3) (p + 1) - &38 * &p pow 2 * vv (p + 3) (p + 1) - &22 * &p * vv (p + 3) (p + 1) - &5 * vv (p + 3) (p + 1) + &72 * &p pow 3 * vv (p + 3) p + &468 * &p pow 2 * vv (p + 3) p + &1008 * &p * vv (p + 3) p + &720 * vv (p + 3) p`;; +let bdry_cof12_tm = `&14400 * &p pow 27 - &741600 * &p pow 26 - &107185200 * &p pow 25 - &4799117400 * &p pow 24 - &129262665600 * &p pow 23 - &2477542254000 * &p pow 22 - &36603694856400 * &p pow 21 - &437024128084200 * &p pow 20 - &4348580656414800 * &p pow 19 - &36820252365459600 * &p pow 18 - &268982859716143200 * &p pow 17 - &1709905430752416600 * &p pow 16 - &9500888284482980400 * &p pow 15 - &46202947462537732800 * &p pow 14 - &196436862153056229600 * &p pow 13 - &728065853217695519400 * &p pow 12 - &2342187201934871596800 * &p pow 11 - &6502788653914224578400 * &p pow 10 - &15470391090693618758400 * &p pow 9 - &31257715628755253692800 * &p pow 8 - &53037210946660988812800 * &p pow 7 - &74482819004203540569600 * &p pow 6 - &84910952831473122969600 * &p pow 5 - &76490541737326489190400 * &p pow 4 - &52335183541710672691200 * &p pow 3 - &25527934394691718348800 * &p pow 2 - &7899972840522370252800 * &p - &1164571431379402752000`;; +let bdry_gen13_tm = `&72 * &p pow 3 * vv (p + 4) p + &864 * &p pow 2 * vv (p + 4) p + &3456 * &p * vv (p + 4) p + &4608 * vv (p + 4) p - &36 * &p pow 5 * vv (p + 3) p - &522 * &p pow 4 * vv (p + 3) p - &3006 * &p pow 3 * vv (p + 3) p - &8550 * &p pow 2 * vv (p + 3) p - &11952 * &p * vv (p + 3) p - &6552 * vv (p + 3) p + &2 * &p pow 8 * vv (p + 2) (p + 1) + &21 * &p pow 7 * vv (p + 2) (p + 1) + &89 * &p pow 6 * vv (p + 2) (p + 1) + &200 * &p pow 5 * vv (p + 2) (p + 1) + &260 * &p pow 4 * vv (p + 2) (p + 1) + &197 * &p pow 3 * vv (p + 2) (p + 1) + &81 * &p pow 2 * vv (p + 2) (p + 1) + &14 * &p * vv (p + 2) (p + 1) + &8 * &p pow 7 * vv (p + 2) p + &96 * &p pow 6 * vv (p + 2) p + &562 * &p pow 5 * vv (p + 2) p + &2114 * &p pow 4 * vv (p + 2) p + &5146 * &p pow 3 * vv (p + 2) p + &7554 * &p pow 2 * vv (p + 2) p + &5976 * &p * vv (p + 2) p + &1944 * vv (p + 2) p`;; +let bdry_cof13_tm = `&384 * &p pow 29 + &32640 * &p pow 28 + &1288160 * &p pow 27 + &31633280 * &p pow 26 + &545123752 * &p pow 25 + &7037282080 * &p pow 24 + &70868350738 * &p pow 23 + &571887278374 * &p pow 22 + &3766738961590 * &p pow 21 + &20500822632154 * &p pow 20 + &92851107960188 * &p pow 19 + &350190642252020 * &p pow 18 + &1087965871592692 * &p pow 17 + &2672302437619732 * &p pow 16 + &4402940729565322 * &p pow 15 - &454464899664050 * &p pow 14 - &40882791732340402 * &p pow 13 - &211152342305588686 * &p pow 12 - &760601943650634200 * &p pow 11 - &2220005577555401096 * &p pow 10 - &5441849540424857536 * &p pow 9 - &11266574541545429920 * &p pow 8 - &19581211151940007808 * &p pow 7 - &28207809741669446528 * &p pow 6 - &33056765181570362880 * &p pow 5 - &30687132729881088000 * &p pow 4 - &21694952873089843200 * &p pow 3 - &10966061767569408000 * &p pow 2 - &3527587065898598400 * &p - &542354259050496000`;; +let bdry_gen14_tm = `&p pow 4 * vv (p + 3) (p + 1) + &4 * &p pow 3 * vv (p + 3) (p + 1) + &6 * &p pow 2 * vv (p + 3) (p + 1) + &4 * &p * vv (p + 3) (p + 1) + vv (p + 3) (p + 1) - &36 * &p pow 2 * vv (p + 3) p - &144 * &p * vv (p + 3) p - &144 * vv (p + 3) p - &p pow 5 * vv (p + 2) (p + 1) - &6 * &p pow 4 * vv (p + 2) (p + 1) - &14 * &p pow 3 * vv (p + 2) (p + 1) - &16 * &p pow 2 * vv (p + 2) (p + 1) - &9 * &p * vv (p + 2) (p + 1) - &2 * vv (p + 2) (p + 1) + &16 * &p pow 3 * vv (p + 2) p + &80 * &p pow 2 * vv (p + 2) p + &132 * &p * vv (p + 2) p + &72 * vv (p + 2) p`;; +let bdry_cof14_tm = `--(&576 * &p pow 31) - &49824 * &p pow 30 - &2127648 * &p pow 29 - &60076416 * &p pow 28 - &1272082140 * &p pow 27 - &21678131478 * &p pow 26 - &309349660470 * &p pow 25 - &3764880838020 * &p pow 24 - &39285269676360 * &p pow 23 - &351373426215450 * &p pow 22 - &2690609090837730 * &p pow 21 - &17632955897724960 * &p pow 20 - &98957756195993940 * &p pow 19 - &476055711249644490 * &p pow 18 - &1964628794902862970 * &p pow 17 - &6954705762708068340 * &p pow 16 - &21083596466364268080 * &p pow 15 - &54509672129360654790 * &p pow 14 - &119173969517281494990 * &p pow 13 - &216661556366147109480 * &p pow 12 - &316043122780615600824 * &p pow 11 - &336701223229004214816 * &p pow 10 - &167699044679585986752 * &p pow 9 + &255669038430056567616 * &p pow 8 + &854346839627358493920 * &p pow 7 + &1385958424319160358848 * &p pow 6 + &1577283348512186818560 * &p pow 5 + &1335654529501529318400 * &p pow 4 + &835710291083698790400 * &p pow 3 + &368146803721159065600 * &p pow 2 + &102378137931605606400 * &p + &13545929348893900800`;; +let bdry_gen15_tm = `&18 * &p pow 3 * vv (p + 3) p + &162 * &p pow 2 * vv (p + 3) p + &486 * &p * vv (p + 3) p + &486 * vv (p + 3) p - &16 * &p pow 5 * vv (p + 2) p - &168 * &p pow 4 * vv (p + 2) p - &708 * &p pow 3 * vv (p + 2) p - &1486 * &p pow 2 * vv (p + 2) p - &1542 * &p * vv (p + 2) p - &630 * vv (p + 2) p + &4 * &p pow 8 * vv (p + 1) (p + 1) + &36 * &p pow 7 * vv (p + 1) (p + 1) + &135 * &p pow 6 * vv (p + 1) (p + 1) + &275 * &p pow 5 * vv (p + 1) (p + 1) + &330 * &p pow 4 * vv (p + 1) (p + 1) + &234 * &p pow 3 * vv (p + 1) (p + 1) + &91 * &p pow 2 * vv (p + 1) (p + 1) + &15 * &p * vv (p + 1) (p + 1) + &8 * &p pow 7 * vv (p + 1) p + &72 * &p pow 6 * vv (p + 1) p + &298 * &p pow 5 * vv (p + 1) p + &748 * &p pow 4 * vv (p + 1) p + &1198 * &p pow 3 * vv (p + 1) p + &1176 * &p pow 2 * vv (p + 1) p + &636 * &p * vv (p + 1) p + &144 * vv (p + 1) p`;; +let bdry_cof15_tm = `&576 * &p pow 31 + &52128 * &p pow 30 + &2164896 * &p pow 29 + &55004064 * &p pow 28 + &957345404 * &p pow 27 + &12047156006 * &p pow 26 + &111770221790 * &p pow 25 + &750215524722 * &p pow 24 + &3236155988338 * &p pow 23 + &2803388952322 * &p pow 22 - &91053628161448 * &p pow 21 - &946551437282136 * &p pow 20 - &5934686877270732 * &p pow 19 - &27875263266799882 * &p pow 18 - &104467845797243726 * &p pow 17 - &320749771148642930 * &p pow 16 - &816774055034567890 * &p pow 15 - &1733586627330459678 * &p pow 14 - &3067409899772814264 * &p pow 13 - &4507647620425796680 * &p pow 12 - &5459083173473240672 * &p pow 11 - &5379766582512786464 * &p pow 10 - &4226679778466588928 * &p pow 9 - &2552732855801555840 * &p pow 8 - &1088673373884929024 * &p pow 7 - &225199038903980032 * &p pow 6 + &101102108821985280 * &p pow 5 + &143428587155251200 * &p pow 4 + &95214356029440000 * &p pow 3 + &42949024815513600 * &p pow 2 + &12386469976473600 * &p + &1715913621504000`;; +let bdry_gen16_tm = `&p pow 4 * vv (p + 2) (p + 1) + &4 * &p pow 3 * vv (p + 2) (p + 1) + &6 * &p pow 2 * vv (p + 2) (p + 1) + &4 * &p * vv (p + 2) (p + 1) + vv (p + 2) (p + 1) - &16 * &p pow 2 * vv (p + 2) p - &48 * &p * vv (p + 2) p - &36 * vv (p + 2) p - &2 * &p pow 5 * vv (p + 1) (p + 1) - &11 * &p pow 4 * vv (p + 1) (p + 1) - &24 * &p pow 3 * vv (p + 1) (p + 1) - &26 * &p pow 2 * vv (p + 1) (p + 1) - &14 * &p * vv (p + 1) (p + 1) - &3 * vv (p + 1) (p + 1) + &8 * &p pow 3 * vv (p + 1) p + &28 * &p pow 2 * vv (p + 1) p + &32 * &p * vv (p + 1) p + &12 * vv (p + 1) p`;; +let bdry_cof16_tm = `--(&768 * &p pow 33) - &70848 * &p pow 32 - &3061216 * &p pow 31 - &83061312 * &p pow 30 - &1598472816 * &p pow 29 - &23362274148 * &p pow 28 - &271514623994 * &p pow 27 - &2601338699496 * &p pow 26 - &21222284621772 * &p pow 25 - &152091013327860 * &p pow 24 - &984751302726734 * &p pow 23 - &5873330498134824 * &p pow 22 - &32447423889987320 * &p pow 21 - &164786849499170652 * &p pow 20 - &758433071885086310 * &p pow 19 - &3118513982593851624 * &p pow 18 - &11328698663537881724 * &p pow 17 - &36080746184490134220 * &p pow 16 - &100220071139584247282 * &p pow 15 - &241822133901305637000 * &p pow 14 - &505048510927361785936 * &p pow 13 - &909407834489851454976 * &p pow 12 - &1405069622466917634944 * &p pow 11 - &1851423958449873246720 * &p pow 10 - &2064195223366505750784 * &p pow 9 - &1927236689094077930496 * &p pow 8 - &1486264235226656990720 * &p pow 7 - &929352431423781402624 * &p pow 6 - &459188080190984724480 * &p pow 5 - &172683375746487091200 * &p pow 4 - &46626662935727308800 * &p pow 3 - &8168330355159859200 * &p pow 2 - &748309452580454400 * &p - &16472770766438400`;; + +(* ========================================================================= *) +(* Boundary group, called "around_p_p" in the Coq development: n=p+1, p>=1. *) +(* sum(p..p+5) pflat2 vv (p+1) j = -(qflat vv (p+1) p). *) +(* Proof by a cofactor certificate: reduce the boundary sum + qflat to 0 *) +(* modulo the cleared v-recurrences (V_*_CL), following the reduction order *) +(* v55..v22,v51,v50,...,v21 used in theories/ops_for_b.v. *) +(* ========================================================================= *) + +(* 6-term numseg expansion. *) +let SUM_6 = prove + (`!f m. sum(m..m+5) f = f m + f(m+1) + f(m+2) + f(m+3) + f(m+4) + f(m+5)`, + REPEAT GEN_TAC THEN + SIMP_TAC([SUM_CLAUSES_LEFT; + ARITH_RULE `m<=m+5`; ARITH_RULE `m+1<=m+5`; ARITH_RULE `m+2<=m+5`; + ARITH_RULE `m+3<=m+5`; ARITH_RULE `m+4<=m+5`] @ + (CONJUNCTS o ARITH_RULE) + `((m+1)+1 = m+2) /\ ((m+2)+1 = m+3) /\ ((m+3)+1 = m+4) /\ ((m+4)+1 = m+5) /\ + ((m+1)+2 = m+3) /\ ((m+1)+3 = m+4) /\ ((m+1)+4 = m+5) /\ + ((m+2)+2 = m+4) /\ ((m+2)+3 = m+5) /\ ((m+3)+2 = m+5)`) THEN + REWRITE_TAC[SUM_SING_NUMSEG] THEN REAL_ARITH_TAC);; + +let hyp1p = ASSUME `1 <= p`;; + +(* support-zero rules vv(p+i)(p+t)=0 for inum->num`,`p:num`),mk_small_numeral i); + mk_comb(mk_comb(`(+):num->num->num`,`p:num`),mk_small_numeral t)] VV_SUPPORT in + MP th (prove(fst(dest_imp(concl th)), ARITH_TAC)) in + map (fun (i,t) -> mk_supp i t) + [(1,2);(1,3);(1,4);(1,5);(2,3);(2,4);(2,5);(3,4);(3,5);(4,5)];; + +(* generic index normalization (p+a)+b = p+(a+b) for the boundary range *) +let GIDX = (CONJUNCTS o ARITH_RULE) + `((p+0)+0 = p+0) /\ ((p+0)+1 = p+1) /\ ((p+0)+2 = p+2) /\ + ((p+1)+0 = p+1) /\ ((p+1)+1 = p+2) /\ ((p+1)+2 = p+3) /\ + ((p+2)+0 = p+2) /\ ((p+2)+1 = p+3) /\ ((p+2)+2 = p+4) /\ + ((p+3)+0 = p+3) /\ ((p+3)+1 = p+4) /\ ((p+3)+2 = p+5) /\ + ((p+4)+1 = p+5) /\ (p+0 = p)`;; + +(* Instantiate a cleared recurrence at (p+No,p+Ko) and normalize indices. *) +let bdry_cl_inst clG no ko = + let inst = SPECL [mk_comb(mk_comb(`(+):num->num->num`,`p:num`),mk_small_numeral no); + mk_comb(mk_comb(`(+):num->num->num`,`p:num`),mk_small_numeral ko)] clG in + let pre = fst(dest_imp(concl inst)) in + let preth = MP (prove(mk_imp(`1<=p`,pre), DISCH_TAC THEN ASM_ARITH_TAC)) hyp1p in + REWRITE_RULE (GIDX @ [GSYM REAL_OF_NUM_ADD]) (MP inst preth);; + +(* Derive each generator equation from its cleared recurrence. *) +let prove_bdry_gen_zero2 clG no ko gen_tm = + prove(mk_imp(`1 <= p`, mk_eq(gen_tm, `&0`)), + DISCH_TAC THEN MP_TAC(bdry_cl_inst clG no ko) THEN ASM_REWRITE_TAC[] THEN + CONV_TAC REAL_RING);; + +(* Cleared recurrences and offsets in the order used by the certificate. *) +let gen_specs = [ + (V_SK2_CL_G, 5, 3); (V_SK2_CL_G, 5, 2); (V_SK2_CL_G, 5, 1); (V_SK2_CL_G, 5, 0); + (V_SK2_CL_G, 4, 2); (V_SK2_CL_G, 4, 1); (V_SK2_CL_G, 4, 0); + (V_SK2_CL_G, 3, 1); (V_SK2_CL_G, 3, 0); (V_SK2_CL_G, 2, 0); + (V_SNSK_CL_G, 4, 0); (V_SN2_CL_G, 3, 0); (V_SNSK_CL_G, 3, 0); (V_SN2_CL_G, 2, 0); + (V_SNSK_CL_G, 2, 0); (V_SN2_CL_G, 1, 0); (V_SNSK_CL_G, 1, 0) ];; + +let gen_tms = [bdry_gen0_tm;bdry_gen1_tm;bdry_gen2_tm;bdry_gen3_tm;bdry_gen4_tm; + bdry_gen5_tm;bdry_gen6_tm;bdry_gen7_tm;bdry_gen8_tm;bdry_gen9_tm;bdry_gen10_tm; + bdry_gen11_tm;bdry_gen12_tm;bdry_gen13_tm;bdry_gen14_tm;bdry_gen15_tm;bdry_gen16_tm];; +let cof_tms = [bdry_cof0_tm;bdry_cof1_tm;bdry_cof2_tm;bdry_cof3_tm;bdry_cof4_tm; + bdry_cof5_tm;bdry_cof6_tm;bdry_cof7_tm;bdry_cof8_tm;bdry_cof9_tm;bdry_cof10_tm; + bdry_cof11_tm;bdry_cof12_tm;bdry_cof13_tm;bdry_cof14_tm;bdry_cof15_tm;bdry_cof16_tm];; + +let bdry_gz = + map2 + (fun (clG,no,ko) gt -> prove_bdry_gen_zero2 clG no ko gt) + gen_specs gen_tms;; + +(* cofactor certificate: bdry_target_tm = sum cof_i*gen_i (REAL_POLY_CONV) *) +let bdry_cert_eq = + let cert_rhs = end_itlist (fun a b -> mk_binop add_tm a b) + (map2 (fun c g -> mk_binop mul_tm c g) cof_tms gen_tms) in + prove(mk_eq(bdry_target_tm, cert_rhs), + CONV_TAC(LAND_CONV REAL_POLY_CONV THENC RAND_CONV REAL_POLY_CONV) THEN REFL_TAC);; + +let BDRY_TARGET_ZERO = prove + (mk_imp(`1 <= p`, mk_eq(bdry_target_tm, `&0`)), + DISCH_TAC THEN + GEN_REWRITE_TAC LAND_CONV [bdry_cert_eq] THEN + ASM_SIMP_TAC bdry_gz THEN + REWRITE_TAC[REAL_MUL_RZERO; REAL_ADD_RID; REAL_ADD_LID]);; + +(* boundary sum expansion (no v-rec substitution) *) +let BSUM_EXPAND = prove + (`!p. 1 <= p ==> + sum(p..p+5) (\j. pflat2 vv (p+1) j) = + pflat2 vv (p+1) p + pflat2 vv (p+1) (p+1) + + pflat2 vv (p+1) (p+2) + pflat2 vv (p+1) (p+3) + + pflat2 vv (p+1) (p+4) + pflat2 vv (p+1) (p+5)`, + GEN_TAC THEN DISCH_TAC THEN + MP_TAC(ISPECL [`\j. pflat2 vv (p+1) j`; `p:num`] SUM_6) THEN + REWRITE_TAC[] THEN + DISCH_THEN SUBST1_TAC THEN REFL_TAC);; + +(* Relate the target to the boundary sum, clearing the qc denominators. *) +let prove_pnz f = + MP (prove(mk_imp(`1 <= p`, mk_neg(mk_eq(f,`&0`))), + REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_LE] THEN DISCH_TAC THEN + CONV_TAC(RAND_CONV(LAND_CONV REAL_POLY_CONV)) THEN ASM_REAL_ARITH_TAC)) + (ASSUME `1 <= p`);; +let conn_rhs = mk_binop mul_tm bdry_Dcom_tm + (mk_binop mul_tm bdry_BIGD_tm + (mk_binop add_tm + `sum(p..p+5)(\j. pflat2 vv (p+1) j)` `qflat vv (p+1) p`));; +let BDRY_CONNECT = + prove(mk_imp(`1 <= p`, mk_eq(bdry_target_tm, conn_rhs)), + DISCH_TAC THEN + ASM_SIMP_TAC[BSUM_EXPAND] THEN + REWRITE_TAC[pflat2; pflat; qflat; + ARITH_RULE `(p+1)+1 = p+2`; ARITH_RULE `(p+1)+2 = p+3`; + ARITH_RULE `(p+1)+3 = p+4`; ARITH_RULE `(p+1)+4 = p+5`] THEN + REWRITE_TAC supp_rules THEN + REWRITE_TAC[REAL_MUL_RZERO; REAL_ADD_RID; REAL_ADD_LID; REAL_MUL_LZERO] THEN + REWRITE_TAC[qc00; qc01; qc10] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN + W(fun (asl,w) -> + let dfs = denom_factors w [] in + let nz = map prove_pnz dfs in + ACCEPT_TAC(MP (DISCH `1 <= p` (prove_rat_eq nz w)) (ASSUME `1 <= p`))));; + +(* Dcom, BIGD nonzero (factored forms) *) +let BDRY_DCOM_NZ = prove(mk_imp(`1 <= p`, mk_neg(mk_eq(bdry_Dcom_tm,`&0`))), + DISCH_TAC THEN + SUBGOAL_THEN (mk_eq(bdry_Dcom_tm, + `(&p + &1) pow 4 * (&p + &2) pow 5 * (&p + &3) pow 2 * (&p + &4) pow 2`)) SUBST1_TAC THENL + [CONV_TAC(LAND_CONV REAL_POLY_CONV THENC RAND_CONV REAL_POLY_CONV) THEN REFL_TAC; + REWRITE_TAC[REAL_ENTIRE; REAL_POW_EQ_0; DE_MORGAN_THM] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_LE] THEN + REPEAT(POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC THEN ASM_REAL_ARITH_TAC]);; +let BDRY_BIGD_NZ = prove(mk_imp(`1 <= p`, mk_neg(mk_eq(bdry_BIGD_tm,`&0`))), + DISCH_TAC THEN + SUBGOAL_THEN (mk_eq(bdry_BIGD_tm, + `&3600 * (&p + &3) pow 3 * (&p + &4) pow 3`)) SUBST1_TAC THENL + [CONV_TAC(LAND_CONV REAL_POLY_CONV THENC RAND_CONV REAL_POLY_CONV) THEN REFL_TAC; + REWRITE_TAC[REAL_ENTIRE; REAL_POW_EQ_0; DE_MORGAN_THM] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_LE] THEN + REPEAT(POP_ASSUM MP_TAC) THEN REPEAT STRIP_TAC THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN ASM_REAL_ARITH_TAC]);; + +let BOUNDARY = prove + (`!p. 1 <= p + ==> sum(p..p+5) (\j. pflat2 vv (p+1) j) = + --(qflat vv (p+1) p)`, + GEN_TAC THEN DISCH_TAC THEN + MP_TAC(SPEC_ALL BDRY_CONNECT) THEN ASM_REWRITE_TAC[] THEN + MP_TAC(SPEC_ALL BDRY_TARGET_ZERO) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(fun th1 -> DISCH_THEN(fun th2 -> MP_TAC(TRANS (SYM th2) th1))) THEN + MP_TAC(SPEC_ALL BDRY_DCOM_NZ) THEN ASM_REWRITE_TAC[] THEN + MP_TAC(SPEC_ALL BDRY_BIGD_NZ) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[REAL_ENTIRE; DE_MORGAN_THM] THEN + CONV_TAC REAL_RING);; + +(* ------------------------------------------------------------------------- *) +(* Assembly for n >= 3: pflat ww n = 0. *) +(* sum(0..n+4) pflat2 = sum(0..n-2) + sum(n-1..n+4) *) +(* = qflat(n,n-1) + (-qflat(n,n-1)) = 0. *) +(* ------------------------------------------------------------------------- *) +let PFLAT_WW_GE3 = prove + (`!n. 3 <= n ==> pflat ww n = &0`, + GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[PFLAT_WW_DECOMP] THEN + SUBGOAL_THEN `sum(0..n+4) (\j. pflat2 vv n j) = + sum(0..n-2) (\j. pflat2 vv n j) + + sum(n-1..n+4) (\j. pflat2 vv n j)` + SUBST1_TAC THENL + [MP_TAC(ISPECL + [`\j. pflat2 vv n j`; `0`; `n-2`; `n+4`] SUM_COMBINE_R) THEN + ASM_SIMP_TAC[ARITH_RULE `3 <= n ==> 0 <= n-2+1 /\ (n-2)+1 = n-1`; LE_0; + ARITH_RULE `3 <= n ==> n-2 <= n+4`] THEN + DISCH_THEN(fun th -> REWRITE_TAC[GSYM th]); ALL_TAC] THEN + ASM_SIMP_TAC[INTERIOR_FULL] THEN + SUBGOAL_THEN + `sum(n-1..n+4) (\j. pflat2 vv n j) = --(qflat vv n (n-1))` + SUBST1_TAC THENL + [MP_TAC(SPEC `n-1` BOUNDARY) THEN + ASM_SIMP_TAC[ARITH_RULE `3 <= n ==> 1 <= n-1`; + ARITH_RULE `3 <= n ==> (n-1)+1 = n`; + ARITH_RULE `3 <= n ==> (n-1)+5 = n+4`]; + ALL_TAC] THEN + REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* The creative-telescoping recurrence for ww. *) +(* ------------------------------------------------------------------------- *) +let PFLAT_WW = prove + (`!n. pflat ww n = &0`, + GEN_TAC THEN ASM_CASES_TAC `n < 3` THENL + [SUBGOAL_THEN `n = 0 \/ n = 1 \/ n = 2` MP_TAC THENL + [ASM_ARITH_TAC; + DISCH_THEN(REPEAT_TCL DISJ_CASES_THEN SUBST1_TAC)] THEN + REWRITE_TAC[pflat] THEN CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[ww; vv; cc; ss] THEN + REWRITE_TAC[num_CONV `6`; num_CONV `5`; num_CONV `4`; num_CONV `3`; + num_CONV `2`; num_CONV `1`; SUM_CLAUSES_NUMSEG] THEN + CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[num_CONV `6`; num_CONV `5`; num_CONV `4`; num_CONV `3`; + num_CONV `2`; num_CONV `1`; BINOM] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RAT_REDUCE_CONV; + MATCH_MP_TAC PFLAT_WW_GE3 THEN ASM_ARITH_TAC]);; + + +(* Assemble P_flat[bb] = 0 from the aa*zz and ww parts. *) +let PFLAT_BB = prove + (`!n. pflat bb n = &0`, + GEN_TAC THEN + SUBGOAL_THEN `pflat bb n = pflat (\m. aa m * zz m) n + pflat ww n` + SUBST1_TAC THENL + [REWRITE_TAC[pflat; BB_AS_AAZZ_WW] THEN BETA_TAC THEN REAL_ARITH_TAC; + REWRITE_TAC[PFLAT_AAZZ; PFLAT_WW] THEN REAL_ARITH_TAC]);; + +let BB_RECURRENCE = prove + (`!n. (&n + &2) pow 3 * bb(n + 2) - + (&2 * &n + &3) * (&17 * &n pow 2 + &51 * &n + &39) * bb(n + 1) + + (&n + &1) pow 3 * bb(n) = &0`, + REWRITE_TAC[GSYM lop] THEN MATCH_MP_TAC M_KERNEL_TRIVIAL THEN + REWRITE_TAC[LOP_BB_0; LOP_BB_1] THEN + GEN_TAC THEN MP_TAC(SPEC `n:num` PFLAT_BB) THEN + REWRITE_TAC[MOL_FACTOR; ARITH_RULE `(n + 1) + 1 = n + 2`] THEN MESON_TAC[]);; + +(* ========================================================================= *) +(* *** Part 4: asymptotic behaviour of a_n zeta(3) - b_n. *) +(* ========================================================================= *) + +let dd = new_definition + `dd n = aa(n) * bb(n + 1) - aa(n + 1) * bb(n)`;; + +let DD_RECURRENCE = prove + (`!n. (&n + &2) pow 3 * dd(n + 1) = (&n + &1) pow 3 * dd n`, + GEN_TAC THEN REWRITE_TAC[dd] THEN + MP_TAC(SPEC `n:num` AA_RECURRENCE) THEN + MP_TAC(SPEC `n:num` BB_RECURRENCE) THEN + REWRITE_TAC[ARITH_RULE `(n + 1) + 1 = n + 2`] THEN CONV_TAC REAL_RING);; + +let DD_EXPLICIT = prove + (`!n. dd n = &6 / (&n + &1) pow 3`, + INDUCT_TAC THENL + [CONV_TAC REAL_RAT_REDUCE_CONV THEN REWRITE_TAC[REAL_DIV_1]; + MP_TAC(SPEC `n:num` DD_RECURRENCE) THEN + ASM_REWRITE_TAC[ADD1; GSYM REAL_OF_NUM_ADD] THEN CONV_TAC REAL_FIELD] THEN + REWRITE_TAC[dd; bb; aa; cc; zz] THEN + CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[num_CONV `1`; SUM_CLAUSES_NUMSEG] THEN + REWRITE_TAC[BINOM] THEN CONV_TAC NUM_REDUCE_CONV THEN + CONV_TAC REAL_RAT_REDUCE_CONV);; + +(* ------------------------------------------------------------------------- *) +(* First just show a_n is increasing, even before we settle into *) +(* the groove where we almost get a smooth exponential growth. *) +(* ------------------------------------------------------------------------- *) + +let AA_INCREASING = prove + (`!n. aa n < aa(n + 1)`, + GEN_TAC THEN REWRITE_TAC[aa; cc] THEN + SIMP_TAC[SUM_CLAUSES_LEFT; ARITH_RULE `0 <= n + 1`] THEN + REWRITE_TAC[SPEC `1` SUM_OFFSET] THEN + REWRITE_TAC[binom] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + MATCH_MP_TAC(REAL_ARITH `x <= y ==> x < &1 + y`) THEN + MATCH_MP_TAC SUM_LE_NUMSEG THEN X_GEN_TAC `k:num` THEN + STRIP_TAC THEN REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN + SIMP_TAC[REAL_POW_LE; REAL_POS] THEN + REWRITE_TAC[GSYM REAL_LE_SQUARE_ABS; REAL_ABS_NUM] THEN + REWRITE_TAC[GSYM ADD1; binom; GSYM REAL_OF_NUM_ADD; ADD_CLAUSES] THEN + REAL_ARITH_TAC);; + +let AA_MONOTONIC = prove + (`!m n. m <= n ==> aa m <= aa n`, + MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN + SIMP_TAC[AA_INCREASING; ADD1; REAL_LT_IMP_LE] THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Hence show that for large enough n we get exponential lower bound. *) +(* ------------------------------------------------------------------------- *) + +let AA_RECURRENCE_SCALED = prove + (`!n. aa(n + 2) = (&2 * &n + &3) * (&17 * &n pow 2 + &51 * &n + &39) / + (&n + &2) pow 3 * aa(n + 1) - + (&n + &1) pow 3 / (&n + &2) pow 3 * aa n`, + MP_TAC AA_RECURRENCE THEN MATCH_MP_TAC MONO_FORALL THEN + CONV_TAC REAL_FIELD);; + +let APERY_RATIO_COEFF_LIM = prove + (`((\n. (&n + &1) pow 3 / (&n + &2) pow 3) ---> &1) sequentially`, + REWRITE_TAC[GSYM REAL_POW_DIV] THEN + GEN_REWRITE_TAC LAND_CONV [REAL_ARITH `&1 = (&1 - &0) pow 3`] THEN + MATCH_MP_TAC REALLIM_POW THEN + REWRITE_TAC[REAL_FIELD `(&n + &1) / (&n + &2) = &1 - inv(&n + &2)`] THEN + MATCH_MP_TAC REALLIM_SUB THEN + REWRITE_TAC[REALLIM_CONST; REALLIM_1_OVER_N_OFFSET]);; + +let APERY_MAIN_COEFF_LIM = prove + (`((\n. (&2 * &n + &3) * (&17 * &n pow 2 + &51 * &n + &39) / + (&n + &2) pow 3) ---> &34) sequentially`, + SUBST1_TAC(REAL_ARITH `&34 = &34 - &0`) THEN + ONCE_REWRITE_TAC[REAL_FIELD + `(&2 * &n + &3) * (&17 * &n pow 2 + &51 * &n + &39) / (&n + &2) pow 3 = + &34 - (&51 * &n pow 2 + &177 * &n + &155) / (&n + &2) pow 3`] THEN + MATCH_MP_TAC REALLIM_SUB THEN REWRITE_TAC[REALLIM_CONST] THEN + MATCH_MP_TAC REALLIM_NULL_COMPARISON THEN + EXISTS_TAC `\n. &120 * inv(&n)` THEN + SIMP_TAC[REALLIM_NULL_LMUL; REALLIM_1_OVER_N; EVENTUALLY_SEQUENTIALLY] THEN + EXISTS_TAC `1` THEN REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[GSYM real_div; REAL_LE_RDIV_EQ; REAL_OF_NUM_LT; LE_1] THEN + REWRITE_TAC[REAL_ABS_DIV; REAL_ABS_POW; + REAL_ARITH `abs(&n + &2) = &n + &2`] THEN + SIMP_TAC[real_abs; REAL_LE_ADD; REAL_LE_MUL; REAL_POW_LE; REAL_POS] THEN + ONCE_REWRITE_TAC[REAL_ARITH `a / b * c:real = (a * c) / b`] THEN + SIMP_TAC[REAL_LE_LDIV_EQ; REAL_POW_LT; REAL_ARITH `&0 < &n + &2`] THEN + ONCE_REWRITE_TAC[GSYM REAL_SUB_LE] THEN + CONV_TAC(RAND_CONV REAL_POLY_CONV) THEN + REPEAT(MATCH_MP_TAC REAL_LE_ADD THEN CONJ_TAC) THEN + SIMP_TAC[REAL_LE_MUL; REAL_POW_LE; REAL_POS]);; + +let AA_LOWERBOUND = prove + (`?A N. &0 < A /\ !n. N <= n ==> A * &31 pow n <= aa n`, + MP_TAC APERY_MAIN_COEFF_LIM THEN MP_TAC APERY_RATIO_COEFF_LIM THEN + REWRITE_TAC[IMP_IMP; REALLIM_SEQUENTIALLY; AND_FORALL_THM] THEN + DISCH_THEN(MP_TAC o SPEC `&1`) THEN REWRITE_TAC[REAL_LT_01] THEN + DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_THEN `N1:num` (LABEL_TAC "1")) + (X_CHOOSE_THEN `N2:num` (LABEL_TAC "2"))) THEN + MAP_EVERY EXISTS_TAC [`aa(MAX N1 N2 + 2) / &31 pow (MAX N1 N2 + 2)`; + `MAX N1 N2 + 2`] THEN + SIMP_TAC[AA_POS_LT; REAL_LT_DIV; REAL_POW_LT; REAL_OF_NUM_LT; ARITH] THEN + REWRITE_TAC[LE_EXISTS; LEFT_IMP_EXISTS_THM] THEN + ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN REWRITE_TAC[FORALL_UNWIND_THM2] THEN + ABBREV_TAC `N = MAX N1 N2 + 2` THEN + SIMP_TAC[REAL_POW_ADD; REAL_MUL_ASSOC; REAL_DIV_RMUL; + REAL_POW_LT; REAL_OF_NUM_LT; ARITH; REAL_LT_IMP_NZ] THEN + INDUCT_TAC THEN + REWRITE_TAC[real_pow; REAL_MUL_RID; ADD_CLAUSES; REAL_LE_REFL] THEN + MP_TAC(SPEC `(N + d) - 1` AA_RECURRENCE_SCALED) THEN + SUBGOAL_THEN `((N + d) - 1) + 2 = SUC(N + d) /\ ((N + d) - 1) + 1 = N + d` + (fun th -> REWRITE_TAC[th]) + THENL [ASM_ARITH_TAC; DISCH_THEN SUBST1_TAC] THEN + TRANS_TAC REAL_LE_TRANS `&33 * aa(N + d) - &2 * aa((N + d) - 1)` THEN + CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC(REAL_ARITH + `x <= y /\ z <= w ==> x - w:real <= y - z`) THEN + CONJ_TAC THEN SIMP_TAC[REAL_LE_RMUL_EQ; AA_POS_LT; REAL_MUL_ASSOC] THENL + [REMOVE_THEN "2" (MP_TAC o SPEC `(N + d) - 1`); + REMOVE_THEN "1" (MP_TAC o SPEC `(N + d) - 1`)] THEN + (ANTS_TAC THENL [ASM_ARITH_TAC; REAL_ARITH_TAC])] THEN + MATCH_MP_TAC(REAL_ARITH + `x <= &31 * a /\ b < a ==> x <= &33 * a - &2 * b`) THEN + MP_TAC(SPEC `(N + d) - 1` AA_INCREASING) THEN + SUBGOAL_THEN `(N + d) - 1 + 1 = N + d` SUBST1_TAC THENL + [ASM_ARITH_TAC; DISCH_THEN(fun th -> REWRITE_TAC[th])] THEN + GEN_REWRITE_TAC LAND_CONV [REAL_ARITH `a * &31 * b = &31 * a * b`] THEN + ASM_SIMP_TAC[REAL_LE_LMUL; REAL_POS]);; + +let APPROXIMATION_BOUND = prove + (`!n. ZETA(&3) * aa n - bb n <= &6 * ZETA(&3) / aa(n + 1)`, + GEN_TAC THEN MATCH_MP_TAC(ISPEC `sequentially` REALLIM_UBOUND) THEN + EXISTS_TAC + `\m. aa(n) * sum(n..m) (\k. bb(k + 1) / aa(k + 1) - bb(k) / aa(k))` THEN + REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN CONJ_TAC THENL + [REWRITE_TAC[SUM_DIFFS_ALT] THEN + MATCH_MP_TAC REALLIM_TRANSFORM_EVENTUALLY THEN + EXISTS_TAC `\m. bb(m + 1) / aa(m + 1) * aa n - bb n` THEN CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `n:num` THEN + SIMP_TAC[REAL_SUB_LDISTRIB; REAL_DIV_LMUL; AA_NONZERO] THEN + REAL_ARITH_TAC; + MATCH_MP_TAC REALLIM_SUB THEN REWRITE_TAC[REALLIM_CONST] THEN + MATCH_MP_TAC REALLIM_RMUL THEN + MP_TAC BB_OVER_AA_LIM THEN + REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + MESON_TAC[ARITH_RULE `N <= n ==> N <= n + 1`]]; + SIMP_TAC[AA_POS_LT; GSYM dd; DD_EXPLICIT; REAL_FIELD + `&0 < a /\ &0 < a' + ==> b' / a' - b / a = (a * b' - a' * b) / (a * a')`] THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `n:num` THEN + X_GEN_TAC `m:num` THEN DISCH_TAC THEN REWRITE_TAC[GSYM SUM_LMUL] THEN + TRANS_TAC REAL_LE_TRANS + `sum(n..m) (\k. &6 / (&k + &1) pow 3) / aa(n + 1)` THEN + CONJ_TAC THENL + [REWRITE_TAC[real_div; GSYM SUM_RMUL; REAL_INV_MUL] THEN + MATCH_MP_TAC SUM_LE_NUMSEG THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC; REAL_ARITH + `a * &6 * inv k1 * inv ak * inv ak1 <= &6 * inv k1 * inv an1 <=> + (a / ak * inv ak1) / k1 <= (&1 / an1) / k1`] THEN + ASM_SIMP_TAC[REAL_LE_DIV2_EQ; REAL_POW_LT; REAL_ARITH`&0 < &k + &1`] THEN + REWRITE_TAC[real_div] THEN MATCH_MP_TAC REAL_LE_MUL2 THEN + SIMP_TAC[REAL_LE_MUL; REAL_LE_INV_EQ; REAL_LT_IMP_LE; AA_POS_LT] THEN + ASM_SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ; AA_POS_LT] THEN + ASM_SIMP_TAC[REAL_MUL_LID; AA_MONOTONIC] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + ASM_SIMP_TAC[AA_MONOTONIC; AA_POS_LT; LE_ADD_RCANCEL]; + SIMP_TAC[REAL_LE_DIV2_EQ; AA_POS_LT; + REAL_ARITH `&6 * a / b = (&6 * a) / b`] THEN + REWRITE_TAC[real_div; SUM_LMUL] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_POS] THEN + REWRITE_TAC[GSYM(SPEC `1` SUM_OFFSET); REAL_OF_NUM_ADD] THEN + TRANS_TAC REAL_LE_TRANS `real_infsum (from 1) (\n. inv(&n pow 3))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_PARTIAL_SUMS_LE_INFSUM_GEN THEN + SIMP_TAC[FINITE_NUMSEG; SUBSET; IN_NUMSEG; IN_FROM] THEN + SIMP_TAC[REAL_LE_INV_EQ; REAL_POW_LE; REAL_POS] THEN + CONJ_TAC THENL [ARITH_TAC; MATCH_MP_TAC REAL_SUMS_SUMMABLE] THEN + EXISTS_TAC `ZETA(&3)`; + MATCH_MP_TAC REAL_EQ_IMP_LE THEN MATCH_MP_TAC REAL_INFSUM_UNIQUE] THEN + MP_TAC ZZ_LIM THEN + REWRITE_TAC[real_sums; REWRITE_RULE[GSYM FUN_EQ_THM; ETA_AX] zz; + FROM_INTER_NUMSEG; real_div; REAL_MUL_LID]]]);; + +(* ========================================================================= *) +(* *** Part 5: b_n / a_n < zeta(3) *) +(* ========================================================================= *) + +let BB_OVER_AA_INCREASES = prove + (`!n. bb n / aa n < bb (n + 1) / aa (n + 1)`, + GEN_TAC THEN SIMP_TAC[REAL_SUB_LT; AA_POS_LT; REAL_LT_RDIV_EQ] THEN + ONCE_REWRITE_TAC[REAL_ARITH `b / a * c:real = (b * c) / a`] THEN + SIMP_TAC[AA_POS_LT; REAL_LT_LDIV_EQ] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + ONCE_REWRITE_TAC[GSYM REAL_SUB_LT] THEN + REWRITE_TAC[GSYM dd; DD_EXPLICIT] THEN + MATCH_MP_TAC REAL_LT_DIV THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + MATCH_MP_TAC REAL_POW_LT THEN REAL_ARITH_TAC);; + +let BB_OVER_AA_LT_ZETA3 = prove + (`!n. bb n / aa n < ZETA(&3)`, + REWRITE_TAC[GSYM REAL_NOT_LE] THEN REPEAT STRIP_TAC THEN + MP_TAC BB_OVER_AA_LIM THEN REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + DISCH_THEN(MP_TAC o SPEC `bb(n + 1) / aa(n + 1) - bb n / aa n`) THEN + REWRITE_TAC[REAL_SUB_LT; BB_OVER_AA_INCREASES] THEN + DISCH_THEN(X_CHOOSE_THEN `m:num` (MP_TAC o SPEC `MAX m (n + 2)`)) THEN + REWRITE_TAC[ARITH_RULE `m <= MAX m n`] THEN SUBGOAL_THEN + `bb (n + 1) / aa (n + 1) < bb(MAX m (n + 2)) / aa(MAX m (n + 2))` + MP_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN + MP_TAC(ARITH_RULE `n + 1 < MAX m (n + 2)`) THEN + SPEC_TAC(`MAX m (n + 2)`,`r:num`) THEN SPEC_TAC(`n + 1`,`s:num`) THEN + MATCH_MP_TAC TRANSITIVE_STEPWISE_LT THEN REWRITE_TAC[REAL_LT_TRANS] THEN + REWRITE_TAC[ADD1; BB_OVER_AA_INCREASES]);; + +(* ------------------------------------------------------------------------- *) +(* Hence put everything together. *) +(* ------------------------------------------------------------------------- *) + +let IRRATIONAL_ZETA3 = prove + (`~rational(ZETA(&3))`, + STRIP_TAC THEN + SUBGOAL_THEN + `?N. !n. N <= n + ==> integer(&2 * &(LCM(1..n)) pow 3 * (bb n - ZETA(&3) * aa n))` + STRIP_ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [RATIONAL_ALT]) THEN + DISCH_THEN(X_CHOOSE_THEN `p:num` MP_TAC) THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `q:num` THEN STRIP_TAC THEN + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[REAL_SUB_LDISTRIB] THEN + MATCH_MP_TAC INTEGER_SUB THEN REWRITE_TAC[BB_INTEGER] THEN + MATCH_MP_TAC INTEGER_MUL THEN REWRITE_TAC[INTEGER_CLOSED] THEN + REWRITE_TAC[REAL_ARITH `x pow 3 * y * z:real = (x * x * z) * (x * y)`] THEN + MATCH_MP_TAC INTEGER_MUL THEN SIMP_TAC[INTEGER_CLOSED; AA_INTEGER] THEN + ONCE_REWRITE_TAC[GSYM INTEGER_ABS] THEN + ASM_REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NUM] THEN + ONCE_REWRITE_TAC[REAL_ARITH `a * b / c:real = b * a / c`] THEN + MATCH_MP_TAC INTEGER_MUL THEN REWRITE_TAC[INTEGER_CLOSED] THEN + REWRITE_TAC[INTEGER_DIV] THEN + DISJ2_TAC THEN MATCH_MP_TAC DIVIDES_LCM_SET THEN + REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `((\n. &2 * &(LCM(1..n)) pow 3 * (bb n - ZETA(&3) * aa n)) ---> &0) + sequentially` + MP_TAC THENL + [MATCH_MP_TAC REALLIM_NULL_LMUL THEN MP_TAC AA_LOWERBOUND THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`A:real`; `N1:num`] THEN STRIP_TAC THEN + X_CHOOSE_TAC `N2:num` LCM_BOUND_SIMPLE THEN + MATCH_MP_TAC REALLIM_NULL_COMPARISON THEN + EXISTS_TAC `\n. &27 pow n * &6 * ZETA(&3) / (A * &31 pow (n + 1))` THEN + CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[real_div; REAL_INV_MUL; REAL_POW_ADD; REAL_ARITH + `tsn * &6 * z * ia * inv t31 * inv(&31 pow 1) = + (&6 / &31 * z * ia) * tsn / t31`] THEN + MATCH_MP_TAC REALLIM_NULL_LMUL THEN + REWRITE_TAC[GSYM REAL_POW_DIV; GSYM real_div] THEN + MATCH_MP_TAC REALLIM_POWN THEN CONV_TAC REAL_RAT_REDUCE_CONV] THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `MAX N1 N2` THEN + REWRITE_TAC[ARITH_RULE `MAX N1 N2 <= n <=> N1 <= n /\ N2 <= n`] THEN + X_GEN_TAC `n:num` THEN STRIP_TAC THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_POW; REAL_ABS_NUM] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN + SIMP_TAC[REAL_POW_LE; REAL_POS; REAL_ABS_POS] THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_ARITH `&27 = &3 pow 3`; REAL_POW_POW] THEN + ONCE_REWRITE_TAC[MULT_SYM] THEN REWRITE_TAC[GSYM REAL_POW_POW] THEN + MATCH_MP_TAC REAL_POW_LE2 THEN + ASM_SIMP_TAC[REAL_OF_NUM_POW; REAL_OF_NUM_LE; LE_0; LT_IMP_LE]; + ALL_TAC] THEN + TRANS_TAC REAL_LE_TRANS `&6 * ZETA (&3) / aa (n + 1)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC(REAL_ARITH + `a - b <= e /\ b < a ==> abs(b - a) <= e`) THEN + REWRITE_TAC[APPROXIMATION_BOUND] THEN + ASM_SIMP_TAC[GSYM REAL_LT_LDIV_EQ; AA_POS_LT; BB_OVER_AA_LT_ZETA3]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_POS; real_div] THEN + SIMP_TAC[REAL_LE_LMUL_EQ; ZETA3_POS] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + ASM_SIMP_TAC[REAL_LT_MUL; REAL_POW_LT; REAL_ARITH `&0 < &31`] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN DISCH_THEN(MP_TAC o SPEC `&1`) THEN + REWRITE_TAC[REAL_LT_01] THEN DISCH_THEN(X_CHOOSE_TAC `M:num`) THEN + SUBGOAL_THEN + `!n. MAX M N <= n + ==> &2 * &(LCM (1..n)) pow 3 * (bb n - ZETA (&3) * aa n) = &0` + MP_TAC THENL + [REWRITE_TAC[ARITH_RULE `MAX M N <= n <=> M <= n /\ N <= n`] THEN + ASM_MESON_TAC[INTEGER_CLOSED; REAL_EQ_INTEGERS_IMP]; + ALL_TAC] THEN + SIMP_TAC[REAL_ENTIRE; REAL_POW_EQ_0; REAL_OF_NUM_EQ; LCM_NONZERO; ARITH] THEN + REWRITE_TAC[REAL_SUB_0] THEN + SIMP_TAC[AA_POS_LT; REAL_FIELD `&0 < a ==> (b = z * a <=> z = b / a)`] THEN + DISCH_THEN(fun th -> + MP_TAC(SPEC `MAX M N` th) THEN MP_TAC(SPEC `MAX M N + 1` th)) THEN + REWRITE_TAC[LE_REFL; LE_ADD] THEN DISCH_THEN SUBST1_TAC THEN + MATCH_MP_TAC(REAL_ARITH `b:real < a ==> ~(a = b)`) THEN + REWRITE_TAC[BB_OVER_AA_INCREASES]);; diff --git a/Examples/sos.ml b/Examples/sos.ml old mode 100644 new mode 100755 index 532a7a40..db7bc3f8 --- a/Examples/sos.ml +++ b/Examples/sos.ml @@ -10,6 +10,12 @@ exception Sanity;; exception Unsolvable;; +(* CSDP failed for a structural reason (e.g. it rejected the input, as with *) +(* "Constraint k is empty"), as opposed to merely reporting the SDP infeasible. *) +(* This is raised as a non-"Failure" exception so that the iterative deepening *) +(* search does not silently treat it as "no certificate at this degree". *) +exception Csdp_error of int;; + (* ------------------------------------------------------------------------- *) (* Turn a rational into a decimal string with d sig digits. *) (* ------------------------------------------------------------------------- *) @@ -980,7 +986,8 @@ let csdp nblocks blocksizes obj mats = else if rv = 3 then (Format.print_string "csdp warning: Reduced accuracy"; Format.print_newline()) - else if rv <> 0 then failwith("csdp: error "^string_of_int rv) + else if rv >= 4 && rv <= 9 then failwith("csdp: error "^string_of_int rv) + else if rv <> 0 then raise(Csdp_error rv) else ()); res;; @@ -1067,8 +1074,24 @@ let real_positivnullstellensatz_general linf d eqs leqs pol = and obj = length pvs, itern 1 pvs (fun v i -> (i |--> tryapplyd diagents v (num 0))) undefined in + (* Depending on the essentially arbitrary order in which variables were *) + (* eliminated above, a free variable may end up not occurring in any of the *) + (* semidefinite blocks, giving an all-zero constraint matrix. CSDP rejects *) + (* such a problem outright ("Constraint k is empty"). Such a variable is *) + (* wholly unconstrained by the SDP, and (since it occurs in no diagonal *) + (* block entry) has objective coefficient zero, so we can just drop it before *) + (* solving and set it to zero in the result without affecting anything. *) + let solve_filtered obj mats = + let m = length mats - 1 in + let keep = filter (fun k -> not(is_undefined(el k mats))) (1--m) in + if keep = [] then vec_0 m else + let mats' = el 0 mats :: map (fun k -> el k mats) keep + and obj' = length keep, + itern 1 keep (fun k i -> (i |--> element obj k)) undefined in + let subvec = csdp nblocks blocksizes obj' mats' in + (m,itern 1 keep (fun k i -> (k |--> element subvec i)) undefined) in let raw_vec = if pvs = [] then vec_0 0 - else scale_then (csdp nblocks blocksizes) obj mats in + else scale_then solve_filtered obj mats in let find_rounding d = (if !debugging then (Format.print_string("Trying rounding with limit "^string_of_num d); @@ -1118,6 +1141,9 @@ let rec deepen f n = try print_string "Searching with depth limit "; print_int n; print_newline(); f n with Failure _ -> deepen f (n + 1);; +(* Note: this deliberately retries only on "Failure" (which includes SDP *) +(* infeasibility at the current degree); a "Csdp_error" from a structurally *) +(* rejected problem propagates instead of causing an unbounded deepening loop. *) (* ------------------------------------------------------------------------- *) (* The ordering so we can create canonical HOL polynomials. *) diff --git a/Library/fieldtheory.ml b/Library/fieldtheory.ml index 447638bf..0110f827 100644 --- a/Library/fieldtheory.ml +++ b/Library/fieldtheory.ml @@ -1229,6 +1229,13 @@ let FIELD_EXTENSION_TRANS = prove ==> field_extension (k,m) (g o f)`, SIMP_TAC[field_extension] THEN MESON_TAC[RING_MONOMORPHISM_COMPOSE]);; +let FIELD_EXTENSION_TRANS_I = prove + (`!(k:A ring) l m. + field_extension (k,l) I /\ field_extension (l,m) I + ==> field_extension (k,m) I`, + REPEAT GEN_TAC THEN DISCH_THEN(MP_TAC o MATCH_MP FIELD_EXTENSION_TRANS) THEN + REWRITE_TAC[I_O_ID]);; + let FIELD_EXTENSION_ISOMORPHISM = prove (`!(f:A->B) k l. (field k \/ field l) /\ ring_isomorphism (k,l) f @@ -1383,6 +1390,37 @@ let KRONECKER_SIMPLE_FIELD_EXTENSION = prove ASM_SIMP_TAC[POLY_CONST_0; POLY_CLAUSES; RING_SUB_RZERO] THEN EXPAND_TAC "j" THEN ASM_SIMP_TAC[IN_IDEAL_GENERATED_SING]);; +let COPRIME_POLY_NO_COMMON_ROOT = prove + (`!(k:A ring) (l:B ring) (h:A->B) p q. + field_extension(k,l) h /\ ring_coprime(poly_ring k (:1)) (p, q) + ==> ~(?x. x IN ring_carrier l /\ + poly_eval l (h o p) x = ring_0 l /\ + poly_eval l (h o q) x = ring_0 l)`, + REWRITE_TAC[field_extension] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN + DISCH_THEN(X_CHOOSE_THEN `y:B` STRIP_ASSUME_TAC) THEN MP_TAC(ISPECL + [`poly_ring (k:A ring) (:1)`; `l:B ring`; + `(\q. poly_eval l q y) o (\p. (h:A->B) o p)`; + `p:(1->num)->A`; `q:(1->num)->A`] RING_COPRIME_HOMOMORPHIC_IMAGE) THEN + ASM_SIMP_TAC[RING_COPRIME_00; FIELD_IMP_NONTRIVIAL_RING; + PID_POLY_RING; PID_IMP_BEZOUT_RING; o_THM] THEN + MATCH_MP_TAC RING_HOMOMORPHISM_COMPOSE THEN + EXISTS_TAC `poly_ring (l:B ring) (:1)` THEN + ASM_SIMP_TAC[RING_HOMOMORPHISM_POLY_RINGS; RING_HOMOMORPHISM_POLY_EVAL; + RING_MONOMORPHISM_IMP_HOMOMORPHISM]);; + +let COPRIME_POLY_NO_COMMON_ROOT_I = prove + (`!(k:A ring) (E:A ring) p q. + field_extension(k,E) I /\ + ring_coprime(poly_ring k (:1)) (p, q) + ==> ~(?x. x IN ring_carrier E /\ + poly_eval E p x = ring_0 E /\ + poly_eval E q x = ring_0 E)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`k:A ring`; `E:A ring`; `I:A->A`; + `p:(1->num)->A`; `q:(1->num)->A`] + COPRIME_POLY_NO_COMMON_ROOT) THEN + ASM_REWRITE_TAC[I_O_ID] THEN EXISTS_TAC `x:A` THEN ASM_REWRITE_TAC[]);; + (* ------------------------------------------------------------------------- *) (* Linear span of a set of elements s in l with respect to a subfield/ring *) (* k, identified by a monomorphism h from k into l. The definition forces it *) @@ -5668,7 +5706,8 @@ let ALGEBRAICALLY_CLOSED_FIELD_ISOMORPHIC_IMAGE = prove (MATCH_MP RING_ISOMORPHISM_IMP_HOMOMORPHISM th)]));; let ISOMORPHIC_RING_ALGEBRAICALLY_CLOSED_FIELD = prove - (`!(k:A ring) (l:B ring). k isomorphic_ring l + (`!(k:A ring) (l:B ring). + k isomorphic_ring l ==> (algebraically_closed_field k <=> algebraically_closed_field l)`, REWRITE_TAC[isomorphic_ring] THEN REPEAT STRIP_TAC THEN FIRST_ASSUM(X_CHOOSE_TAC `g:B->A` o @@ -5727,7 +5766,8 @@ let ALGEBRAICALLY_CLOSED_FIELD_IMP_INFINITE = prove let ALGEBRAICALLY_CLOSED_FIELD_NO_PROPER_ALGEBRAIC_EXTENSION = prove (`!(k:A ring) (l:B ring) (f:A->B). algebraically_closed_field k /\ algebraic_extension(k,l) f - ==> ring_isomorphism(k,l) f`, REPEAT GEN_TAC THEN + ==> ring_isomorphism(k,l) f`, + REPEAT GEN_TAC THEN REWRITE_TAC[algebraically_closed_field; ALGEBRAIC_EXTENSION_ALT] THEN STRIP_TAC THEN SUBGOAL_THEN `ring_monomorphism(k:A ring,l:B ring) (f:A->B) /\ field(l:B ring) /\ @@ -5959,6 +5999,14 @@ let ALGEBRAICALLY_CLOSED_FIELD_EQ_IRREDUCIBLES = prove ANTS_TAC THENL [ASM_SIMP_TAC[RING_HOMOMORPHISM_POLY_EVAL]; ALL_TAC] THEN BETA_TAC THEN ASM_REWRITE_TAC[RING_DIVIDES_ZERO]]);; +let IRREDUCIBLE_ALGEBRAICALLY_CLOSED_FIELD = prove + (`!(k:A ring) p. + algebraically_closed_field k + ==> (ring_irreducible (poly_ring k (:1)) p <=> + p IN ring_carrier (poly_ring k (:1)) /\ poly_deg k p = 1)`, + MESON_TAC[POLY_DEG_1_IMP_IRREDUCIBLE; RING_IRREDUCIBLE_IN_CARRIER; + ALGEBRAICALLY_CLOSED_FIELD_EQ_IRREDUCIBLES]);; + let ALGEBRAICALLY_CLOSED_FIELD_DECOMPOSE = prove (`!k:A ring. algebraically_closed_field k @@ -5994,7 +6042,88 @@ let ALGEBRAICALLY_CLOSED_FIELD_DECOMPOSE = prove POLY_RING_CLAUSES; IN_ELIM_THM; SUBSET_UNIV] THEN ARITH_TAC);; -let ALGEBRAICALLY_CLOSED_FIELD_EQ_SPLITS = prove +let ALGEBRAICALLY_CLOSED_FIELD_SPLITS = prove + (`!(k:A ring) p. + algebraically_closed_field k /\ + p IN ring_carrier(poly_ring k (:1)) /\ ~(p = poly_0 k) + ==> ?c a. c IN ring_carrier k /\ ~(c = ring_0 k) /\ + (!i. 1 <= i /\ i <= poly_deg k p + ==> a(i) IN ring_carrier k) /\ + p = poly_mul k (poly_const k c) + (ring_product (poly_ring k (:1)) (1..poly_deg k p) + (\i. poly_sub k (poly_var k one) + (poly_const k (a i))))`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + SUBGOAL_THEN `field (k:A ring) /\ integral_domain (k:A ring)` + STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[ALGEBRAICALLY_CLOSED_FIELD_IMP_FIELD; + FIELD_IMP_INTEGRAL_DOMAIN]; + ALL_TAC] THEN + ABBREV_TAC `n = poly_deg k (p:(1->num)->A)` THEN + POP_ASSUM MP_TAC THEN REWRITE_TAC[GSYM IMP_CONJ_ALT; GSYM CONJ_ASSOC] THEN + MAP_EVERY (fun t -> SPEC_TAC(t,t)) [`p:(1->num)->A`; `n:num`] THEN + INDUCT_TAC THEN X_GEN_TAC `p:(1->num)->A` THEN STRIP_TAC THENL + [UNDISCH_TAC `poly_deg k (p:(1->num)->A) = 0` THEN + ASM_SIMP_TAC[POLY_DEG_EQ_0; RING_POLYNOMIAL] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `c:A` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC) THEN + REWRITE_TAC[RING_PRODUCT_CLAUSES_NUMSEG; ARITH_EQ] THEN + ASM_REWRITE_TAC[POLY_CONST_1; POLY_RING] THEN + REWRITE_TAC[ARITH_RULE `~(1 <= i /\ i <= 0)`] THEN + ASM_SIMP_TAC[POLY_MUL_RID; RING_POWERSERIES_CONST] THEN + ASM_MESON_TAC[POLY_CONST_EQ_0]; + ALL_TAC] THEN + MP_TAC(SPEC `k:A ring` ALGEBRAICALLY_CLOSED_FIELD_DECOMPOSE) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `p:(1->num)->A`) THEN + ASM_REWRITE_TAC[ARITH_RULE `~(SUC n = 0)`] THEN + DISCH_THEN(X_CHOOSE_THEN `a0:A` + (X_CHOOSE_THEN `q:(1->num)->A` STRIP_ASSUME_TAC)) THEN + SUBGOAL_THEN `poly_deg (k:A ring) (q:(1->num)->A) = n` ASSUME_TAC THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `poly_sub (k:A ring) (poly_var k one) (poly_const k (a0:A)) + IN ring_carrier(poly_ring k (:1))` ASSUME_TAC THENL + [MATCH_MP_TAC POLY_X_MINUS_A_IN_CARRIER THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `q:(1->num)->A`) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [ASM_MESON_TAC[POLY_MUL_0; RING_POLYNOMIAL_SUB; RING_POLYNOMIAL_CONST; + RING_POLYNOMIAL_VAR]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `c':A` + (X_CHOOSE_THEN `a':num->A` STRIP_ASSUME_TAC)) THEN + EXISTS_TAC `c':A` THEN + EXISTS_TAC + `\i:num. if i = SUC n then (a0:A) else (a':num->A) i` THEN + ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [X_GEN_TAC `i:num` THEN STRIP_TAC THEN + COND_CASES_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `ring_product (poly_ring (k:A ring) (:1)) (1..SUC n) + (\i. poly_sub k (poly_var k one) + (poly_const k (if i = SUC n then a0 else (a':num->A) i))) + :(1->num)->A = poly_mul k + (poly_sub k (poly_var k one) (poly_const k (a0:A))) + (ring_product (poly_ring k (:1)) (1..n) + (\i. poly_sub k (poly_var k one) (poly_const k (a' i))))` + SUBST1_TAC THENL + [REWRITE_TAC[RING_PRODUCT_CLAUSES_NUMSEG_ALT; + ARITH_RULE `1 <= SUC n`] THEN + ASM_REWRITE_TAC[ARITH_RULE `~(SUC n <= n)`] THEN + REWRITE_TAC[POLY_RING_CLAUSES] THEN AP_TERM_TAC THEN + MATCH_MP_TAC RING_PRODUCT_EQ THEN REWRITE_TAC[IN_NUMSEG] THEN + X_GEN_TAC `j:num` THEN STRIP_TAC THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `poly_mul (k:A ring) = ring_mul + (poly_ring k (:1))` SUBST1_TAC THENL + [REWRITE_TAC[POLY_RING_CLAUSES]; ALL_TAC] THEN + ASM_SIMP_TAC[RING_MUL_ASSOC; POLY_CONST; RING_PRODUCT] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC RING_MUL_SYM THEN + ASM_REWRITE_TAC[POLY_CONST; RING_PRODUCT]);; + +let ALGEBRAICALLY_CLOSED_FIELD_EQ_SPLITS_ALT = prove (`!k:A ring. algebraically_closed_field k <=> field k /\ @@ -6006,149 +6135,89 @@ let ALGEBRAICALLY_CLOSED_FIELD_EQ_SPLITS = prove (ring_product (poly_ring k (:1)) (1..poly_deg k p) (\i. poly_sub k (poly_var k one) (poly_const k (a i))))`, - GEN_TAC THEN EQ_TAC THENL [(* Forward: ACF ==> splits *) - DISCH_TAC THEN - SUBGOAL_THEN `field (k:A ring) /\ integral_domain (k:A ring)` - STRIP_ASSUME_TAC THENL - [ASM_MESON_TAC[ALGEBRAICALLY_CLOSED_FIELD_IMP_FIELD; - FIELD_IMP_INTEGRAL_DOMAIN]; ALL_TAC] THEN - ASM_REWRITE_TAC[] THEN - SUBGOAL_THEN `!n (p:(1->num)->A). - p IN ring_carrier(poly_ring k (:1)) /\ poly_deg k p = n /\ ~(n = 0) - ==> ?c a. c IN ring_carrier k /\ ~(c = ring_0 k) /\ - (!i. 1 <= i /\ i <= n ==> a(i) IN ring_carrier k) /\ - p = poly_mul k (poly_const k c) - (ring_product (poly_ring k (:1)) (1..n) - (\i. poly_sub k (poly_var k one) - (poly_const k (a i))))` - (fun th -> X_GEN_TAC `p:(1->num)->A` THEN STRIP_TAC THEN - MP_TAC(SPECL [`poly_deg (k:A ring) (p:(1->num)->A)`; - `p:(1->num)->A`] th) THEN - ASM_REWRITE_TAC[]) THEN - INDUCT_TAC THENL [REWRITE_TAC[]; ALL_TAC] THEN - X_GEN_TAC `p:(1->num)->A` THEN STRIP_TAC THEN - MP_TAC(SPEC `k:A ring` ALGEBRAICALLY_CLOSED_FIELD_DECOMPOSE) THEN - ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `p:(1->num)->A`) THEN - ASM_REWRITE_TAC[ARITH_RULE `~(SUC n = 0)`] THEN - DISCH_THEN(X_CHOOSE_THEN `a0:A` - (X_CHOOSE_THEN `q:(1->num)->A` STRIP_ASSUME_TAC)) THEN - SUBGOAL_THEN `poly_deg (k:A ring) (q:(1->num)->A) = n` ASSUME_TAC THENL - [ASM_ARITH_TAC; ALL_TAC] THEN - SUBGOAL_THEN - `poly_sub (k:A ring) (poly_var k one) (poly_const k (a0:A)) - IN ring_carrier(poly_ring k (:1))` ASSUME_TAC THENL - [MATCH_MP_TAC POLY_X_MINUS_A_IN_CARRIER THEN ASM_REWRITE_TAC[]; - ALL_TAC] THEN - ASM_CASES_TAC `n = 0` THENL - [MP_TAC(ISPECL [`k:A ring`; `q:(1->num)->A`] POLY_DEG_EQ_0) THEN - ASM_REWRITE_TAC[RING_POLYNOMIAL] THEN - DISCH_THEN(X_CHOOSE_THEN `c:A` STRIP_ASSUME_TAC) THEN - EXISTS_TAC `c:A` THEN EXISTS_TAC `\i:num. a0:A` THEN - ASM_REWRITE_TAC[] THEN CONJ_TAC THENL - [DISCH_TAC THEN - SUBGOAL_THEN `(p:(1->num)->A) = poly_0 (k:A ring)` MP_TAC THENL - [ASM_REWRITE_TAC[POLY_CLAUSES; POLY_CONST_0] THEN - MATCH_MP_TAC RING_MUL_RZERO THEN MATCH_MP_TAC RING_SUB THEN - REWRITE_TAC[GSYM RING_POLYNOMIAL] THEN - ASM_SIMP_TAC[RING_POLYNOMIAL_VAR; RING_POLYNOMIAL_CONST]; - DISCH_THEN SUBST_ALL_TAC THEN - RULE_ASSUM_TAC(REWRITE_RULE[POLY_DEG_0]) THEN ASM_ARITH_TAC]; - CONV_TAC NUM_REDUCE_CONV THEN - REWRITE_TAC[NUMSEG_SING; RING_PRODUCT_SING] THEN - ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `poly_mul (k:A ring) = ring_mul - (poly_ring k (:1))` SUBST1_TAC THENL - [REWRITE_TAC[POLY_RING_CLAUSES]; ALL_TAC] THEN - MATCH_MP_TAC RING_MUL_SYM THEN ASM_REWRITE_TAC[POLY_CONST]]; - ALL_TAC] THEN - FIRST_X_ASSUM(MP_TAC o SPEC `q:(1->num)->A`) THEN - ASM_REWRITE_TAC[] THEN - DISCH_THEN(X_CHOOSE_THEN `c':A` - (X_CHOOSE_THEN `a':num->A` STRIP_ASSUME_TAC)) THEN - EXISTS_TAC `c':A` THEN - EXISTS_TAC - `\i:num. if i = SUC n then (a0:A) else (a':num->A) i` THEN - ASM_REWRITE_TAC[] THEN - CONJ_TAC THENL - [X_GEN_TAC `i:num` THEN STRIP_TAC THEN - COND_CASES_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN - FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; ALL_TAC] THEN - SUBGOAL_THEN `ring_product (poly_ring (k:A ring) (:1)) (1..SUC n) - (\i. poly_sub k (poly_var k one) - (poly_const k (if i = SUC n then a0 else (a':num->A) i))) - :(1->num)->A = poly_mul k - (poly_sub k (poly_var k one) (poly_const k (a0:A))) - (ring_product (poly_ring k (:1)) (1..n) - (\i. poly_sub k (poly_var k one) (poly_const k (a' i))))` - SUBST1_TAC THENL - [REWRITE_TAC[RING_PRODUCT_CLAUSES_NUMSEG_ALT; - ARITH_RULE `1 <= SUC n`] THEN - ASM_REWRITE_TAC[ARITH_RULE `~(SUC n <= n)`] THEN - REWRITE_TAC[POLY_RING_CLAUSES] THEN AP_TERM_TAC THEN - MATCH_MP_TAC RING_PRODUCT_EQ THEN REWRITE_TAC[IN_NUMSEG] THEN - X_GEN_TAC `j:num` THEN STRIP_TAC THEN - COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; - ALL_TAC] THEN - ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `poly_mul (k:A ring) = ring_mul - (poly_ring k (:1))` SUBST1_TAC THENL - [REWRITE_TAC[POLY_RING_CLAUSES]; ALL_TAC] THEN - ASM_SIMP_TAC[RING_MUL_ASSOC; POLY_CONST; RING_PRODUCT] THEN - AP_THM_TAC THEN AP_TERM_TAC THEN MATCH_MP_TAC RING_MUL_SYM THEN - ASM_REWRITE_TAC[POLY_CONST; RING_PRODUCT]; - STRIP_TAC THEN ASM_REWRITE_TAC[algebraically_closed_field] THEN - X_GEN_TAC `p:(1->num)->A` THEN STRIP_TAC THEN - FIRST_X_ASSUM(MP_TAC o SPEC `p:(1->num)->A`) THEN ASM_REWRITE_TAC[] THEN - DISCH_THEN(X_CHOOSE_THEN `c:A` - (X_CHOOSE_THEN `a:num->A` STRIP_ASSUME_TAC)) THEN - SUBGOAL_THEN `integral_domain (k:A ring)` ASSUME_TAC THENL - [ASM_SIMP_TAC[FIELD_IMP_INTEGRAL_DOMAIN]; ALL_TAC] THEN - SUBGOAL_THEN `1 <= poly_deg (k:A ring) (p:(1->num)->A)` ASSUME_TAC THENL - [ASM_ARITH_TAC; ALL_TAC] THEN - SUBGOAL_THEN `(a:num->A) 1 IN ring_carrier k` ASSUME_TAC THENL - [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[LE_REFL]; ALL_TAC] THEN - EXISTS_TAC `(a:num->A) 1` THEN ASM_REWRITE_TAC[] THEN ABBREV_TAC - `Q = ring_product (poly_ring (k:A ring) (:1)) - (1..poly_deg k (p:(1->num)->A)) (\i. poly_sub k (poly_var k - one) - (poly_const k ((a:num->A) i)))` THEN - SUBGOAL_THEN `ring_polynomial (k:A ring) (Q:(1->num)->A)` ASSUME_TAC THENL - [EXPAND_TAC "Q" THEN REWRITE_TAC[RING_POLYNOMIAL; RING_PRODUCT]; - ALL_TAC] THEN - ASM_SIMP_TAC[POLY_EVAL_MUL; RING_POLYNOMIAL_CONST; POLY_EVAL_CONST] THEN - (* Goal: ring_mul k c (poly_eval k Q (a 1)) = ring_0 k *) SUBGOAL_THEN - `poly_eval (k:A ring) (Q:(1->num)->A) ((a:num->A) 1) = ring_0 k` - SUBST1_TAC THENL [(* Step 1: Expand Q and apply POLY_EVAL_RING_PRODUCT *) - EXPAND_TAC "Q" THEN SUBGOAL_THEN `poly_eval (k:A ring) - (ring_product (poly_ring k (:1)) (1..poly_deg k (p:(1->num)->A)) - (\i. poly_sub k (poly_var k one) - (poly_const k ((a:num->A) i)))) ((a:num->A) 1) = - ring_product k (1..poly_deg k p) (\i. poly_eval k - (poly_sub k (poly_var k one) (poly_const k (a i))) - (a 1))` SUBST1_TAC THENL [MATCH_MP_TAC POLY_EVAL_RING_PRODUCT THEN - ASM_REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN - REPEAT STRIP_TAC THEN MATCH_MP_TAC POLY_X_MINUS_A_IN_CARRIER THEN - FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN - SUBGOAL_THEN `ring_product (k:A ring) (1..poly_deg k (p:(1->num)->A)) - (\i. poly_eval k (poly_sub k (poly_var k one) - (poly_const k ((a:num->A) i))) ((a:num->A) 1)) = - ring_product k (1..poly_deg k p) - (\i. ring_sub k (a 1) (a i))` SUBST1_TAC THENL - [MATCH_MP_TAC RING_PRODUCT_EQ THEN - REWRITE_TAC[IN_NUMSEG] THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN - BETA_TAC THEN - SUBGOAL_THEN `(a:num->A) j IN ring_carrier k` ASSUME_TAC THENL - [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN - ASM_SIMP_TAC[POLY_EVAL_SUB; RING_POLYNOMIAL_VAR; RING_POLYNOMIAL_CONST; - POLY_EVAL_VAR; POLY_EVAL_CONST]; ALL_TAC] THEN - MP_TAC(SPEC `\i:num. ring_sub (k:A ring) ((a:num->A) 1) (a i)` - (MATCH_MP (REWRITE_RULE[FINITE_NUMSEG] (ISPECL [`k:A ring`; - `1..poly_deg (k:A ring) (p:(1->num)->A)`] - INTEGRAL_DOMAIN_PRODUCT_EQ_0)) - (ASSUME `integral_domain (k:A ring)`))) THEN - DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN - EXISTS_TAC `1` THEN REWRITE_TAC[IN_NUMSEG; LE_REFL] THEN - BETA_TAC THEN ASM_SIMP_TAC[RING_SUB_REFL] THEN ASM_REWRITE_TAC[]; - (* ring_mul k c (ring_0 k) = ring_0 k *) - ASM_SIMP_TAC[RING_MUL_RZERO]]]);; + GEN_TAC THEN EQ_TAC THENL + [DISCH_TAC THEN CONJ_TAC THENL + [ASM_MESON_TAC[ALGEBRAICALLY_CLOSED_FIELD_IMP_FIELD]; ALL_TAC] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC ALGEBRAICALLY_CLOSED_FIELD_SPLITS THEN + ASM_MESON_TAC[POLY_DEG_0]; + ALL_TAC] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[algebraically_closed_field] THEN + X_GEN_TAC `p:(1->num)->A` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `p:(1->num)->A`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `c:A` + (X_CHOOSE_THEN `a:num->A` STRIP_ASSUME_TAC)) THEN + SUBGOAL_THEN `integral_domain (k:A ring)` ASSUME_TAC THENL + [ASM_SIMP_TAC[FIELD_IMP_INTEGRAL_DOMAIN]; ALL_TAC] THEN + SUBGOAL_THEN `1 <= poly_deg (k:A ring) (p:(1->num)->A)` ASSUME_TAC THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `(a:num->A) 1 IN ring_carrier k` ASSUME_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[LE_REFL]; ALL_TAC] THEN + EXISTS_TAC `(a:num->A) 1` THEN ASM_REWRITE_TAC[] THEN ABBREV_TAC + `Q = ring_product (poly_ring (k:A ring) (:1)) + (1..poly_deg k (p:(1->num)->A)) (\i. poly_sub k (poly_var k + one) + (poly_const k ((a:num->A) i)))` THEN + SUBGOAL_THEN `ring_polynomial (k:A ring) (Q:(1->num)->A)` ASSUME_TAC THENL + [EXPAND_TAC "Q" THEN REWRITE_TAC[RING_POLYNOMIAL; RING_PRODUCT]; + ALL_TAC] THEN + ASM_SIMP_TAC[POLY_EVAL_MUL; RING_POLYNOMIAL_CONST; POLY_EVAL_CONST] THEN + (* Goal: ring_mul k c (poly_eval k Q (a 1)) = ring_0 k *) + SUBGOAL_THEN + `poly_eval (k:A ring) (Q:(1->num)->A) ((a:num->A) 1) = ring_0 k` + SUBST1_TAC THENL + [(* Step 1: Expand Q and apply POLY_EVAL_RING_PRODUCT *) + EXPAND_TAC "Q" THEN SUBGOAL_THEN `poly_eval (k:A ring) + (ring_product (poly_ring k (:1)) (1..poly_deg k (p:(1->num)->A)) + (\i. poly_sub k (poly_var k one) + (poly_const k ((a:num->A) i)))) ((a:num->A) 1) = + ring_product k (1..poly_deg k p) (\i. poly_eval k + (poly_sub k (poly_var k one) (poly_const k (a i))) + (a 1))` SUBST1_TAC THENL [MATCH_MP_TAC POLY_EVAL_RING_PRODUCT THEN + ASM_REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC POLY_X_MINUS_A_IN_CARRIER THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `ring_product (k:A ring) (1..poly_deg k (p:(1->num)->A)) + (\i. poly_eval k (poly_sub k (poly_var k one) + (poly_const k ((a:num->A) i))) ((a:num->A) 1)) = + ring_product k (1..poly_deg k p) + (\i. ring_sub k (a 1) (a i))` SUBST1_TAC THENL + [MATCH_MP_TAC RING_PRODUCT_EQ THEN + REWRITE_TAC[IN_NUMSEG] THEN X_GEN_TAC `j:num` THEN STRIP_TAC THEN + BETA_TAC THEN + SUBGOAL_THEN `(a:num->A) j IN ring_carrier k` ASSUME_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_SIMP_TAC[POLY_EVAL_SUB; RING_POLYNOMIAL_VAR; RING_POLYNOMIAL_CONST; + POLY_EVAL_VAR; POLY_EVAL_CONST]; ALL_TAC] THEN + MP_TAC(SPEC `\i:num. ring_sub (k:A ring) ((a:num->A) 1) (a i)` + (MATCH_MP (REWRITE_RULE[FINITE_NUMSEG] (ISPECL [`k:A ring`; + `1..poly_deg (k:A ring) (p:(1->num)->A)`] + INTEGRAL_DOMAIN_PRODUCT_EQ_0)) + (ASSUME `integral_domain (k:A ring)`))) THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN + EXISTS_TAC `1` THEN REWRITE_TAC[IN_NUMSEG; LE_REFL] THEN + BETA_TAC THEN ASM_SIMP_TAC[RING_SUB_REFL] THEN ASM_REWRITE_TAC[]; + (* ring_mul k c (ring_0 k) = ring_0 k *) + ASM_SIMP_TAC[RING_MUL_RZERO]]);; + +let ALGEBRAICALLY_CLOSED_FIELD_EQ_SPLITS = prove + (`!k:A ring. + algebraically_closed_field k <=> + field k /\ + !p. p IN ring_carrier(poly_ring k (:1)) /\ ~(p = poly_0 k) + ==> ?c a. c IN ring_carrier k /\ ~(c = ring_0 k) /\ + (!i. 1 <= i /\ i <= poly_deg k p + ==> a(i) IN ring_carrier k) /\ + p = poly_mul k (poly_const k c) + (ring_product (poly_ring k (:1)) (1..poly_deg k p) + (\i. poly_sub k (poly_var k one) + (poly_const k (a i))))`, + GEN_TAC THEN EQ_TAC THENL + [DISCH_TAC THEN CONJ_TAC THENL + [ASM_MESON_TAC[ALGEBRAICALLY_CLOSED_FIELD_IMP_FIELD]; ALL_TAC] THEN + ASM_SIMP_TAC[ALGEBRAICALLY_CLOSED_FIELD_SPLITS]; + REWRITE_TAC[ALGEBRAICALLY_CLOSED_FIELD_EQ_SPLITS_ALT] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[POLY_DEG_0]]);; let SIMPLE_ALGEBRAIC_EXTEND_HOMOMORPHISM = prove (`!(k:A ring) (l:B ring) (l':C ring) (f:A->B) (g:A->C) a. @@ -6694,6 +6763,140 @@ let ALGEBRAIC_CLOSURE_EXTEND_HOMOMORPHISM = prove EXISTS_TAC `\x:B. @y:C. (x,y) IN (G:(B#C)->bool)` THEN ASM_MESON_TAC[SUBRING_GENERATED_RING_CARRIER]]);; +let POLY_SQUAREFREE_ROOT_COUNT_EXPLICIT = prove + (`!(k:A ring) p. + algebraically_closed_field k /\ + p IN ring_carrier(poly_ring k (:1)) /\ + ~(p = ring_0(poly_ring k (:1))) /\ + (!a. a IN ring_carrier k /\ poly_eval k p a = ring_0 k + ==> ~(ring_divides (poly_ring k (:1)) + (poly_pow k (poly_sub k (poly_var k one) (poly_const k a)) 2) + p)) + ==> CARD {x | x IN ring_carrier k /\ poly_eval k p x = ring_0 k} = + poly_deg k p`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`k:A ring`; `p:(1->num)->A`] + ALGEBRAICALLY_CLOSED_FIELD_SPLITS) THEN + ASM_REWRITE_TAC[GSYM IN_NUMSEG] THEN ANTS_TAC THENL + [ASM_MESON_TAC[POLY_RING]; REWRITE_TAC[LEFT_IMP_EXISTS_THM]] THEN + MAP_EVERY X_GEN_TAC [`c:A`; `a:num->A`] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(ASSUME_TAC o SYM) THEN + ABBREV_TAC `n = poly_deg k (p:(1->num)->A)` THEN + SUBGOAL_THEN + `{x:A | x IN ring_carrier k /\ poly_eval k p x = ring_0 k} = + IMAGE a (1..n)` + ASSUME_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `x:A` THEN + ASM_CASES_TAC `(x:A) IN ring_carrier k` THENL + [ASM_REWRITE_TAC[]; ASM SET_TAC[]] THEN + FIRST_X_ASSUM(MP_TAC o AP_TERM `\p:(1->num)->A. poly_eval k p x`) THEN + REWRITE_TAC[] THEN + W(MP_TAC o PART_MATCH (lhand o rand) POLY_EVAL_MUL o + lhand o lhand o snd) THEN + ASM_REWRITE_TAC[RING_POLYNOMIAL_CONST] THEN + REWRITE_TAC[RING_POLYNOMIAL; RING_PRODUCT] THEN + DISCH_THEN SUBST1_TAC THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + W(MP_TAC o PART_MATCH (lhand o rand) POLY_EVAL_RING_PRODUCT o + rand o lhand o lhand o snd) THEN + ASM_REWRITE_TAC[FINITE_NUMSEG; GSYM RING_POLYNOMIAL] THEN + ASM_SIMP_TAC[POLY_EVAL_CONST; POLY_EVAL_SUB; POLY_EVAL_VAR; + POLY_EVAL_CONST; RING_POLYNOMIAL_CONST; + RING_POLYNOMIAL_SUB; RING_POLYNOMIAL_VAR] THEN + DISCH_THEN SUBST1_TAC THEN + ASM_SIMP_TAC[INTEGRAL_DOMAIN_MUL_EQ_0; RING_PRODUCT; FINITE_NUMSEG; + INTEGRAL_DOMAIN_PRODUCT_EQ_0; FIELD_IMP_INTEGRAL_DOMAIN; + ALGEBRAICALLY_CLOSED_FIELD_IMP_FIELD] THEN + ASM SET_TAC[RING_SUB_EQ_0]; + ASM_REWRITE_TAC[]] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM CARD_NUMSEG_1] THEN + MATCH_MP_TAC CARD_IMAGE_INJ THEN REWRITE_TAC[FINITE_NUMSEG] THEN + MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN + ABBREV_TAC `b = (a:num->A) j` THEN STRIP_TAC THEN + ASM_CASES_TAC `i:num = j` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `(b:A) IN ring_carrier k` ASSUME_TAC THENL + [ASM SET_TAC[]; FIRST_X_ASSUM(MP_TAC o SPEC `b:A`)] THEN + ANTS_TAC THENL [ASM SET_TAC[]; EXPAND_TAC "p" THEN REWRITE_TAC[]] THEN + SUBGOAL_THEN `1..n = i INSERT j INSERT ((1..n) DIFF {i,j})` SUBST1_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + ASM_SIMP_TAC[RING_PRODUCT_CLAUSES; FINITE_NUMSEG; FINITE_DIFF; FINITE_INSERT; + IN_INSERT; IN_DIFF; NOT_IN_EMPTY] THEN + ASM_SIMP_TAC[POLY_CLAUSES; RING_SUB; POLY_CONST; POLY_VAR_UNIV; + RING_POW_2] THEN + MATCH_MP_TAC RING_DIVIDES_LMUL THEN ASM_REWRITE_TAC[POLY_CONST] THEN + MATCH_MP_TAC RING_DIVIDES_LMUL2 THEN + ASM_SIMP_TAC[RING_SUB; POLY_CONST; POLY_VAR_UNIV] THEN + MATCH_MP_TAC RING_DIVIDES_RMUL THEN + REWRITE_TAC[RING_PRODUCT; RING_DIVIDES_REFL] THEN + ASM_SIMP_TAC[RING_SUB; POLY_CONST; POLY_VAR_UNIV]);; + +let POLY_SQUAREFREE_ROOT_COUNT = prove + (`!(k:A ring) p. + algebraically_closed_field k /\ + ring_squarefree (poly_ring k (:1)) p + ==> CARD {x | x IN ring_carrier k /\ poly_eval k p x = ring_0 k} = + poly_deg k p`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC POLY_SQUAREFREE_ROOT_COUNT_EXPLICIT THEN + ASM_SIMP_TAC[RING_SQUAREFREE_IN_CARRIER; RING_SQUAREFREE_IMP_NONZERO; + FIELD_IMP_NONTRIVIAL_RING; ALGEBRAICALLY_CLOSED_FIELD_IMP_FIELD; + TRIVIAL_POLY_RING] THEN + X_GEN_TAC `a:A` THEN STRIP_TAC THEN DISCH_TAC THEN + FIRST_X_ASSUM(CONJUNCTS_THEN2 ASSUME_TAC + (MP_TAC o SPEC `poly_sub k (poly_var k one) (poly_const k (a:A))`) o + REWRITE_RULE[ring_squarefree]) THEN + ASM_REWRITE_TAC[CONJUNCT2 POLY_RING_CLAUSES; NOT_IMP] THEN + ASM_SIMP_TAC[POLY_CLAUSES; RING_SUB; POLY_CONST; POLY_VAR_UNIV] THEN + DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] + POLY_DEG_UNIT)) THEN + ASM_SIMP_TAC[ALGEBRAICALLY_CLOSED_FIELD_IMP_FIELD; FIELD_IMP_INTEGRAL_DOMAIN; + FIELD_IMP_NONTRIVIAL_RING; ARITH_EQ; + CONJUNCT2 POLY_RING_CLAUSES; POLY_DEG_X_MINUS_A]);; + +let POLY_SQUAREFREE_ROOT_COUNT_EQ = prove + (`!(k:A ring) p. + algebraically_closed_field k + ==> (ring_squarefree (poly_ring k (:1)) p <=> + p IN ring_carrier (poly_ring k (:1)) /\ + ~(p = ring_0 (poly_ring k (:1))) /\ + CARD {x | x IN ring_carrier k /\ poly_eval k p x = ring_0 k} = + poly_deg k p)`, + REPEAT STRIP_TAC THEN EQ_TAC THENL + [ASM_SIMP_TAC[POLY_SQUAREFREE_ROOT_COUNT; RING_SQUAREFREE_IN_CARRIER; + RING_SQUAREFREE_IMP_NONZERO; FIELD_IMP_NONTRIVIAL_RING; + ALGEBRAICALLY_CLOSED_FIELD_IMP_FIELD; TRIVIAL_POLY_RING]; + ASM_SIMP_TAC[POLY_ROOT_COUNT_IMP_SQUAREFREE; + ALGEBRAICALLY_CLOSED_FIELD_IMP_FIELD]]);; + +let POLY_SQUAREFREE_EXPLICIT_EQ = prove + (`!(k:A ring) p. + algebraically_closed_field k + ==> (ring_squarefree (poly_ring k (:1)) p <=> + p IN ring_carrier (poly_ring k (:1)) /\ + ~(p = ring_0 (poly_ring k (:1))) /\ + (!a. a IN ring_carrier k /\ poly_eval k p a = ring_0 k + ==> ~(ring_divides (poly_ring k (:1)) + (poly_pow k (poly_sub k (poly_var k one) (poly_const k a)) 2) + p)))`, + REPEAT STRIP_TAC THEN EQ_TAC THENL + [DISCH_TAC THEN + ASM_SIMP_TAC[RING_SQUAREFREE_IN_CARRIER; RING_SQUAREFREE_IMP_NONZERO; + FIELD_IMP_NONTRIVIAL_RING; TRIVIAL_POLY_RING; + ALGEBRAICALLY_CLOSED_FIELD_IMP_FIELD] THEN + X_GEN_TAC `a:A` THEN STRIP_TAC THEN DISCH_TAC THEN + FIRST_X_ASSUM(CONJUNCTS_THEN2 ASSUME_TAC + (MP_TAC o SPEC `poly_sub k (poly_var k one) (poly_const k (a:A))`) o + REWRITE_RULE[ring_squarefree]) THEN + ASM_REWRITE_TAC[CONJUNCT2 POLY_RING_CLAUSES; NOT_IMP] THEN + ASM_SIMP_TAC[POLY_CLAUSES; RING_SUB; POLY_CONST; POLY_VAR_UNIV] THEN + DISCH_THEN(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] + POLY_DEG_UNIT)) THEN + ASM_SIMP_TAC[ALGEBRAICALLY_CLOSED_FIELD_IMP_FIELD; POLY_DEG_X_MINUS_A; + FIELD_IMP_INTEGRAL_DOMAIN; FIELD_IMP_NONTRIVIAL_RING; ARITH_EQ; + CONJUNCT2 POLY_RING_CLAUSES]; + STRIP_TAC THEN MATCH_MP_TAC POLY_ROOT_COUNT_IMP_SQUAREFREE THEN + ASM_SIMP_TAC[ALGEBRAICALLY_CLOSED_FIELD_IMP_FIELD] THEN + MATCH_MP_TAC POLY_SQUAREFREE_ROOT_COUNT_EXPLICIT THEN ASM_REWRITE_TAC[]]);; + let ALGEBRAIC_CLOSURE_EXISTS_ID = prove (`!k:A ring. ring_carrier k <_c (:A) /\ (:num) <_c (:A) /\ field k diff --git a/Library/grouptheory.ml b/Library/grouptheory.ml index 56999756..995734cd 100644 --- a/Library/grouptheory.ml +++ b/Library/grouptheory.ml @@ -15672,14 +15672,13 @@ let SOLVABLE_GROUP_ALT = prove (* We formalize this as: commutators land in the normal subgroup. *) let ABELIAN_QUOTIENT_COMMUTATOR = prove - (`!G (n:A->bool). + (`!G (n:A->bool) x y. n normal_subgroup_of G /\ - abelian_group(quotient_group G n) - ==> !x y. x IN group_carrier G /\ y IN group_carrier G - ==> group_mul G (group_inv G x) - (group_mul G (group_inv G y) - (group_mul G x y)) IN n`, - REPEAT GEN_TAC THEN STRIP_TAC THEN + abelian_group(quotient_group G n) /\ + x IN group_carrier G /\ y IN group_carrier G + ==> group_mul G (group_inv G x) + (group_mul G (group_inv G y) + (group_mul G x y)) IN n`, REPEAT GEN_TAC THEN STRIP_TAC THEN SUBGOAL_THEN `(n:A->bool) subgroup_of G` ASSUME_TAC THENL [ASM_MESON_TAC[normal_subgroup_of]; ALL_TAC] THEN @@ -16020,6 +16019,24 @@ let COMMUTATOR_IMP_ABELIAN_QUOTIENT = prove FIRST_X_ASSUM(MP_TAC o SPECL [`group_inv G (x:A)`; `group_inv G (y:A)`]) THEN ASM_SIMP_TAC[GROUP_INV; GROUP_INV_INV]);; +let ABELIAN_QUOTIENT_GROUP_DIV = prove + (`!G (n:A->bool). + n normal_subgroup_of G /\ + (!x y. x IN group_carrier G /\ y IN group_carrier G + ==> group_div G (group_mul G x y) (group_mul G y x) IN n) + ==> abelian_group(quotient_group G n)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `(n:A->bool) subgroup_of G` ASSUME_TAC THENL + [ASM_MESON_TAC[normal_subgroup_of]; ALL_TAC] THEN + REWRITE_TAC[abelian_group] THEN + ASM_SIMP_TAC[QUOTIENT_GROUP; IMP_CONJ; RIGHT_FORALL_IMP_THM; + FORALL_IN_GSPEC] THEN + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + X_GEN_TAC `y:A` THEN DISCH_TAC THEN + ASM_SIMP_TAC[GROUP_SETMUL_RIGHT_COSET] THEN + ASM_SIMP_TAC[RIGHT_COSET_EQ; GROUP_MUL] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]);; + (* Subgroups of solvable groups are solvable. *) (* Proof: intersect the solvability chain with the subgroup. The commutator *) (* and conjugation conditions transfer because subgroups are closed under *) @@ -16178,6 +16195,18 @@ let SOLVABLE_GROUP_SUBGROUP = prove [ASM_MESON_TAC[IN_SUBGROUP_INV]; ALL_TAC] THEN REPEAT(MATCH_MP_TAC IN_SUBGROUP_MUL THEN ASM_REWRITE_TAC[])]);; +let SOLVABLE_GROUP_MONOMORPHIC_PREIMAGE = prove + (`!(G:A group) (H:B group) (f:A->B). + group_monomorphism(G,H) f /\ solvable_group H ==> solvable_group G`, + REPEAT STRIP_TAC THEN MP_TAC(ISPECL + [`G:A group`; `subgroup_generated H (group_image(G,H) (f:A->B))`] + ISOMORPHIC_GROUP_SOLVABILITY) THEN + ANTS_TAC THENL + [ASM_MESON_TAC[isomorphic_group; GROUP_ISOMORPHISM_ONTO_IMAGE]; + DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC SOLVABLE_GROUP_SUBGROUP THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUBGROUP_GROUP_IMAGE THEN + ASM_MESON_TAC[group_monomorphism]]);; + (* "Three for the price of two": G is solvable iff N and G/N are both *) (* solvable (backward direction; forward is SOLVABLE_GROUP_SUBGROUP + *) (* SOLVABLE_GROUP_QUOTIENT). Proof: concatenate the solvability chains. *) diff --git a/Library/rabin_test.ml b/Library/rabin_test.ml index 1199fc5d..6c3d5b72 100644 --- a/Library/rabin_test.ml +++ b/Library/rabin_test.ml @@ -10,50 +10,35 @@ needs "Library/fieldtheory.ml";; (* General lemmas. *) (* ------------------------------------------------------------------------- *) -(* Iteration lemma: if p | (x^m - x) in a ring, then p | (x^(m^k) - x) *) let RING_DIVIDES_POW_ITERATE = prove - (`!r (p:A) x m k. - integral_domain r /\ + (`!r (p:A) x m k. integral_domain r /\ p IN ring_carrier r /\ x IN ring_carrier r /\ - ring_divides r p (ring_sub r (ring_pow r x m) x) /\ ~(k = 0) /\ - 1 <= m + ring_divides r p (ring_sub r (ring_pow r x m) x) /\ ~(k = 0) /\ 1 <= m ==> ring_divides r p (ring_sub r (ring_pow r x (m EXP k)) x)`, GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN - INDUCT_TAC THENL - [MESON_TAC[]; ALL_TAC] THEN - REWRITE_TAC[NOT_SUC] THEN - DISCH_TAC THEN - ASM_CASES_TAC `k = 0` THENL - [ASM_REWRITE_TAC[EXP; EXP_1; MULT_CLAUSES]; - ALL_TAC] THEN - (* k != 0 case: use IH then telescope *) + INDUCT_TAC THENL [MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[NOT_SUC] THEN + DISCH_TAC THEN ASM_CASES_TAC `k = 0` THENL + [ASM_REWRITE_TAC[EXP; EXP_1; MULT_CLAUSES]; ALL_TAC] THEN SUBGOAL_THEN `ring_divides r (p:A) (ring_sub r (ring_pow r x (m EXP k)) x)` ASSUME_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN - SUBGOAL_THEN `ring_pow r (x:A) (m EXP k) IN ring_carrier r` - ASSUME_TAC THENL + SUBGOAL_THEN `ring_pow r (x:A) (m EXP k) IN ring_carrier r` ASSUME_TAC THENL [MATCH_MP_TAC RING_POW THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN - (* x^(m^(SUC k)) = (x^(m^k))^m *) SUBGOAL_THEN `ring_pow r (x:A) (m EXP (SUC k)) = - ring_pow r (ring_pow r x (m EXP k)) m` - SUBST1_TAC THENL + ring_pow r (ring_pow r x (m EXP k)) m` SUBST1_TAC THENL [REWRITE_TAC[EXP] THEN ONCE_REWRITE_TAC[MULT_SYM] THEN ASM_SIMP_TAC[RING_POW_POW]; ALL_TAC] THEN - (* Telescope: (x^(m^k))^m - x = ((x^(m^k))^m - x^m) + (x^m - x) *) SUBGOAL_THEN - `ring_sub r (ring_pow r (ring_pow r (x:A) (m EXP k)) m) x = - ring_add r + `ring_sub r (ring_pow r (ring_pow r (x:A) (m EXP k)) m) x = ring_add r (ring_sub r (ring_pow r (ring_pow r x (m EXP k)) m) (ring_pow r x m)) (ring_sub r (ring_pow r x m) x)` SUBST1_TAC THENL [MATCH_MP_TAC(GSYM RING_SUB_TELESCOPE) THEN ASM_SIMP_TAC[RING_POW]; ALL_TAC] THEN MATCH_MP_TAC RING_DIVIDES_ADD THEN CONJ_TAC THENL - [(* p | ((x^(m^k))^m - x^m): by p | (x^(m^k) - x) | ((x^(m^k))^m - x^m) *) + [ MATCH_MP_TAC RING_DIVIDES_TRANS THEN EXISTS_TAC `ring_sub r (ring_pow r (x:A) (m EXP k)) x` THEN - ASM_REWRITE_TAC[] THEN - MATCH_MP_TAC RING_DIVIDES_SUB_POW THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC RING_DIVIDES_SUB_POW THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; - (* p | (x^m - x): direct hypothesis *) ASM_REWRITE_TAC[]]);; (* Helper: non-unit non-zero polynomial over a field has degree >= 1 *) @@ -71,47 +56,39 @@ let POLY_NONUNIT_DEGREE_GE_1 = prove (* Helper: if p | (u - x) and p | (u^m - x) and m >= 1, then p | (x^m - x) *) let RING_DIVIDES_REDUCE = prove (`!r (p:A) u x m. - p IN ring_carrier r /\ u IN ring_carrier r /\ x IN ring_carrier r /\ + u IN ring_carrier r /\ x IN ring_carrier r /\ ring_divides r p (ring_sub r u x) /\ ring_divides r p (ring_sub r (ring_pow r u m) x) /\ ~(m = 0) ==> ring_divides r p (ring_sub r (ring_pow r x m) x)`, REPEAT GEN_TAC THEN STRIP_TAC THEN - (* Step 1: p | (u^m - x^m) via (u-x) | (u^m - x^m) *) + SUBGOAL_THEN `(p:A) IN ring_carrier r` ASSUME_TAC THENL + [ASM_MESON_TAC[ring_divides]; ALL_TAC] THEN SUBGOAL_THEN `ring_divides r (p:A) (ring_sub r (ring_pow r u m) (ring_pow r x m))` ASSUME_TAC THENL [MATCH_MP_TAC RING_DIVIDES_TRANS THEN EXISTS_TAC `ring_sub r (u:A) x` THEN ASM_REWRITE_TAC[] THEN - MATCH_MP_TAC RING_DIVIDES_SUB_POW THEN ASM_REWRITE_TAC[]; - ALL_TAC] THEN - (* Step 2: p | (u^m - x) - (u^m - x^m) by RING_DIVIDES_SUB *) + MATCH_MP_TAC RING_DIVIDES_SUB_POW THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `ring_divides r (p:A) (ring_sub r (ring_sub r (ring_pow r u m) x) (ring_sub r (ring_pow r u m) (ring_pow r x m)))` MP_TAC THENL [MATCH_MP_TAC RING_DIVIDES_SUB THEN - ASM_SIMP_TAC[RING_POW; RING_SUB]; - ALL_TAC] THEN - (* Step 3: (u^m - x) - (u^m - x^m) = x^m - x *) - SUBGOAL_THEN - `ring_sub r (ring_sub r (ring_pow r (u:A) m) x) + ASM_SIMP_TAC[RING_POW; RING_SUB]; ALL_TAC] THEN + SUBGOAL_THEN `ring_sub r (ring_sub r (ring_pow r (u:A) m) x) (ring_sub r (ring_pow r u m) (ring_pow r x m)) = ring_sub r (ring_pow r x m) x` - (fun th -> REWRITE_TAC[th]) THEN - ASM_SIMP_TAC[RING_POW; RING_RULE + (fun th -> REWRITE_TAC[th]) THEN ASM_SIMP_TAC[RING_POW; RING_RULE `ring_sub r (ring_sub r (a:A) b) (ring_sub r a c) = ring_sub r c b`]);; (* ------------------------------------------------------------------------- *) (* Finite field Fermat / Frobenius *) (* ------------------------------------------------------------------------- *) -(* Product of nonzero elements is invariant under multiplication by nonzero x *) let FIELD_NONZERO_PRODUCT_PERMUTE = prove - (`!f:A ring x. - field f /\ FINITE(ring_carrier f) /\ + (`!f:A ring x. field f /\ FINITE(ring_carrier f) /\ x IN ring_carrier f /\ ~(x = ring_0 f) ==> ring_product f (ring_carrier f DELETE ring_0 f) (\y. ring_mul f x y) = ring_product f (ring_carrier f DELETE ring_0 f) (\y. y)`, - REPEAT STRIP_TAC THEN - MATCH_MP_TAC RING_PRODUCT_EQ_GENERAL_INVERSES THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC RING_PRODUCT_EQ_GENERAL_INVERSES THEN EXISTS_TAC `\y:A. ring_mul f x y` THEN EXISTS_TAC `\y:A. ring_mul f (ring_inv f x) y` THEN SUBGOAL_THEN `ring_inv f (x:A) IN ring_carrier f /\ @@ -119,94 +96,61 @@ let FIELD_NONZERO_PRODUCT_PERMUTE = prove [ASM_MESON_TAC[RING_INV; FIELD_UNIT; RING_UNIT_INV]; ALL_TAC] THEN REWRITE_TAC[] THEN CONJ_TAC THEN X_GEN_TAC `y:A` THEN REWRITE_TAC[IN_DELETE] THEN - STRIP_TAC THEN REPEAT CONJ_TAC THENL - [(* ring_mul f (inv x) y IN carrier *) + STRIP_TAC THEN REPEAT CONJ_TAC THENL [ ASM_MESON_TAC[RING_MUL]; - (* ~(ring_mul f (inv x) y = 0) *) ASM_SIMP_TAC[FIELD_MUL_EQ_0]; - (* ring_mul f x (ring_mul f (inv x) y) = y *) ASM_SIMP_TAC[RING_MUL_ASSOC; FIELD_MUL_RINV; RING_MUL_LID]; - (* ring_mul f x y IN carrier *) ASM_MESON_TAC[RING_MUL]; - (* ~(ring_mul f x y = 0) *) ASM_SIMP_TAC[FIELD_MUL_EQ_0]; - (* ring_mul f (inv x) (ring_mul f x y) = y *) ASM_SIMP_TAC[RING_MUL_ASSOC; FIELD_MUL_LINV; RING_MUL_LID]]);; -(* Every element of a finite field satisfies x^q = x where q = CARD(carrier) *) let FINITE_FIELD_ELEMENT_POW = prove - (`!f:A ring. - field f /\ FINITE(ring_carrier f) - ==> !x. x IN ring_carrier f - ==> ring_pow f x (CARD(ring_carrier f)) = x`, - REPEAT STRIP_TAC THEN - (* Case x = 0: x^q = 0 = x *) - ASM_CASES_TAC `x:A = ring_0 f` THENL - [ASM_SIMP_TAC[RING_POW_ZERO] THEN + (`!f:A ring. field f /\ FINITE(ring_carrier f) ==> !x. x IN ring_carrier f + ==> ring_pow f x (CARD(ring_carrier f)) = x`, REPEAT STRIP_TAC THEN + ASM_CASES_TAC `x:A = ring_0 f` THENL [ASM_SIMP_TAC[RING_POW_ZERO] THEN COND_CASES_TAC THENL - [ASM_MESON_TAC[CARD_EQ_0; RING_CARRIER_NONEMPTY]; REFL_TAC]; - ALL_TAC] THEN - (* Rewrite q = (q-1) + 1, split x^q = x^(q-1) * x *) + [ASM_MESON_TAC[CARD_EQ_0; RING_CARRIER_NONEMPTY]; REFL_TAC]; ALL_TAC] THEN SUBGOAL_THEN `CARD(ring_carrier(f:A ring)) = (CARD(ring_carrier f) - 1) + 1` SUBST1_TAC THENL [MATCH_MP_TAC(ARITH_RULE `~(n = 0) ==> n = (n - 1) + 1`) THEN - ASM_MESON_TAC[CARD_EQ_0; RING_CARRIER_NONEMPTY]; - ALL_TAC] THEN + ASM_MESON_TAC[CARD_EQ_0; RING_CARRIER_NONEMPTY]; ALL_TAC] THEN ASM_SIMP_TAC[RING_POW_ADD; RING_POW] THEN REWRITE_TAC[ring_pow; RING_MUL_RID] THEN - (* Reduce to showing x^(q-1) = 1 *) SUBGOAL_THEN `ring_pow f x (CARD(ring_carrier(f:A ring)) - 1) = ring_1 f` (fun th -> ASM_SIMP_TAC[th; RING_MUL_RID; RING_MUL_LID; RING_POW_1; RING_POW]) THEN - (* Set up s = carrier \ {0} *) - ABBREV_TAC `s = ring_carrier f DELETE (ring_0 (f:A ring))` THEN - SUBGOAL_THEN `FINITE (s:A->bool)` ASSUME_TAC THENL - [EXPAND_TAC "s" THEN ASM_SIMP_TAC[FINITE_DELETE]; ALL_TAC] THEN - SUBGOAL_THEN `CARD(s:A->bool) = CARD(ring_carrier(f:A ring)) - 1` - ASSUME_TAC THENL - [EXPAND_TAC "s" THEN ASM_SIMP_TAC[CARD_DELETE; RING_0]; ALL_TAC] THEN + ABBREV_TAC `s = ring_carrier f DELETE (ring_0 (f:A ring))` THEN SUBGOAL_THEN + `FINITE (s:A->bool) /\ CARD s = CARD(ring_carrier(f:A ring)) - 1` + STRIP_ASSUME_TAC THENL [EXPAND_TAC "s" THEN + ASM_SIMP_TAC[FINITE_DELETE; CARD_DELETE; RING_0]; ALL_TAC] THEN SUBGOAL_THEN `(x:A) IN s` ASSUME_TAC THENL [EXPAND_TAC "s" THEN ASM_REWRITE_TAC[IN_DELETE]; ALL_TAC] THEN SUBGOAL_THEN `!y:A. y IN s ==> y IN ring_carrier f /\ ~(y = ring_0 f)` - ASSUME_TAC THENL - [EXPAND_TAC "s" THEN SIMP_TAC[IN_DELETE]; ALL_TAC] THEN - (* Product P of all nonzero elements is nonzero *) + ASSUME_TAC THENL [EXPAND_TAC "s" THEN SIMP_TAC[IN_DELETE]; ALL_TAC] THEN SUBGOAL_THEN `~(ring_product f s (\y:A. y) = ring_0 f)` ASSUME_TAC THENL [ASM_SIMP_TAC[INTEGRAL_DOMAIN_PRODUCT_EQ_0; FIELD_IMP_INTEGRAL_DOMAIN] THEN - ASM_MESON_TAC[]; - ALL_TAC] THEN - (* Product permutation: product of (x*y) = product of y *) - SUBGOAL_THEN - `ring_product f s (\y:A. ring_mul f x y) = + ASM_MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `ring_product f s (\y:A. ring_mul f x y) = ring_product f s (\y:A. y)` ASSUME_TAC THENL [EXPAND_TAC "s" THEN MATCH_MP_TAC FIELD_NONZERO_PRODUCT_PERMUTE THEN - ASM_REWRITE_TAC[]; - ALL_TAC] THEN - (* By RING_PRODUCT_LMUL: product of (x*y) = x^|s| * product of y *) - SUBGOAL_THEN - `ring_product f s (\y:A. ring_mul f x y) = + ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `ring_product f s (\y:A. ring_mul f x y) = ring_mul f (ring_pow f x (CARD(s:A->bool))) (ring_product f s (\y:A. y))` ASSUME_TAC THENL [MATCH_MP_TAC RING_PRODUCT_LMUL THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; ALL_TAC] THEN - (* Cancel: x^|s| = 1 (using x^|s| * P = P from previous equalities) *) SUBGOAL_THEN `ring_pow f x (CARD(s:A->bool)) = ring_1 (f:A ring)` - (fun th -> ASM_MESON_TAC[th]) THEN - MP_TAC (ISPECL [`f:A ring`; + (fun th -> ASM_MESON_TAC[th]) THEN MP_TAC (ISPECL [`f:A ring`; `ring_product f s (\y:A. y)`; - `ring_pow f (x:A) (CARD(s:A->bool))`; - `ring_1 (f:A ring)`] + `ring_pow f (x:A) (CARD(s:A->bool))`; `ring_1 (f:A ring)`] INTEGRAL_DOMAIN_MUL_RCANCEL) THEN ASM_SIMP_TAC[FIELD_IMP_INTEGRAL_DOMAIN; RING_POW; RING_1; - RING_MUL_LID; RING_PRODUCT] THEN - ASM_MESON_TAC[]);; + RING_MUL_LID; RING_PRODUCT] THEN ASM_MESON_TAC[]);; (* Helper: The quotient F[x]/(p) for irreducible p of degree d over a finite field F with q elements is a finite field with q^d elements *) let QUOTIENT_POLY_RING_FINITE_CARD = prove - (`!f:A ring p. - field f /\ FINITE(ring_carrier f) /\ - p IN ring_carrier(poly_ring f (:1)) /\ + (`!f:A ring p. field f /\ FINITE(ring_carrier f) /\ ring_irreducible (poly_ring f (:1)) p ==> field(quotient_ring (poly_ring f (:1)) (ideal_generated (poly_ring f (:1)) {p})) /\ @@ -216,6 +160,8 @@ let QUOTIENT_POLY_RING_FINITE_CARD = prove (ideal_generated (poly_ring f (:1)) {p}))) = CARD(ring_carrier f) EXP (poly_deg f p)`, REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `(p:(1->num)->A) IN ring_carrier(poly_ring f (:1))` + ASSUME_TAC THENL [ASM_MESON_TAC[ring_irreducible]; ALL_TAC] THEN ABBREV_TAC `R = poly_ring (f:A ring) (:1)` THEN ABBREV_TAC `J = ideal_generated R {p:(1->num)->A}` THEN ABBREV_TAC `K = quotient_ring R (J:((1->num)->A)->bool)` THEN @@ -224,211 +170,139 @@ let QUOTIENT_POLY_RING_FINITE_CARD = prove ABBREV_TAC `a:((1->num)->A)->bool = ring_coset R J (poly_var (f:A ring) one)` THEN SUBGOAL_THEN `PID (R:((1->num)->A)ring)` ASSUME_TAC THENL - [EXPAND_TAC "R" THEN ASM_MESON_TAC[PID_POLY_RING]; - ALL_TAC] THEN + [EXPAND_TAC "R" THEN ASM_MESON_TAC[PID_POLY_RING]; ALL_TAC] THEN SUBGOAL_THEN `maximal_ideal R (J:((1->num)->A)->bool) /\ ring_ideal R (J:((1->num)->A)->bool)` STRIP_ASSUME_TAC THENL [EXPAND_TAC "J" THEN ASM_MESON_TAC[RING_IRREDUCIBLE_EQ_MAXIMAL_IDEAL; MAXIMAL_IMP_RING_IDEAL]; ALL_TAC] THEN - (* field K *) SUBGOAL_THEN `field (K:(((1->num)->A)->bool)ring)` ASSUME_TAC THENL [EXPAND_TAC "K" THEN ASM_MESON_TAC[FIELD_QUOTIENT_RING]; ALL_TAC] THEN - (* field_extension(f, K) h - expand all abbrevs for KRONECKER *) - SUBGOAL_THEN `field_extension - (f:A ring, K:(((1->num)->A)->bool)ring) + SUBGOAL_THEN `field_extension (f:A ring, K:(((1->num)->A)->bool)ring) (h:A->((1->num)->A)->bool)` ASSUME_TAC THENL [EXPAND_TAC "K" THEN EXPAND_TAC "h" THEN EXPAND_TAC "J" THEN - EXPAND_TAC "R" THEN - MATCH_MP_TAC KRONECKER_FIELD_EXTENSION THEN + EXPAND_TAC "R" THEN MATCH_MP_TAC KRONECKER_FIELD_EXTENSION THEN CONJ_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN - ASM_MESON_TAC[]; - ALL_TAC] THEN - (* ring_homomorphism(R, K)(ring_coset R J) *) + ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `ring_homomorphism (R:((1->num)->A)ring, K:(((1->num)->A)->bool)ring) (ring_coset R (J:((1->num)->A)->bool))` ASSUME_TAC THENL [EXPAND_TAC "K" THEN ASM_MESON_TAC[RING_HOMOMORPHISM_RING_COSET]; ALL_TAC] THEN - (* ring_homomorphism(f, K) h *) - SUBGOAL_THEN `ring_homomorphism - (f:A ring, K:(((1->num)->A)->bool)ring) + SUBGOAL_THEN `ring_homomorphism (f:A ring, K:(((1->num)->A)->bool)ring) (h:A->((1->num)->A)->bool)` ASSUME_TAC THENL [ASM_MESON_TAC[field_extension; RING_MONOMORPHISM_IMP_HOMOMORPHISM]; ALL_TAC] THEN - (* a IN carrier K *) SUBGOAL_THEN `(a:((1->num)->A)->bool) IN ring_carrier K` ASSUME_TAC THENL [SUBGOAL_THEN `poly_var (f:A ring) one IN ring_carrier R` ASSUME_TAC THENL [EXPAND_TAC "R" THEN REWRITE_TAC[POLY_VAR_UNIV]; ALL_TAC] THEN - ASM_MESON_TAC[ring_homomorphism; IN_IMAGE; SUBSET]; - ALL_TAC] THEN - (* poly_extend = ring_coset R J on carrier R *) - SUBGOAL_THEN - `!g. g IN ring_carrier R - ==> poly_extend (f:A ring,K:(((1->num)->A)->bool)ring) - h (\v:1. a) g = + ASM_MESON_TAC[ring_homomorphism; IN_IMAGE; SUBSET]; ALL_TAC] THEN + SUBGOAL_THEN `!g. g IN ring_carrier R + ==> poly_extend (f:A ring,K:(((1->num)->A)->bool)ring) h (\v:1. a) g = ring_coset R (J:((1->num)->A)->bool) g` ASSUME_TAC THENL [X_GEN_TAC `g:(1->num)->A` THEN DISCH_TAC THEN MP_TAC(ISPECL [`f:A ring`; `K:(((1->num)->A)->bool)ring`; - `(:1)`; `h:A->((1->num)->A)->bool`; - `(\v:1. a:((1->num)->A)->bool)`; + `(:1)`; `h:A->((1->num)->A)->bool`; `(\v:1. a:((1->num)->A)->bool)`; `ring_coset R (J:((1->num)->A)->bool)`; `g:(1->num)->A`] POLY_EXTEND_UNIQUE) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN - CONJ_TAC THENL - [X_GEN_TAC `c:A` THEN DISCH_TAC THEN EXPAND_TAC "h" THEN - REWRITE_TAC[o_THM]; - X_GEN_TAC `i:1` THEN REWRITE_TAC[IN_UNIV] THEN - SUBGOAL_THEN `i:1 = one` SUBST1_TAC THENL - [MESON_TAC[one]; ALL_TAC] THEN - EXPAND_TAC "a" THEN REFL_TAC]; - ALL_TAC] THEN - (* p IN J *) + CONJ_TAC THENL [X_GEN_TAC `c:A` THEN DISCH_TAC THEN EXPAND_TAC "h" THEN + REWRITE_TAC[o_THM]; X_GEN_TAC `i:1` THEN REWRITE_TAC[IN_UNIV] THEN + SUBGOAL_THEN `i:1 = one` SUBST1_TAC THENL [MESON_TAC[one]; ALL_TAC] THEN + EXPAND_TAC "a" THEN REFL_TAC]; ALL_TAC] THEN SUBGOAL_THEN `p:(1->num)->A IN J` ASSUME_TAC THENL [EXPAND_TAC "J" THEN REWRITE_TAC[IN_IDEAL_GENERATED_SELF] THEN - ASM_REWRITE_TAC[]; - ALL_TAC] THEN - (* ring_coset R J p = ring_0 K *) - SUBGOAL_THEN - `ring_coset R (J:((1->num)->A)->bool) (p:(1->num)->A) = + ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `ring_coset R (J:((1->num)->A)->bool) (p:(1->num)->A) = ring_0 (K:(((1->num)->A)->bool)ring)` ASSUME_TAC THENL [EXPAND_TAC "K" THEN ASM_SIMP_TAC[QUOTIENT_RING_0] THEN - ASM_MESON_TAC[RING_COSET_EQ_IDEAL]; - ALL_TAC] THEN - (* algebraic_over *) - SUBGOAL_THEN - `algebraic_over (f:A ring,K:(((1->num)->A)->bool)ring) + ASM_MESON_TAC[RING_COSET_EQ_IDEAL]; ALL_TAC] THEN + SUBGOAL_THEN `algebraic_over (f:A ring,K:(((1->num)->A)->bool)ring) (h:A->((1->num)->A)->bool) (a:((1->num)->A)->bool)` ASSUME_TAC THENL [REWRITE_TAC[algebraic_over] THEN CONJ_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN - EXISTS_TAC `p:(1->num)->A` THEN ASM_REWRITE_TAC[] THEN - CONJ_TAC THENL + EXISTS_TAC `p:(1->num)->A` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[ring_irreducible; POLY_RING_CLAUSES]; ALL_TAC] THEN - SUBGOAL_THEN - `poly_extend (f:A ring,K:(((1->num)->A)->bool)ring) + SUBGOAL_THEN `poly_extend (f:A ring,K:(((1->num)->A)->bool)ring) h (\v:1. a) p = ring_coset R (J:((1->num)->A)->bool) p` - SUBST1_TAC THENL - [ASM_SIMP_TAC[]; ALL_TAC] THEN - ASM_REWRITE_TAC[]; - ALL_TAC] THEN - (* subring_generated K (...) = K *) - SUBGOAL_THEN - `subring_generated K - ((a:((1->num)->A)->bool) INSERT + SUBST1_TAC THENL [ASM_SIMP_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `subring_generated K ((a:((1->num)->A)->bool) INSERT IMAGE (h:A->((1->num)->A)->bool) (ring_carrier f)) = K` - ASSUME_TAC THENL - [REWRITE_TAC[SUBRING_GENERATED_SUPERSET] THEN + ASSUME_TAC THENL [REWRITE_TAC[SUBRING_GENERATED_SUPERSET] THEN MP_TAC(ISPECL [`h:A->((1->num)->A)->bool`; `f:A ring`; - `K:(((1->num)->A)->bool)ring`; - `a:((1->num)->A)->bool`] - IMAGE_POLY_EXTEND_1) THEN - ASM_REWRITE_TAC[] THEN + `K:(((1->num)->A)->bool)ring`; `a:((1->num)->A)->bool`] + IMAGE_POLY_EXTEND_1) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> REWRITE_TAC[GSYM th]) THEN - (* Goal: ring_carrier K ⊆ IMAGE (poly_extend ...) (ring_carrier R) *) - SUBGOAL_THEN - `ring_carrier(K:(((1->num)->A)->bool)ring) = + SUBGOAL_THEN `ring_carrier(K:(((1->num)->A)->bool)ring) = {ring_coset R (J:((1->num)->A)->bool) x |x| x IN ring_carrier R}` SUBST1_TAC THENL [EXPAND_TAC "K" THEN ASM_SIMP_TAC[QUOTIENT_RING_CARRIER]; ALL_TAC] THEN REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; IN_IMAGE] THEN X_GEN_TAC `g:(1->num)->A` THEN DISCH_TAC THEN - EXISTS_TAC `g:(1->num)->A` THEN ASM_SIMP_TAC[]; - ALL_TAC] THEN - (* finite_extension(f, K) h *) - SUBGOAL_THEN `finite_extension - (f:A ring, K:(((1->num)->A)->bool)ring) + EXISTS_TAC `g:(1->num)->A` THEN ASM_SIMP_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `finite_extension (f:A ring, K:(((1->num)->A)->bool)ring) (h:A->((1->num)->A)->bool)` ASSUME_TAC THENL [MP_TAC(ISPECL [`h:A->((1->num)->A)->bool`; - `f:A ring`; `K:(((1->num)->A)->bool)ring`; - `a:((1->num)->A)->bool`] - FINITE_SIMPLE_ALGEBRAIC_EXTENSION) THEN - ASM_REWRITE_TAC[]; - ALL_TAC] THEN - (* Extract basis *) + `f:A ring`; `K:(((1->num)->A)->bool)ring`; `a:((1->num)->A)->bool`] + FINITE_SIMPLE_ALGEBRAIC_EXTENSION) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [FINITE_EXTENSION_BASIS]) THEN DISCH_THEN(CONJUNCTS_THEN2 (fun _ -> ALL_TAC) (X_CHOOSE_THEN `b:(((1->num)->A)->bool)->bool` STRIP_ASSUME_TAC)) THEN - (* field K already proved *) CONJ_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN - (* FINITE + CARD *) MP_TAC(ISPECL [`h:A->((1->num)->A)->bool`; - `f:A ring`; `K:(((1->num)->A)->bool)ring`; - `b:(((1->num)->A)->bool)->bool`] - HAS_SIZE_FINITE_EXTENSION) THEN - ASM_REWRITE_TAC[] THEN + `f:A ring`; `K:(((1->num)->A)->bool)ring`; `b:(((1->num)->A)->bool)->bool`] + HAS_SIZE_FINITE_EXTENSION) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[HAS_SIZE] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (fun th -> REWRITE_TAC[th])) THEN ASM_REWRITE_TAC[] THEN - (* Need: CARD(ring_carrier f) EXP CARD b = ... EXP poly_deg f p *) - (* Suffices to show CARD b = poly_deg f p *) SUBGOAL_THEN `CARD (b:(((1->num)->A)->bool)->bool) = poly_deg (f:A ring) (p:(1->num)->A)` (fun th -> REWRITE_TAC[th]) THEN ABBREV_TAC `d = poly_deg (f:A ring) (p:(1->num)->A)` THEN REWRITE_TAC[GSYM LE_ANTISYM] THEN CONJ_TAC THENL - [(* Upper bound: CARD b <= d *) - (* Establish key facts *) + [ SUBGOAL_THEN `~(p:(1->num)->A = ring_0 R)` ASSUME_TAC THENL [ASM_MESON_TAC[ring_irreducible]; ALL_TAC] THEN SUBGOAL_THEN `poly_extend (f:A ring,K:(((1->num)->A)->bool)ring) h (\v:1. a) p = ring_0 K` ASSUME_TAC THENL [SUBGOAL_THEN `poly_extend (f:A ring,K:(((1->num)->A)->bool)ring) h (\v:1. a) (p:(1->num)->A) = ring_coset R J p` SUBST1_TAC THENL - [ASM_SIMP_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[]; - ALL_TAC] THEN - (* Upper bound: CARD b <= d *) - (* Extract ring_independent and b SUBSET from ring_basis *) + [ASM_SIMP_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `ring_independent (f:A ring,K:(((1->num)->A)->bool)ring) (h:A->((1->num)->A)->bool) (b:(((1->num)->A)->bool)->bool)` - ASSUME_TAC THENL - [ASM_MESON_TAC[ring_basis]; ALL_TAC] THEN + ASSUME_TAC THENL [ASM_MESON_TAC[ring_basis]; ALL_TAC] THEN SUBGOAL_THEN `(b:(((1->num)->A)->bool)->bool) SUBSET ring_carrier (K:(((1->num)->A)->bool)ring)` ASSUME_TAC THENL [ASM_MESON_TAC[ring_independent]; ALL_TAC] THEN - (* Powers {a^n | n < d} span K *) MP_TAC(ISPECL [`h:A->((1->num)->A)->bool`; `f:A ring`; `K:(((1->num)->A)->bool)ring`; `p:(1->num)->A`; `a:((1->num)->A)->bool`] RING_SIMPLE_ALGEBRAIC_EXTENSION_SPAN) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN - (* Apply RING_INDEPENDENT_LE_SPAN *) MP_TAC(ISPECL [`h:A->((1->num)->A)->bool`; `f:A ring`; - `K:(((1->num)->A)->bool)ring`; - `b:(((1->num)->A)->bool)->bool`; + `K:(((1->num)->A)->bool)ring`; `b:(((1->num)->A)->bool)->bool`; `{ring_pow (K:(((1->num)->A)->bool)ring) (a:((1->num)->A)->bool) n | n < d}`] - RING_INDEPENDENT_LE_SPAN) THEN - ANTS_TAC THENL - [CONJ_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN - CONJ_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN - CONJ_TAC THENL - [(* t SUBSET ring_carrier K *) + RING_INDEPENDENT_LE_SPAN) THEN ANTS_TAC THENL [REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]; REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN MATCH_MP_TAC RING_POW THEN ASM_REWRITE_TAC[]; - ALL_TAC] THEN - CONJ_TAC THENL - [(* FINITE t *) ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN MATCH_MP_TAC FINITE_IMAGE THEN REWRITE_TAC[FINITE_NUMSEG_LT]; - ALL_TAC] THEN - CONJ_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN - (* b SUBSET ring_span(f,K) h {ring_pow K a n | n < d} *) - SUBGOAL_THEN `ring_span (f:A ring,K:(((1->num)->A)->bool)ring) - (h:A->((1->num)->A)->bool) - {ring_pow K (a:((1->num)->A)->bool) n | n < d} = - ring_carrier (K:(((1->num)->A)->bool)ring)` - (fun th -> REWRITE_TAC[th]) THENL - [ASM_MESON_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[]; - ALL_TAC] THEN - (* FINITE b /\ CARD b <= CARD {ring_pow K a n | n < d} *) + ASM_REWRITE_TAC[]; + SUBGOAL_THEN `ring_span (f:A ring,K:(((1->num)->A)->bool)ring) + (h:A->((1->num)->A)->bool) + {ring_pow K (a:((1->num)->A)->bool) n | n < d} = + ring_carrier (K:(((1->num)->A)->bool)ring)` + (fun th -> REWRITE_TAC[th]) THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN DISCH_THEN(fun th -> MP_TAC(CONJUNCT2 th)) THEN MATCH_MP_TAC(ARITH_RULE `b <= c ==> a <= b ==> a <= c`) THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN - TRANS_TAC LE_TRANS `CARD {n:num | n < d}` THEN - CONJ_TAC THENL + TRANS_TAC LE_TRANS `CARD {n:num | n < d}` THEN CONJ_TAC THENL [MATCH_MP_TAC CARD_IMAGE_LE THEN REWRITE_TAC[FINITE_NUMSEG_LT]; REWRITE_TAC[CARD_NUMSEG_LT; LE_REFL]]; - (* Lower bound: d <= CARD b *) SUBGOAL_THEN `ring_span (f:A ring,K:(((1->num)->A)->bool)ring) (h:A->((1->num)->A)->bool) (b:(((1->num)->A)->bool)->bool) = ring_carrier K` ASSUME_TAC THENL @@ -437,13 +311,10 @@ let QUOTIENT_POLY_RING_FINITE_CARD = prove ring_carrier (K:(((1->num)->A)->bool)ring)` ASSUME_TAC THENL [ASM_MESON_TAC[ring_basis; ring_independent]; ALL_TAC] THEN MP_TAC(ISPECL [`h:A->((1->num)->A)->bool`; `f:A ring`; - `K:(((1->num)->A)->bool)ring`; - `a:((1->num)->A)->bool`; - `b:(((1->num)->A)->bool)->bool`; - `CARD (b:(((1->num)->A)->bool)->bool)`] + `K:(((1->num)->A)->bool)ring`; `a:((1->num)->A)->bool`; + `b:(((1->num)->A)->bool)->bool`; `CARD (b:(((1->num)->A)->bool)->bool)`] FINITE_IMP_ALGEBRAIC_EXTENSION_EXPLICIT) THEN - ANTS_TAC THENL - [ASM_REWRITE_TAC[HAS_SIZE; SUBSET_REFL]; ALL_TAC] THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[HAS_SIZE; SUBSET_REFL]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `q:(1->num)->A` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `(q:(1->num)->A) IN ring_carrier R` ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN @@ -451,48 +322,35 @@ let QUOTIENT_POLY_RING_FINITE_CARD = prove ring_0 (K:(((1->num)->A)->bool)ring)` ASSUME_TAC THENL [FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `q:(1->num)->A` th)) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN - ASM_REWRITE_TAC[]; - ALL_TAC] THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `(q:(1->num)->A) IN J` ASSUME_TAC THENL [SUBGOAL_THEN `ring_kernel(R,K) (ring_coset R (J:((1->num)->A)->bool)) = J` (SUBST1_TAC o SYM) THENL [EXPAND_TAC "K" THEN ASM_MESON_TAC[RING_KERNEL_RING_COSET]; ALL_TAC] THEN - REWRITE_TAC[ring_kernel; IN_ELIM_THM] THEN ASM_MESON_TAC[]; - ALL_TAC] THEN + REWRITE_TAC[ring_kernel; IN_ELIM_THM] THEN ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `ring_divides R (p:(1->num)->A) q` ASSUME_TAC THENL [MP_TAC(ISPECL [`R:((1->num)->A)ring`; `p:(1->num)->A`; - `q:(1->num)->A`] IN_IDEAL_GENERATED_SING_EQ) THEN - ASM_REWRITE_TAC[] THEN - DISCH_THEN(fun th -> ASM_REWRITE_TAC[GSYM th]); - ALL_TAC] THEN + `q:(1->num)->A`] IN_IDEAL_GENERATED_SING_EQ) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(fun th -> ASM_REWRITE_TAC[GSYM th]); ALL_TAC] THEN TRANS_TAC LE_TRANS `poly_deg (f:A ring) (q:(1->num)->A)` THEN - CONJ_TAC THENL - [EXPAND_TAC "d" THEN + CONJ_TAC THENL [EXPAND_TAC "d" THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ring_divides]) THEN EXPAND_TAC "R" THEN REWRITE_TAC[POLY_RING_CLAUSES; SUBSET_UNIV; IN_ELIM_THM] THEN - DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC - (CONJUNCTS_THEN2 ASSUME_TAC + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (CONJUNCTS_THEN2 ASSUME_TAC (X_CHOOSE_THEN `s:(1->num)->A` STRIP_ASSUME_TAC))) THEN - (* poly_deg f q = poly_deg f p + poly_deg f s *) SUBGOAL_THEN `poly_deg (f:A ring) (q:(1->num)->A) = poly_deg f (p:(1->num)->A) + poly_deg f (s:(1->num)->A)` MP_TAC THENL - [SUBGOAL_THEN `(q:(1->num)->A) = poly_mul (f:A ring) p s` - SUBST1_TAC THENL - [ASM_REWRITE_TAC[]; ALL_TAC] THEN - MATCH_MP_TAC POLY_DEG_MUL THEN + [SUBGOAL_THEN `(q:(1->num)->A) = poly_mul (f:A ring) p s` SUBST1_TAC THENL + [ASM_REWRITE_TAC[]; ALL_TAC] THEN MATCH_MP_TAC POLY_DEG_MUL THEN ASM_SIMP_TAC[FIELD_IMP_INTEGRAL_DOMAIN] THEN - (* Remaining: p = poly_0 f <=> s = poly_0 f; both sides false *) SUBGOAL_THEN `poly_0 (f:A ring) = ring_0 (R:((1->num)->A)ring)` (fun th -> REWRITE_TAC[th]) THENL [EXPAND_TAC "R" THEN REWRITE_TAC[POLY_RING_CLAUSES]; ALL_TAC] THEN - (* Goal: p = ring_0 R <=> s = ring_0 R *) MATCH_MP_TAC(TAUT `~p /\ ~q ==> (p <=> q)`) THEN FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [ring_irreducible]) THEN - CONJ_TAC THENL - [ASM_REWRITE_TAC[]; - (* ~(s = ring_0 R): if s = 0 then q = p*0 = 0, contradicting q <> 0 *) + CONJ_TAC THENL [ASM_REWRITE_TAC[]; DISCH_TAC THEN SUBGOAL_THEN `ring_mul (R:((1->num)->A)ring) (p:(1->num)->A) (ring_0 R) = ring_0 R` ASSUME_TAC THENL @@ -501,224 +359,143 @@ let QUOTIENT_POLY_RING_FINITE_CARD = prove (ring_0 (R:((1->num)->A)ring)) = ring_mul R p (ring_0 R)` ASSUME_TAC THENL [EXPAND_TAC "R" THEN REWRITE_TAC[POLY_RING_CLAUSES]; ALL_TAC] THEN - ASM_MESON_TAC[]]; - ALL_TAC] THEN - EXPAND_TAC "d" THEN ARITH_TAC; + ASM_MESON_TAC[]]; ALL_TAC] THEN EXPAND_TAC "d" THEN ARITH_TAC; ASM_REWRITE_TAC[]]]);; (* Generalized: irreducible p with deg(p) | n implies p | x^(q^n) - x *) let IRREDUCIBLE_DIVIDES_XQ_MINUS_X_GEN = prove - (`!f:A ring p n. - field f /\ FINITE(ring_carrier f) /\ - p IN ring_carrier(poly_ring f (:1)) /\ - ring_irreducible (poly_ring f (:1)) p /\ - (poly_deg f p) divides n - ==> ring_divides (poly_ring f (:1)) p - (ring_sub (poly_ring f (:1)) + (`!f:A ring p n. field f /\ FINITE(ring_carrier f) /\ + ring_irreducible (poly_ring f (:1)) p /\ (poly_deg f p) divides n + ==> ring_divides (poly_ring f (:1)) p (ring_sub (poly_ring f (:1)) (ring_pow (poly_ring f (:1)) (poly_var f one) (CARD(ring_carrier f) EXP n)) - (poly_var f one))`, - REPEAT GEN_TAC THEN STRIP_TAC THEN + (poly_var f one))`, REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `(p:(1->num)->A) IN ring_carrier(poly_ring f (:1))` + ASSUME_TAC THENL [ASM_MESON_TAC[ring_irreducible]; ALL_TAC] THEN ABBREV_TAC `R = poly_ring (f:A ring) (:1)` THEN ABBREV_TAC `J = ideal_generated R {p:(1->num)->A}` THEN ABBREV_TAC `K = quotient_ring R (J:((1->num)->A)->bool)` THEN - (* Step 1: J is maximal, hence a ring ideal *) SUBGOAL_THEN `PID (R:((1->num)->A)ring)` ASSUME_TAC THENL - [EXPAND_TAC "R" THEN ASM_MESON_TAC[PID_POLY_RING]; - ALL_TAC] THEN + [EXPAND_TAC "R" THEN ASM_MESON_TAC[PID_POLY_RING]; ALL_TAC] THEN SUBGOAL_THEN `maximal_ideal R (J:((1->num)->A)->bool) /\ ring_ideal R (J:((1->num)->A)->bool)` STRIP_ASSUME_TAC THENL [EXPAND_TAC "J" THEN ASM_MESON_TAC[RING_IRREDUCIBLE_EQ_MAXIMAL_IDEAL; MAXIMAL_IMP_RING_IDEAL]; ALL_TAC] THEN - (* Step 2: K is a finite field with q^d elements *) SUBGOAL_THEN - `field (K:(((1->num)->A)->bool) ring) /\ - FINITE(ring_carrier K) /\ + `field (K:(((1->num)->A)->bool) ring) /\ FINITE(ring_carrier K) /\ CARD(ring_carrier K) = CARD(ring_carrier(f:A ring)) EXP (poly_deg f (p:(1->num)->A))` STRIP_ASSUME_TAC THENL [MP_TAC(ISPECL [`f:A ring`; `p:(1->num)->A`] QUOTIENT_POLY_RING_FINITE_CARD) THEN - ASM_REWRITE_TAC[]; - ALL_TAC] THEN - (* Step 3: ring_coset R J is a ring homomorphism R -> K *) + ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `ring_homomorphism(R,K) (ring_coset R (J:((1->num)->A)->bool))` ASSUME_TAC THENL [EXPAND_TAC "K" THEN ASM_MESON_TAC[RING_HOMOMORPHISM_RING_COSET]; ALL_TAC] THEN - (* Step 4: poly_var f one IN carrier R *) SUBGOAL_THEN `poly_var f one IN ring_carrier(R:((1->num)->A)ring)` ASSUME_TAC THENL [EXPAND_TAC "R" THEN REWRITE_TAC[POLY_VAR_UNIV]; ALL_TAC] THEN - (* Step 5: proj(x) IN carrier K *) - SUBGOAL_THEN - `ring_coset R (J:((1->num)->A)->bool) + SUBGOAL_THEN `ring_coset R (J:((1->num)->A)->bool) (poly_var (f:A ring) one) IN ring_carrier K` ASSUME_TAC THENL [ASM_MESON_TAC[ring_homomorphism; IN_IMAGE; SUBSET]; ALL_TAC] THEN - (* Step 6: proj(x)^(q^d) = proj(x) by FINITE_FIELD_ELEMENT_POW *) - SUBGOAL_THEN - `ring_pow K + SUBGOAL_THEN `ring_pow K (ring_coset R (J:((1->num)->A)->bool) (poly_var (f:A ring) one)) - (CARD(ring_carrier(f:A ring)) EXP - (poly_deg f (p:(1->num)->A))) = - ring_coset R J (poly_var f one)` ASSUME_TAC THENL - [SUBGOAL_THEN + (CARD(ring_carrier(f:A ring)) EXP (poly_deg f (p:(1->num)->A))) = + ring_coset R J (poly_var f one)` ASSUME_TAC THENL [SUBGOAL_THEN `CARD(ring_carrier(f:A ring)) EXP (poly_deg f (p:(1->num)->A)) = CARD(ring_carrier(K:(((1->num)->A)->bool) ring))` SUBST1_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN MP_TAC(ISPEC `K:(((1->num)->A)->bool) ring` FINITE_FIELD_ELEMENT_POW) THEN - ASM_REWRITE_TAC[] THEN - DISCH_THEN(MP_TAC o SPEC + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `ring_coset R (J:((1->num)->A)->bool) (poly_var (f:A ring) one)`) THEN - ASM_REWRITE_TAC[]; - ALL_TAC] THEN - (* Step 7: proj(x^(q^d) - x) = 0 *) - SUBGOAL_THEN - `ring_coset R (J:((1->num)->A)->bool) - (ring_sub R - (ring_pow R (poly_var f one) - (CARD(ring_carrier(f:A ring)) EXP - (poly_deg f (p:(1->num)->A)))) - (poly_var f one)) = + ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `ring_coset R (J:((1->num)->A)->bool) (ring_sub R + (ring_pow R (poly_var f one) (CARD(ring_carrier(f:A ring)) EXP + (poly_deg f (p:(1->num)->A)))) (poly_var f one)) = ring_0 (K:(((1->num)->A)->bool) ring)` ASSUME_TAC THENL - [(* proj(a - b) = proj(a) - proj(b) *) - FIRST_ASSUM(fun hom -> - MP_TAC(MATCH_MP RING_HOMOMORPHISM_SUB hom)) THEN - DISCH_THEN(fun th -> + [ FIRST_ASSUM(fun hom -> + MP_TAC(MATCH_MP RING_HOMOMORPHISM_SUB hom)) THEN DISCH_THEN(fun th -> MP_TAC(SPECL [`ring_pow R (poly_var f one) (CARD(ring_carrier(f:A ring)) EXP - (poly_deg f (p:(1->num)->A)))`; - `poly_var (f:A ring) one`] th)) THEN + (poly_deg f (p:(1->num)->A)))`; `poly_var (f:A ring) one`] th)) THEN ASM_SIMP_TAC[RING_POW] THEN DISCH_THEN SUBST1_TAC THEN - (* proj(x^n) = proj(x)^n *) FIRST_ASSUM(fun hom -> - MP_TAC(MATCH_MP RING_HOMOMORPHISM_POW hom)) THEN - DISCH_THEN(fun th -> - MP_TAC(SPECL [`poly_var (f:A ring) one`; - `CARD(ring_carrier(f:A ring)) EXP + MP_TAC(MATCH_MP RING_HOMOMORPHISM_POW hom)) THEN DISCH_THEN(fun th -> + MP_TAC(SPECL [`poly_var (f:A ring) one`; `CARD(ring_carrier(f:A ring)) EXP (poly_deg f (p:(1->num)->A))`] th)) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN - (* Now: ring_sub K (ring_pow K proj(x) (q^d)) proj(x) = ring_0 K *) - (* Use proj(x)^(|K|) = proj(x) and |K| = q^d *) - ASM_REWRITE_TAC[] THEN - ASM_MESON_TAC[RING_SUB_REFL]; - ALL_TAC] THEN - (* Step 8: x^(q^d) - x IN J (kernel of proj = J) *) + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[RING_SUB_REFL]; ALL_TAC] THEN SUBGOAL_THEN - `ring_sub R - (ring_pow R (poly_var f one) - (CARD(ring_carrier(f:A ring)) EXP + `ring_sub R (ring_pow R (poly_var f one) (CARD(ring_carrier(f:A ring)) EXP (poly_deg f (p:(1->num)->A)))) - (poly_var (f:A ring) one) IN J` - ASSUME_TAC THENL - [SUBGOAL_THEN + (poly_var (f:A ring) one) IN J` ASSUME_TAC THENL [SUBGOAL_THEN `ring_kernel(R,K) (ring_coset R (J:((1->num)->A)->bool)) = J` (SUBST1_TAC o SYM) THENL - [EXPAND_TAC "K" THEN ASM_MESON_TAC[RING_KERNEL_RING_COSET]; - ALL_TAC] THEN + [EXPAND_TAC "K" THEN ASM_MESON_TAC[RING_KERNEL_RING_COSET]; ALL_TAC] THEN REWRITE_TAC[ring_kernel; IN_ELIM_THM] THEN - CONJ_TAC THENL - [ASM_MESON_TAC[RING_SUB; RING_POW]; - ASM_REWRITE_TAC[]]; - ALL_TAC] THEN - (* Step 9: p | x^(q^d) - x from membership in ideal_generated R {p} *) + CONJ_TAC THENL [ASM_MESON_TAC[RING_SUB; RING_POW]; + ASM_REWRITE_TAC[]]; ALL_TAC] THEN SUBGOAL_THEN - `ring_divides R (p:(1->num)->A) - (ring_sub R - (ring_pow R (poly_var f one) - (CARD(ring_carrier(f:A ring)) EXP - (poly_deg f (p:(1->num)->A)))) + `ring_divides R (p:(1->num)->A) (ring_sub R (ring_pow R (poly_var f one) + (CARD(ring_carrier(f:A ring)) EXP (poly_deg f (p:(1->num)->A)))) (poly_var f one))` ASSUME_TAC THENL [MP_TAC(ISPECL [`R:((1->num)->A)ring`; `p:(1->num)->A`; - `ring_sub R - (ring_pow R (poly_var f one) - (CARD(ring_carrier(f:A ring)) EXP + `ring_sub R (ring_pow R (poly_var f one) (CARD(ring_carrier(f:A ring)) EXP (poly_deg f (p:(1->num)->A)))) - (poly_var (f:A ring) one)`] - IN_IDEAL_GENERATED_SING_EQ) THEN + (poly_var (f:A ring) one)`] IN_IDEAL_GENERATED_SING_EQ) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN DISCH_THEN(fun th -> REWRITE_TAC[GSYM th]) THEN - ASM_REWRITE_TAC[]; - ALL_TAC] THEN - (* Step 10: Iterate for d | n *) - (* From d divides n, extract k with n = d * k *) + ASM_REWRITE_TAC[]; ALL_TAC] THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [divides]) THEN - DISCH_THEN(X_CHOOSE_TAC `k:num`) THEN - ASM_CASES_TAC `k = 0` THENL - [(* k = 0 case: n = 0, x^(q^0) - x = x - x = 0, p | 0 *) + DISCH_THEN(X_CHOOSE_TAC `k:num`) THEN ASM_CASES_TAC `k = 0` THENL + [ SUBGOAL_THEN `n = 0` SUBST_ALL_TAC THENL - [ASM_REWRITE_TAC[MULT_CLAUSES]; ALL_TAC] THEN - REWRITE_TAC[EXP] THEN - SUBGOAL_THEN - `ring_sub R - (ring_pow R (poly_var (f:A ring) one) 1) - (poly_var f one) = ring_0 R` - SUBST1_TAC THENL - [ASM_SIMP_TAC[RING_POW_1] THEN - ASM_MESON_TAC[RING_SUB_REFL]; - ALL_TAC] THEN - REWRITE_TAC[RING_DIVIDES_0] THEN ASM_MESON_TAC[]; - ALL_TAC] THEN - (* k > 0 case: use RING_DIVIDES_POW_ITERATE *) - SUBGOAL_THEN - `CARD(ring_carrier(f:A ring)) EXP n = + [ASM_REWRITE_TAC[MULT_CLAUSES]; ALL_TAC] THEN REWRITE_TAC[EXP] THEN + SUBGOAL_THEN `ring_sub R (ring_pow R (poly_var (f:A ring) one) 1) + (poly_var f one) = ring_0 R` SUBST1_TAC THENL + [ASM_SIMP_TAC[RING_POW_1] THEN ASM_MESON_TAC[RING_SUB_REFL]; ALL_TAC] THEN + REWRITE_TAC[RING_DIVIDES_0] THEN ASM_MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `CARD(ring_carrier(f:A ring)) EXP n = (CARD(ring_carrier f) EXP (poly_deg f (p:(1->num)->A))) EXP k` SUBST1_TAC THENL - [REWRITE_TAC[EXP_EXP] THEN AP_TERM_TAC THEN ASM_REWRITE_TAC[]; - ALL_TAC] THEN - MP_TAC(ISPECL - [`R:((1->num)->A)ring`; - `p:(1->num)->A`; - `poly_var (f:A ring) one`; + [REWRITE_TAC[EXP_EXP] THEN AP_TERM_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL [`R:((1->num)->A)ring`; + `p:(1->num)->A`; `poly_var (f:A ring) one`; `CARD(ring_carrier(f:A ring)) EXP poly_deg f (p:(1->num)->A)`; - `k:num`] RING_DIVIDES_POW_ITERATE) THEN - ASM_REWRITE_TAC[] THEN - DISCH_THEN MATCH_MP_TAC THEN - ASM_REWRITE_TAC[] THEN - CONJ_TAC THENL + `k:num`] RING_DIVIDES_POW_ITERATE) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_MESON_TAC[FIELD_IMP_INTEGRAL_DOMAIN; INTEGRAL_DOMAIN_POLY_RING]; - ALL_TAC] THEN - ASM_REWRITE_TAC[] THEN - (* 1 <= q^d: field has >= 2 elements, so q >= 2, d >= 1, q^d >= 2 *) + ALL_TAC] THEN ASM_REWRITE_TAC[] THEN SUBGOAL_THEN `2 <= CARD(ring_carrier(f:A ring))` ASSUME_TAC THENL [SUBGOAL_THEN `~(ring_1 (f:A ring) = ring_0 f)` ASSUME_TAC THENL [MP_TAC(ISPEC `f:A ring` FIELD_NONTRIVIAL) THEN ASM_REWRITE_TAC[TRIVIAL_RING_10]; ALL_TAC] THEN MP_TAC(ISPECL [`{ring_0 f, ring_1 (f:A ring)}`; `ring_carrier(f:A ring)`] - CARD_SUBSET) THEN - ASM_REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY; + CARD_SUBSET) THEN ASM_REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY; INSERT_SUBSET; EMPTY_SUBSET; RING_0; RING_1] THEN SIMP_TAC[CARD_CLAUSES; FINITE_INSERT; FINITE_EMPTY; IN_INSERT; NOT_IN_EMPTY] THEN - ASM_REWRITE_TAC[] THEN ARITH_TAC; - ALL_TAC] THEN - REWRITE_TAC[ARITH_RULE `1 <= n <=> ~(n = 0)`; EXP_EQ_0] THEN - ASM_ARITH_TAC);; + ASM_REWRITE_TAC[] THEN ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[ARITH_RULE `1 <= n <=> ~(n = 0)`; EXP_EQ_0] THEN ASM_ARITH_TAC);; (* Special case: p | x^(q^(deg p)) - x *) let IRREDUCIBLE_DIVIDES_XQ_MINUS_X = prove - (`!f:A ring p. - field f /\ FINITE(ring_carrier f) /\ - p IN ring_carrier(poly_ring f (:1)) /\ + (`!f:A ring p. field f /\ FINITE(ring_carrier f) /\ ring_irreducible (poly_ring f (:1)) p - ==> ring_divides (poly_ring f (:1)) p - (ring_sub (poly_ring f (:1)) + ==> ring_divides (poly_ring f (:1)) p (ring_sub (poly_ring f (:1)) (ring_pow (poly_ring f (:1)) (poly_var f one) (CARD(ring_carrier f) EXP (poly_deg f p))) - (poly_var f one))`, - REPEAT GEN_TAC THEN STRIP_TAC THEN + (poly_var f one))`, REPEAT GEN_TAC THEN STRIP_TAC THEN MP_TAC(ISPECL [`f:A ring`; `p:(1->num)->A`; `poly_deg f (p:(1->num)->A)`] - IRREDUCIBLE_DIVIDES_XQ_MINUS_X_GEN) THEN - ASM_REWRITE_TAC[] THEN - DISCH_THEN MATCH_MP_TAC THEN - MESON_TAC[divides; MULT_CLAUSES]);; + IRREDUCIBLE_DIVIDES_XQ_MINUS_X_GEN) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN MATCH_MP_TAC THEN MESON_TAC[divides; MULT_CLAUSES]);; (* Helper: x^(q^r) = x for elements of GF(q), for any r *) let FINITE_FIELD_POW_ITERATE = prove (`!f:A ring x r. field f /\ FINITE(ring_carrier f) /\ x IN ring_carrier f ==> ring_pow f x (CARD(ring_carrier f) EXP r) = x`, - GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THENL - [SIMP_TAC[EXP; RING_POW_1]; + GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THENL [SIMP_TAC[EXP; RING_POW_1]; STRIP_TAC THEN REWRITE_TAC[EXP] THEN ASM_SIMP_TAC[RING_POW_MUL; FINITE_FIELD_ELEMENT_POW] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]);; @@ -727,256 +504,124 @@ let FINITE_FIELD_POW_ITERATE = prove let RING_ENDOMORPHISM_FROBENIUS_ITERATE = prove (`!r:A ring k. prime(ring_char r) ==> ring_endomorphism r (\x. ring_pow r x (ring_char r EXP k))`, - GEN_TAC THEN INDUCT_TAC THENL - [(* k = 0: x^1 = identity *) - DISCH_TAC THEN REWRITE_TAC[EXP] THEN - MP_TAC(ISPECL [`r:A ring`; `\x:A. x`; + GEN_TAC THEN INDUCT_TAC THENL [ + DISCH_TAC THEN REWRITE_TAC[EXP] THEN MP_TAC(ISPECL [`r:A ring`; `\x:A. x`; `\x:A. ring_pow r x 1`] RING_ENDOMORPHISM_EQ) THEN SIMP_TAC[ring_endomorphism; RING_HOMOMORPHISM_ID; RING_POW_1]; - (* k = SUC k: compose Frobenius with iterate *) - DISCH_TAC THEN - SUBGOAL_THEN - `ring_endomorphism (r:A ring) - ((\x. ring_pow r x (ring_char r)) o - (\x. ring_pow r x (ring_char r EXP k)))` - ASSUME_TAC THENL + DISCH_TAC THEN SUBGOAL_THEN + `ring_endomorphism (r:A ring) ((\x. ring_pow r x (ring_char r)) o + (\x. ring_pow r x (ring_char r EXP k)))` ASSUME_TAC THENL [REWRITE_TAC[ring_endomorphism] THEN - MATCH_MP_TAC RING_HOMOMORPHISM_COMPOSE THEN - EXISTS_TAC `r:A ring` THEN + MATCH_MP_TAC RING_HOMOMORPHISM_COMPOSE THEN EXISTS_TAC `r:A ring` THEN REWRITE_TAC[GSYM ring_endomorphism] THEN - CONJ_TAC THENL - [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; - ASM_SIMP_TAC[RING_ENDOMORPHISM_FROBENIUS]]; - ALL_TAC] THEN - MP_TAC(ISPECL [`r:A ring`; - `(\x:A. ring_pow r x (ring_char r)) o + CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + ASM_SIMP_TAC[RING_ENDOMORPHISM_FROBENIUS]]; ALL_TAC] THEN + MP_TAC(ISPECL [`r:A ring`; `(\x:A. ring_pow r x (ring_char r)) o (\x. ring_pow r x (ring_char r EXP k))`; `\x:A. ring_pow r x (ring_char r EXP (SUC k))`] - RING_ENDOMORPHISM_EQ) THEN - ASM_REWRITE_TAC[] THEN - DISCH_THEN MATCH_MP_TAC THEN - X_GEN_TAC `x:A` THEN DISCH_TAC THEN - REWRITE_TAC[o_THM; EXP] THEN - ONCE_REWRITE_TAC[MULT_SYM] THEN + RING_ENDOMORPHISM_EQ) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN MATCH_MP_TAC THEN X_GEN_TAC `x:A` THEN DISCH_TAC THEN + REWRITE_TAC[o_THM; EXP] THEN ONCE_REWRITE_TAC[MULT_SYM] THEN ASM_SIMP_TAC[RING_POW_POW]]);; (* Helper: in a field, if every element satisfies x^n = x, then |field| <= n *) let FIELD_ROOTS_BOUND = prove - (`!r:A ring n. - field r /\ FINITE(ring_carrier r) /\ 2 <= n /\ + (`!r:A ring n. field r /\ FINITE(ring_carrier r) /\ 2 <= n /\ (!a. a IN ring_carrier r ==> ring_pow r a n = a) - ==> CARD(ring_carrier r) <= n`, - REPEAT STRIP_TAC THEN + ==> CARD(ring_carrier r) <= n`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `~(ring_1 r:A = ring_0 r)` ASSUME_TAC THENL [ASM_MESON_TAC[FIELD_NONTRIVIAL; TRIVIAL_RING_10]; ALL_TAC] THEN - ABBREV_TAC `P = poly_ring (r:A ring) (:1)` THEN - ABBREV_TAC `g = ring_sub P - (ring_pow P (poly_var r one) n) - (poly_var (r:A ring) one)` THEN + ABBREV_TAC `P = poly_ring (r:A ring) (:1)` THEN ABBREV_TAC `g = ring_sub P + (ring_pow P (poly_var r one) n) (poly_var (r:A ring) one)` THEN SUBGOAL_THEN `(g:(1->num)->A) IN ring_carrier P` ASSUME_TAC THENL [EXPAND_TAC "g" THEN EXPAND_TAC "P" THEN - SIMP_TAC[RING_SUB; RING_POW; POLY_VAR_UNIV]; - ALL_TAC] THEN - SUBGOAL_THEN `~(g:(1->num)->A = ring_0 P)` ASSUME_TAC THENL - [DISCH_TAC THEN + SIMP_TAC[RING_SUB; RING_POW; POLY_VAR_UNIV]; ALL_TAC] THEN + SUBGOAL_THEN `~(g:(1->num)->A = ring_0 P)` ASSUME_TAC THENL [DISCH_TAC THEN SUBGOAL_THEN `ring_pow P (poly_var r one:(1->num)->A) n = poly_var r one` MP_TAC THENL [SUBGOAL_THEN `ring_sub P (ring_pow P (poly_var r one:(1->num)->A) n) (poly_var r one) = ring_0 P` MP_TAC THENL - [ASM_MESON_TAC[]; ALL_TAC] THEN - EXPAND_TAC "P" THEN + [ASM_MESON_TAC[]; ALL_TAC] THEN EXPAND_TAC "P" THEN SIMP_TAC[RING_SUB_EQ_0; RING_POW; POLY_VAR_UNIV]; ALL_TAC] THEN DISCH_THEN(MP_TAC o AP_TERM `poly_deg (r:A ring):((1->num)->A)->num`) THEN EXPAND_TAC "P" THEN REWRITE_TAC[POLY_DEG_VAR_POW; POLY_DEG_VAR] THEN - ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; - ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `poly_deg r (g:(1->num)->A) <= n` ASSUME_TAC THENL [EXPAND_TAC "g" THEN EXPAND_TAC "P" THEN MP_TAC(ISPECL [`r:A ring`; `ring_pow (poly_ring r (:1)) (poly_var r one:(1->num)->A) n`; `poly_var (r:A ring) one`] - POLY_DEG_SUB_LE) THEN - ANTS_TAC THENL + POLY_DEG_SUB_LE) THEN ANTS_TAC THENL [REWRITE_TAC[POLY_RING_CLAUSES; RING_POLYNOMIAL_VAR; IN_UNIV] THEN MATCH_MP_TAC RING_POLYNOMIAL_POW THEN REWRITE_TAC[RING_POLYNOMIAL_VAR; IN_UNIV]; ALL_TAC] THEN REWRITE_TAC[POLY_RING_CLAUSES; POLY_DEG_VAR_POW; POLY_DEG_VAR] THEN - ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; - ALL_TAC] THEN - (* Every element of r is a root of g *) + ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `ring_carrier r SUBSET - {x:A | x IN ring_carrier r /\ poly_eval r g x = ring_0 r}` - ASSUME_TAC THENL + {x:A | x IN ring_carrier r /\ poly_eval r g x = ring_0 r}` ASSUME_TAC THENL [REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `a:A` THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN - EXPAND_TAC "g" THEN EXPAND_TAC "P" THEN - REWRITE_TAC[POLY_RING_CLAUSES] THEN + EXPAND_TAC "g" THEN EXPAND_TAC "P" THEN REWRITE_TAC[POLY_RING_CLAUSES] THEN ASM_SIMP_TAC[POLY_EVAL_SUB; RING_POLYNOMIAL_VAR; IN_UNIV; RING_POLYNOMIAL_POW; POLY_EVAL_POW; POLY_EVAL_VAR] THEN - ASM_SIMP_TAC[RING_SUB_EQ_0; RING_POW]; - ALL_TAC] THEN - (* POLY_ROOT_BOUND gives finite roots and CARD bound *) + ASM_SIMP_TAC[RING_SUB_EQ_0; RING_POW]; ALL_TAC] THEN MP_TAC(ISPECL [`r:A ring`; `g:(1->num)->A`] POLY_ROOT_BOUND) THEN - ANTS_TAC THENL - [ASM_SIMP_TAC[FIELD_IMP_INTEGRAL_DOMAIN] THEN - EXPAND_TAC "P" THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN - STRIP_TAC THEN + ANTS_TAC THENL [ASM_SIMP_TAC[FIELD_IMP_INTEGRAL_DOMAIN] THEN + EXPAND_TAC "P" THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN STRIP_TAC THEN MP_TAC(ISPECL [`ring_carrier r:A->bool`; `{x:A | x IN ring_carrier r /\ poly_eval r g x = ring_0 r}`] - CARD_SUBSET) THEN - ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC);; + CARD_SUBSET) THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC);; -(* Helper: irreducible p of degree d divides a^(q^d) - a for ANY polynomial a *) -let IRRED_DIVIDES_POLY_EVAL_MINUS = prove - (`!f:A ring p a. - field f /\ FINITE(ring_carrier f) /\ - p IN ring_carrier(poly_ring f (:1)) /\ - ring_irreducible (poly_ring f (:1)) p /\ - a IN ring_carrier(poly_ring f (:1)) - ==> ring_divides (poly_ring f (:1)) p - (ring_sub (poly_ring f (:1)) - (ring_pow (poly_ring f (:1)) a - (CARD(ring_carrier f) EXP (poly_deg f p))) - a)`, - REPEAT GEN_TAC THEN STRIP_TAC THEN - ABBREV_TAC `R = poly_ring (f:A ring) (:1)` THEN - ABBREV_TAC `J = ideal_generated R {p:(1->num)->A}` THEN - ABBREV_TAC `K = quotient_ring R (J:((1->num)->A)->bool)` THEN - SUBGOAL_THEN `PID (R:((1->num)->A)ring)` ASSUME_TAC THENL - [EXPAND_TAC "R" THEN ASM_MESON_TAC[PID_POLY_RING]; - ALL_TAC] THEN - SUBGOAL_THEN `maximal_ideal R (J:((1->num)->A)->bool) /\ - ring_ideal R (J:((1->num)->A)->bool)` STRIP_ASSUME_TAC THENL - [EXPAND_TAC "J" THEN - ASM_MESON_TAC[RING_IRREDUCIBLE_EQ_MAXIMAL_IDEAL; MAXIMAL_IMP_RING_IDEAL]; - ALL_TAC] THEN - SUBGOAL_THEN - `field (K:(((1->num)->A)->bool) ring) /\ - FINITE(ring_carrier K) /\ - CARD(ring_carrier K) = - CARD(ring_carrier(f:A ring)) EXP (poly_deg f (p:(1->num)->A))` - STRIP_ASSUME_TAC THENL - [MP_TAC(ISPECL [`f:A ring`; `p:(1->num)->A`] QUOTIENT_POLY_RING_FINITE_CARD) - THEN ASM_REWRITE_TAC[]; - ALL_TAC] THEN - SUBGOAL_THEN `ring_homomorphism(R,K) - (ring_coset R (J:((1->num)->A)->bool))` ASSUME_TAC THENL - [EXPAND_TAC "K" THEN ASM_MESON_TAC[RING_HOMOMORPHISM_RING_COSET]; - ALL_TAC] THEN - (* proj(a) IN carrier K *) - SUBGOAL_THEN - `ring_coset R (J:((1->num)->A)->bool) (a:(1->num)->A) IN ring_carrier K` - ASSUME_TAC THENL - [ASM_MESON_TAC[ring_homomorphism; IN_IMAGE; SUBSET]; ALL_TAC] THEN - (* proj(a)^(q^d) = proj(a) by FINITE_FIELD_ELEMENT_POW *) - SUBGOAL_THEN - `ring_pow K - (ring_coset R (J:((1->num)->A)->bool) (a:(1->num)->A)) - (CARD(ring_carrier(f:A ring)) EXP (poly_deg f (p:(1->num)->A))) = - ring_coset R J a` ASSUME_TAC THENL - [SUBGOAL_THEN - `CARD(ring_carrier(f:A ring)) EXP (poly_deg f (p:(1->num)->A)) = - CARD(ring_carrier(K:(((1->num)->A)->bool) ring))` - SUBST1_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN - MP_TAC(ISPEC `K:(((1->num)->A)->bool) ring` FINITE_FIELD_ELEMENT_POW) THEN - ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; - ALL_TAC] THEN - (* proj(a^(q^d) - a) = 0 *) - SUBGOAL_THEN - `ring_coset R (J:((1->num)->A)->bool) - (ring_sub R - (ring_pow R (a:(1->num)->A) - (CARD(ring_carrier(f:A ring)) EXP - (poly_deg f (p:(1->num)->A)))) - a) = - ring_0 (K:(((1->num)->A)->bool) ring)` ASSUME_TAC THENL - [FIRST_ASSUM(fun hom -> MP_TAC(MATCH_MP RING_HOMOMORPHISM_SUB hom)) THEN - DISCH_THEN(fun th -> - MP_TAC(SPECL [`ring_pow R (a:(1->num)->A) - (CARD(ring_carrier(f:A ring)) EXP - (poly_deg f (p:(1->num)->A)))`; - `a:(1->num)->A`] th)) THEN - ASM_SIMP_TAC[RING_POW] THEN DISCH_THEN SUBST1_TAC THEN - FIRST_ASSUM(fun hom -> MP_TAC(MATCH_MP RING_HOMOMORPHISM_POW hom)) THEN - DISCH_THEN(fun th -> - MP_TAC(SPECL [`a:(1->num)->A`; - `CARD(ring_carrier(f:A ring)) EXP - (poly_deg f (p:(1->num)->A))`] th)) THEN - ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN - ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[RING_SUB_REFL]; - ALL_TAC] THEN - (* a^(q^d) - a IN J (kernel of proj) *) - SUBGOAL_THEN - `ring_sub R - (ring_pow R (a:(1->num)->A) - (CARD(ring_carrier(f:A ring)) EXP - (poly_deg f (p:(1->num)->A)))) - a IN J` - ASSUME_TAC THENL - [SUBGOAL_THEN - `ring_kernel(R,K) (ring_coset R (J:((1->num)->A)->bool)) = J` - (SUBST1_TAC o SYM) THENL - [EXPAND_TAC "K" THEN ASM_MESON_TAC[RING_KERNEL_RING_COSET]; ALL_TAC] THEN - REWRITE_TAC[ring_kernel; IN_ELIM_THM] THEN - ASM_MESON_TAC[RING_SUB; RING_POW]; - ALL_TAC] THEN - (* p | a^(q^d) - a from ideal membership *) - MP_TAC(ISPECL [`R:((1->num)->A)ring`; `p:(1->num)->A`; - `ring_sub R - (ring_pow R (a:(1->num)->A) - (CARD(ring_carrier(f:A ring)) EXP - (poly_deg f (p:(1->num)->A)))) - a`] - IN_IDEAL_GENERATED_SING_EQ) THEN - ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN - DISCH_THEN(fun th -> REWRITE_TAC[GSYM th]) THEN - ASM_REWRITE_TAC[]);; +(* Helper: CARD(ring_carrier f) = ring_char(f)^e for some e >= 1 *) +let FINITE_FIELD_CARD_CHAR_POWER = prove + (`!f:A ring. field f /\ FINITE(ring_carrier f) + ==> ?e. ~(e = 0) /\ CARD(ring_carrier f) = ring_char f EXP e`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `prime(ring_char(f:A ring))` ASSUME_TAC THENL + [MATCH_MP_TAC FINITE_INTEGRAL_DOMAIN_CHAR THEN + ASM_SIMP_TAC[FIELD_IMP_INTEGRAL_DOMAIN]; ALL_TAC] THEN + MP_TAC(ISPEC `f:A ring` FINITE_INTEGRAL_DOMAIN_SIZE) THEN + ASM_SIMP_TAC[FIELD_IMP_INTEGRAL_DOMAIN] THEN + DISCH_THEN(X_CHOOSE_THEN `pp:num` + (X_CHOOSE_THEN `ee:num` STRIP_ASSUME_TAC)) THEN + EXISTS_TAC `ee:num` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `(pp:num) = ring_char(f:A ring)` (fun th -> ASM_REWRITE_TAC[th]) THEN + MP_TAC(ISPEC `f:A ring` RING_CHAR_DIVIDES_ORDER) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(fun th -> MP_TAC(MATCH_MP PRIME_DIVEXP + (CONJ (ASSUME `prime(ring_char(f:A ring))`) th))) THEN + ASM_SIMP_TAC[DIVIDES_PRIME_PRIME]);; (* Degree bound: if p | x^(q^n) - x with n >= 1, then deg(p) <= n *) let IRREDUCIBLE_DIVIDES_DEGREE_BOUND = prove - (`!f:A ring p n. - field f /\ FINITE(ring_carrier f) /\ - p IN ring_carrier(poly_ring f (:1)) /\ - ring_irreducible (poly_ring f (:1)) p /\ - ring_divides (poly_ring f (:1)) p - (ring_sub (poly_ring f (:1)) - (ring_pow (poly_ring f (:1)) (poly_var f one) - (CARD(ring_carrier f) EXP n)) - (poly_var f one)) /\ - 1 <= n - ==> poly_deg f p <= n`, - REPEAT GEN_TAC THEN STRIP_TAC THEN + (`!f:A ring p n. field f /\ FINITE(ring_carrier f) /\ + ring_irreducible (poly_ring f (:1)) p /\ ring_divides (poly_ring f (:1)) p + (ring_sub (poly_ring f (:1)) (ring_pow (poly_ring f (:1)) (poly_var f one) + (CARD(ring_carrier f) EXP n)) (poly_var f one)) /\ + 1 <= n ==> poly_deg f p <= n`, REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `(p:(1->num)->A) IN ring_carrier(poly_ring f (:1))` + ASSUME_TAC THENL [ASM_MESON_TAC[ring_irreducible]; ALL_TAC] THEN ABBREV_TAC `R = poly_ring (f:A ring) (:1)` THEN ABBREV_TAC `q = CARD(ring_carrier(f:A ring))` THEN ABBREV_TAC `d = poly_deg f (p:(1->num)->A)` THEN ABBREV_TAC `J = ideal_generated R {p:(1->num)->A}` THEN ABBREV_TAC `K = quotient_ring R (J:((1->num)->A)->bool)` THEN - (* Setup: K is finite field, |K| = q^d *) SUBGOAL_THEN `PID (R:((1->num)->A)ring)` ASSUME_TAC THENL - [EXPAND_TAC "R" THEN ASM_MESON_TAC[PID_POLY_RING]; - ALL_TAC] THEN + [EXPAND_TAC "R" THEN ASM_MESON_TAC[PID_POLY_RING]; ALL_TAC] THEN SUBGOAL_THEN `maximal_ideal R (J:((1->num)->A)->bool) /\ ring_ideal R (J:((1->num)->A)->bool)` STRIP_ASSUME_TAC THENL [EXPAND_TAC "J" THEN ASM_MESON_TAC[RING_IRREDUCIBLE_EQ_MAXIMAL_IDEAL; MAXIMAL_IMP_RING_IDEAL]; - ALL_TAC] THEN - SUBGOAL_THEN - `field (K:(((1->num)->A)->bool) ring) /\ - FINITE(ring_carrier K) /\ + ALL_TAC] THEN SUBGOAL_THEN + `field (K:(((1->num)->A)->bool) ring) /\ FINITE(ring_carrier K) /\ CARD(ring_carrier K) = CARD(ring_carrier(f:A ring)) EXP (poly_deg f (p:(1->num)->A))` STRIP_ASSUME_TAC THENL [MP_TAC(ISPECL [`f:A ring`; `p:(1->num)->A`] QUOTIENT_POLY_RING_FINITE_CARD) - THEN ASM_REWRITE_TAC[]; - ALL_TAC] THEN + THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `CARD(ring_carrier(K:(((1->num)->A)->bool) ring)) = q EXP d` - ASSUME_TAC THENL - [ASM_REWRITE_TAC[]; ALL_TAC] THEN - (* ring_char f is prime *) + ASSUME_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `prime(ring_char(f:A ring))` ASSUME_TAC THENL [MATCH_MP_TAC FINITE_INTEGRAL_DOMAIN_CHAR THEN - ASM_SIMP_TAC[FIELD_IMP_INTEGRAL_DOMAIN]; - ALL_TAC] THEN - (* ring_char K = ring_char f *) + ASM_SIMP_TAC[FIELD_IMP_INTEGRAL_DOMAIN]; ALL_TAC] THEN SUBGOAL_THEN `ring_homomorphism(R,K) (ring_coset R (J:((1->num)->A)->bool))` ASSUME_TAC THENL [EXPAND_TAC "K" THEN ASM_MESON_TAC[RING_HOMOMORPHISM_RING_COSET]; @@ -986,210 +631,142 @@ let IRREDUCIBLE_DIVIDES_DEGREE_BOUND = prove [MP_TAC(ISPECL [`f:A ring`; `(:1)`] RING_MONOMORPHISM_POLY_CONST) THEN EXPAND_TAC "R" THEN DISCH_THEN(fun th -> MP_TAC(MATCH_MP RING_CHAR_MONOMORPHIC_IMAGE th)) THEN - SIMP_TAC[]; - ALL_TAC] THEN + SIMP_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `ring_char(K:(((1->num)->A)->bool) ring) = ring_char(f:A ring)` ASSUME_TAC THENL - [MP_TAC(ISPECL [`R:((1->num)->A)ring`; - `K:(((1->num)->A)->bool) ring`; + [MP_TAC(ISPECL [`R:((1->num)->A)ring`; `K:(((1->num)->A)->bool) ring`; `ring_coset R (J:((1->num)->A)->bool)`] - RING_CHAR_HOMOMORPHIC_IMAGE) THEN - ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + RING_CHAR_HOMOMORPHIC_IMAGE) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MP_TAC(ISPECL [`K:(((1->num)->A)->bool) ring`; `ring_char(f:A ring)`] RING_CHAR_DIVIDES_PRIME) THEN ANTS_TAC THENL [ASM_MESON_TAC[FIELD_IMP_INTEGRAL_DOMAIN]; ALL_TAC] THEN DISCH_THEN(fun th -> REWRITE_TAC[GSYM th]) THEN - ASM_MESON_TAC[]; - ALL_TAC] THEN - (* q = ring_char(f)^e for some e >= 1 *) + ASM_MESON_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `?e. ~(e = 0) /\ q = ring_char(f:A ring) EXP e` STRIP_ASSUME_TAC THENL - [MP_TAC(ISPEC `f:A ring` FINITE_INTEGRAL_DOMAIN_SIZE) THEN - ASM_SIMP_TAC[FIELD_IMP_INTEGRAL_DOMAIN] THEN - DISCH_THEN(X_CHOOSE_THEN `pp:num` - (X_CHOOSE_THEN `ee:num` STRIP_ASSUME_TAC)) THEN - EXISTS_TAC `ee:num` THEN ASM_REWRITE_TAC[] THEN - SUBGOAL_THEN `ring_char(f:A ring) = pp` (fun th -> ASM_REWRITE_TAC[th]) THEN - ASM_MESON_TAC[DIVIDES_PRIME_PRIME; PRIME_DIVEXP; RING_CHAR_DIVIDES_ORDER]; - ALL_TAC] THEN - (* q^n = ring_char(K)^(e*n) *) + [MP_TAC(ISPEC `f:A ring` FINITE_FIELD_CARD_CHAR_POWER) THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `q EXP n = ring_char(K:(((1->num)->A)->bool) ring) EXP (e * n)` - ASSUME_TAC THENL - [ASM_REWRITE_TAC[EXP_EXP]; ALL_TAC] THEN - (* Frobenius y -> y^(q^n) is a ring endomorphism of K *) - ABBREV_TAC `frob = \y:(((1->num)->A)->bool). - ring_pow K y (q EXP n)` THEN + ASSUME_TAC THENL [ASM_REWRITE_TAC[EXP_EXP]; ALL_TAC] THEN + ABBREV_TAC `frob = \y:(((1->num)->A)->bool). ring_pow K y (q EXP n)` THEN SUBGOAL_THEN `ring_endomorphism (K:(((1->num)->A)->bool) ring) frob` - ASSUME_TAC THENL - [SUBGOAL_THEN `frob = (\y:(((1->num)->A)->bool). + ASSUME_TAC THENL [SUBGOAL_THEN `frob = (\y:(((1->num)->A)->bool). ring_pow K y (ring_char K EXP (e * n)))` SUBST1_TAC THENL [EXPAND_TAC "frob" THEN REWRITE_TAC[ASSUME `q EXP n = ring_char(K:(((1->num)->A)->bool) ring) EXP (e * n)`]; - ALL_TAC] THEN - MATCH_MP_TAC RING_ENDOMORPHISM_FROBENIUS_ITERATE THEN - ASM_REWRITE_TAC[]; - ALL_TAC] THEN - (* proj = ring_coset R J; proj is a surjection *) + ALL_TAC] THEN MATCH_MP_TAC RING_ENDOMORPHISM_FROBENIUS_ITERATE THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN ABBREV_TAC `proj = ring_coset R (J:((1->num)->A)->bool)` THEN SUBGOAL_THEN `ring_epimorphism(R,K) (proj:((1->num)->A) -> ((1->num)->A)->bool)` ASSUME_TAC THENL [EXPAND_TAC "K" THEN EXPAND_TAC "proj" THEN MATCH_MP_TAC RING_EPIMORPHISM_RING_COSET THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN - (* frob o proj is a ring homomorphism R -> K *) SUBGOAL_THEN `ring_homomorphism(R,K) ((frob:(((1->num)->A)->bool) -> ((1->num)->A)->bool) o (proj:((1->num)->A) -> ((1->num)->A)->bool))` ASSUME_TAC THENL [REWRITE_TAC[ring_endomorphism] THEN MATCH_MP_TAC RING_HOMOMORPHISM_COMPOSE THEN EXISTS_TAC `K:(((1->num)->A)->bool) ring` THEN - CONJ_TAC THENL - [ASM_MESON_TAC[ring_epimorphism]; ALL_TAC] THEN - ASM_REWRITE_TAC[GSYM ring_endomorphism]; - ALL_TAC] THEN - (* proj is a ring homomorphism R -> K *) + CONJ_TAC THENL [ASM_MESON_TAC[ring_epimorphism]; ALL_TAC] THEN + ASM_REWRITE_TAC[GSYM ring_endomorphism]; ALL_TAC] THEN SUBGOAL_THEN `ring_homomorphism(R,K) (proj:((1->num)->A) -> ((1->num)->A)->bool)` ASSUME_TAC THENL [ASM_MESON_TAC[ring_epimorphism]; ALL_TAC] THEN - (* Agreement on constants: (frob o proj)(poly_const f c) = proj(poly_const f c) *) - SUBGOAL_THEN - `!c:A. c IN ring_carrier f + SUBGOAL_THEN `!c:A. c IN ring_carrier f ==> ((frob:(((1->num)->A)->bool) -> ((1->num)->A)->bool) o - (proj:((1->num)->A) -> ((1->num)->A)->bool)) - (poly_const f c) = + (proj:((1->num)->A) -> ((1->num)->A)->bool)) (poly_const f c) = proj (poly_const f c)` ASSUME_TAC THENL [X_GEN_TAC `c:A` THEN DISCH_TAC THEN REWRITE_TAC[o_THM] THEN - (* Replace frob(proj(pc)) with ring_pow K (proj(pc)) (q^n) *) - SUBGOAL_THEN - `(frob:(((1->num)->A)->bool) -> ((1->num)->A)->bool) + SUBGOAL_THEN `(frob:(((1->num)->A)->bool) -> ((1->num)->A)->bool) ((proj:((1->num)->A) -> ((1->num)->A)->bool) (poly_const (f:A ring) c)) = ring_pow K (proj (poly_const f c)) (q EXP n)` SUBST1_TAC THENL [EXPAND_TAC "frob" THEN REWRITE_TAC[]; ALL_TAC] THEN - (* Now goal: ring_pow K (proj(poly_const f c)) (q^n) = proj(poly_const f c) *) SUBGOAL_THEN `poly_const (f:A ring) c IN ring_carrier (R:((1->num)->A)ring)` ASSUME_TAC THENL [EXPAND_TAC "R" THEN REWRITE_TAC[POLY_CONST] THEN - ASM_REWRITE_TAC[]; - ALL_TAC] THEN - (* proj(poly_const f c)^(q^n) = proj(ring_pow R (poly_const f c) (q^n)) *) + ASM_REWRITE_TAC[]; ALL_TAC] THEN FIRST_ASSUM(fun hom -> MP_TAC(MATCH_MP RING_HOMOMORPHISM_POW hom)) THEN - DISCH_THEN(fun th -> - MP_TAC(SPECL [`(poly_const (f:A ring) c):(1->num)->A`; + DISCH_THEN(fun th -> MP_TAC(SPECL [`(poly_const (f:A ring) c):(1->num)->A`; `q EXP n`] th)) THEN REWRITE_TAC[ASSUME `poly_const (f:A ring) c IN ring_carrier (R:((1->num)->A)ring)`] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN - (* ring_pow R (poly_const f c) (q^n) = poly_const f (ring_pow f c (q^n)) *) MP_TAC(ISPECL [`f:A ring`; `(:1)`] RING_HOMOMORPHISM_POLY_CONST) THEN EXPAND_TAC "R" THEN DISCH_THEN(fun hom -> MP_TAC(MATCH_MP RING_HOMOMORPHISM_POW hom)) THEN DISCH_THEN(fun th -> MP_TAC(SPECL [`c:A`; `q EXP n`] th)) THEN REWRITE_TAC[ASSUME `(c:A) IN ring_carrier (f:A ring)`] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN - (* c^(q^n) = c by FINITE_FIELD_POW_ITERATE *) AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM(ASSUME `CARD(ring_carrier(f:A ring)) = q`)] THEN - MATCH_MP_TAC FINITE_FIELD_POW_ITERATE THEN - ASM_REWRITE_TAC[]; - ALL_TAC] THEN - (* Agreement on variable: (frob o proj)(poly_var f one) = proj(poly_var f one) *) - SUBGOAL_THEN - `((frob:(((1->num)->A)->bool) -> ((1->num)->A)->bool) o + MATCH_MP_TAC FINITE_FIELD_POW_ITERATE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `((frob:(((1->num)->A)->bool) -> ((1->num)->A)->bool) o (proj:((1->num)->A) -> ((1->num)->A)->bool)) (poly_var (f:A ring) one) = proj (poly_var f one)` ASSUME_TAC THENL [REWRITE_TAC[o_THM] THEN - (* Replace frob(proj(v)) with ring_pow K (proj v) (q^n) *) - SUBGOAL_THEN - `(frob:(((1->num)->A)->bool) -> ((1->num)->A)->bool) + SUBGOAL_THEN `(frob:(((1->num)->A)->bool) -> ((1->num)->A)->bool) ((proj:((1->num)->A) -> ((1->num)->A)->bool) (poly_var (f:A ring) one)) = ring_pow K (proj (poly_var f one)) (q EXP n)` SUBST1_TAC THENL [EXPAND_TAC "frob" THEN REWRITE_TAC[]; ALL_TAC] THEN - (* Goal: ring_pow K (proj v) (q^n) = proj v *) SUBGOAL_THEN `poly_var (f:A ring) one IN ring_carrier (R:((1->num)->A)ring)` ASSUME_TAC THENL [EXPAND_TAC "R" THEN REWRITE_TAC[POLY_VAR_UNIV]; ALL_TAC] THEN - (* proj(ring_pow R v (q^n)) = ring_pow K (proj v) (q^n) by homomorphism *) FIRST_ASSUM(fun hom -> MP_TAC(MATCH_MP RING_HOMOMORPHISM_POW hom)) THEN DISCH_THEN(fun th -> MP_TAC(SPECL [`poly_var (f:A ring) one`; `q EXP n`] th)) THEN REWRITE_TAC[ASSUME `poly_var (f:A ring) one IN ring_carrier (R:((1->num)->A)ring)`] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN - (* Goal: proj(ring_pow R v (q^n)) = proj v *) EXPAND_TAC "proj" THEN - (* Goal: ring_coset R J (ring_pow R v (q^n)) = ring_coset R J v *) - MP_TAC(ISPECL [`R:((1->num)->A)ring`; - `J:((1->num)->A)->bool`; + MP_TAC(ISPECL [`R:((1->num)->A)ring`; `J:((1->num)->A)->bool`; `ring_pow (R:((1->num)->A)ring) (poly_var (f:A ring) one) (q EXP n)`; `poly_var (f:A ring) one`] RING_COSET_EQ) THEN - ANTS_TAC THENL - [ASM_SIMP_TAC[RING_POW]; ALL_TAC] THEN + ANTS_TAC THENL [ASM_SIMP_TAC[RING_POW]; ALL_TAC] THEN DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN - (* Goal: ring_sub R (ring_pow R v (q^n)) v IN J *) - EXPAND_TAC "J" THEN - MATCH_MP_TAC IN_IDEAL_GENERATED_SING THEN - ASM_MESON_TAC[]; - ALL_TAC] THEN - (* Step 1: frob o proj = proj on all of R *) - MP_TAC(ISPECL [ - `(frob:(((1->num)->A)->bool) -> ((1->num)->A)->bool) o + EXPAND_TAC "J" THEN MATCH_MP_TAC IN_IDEAL_GENERATED_SING THEN + ASM_MESON_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL [ `(frob:(((1->num)->A)->bool) -> ((1->num)->A)->bool) o (proj:((1->num)->A) -> ((1->num)->A)->bool)`; - `proj:((1->num)->A) -> ((1->num)->A)->bool`; - `f:A ring`; - `(:1)`; - `K:(((1->num)->A)->bool) ring` + `proj:((1->num)->A) -> ((1->num)->A)->bool`; `f:A ring`; + `(:1)`; `K:(((1->num)->A)->bool) ring` ] RING_HOMOMORPHISMS_EQ_FROM_POLY_RING) THEN - REWRITE_TAC[ASSUME `poly_ring (f:A ring) (:1) = R`] THEN - ANTS_TAC THENL + REWRITE_TAC[ASSUME `poly_ring (f:A ring) (:1) = R`] THEN ANTS_TAC THENL [ASM_REWRITE_TAC[UNIV_1; FORALL_IN_INSERT; NOT_IN_EMPTY]; ALL_TAC] THEN DISCH_TAC THEN - (* Step 2: every element of K satisfies y^(q^n) = y *) - SUBGOAL_THEN - `!y:(((1->num)->A)->bool). y IN ring_carrier K + SUBGOAL_THEN `!y:(((1->num)->A)->bool). y IN ring_carrier K ==> ring_pow K y (q EXP n) = y` ASSUME_TAC THENL [X_GEN_TAC `y:(((1->num)->A)->bool)` THEN DISCH_TAC THEN SUBGOAL_THEN `?x:(1->num)->A. x IN ring_carrier R /\ - (proj:((1->num)->A) -> ((1->num)->A)->bool) x = y` - STRIP_ASSUME_TAC THENL + (proj:((1->num)->A) -> ((1->num)->A)->bool) x = y` STRIP_ASSUME_TAC THENL [MP_TAC(ASSUME `ring_epimorphism (R:((1->num)->A)ring, K:(((1->num)->A)->bool) ring) (proj:((1->num)->A) -> ((1->num)->A)->bool)`) THEN - REWRITE_TAC[ring_epimorphism] THEN ASM SET_TAC[]; - ALL_TAC] THEN - FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN - SUBGOAL_THEN + REWRITE_TAC[ring_epimorphism] THEN ASM SET_TAC[]; ALL_TAC] THEN + FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN SUBGOAL_THEN `ring_pow K ((proj:((1->num)->A) -> ((1->num)->A)->bool) (x:(1->num)->A)) (q EXP n) = ((frob:(((1->num)->A)->bool) -> ((1->num)->A)->bool) o proj) x` - SUBST1_TAC THENL - [EXPAND_TAC "frob" THEN REWRITE_TAC[o_THM]; ALL_TAC] THEN - FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; - ALL_TAC] THEN - (* Step 3: 2 <= q *) + SUBST1_TAC THENL [EXPAND_TAC "frob" THEN REWRITE_TAC[o_THM]; ALL_TAC] THEN + FIRST_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `2 <= q` ASSUME_TAC THENL [SUBGOAL_THEN `2 <= ring_char(f:A ring)` ASSUME_TAC THENL [ASM_MESON_TAC[PRIME_GE_2]; ALL_TAC] THEN MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `ring_char(f:A ring) EXP 1` THEN - CONJ_TAC THENL - [REWRITE_TAC[EXP_1] THEN ASM_ARITH_TAC; + CONJ_TAC THENL [REWRITE_TAC[EXP_1] THEN ASM_ARITH_TAC; REWRITE_TAC[ASSUME `q = ring_char(f:A ring) EXP e`; LE_EXP] THEN - COND_CASES_TAC THEN ASM_ARITH_TAC]; - ALL_TAC] THEN - (* Step 4: CARD K <= q^n *) + COND_CASES_TAC THEN ASM_ARITH_TAC]; ALL_TAC] THEN SUBGOAL_THEN `2 <= q EXP n` ASSUME_TAC THENL [MATCH_MP_TAC LE_TRANS THEN EXISTS_TAC `q EXP 1` THEN REWRITE_TAC[EXP_1; LE_EXP] THEN CONJ_TAC THENL [ASM_ARITH_TAC; COND_CASES_TAC THEN ASM_ARITH_TAC]; ALL_TAC] THEN SUBGOAL_THEN `CARD(ring_carrier(K:(((1->num)->A)->bool) ring)) <= q EXP n` - ASSUME_TAC THENL - [MP_TAC(ISPECL [`K:(((1->num)->A)->bool) ring`; `q EXP n`] - FIELD_ROOTS_BOUND) THEN - ASM_REWRITE_TAC[]; - ALL_TAC] THEN - (* Step 5: q^d <= q^n implies d <= n *) + ASSUME_TAC THENL [MP_TAC(ISPECL [`K:(((1->num)->A)->bool) ring`; `q EXP n`] + FIELD_ROOTS_BOUND) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `q EXP d <= q EXP n` MP_TAC THENL - [ASM_MESON_TAC[]; ALL_TAC] THEN - REWRITE_TAC[LE_EXP] THEN + [ASM_MESON_TAC[]; ALL_TAC] THEN REWRITE_TAC[LE_EXP] THEN COND_CASES_TAC THEN ASM_ARITH_TAC);; + + (* Converse: if p is monic irreducible of degree d over GF(q) and p divides x^(q^n) - x, then d divides n. Proof: Write n = k*d + r with 0 <= r < d. Show p | x^(q^(k*d))-x @@ -1198,29 +775,18 @@ let IRREDUCIBLE_DIVIDES_DEGREE_BOUND = prove p | x^(q^r)-x. If r > 0, IRREDUCIBLE_DIVIDES_DEGREE_BOUND gives d <= r < d, contradiction. So r = 0 and d | n. *) let IRREDUCIBLE_DIVIDES_DEGREE = prove - (`!f:A ring p n. - field f /\ FINITE(ring_carrier f) /\ - p IN ring_carrier(poly_ring f (:1)) /\ - ring_irreducible (poly_ring f (:1)) p /\ - ring_divides (poly_ring f (:1)) p - (ring_sub (poly_ring f (:1)) - (ring_pow (poly_ring f (:1)) (poly_var f one) - (CARD(ring_carrier f) EXP n)) - (poly_var f one)) - ==> (poly_deg f p) divides n`, - REPEAT GEN_TAC THEN STRIP_TAC THEN + (`!f:A ring p n. field f /\ FINITE(ring_carrier f) /\ + ring_irreducible (poly_ring f (:1)) p /\ ring_divides (poly_ring f (:1)) p + (ring_sub (poly_ring f (:1)) (ring_pow (poly_ring f (:1)) (poly_var f one) + (CARD(ring_carrier f) EXP n)) (poly_var f one)) + ==> (poly_deg f p) divides n`, REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `(p:(1->num)->A) IN ring_carrier(poly_ring f (:1))` + ASSUME_TAC THENL [ASM_MESON_TAC[ring_irreducible]; ALL_TAC] THEN ABBREV_TAC `R = poly_ring (f:A ring) (:1)` THEN ABBREV_TAC `q = CARD(ring_carrier(f:A ring))` THEN ABBREV_TAC `d = poly_deg (f:A ring) (p:(1->num)->A)` THEN ABBREV_TAC `x = poly_var (f:A ring) one` THEN - (* Note: ABBREV_TAC modifies both goal AND existing assumptions. - So assumptions from STRIP_TAC are now in abbreviated form: - p IN ring_carrier R, ring_irreducible R p, - ring_divides R p (ring_sub R (ring_pow R x (q EXP n)) x) *) - (* Case n = 0 *) - ASM_CASES_TAC `n = 0` THENL - [ASM_REWRITE_TAC[DIVIDES_0]; ALL_TAC] THEN - (* d >= 1: irreducible polynomials have degree >= 1 *) + ASM_CASES_TAC `n = 0` THENL [ASM_REWRITE_TAC[DIVIDES_0]; ALL_TAC] THEN SUBGOAL_THEN `1 <= d` ASSUME_TAC THENL [EXPAND_TAC "d" THEN MP_TAC(ISPECL [`f:A ring`; `p:(1->num)->A`; `(:1)`] POLY_NONUNIT_DEGREE_GE_1) THEN @@ -1228,85 +794,56 @@ let IRREDUCIBLE_DIVIDES_DEGREE = prove [ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[ring_irreducible]; REWRITE_TAC[]]; ALL_TAC] THEN - (* x IN ring_carrier R *) SUBGOAL_THEN `(x:(1->num)->A) IN ring_carrier R` ASSUME_TAC THENL [EXPAND_TAC "x" THEN EXPAND_TAC "R" THEN - REWRITE_TAC[POLY_VAR_UNIV]; - ALL_TAC] THEN - (* integral_domain R *) + REWRITE_TAC[POLY_VAR_UNIV]; ALL_TAC] THEN SUBGOAL_THEN `integral_domain (R:((1->num)->A)ring)` ASSUME_TAC THENL [EXPAND_TAC "R" THEN ASM_MESON_TAC[INTEGRAL_DOMAIN_POLY_RING; FIELD_IMP_INTEGRAL_DOMAIN]; ALL_TAC] THEN - (* ~(q = 0) *) SUBGOAL_THEN `~(q = 0)` ASSUME_TAC THENL [EXPAND_TAC "q" THEN ASM_MESON_TAC[CARD_EQ_0; RING_CARRIER_NONEMPTY]; ALL_TAC] THEN - (* p | x^(q^d) - x by IRREDUCIBLE_DIVIDES_XQ_MINUS_X *) SUBGOAL_THEN `ring_divides R (p:(1->num)->A) (ring_sub R (ring_pow R x (q EXP d)) x)` ASSUME_TAC THENL [MP_TAC(ISPECL [`f:A ring`; `p:(1->num)->A`] - IRREDUCIBLE_DIVIDES_XQ_MINUS_X) THEN - ASM_REWRITE_TAC[]; - ALL_TAC] THEN - (* Division: n = k*d + r, r < d *) - ABBREV_TAC `k = n DIV d` THEN - ABBREV_TAC `r = n MOD d` THEN + IRREDUCIBLE_DIVIDES_XQ_MINUS_X) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + ABBREV_TAC `k = n DIV d` THEN ABBREV_TAC `r = n MOD d` THEN SUBGOAL_THEN `n = k * d + r` ASSUME_TAC THENL [MAP_EVERY EXPAND_TAC ["k"; "r"] THEN - MESON_TAC[DIVISION_SIMP; ADD_SYM]; - ALL_TAC] THEN + MESON_TAC[DIVISION_SIMP; ADD_SYM]; ALL_TAC] THEN SUBGOAL_THEN `r < d` ASSUME_TAC THENL - [EXPAND_TAC "r" THEN REWRITE_TAC[MOD_LT_EQ] THEN ASM_ARITH_TAC; - ALL_TAC] THEN - (* p | x^(q^(k*d)) - x via IRREDUCIBLE_DIVIDES_XQ_MINUS_X_GEN *) + [EXPAND_TAC "r" THEN REWRITE_TAC[MOD_LT_EQ] THEN ASM_ARITH_TAC; ALL_TAC] THEN SUBGOAL_THEN `ring_divides R (p:(1->num)->A) (ring_sub R (ring_pow R x (q EXP (k * d))) x)` ASSUME_TAC THENL [MP_TAC(ISPECL [`f:A ring`; `p:(1->num)->A`; `k * d`] - IRREDUCIBLE_DIVIDES_XQ_MINUS_X_GEN) THEN - ASM_REWRITE_TAC[] THEN + IRREDUCIBLE_DIVIDES_XQ_MINUS_X_GEN) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN - REWRITE_TAC[divides] THEN EXISTS_TAC `k:num` THEN ARITH_TAC; - ALL_TAC] THEN - (* Let u = x^(q^(k*d)). ABBREV_TAC modifies the ring_divides assumption - about x^(q^(k*d)) to use u, giving p | (u - x) automatically. *) + REWRITE_TAC[divides] THEN EXISTS_TAC `k:num` THEN ARITH_TAC; ALL_TAC] THEN ABBREV_TAC `u = ring_pow R (x:(1->num)->A) (q EXP (k * d))` THEN - (* u IN ring_carrier R *) SUBGOAL_THEN `(u:(1->num)->A) IN ring_carrier R` ASSUME_TAC THENL [EXPAND_TAC "u" THEN MATCH_MP_TAC RING_POW THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN - (* p | u^(q^r) - x: prove u^(q^r) = x^(q^n), then use original hyp *) SUBGOAL_THEN `ring_divides R (p:(1->num)->A) (ring_sub R (ring_pow R u (q EXP r)) x)` ASSUME_TAC THENL [SUBGOAL_THEN `ring_pow R (u:(1->num)->A) (q EXP r) = - ring_pow R x (q EXP n)` SUBST1_TAC THENL - [EXPAND_TAC "u" THEN + ring_pow R x (q EXP n)` SUBST1_TAC THENL [EXPAND_TAC "u" THEN MP_TAC(ISPECL [`R:((1->num)->A)ring`; `x:(1->num)->A`; `q EXP (k * d)`; `q EXP r`] RING_POW_POW) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN - DISCH_THEN SUBST1_TAC THEN - AP_TERM_TAC THEN REWRITE_TAC[GSYM EXP_ADD] THEN - AP_TERM_TAC THEN ASM_ARITH_TAC; - FIRST_ASSUM ACCEPT_TAC]; - ALL_TAC] THEN - (* ~(q EXP r = 0) *) + DISCH_THEN SUBST1_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[GSYM EXP_ADD] THEN + AP_TERM_TAC THEN ASM_ARITH_TAC; FIRST_ASSUM ACCEPT_TAC]; ALL_TAC] THEN SUBGOAL_THEN `~(q EXP r = 0)` ASSUME_TAC THENL [ASM_REWRITE_TAC[EXP_EQ_0]; ALL_TAC] THEN - (* p | x^(q^r) - x via RING_DIVIDES_REDUCE *) SUBGOAL_THEN `ring_divides R (p:(1->num)->A) (ring_sub R (ring_pow R x (q EXP r)) x)` ASSUME_TAC THENL [MP_TAC(ISPECL [`R:((1->num)->A)ring`; `p:(1->num)->A`; `u:(1->num)->A`; `x:(1->num)->A`; `q EXP r`] - RING_DIVIDES_REDUCE) THEN - ASM_REWRITE_TAC[]; - ALL_TAC] THEN - (* Case split on r *) + RING_DIVIDES_REDUCE) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN ASM_CASES_TAC `r = 0` THENL [REWRITE_TAC[divides] THEN EXISTS_TAC `k:num` THEN ASM_ARITH_TAC; ALL_TAC] THEN - (* r >= 1: IRREDUCIBLE_DIVIDES_DEGREE_BOUND gives d <= r, contradicting - r < d *) - MP_TAC(ISPECL [`f:A ring`; `p:(1->num)->A`; `r:num`] + MP_TAC(ISPECL [`f:A ring`; `p:(1->num)->A`; `r:num`] IRREDUCIBLE_DIVIDES_DEGREE_BOUND) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; ALL_TAC] THEN ASM_ARITH_TAC);; @@ -1362,14 +899,12 @@ let RABIN_IRREDUCIBILITY_NECESSARY = prove MP_TAC(SPECL [`k:num`; `q:num`] MULT_EQ_1) THEN ASM_ARITH_TAC) in REPEAT GEN_TAC THEN STRIP_TAC THEN CONJ_TAC THENL - [(* Part 1: p divides x^(q^n) - x, from IRREDUCIBLE_DIVIDES_XQ_MINUS_X *) + [ MP_TAC(ISPECL [`f:A ring`; `p:(1->num)->A`] IRREDUCIBLE_DIVIDES_XQ_MINUS_X) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN - (* Part 2: coprimality for each prime divisor of n *) X_GEN_TAC `q':num` THEN STRIP_TAC THEN - (* By RING_IRREDUCIBLE_DIVIDES_OR_COPRIME: divides or coprime *) MP_TAC(ISPECL [`poly_ring (f:A ring) (:1)`; `p:(1->num)->A`; `ring_sub (poly_ring (f:A ring) (:1)) @@ -1385,15 +920,13 @@ let RABIN_IRREDUCIBILITY_NECESSARY = prove REWRITE_TAC[POLY_VAR_UNIV]; ALL_TAC] THEN DISCH_THEN(DISJ_CASES_TAC) THENL - [(* Case: p divides x^(q^(n/q')) - x -- derive contradiction *) - (* By IRREDUCIBLE_DIVIDES_DEGREE: n divides (n DIV q') *) + [ MP_TAC(ISPECL [`f:A ring`; `p:(1->num)->A`; `n DIV q'`] IRREDUCIBLE_DIVIDES_DEGREE) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN MP_TAC(SPECL [`n:num`; `q':num`] DIVIDES_DIV_PRIME_ABSURD) THEN ASM_REWRITE_TAC[]; - (* Case: coprime -- this is the goal *) ASM_REWRITE_TAC[]]);; (* Rabin's Test - backward direction: conditions imply irreducible *) @@ -1441,12 +974,10 @@ let RABIN_IRREDUCIBILITY_SUFFICIENT = prove ASM_MESON_TAC[MULT_SYM]) in REPEAT GEN_TAC THEN STRIP_TAC THEN ABBREV_TAC `R = poly_ring (f:A ring) (:1)` THEN - (* Step 1: integral_domain R *) SUBGOAL_THEN `integral_domain (R:((1->num)->A)ring)` ASSUME_TAC THENL [EXPAND_TAC "R" THEN ASM_MESON_TAC[INTEGRAL_DOMAIN_POLY_RING; FIELD_IMP_INTEGRAL_DOMAIN]; ALL_TAC] THEN - (* Step 2: p is not a unit (units have degree 0, but deg p = n > 0) *) SUBGOAL_THEN `~(ring_unit R (p:(1->num)->A))` ASSUME_TAC THENL [DISCH_TAC THEN MP_TAC(ISPECL [`f:A ring`; `(:1)`; `p:(1->num)->A`] @@ -1456,9 +987,7 @@ let RABIN_IRREDUCIBILITY_SUFFICIENT = prove DISCH_THEN(X_CHOOSE_THEN `c:A` STRIP_ASSUME_TAC) THEN ASM_MESON_TAC[POLY_DEG_CONST]; ALL_TAC] THEN - (* Step 3: proof by contradiction *) MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN - (* Step 4: extract non-trivial factorization from ~irreducible *) SUBGOAL_THEN `?a b:(1->num)->A. a IN ring_carrier R /\ b IN ring_carrier R /\ @@ -1474,11 +1003,9 @@ let RABIN_IRREDUCIBILITY_SUFFICIENT = prove [`a:(1->num)->A`; `b:(1->num)->A`] THEN ASM_REWRITE_TAC[GSYM POLY_RING_CLAUSES]; ALL_TAC] THEN - (* Step 5: a and b are nonzero *) SUBGOAL_THEN `~(a:(1->num)->A = ring_0 R) /\ ~(b:(1->num)->A = ring_0 R)` STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[RING_MUL_LZERO; RING_MUL_RZERO]; ALL_TAC] THEN - (* Step 6: deg(a) + deg(b) = n *) SUBGOAL_THEN `ring_polynomial f (a:(1->num)->A) /\ ring_polynomial f (b:(1->num)->A)` STRIP_ASSUME_TAC THENL [CONJ_TAC THENL @@ -1502,7 +1029,6 @@ let RABIN_IRREDUCIBILITY_SUFFICIENT = prove [ASM_MESON_TAC[POLY_RING_CLAUSES]; ALL_TAC] THEN ASM_MESON_TAC[]; ALL_TAC] THEN - (* Step 7: deg(a) >= 1 and deg(b) >= 1 *) SUBGOAL_THEN `1 <= poly_deg f (a:(1->num)->A) /\ 1 <= poly_deg f (b:(1->num)->A)` STRIP_ASSUME_TAC THENL [CONJ_TAC THENL @@ -1513,7 +1039,6 @@ let RABIN_IRREDUCIBILITY_SUFFICIENT = prove ALL_TAC] THEN SUBGOAL_THEN `poly_deg f (a:(1->num)->A) < n` ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN - (* Step 8: a has an irreducible factor g *) SUBGOAL_THEN `UFD (R:((1->num)->A)ring)` ASSUME_TAC THENL [EXPAND_TAC "R" THEN ASM_MESON_TAC[PID_IMP_UFD; PID_POLY_RING]; ALL_TAC] THEN @@ -1521,14 +1046,12 @@ let RABIN_IRREDUCIBILITY_SUFFICIENT = prove NOETHERIAN_DOMAIN_IRREDUCIBLE_FACTOR_EXISTS) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; ALL_TAC] THEN DISCH_THEN(X_CHOOSE_THEN `g:(1->num)->A` STRIP_ASSUME_TAC) THEN - (* Step 9: g | a | p, so g | p *) SUBGOAL_THEN `ring_divides R (g:(1->num)->A) p` ASSUME_TAC THENL [MATCH_MP_TAC RING_DIVIDES_TRANS THEN EXISTS_TAC `a:(1->num)->A` THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ring_divides] THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `b:(1->num)->A` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN - (* Step 10: g | x^(q^n) - x via transitivity *) SUBGOAL_THEN `ring_divides R (g:(1->num)->A) (ring_sub R (ring_pow R (poly_var f one) (CARD(ring_carrier f) EXP n)) (poly_var f one))` @@ -1536,7 +1059,6 @@ let RABIN_IRREDUCIBILITY_SUFFICIENT = prove [MATCH_MP_TAC RING_DIVIDES_TRANS THEN EXISTS_TAC `p:(1->num)->A` THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[POLY_RING_CLAUSES]; ALL_TAC] THEN - (* Step 11: deg(g) | n by IRREDUCIBLE_DIVIDES_DEGREE *) SUBGOAL_THEN `g:(1->num)->A IN ring_carrier R` ASSUME_TAC THENL [ASM_MESON_TAC[ring_irreducible]; ALL_TAC] THEN SUBGOAL_THEN `(poly_deg f (g:(1->num)->A)) divides n` ASSUME_TAC THENL @@ -1545,14 +1067,12 @@ let RABIN_IRREDUCIBILITY_SUFFICIENT = prove ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_MESON_TAC[POLY_RING_CLAUSES]; ALL_TAC] THEN - (* Step 12: deg(g) >= 1 (g is irreducible, hence nonzero non-unit) *) SUBGOAL_THEN `1 <= poly_deg f (g:(1->num)->A)` ASSUME_TAC THENL [MP_TAC(ISPECL [`f:A ring`; `g:(1->num)->A`; `(:1)`] POLY_NONUNIT_DEGREE_GE_1) THEN ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[ring_irreducible; POLY_RING_CLAUSES]; SIMP_TAC[]]; ALL_TAC] THEN - (* Step 13: deg(g) <= deg(a) < n, so deg(g) < n *) SUBGOAL_THEN `poly_deg f (g:(1->num)->A) <= poly_deg f (a:(1->num)->A)` ASSUME_TAC THENL [UNDISCH_TAC `ring_divides R (g:(1->num)->A) (a:(1->num)->A)` THEN REWRITE_TAC[ring_divides] THEN @@ -1584,12 +1104,10 @@ let RABIN_IRREDUCIBILITY_SUFFICIENT = prove ALL_TAC] THEN SUBGOAL_THEN `poly_deg f (g:(1->num)->A) < n` ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN - (* Step 14: number theory: find prime l | n with deg(g) | (n DIV l) *) MP_TAC(SPECL [`poly_deg f (g:(1->num)->A)`; `n:num`] PROPER_DIVISOR_PRIME_FACTOR) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `l:num` STRIP_ASSUME_TAC) THEN - (* Step 15: g | x^(q^(n/l)) - x by IRREDUCIBLE_DIVIDES_XQ_MINUS_X_GEN *) SUBGOAL_THEN `ring_divides R (g:(1->num)->A) (ring_sub R (ring_pow R (poly_var f one) (CARD(ring_carrier f) EXP (n DIV l))) (poly_var f one))` @@ -1599,7 +1117,6 @@ let RABIN_IRREDUCIBILITY_SUFFICIENT = prove ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_MESON_TAC[POLY_RING_CLAUSES]; ALL_TAC] THEN - (* Step 16: coprimality gives g is a unit *) SUBGOAL_THEN `ring_unit R (g:(1->num)->A)` MP_TAC THENL [FIRST_X_ASSUM(MP_TAC o SPEC `l:num`) THEN ASM_REWRITE_TAC[] THEN REWRITE_TAC[ring_coprime] THEN @@ -1608,7 +1125,6 @@ let RABIN_IRREDUCIBILITY_SUFFICIENT = prove ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_MESON_TAC[POLY_RING_CLAUSES]; ALL_TAC] THEN - (* Step 17: contradiction - g is irreducible hence not a unit *) ASM_MESON_TAC[ring_irreducible]);; (* Combined Rabin's Test *) @@ -1632,12 +1148,11 @@ let RABIN_IRREDUCIBILITY_TEST = prove (CARD(ring_carrier f) EXP (n DIV q))) (poly_var f one)))`, REPEAT GEN_TAC THEN STRIP_TAC THEN EQ_TAC THENL - [(* Forward: irreducible ==> conditions *) + [ DISCH_TAC THEN MP_TAC(ISPECL [`f:A ring`; `p:(1->num)->A`; `n:num`] RABIN_IRREDUCIBILITY_NECESSARY) THEN ASM_REWRITE_TAC[]; - (* Backward: conditions ==> irreducible *) STRIP_TAC THEN MP_TAC(ISPECL [`f:A ring`; `p:(1->num)->A`; `n:num`] RABIN_IRREDUCIBILITY_SUFFICIENT) THEN diff --git a/Library/ringtheory.ml b/Library/ringtheory.ml index 3c8ba4bb..92b2394d 100644 --- a/Library/ringtheory.ml +++ b/Library/ringtheory.ml @@ -405,6 +405,13 @@ let RING_SUB_TELESCOPE = prove ASM_SIMP_TAC[RING_ADD_ASSOC; RING_NEG; RING_ADD] THEN ASM_SIMP_TAC[RING_ADD_LNEG; RING_ADD_LZERO; RING_NEG]);; +let RING_NEG_SUB = prove + (`!r x y:A. + x IN ring_carrier r /\ y IN ring_carrier r + ==> ring_neg r (ring_sub r x y) = ring_sub r y x`, + SIMP_TAC[ring_sub; RING_NEG_ADD; RING_NEG; RING_NEG_NEG] THEN + MESON_TAC[RING_ADD_SYM; RING_NEG]);; + let RING_CARRIER_NONEMPTY = prove (`!r:A ring. ~(ring_carrier r = {})`, MESON_TAC[MEMBER_NOT_EMPTY; RING_0]);; @@ -618,22 +625,10 @@ let RING_OF_INT_SUB = prove let RING_OF_NUM_EQ_0 = let eth = prove (`!r:A ring. ?p. !n. ring_of_num r n = ring_0 r <=> p divides n`, - GEN_TAC THEN MATCH_MP_TAC(MESON[] - `(~P 0 ==> ?n. ~(n = 0) /\ P n) ==> ?n. P n`) THEN - REWRITE_TAC[NUMBER_RULE `0 divides n <=> n = 0`] THEN - SIMP_TAC[NOT_FORALL_THM; RING_OF_NUM_0; TAUT - `~(p <=> q) <=> ~q /\ p \/ ~(q ==> p)`] THEN - GEN_REWRITE_TAC LAND_CONV [num_WOP] THEN - MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `p:num` THEN - REWRITE_TAC[TAUT `p ==> ~(q /\ r) <=> q /\ p ==> ~r`] THEN STRIP_TAC THEN - ASM_REWRITE_TAC[] THEN X_GEN_TAC `m:num` THEN EQ_TAC THEN - SIMP_TAC[divides; LEFT_IMP_EXISTS_THM; RING_OF_NUM_MUL] THEN - ASM_SIMP_TAC[RING_MUL_LZERO; RING_OF_NUM] THEN - SUBST1_TAC(SYM(SPECL [`m:num`; `p:num`] (CONJUNCT2 DIVISION_SIMP))) THEN - ASM_SIMP_TAC[RING_OF_NUM_ADD; RING_OF_NUM_MUL; RING_MUL_LZERO; - RING_OF_NUM; RING_ADD_LZERO] THEN - DISCH_TAC THEN EXISTS_TAC `m DIV p` THEN REWRITE_TAC[EQ_ADD_LCANCEL_0] THEN - ASM_MESON_TAC[DIVISION]) in + GEN_TAC THEN MP_TAC(ISPECL [`\x:A. x = ring_0 r`; `\n. ring_of_num r n:A`] + ORDER_EXISTENCE_GEN) THEN + REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + SIMP_TAC[ring_of_num; RING_OF_NUM_ADD; RING_ADD_LZERO; RING_OF_NUM]) in new_specification ["ring_char"] (REWRITE_RULE[SKOLEM_THM] eth);; let RING_CHAR_EQ_0 = prove @@ -1307,6 +1302,17 @@ let RING_SUM_OFFSET = prove MATCH_MP_TAC(REWRITE_RULE[o_DEF] RING_SUM_IMAGE) THEN SIMP_TAC[EQ_ADD_RCANCEL]);; +let RING_SUM_CONST = prove + (`!(r:A ring) (c:A) (s:B->bool). + FINITE s /\ c IN ring_carrier r + ==> ring_sum r s (\i. c) = ring_mul r (ring_of_num r (CARD s)) c`, + REWRITE_TAC[IMP_CONJ_ALT; RIGHT_FORALL_IMP_THM] THEN + REPEAT GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + ASM_SIMP_TAC[RING_SUM_CLAUSES; CARD_CLAUSES; RING_OF_NUM_0; RING_MUL_LZERO; + ADD1; RING_OF_NUM_ADD; RING_OF_NUM_1] THEN + ASM_SIMP_TAC[RING_ADD_RDISTRIB; RING_OF_NUM; RING_1; RING_MUL_LID] THEN + ASM_MESON_TAC[RING_ADD_SYM; RING_MUL; RING_OF_NUM]);; + let RING_SUM_IMAGE_GEN = prove (`!r (f:K->B) (g:K->A) s. FINITE s @@ -1398,6 +1404,84 @@ let RING_BINOMIAL_FRESHMAN = prove DISCH_THEN SUBST1_TAC THEN ASM_SIMP_TAC[RING_ADD_RZERO; RING_POW] THEN MATCH_MP_TAC RING_ADD_SYM THEN ASM_SIMP_TAC[RING_POW]]);; +let RING_SUM_DIFFS = prove + (`!r (f:num->A) m n. + (!i. m <= i /\ i <= n + 1 ==> f i IN ring_carrier r) + ==> ring_sum r (m..n) (\k. ring_sub r (f k) (f(k + 1))) = + if m <= n then ring_sub r (f m) (f(n + 1)) else ring_0 r`, + let lemma = prove + (`!r (f:num->A) n. + (!i. i <= n + 1 ==> f i IN ring_carrier r) + ==> ring_sum r (0..n) (\k. ring_sub r (f k) (f(SUC k))) = + ring_sub r (f 0) (f(SUC n))`, + GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[GSYM ADD1] THEN INDUCT_TAC THENL + [SIMP_TAC[ARITH; NUMSEG_CLAUSES; RING_SUM_SING; RING_SUB]; + REWRITE_TAC[RING_SUM_CLAUSES_NUMSEG; LE_0] THEN + SIMP_TAC[RING_SUB; LE_REFL; ARITH_RULE `n <= SUC n`] THEN + DISCH_TAC THEN ASM_SIMP_TAC[ARITH_RULE `i <= n ==> i <= SUC n`] THEN + MATCH_MP_TAC RING_SUB_TELESCOPE THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ARITH_TAC]) in + REPEAT STRIP_TAC THEN COND_CASES_TAC THENL + [ALL_TAC; ASM_MESON_TAC[EMPTY_NUMSEG; NOT_LT; RING_SUM_CLAUSES]] THEN + FIRST_X_ASSUM(X_CHOOSE_THEN `d:num` SUBST_ALL_TAC o + ONCE_REWRITE_RULE[ADD_SYM] o GEN_REWRITE_RULE I [LE_EXISTS]) THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o LAND_CONV) + [GSYM(CONJUNCT1 ADD_CLAUSES)] THEN + REWRITE_TAC[RING_SUM_OFFSET] THEN + MP_TAC(SPECL [`r:A ring`; `\i. (f:num->A)(i + m)`; `d:num`] lemma) THEN + ASM_REWRITE_TAC[GSYM ADD1; ADD_CLAUSES] THEN DISCH_THEN MATCH_MP_TAC THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC);; + +let RING_SUM_DIFFS_ALT = prove + (`!r (f:num->A) m n. + (!i. m <= i /\ i <= n + 1 ==> f i IN ring_carrier r) + ==> ring_sum r (m..n) (\k. ring_sub r (f(k + 1)) (f k)) = + if m <= n then ring_sub r (f(n + 1)) (f m) else ring_0 r`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o AP_TERM `ring_neg (r:A ring)` o + MATCH_MP RING_SUM_DIFFS) THEN + MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THENL + [W(MP_TAC o PART_MATCH (rand o rand) RING_SUM_NEG o lhand o snd) THEN + REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN ANTS_TAC THENL + [REPEAT STRIP_TAC THEN MATCH_MP_TAC RING_SUB; + DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC RING_SUM_EQ THEN + REWRITE_TAC[IN_NUMSEG] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC RING_NEG_SUB]; + COND_CASES_TAC THEN REWRITE_TAC[RING_NEG_0] THEN + MATCH_MP_TAC RING_NEG_SUB] THEN + REPEAT CONJ_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC);; + +let RING_GEOM_SERIES_GEN = prove + (`!(r:A ring) x y n. + x IN ring_carrier r /\ y IN ring_carrier r + ==> ring_mul r (ring_sub r x y) + (ring_sum r (0..n) + (\i. ring_mul r (ring_pow r x i) (ring_pow r y (n - i)))) = + ring_sub r (ring_pow r x (SUC n)) (ring_pow r y (SUC n))`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[GSYM RING_SUM_LMUL; RING_SUB; RING_POW; RING_MUL; + FINITE_NUMSEG; RING_SUB_RDISTRIB] THEN + MP_TAC(ISPECL + [`r:A ring`; `\i. ring_mul r (ring_pow r x i:A) (ring_pow r y (SUC n - i))`; + `0`; `n:num`] RING_SUM_DIFFS_ALT) THEN + ASM_SIMP_TAC[RING_MUL; RING_POW; SUB_0; GSYM ADD1; SUB_REFL; LE_0] THEN + ASM_SIMP_TAC[CONJUNCT1 ring_pow; RING_MUL_LID; RING_POW; + SUB_SUC; RING_MUL_RID; RING_MUL] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC RING_SUM_EQ THEN + X_GEN_TAC `i:num` THEN REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN + ASM_SIMP_TAC[ARITH_RULE `i <= n ==> SUC n - i = SUC(n - i)`; ring_pow] THEN + ASM_SIMP_TAC[RING_MUL_AC; RING_POW]);; + +let RING_GEOM_SERIES = prove + (`!r (x:A) n. + x IN ring_carrier r + ==> ring_mul r (ring_sub r x (ring_1 r)) + (ring_sum r (0..n) (\i. ring_pow r x i)) = + ring_sub r (ring_pow r x (SUC n)) (ring_1 r)`, + REPEAT STRIP_TAC THEN MP_TAC(ISPECL + [`r:A ring`; `x:A`; `ring_1 r:A`; `n:num`] RING_GEOM_SERIES_GEN) THEN + ASM_SIMP_TAC[RING_POW_ONE; RING_1; RING_MUL_RID; RING_POW]);; + let th = prove (`!r (f:K->A) g s. (!a. a IN s ==> f a = g a) ==> ring_sum r s (\i. f i) = ring_sum r s g`, @@ -1619,6 +1703,22 @@ let RING_PRODUCT_1 = prove (`!r s. ring_product r s (\i:K. ring_1 r):A = ring_1 r`, SIMP_TAC[RING_PRODUCT_EQ_1]);; +let RING_PRODUCT_0 = prove + (`!r s. ring_product r s (\i:K. ring_0 r):A = + if s = {} \/ INFINITE s then ring_1 r else ring_0 r`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `trivial_ring(r:A ring)` THENL + [ASM_MESON_TAC[trivial_ring; IN_SING; RING_0; RING_1; RING_PRODUCT]; + RULE_ASSUM_TAC(REWRITE_RULE[TRIVIAL_RING_10])] THEN + MP_TAC(ISPECL [`r:A ring`; `s:K->bool`; `(\x. ring_0 r):K->A`] + RING_PRODUCT_TRIVIAL) THEN + ASM_REWRITE_TAC[RING_0; IN_GSPEC] THEN + ASM_CASES_TAC `FINITE(s:K->bool)` THEN ASM_REWRITE_TAC[INFINITE] THEN + UNDISCH_TAC `FINITE(s:K->bool)` THEN SPEC_TAC(`s:K->bool`,`s:K->bool`) THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + ASM_SIMP_TAC[RING_PRODUCT_CLAUSES; RING_0; NOT_INSERT_EMPTY] THEN + REPEAT GEN_TAC THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[RING_MUL_LZERO; RING_1; RING_0]);; + let RING_PRODUCT_MUL = prove (`!r (f:K->A) (g:K->A) s. FINITE s /\ @@ -1742,6 +1842,21 @@ let RING_PRODUCT_RESTRICT_SET = prove MATCH_MP_TAC RING_PRODUCT_SUPERSET THEN SIMP_TAC[IN_ELIM_THM; SUBSET_RESTRICT] THEN MESON_TAC[]]);; +let RING_PRODUCT_CASES = prove + (`!r s P (f:K->A) g. + FINITE s + ==> ring_product r s (\x. if P x then f x else g x) = + ring_mul r (ring_product r {x | x IN s /\ P x} f) + (ring_product r {x | x IN s /\ ~P x} g)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`r:A ring`; `\x. if P x then (f:K->A) x else g x`; + `{x:K | x IN s /\ P x}`; `{x:K | x IN s /\ ~P x}`] + RING_PRODUCT_UNION) THEN + ANTS_TAC THENL [ASM_SIMP_TAC[FINITE_RESTRICT] THEN SET_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC EQ_IMP THEN BINOP_TAC THENL + [AP_THM_TAC THEN AP_TERM_TAC THEN SET_TAC[]; + BINOP_TAC THEN MATCH_MP_TAC RING_PRODUCT_EQ THEN SET_TAC[]]);; + let RING_PRODUCT_IMAGE = prove (`!r (f:K->L) (g:L->A) s. (!x y. x IN s /\ y IN s /\ f x = f y ==> x = y) @@ -1797,6 +1912,15 @@ let RING_PRODUCT_IMAGE_GEN = prove SIMP_TAC[FUN_IN_IMAGE] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC RING_PRODUCT_EQ_1 THEN ASM SET_TAC[]);; +let RING_PRODUCT_NSUM = prove + (`!(r:A ring) s (e:K->num) a. + FINITE s /\ a IN ring_carrier r + ==> ring_pow r a (nsum s e) = ring_product r s (\i. ring_pow r a (e i))`, + GEN_TAC THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN CONJ_TAC THENL + [SIMP_TAC[RING_PRODUCT_CLAUSES; NSUM_CLAUSES; RING_POW_0]; + ASM_SIMP_TAC[RING_POW_ADD; NSUM_CLAUSES; RING_PRODUCT_CLAUSES; RING_POW]]);; + let th = prove (`!r (f:K->A) g s. (!a. a IN s ==> f a = g a) @@ -1852,6 +1976,13 @@ let ring_inv = new_definition let ring_div = new_definition `ring_div r (a:A) b = ring_mul r a (ring_inv r b)`;; +let RING_DIVIDES_ALT = prove + (`!r a b:A. + ring_divides r a b <=> + a IN ring_carrier r /\ b IN ring_carrier r /\ + ?x. x IN ring_carrier r /\ b = ring_mul r x a`, + MESON_TAC[ring_divides; RING_MUL_SYM]);; + let RING_DIVIDES_IN_CARRIER = prove (`!r a b:A. ring_divides r a b @@ -2140,6 +2271,25 @@ let RING_UNIT_PRODUCT = prove REPEAT STRIP_TAC THEN COND_CASES_TAC THEN ASM_SIMP_TAC[RING_UNIT_MUL_EQ; RING_PRODUCT]);; +let RING_MUL_LCANCEL = prove + (`!r (a:A) x y. + x IN ring_carrier r /\ y IN ring_carrier r /\ + ring_unit r a /\ + ring_mul r a x = ring_mul r a y + ==> x = y`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP RING_UNIT_IN_CARRIER) THEN + FIRST_X_ASSUM(MP_TAC o AP_TERM `ring_mul r (ring_inv r a:A)`) THEN + ASM_SIMP_TAC[RING_MUL_ASSOC; RING_INV; RING_MUL_LINV; RING_MUL_LID]);; + +let RING_MUL_RCANCEL = prove + (`!r (a:A) x y. + x IN ring_carrier r /\ y IN ring_carrier r /\ + ring_unit r a /\ + ring_mul r x a = ring_mul r y a + ==> x = y`, + MESON_TAC[RING_MUL_LCANCEL; RING_MUL_SYM; RING_UNIT_IN_CARRIER]);; + let RING_DIVIDES_REFL = prove (`!r a:A. ring_divides r a a <=> a IN ring_carrier r`, REPEAT GEN_TAC THEN REWRITE_TAC[ring_divides] THEN @@ -2284,33 +2434,20 @@ let RING_DIVIDES_SUB_POW = prove a IN ring_carrier r /\ b IN ring_carrier r /\ ~(n = 0) ==> ring_divides r (ring_sub r a b) (ring_sub r (ring_pow r a n) (ring_pow r b n))`, - GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN - INDUCT_TAC THEN REWRITE_TAC[NOT_SUC] THEN - DISCH_TAC THEN - ASM_CASES_TAC `n = 0` THENL - [ASM_REWRITE_TAC[ring_pow; RING_POW] THEN - ASM_SIMP_TAC[RING_MUL_RID] THEN REWRITE_TAC[RING_DIVIDES_REFL] THEN - ASM_SIMP_TAC[RING_SUB]; - ALL_TAC] THEN - (* a^(SUC n) - b^(SUC n) = a*(a^n - b^n) + (a-b)*b^n *) - SUBGOAL_THEN - `ring_sub r (ring_pow r (a:A) (SUC n)) (ring_pow r b (SUC n)) = - ring_add r (ring_mul r a (ring_sub r (ring_pow r a n) (ring_pow r b n))) - (ring_mul r (ring_sub r a b) (ring_pow r b n))` - SUBST1_TAC THENL - [REWRITE_TAC[ring_pow] THEN - ASM_SIMP_TAC[RING_SUB_LDISTRIB; RING_POW; - RING_SUB_RDISTRIB; RING_MUL; RING_SUB] THEN - MATCH_MP_TAC(GSYM RING_SUB_TELESCOPE) THEN - ASM_SIMP_TAC[RING_MUL; RING_POW]; - ALL_TAC] THEN - MATCH_MP_TAC RING_DIVIDES_ADD THEN - ASM_SIMP_TAC[RING_MUL; RING_POW; RING_SUB] THEN CONJ_TAC THENL - [MATCH_MP_TAC RING_DIVIDES_LMUL THEN - ASM_SIMP_TAC[RING_POW; RING_SUB] THEN - FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; - MATCH_MP_TAC RING_DIVIDES_RMUL THEN - ASM_SIMP_TAC[RING_POW; RING_SUB; RING_DIVIDES_REFL]]);; + REPLICATE_TAC 3 GEN_TAC THEN MATCH_MP_TAC num_INDUCTION THEN + REWRITE_TAC[NOT_SUC] THEN X_GEN_TAC `n:num` THEN + DISCH_THEN(K ALL_TAC) THEN STRIP_TAC THEN + ASM_SIMP_TAC[GSYM RING_GEOM_SERIES_GEN] THEN + MATCH_MP_TAC RING_DIVIDES_RMUL THEN + ASM_SIMP_TAC[RING_SUM; RING_SUB; RING_DIVIDES_REFL]);; + +let RING_DIVIDES_PRODUCTS = prove + (`!(r:A ring) (f:K->A) (g:K->A) s. + FINITE s /\ (!i. i IN s ==> ring_divides r (f i) (g i)) + ==> ring_divides r (ring_product r s f) (ring_product r s g)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC RING_PRODUCT_RELATED THEN + ASM_SIMP_TAC[RING_DIVIDES_MUL2; RING_DIVIDES_1; RING_1] THEN + ASM_MESON_TAC[RING_DIVIDES_IN_CARRIER]);; let RING_DIVIDES_PRODUCT_SUBSET = prove (`!r (f:K->A) s t. @@ -2543,6 +2680,17 @@ let RING_COPRIME_00 = prove (`!r:A ring. ring_coprime r (ring_0 r,ring_0 r) <=> trivial_ring r`, REWRITE_TAC[RING_COPRIME_0; RING_UNIT_0]);; +let RING_COPRIME_DIVISORS = prove + (`!r a b d e:A. + ring_divides r d a /\ ring_divides r e b /\ ring_coprime r (a,b) + ==> ring_coprime r (d,e)`, + SIMP_TAC[ring_coprime] THEN MESON_TAC[ring_divides; RING_DIVIDES_TRANS]);; + +let RING_COPRIME_UNIT = prove + (`(!r a b:A. ring_unit r a /\ b IN ring_carrier r ==> ring_coprime r (a,b)) /\ + (!r a b:A. a IN ring_carrier r /\ ring_unit r b ==> ring_coprime r (a,b))`, + MESON_TAC[ring_coprime; ring_unit;RING_UNIT_DIVISOR]);; + let RING_ASSOCIATES_RMUL = prove (`!r a u:A. a IN ring_carrier r /\ ring_unit r u @@ -2677,6 +2825,17 @@ let RING_NILPOTENT_NEG_EQ = prove ==> (ring_nilpotent r (ring_neg r x) <=> ring_nilpotent r x)`, MESON_TAC[RING_NILPOTENT_NEG; RING_NILPOTENT_IN_CARRIER; RING_NEG_NEG]);; +let RING_UNIT_IDEMPOTENT_EQ_1 = prove + (`!r a:A. ring_unit r a /\ ring_mul r a a = a <=> a = ring_1 r`, + REPEAT GEN_TAC THEN EQ_TAC THENL + [STRIP_TAC THEN + SUBGOAL_THEN `a:A = ring_mul r (ring_mul r a a) (ring_inv r a)` SUBST1_TAC + THENL [SUBGOAL_THEN `(a:A) IN ring_carrier r` ASSUME_TAC THENL + [ASM_SIMP_TAC[RING_UNIT_IN_CARRIER]; ALL_TAC] THEN CONV_TAC SYM_CONV THEN + ASM_SIMP_TAC[GSYM RING_MUL_ASSOC; RING_INV; RING_MUL_RINV; RING_MUL_RID]; + ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[RING_MUL_RINV]]; + DISCH_THEN SUBST1_TAC THEN SIMP_TAC[RING_MUL_LID; RING_UNIT_1; RING_1]]);; + (* ------------------------------------------------------------------------- *) (* Subrings. We treat them as *sets* which seems to be a common convention. *) (* And "subring_generated" can be used in the degenerate case where the set *) @@ -3300,6 +3459,17 @@ let ring_ideal = new_definition (!x y. x IN j /\ y IN j ==> ring_add r x y IN j) /\ (!x y. x IN ring_carrier r /\ y IN j ==> ring_mul r x y IN j)`;; +let RING_IDEAL = prove + (`!r j:A->bool. + ring_ideal r j <=> + j SUBSET ring_carrier r /\ + ring_0 r IN j /\ + (!x y. x IN j /\ y IN j ==> ring_add r x y IN j) /\ + (!x y. x IN ring_carrier r /\ y IN j ==> ring_mul r x y IN j)`, + REPEAT GEN_TAC THEN REWRITE_TAC[ring_ideal; SUBSET] THEN + EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[RING_MUL_LNEG; RING_MUL_LID; RING_MUL; RING_NEG; RING_1]);; + let RING_IDEAL_IMP_SUBSET = prove (`!r s:A->bool. ring_ideal r s ==> s SUBSET ring_carrier r`, SIMP_TAC[ring_ideal]);; @@ -4052,7 +4222,6 @@ let IDEAL_GENERATED_INDUCT_STRONG = prove (`!r P s:A->bool. (!x. x IN ring_carrier r /\ x IN s ==> P x) /\ P(ring_0 r) /\ - (!x. x IN ring_carrier r /\ P x ==> P(ring_neg r x)) /\ (!x y. x IN ring_carrier r /\ y IN ring_carrier r /\ P x /\ P y ==> P(ring_add r x y)) /\ (!x y. x IN ring_carrier r /\ y IN ring_carrier r /\ P y @@ -4063,7 +4232,8 @@ let IDEAL_GENERATED_INDUCT_STRONG = prove `!x. x IN ideal_generated r s ==> (x:A) IN ring_carrier r /\ P x` MP_TAC THENL [ALL_TAC; MESON_TAC[]] THEN MATCH_MP_TAC IDEAL_GENERATED_INDUCT THEN - ASM_SIMP_TAC[RING_0; RING_1; RING_NEG; RING_ADD; RING_MUL]);; + ASM_SIMP_TAC[RING_0; RING_1; RING_NEG; RING_ADD; RING_MUL] THEN + ASM_MESON_TAC[RING_MUL_LNEG; RING_MUL_LID; RING_MUL; RING_NEG; RING_1]);; let IDEAL_GENERATED_SUBSET = prove (`!r h:A->bool. @@ -4319,6 +4489,151 @@ let IDEAL_GENERATED_2 = prove ASM_SIMP_TAC[IDEAL_GENERATED_SING_ALT] THEN REWRITE_TAC[ring_setadd] THEN ASM SET_TAC[]);; +let IDEAL_GENERATED_SETADD_SUBSET = prove + (`!r s t:A->bool. + s SUBSET ring_carrier r /\ t SUBSET ring_carrier r + ==> ideal_generated r (ring_setadd r s t) SUBSET + ideal_generated r (s UNION t)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC IDEAL_GENERATED_MINIMAL THEN + REWRITE_TAC[RING_IDEAL_IDEAL_GENERATED; IDEAL_GENERATED_UNION] THEN + MATCH_MP_TAC RING_SETADD_MONO THEN + ASM_SIMP_TAC[IDEAL_GENERATED_SUBSET_CARRIER_SUBSET]);; + +let RING_SCALE_SETMUL = prove + (`!r s a:A. IMAGE (ring_mul r a) = ring_setmul r {a}`, + REWRITE_TAC[FUN_EQ_THM] THEN + REWRITE_TAC[IMAGE; IN_ELIM_THM; ring_setmul] THEN SET_TAC[]);; + +let RING_IDEAL_SCALE = prove + (`!r j a:A. + ring_ideal r j /\ a IN ring_carrier r + ==> ring_ideal r (IMAGE (ring_mul r a) j)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[ring_ideal; SUBSET; IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[FORALL_IN_IMAGE] THEN + REWRITE_TAC[RIGHT_IMP_FORALL_THM; IMP_IMP] THEN + STRIP_TAC THEN REWRITE_TAC[IN_IMAGE] THEN REPEAT CONJ_TAC THENL + [ASM_SIMP_TAC[RING_MUL]; + ASM_MESON_TAC[RING_0; RING_MUL_RZERO]; + ASM_SIMP_TAC[GSYM RING_MUL_RNEG] THEN ASM_MESON_TAC[]; + ASM_SIMP_TAC[GSYM RING_ADD_LDISTRIB] THEN ASM_MESON_TAC[]; + ASM_MESON_TAC[RING_MUL_AC]]);; + +let IDEAL_GENERATED_SCALE = prove + (`!r s a:A. + s SUBSET ring_carrier r /\ a IN ring_carrier r + ==> ideal_generated r (IMAGE (ring_mul r a) s) = + IMAGE (ring_mul r a) (ideal_generated r s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [MATCH_MP_TAC IDEAL_GENERATED_MINIMAL THEN + ASM_SIMP_TAC[RING_IDEAL_SCALE; RING_IDEAL_IDEAL_GENERATED] THEN + ASM_SIMP_TAC[IMAGE_SUBSET; IDEAL_GENERATED_SUBSET_CARRIER_SUBSET]; + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + MATCH_MP_TAC IDEAL_GENERATED_INDUCT_STRONG THEN REPEAT CONJ_TAC THENL + [REPEAT STRIP_TAC THEN MATCH_MP_TAC IDEAL_GENERATED_INC_GEN THEN + ASM SET_TAC[RING_MUL]; + ASM_MESON_TAC[RING_MUL_RZERO; IN_RING_IDEAL_0; + RING_IDEAL_IDEAL_GENERATED]; + ASM_SIMP_TAC[RING_ADD_LDISTRIB] THEN + ASM_MESON_TAC[IN_RING_IDEAL_ADD; RING_IDEAL_IDEAL_GENERATED]; + ASM_MESON_TAC[IN_RING_IDEAL_LMUL; RING_IDEAL_IDEAL_GENERATED; + RING_MUL_AC]]]);; + +let IDEAL_GENERATED_FINITARY = prove + (`!r j:A->bool. + ideal_generated r j = + UNIONS {ideal_generated r k | FINITE k /\ k SUBSET j}`, + REPEAT GEN_TAC THEN REWRITE_TAC[UNIONS_GSPEC; IN_ELIM_THM] THEN + GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `x:A` THEN + REWRITE_TAC[IN_ELIM_THM] THEN EQ_TAC THENL + [SPEC_TAC(`x:A`,`x:A`); MESON_TAC[IDEAL_GENERATED_MONO; SUBSET]] THEN + MATCH_MP_TAC IDEAL_GENERATED_INDUCT_STRONG THEN REPEAT CONJ_TAC THENL + [X_GEN_TAC `x:A` THEN STRIP_TAC THEN EXISTS_TAC `{x:A}` THEN + ASM_SIMP_TAC[SING_SUBSET; IDEAL_GENERATED_INC; FINITE_SING; IN_SING]; + EXISTS_TAC `{}:A->bool` THEN REWRITE_TAC[FINITE_EMPTY; EMPTY_SUBSET] THEN + SIMP_TAC[IN_RING_IDEAL_0; RING_IDEAL_IDEAL_GENERATED]; + MAP_EVERY X_GEN_TAC [`x:A`; `y:A`] THEN + REWRITE_TAC[IMP_CONJ; LEFT_IMP_EXISTS_THM] THEN + REPEAT DISCH_TAC THEN X_GEN_TAC `k:A->bool` THEN + REPEAT DISCH_TAC THEN X_GEN_TAC `l:A->bool` THEN + REPEAT DISCH_TAC THEN EXISTS_TAC `k UNION l:A->bool` THEN + ASM_REWRITE_TAC[FINITE_UNION; UNION_SUBSET] THEN + MATCH_MP_TAC IN_RING_IDEAL_ADD THEN + REWRITE_TAC[RING_IDEAL_IDEAL_GENERATED] THEN + ASM_MESON_TAC[IDEAL_GENERATED_MONO; SUBSET; SUBSET_UNION]; + MESON_TAC[IN_RING_IDEAL_LMUL; RING_IDEAL_IDEAL_GENERATED]]);; + +let IDEAL_GENERATED_FINITARY_ALT = prove + (`!r j:A->bool. + ideal_generated r j = + UNIONS { ideal_generated r k | k | + FINITE k /\ k SUBSET j /\ k SUBSET ring_carrier r}`, + REPEAT GEN_TAC THEN + GEN_REWRITE_TAC LAND_CONV [IDEAL_GENERATED_RESTRICT] THEN + GEN_REWRITE_TAC LAND_CONV [IDEAL_GENERATED_FINITARY] THEN + REWRITE_TAC[SUBSET_INTER] THEN AP_TERM_TAC THEN SET_TAC[]);; + +let IDEAL_GENERATED_FINITE_IMAGE = prove + (`!r k (f:K->A). + FINITE k /\ IMAGE f k SUBSET ring_carrier r + ==> ideal_generated r (IMAGE f k) = + { ring_sum r k (\i. ring_mul r (c i) (f i)) | c | + !i. i IN k ==> c i IN ring_carrier r }`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM SUBSET_ANTISYM_EQ; SUBSET] THEN + CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[FORALL_IN_GSPEC] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC IN_RING_IDEAL_SUM THEN + REWRITE_TAC[RING_IDEAL_IDEAL_GENERATED] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC IN_RING_IDEAL_LMUL THEN + ASM_SIMP_TAC[RING_IDEAL_IDEAL_GENERATED] THEN + MATCH_MP_TAC IDEAL_GENERATED_INC THEN ASM SET_TAC[]] THEN + RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; FORALL_IN_IMAGE]) THEN + MATCH_MP_TAC IDEAL_GENERATED_INDUCT THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC] THEN + REWRITE_TAC[IN_ELIM_THM] THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[GSYM IMP_CONJ] THEN REWRITE_TAC[IMP_CONJ_ALT] THEN + REWRITE_TAC[FORALL_IN_IMAGE] THEN X_GEN_TAC `i:K` THEN REPEAT DISCH_TAC THEN + EXISTS_TAC `(\j. if j = i then ring_1 r else ring_0 r):K->A` THEN + ASM_SIMP_TAC[COND_RAND; COND_RATOR; RING_MUL_LZERO; RING_1; RING_0; + RING_MUL_LID; COND_ID; RING_SUM_DELTA]; + EXISTS_TAC `(\i. ring_0 r):K->A` THEN + ASM_SIMP_TAC[RING_MUL_LZERO; RING_0; RING_SUM_0]; + X_GEN_TAC `c:K->A` THEN DISCH_TAC THEN + EXISTS_TAC `(\i. ring_neg r (c i)):K->A` THEN + ASM_SIMP_TAC[RING_MUL_LNEG; RING_SUM_NEG; RING_NEG; RING_MUL]; + X_GEN_TAC `c:K->A` THEN DISCH_TAC THEN + X_GEN_TAC `d:K->A` THEN DISCH_TAC THEN + EXISTS_TAC `(\i. ring_add r (c i) (d i)):K->A` THEN + ASM_SIMP_TAC[RING_ADD_RDISTRIB; RING_SUM_ADD; RING_ADD; RING_MUL]; + X_GEN_TAC `a:A` THEN DISCH_TAC THEN + X_GEN_TAC `c:K->A` THEN DISCH_TAC THEN + EXISTS_TAC `(\i. ring_mul r a (c i)):K->A` THEN + ASM_SIMP_TAC[RING_MUL; GSYM RING_MUL_ASSOC; RING_SUM_LMUL]]);; + +let IDEAL_GENERATED_FINITE = prove + (`!r k:A->bool. + FINITE k /\ k SUBSET ring_carrier r + ==> ideal_generated r k = + { ring_sum r k (\i. ring_mul r (c i) i) | c | + !i. i IN k ==> c i IN ring_carrier r }`, + REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM IMAGE_I] THEN + ASM_SIMP_TAC[IDEAL_GENERATED_FINITE_IMAGE; IMAGE_I; I_THM]);; + +let IDEAL_GENERATED_EXPLICIT = prove + (`!r s:A->bool. + ideal_generated r s = + { ring_sum r k (\i. ring_mul r (c i) i) | k,c | + FINITE k /\ k SUBSET s /\ k SUBSET ring_carrier r /\ + (!i. i IN k ==> c i IN ring_carrier r) }`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[IDEAL_GENERATED_FINITARY_ALT] THEN + REWRITE_TAC[UNIONS_GSPEC] THEN GEN_REWRITE_TAC I [EXTENSION] THEN + X_GEN_TAC `y:A` THEN REWRITE_TAC[IN_ELIM_THM] THEN + ONCE_REWRITE_TAC[TAUT `p /\ q <=> ~(p ==> ~q)`] THEN + SIMP_TAC[IDEAL_GENERATED_FINITE] THEN + REWRITE_TAC[IN_ELIM_THM] THEN MESON_TAC[]);; + (* ------------------------------------------------------------------------- *) (* Integral domain and field. *) (* ------------------------------------------------------------------------- *) @@ -5154,6 +5469,12 @@ let RING_ISOMORPHISMS = prove REPEAT GEN_TAC THEN EQ_TAC THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[] THEN ASM_MESON_TAC[RING_0; RING_1; RING_NEG; RING_ADD; RING_MUL]);; +let RING_HOMOMORPHISM_IN_CARRIER = prove + (`!r r' (f:A->B) x. + ring_homomorphism (r,r') f /\ x IN ring_carrier r + ==> f x IN ring_carrier r'`, + REWRITE_TAC[RING_HOMOMORPHISM] THEN SET_TAC[]);; + let RING_HOMOMORPHISM_0 = prove (`!r r' (f:A->B). ring_homomorphism(r,r') f ==> f(ring_0 r) = ring_0 r'`, SIMP_TAC[ring_homomorphism]);; @@ -5421,6 +5742,14 @@ let RING_ISOMORPHISM_I = prove (`!r:A ring. ring_isomorphism (r,r) I`, REWRITE_TAC[I_DEF; RING_ISOMORPHISM_ID]);; +let RING_AUTOMORPHISM_ID = prove + (`!r:A ring. ring_automorphism r (\x. x)`, + REWRITE_TAC[ring_automorphism; RING_ISOMORPHISM_ID]);; + +let RING_AUTOMORPHISM_I = prove + (`!r:A ring. ring_automorphism r I`, + REWRITE_TAC[ring_automorphism; RING_ISOMORPHISM_I]);; + let RING_HOMOMORPHISM_COMPOSE = prove (`!r1 r2 r3 (f:A->B) (g:B->C). ring_homomorphism(r1,r2) f /\ ring_homomorphism(r2,r3) g @@ -5734,26 +6063,33 @@ let RING_IDEAL_HOMOMORPHIC_PREIMAGE = prove REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN MESON_TAC[RING_0; RING_1; RING_NEG; RING_ADD; RING_MUL]);; +let IDEAL_GENERATED_BY_HOMOMORPHIC_IMAGE = prove + (`!r r' (f:A->B) s. + ring_homomorphism(r,r') f /\ s SUBSET ring_carrier r + ==> IMAGE f (ideal_generated r s) SUBSET ideal_generated r' (IMAGE f s)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC(SET_RULE + `u SUBSET {x | x IN ring_carrier r /\ f x IN t} + ==> IMAGE f u SUBSET t`) THEN + MATCH_MP_TAC IDEAL_GENERATED_MINIMAL THEN CONJ_TAC THENL + [MATCH_MP_TAC(SET_RULE + `s SUBSET u /\ IMAGE f s SUBSET t + ==> s SUBSET {x | x IN u /\ f x IN t}`) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC IDEAL_GENERATED_SUBSET_CARRIER_SUBSET THEN + RULE_ASSUM_TAC(REWRITE_RULE[ring_homomorphism]) THEN ASM SET_TAC[]; + MATCH_MP_TAC RING_IDEAL_HOMOMORPHIC_PREIMAGE THEN + ASM_MESON_TAC[RING_IDEAL_IDEAL_GENERATED]]);; + let IDEAL_GENERATED_BY_EPIMORPHIC_IMAGE = prove (`!r r' (f:A->B) s. ring_epimorphism(r,r') f /\ s SUBSET ring_carrier r ==> ideal_generated r' (IMAGE f s) = IMAGE f (ideal_generated r s)`, - REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL - [MATCH_MP_TAC IDEAL_GENERATED_MINIMAL THEN - ASM_SIMP_TAC[IDEAL_GENERATED_SUBSET_CARRIER_SUBSET; IMAGE_SUBSET] THEN - ASM_MESON_TAC[RING_IDEAL_IDEAL_GENERATED; RING_IDEAL_EPIMORPHIC_IMAGE]; - MATCH_MP_TAC(SET_RULE - `u SUBSET {x | x IN ring_carrier r /\ f x IN t} - ==> IMAGE f u SUBSET t`) THEN - MATCH_MP_TAC IDEAL_GENERATED_MINIMAL THEN CONJ_TAC THENL - [MATCH_MP_TAC(SET_RULE - `s SUBSET u /\ IMAGE f s SUBSET t - ==> s SUBSET {x | x IN u /\ f x IN t}`) THEN - ASM_REWRITE_TAC[] THEN - MATCH_MP_TAC IDEAL_GENERATED_SUBSET_CARRIER_SUBSET THEN - RULE_ASSUM_TAC(REWRITE_RULE[ring_epimorphism]) THEN ASM SET_TAC[]; - MATCH_MP_TAC RING_IDEAL_HOMOMORPHIC_PREIMAGE THEN - ASM_MESON_TAC[RING_IDEAL_IDEAL_GENERATED; ring_epimorphism]]]);; + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN + ASM_SIMP_TAC[IDEAL_GENERATED_BY_HOMOMORPHIC_IMAGE; + RING_EPIMORPHISM_IMP_HOMOMORPHISM] THEN + MATCH_MP_TAC IDEAL_GENERATED_MINIMAL THEN + ASM_SIMP_TAC[IDEAL_GENERATED_SUBSET_CARRIER_SUBSET; IMAGE_SUBSET] THEN + ASM_MESON_TAC[RING_IDEAL_IDEAL_GENERATED; RING_IDEAL_EPIMORPHIC_IMAGE]);; let RING_MONOMORPHISM_EPIMORPHISM = prove (`!r r' f:A->B. @@ -6092,6 +6428,10 @@ let ISOMORPHIC_RING_REFL = prove GEN_TAC THEN REWRITE_TAC[isomorphic_ring] THEN EXISTS_TAC `\x:A. x` THEN REWRITE_TAC[RING_ISOMORPHISM_ID]);; +let ISOMORPHIC_RING_EQ = prove + (`!r r':A ring. r = r' ==> r isomorphic_ring r'`, + MESON_TAC[ISOMORPHIC_RING_REFL]);; + let ISOMORPHIC_RING_SYM = prove (`!(r:A ring) (r':B ring). r isomorphic_ring r' <=> r' isomorphic_ring r`, REWRITE_TAC[isomorphic_ring; ring_isomorphism] THEN @@ -7778,7 +8118,6 @@ let ISOMORPHIC_PRODUCT_RING_DISJOINT_UNION = prove REWRITE_TAC[EXTENSIONAL; IN_ELIM_THM] THEN REWRITE_TAC[FUN_EQ_THM; RESTRICTION] THEN ASM SET_TAC[]]);; - let ISOMORPHIC_PRODUCT_RING_SING = prove (`!(r:K->A ring) k. product_ring {k} r isomorphic_ring r k`, REWRITE_TAC[isomorphic_ring] THEN @@ -9123,6 +9462,31 @@ let RING_IRREDUCIBLE_IN_CARRIER = prove (`!r a:A. ring_irreducible r a ==> a IN ring_carrier r`, SIMP_TAC[ring_irreducible]);; +let RING_PRIME_NEG = prove + (`!r x:A. + x IN ring_carrier r + ==> (ring_prime r (ring_neg r x) <=> ring_prime r x)`, + SIMP_TAC[ring_prime; RING_UNIT_NEG_EQ; RING_NEG_EQ_0; RING_NEG] THEN + MESON_TAC[RING_DIVIDES_NEG_EQ; RING_MUL]);; + +let RING_IRREDUCIBLE_NEG = prove + (`!r x:A. + x IN ring_carrier r + ==> (ring_irreducible r (ring_neg r x) <=> ring_irreducible r x)`, + SIMP_TAC[ring_irreducible; RING_UNIT_NEG_EQ; RING_NEG_EQ_0; RING_NEG] THEN + REPEAT STRIP_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC [`a:A`; `b:A`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`ring_neg r a:A`; `b:A`]) THEN + ASM_SIMP_TAC[RING_NEG; RING_MUL_LNEG; RING_UNIT_NEG_EQ; RING_NEG_NEG]);; + +let RING_PRIME_IMP_NONTRIVIAL_RING = prove + (`!r p:A. ring_prime r p ==> ~trivial_ring r`, + REWRITE_TAC[ring_prime; trivial_ring] THEN SET_TAC[]);; + +let RING_IRREDUCIBLE_IMP_NONTRIVIAL_RING = prove + (`!r p:A. ring_irreducible r p ==> ~trivial_ring r`, + REWRITE_TAC[ring_irreducible; trivial_ring] THEN SET_TAC[]);; + let FIELD_PRIME = prove (`!r a:A. field r ==> ~(ring_prime r a)`, REPEAT GEN_TAC THEN STRIP_TAC THEN @@ -9181,6 +9545,16 @@ let RING_PRIME_DIVIDES_MUL = prove ring_divides r p a \/ ring_divides r p b)`, MESON_TAC[ring_prime; RING_DIVIDES_RMUL; RING_DIVIDES_LMUL]);; +let RING_PRIME_DIVIDES_POW = prove + (`!r p (x:A) n. + ring_prime r p /\ x IN ring_carrier r /\ + ring_divides r p (ring_pow r x n) + ==> ring_divides r p x`, + GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THENL + [SIMP_TAC[ring_pow; RING_DIVIDES_ONE] THEN MESON_TAC[ring_prime]; + REWRITE_TAC[ring_pow] THEN + ASM_MESON_TAC[RING_PRIME_DIVIDES_MUL; RING_POW]]);; + let RING_PRIME_DIVIDES_PRODUCT = prove (`!r p k (f:K->A). ring_prime r p /\ FINITE k /\ (!i. i IN k ==> f i IN ring_carrier r) @@ -9333,6 +9707,15 @@ let RING_IRREDUCIBLE_COPRIME_EQ = prove ASM_REWRITE_TAC[ring_coprime] THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `p:A`)) THEN ASM_MESON_TAC[RING_DIVIDES_REFL; ring_irreducible]);; + +let RING_IRREDUCIBLES_COPRIME_OR_ASSOCIATES = prove + (`!r p q:A. + ring_irreducible r p /\ ring_irreducible r q + ==> ring_coprime r (p,q) \/ ring_associates r p q`, + REWRITE_TAC[ring_associates] THEN + MESON_TAC[RING_IRREDUCIBLE_DIVIDES_OR_COPRIME; RING_COPRIME_SYM; + ring_irreducible]);; + let INTEGRAL_DOMAIN_PRIME_DIVIDES_OR_COPRIME = prove (`!r p a:A. integral_domain r /\ ring_prime r p /\ a IN ring_carrier r @@ -9348,6 +9731,20 @@ let INTEGRAL_DOMAIN_PRIME_COPRIME_EQ = prove MESON_TAC[RING_IRREDUCIBLE_COPRIME_EQ; INTEGRAL_DOMAIN_PRIME_IMP_IRREDUCIBLE]);; +let INTEGRAL_DOMAIN_PRIMES_COPRIME_OR_ASSOCIATES = prove + (`!r p q:A. + integral_domain r /\ ring_prime r p /\ ring_prime r q + ==> ring_coprime r (p,q) \/ ring_associates r p q`, + MESON_TAC[RING_IRREDUCIBLES_COPRIME_OR_ASSOCIATES; + INTEGRAL_DOMAIN_PRIME_IMP_IRREDUCIBLE]);; + +let INTEGRAL_DOMAIN_PRIMES_DIVIDES_EQ_ASSOCIATES = prove + (`!r p q:A. + integral_domain r /\ ring_prime r p /\ ring_prime r q + ==> (ring_divides r p q <=> ring_associates r p q)`, + MESON_TAC[ring_associates; INTEGRAL_DOMAIN_PRIMES_COPRIME_OR_ASSOCIATES; + INTEGRAL_DOMAIN_PRIME_COPRIME_EQ]);; + let RING_PRIME_ISOMORPHIC_IMAGE_EQ = prove (`!r r' (f:A->B) a. ring_isomorphism(r,r') f /\ a IN ring_carrier r @@ -9389,6 +9786,68 @@ let RING_IRREDUCIBLE_ISOMORPHIC_IMAGE_EQ = prove (ONCE_REWRITE_RULE[IMP_CONJ] RING_MONOMORPHISM_INJECTIVE_EQ) (MATCH_MP RING_ISOMORPHISM_IMP_MONOMORPHISM th)]));; +let RING_PRIME_MUL_DIVIDES = prove + (`!r a b x:A. + ring_prime r a /\ ~(ring_divides r a b) /\ + ring_divides r a x /\ ring_divides r b x + ==> ring_divides r (ring_mul r a b) x`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ring_divides]) THEN + STRIP_TAC THEN + SUBGOAL_THEN `ring_divides r a (x':A)` MP_TAC THENL + [SUBGOAL_THEN `ring_divides r a (ring_mul r b (x':A))` MP_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + ASM_MESON_TAC[RING_PRIME_DIVIDES_MUL; ring_prime]; + ASM_REWRITE_TAC[ring_divides] THEN STRIP_TAC THEN + ASM_SIMP_TAC[RING_MUL; ring_prime] THEN + EXISTS_TAC `x'':A` THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[RING_MUL_AC; RING_MUL; ring_prime]]);; + +let RING_PRIME_MUL_DIVIDES_EQ = prove + (`!r p q x:A. + ring_prime r p /\ q IN ring_carrier r /\ ~(ring_divides r p q) + ==> (ring_divides r (ring_mul r p q) x <=> + ring_divides r p x /\ ring_divides r q x)`, + REPEAT STRIP_TAC THEN EQ_TAC THENL + [ASM_MESON_TAC[RING_DIVIDES_RMUL_REV; RING_DIVIDES_LMUL_REV; ring_prime]; + ASM_MESON_TAC[RING_PRIME_MUL_DIVIDES]]);; + +let RING_PRIME_PRODUCT_DIVIDES = prove + (`!r p (s:K->bool) x:A. + FINITE s /\ + x IN ring_carrier r /\ + (!i. i IN s ==> ring_prime r (p i)) /\ + pairwise (\i j. ~ring_divides r (p i) (p j)) s + ==> (ring_divides r (ring_product r s p) x <=> + !i. i IN s ==> ring_divides r (p i) x)`, + GEN_TAC THEN GEN_TAC THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN GEN_TAC THEN + ASM_CASES_TAC `(x:A) IN ring_carrier r` THEN ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + ASM_SIMP_TAC[RING_PRODUCT_CLAUSES; NOT_IN_EMPTY; FORALL_IN_INSERT] THEN + ASM_REWRITE_TAC[RING_DIVIDES_1; PAIRWISE_INSERT] THEN + MAP_EVERY X_GEN_TAC [`i:K`; `s:K->bool`] THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP RING_PRIME_IN_CARRIER) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC RING_PRIME_MUL_DIVIDES_EQ THEN + ASM_REWRITE_TAC[RING_PRODUCT] THEN + ASM_SIMP_TAC[RING_PRIME_DIVIDES_PRODUCT; RING_PRIME_IN_CARRIER] THEN + ASM_MESON_TAC[]);; + +let INTEGRAL_DOMAIN_PRIME_PRODUCT_DIVIDES = prove + (`!r p (s:K->bool) x:A. + integral_domain r /\ + FINITE s /\ + x IN ring_carrier r /\ + (!i. i IN s ==> ring_prime r (p i)) /\ + pairwise (\i j. ~ring_associates r (p i) (p j)) s + ==> (ring_divides r (ring_product r s p) x <=> + !i. i IN s ==> ring_divides r (p i) x)`, + REWRITE_TAC[pairwise] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC RING_PRIME_PRODUCT_DIVIDES THEN + ASM_REWRITE_TAC[pairwise] THEN + ASM_MESON_TAC[INTEGRAL_DOMAIN_PRIMES_DIVIDES_EQ_ASSOCIATES]);; + (* ------------------------------------------------------------------------- *) (* Prime (not in general irreducible) factorizations are automatically *) (* unique, up to permutation and associates. Here we have several forms of *) @@ -9639,6 +10098,148 @@ let RING_DIVIDES_PRIMEFACTS_LT = prove MATCH_MP_TAC CARD_IMAGE_INJ THEN ASM_MESON_TAC[]; MATCH_MP_TAC CARD_PSUBSET THEN ASM SET_TAC[]]);; +(* ------------------------------------------------------------------------- *) +(* Squarefree elements of a ring: no non-unit has its square dividing a. *) +(* In a UFD this is (RING_SQUAREFREE below) equivalent to a | b^2 ==> a | b. *) +(* ------------------------------------------------------------------------- *) + +let ring_squarefree = new_definition + `ring_squarefree (r:A ring) (a:A) <=> + a IN ring_carrier r /\ + !q. q IN ring_carrier r /\ ring_divides r (ring_pow r q 2) a + ==> ring_unit r q`;; + +let RING_SQUAREFREE_IN_CARRIER = prove + (`!r (a:A). ring_squarefree r a ==> a IN ring_carrier r`, + SIMP_TAC[ring_squarefree]);; + +let RING_UNIT_IMP_SQUAREFREE = prove + (`!r (a:A). ring_unit r a ==> ring_squarefree r a`, + REWRITE_TAC[ring_squarefree] THEN REPEAT STRIP_TAC THENL + [ASM_MESON_TAC[ring_unit]; + MP_TAC(ISPECL [`r:A ring`; `a:A`; `ring_pow r (q:A) 2`] + RING_UNIT_DIVISOR) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + ASM_MESON_TAC[RING_UNIT_POW_EQ; ARITH_RULE `~(2 = 0)`]]);; + +let RING_SQUAREFREE_1 = prove + (`!r:A ring. ring_squarefree r (ring_1 r)`, + MESON_TAC[RING_UNIT_IMP_SQUAREFREE; RING_UNIT_1]);; + +let RING_SQUAREFREE_DIVISOR = prove + (`!r d (a:A). + ring_squarefree r a /\ ring_divides r d a + ==> ring_squarefree r d`, + REWRITE_TAC[ring_squarefree] THEN REPEAT STRIP_TAC THENL + [ASM_MESON_TAC[ring_divides]; + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[RING_DIVIDES_TRANS]]);; + +let RING_SQUAREFREE_ASSOCIATES = prove + (`!r a (b:A). + ring_associates r a b + ==> (ring_squarefree r a <=> ring_squarefree r b)`, + MESON_TAC[RING_SQUAREFREE_DIVISOR; ring_associates]);; + +let RING_SQUAREFREE_0 = prove + (`!r:A ring. ring_squarefree r (ring_0 r) <=> trivial_ring r`, + GEN_TAC THEN REWRITE_TAC[ring_squarefree; RING_0; RING_DIVIDES_0] THEN + SIMP_TAC[IMP_CONJ; RING_POW] THEN EQ_TAC THENL + [MESON_TAC[RING_UNIT_0; RING_0]; + SIMP_TAC[trivial_ring; FORALL_IN_INSERT; NOT_IN_EMPTY] THEN + REWRITE_TAC[RING_UNIT_0; trivial_ring]]);; + +let RING_SQUAREFREE_IMP_NONZERO = prove + (`!r (a:A). ~trivial_ring r /\ ring_squarefree r a ==> ~(a = ring_0 r)`, + MESON_TAC[RING_SQUAREFREE_0]);; + +let RING_IRREDUCIBLE_IMP_SQUAREFREE = prove + (`!r (a:A). ring_irreducible r a ==> ring_squarefree r a`, + REWRITE_TAC[ring_irreducible; ring_squarefree] THEN + REPEAT GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `q:A` THEN STRIP_TAC THEN + UNDISCH_TAC `ring_divides r (ring_pow r (q:A) 2) a` THEN + ASM_SIMP_TAC[ring_divides; RING_POW_2; RING_MUL] THEN + DISCH_THEN(X_CHOOSE_THEN `e:A` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`q:A`; `ring_mul r (q:A) e`]) THEN + ASM_SIMP_TAC[RING_MUL; RING_MUL_ASSOC] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[RING_UNIT_DIVISOR; RING_DIVIDES_RMUL; RING_DIVIDES_REFL]);; + +let RING_PRIME_IMP_SQUAREFREE = prove + (`!r (a:A). integral_domain r /\ ring_prime r a ==> ring_squarefree r a`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC RING_IRREDUCIBLE_IMP_SQUAREFREE THEN + ASM_MESON_TAC[INTEGRAL_DOMAIN_PRIME_IMP_IRREDUCIBLE]);; + +let RING_SQUAREFREE_IMP_NO_PRIME_SQUARE = prove + (`!r a p:A. + ring_squarefree r a /\ ring_prime r p + ==> ~ring_divides r (ring_pow r p 2) a`, + REWRITE_TAC[ring_squarefree] THEN MESON_TAC[ring_prime]);; + +let RING_SQUAREFREE_COPRIME = prove + (`!r (a:A). + ring_squarefree r a <=> + a IN ring_carrier r /\ + !b c. b IN ring_carrier r /\ c IN ring_carrier r /\ ring_mul r b c = a + ==> ring_coprime r (b,c)`, + REPEAT GEN_TAC THEN EQ_TAC THENL + [REWRITE_TAC[ring_squarefree] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + REPEAT GEN_TAC THEN STRIP_TAC THEN + REWRITE_TAC[ring_coprime] THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[ring_divides; RING_DIVIDES_MUL2; RING_POW_2]; + STRIP_TAC THEN REWRITE_TAC[ring_squarefree] THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `q:A` THEN STRIP_TAC THEN + UNDISCH_TAC `ring_divides r (ring_pow r (q:A) 2) a` THEN + ASM_SIMP_TAC[RING_POW_2; ring_divides; RING_MUL] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`q:A`; `ring_mul r (q:A) x`]) THEN + ASM_SIMP_TAC[RING_MUL; RING_MUL_ASSOC] THEN + REWRITE_TAC[ring_coprime] THEN STRIP_TAC THEN + ASM_SIMP_TAC[RING_DIVIDES_REFL; RING_DIVIDES_RMUL]]);; + +let RING_SQUAREFREE_COPRIME_DIVISORS = prove + (`!r (a:A). + ring_squarefree r a <=> + a IN ring_carrier r /\ + !b c. b IN ring_carrier r /\ c IN ring_carrier r /\ + ring_divides r (ring_mul r b c) a + ==> ring_coprime r (b,c)`, + GEN_TAC THEN GEN_TAC THEN EQ_TAC THENL + [DISCH_TAC THEN CONJ_TAC THENL + [ASM_MESON_TAC[RING_SQUAREFREE_IN_CARRIER]; ALL_TAC] THEN + ASM_MESON_TAC[RING_SQUAREFREE_DIVISOR; RING_SQUAREFREE_COPRIME; RING_MUL]; + STRIP_TAC THEN REWRITE_TAC[ring_squarefree] THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[RING_POW_2; ring_coprime; RING_DIVIDES_REFL]]);; + +let RING_SQUAREFREE_MUL_IMP = prove + (`!r a (b:A). + a IN ring_carrier r /\ b IN ring_carrier r /\ + ring_squarefree r (ring_mul r a b) + ==> ring_coprime r (a,b) /\ + ring_squarefree r a /\ ring_squarefree r b`, + MESON_TAC[RING_SQUAREFREE_COPRIME; RING_SQUAREFREE_DIVISOR; + RING_DIVIDES_RMUL; RING_DIVIDES_LMUL; RING_DIVIDES_REFL]);; + +let RING_SQUAREFREE_POW = prove + (`!r (a:A) k. + a IN ring_carrier r + ==> (ring_squarefree r (ring_pow r a k) <=> + ring_unit r a \/ k = 0 \/ ring_squarefree r a /\ k = 1)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + ASM_CASES_TAC `ring_unit r (a:A)` THENL + [ASM_SIMP_TAC[RING_UNIT_IMP_SQUAREFREE; RING_UNIT_POW]; ALL_TAC] THEN + ASM_CASES_TAC `k = 0` THENL + [ASM_REWRITE_TAC[ring_pow; RING_SQUAREFREE_1]; ALL_TAC] THEN + ASM_CASES_TAC `k = 1` THENL + [ASM_SIMP_TAC[RING_POW_1]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[ring_squarefree; DE_MORGAN_THM; NOT_FORALL_THM; NOT_IMP] THEN + DISJ2_TAC THEN EXISTS_TAC `a:A` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `k = 2 + (k - 2)` SUBST1_TAC THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[RING_POW_ADD] THEN + ASM_MESON_TAC[RING_DIVIDES_RMUL; RING_DIVIDES_REFL; RING_POW]);; + (* ------------------------------------------------------------------------- *) (* Multiplicative system in a ring. *) (* ------------------------------------------------------------------------- *) @@ -10103,6 +10704,18 @@ let RING_LOCALIZATION_1 = prove ring_localequiv r s (ring_1 r,ring_1 r)`, REWRITE_TAC[RING_LOCALIZATION]);; +let RING_LOCALEQUIV_REFL = prove + (`!r s a:A. + ring_multsys r s /\ a IN s + ==> ring_localequiv r s (a,a) = ring_1(ring_localization r s)`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ring_multsys]) THEN + REWRITE_TAC[SUBSET] THEN STRIP_TAC THEN + ASM_SIMP_TAC[GSYM RING_LOCALEQUIV_EQUIV; RING_LOCALIZATION_1] THEN + ASM_SIMP_TAC[ring_localequiv] THEN EXISTS_TAC `ring_1 r:A` THEN + ASM_SIMP_TAC[RING_MUL_LID; RING_MUL_RID; RING_SUB_REFL; + RING_MUL_LID; RING_0]);; + let TRIVIAL_RING_LOCALIZATION = prove (`!r s:A->bool. ring_multsys r s @@ -10192,6 +10805,30 @@ let RING_LOCALEQUIV_EQ_0_GEN = prove ASM_SIMP_TAC[ring_localequiv; RING_0; RING_MUL_RID; RING_MUL_LZERO] THEN ASM_SIMP_TAC[RING_SUB_RZERO]);; +let RING_IDEAL_LOCALIZATION = prove + (`!r s (j:A->bool). + ring_multsys r s /\ ring_ideal r j + ==> ring_ideal (ring_localization r s) + {ring_localequiv r s (a,b) |a,b| a IN j /\ b IN s}`, + REPEAT STRIP_TAC THEN FIRST_ASSUM + (ASSUME_TAC o REWRITE_RULE[SUBSET] o MATCH_MP RING_IDEAL_IMP_SUBSET) THEN + ASM_SIMP_TAC[RING_IDEAL; RING_LOCALIZATION_CARRIER] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC] THEN + REWRITE_TAC[IMP_IMP; RIGHT_IMP_FORALL_THM] THEN + ASM_SIMP_TAC[RING_LOCALIZATION_ADD; RING_LOCALIZATION_MUL; + RING_LOCALIZATION_0] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN + RULE_ASSUM_TAC(REWRITE_RULE[ring_ideal; ring_multsys; SUBSET]) THEN + REPEAT(FIRST_X_ASSUM(CONJUNCTS_THEN STRIP_ASSUME_TAC)) THEN + REPEAT CONJ_TAC THENL + [ASM_MESON_TAC[RING_0; RING_1]; + ASM_MESON_TAC[RING_0; RING_1]; + MAP_EVERY X_GEN_TAC [`a:A`; `b:A`; `c:A`; `d:A`] THEN STRIP_TAC THEN + EXISTS_TAC `ring_add r (ring_mul r a d) (ring_mul r c b):A` THEN + EXISTS_TAC `ring_mul r b d:A` THEN ASM_SIMP_TAC[] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[RING_MUL_SYM]; + ASM_MESON_TAC[RING_MUL_SYM]]);; + let ring_fractionate = new_definition `ring_fractionate r s = \x:A. ring_localequiv r s (x,ring_1 r)`;; @@ -10369,51 +11006,361 @@ let RING_LOCALIZATION_UNIVERSAL = prove DISCH_THEN(CONJUNCTS_THEN(MP_TAC o MATCH_MP RING_MUL_RINV)) THEN RING_TAC THEN ASM_SIMP_TAC[RING_INV]);; -let fraction_ring = new_definition - `fraction_ring (r:A ring) = ring_localization r {a | ring_regular r a}`;; - -let RING_LOCALEQUIV_EQ_0 = prove - (`!r a b:A. - a IN ring_carrier r /\ ring_regular r b - ==> (ring_localequiv r {x | ring_regular r x} (a,b) = - ring_0(fraction_ring r) <=> - a = ring_0 r)`, - REPEAT STRIP_TAC THEN REWRITE_TAC[fraction_ring] THEN - ASM_SIMP_TAC[RING_LOCALEQUIV_EQ_0_GEN; RING_MULTSYS_REGULAR; - IN_ELIM_THM] THEN - REWRITE_TAC[IN_ELIM_THM] THEN EQ_TAC THENL - [REWRITE_TAC[ring_regular; ring_zerodivisor] THEN ASM_MESON_TAC[]; - ASM_MESON_TAC[RING_MUL_RZERO; RING_REGULAR_IN_CARRIER]]);; +let RING_LOCALEQUIV_SPLIT_EXPLICIT = prove + (`!r s a b:A. + ring_multsys r s /\ a IN ring_carrier r /\ b IN s + ==> ring_localequiv r s (a,b) = + ring_mul (ring_localization r s) + (ring_fractionate r s a) + (ring_localequiv r s (ring_1 r,b))`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [ring_multsys]) THEN + ASM_SIMP_TAC[ring_fractionate; RING_LOCALIZATION_MUL; RING_1] THEN + ASM_MESON_TAC[RING_MUL_LID; RING_MUL_RID; SUBSET]);; -let RING_FRACTIONATE_EQ_0 = prove - (`!r a:A. - a IN ring_carrier r - ==> (ring_fractionate r {x | ring_regular r x} a = - ring_0(fraction_ring r) <=> - a = ring_0 r)`, - REPEAT STRIP_TAC THEN REWRITE_TAC[ring_fractionate] THEN - MATCH_MP_TAC RING_LOCALEQUIV_EQ_0 THEN - ASM_REWRITE_TAC[RING_REGULAR_1]);; +let RING_LOCALEQUIV_SPLIT = prove + (`!r s a b:A. + ring_multsys r s /\ a IN ring_carrier r /\ b IN s + ==> ring_localequiv r s (a,b) = + ring_div (ring_localization r s) + (ring_fractionate r s a) + (ring_fractionate r s b)`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[RING_LOCALEQUIV_SPLIT_EXPLICIT] THEN + REWRITE_TAC[ring_div] THEN AP_TERM_TAC THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC RING_RINV_UNIQUE THEN + ASM_SIMP_TAC[RING_LOCALEQUIV_IN_CARRIER; RING_1] THEN + SUBGOAL_THEN `(b:A) IN ring_carrier r` ASSUME_TAC THENL + [ASM_MESON_TAC[ring_multsys; SUBSET]; ALL_TAC] THEN + ASM_SIMP_TAC[RING_FRACTIONATE_IN_CARRIER; GSYM + RING_LOCALEQUIV_SPLIT_EXPLICIT] THEN + ASM_SIMP_TAC[RING_LOCALEQUIV_REFL]);; -let RING_MONOMORPHISM_FRACTIONATE = prove - (`!r:A ring. - ring_monomorphism (r,fraction_ring r) - (ring_fractionate r {a | ring_regular r a})`, - SIMP_TAC[fraction_ring; RING_MONOMORPHISM_FRACTIONATE_GEN; - RING_MULTSYS_REGULAR; SUBSET_REFL]);; +let LOCALEQUIV_MUL_RCANCEL = prove + (`!r s a b:A. + ring_multsys r s /\ a IN ring_carrier r /\ b IN s + ==> ring_mul (ring_localization r s) + (ring_fractionate r s b) (ring_localequiv r s (a,b)) = + ring_fractionate r s a`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(b:A) IN ring_carrier r /\ ring_1 r IN s` + STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[ring_multsys; SUBSET]; ALL_TAC] THEN + REWRITE_TAC[ring_fractionate] THEN + ASM_SIMP_TAC[RING_LOCALIZATION_MUL; RING_MUL_LID; + GSYM RING_LOCALEQUIV_EQUIV; RING_MUL] THEN + REWRITE_TAC[ring_localequiv] THEN ASM_SIMP_TAC[RING_1; RING_MUL] THEN + EXISTS_TAC `ring_1 r:A` THEN ASM_REWRITE_TAC[] THEN + RING_TAC THEN ASM_SIMP_TAC[]);; -let FRACTION_RING_UNIVERSAL = prove - (`!r r' (f:A->B). - ring_homomorphism (r,r') f /\ - (!x. ring_regular r x ==> ring_unit r' (f x)) - ==> ?g. ring_homomorphism(fraction_ring r,r') g /\ - !x. x IN ring_carrier r - ==> g (ring_fractionate r {a | ring_regular r a} x) = f x`, - REPEAT STRIP_TAC THEN REWRITE_TAC[fraction_ring] THEN - MATCH_MP_TAC RING_LOCALIZATION_UNIVERSAL THEN - ASM_REWRITE_TAC[IN_ELIM_THM; RING_MULTSYS_REGULAR]);; +let LOCALEQUIV_MUL_LCANCEL = prove + (`!r s a b:A. + ring_multsys r s /\ a IN ring_carrier r /\ b IN s + ==> ring_mul (ring_localization r s) + (ring_localequiv r s (a,b)) (ring_fractionate r s b) = + ring_fractionate r s a`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(b:A) IN ring_carrier r /\ ring_1 r IN s` + STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[ring_multsys; SUBSET]; ALL_TAC] THEN + REWRITE_TAC[ring_fractionate] THEN + ASM_SIMP_TAC[RING_LOCALIZATION_MUL; RING_MUL_RID; + GSYM RING_LOCALEQUIV_EQUIV; RING_MUL] THEN + REWRITE_TAC[ring_localequiv] THEN ASM_SIMP_TAC[RING_1; RING_MUL] THEN + EXISTS_TAC `ring_1 r:A` THEN ASM_REWRITE_TAC[] THEN + RING_TAC THEN ASM_SIMP_TAC[]);; -let RING_UNIT_FRACTION_RING,RING_ZERODIVISOR_FRACTION_RING = +let RING_LOCALIZATION_HOMOMORPHISM_UNIQUE = prove + (`!r s r' (f:((A#A)->bool)->B) g. + ring_multsys r s /\ + ring_homomorphism(ring_localization r s, r') f /\ + ring_homomorphism(ring_localization r s, r') g /\ + (!x. x IN ring_carrier r + ==> f(ring_fractionate r s x) = g(ring_fractionate r s x)) + ==> !y. y IN ring_carrier(ring_localization r s) ==> f y = g y`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + ASM_SIMP_TAC[RING_LOCALIZATION_CARRIER; FORALL_IN_GSPEC] THEN + MAP_EVERY X_GEN_TAC [`a:A`; `b:A`] THEN STRIP_TAC THEN + SUBGOAL_THEN `(b:A) IN ring_carrier r` ASSUME_TAC THENL + [ASM_MESON_TAC[ring_multsys; SUBSET]; ALL_TAC] THEN + MATCH_MP_TAC(ISPEC `r':B ring` RING_MUL_LCANCEL) THEN + EXISTS_TAC `(g:((A#A)->bool)->B)(ring_fractionate r s (b:A))` THEN + SUBGOAL_THEN + `ring_localequiv r s (a:A,b) IN ring_carrier(ring_localization r s)` + ASSUME_TAC THENL [ASM_SIMP_TAC[RING_LOCALEQUIV_IN_CARRIER]; ALL_TAC] THEN + REPEAT CONJ_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE[ring_homomorphism]) THEN + ASM_MESON_TAC[SUBSET; IN_IMAGE]; + RULE_ASSUM_TAC(REWRITE_RULE[ring_homomorphism]) THEN + ASM_MESON_TAC[SUBSET; IN_IMAGE]; + MATCH_MP_TAC RING_UNIT_HOMOMORPHIC_IMAGE THEN + EXISTS_TAC `ring_localization r (s:A->bool)` THEN + ASM_MESON_TAC[RING_UNIT_FRACTIONATE]; + ALL_TAC] THEN + SUBGOAL_THEN `ring_mul r' ((g:((A#A)->bool)->B)(ring_fractionate r s b)) + (f(ring_localequiv r s (a:A,b))) = + (f:((A#A)->bool)->B)(ring_fractionate r s a) /\ + ring_mul r' ((g:((A#A)->bool)->B)(ring_fractionate r s b)) + (g(ring_localequiv r s (a:A,b))) = + g(ring_fractionate r s a)` (fun th -> ASM_SIMP_TAC[th]) THEN + CONJ_TAC THENL + [SUBGOAL_THEN `(g:((A#A)->bool)->B)(ring_fractionate r s (b:A)) = + f(ring_fractionate r s b)` SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN ASM_SIMP_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL [`ring_localization r (s:A->bool)`; `r':B ring`; + `f:((A#A)->bool)->B`] RING_HOMOMORPHISM_MUL) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPECL + [`ring_fractionate r s (b:A):(A#A)->bool`; + `ring_localequiv r s (a:A,b):(A#A)->bool`]) THEN + ASM_SIMP_TAC[RING_FRACTIONATE_IN_CARRIER; LOCALEQUIV_MUL_RCANCEL]; + MP_TAC(ISPECL [`ring_localization r (s:A->bool)`; `r':B ring`; + `g:((A#A)->bool)->B`] RING_HOMOMORPHISM_MUL) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPECL + [`ring_fractionate r s (b:A):(A#A)->bool`; + `ring_localequiv r s (a:A,b):(A#A)->bool`]) THEN + ASM_SIMP_TAC[RING_FRACTIONATE_IN_CARRIER; LOCALEQUIV_MUL_RCANCEL]]);; + +let RING_LOCALIZATION_UNIQUE = prove + (`!r:A ring s (r':B ring) alpha. + ring_multsys r s /\ + ring_homomorphism (r,r') alpha /\ + (!x. x IN s ==> ring_unit r' (alpha x)) /\ + (!y. y IN ring_carrier r' + ==> ?a b. a IN ring_carrier r /\ b IN s /\ + ring_mul r' y (alpha b) = alpha a) /\ + (!x. x IN ring_carrier r + ==> (alpha x = ring_0 r' <=> + ?c. c IN s /\ ring_mul r c x = ring_0 r)) + ==> r' isomorphic_ring ring_localization r s`, + REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[ISOMORPHIC_RING_SYM] THEN + REWRITE_TAC[isomorphic_ring; GSYM RING_MONOMORPHISM_EPIMORPHISM] THEN + MP_TAC(ISPECL [`r:A ring`; `s:A->bool`; `r':B ring`; `alpha:A->B`] + RING_LOCALIZATION_UNIVERSAL) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `g:(A#A->bool)->B` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `g:(A#A->bool)->B` THEN + SUBGOAL_THEN `!b:A. b IN s ==> b IN ring_carrier r` (LABEL_TAC "scar") THENL + [ASM_MESON_TAC[RING_MULTSYS_IMP_SUBSET; SUBSET]; ALL_TAC] THEN + SUBGOAL_THEN + `!a b. a IN ring_carrier r /\ b IN s + ==> ring_mul r' (g (ring_localequiv r s (a,b))) (alpha b) = + (alpha:A->B) a` + (LABEL_TAC "germ") THENL + [REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`r:A ring`; `s:A->bool`; `a:A`; `b:A`] + LOCALEQUIV_MUL_LCANCEL) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o AP_TERM `g:(A#A->bool)->B`) THEN MP_TAC(ISPECL + [`ring_localization r s:(A#A->bool)ring`; `r':B ring`; `g:(A#A->bool)->B`] + RING_HOMOMORPHISM_MUL) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPECL + [`ring_localequiv r s (a:A,b)`; `ring_fractionate r s (b:A)`]) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC RING_LOCALEQUIV_IN_CARRIER THEN ASM_SIMP_TAC[]; + MATCH_MP_TAC RING_FRACTIONATE_IN_CARRIER THEN ASM_SIMP_TAC[]]; + ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN ASM_SIMP_TAC[]; ALL_TAC] THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[RING_MONOMORPHISM_ALT] THEN + X_GEN_TAC `z:A#A->bool` THEN STRIP_TAC THEN + SUBGOAL_THEN `?a:A b:A. a IN ring_carrier r /\ b IN s /\ + z = ring_localequiv r s (a,b)` + STRIP_ASSUME_TAC THENL + [UNDISCH_TAC `(z:A#A->bool) IN ring_carrier (ring_localization r s)` THEN + ASM_SIMP_TAC[RING_LOCALIZATION_CARRIER; IN_ELIM_THM] THEN MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `(alpha:A->B) a = ring_0 r'` ASSUME_TAC THENL + [USE_THEN "germ" (MP_TAC o SPECL [`a:A`; `b:A`]) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBST1_TAC(SYM(ASSUME `z = ring_localequiv r s (a:A,b)`)) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC RING_MUL_LZERO THEN ASM_MESON_TAC[RING_UNIT_IN_CARRIER]; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN MP_TAC(ISPECL + [`r:A ring`; `s:A->bool`; `a:A`; `b:A`] RING_LOCALEQUIV_EQ_0_GEN) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `a:A` o check(fun th -> + is_forall(concl th) && free_in `ring_0 r:A` (concl th))) THEN + ASM_REWRITE_TAC[]; + REWRITE_TAC[ring_epimorphism] THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[ring_image; EXTENSION; IN_IMAGE] THEN + X_GEN_TAC `y:B` THEN EQ_TAC THENL + [STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[RING_HOMOMORPHISM_IN_CARRIER]; + DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `y:B`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `a:A` (X_CHOOSE_THEN `b:A` STRIP_ASSUME_TAC)) THEN + EXISTS_TAC `ring_localequiv r s (a:A,b)` THEN + SUBGOAL_THEN + `ring_localequiv r s (a:A,b) IN ring_carrier (ring_localization r s)` + ASSUME_TAC THENL + [MATCH_MP_TAC RING_LOCALEQUIV_IN_CARRIER THEN ASM_SIMP_TAC[]; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `ring_mul (r':B ring) y (alpha b) = + ring_mul r' (g (ring_localequiv r s (a:A,b))) (alpha b)` + ASSUME_TAC THENL + [USE_THEN "germ" (MP_TAC o SPECL [`a:A`; `b:A`]) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `ring_unit (r':B ring) (alpha (b:A))` MP_TAC THENL + [ASM_SIMP_TAC[]; ALL_TAC] THEN + REWRITE_TAC[ring_unit] THEN STRIP_TAC THEN + SUBGOAL_THEN + `g (ring_localequiv r s (a:A,b)) IN ring_carrier (r':B ring)` + ASSUME_TAC THENL + [ASM_MESON_TAC[RING_HOMOMORPHISM_IN_CARRIER]; ALL_TAC] THEN + TRANS_TAC EQ_TRANS + `ring_mul (r':B ring) y (ring_mul r' (alpha (b:A)) (x:B))` THEN + CONJ_TAC THENL [ASM_MESON_TAC[RING_MUL_RID]; ALL_TAC] THEN + TRANS_TAC EQ_TRANS + `ring_mul (r':B ring) (g (ring_localequiv r s (a:A,b))) + (ring_mul r' (alpha b) (x:B))` THEN + CONJ_TAC THENL + [SUBGOAL_THEN + `ring_mul (r':B ring) y (ring_mul r' (alpha (b:A)) (x:B)) = + ring_mul r' (ring_mul r' y (alpha b)) x /\ + ring_mul (r':B ring) (g (ring_localequiv r s (a:A,b))) + (ring_mul r' (alpha b) (x:B)) = + ring_mul r' (ring_mul r' (g (ring_localequiv r s (a,b))) (alpha b)) x` + (CONJUNCTS_THEN SUBST1_TAC) THENL + [CONJ_TAC THEN MATCH_MP_TAC RING_MUL_ASSOC THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + USE_THEN "germ" (MP_TAC o SPECL [`a:A`; `b:A`]) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN REFL_TAC; + ASM_MESON_TAC[RING_MUL_RID]]]]);; + +let IDEAL_LOCALIZATION_CONTRACTION = prove + (`!r s (j:A->bool) x. + ring_multsys r s /\ ring_ideal r j /\ x IN ring_carrier r + ==> (ring_fractionate r s x IN + {ring_localequiv r s (a,b) | a,b | a IN j /\ b IN s} + <=> ?c. c IN s /\ ring_mul r c x IN j)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(s:A->bool) SUBSET ring_carrier r /\ ring_1 r IN s` + STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[ring_multsys]; ALL_TAC] THEN + SUBGOAL_THEN `(j:A->bool) SUBSET ring_carrier r` ASSUME_TAC THENL + [ASM_MESON_TAC[ring_ideal]; ALL_TAC] THEN + REWRITE_TAC[ring_fractionate; IN_ELIM_THM] THEN + ASM_SIMP_TAC[RING_LOCALEQUIV_IN_CARRIER; RING_1] THEN EQ_TAC THENL + [DISCH_THEN(X_CHOOSE_THEN `a:A` + (X_CHOOSE_THEN `b:A` STRIP_ASSUME_TAC)) THEN + SUBGOAL_THEN `(a:A) IN ring_carrier r` ASSUME_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `(b:A) IN ring_carrier r` ASSUME_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `ring_localequiv r (s:A->bool) (x,ring_1 r) (a,b)` MP_TAC THENL + [MP_TAC(ISPECL [`r:A ring`; `s:A->bool`; `x:A`; `ring_1 r:A`; `a:A`; `b:A`] + RING_LOCALEQUIV_EQUIV) THEN + ASM_REWRITE_TAC[RING_1] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + ASM_SIMP_TAC[RING_LOCALEQUIV; RING_1] THEN + DISCH_THEN(X_CHOOSE_THEN `u:A` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `ring_mul r u (b:A)` THEN CONJ_TAC THENL + [ASM_MESON_TAC[ring_multsys]; ALL_TAC] THEN + SUBGOAL_THEN `ring_mul r (ring_mul r u b) (x:A) = + ring_mul r u (ring_mul r a (ring_1 r))` MP_TAC THENL + [MP_TAC(RING_RULE + `ring_mul r u (ring_sub r (ring_mul r x b) (ring_mul r a (ring_1 r))):A = + ring_0 r + ==> ring_mul r (ring_mul r u b) x = + ring_mul r u (ring_mul r a (ring_1 r))`) THEN + ASM_MESON_TAC[SUBSET]; + ALL_TAC] THEN + ASM_SIMP_TAC[RING_MUL_RID] THEN DISCH_THEN SUBST1_TAC THEN + MATCH_MP_TAC IN_RING_IDEAL_LMUL THEN ASM_REWRITE_TAC[] THEN + ASM SET_TAC[]; + DISCH_THEN(X_CHOOSE_THEN `c:A` STRIP_ASSUME_TAC) THEN + MAP_EVERY EXISTS_TAC [`ring_mul r c (x:A)`; `c:A`] THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `(c:A) IN ring_carrier r` ASSUME_TAC THENL + [ASM SET_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL [`r:A ring`; `s:A->bool`; `x:A`; `ring_1 r:A`; + `ring_mul r c (x:A)`; `c:A`] + RING_LOCALEQUIV_EQUIV) THEN + ANTS_TAC THENL [ASM_SIMP_TAC[RING_MUL; RING_1]; ALL_TAC] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + ASM_SIMP_TAC[RING_LOCALEQUIV; RING_MUL; RING_1] THEN + EXISTS_TAC `ring_1 r:A` THEN ASM_REWRITE_TAC[] THEN + RING_TAC THEN ASM_SIMP_TAC[]]);; + +let IDEAL_GENERATED_RING_LOCALIZATION = prove + (`!r s (u:A->bool). + ring_multsys r s /\ u SUBSET ring_carrier r + ==> ideal_generated (ring_localization r s) + (IMAGE (ring_fractionate r s) u) = + {ring_localequiv r s (a,b) | a,b | + a IN ideal_generated r u /\ b IN s}`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [MATCH_MP_TAC IDEAL_GENERATED_MINIMAL THEN + ASM_SIMP_TAC[RING_IDEAL_LOCALIZATION; RING_IDEAL_IDEAL_GENERATED] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; ring_fractionate; IN_ELIM_THM] THEN + ASM_MESON_TAC[ring_multsys; IDEAL_GENERATED_INC]; + REWRITE_TAC[SUBSET; FORALL_IN_GSPEC] THEN + MAP_EVERY X_GEN_TAC [`a:A`; `b:A`] THEN STRIP_TAC THEN + SUBGOAL_THEN `(a:A) IN ring_carrier r /\ (b:A) IN ring_carrier r` + STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[IDEAL_GENERATED_SUBSET; SUBSET; ring_multsys]; + ALL_TAC] THEN + ASM_SIMP_TAC[RING_LOCALEQUIV_SPLIT; ring_div] THEN + MATCH_MP_TAC IN_RING_IDEAL_RMUL THEN + REWRITE_TAC[RING_IDEAL_IDEAL_GENERATED] THEN + ASM_SIMP_TAC[RING_FRACTIONATE_IN_CARRIER; RING_INV] THEN + MATCH_MP_TAC(REWRITE_RULE[SUBSET; RIGHT_IMP_FORALL_THM; IMP_IMP] + IDEAL_GENERATED_BY_HOMOMORPHIC_IMAGE) THEN + EXISTS_TAC `r:A ring` THEN + ASM_SIMP_TAC[RING_HOMOMORPHISM_FRACTIONATE; GSYM SUBSET] THEN + ASM SET_TAC[]]);; + +let fraction_ring = new_definition + `fraction_ring (r:A ring) = ring_localization r {a | ring_regular r a}`;; + +let RING_LOCALEQUIV_EQ_0 = prove + (`!r a b:A. + a IN ring_carrier r /\ ring_regular r b + ==> (ring_localequiv r {x | ring_regular r x} (a,b) = + ring_0(fraction_ring r) <=> + a = ring_0 r)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[fraction_ring] THEN + ASM_SIMP_TAC[RING_LOCALEQUIV_EQ_0_GEN; RING_MULTSYS_REGULAR; + IN_ELIM_THM] THEN + REWRITE_TAC[IN_ELIM_THM] THEN EQ_TAC THENL + [REWRITE_TAC[ring_regular; ring_zerodivisor] THEN ASM_MESON_TAC[]; + ASM_MESON_TAC[RING_MUL_RZERO; RING_REGULAR_IN_CARRIER]]);; + +let RING_FRACTIONATE_EQ_0 = prove + (`!r a:A. + a IN ring_carrier r + ==> (ring_fractionate r {x | ring_regular r x} a = + ring_0(fraction_ring r) <=> + a = ring_0 r)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[ring_fractionate] THEN + MATCH_MP_TAC RING_LOCALEQUIV_EQ_0 THEN + ASM_REWRITE_TAC[RING_REGULAR_1]);; + +let RING_MONOMORPHISM_FRACTIONATE = prove + (`!r:A ring. + ring_monomorphism (r,fraction_ring r) + (ring_fractionate r {a | ring_regular r a})`, + SIMP_TAC[fraction_ring; RING_MONOMORPHISM_FRACTIONATE_GEN; + RING_MULTSYS_REGULAR; SUBSET_REFL]);; + +let FRACTION_RING_UNIVERSAL = prove + (`!r r' (f:A->B). + ring_homomorphism (r,r') f /\ + (!x. ring_regular r x ==> ring_unit r' (f x)) + ==> ?g. ring_homomorphism(fraction_ring r,r') g /\ + !x. x IN ring_carrier r + ==> g (ring_fractionate r {a | ring_regular r a} x) = f x`, + REPEAT STRIP_TAC THEN REWRITE_TAC[fraction_ring] THEN + MATCH_MP_TAC RING_LOCALIZATION_UNIVERSAL THEN + ASM_REWRITE_TAC[IN_ELIM_THM; RING_MULTSYS_REGULAR]);; + +let RING_UNIT_FRACTION_RING,RING_ZERODIVISOR_FRACTION_RING = (CONJ_PAIR o prove) (`(!r a b:A. a IN ring_carrier r /\ ring_regular r b @@ -10597,6 +11544,13 @@ let FINITELY_GENERATED_IDEAL_IMP_SUBSET = prove (`!r s:A->bool. finitely_generated_ideal r s ==> s SUBSET ring_carrier r`, MESON_TAC[finitely_generated_ideal; IDEAL_GENERATED_SUBSET]);; +let FINITELY_GENERATED_IDEAL_SUBSET = prove + (`!(r:A ring) j. + finitely_generated_ideal r j <=> + ?s. FINITE s /\ s SUBSET j /\ s SUBSET ring_carrier r /\ + ideal_generated r s = j`, + MESON_TAC[finitely_generated_ideal; IDEAL_GENERATED_SUBSET_CARRIER_SUBSET]);; + let PRIME_IMP_PROPER_IDEAL = prove (`!r j:A->bool. prime_ideal r j ==> proper_ideal r j`, SIMP_TAC[prime_ideal]);; @@ -10788,6 +11742,33 @@ let PRINCIPAL_IDEAL_EPIMORPHIC_IMAGE = prove ASM_MESON_TAC[IMAGE_CLAUSES; SING_SUBSET; IDEAL_GENERATED_BY_EPIMORPHIC_IMAGE]);; +let FINITELY_GENERATED_IDEAL_LOCALIZATION = prove + (`!r s (j:A->bool). + ring_multsys r s /\ finitely_generated_ideal r j + ==> finitely_generated_ideal (ring_localization r s) + {ring_localequiv r s (a,b) | a,b | a IN j /\ b IN s}`, + REPEAT GEN_TAC THEN + REWRITE_TAC[finitely_generated_ideal; IMP_CONJ; LEFT_IMP_EXISTS_THM] THEN + DISCH_TAC THEN X_GEN_TAC `k:A->bool` THEN REPEAT STRIP_TAC THEN + EXISTS_TAC `IMAGE (ring_fractionate (r:A ring) s) k` THEN + ASM_SIMP_TAC[IDEAL_GENERATED_RING_LOCALIZATION; FINITE_IMAGE] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + ASM_MESON_TAC[RING_FRACTIONATE_IN_CARRIER; SUBSET]);; + +let PRINCIPAL_IDEAL_LOCALIZATION = prove + (`!r s (j:A->bool). + ring_multsys r s /\ principal_ideal r j + ==> principal_ideal (ring_localization r s) + {ring_localequiv r s (a,b) | a,b | a IN j /\ b IN s}`, + REPEAT GEN_TAC THEN + REWRITE_TAC[principal_ideal; IMP_CONJ; LEFT_IMP_EXISTS_THM] THEN + DISCH_TAC THEN X_GEN_TAC `a:A` THEN REPEAT STRIP_TAC THEN + EXISTS_TAC `ring_fractionate (r:A ring) s a` THEN CONJ_TAC THENL + [ASM_MESON_TAC[RING_FRACTIONATE_IN_CARRIER; SUBSET]; ALL_TAC] THEN + FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN + ASM_SIMP_TAC[GSYM IDEAL_GENERATED_RING_LOCALIZATION; SING_SUBSET] THEN + REWRITE_TAC[IMAGE_CLAUSES]);; + let PROPER_IDEAL_HOMOMORPHIC_PREIMAGE = prove (`!r r' (f:A->B) j. ring_homomorphism(r,r') f /\ proper_ideal r' j @@ -11026,6 +12007,125 @@ let PRIME_IDEAL_EXCLUDING_EXISTS = prove PRIME_SUPERIDEAL_EXCLUDING_EXISTS) THEN ASM_REWRITE_TAC[RING_IDEAL_0; DISJOINT_SING] THEN MESON_TAC[]);; +let MAXIMAL_NONFG_IMP_PRIME_IDEAL = prove + (`!r j:A->bool. + ring_ideal r j /\ ~finitely_generated_ideal r j /\ + (!j'. ring_ideal r j' /\ j PSUBSET j' ==> finitely_generated_ideal r j') + ==> prime_ideal r j`, + let eqlemma = prove + (`!r s t:A->bool. + ring_setadd r s t = IMAGE (\(x,y). ring_add r x y) (s CROSS t)`, + REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_IMAGE; + EXISTS_PAIR_THM; IN_CROSS] THEN + REWRITE_TAC[ring_setadd; IN_ELIM_THM] THEN MESON_TAC[]) + and sublemma = prove + (`!r s:A#A->bool. + IMAGE (\(x,y). ring_add r x y) s SUBSET + ring_setadd r (IMAGE FST s) (IMAGE SND s)`, + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + REWRITE_TAC[FORALL_PAIR_THM] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC RING_ADD_IN_SETADD THEN + REWRITE_TAC[IN_IMAGE; EXISTS_PAIR_THM] THEN ASM_MESON_TAC[]) in + REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP RING_IDEAL_IMP_SUBSET) THEN + ASM_REWRITE_TAC[prime_ideal; proper_ideal; PSUBSET] THEN CONJ_TAC THENL + [ASM_MESON_TAC[FINITELY_GENERATED_IDEAL_CARRIER]; ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`a:A`; `b:A`] THEN + REWRITE_TAC[TAUT `p \/ q <=> ~(~p /\ ~q)`] THEN REPEAT STRIP_TAC THEN + ABBREV_TAC `J = ideal_generated r ((a:A) INSERT j)` THEN + FIRST_ASSUM(MP_TAC o SPEC `J:A->bool`) THEN + MATCH_MP_TAC(TAUT `p /\ (p ==> ~q) ==> (p ==> q) ==> F`) THEN CONJ_TAC THENL + [EXPAND_TAC "J" THEN REWRITE_TAC[RING_IDEAL_IDEAL_GENERATED] THEN + REWRITE_TAC[PSUBSET_ALT] THEN CONJ_TAC THENL + [W(MP_TAC o PART_MATCH (rand o rand) + IDEAL_GENERATED_SUBSET_CARRIER_SUBSET o rand o snd) THEN + ASM SET_TAC[]; + EXISTS_TAC `a:A` THEN ASM_MESON_TAC[IDEAL_GENERATED_INC_GEN; IN_INSERT]]; + REPEAT STRIP_TAC] THEN + FIRST_X_ASSUM(MP_TAC o + GEN_REWRITE_RULE I [FINITELY_GENERATED_IDEAL_SUBSET]) THEN + EXPAND_TAC "J" THEN REWRITE_TAC[] THEN + GEN_REWRITE_TAC (RAND_CONV o BINDER_CONV o RAND_CONV o LAND_CONV o RAND_CONV) + [IDEAL_GENERATED_INSERT] THEN + ASM_SIMP_TAC[IDEAL_GENERATED_RING_IDEAL] THEN + REWRITE_TAC[eqlemma; EXISTS_FINITE_SUBSET_IMAGE] THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `G:A#A->bool` STRIP_ASSUME_TAC) THEN + ABBREV_TAC `K = {x:A | x IN ring_carrier r /\ ring_mul r a x IN j}` THEN + FIRST_X_ASSUM(MP_TAC o SPEC `K:A->bool`) THEN + MATCH_MP_TAC(TAUT `p /\ (p ==> ~q) ==> (p ==> q) ==> F`) THEN CONJ_TAC THENL + [EXPAND_TAC "K" THEN ASM_SIMP_TAC[RING_IDEAL_QUOTIENT_LMUL] THEN + EXPAND_TAC "K" THEN REWRITE_TAC[PSUBSET_ALT; IN_ELIM_THM; SUBSET] THEN + ASM_MESON_TAC[IN_RING_IDEAL_LMUL; SUBSET]; + STRIP_TAC] THEN + REWRITE_TAC[finitely_generated_ideal] THEN + DISCH_THEN(X_CHOOSE_THEN `H:A->bool` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV + [finitely_generated_ideal]) THEN + ASM_REWRITE_TAC[] THEN + EXISTS_TAC `IMAGE (ring_mul r a) H UNION IMAGE SND (G:A#A->bool)` THEN + ASM_SIMP_TAC[FINITE_UNION; FINITE_IMAGE] THEN + ASM_SIMP_TAC[IDEAL_GENERATED_MINIMAL_EQ; GSYM SUBSET_ANTISYM_EQ] THEN + MATCH_MP_TAC(SET_RULE + `j SUBSET r /\ s SUBSET j /\ (s SUBSET j ==> j SUBSET k) + ==> s SUBSET r /\ r INTER s SUBSET j /\ j SUBSET k`) THEN + ASM_REWRITE_TAC[UNION_SUBSET] THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN CONJ_TAC THENL + [FIRST_ASSUM(MP_TAC o MATCH_MP IDEAL_GENERATED_SUBSET_CARRIER_SUBSET) THEN + ASM SET_TAC[]; + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `G SUBSET s ==> (!x. x IN s ==> P x) ==> (!x. x IN G ==> P x)`)) THEN + SIMP_TAC[FORALL_PAIR_THM; IN_CROSS]]; + STRIP_TAC] THEN + REWRITE_TAC[SUBSET] THEN X_GEN_TAC `z:A` THEN DISCH_TAC THEN + SUBGOAL_THEN `z IN ideal_generated r ((a:A) INSERT j)` MP_TAC THENL + [MATCH_MP_TAC IDEAL_GENERATED_INC THEN + ASM_REWRITE_TAC[IN_INSERT; INSERT_SUBSET]; + ASM_REWRITE_TAC[] THEN EXPAND_TAC "J"] THEN + W(MP_TAC o PART_MATCH lhand sublemma o + rand o rand o lhand o snd) THEN + DISCH_THEN(MP_TAC o SPEC `r:A ring` o MATCH_MP IDEAL_GENERATED_MONO) THEN + W(MP_TAC o PART_MATCH (lhand o rand) IDEAL_GENERATED_SETADD_SUBSET o + rand o lhand o snd) THEN + ANTS_TAC THENL + [CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `G SUBSET s ==> (!x. x IN s ==> P x) ==> (!x. x IN G ==> P x)`)) THEN + SIMP_TAC[FORALL_PAIR_THM; IN_CROSS] THEN + MESON_TAC[SUBSET; IDEAL_GENERATED_SUBSET]; + REWRITE_TAC[IMP_IMP; GSYM CONJ_ASSOC]] THEN + DISCH_THEN(MP_TAC o MATCH_MP (SET_RULE + `t SUBSET u /\ s SUBSET t /\ x IN s ==> x IN u`)) THEN + UNDISCH_TAC `(z:A) IN j` THEN + ONCE_REWRITE_TAC[TAUT `p ==> q ==> r <=> q ==> p ==> r`] THEN + SPEC_TAC(`z:A`,`z:A`) THEN REWRITE_TAC[IDEAL_GENERATED_UNION] THEN + REWRITE_TAC[ring_setadd; FORALL_IN_GSPEC] THEN + MAP_EVERY X_GEN_TAC [`x:A`; `y:A`] THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[IN_ELIM_THM] THEN + MAP_EVERY EXISTS_TAC [`x:A`; `y:A`] THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `(x:A) IN j` MP_TAC THENL + [SUBGOAL_THEN `(x:A) = ring_sub r (ring_add r x y) y` SUBST1_TAC THENL + [RING_TAC THEN ASM_MESON_TAC[SUBSET; IDEAL_GENERATED_SUBSET]; + MATCH_MP_TAC IN_RING_IDEAL_SUB THEN ASM_REWRITE_TAC[]] THEN + ASM_MESON_TAC[IDEAL_GENERATED_MINIMAL; SUBSET]; + ALL_TAC] THEN + SUBGOAL_THEN `x IN ideal_generated r {a:A}` MP_TAC THENL + [ONCE_REWRITE_TAC[GSYM IDEAL_GENERATED_BY_IDEAL_GENERATED] THEN + UNDISCH_TAC `x IN ideal_generated r (IMAGE FST (G:A#A->bool))` THEN + MATCH_MP_TAC(SET_RULE `s SUBSET t ==> x IN s ==> x IN t`) THEN + MATCH_MP_TAC IDEAL_GENERATED_MONO THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `G SUBSET s ==> (!x. x IN s ==> P x) ==> (!x. x IN G ==> P x)`)) THEN + SIMP_TAC[FORALL_PAIR_THM; IN_CROSS]; + ASM_SIMP_TAC[IN_IDEAL_GENERATED_SING_EQ; ring_divides] THEN + DISCH_THEN(X_CHOOSE_THEN `w:A` (CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC) o + CONJUNCT2) THEN + DISCH_TAC] THEN + ASM_SIMP_TAC[IDEAL_GENERATED_SCALE; IN_IMAGE] THEN EXISTS_TAC `w:A` THEN + ASM SET_TAC[]);; + let PRIME_IDEAL_SING = prove (`!r a:A. prime_ideal r (ideal_generated r {a}) <=> if ~(a IN ring_carrier r) \/ a = ring_0 r then integral_domain r @@ -12716,22 +13816,6 @@ let PID_EQ_UFD_PRIME_MAXIMAL = prove (* Multiplying frac(b) by a/b gives frac(a) *) -let LOCALEQUIV_MUL_CANCEL = prove - (`!r s a b:A. - ring_multsys r s /\ a IN ring_carrier r /\ b IN s - ==> ring_mul (ring_localization r s) (ring_fractionate r s b) - (ring_localequiv r s (a,b)) = ring_fractionate r s a`, - REPEAT STRIP_TAC THEN - SUBGOAL_THEN `(b:A) IN ring_carrier r /\ ring_1 r IN s` - STRIP_ASSUME_TAC THENL - [ASM_MESON_TAC[ring_multsys; SUBSET]; ALL_TAC] THEN - REWRITE_TAC[ring_fractionate] THEN - ASM_SIMP_TAC[RING_LOCALIZATION_MUL; RING_MUL_LID; - GSYM RING_LOCALEQUIV_EQUIV; RING_MUL] THEN - REWRITE_TAC[ring_localequiv] THEN ASM_SIMP_TAC[RING_1; RING_MUL] THEN - EXISTS_TAC `ring_1 r:A` THEN ASM_REWRITE_TAC[] THEN - RING_TAC THEN ASM_SIMP_TAC[]);; - (* If p divides a in r, frac(p) divides a/b *) let RING_DIVIDES_LOCALEQUIV = prove @@ -12796,7 +13880,7 @@ let UFD_LOCALIZATION = prove [FIRST_X_ASSUM(MP_TAC o SPEC `a0:A` o GEN_REWRITE_RULE I [EXTENSION]) THEN EXPAND_TAC "jj" THEN REWRITE_TAC[IN_ELIM_THM; IN_SING] THEN - ASM_MESON_TAC[LOCALEQUIV_MUL_CANCEL; IN_RING_IDEAL_LMUL; + ASM_MESON_TAC[LOCALEQUIV_MUL_RCANCEL; IN_RING_IDEAL_LMUL; PRIME_IMP_RING_IDEAL; RING_FRACTIONATE_IN_CARRIER; ring_multsys; SUBSET]; ALL_TAC] THEN @@ -12904,6 +13988,192 @@ let UFD_LOCALIZATION = prove MATCH_MP_TAC RING_DIVIDES_HOMOMORPHIC_IMAGE THEN EXISTS_TAC `r:A ring` THEN ASM_SIMP_TAC[RING_HOMOMORPHISM_FRACTIONATE]);; +let PROPER_IDEAL_LOCALIZATION = prove + (`!r s (j:A->bool). + ring_multsys r s /\ ring_ideal r j /\ j INTER s = {} + ==> proper_ideal (ring_localization r s) + {ring_localequiv r s (a,b) | a,b | a IN j /\ b IN s}`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[PROPER_IDEAL; RING_IDEAL_LOCALIZATION] THEN + ASM_SIMP_TAC[RING_LOCALIZATION_1; IN_ELIM_THM; NOT_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`a:A`; `b:A`] THEN + DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN + SUBGOAL_THEN + `(a:A) IN ring_carrier r /\ b IN ring_carrier r /\ ring_1 r IN s` + STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[ring_multsys; ring_ideal; SUBSET]; ALL_TAC] THEN + ASM_SIMP_TAC[GSYM RING_LOCALEQUIV_EQUIV; RING_1] THEN + ASM_SIMP_TAC[RING_LOCALEQUIV; RING_1; NOT_EXISTS_THM] THEN + X_GEN_TAC `u:A` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + SUBGOAL_THEN `(u:A) IN ring_carrier r` ASSUME_TAC THENL + [ASM_MESON_TAC[ring_multsys; SUBSET]; ALL_TAC] THEN + ASM_SIMP_TAC[RING_MUL_LID; RING_MUL_RID; RING_SUB_EQ_0; + RING_SUB_LDISTRIB; RING_MUL] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `j INTER s = {} ==> y IN j /\ x IN s ==> ~(x = y)`)) THEN + ASM_MESON_TAC[ring_multsys; ring_ideal]);; + +let RING_LOCALEQUIV_IN_LOCALIZED_IDEAL = prove + (`!r (s:A->bool) p a b. + ring_multsys r s /\ prime_ideal r p /\ p INTER s = {} /\ + a IN ring_carrier r /\ b IN s + ==> (ring_localequiv r s (a,b) IN + {ring_localequiv r s (a',b') | a',b' | a' IN p /\ b' IN s} + <=> a IN p)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN + EQ_TAC THENL [REWRITE_TAC[LEFT_IMP_EXISTS_THM]; ASM_MESON_TAC[]] THEN + MAP_EVERY X_GEN_TAC [`a':A`; `b':A`] THEN + DISCH_THEN(CONJUNCTS_THEN2 STRIP_ASSUME_TAC MP_TAC) THEN + SUBGOAL_THEN `(a':A) IN ring_carrier r` ASSUME_TAC THENL + [ASM_MESON_TAC[prime_ideal; proper_ideal; ring_ideal; SUBSET]; + ASM_SIMP_TAC[GSYM RING_LOCALEQUIV_EQUIV]] THEN + ASM_SIMP_TAC[RING_LOCALEQUIV; IMP_CONJ; LEFT_IMP_EXISTS_THM] THEN + REPEAT DISCH_TAC THEN X_GEN_TAC `u:A` THEN DISCH_TAC THEN + SUBGOAL_THEN `(u:A) IN ring_carrier r` ASSUME_TAC THENL + [ASM_MESON_TAC[RING_MULTSYS_IMP_SUBSET; SUBSET]; + ASM_SIMP_TAC[RING_SUB_LDISTRIB; RING_MUL; RING_SUB_EQ_0]] THEN + MATCH_MP_TAC(SET_RULE + `(x IN p ==> a IN p) /\ y IN p ==> x = y ==> a IN p`) THEN + ASM_SIMP_TAC[RING_MUL_IN_PRIME_IDEAL; RING_MUL] THEN ASM SET_TAC[]);; + +let PRIME_IDEAL_LOCALIZATION_CONTRACTION = prove + (`!r s (p:A->bool) x. + ring_multsys r s /\ prime_ideal r p /\ p INTER s = {} /\ + x IN ring_carrier r + ==> (ring_fractionate r s x IN + {ring_localequiv r s (a,b) | a,b | a IN p /\ b IN s} + <=> x IN p)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[ring_fractionate] THEN + MATCH_MP_TAC RING_LOCALEQUIV_IN_LOCALIZED_IDEAL THEN + ASM_MESON_TAC[ring_multsys]);; + +let PRIME_IDEAL_LOCALIZATION = prove + (`!r s (p:A->bool). + ring_multsys r s /\ prime_ideal r p /\ p INTER s = {} + ==> prime_ideal (ring_localization r s) + {ring_localequiv r s (a,b) | a,b | a IN p /\ b IN s}`, + REPEAT STRIP_TAC THEN REWRITE_TAC[prime_ideal] THEN CONJ_TAC THENL + [ASM_SIMP_TAC[PROPER_IDEAL_LOCALIZATION; PRIME_IMP_RING_IDEAL]; + ASM_SIMP_TAC[RING_LOCALIZATION_CARRIER]] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REWRITE_TAC[FORALL_IN_GSPEC] THEN + MAP_EVERY X_GEN_TAC [`a1:A`; `b1:A`] THEN STRIP_TAC THEN + MAP_EVERY X_GEN_TAC [`a2:A`; `b2:A`] THEN STRIP_TAC THEN + ASM_SIMP_TAC[RING_LOCALIZATION_MUL] THEN + SUBGOAL_THEN `ring_mul r b1 (b2:A) IN s` ASSUME_TAC THENL + [ASM_MESON_TAC[ring_multsys]; + ASM_SIMP_TAC[RING_LOCALEQUIV_IN_LOCALIZED_IDEAL; RING_MUL]] THEN + ASM_MESON_TAC[RING_MUL_IN_PRIME_IDEAL]);; + +let PRIME_IDEAL_LOCALIZATION_EXISTS = prove + (`!r (s:A->bool) q. + ring_multsys r s /\ + prime_ideal (ring_localization r s) q + ==> ?p. prime_ideal r p /\ p INTER s = {} /\ + q = {ring_localequiv r s (a,b) | a,b | a IN p /\ b IN s}`, + REPEAT STRIP_TAC THEN + EXISTS_TAC `{a:A | a IN ring_carrier r /\ ring_fractionate r s a IN q}` THEN + SUBGOAL_THEN `ring_ideal (ring_localization r (s:A->bool)) q` ASSUME_TAC THENL + [ASM_MESON_TAC[prime_ideal; proper_ideal]; ALL_TAC] THEN + MATCH_MP_TAC(TAUT `a /\ b /\ (a ==> c) ==> a /\ b /\ c`) THEN + REPEAT CONJ_TAC THENL + [MP_TAC(ISPECL [`r:A ring`; `ring_localization r (s:A->bool)`; + `ring_fractionate r (s:A->bool)`; `q:(A#A->bool)->bool`] + PRIME_IDEAL_HOMOMORPHIC_PREIMAGE) THEN + ASM_SIMP_TAC[RING_HOMOMORPHISM_FRACTIONATE] THEN + REWRITE_TAC[ring_fractionate; ETA_AX]; + REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM; NOT_IN_EMPTY] THEN + X_GEN_TAC `c:A` THEN STRIP_TAC THEN + MP_TAC(ISPECL [`r:A ring`; `s:A->bool`; `c:A`] RING_UNIT_FRACTIONATE) THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(ISPEC `ring_localization r (s:A->bool)` PROPER_IDEAL_UNIT) THEN + REWRITE_TAC[DISJOINT; EXTENSION; IN_INTER; IN_ELIM_THM; NOT_IN_EMPTY] THEN + ASM_MESON_TAC[prime_ideal]; + DISCH_TAC] THEN + MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN + X_GEN_TAC `z:(A#A->bool)` THEN DISCH_TAC THEN + SUBGOAL_THEN `(z:(A#A->bool)) IN ring_carrier(ring_localization r s)` + ASSUME_TAC THENL [ASM_MESON_TAC[ring_ideal; SUBSET]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV + [MATCH_MP RING_LOCALIZATION_CARRIER + (ASSUME `ring_multsys r (s:A->bool)`)]) THEN + REWRITE_TAC[IN_ELIM_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `a:A` (X_CHOOSE_THEN `b:A` STRIP_ASSUME_TAC)) THEN + MAP_EVERY EXISTS_TAC [`a:A`; `b:A`] THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `ring_fractionate r s (a:A) = + ring_mul (ring_localization r (s:A->bool)) z (ring_fractionate r s b)` + SUBST1_TAC THENL + [ONCE_ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(GSYM LOCALEQUIV_MUL_LCANCEL) THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC(ISPEC + `ring_localization r (s:A->bool)` IN_RING_IDEAL_RMUL) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC RING_FRACTIONATE_IN_CARRIER THEN + ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP RING_MULTSYS_IMP_SUBSET) THEN + ASM SET_TAC[]]; + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN + X_GEN_TAC `z:(A#A->bool)` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `(b:A) IN ring_carrier r` ASSUME_TAC THENL + [FIRST_ASSUM(MP_TAC o MATCH_MP RING_MULTSYS_IMP_SUBSET) THEN ASM SET_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `ring_1 r IN (s:A->bool)` ASSUME_TAC THENL + [MP_TAC(CONJUNCT1(CONJUNCT2 RING_MULTSYS)) THEN + DISCH_THEN(MP_TAC o SPECL [`r:A ring`; `s:A->bool`]) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `ring_localequiv r s (a:A,b) = + ring_mul (ring_localization r (s:A->bool)) + (ring_localequiv r s (ring_1 r, b)) + (ring_fractionate r s a)` SUBST1_TAC THENL + [REWRITE_TAC[ring_fractionate] THEN + ASM_SIMP_TAC[RING_LOCALIZATION_MUL; RING_1] THEN + SUBGOAL_THEN + `ring_localequiv r s + (ring_mul r (ring_1 r) a, ring_mul r b (ring_1 r)) (a:A, b)` + MP_TAC THENL + [ASM_SIMP_TAC[RING_LOCALEQUIV; RING_MUL; RING_1] THEN + ASM_SIMP_TAC[RING_MUL_LID; RING_MUL_RID; RING_MUL] THEN + EXISTS_TAC `ring_1 r:A` THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[RING_SUB_REFL; RING_MUL; RING_MUL_RZERO; RING_1]; + DISCH_TAC THEN FIRST_ASSUM(MP_TAC o REWRITE_RULE + [MATCH_MP RING_LOCALEQUIV_SYM + (ASSUME `ring_multsys r (s:A->bool)`)]) THEN + ASM_SIMP_TAC[RING_LOCALEQUIV_EQUIV; RING_MUL; RING_1; RING_MULTSYS]]; + MATCH_MP_TAC(ISPEC `ring_localization r (s:A->bool)` + IN_RING_IDEAL_LMUL) THEN + ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[RING_LOCALEQUIV_IN_CARRIER; RING_1]]]);; + +let RING_LOCALIZATION_PRIME_IDEAL_CORRESPONDENCE = prove + (`!r:A ring s Q. + ring_multsys r s + ==> (prime_ideal (ring_localization r s) Q <=> + ?p. prime_ideal r p /\ p INTER s = {} /\ + {x | x IN ring_carrier r /\ ring_fractionate r s x IN Q} = p /\ + {ring_localequiv r s (a,b) | a,b | a IN p /\ b IN s} = Q)`, + REPEAT STRIP_TAC THEN EQ_TAC THENL + [DISCH_TAC THEN + MP_TAC(ISPECL [`r:A ring`;`s:A->bool`;`Q:(A#A->bool)->bool`] + PRIME_IDEAL_LOCALIZATION_EXISTS) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `p:A->bool` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `ring_ideal (r:A ring) p` ASSUME_TAC THENL + [ASM_MESON_TAC[PRIME_IMP_RING_IDEAL]; ALL_TAC] THEN + GEN_REWRITE_TAC I [EXTENSION] THEN X_GEN_TAC `x:A` THEN + MP_TAC(ISPECL [`r:A ring`;`s:A->bool`;`p:A->bool`;`x:A`] + PRIME_IDEAL_LOCALIZATION_CONTRACTION) THEN + ASM_CASES_TAC `(x:A) IN ring_carrier r` THENL + [ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + REWRITE_TAC[IN_ELIM_THM] THEN + RULE_ASSUM_TAC(REWRITE_RULE[IN_ELIM_THM]) THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[IN_ELIM_THM] THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[PRIME_IDEAL_IMP_SUBSET; SUBSET]]; + STRIP_TAC THEN EXPAND_TAC "Q" THEN + MATCH_MP_TAC PRIME_IDEAL_LOCALIZATION THEN ASM_REWRITE_TAC[]]);; + (* ------------------------------------------------------------------------- *) (* Euclidean rings. *) (* ------------------------------------------------------------------------- *) @@ -13447,6 +14717,47 @@ let NOETHERIAN_PRODUCT_RING = prove REWRITE_TAC[CARTESIAN_PRODUCT_EQ_EMPTY; NOT_INSERT_EMPTY] THEN ASM_SIMP_TAC[CARTESIAN_PRODUCT_EQ; IDEAL_GENERATED_INSERT_ZERO]]);; +let NOETHERIAN_RING_EQ_FG_PRIME_IDEALS = prove + (`!r:A ring. + noetherian_ring r <=> + !j. prime_ideal r j ==> finitely_generated_ideal r j`, + GEN_TAC THEN REWRITE_TAC[noetherian_ring] THEN EQ_TAC THENL + [MESON_TAC[PRIME_IMP_RING_IDEAL]; STRIP_TAC] THEN + GEN_REWRITE_TAC I [MESON[] `(!x. P x ==> Q x) <=> ~(?x. P x /\ ~Q x)`] THEN + DISCH_TAC THEN + MP_TAC(ISPEC `\j:A->bool. ring_ideal r j /\ ~finitely_generated_ideal r j` + ZL_SUBSETS_UNIONS_NONEMPTY) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[MEMBER_NOT_EMPTY; PROPER_IDEAL] THEN + SIMP_TAC[RING_IDEAL_UNIONS] THEN + X_GEN_TAC `c:(A->bool)->bool` THEN STRIP_TAC THEN + REWRITE_TAC[finitely_generated_ideal] THEN + DISCH_THEN(X_CHOOSE_THEN `k:A->bool` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`c:(A->bool)->bool`; `k:A->bool`] + FINITE_SUBSET_UNIONS_CHAIN) THEN + ASM_REWRITE_TAC[NOT_IMP] THEN CONJ_TAC THENL + [ASM_MESON_TAC[IDEAL_GENERATED_SUBSET_CARRIER_SUBSET]; + DISCH_THEN(X_CHOOSE_THEN `j:A->bool` STRIP_ASSUME_TAC)] THEN + SUBGOAL_THEN `finitely_generated_ideal r (j:A->bool)` + (fun th -> ASM_MESON_TAC[th]) THEN + REWRITE_TAC[finitely_generated_ideal] THEN EXISTS_TAC `k:A->bool` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN + CONJ_TAC THENL [ALL_TAC; ASM SET_TAC[]] THEN + ASM_MESON_TAC[IDEAL_GENERATED_MINIMAL]; + ASM_MESON_TAC[MAXIMAL_NONFG_IMP_PRIME_IDEAL; PSUBSET]]);; + +let NOETHERIAN_RING_LOCALIZATION = prove + (`!r (s:A->bool). + ring_multsys r s /\ noetherian_ring r + ==> noetherian_ring (ring_localization r s)`, + REPEAT GEN_TAC THEN REWRITE_TAC[NOETHERIAN_RING_EQ_FG_PRIME_IDEALS] THEN + STRIP_TAC THEN X_GEN_TAC `j:(A#A->bool)->bool` THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `j:(A#A->bool)->bool` o + MATCH_MP RING_LOCALIZATION_PRIME_IDEAL_CORRESPONDENCE) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `p:A->bool` THEN STRIP_TAC THEN + EXPAND_TAC "j" THEN ASM_SIMP_TAC[FINITELY_GENERATED_IDEAL_LOCALIZATION]);; + (* ------------------------------------------------------------------------- *) (* The special case of ACC for principal ideals (ACCP), which holds in UFDs. *) (* ------------------------------------------------------------------------- *) @@ -13633,13 +14944,12 @@ let NOETHERIAN_DOMAIN_ATOMIC = prove let NOETHERIAN_DOMAIN_IRREDUCIBLE_FACTOR_EXISTS = prove (`!r x:A. - integral_domain r /\ - (noetherian_ring r \/ UFD r) /\ + (integral_domain r /\ noetherian_ring r \/ UFD r) /\ x IN ring_carrier r /\ ~(x = ring_0 r) /\ ~(ring_unit r x) ==> ?p. ring_irreducible r p /\ ring_divides r p x`, - REPEAT GEN_TAC THEN DISCH_TAC THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC ACCP_DOMAIN_IRREDUCIBLE_FACTOR_EXISTS THEN - ASM_SIMP_TAC[RING_DIVIDES_WF]);; + ASM_SIMP_TAC[UFD_IMP_INTEGRAL_DOMAIN; RING_DIVIDES_WF]);; let UFD_EQ_ACCP = prove (`!r:A ring. @@ -13997,6 +15307,29 @@ let BEZOUT_RING_IMP_GCD = prove MAP_EVERY EXISTS_TAC [`ring_mul r x u:A`; `ring_mul r y u:A`] THEN ASM_SIMP_TAC[RING_MUL_ASSOC; RING_MUL; GSYM RING_ADD_RDISTRIB]);; +let BEZOUT_RING = prove + (`!r:A ring. + bezout_ring r <=> + !a b. a IN ring_carrier r /\ b IN ring_carrier r + ==> ?d x y. d IN ring_carrier r /\ + x IN ring_carrier r /\ y IN ring_carrier r /\ + ring_add r (ring_mul r a x) (ring_mul r b y) = d /\ + ring_divides r d a /\ ring_divides r d b`, + GEN_TAC THEN EQ_TAC THENL + [REPEAT STRIP_TAC THEN EXISTS_TAC `ring_gcd r (a:A,b)` THEN + ASM_SIMP_TAC[RING_GCD_DIVIDES; RING_GCD; BEZOUT_RING_IMP_GCD]; + DISCH_TAC THEN REWRITE_TAC[BEZOUT_RING_2; principal_ideal]] THEN + MAP_EVERY X_GEN_TAC [`a:A`; `b:A`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`a:A`; `b:A`]) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `d:A` THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`u:A`; `v:A`] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC SUBSET_ANTISYM THEN + CONJ_TAC THEN MATCH_MP_TAC IDEAL_GENERATED_MINIMAL THEN + ASM_SIMP_TAC[RING_IDEAL_IDEAL_GENERATED; INSERT_SUBSET; EMPTY_SUBSET] THENL + [ASM_SIMP_TAC[IDEAL_GENERATED_2; IN_ELIM_THM] THEN ASM SET_TAC[]; + ASM_SIMP_TAC[IDEAL_GENERATED_SING; IN_ELIM_THM]]);; + let BEZOUT_RING_COPRIME = prove (`!r a b:A. bezout_ring r @@ -14169,6 +15502,59 @@ let ISOMORPHIC_RING_BEZOUTNESS = prove ASM_MESON_TAC[BEZOUT_RING_EPIMORPHIC_IMAGE; RING_ISOMORPHISM_IMP_EPIMORPHISM]);; +let RING_COPRIME_HOMOMORPHIC_IMAGE = prove + (`!r s (f:A->B) a b. + ring_homomorphism(r,s) f /\ + bezout_ring r /\ + ring_coprime r (a,b) + ==> ring_coprime s (f a, f b)`, + REPEAT GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN DISCH_TAC THEN + SIMP_TAC[BEZOUT_RING_COPRIME] THEN REPEAT STRIP_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[ring_homomorphism; SUBSET; FORALL_IN_IMAGE]) THEN + FIRST_X_ASSUM(MP_TAC o AP_TERM `f:A->B`) THEN ASM_SIMP_TAC[RING_MUL] THEN + ASM_SIMP_TAC[ring_coprime; RING_UNIT_DIVIDES] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + ASM_MESON_TAC[RING_DIVIDES_RMUL; RING_DIVIDES_ADD]);; + +let BEZOUT_RING_LOCALIZATION = prove + (`!r (s:A->bool). + ring_multsys r s /\ bezout_ring r + ==> bezout_ring (ring_localization r s)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[BEZOUT_RING] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ring_multsys]) THEN + REWRITE_TAC[SUBSET] THEN STRIP_TAC THEN + ASM_SIMP_TAC[RING_LOCALIZATION_CARRIER] THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_IN_GSPEC] THEN + X_GEN_TAC `a:A` THEN DISCH_TAC THEN X_GEN_TAC `p:A` THEN DISCH_TAC THEN + X_GEN_TAC `b:A` THEN DISCH_TAC THEN X_GEN_TAC `q:A` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`a:A`; `b:A`] o + GEN_REWRITE_RULE I [BEZOUT_RING]) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`d:A`; `x:A`; `y:A`] THEN STRIP_TAC THEN + MAP_EVERY EXISTS_TAC + [`ring_fractionate r s (d:A)`; + `ring_fractionate r s (ring_mul r p x:A)`; + `ring_fractionate r s (ring_mul r q y:A)`] THEN + ASM_SIMP_TAC[RING_FRACTIONATE_IN_CARRIER; GSYM RING_LOCALIZATION_CARRIER; + RING_DIVIDES_LOCALEQUIV; RING_MUL] THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP RING_HOMOMORPHISM_FRACTIONATE) THEN + REWRITE_TAC[ring_homomorphism; SUBSET; FORALL_IN_IMAGE] THEN + STRIP_TAC THEN ASM_SIMP_TAC[RING_MUL] THEN + ASM (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 6) + [ring_fractionate; RING_LOCALIZATION_MUL; RING_LOCALIZATION_ADD; + RING_MUL; RING_1; RING_MUL_LID; RING_MUL_RID; RING_ADD; + GSYM RING_LOCALEQUIV_EQUIV; ring_localequiv] THEN + EXISTS_TAC `ring_1 r:A` THEN ASM_SIMP_TAC[] THEN + RING_TAC THEN ASM_SIMP_TAC[]);; + +let PID_RING_LOCALIZATION = prove + (`!r s:A->bool. + ring_multsys r s /\ PID r /\ ~(ring_0 r IN s) + ==> PID (ring_localization r s)`, + SIMP_TAC[PID_EQ_NOETHERIAN_BEZOUT_DOMAIN; BEZOUT_RING_LOCALIZATION; + INTEGRAL_DOMAIN_LOCALIZATION; NOETHERIAN_RING_LOCALIZATION]);; + (* ------------------------------------------------------------------------- *) (* More divisibility properties that need something like GCD domain. *) (* ------------------------------------------------------------------------- *) @@ -14267,6 +15653,15 @@ let RING_DIVIDES_MUL = prove ASM_SIMP_TAC[RING_DIVIDES_GCD_EQ; RING_MUL] THEN ASM_MESON_TAC[RING_DIVIDES_MUL2; RING_DIVIDES_REFL; RING_MUL_SYM]);; +let RING_DIVIDES_MUL_EQ = prove + (`!r a b c:A. + (UFD r \/ integral_domain r /\ bezout_ring r) /\ + ring_coprime r (a,b) + ==> (ring_divides r (ring_mul r a b) c <=> + ring_divides r a c /\ ring_divides r b c)`, + MESON_TAC[RING_DIVIDES_MUL; RING_DIVIDES_RMUL_REV; + RING_MUL_SYM; ring_coprime]);; + let RING_COPRIME_LMUL = prove (`!r a b c:A. (UFD r \/ integral_domain r /\ bezout_ring r) /\ @@ -14297,13 +15692,319 @@ let RING_COPRIME_RMUL = prove ring_coprime r (a,b) /\ ring_coprime r (a,c))`, ONCE_REWRITE_TAC[RING_COPRIME_SYM] THEN SIMP_TAC[RING_COPRIME_LMUL]);; -(* ------------------------------------------------------------------------- *) -(* The general concept of a Boolean ring. *) -(* ------------------------------------------------------------------------- *) - -let boolean_ring = new_definition - `boolean_ring (r:A ring) <=> - !x. x IN ring_carrier r ==> ring_mul r x x = x`;; +let RING_COPRIME_PRODUCT_EQ = prove + (`!r (a:A) (f:K->A) s. + (UFD r \/ integral_domain r /\ bezout_ring r) /\ + a IN ring_carrier r /\ FINITE s /\ + (!i. i IN s ==> f i IN ring_carrier r) + ==> (ring_coprime r (a, ring_product r s f) <=> + !i. i IN s ==> ring_coprime r (a, f i))`, + GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REPEAT DISCH_TAC THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[RING_PRODUCT_CLAUSES; NOT_IN_EMPTY; FORALL_IN_INSERT] THEN + CONJ_TAC THENL + [REWRITE_TAC[ring_coprime; RING_1] THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[RING_DIVIDES_ONE]; ALL_TAC] THEN + REPEAT GEN_TAC THEN STRIP_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `(f:K->A) x IN ring_carrier r` ASSUME_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + ASM_SIMP_TAC[RING_COPRIME_RMUL; RING_PRODUCT]);; + +let RING_COPRIME_PRODUCT = prove + (`!r (a:A) (f:K->A) s. + (UFD r \/ integral_domain r /\ bezout_ring r) /\ + a IN ring_carrier r /\ FINITE s /\ + (!i. i IN s ==> ring_coprime r (a, f i)) + ==> ring_coprime r (a, ring_product r s f)`, + MESON_TAC[RING_COPRIME_PRODUCT_EQ; RING_COPRIME_IN_CARRIER]);; + +let RING_COPRIME_RPOW = prove + (`!r a (b:A) n. + (UFD r \/ integral_domain r /\ bezout_ring r) /\ + a IN ring_carrier r /\ b IN ring_carrier r /\ + ring_coprime r (a, b) + ==> ring_coprime r (a, ring_pow r b n)`, + GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + REPEAT DISCH_TAC THEN INDUCT_TAC THENL + [REWRITE_TAC[ring_pow; ring_coprime; RING_1] THEN + ASM_MESON_TAC[RING_DIVIDES_ONE]; + ASM_SIMP_TAC[ring_pow; RING_COPRIME_RMUL; RING_POW]]);; + +let RING_COPRIME_LPOW = prove + (`!r a (b:A) n. + (UFD r \/ integral_domain r /\ bezout_ring r) /\ + a IN ring_carrier r /\ b IN ring_carrier r /\ + ring_coprime r (a, b) + ==> ring_coprime r (ring_pow r a n, b)`, + MESON_TAC[RING_COPRIME_RPOW; RING_COPRIME_SYM]);; + +let RING_COPRIME_PRODUCT_DIVIDES_ALT = prove + (`!r p (s:K->bool) x:A. + (UFD r \/ integral_domain r /\ bezout_ring r) /\ + FINITE s /\ + x IN ring_carrier r /\ + pairwise (\i j. ring_coprime r (p i,p j)) s + ==> ((!i. i IN s ==> ring_divides r (p i) x) <=> + (!i. i IN s ==> p i IN ring_carrier r) /\ + ring_divides r (ring_product r s p) x)`, + GEN_TAC THEN GEN_TAC THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN GEN_TAC THEN + ASM_CASES_TAC `(x:A) IN ring_carrier r` THEN ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[IMP_CONJ] THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN + DISCH_TAC THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + ASM_SIMP_TAC[RING_PRODUCT_CLAUSES; NOT_IN_EMPTY; FORALL_IN_INSERT] THEN + ASM_REWRITE_TAC[RING_DIVIDES_1; PAIRWISE_INSERT] THEN + MAP_EVERY X_GEN_TAC [`i:K`; `s:K->bool`] THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[COND_SWAP] THEN COND_CASES_TAC THENL + [ASM_REWRITE_TAC[]; ASM_MESON_TAC[RING_DIVIDES_IN_CARRIER]] THEN + ASM_CASES_TAC `!i. i IN s ==> (p:K->A) i IN ring_carrier r` THEN + ASM_REWRITE_TAC[] THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC RING_DIVIDES_MUL_EQ THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC RING_COPRIME_PRODUCT THEN ASM_MESON_TAC[]);; + +let RING_COPRIME_PRODUCT_DIVIDES = prove + (`!r p (s:K->bool) x:A. + (UFD r \/ integral_domain r /\ bezout_ring r) /\ + FINITE s /\ + x IN ring_carrier r /\ + (!i. i IN s ==> p i IN ring_carrier r) /\ + pairwise (\i j. ring_coprime r (p i,p j)) s + ==> (ring_divides r (ring_product r s p) x <=> + !i. i IN s ==> ring_divides r (p i) x)`, + MESON_TAC[RING_COPRIME_PRODUCT_DIVIDES_ALT]);; + +(* ------------------------------------------------------------------------- *) +(* Additional properties of squarefree elements, mainly assuming UFD etc. *) +(* ------------------------------------------------------------------------- *) + +let RING_SQUAREFREE_GCD = prove + (`!r (a:A) b. ring_squarefree r a \/ ring_squarefree r b + ==> ring_squarefree r (ring_gcd r (a,b))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC RING_SQUAREFREE_DIVISOR THENL + [EXISTS_TAC `a:A`; EXISTS_TAC `b:A`] THEN + ASM_MESON_TAC[RING_GCD_DIVIDES; RING_SQUAREFREE_IN_CARRIER]);; + +let RING_SQUAREFREE_PRIME_EQ = prove + (`!r (a:A). UFD r /\ a IN ring_carrier r /\ ~(a = ring_0 r) + ==> (ring_squarefree r a <=> + !p. ring_prime r p ==> ~ring_divides r (ring_pow r p 2) a)`, + REPEAT STRIP_TAC THEN EQ_TAC THENL + [MESON_TAC[RING_SQUAREFREE_IMP_NO_PRIME_SQUARE]; ALL_TAC] THEN + REWRITE_TAC[ring_squarefree] THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `q:A` THEN STRIP_TAC THEN + ASM_CASES_TAC `ring_unit r (q:A)` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `q:A = ring_0 r` THENL + [ASM_MESON_TAC[RING_POW_ZERO; ARITH_RULE `~(2 = 0)`; + RING_DIVIDES_ZERO]; ALL_TAC] THEN + MP_TAC(ISPECL [`r:A ring`; `q:A`] UFD_PRIME_FACTOR_EXISTS) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `p:A` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `p:A`) THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `ring_divides r (ring_pow r (p:A) 2) (ring_pow r q 2)` + ASSUME_TAC THENL + [ASM_MESON_TAC[RING_DIVIDES_MUL2; RING_POW_2; ring_prime; ring_divides]; + ASM_MESON_TAC[RING_DIVIDES_TRANS]]);; + +let RING_SQUAREFREE_PRIME_DIVISOR_EQ = prove + (`!r (a:A). + UFD r /\ a IN ring_carrier r /\ ~(a = ring_0 r) + ==> (ring_squarefree r a <=> + !p. ring_prime r p /\ ring_divides r p a + ==> ~ring_divides r (ring_pow r p 2) a)`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[RING_SQUAREFREE_PRIME_EQ] THEN + EQ_TAC THEN MATCH_MP_TAC MONO_FORALL THEN + MESON_TAC[RING_DIVIDES_LMUL_REV; ring_prime; RING_POW_2]);; + +let RING_SQUAREFREE_DIVIDES = prove + (`!r q n:A. + UFD r /\ ring_squarefree r q /\ ~(q = ring_0 r) /\ n IN ring_carrier r + ==> (ring_divides r q n <=> + !p. ring_prime r p /\ ring_divides r p q ==> ring_divides r p n)`, + GEN_TAC THEN REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN + SUBGOAL_THEN `~trivial_ring (r:A ring)` ASSUME_TAC THENL + [ASM_MESON_TAC[INTEGRAL_DOMAIN_IMP_NONTRIVIAL_RING; UFD_IMP_INTEGRAL_DOMAIN]; + ONCE_REWRITE_TAC[MESON[ring_squarefree] + `ring_squarefree r x <=> x IN ring_carrier r /\ ring_squarefree r x`]] THEN + ONCE_REWRITE_TAC[IMP_CONJ] THEN MATCH_MP_TAC UFD_PRIME_FACTOR_INDUCT THEN + ASM_REWRITE_TAC[RING_SQUAREFREE_0] THEN CONJ_TAC THENL + [ASM_MESON_TAC[RING_UNIT_DIVIDES_ANY; RING_DIVIDES_TRANS]; ALL_TAC] THEN + REPEAT STRIP_TAC THEN EQ_TAC THENL + [ASM_MESON_TAC[RING_DIVIDES_TRANS]; DISCH_TAC] THEN + MATCH_MP_TAC RING_DIVIDES_MUL THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[RING_SQUAREFREE_MUL_IMP; RING_SQUAREFREE_IMP_NONZERO; + ring_prime; RING_DIVIDES_LMUL; RING_DIVIDES_RMUL; RING_DIVIDES_REFL]);; + +let RING_SQUAREFREE_DIVPOW = prove + (`!r (a:A) x n. + UFD r /\ ring_squarefree r a /\ x IN ring_carrier r /\ + ring_divides r a (ring_pow r x n) + ==> ring_divides r a x`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `a:A = ring_0 r` THENL + [ASM_MESON_TAC[RING_SQUAREFREE_IMP_NONZERO; UFD_IMP_INTEGRAL_DOMAIN; + INTEGRAL_DOMAIN_IMP_NONTRIVIAL_RING]; + ASM_MESON_TAC[RING_PRIME_DIVIDES_POW; RING_DIVIDES_TRANS; + RING_SQUAREFREE_DIVIDES]]);; + +let RING_SQUAREFREE_DIVPOW_EQ = prove + (`!r (a:A) x n. + UFD r /\ ring_squarefree r a /\ x IN ring_carrier r /\ ~(n = 0) + ==> (ring_divides r a (ring_pow r x n) <=> ring_divides r a x)`, + REPEAT STRIP_TAC THEN EQ_TAC THENL + [ASM_MESON_TAC[RING_SQUAREFREE_DIVPOW]; ALL_TAC] THEN + DISCH_TAC THEN MATCH_MP_TAC RING_DIVIDES_TRANS THEN + EXISTS_TAC `x:A` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `?m. n = SUC m` (CHOOSE_THEN SUBST1_TAC) THENL + [ASM_MESON_TAC[num_CASES]; ALL_TAC] THEN + ONCE_REWRITE_TAC[CONJUNCT2 ring_pow] THEN + ASM_SIMP_TAC[RING_DIVIDES_RMUL; RING_DIVIDES_REFL; RING_POW]);; + +let RING_SQUAREFREE_DIVIDES_SQUARE = prove + (`!r (a:A) b. + UFD r /\ ring_squarefree r a /\ + b IN ring_carrier r /\ ring_divides r a (ring_pow r b 2) + ==> ring_divides r a b`, + MESON_TAC[RING_SQUAREFREE_DIVPOW]);; + +let RING_SQUAREFREE_MUL_EQ = prove + (`!r a (b:A). + UFD r /\ a IN ring_carrier r /\ b IN ring_carrier r + ==> (ring_squarefree r (ring_mul r a b) <=> + ring_coprime r (a,b) /\ + ring_squarefree r a /\ ring_squarefree r b)`, + REPEAT STRIP_TAC THEN EQ_TAC THENL + [ASM_MESON_TAC[RING_SQUAREFREE_MUL_IMP]; STRIP_TAC] THEN + ASM_CASES_TAC + `~(a:A = ring_0 r) /\ ~(b = ring_0 r) /\ ~(ring_mul r a b = ring_0 r)` + THENL + [FIRST_X_ASSUM(CONJUNCTS_THEN STRIP_ASSUME_TAC); + ASM_MESON_TAC[RING_MUL_LZERO; RING_MUL_RZERO; UFD; integral_domain; + RING_SQUAREFREE_0; TRIVIAL_RING_10]] THEN + ASM_SIMP_TAC[RING_SQUAREFREE_PRIME_DIVISOR_EQ; RING_MUL] THEN + ASM_SIMP_TAC[IMP_CONJ; RING_PRIME_DIVIDES_MUL] THEN REPEAT STRIP_TAC THENL + [UNDISCH_TAC `ring_squarefree r (a:A)`; + UNDISCH_TAC `ring_squarefree r (b:A)`] THEN + ASM_SIMP_TAC[RING_SQUAREFREE_PRIME_EQ] THEN + DISCH_THEN(MP_TAC o SPEC `p:A`) THEN ASM_REWRITE_TAC[] THENL + [MATCH_MP_TAC RING_COPRIME_DIVPROD_RIGHT THEN EXISTS_TAC `b:A`; + MATCH_MP_TAC RING_COPRIME_DIVPROD_LEFT THEN EXISTS_TAC `a:A`] THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC RING_COPRIME_RPOW THEN + ASM_SIMP_TAC[RING_PRIME_IN_CARRIER] THEN + MATCH_MP_TAC RING_COPRIME_DIVISORS THEN + ASM_MESON_TAC[RING_DIVIDES_REFL; RING_COPRIME_SYM]);; + +let RING_SQUAREFREE_PRODUCT = prove + (`!r (f:K->A) s. + UFD r /\ FINITE s /\ + (!i. i IN s ==> f i IN ring_carrier r) /\ + ~(ring_product r s f = ring_0 r) + ==> (ring_squarefree r (ring_product r s f) <=> + pairwise (\i j. ring_coprime r (f i, f j)) s /\ + !i. i IN s ==> ring_squarefree r (f i))`, + GEN_TAC THEN GEN_TAC THEN + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[RING_PRODUCT_CLAUSES; PAIRWISE_EMPTY; NOT_IN_EMPTY; + RING_SQUAREFREE_1; FORALL_IN_INSERT; PAIRWISE_INSERT] THEN + REPEAT GEN_TAC THEN STRIP_TAC THEN STRIP_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN `(f:K->A) x IN ring_carrier r` ASSUME_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `integral_domain (r:A ring)` ASSUME_TAC THENL + [ASM_MESON_TAC[UFD_IMP_INTEGRAL_DOMAIN]; ALL_TAC] THEN + SUBGOAL_THEN `~((f:K->A) x = ring_0 r) /\ ~(ring_product r s f = ring_0 r)` + STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[INTEGRAL_DOMAIN_MUL_EQ_0; RING_PRODUCT]; ALL_TAC] THEN + ASM_SIMP_TAC[RING_SQUAREFREE_MUL_EQ; RING_PRODUCT] THEN + ASM_SIMP_TAC[RING_COPRIME_PRODUCT_EQ; RING_PRODUCT] THEN + ASM_MESON_TAC[RING_COPRIME_SYM]);; + +let RING_SQUAREFREE_ALT,RING_SQUAREFREE = (CONJ_PAIR o prove) + (`(!r (a:A). + UFD r /\ a IN ring_carrier r + ==> (ring_squarefree r a <=> + ~(a = ring_0 r) /\ + !b k. b IN ring_carrier r /\ ring_divides r a (ring_pow r b k) + ==> ring_divides r a b)) /\ + (!r (a:A). + UFD r /\ a IN ring_carrier r + ==> (ring_squarefree r a <=> + ~(a = ring_0 r) /\ + !b. b IN ring_carrier r /\ ring_divides r a (ring_pow r b 2) + ==> ring_divides r a b))`, + REWRITE_TAC[AND_FORALL_THM] THEN REPEAT GEN_TAC THEN + REWRITE_TAC[TAUT `(p ==> q) /\ (p ==> r) <=> p ==> q /\ r`] THEN + STRIP_TAC THEN MATCH_MP_TAC(TAUT + `((p ==> q) /\ (q ==> r)) /\ (r ==> p) ==> (p <=> q) /\ (p <=> r)`) THEN + CONJ_TAC THENL + [ASM_MESON_TAC[RING_SQUAREFREE_DIVPOW; RING_SQUAREFREE_0; RING_POW; + UFD_IMP_INTEGRAL_DOMAIN; INTEGRAL_DOMAIN_IMP_NONTRIVIAL_RING]; + STRIP_TAC THEN ASM_SIMP_TAC[RING_SQUAREFREE_PRIME_EQ]] THEN + X_GEN_TAC `p:A` THEN REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP RING_PRIME_IN_CARRIER) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ring_divides]) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC o CONJUNCT2) THEN + DISCH_THEN(X_CHOOSE_THEN `q:A` + (CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC)) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `ring_mul r p q:A`) THEN + ASM_SIMP_TAC[RING_MUL; NOT_IMP] THEN CONJ_TAC THENL + [ASM_SIMP_TAC[ring_divides; RING_MUL; RING_POW] THEN + EXISTS_TAC `q:A` THEN ASM_REWRITE_TAC[] THEN RING_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `ring_mul r p q:A = ring_mul r (ring_mul r (ring_1 r) p) q` + SUBST1_TAC THENL [RING_TAC; ASM_SIMP_TAC[RING_POW_2]] THEN + ASM_SIMP_TAC[INTEGRAL_DOMAIN_DIVIDES_RMUL2; RING_MUL; RING_1; DE_MORGAN_THM; + UFD_IMP_INTEGRAL_DOMAIN; RING_DIVIDES_ONE] THEN + ASM_MESON_TAC[ring_prime; RING_POW; RING_MUL_RZERO]);; + +let RING_SQUAREFREE_DECOMPOSITION = prove + (`!r (a:A). UFD r /\ a IN ring_carrier r + ==> ?s t. ring_squarefree r s /\ + t IN ring_carrier r /\ + ring_mul r s (ring_pow r t 2) = a`, + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM] THEN + GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC UFD_PRIME_FACTOR_INDUCT THEN + ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [MAP_EVERY EXISTS_TAC [`ring_1 r:A`; `ring_0 r:A`] THEN + SIMP_TAC[RING_SQUAREFREE_1; RING_0; RING_POW_ZERO; + ARITH_RULE `~(2 = 0)`; RING_MUL_RZERO; RING_1]; + X_GEN_TAC `u:A` THEN DISCH_TAC THEN + MAP_EVERY EXISTS_TAC [`u:A`; `ring_1 r:A`] THEN + SUBGOAL_THEN `(u:A) IN ring_carrier r` ASSUME_TAC THENL + [ASM_MESON_TAC[ring_unit]; ALL_TAC] THEN + ASM_SIMP_TAC[RING_UNIT_IMP_SQUAREFREE; RING_1; RING_POW_ONE; RING_MUL_RID]; + ALL_TAC] THEN + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (CONJUNCTS_THEN2 ASSUME_TAC + (X_CHOOSE_THEN `s:A` (X_CHOOSE_THEN `t:A` STRIP_ASSUME_TAC)))) THEN + SUBGOAL_THEN `integral_domain (r:A ring)` ASSUME_TAC THENL + [ASM_MESON_TAC[UFD_IMP_INTEGRAL_DOMAIN]; ALL_TAC] THEN + SUBGOAL_THEN `(p:A) IN ring_carrier r /\ s IN ring_carrier r` + STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[ring_prime; ring_squarefree]; ALL_TAC] THEN + ASM_CASES_TAC `ring_divides r (p:A) s` THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ring_divides]) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `s':A` THEN STRIP_TAC THEN EXISTS_TAC `ring_mul r p t:A` THEN + ASM_SIMP_TAC[RING_MUL] THEN CONJ_TAC THENL [ALL_TAC; RING_TAC] THEN + ASM_MESON_TAC[RING_SQUAREFREE_DIVISOR; RING_DIVIDES_LMUL; + RING_DIVIDES_REFL]; + MAP_EVERY EXISTS_TAC [`ring_mul r p (s:A)`; `t:A`] THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ALL_TAC; RING_TAC] THEN + ASM_SIMP_TAC[RING_SQUAREFREE_MUL_EQ; RING_PRIME_IMP_SQUAREFREE] THEN + ASM_SIMP_TAC[INTEGRAL_DOMAIN_PRIME_COPRIME_EQ; UFD_IMP_INTEGRAL_DOMAIN]]);; + +(* ------------------------------------------------------------------------- *) +(* The general concept of a Boolean ring. *) +(* ------------------------------------------------------------------------- *) + +let boolean_ring = new_definition + `boolean_ring (r:A ring) <=> + !x. x IN ring_carrier r ==> ring_mul r x x = x`;; let BOOLEAN_RING_SQUARE = prove (`!r x:A. @@ -14682,6 +16383,16 @@ let LOCAL_RING_LOCALIZATION = prove REWRITE_TAC[ring_ideal; SUBSET] THEN REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[RING_MUL_SYM]);; +let NOETHERIAN_LOCAL_RING_LOCALIZATION = prove + (`!r (p:A->bool). + noetherian_ring r /\ prime_ideal r p + ==> noetherian_ring(ring_localization r (ring_carrier r DIFF p)) /\ + local_ring(ring_localization r (ring_carrier r DIFF p))`, + REPEAT STRIP_TAC THENL + [MATCH_MP_TAC NOETHERIAN_RING_LOCALIZATION THEN + ASM_SIMP_TAC[RING_MULTSYS_NONPRIME]; + ASM_SIMP_TAC[LOCAL_RING_LOCALIZATION]]);; + (* ------------------------------------------------------------------------- *) (* Von Neumann regular rings. *) (* ------------------------------------------------------------------------- *) @@ -14916,6 +16627,27 @@ let VNREGULAR_RING_ALT = prove ==> ((!a. P a ==> ?x. R a x) <=> (!a. P a ==> ?!x. R a x))`) THEN CONV_TAC RING_RULE);; +let VNREGULAR_RING_LOCALIZATION = prove + (`!r s:A->bool. + vnregular_ring r /\ ring_multsys r s + ==> vnregular_ring (ring_localization r s)`, + REPEAT GEN_TAC THEN REWRITE_TAC[vnregular_ring] THEN STRIP_TAC THEN + ASM_SIMP_TAC[RING_LOCALIZATION_CARRIER; FORALL_IN_GSPEC] THEN + MAP_EVERY X_GEN_TAC [`a:A`; `p:A`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `a:A`) THEN + ASM_REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `x:A` THEN STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ring_multsys]) THEN + REWRITE_TAC[SUBSET] THEN STRIP_TAC THEN + EXISTS_TAC `ring_fractionate r s (ring_mul r p x:A)` THEN + ASM_SIMP_TAC[RING_FRACTIONATE_IN_CARRIER; GSYM RING_LOCALIZATION_CARRIER; + RING_DIVIDES_LOCALEQUIV; RING_MUL] THEN + ASM (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 5) + [ring_fractionate; RING_LOCALIZATION_MUL; RING_MUL; RING_MUL_LID; + GSYM RING_LOCALEQUIV_EQUIV; ring_localequiv] THEN + EXISTS_TAC `ring_1 r:A` THEN ASM_SIMP_TAC[] THEN + RING_TAC THEN ASM_SIMP_TAC[]);; + let VNREGULAR_FRACTION_RING = prove (`!r:A ring. vnregular_ring r ==> (fraction_ring r) isomorphic_ring r`, @@ -15011,6 +16743,11 @@ let INTEGER_RING = prove PURE_REWRITE_TAC[integer_ring; GSYM(CONJUNCT2 ring_tybij)] THEN REWRITE_TAC[IN_UNIV] THEN CONV_TAC INT_RING);; +let INTEGER_RING_POW = prove + (`!q:int n. ring_pow integer_ring q n = q pow n`, + GEN_TAC THEN INDUCT_TAC THEN + ASM_REWRITE_TAC[ring_pow; INT_POW; INTEGER_RING]);; + let INTEGER_RING_UNIT = prove (`!x. ring_unit integer_ring x <=> x = &1 \/ x = -- &1`, REWRITE_TAC[ring_unit; INTEGER_RING; INT_MUL_EQ_1; IN_UNIV] THEN @@ -15357,7 +17094,7 @@ let FIELD_INTEGER_MOD_RING = prove ANTS_TAC THENL [ASM_MESON_TAC[NUMBER_RULE `0 divides n <=> n = 0`]; DISCH_TAC THEN DISJ1_TAC THEN FIRST_ASSUM(MP_TAC o MATCH_MP (NUMBER_RULE - `coprime(d,n) ==> d divides n ==> coprime(d,d)`)) THEN + `coprime(d:num,n) ==> d divides n ==> coprime(d,d)`)) THEN ASM_REWRITE_TAC[] THEN CONV_TAC NUMBER_RULE]; DISCH_TAC THEN REWRITE_TAC[coprime] THEN X_GEN_TAC `e:num` THEN STRIP_TAC THEN @@ -15934,6 +17671,10 @@ let MONOMIAL = prove (`monomial (:V) m <=> FINITE(monomial_vars m)`, REWRITE_TAC[monomial; SUBSET_UNIV]);; +let MONOMIAL_UNIV_1 = prove + (`!m:1->num. monomial (:1) m`, + REWRITE_TAC[MONOMIAL; FINITE_MONOMIAL_VARS_1]);; + let MONOMIAL_DEG_1 = prove (`monomial_deg (monomial_1:V->num) = 0`, REWRITE_TAC[monomial_deg; MONOMIAL_VARS_1; NSUM_CLAUSES]);; @@ -15973,6 +17714,27 @@ let MONOMIAL_DIVIDES_EXISTS = prove ARITH_RULE `a:num = b + m <=> m = a - b /\ b <= a`] THEN ARITH_TAC);; +let MONOMIAL_VAR_DIVIDES_MUL = prove + (`!m1 m2 x:V. + monomial_divides (monomial_var x) (monomial_mul m1 m2) <=> + monomial_divides (monomial_var x) m1 \/ + monomial_divides (monomial_var x) m2`, + MONOMIAL_POINTWISE_TAC THEN + REWRITE_TAC[COND_RAND; COND_RATOR; LE_0] THEN + SIMP_TAC[MESON[] `(if p then q else true) <=> p ==> q`] THEN + REWRITE_TAC[FORALL_UNWIND_THM2] THEN ARITH_TAC);; + +let MONOMIAL_MUL_EQ_VAR = prove + (`!m1 m2 x:V. + monomial_mul m1 m2 = monomial_var x <=> + m1 = monomial_var x /\ m2 = monomial_1 \/ + m1 = monomial_1 /\ m2 = monomial_var x`, + MONOMIAL_POINTWISE_TAC THEN + REWRITE_TAC[COND_RAND; COND_RATOR; LE_0] THEN + SIMP_TAC[MESON[] `(if p then x else y) <=> (p ==> x) /\ (~p ==> y)`] THEN + SIMP_TAC[FORALL_AND_THM; FORALL_UNWIND_THM2; ADD_EQ_0] THEN + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[] THEN ASM_ARITH_TAC);; + let MONOMIAL_DEG_MUL = prove (`!(m1:V->num) m2. monomial (:V) m1 /\ monomial (:V) m2 @@ -16460,6 +18222,12 @@ let POLY_ADD_LZERO = prove REPEAT STRIP_TAC THEN REWRITE_TAC[poly_add; POLY_0] THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `m:V->num` THEN RING_TAC);; +let POLY_ADD_RZERO = prove + (`!r (p:(V->num)->A). + ring_powerseries r p + ==> poly_add r p (poly_0 r) = p`, + MESON_TAC[POLY_ADD_LZERO; RING_POWERSERIES_0; POLY_ADD_SYM]);; + let POLY_ADD_LNEG = prove (`!r (p:(V->num)->A). ring_powerseries r p @@ -16532,6 +18300,12 @@ let POLY_MUL_LID = prove REWRITE_TAC[IN_SING; FORALL_PAIR_THM; IN_ELIM_PAIR_THM; PAIR_EQ] THEN MESON_TAC[MONOMIAL_MUL_LID]);; +let POLY_MUL_RID = prove + (`!r (p:(V->num)->A). + ring_powerseries r p + ==> poly_mul r p (poly_1 r) = p`, + MESON_TAC[POLY_MUL_LID; POLY_MUL_SYM; RING_POWERSERIES_1]);; + let POLY_MUL_ASSOC = prove (`!r p1 p2 (p3:(V->num)->A). ring_powerseries r p1 /\ ring_powerseries r p2 /\ ring_powerseries r p3 @@ -16610,28 +18384,41 @@ let POLY_MUL_ASSOC = prove REWRITE_TAC[MONOMIAL_MUL_AC] THEN SIMP_TAC[] THEN REPEAT STRIP_TAC THEN RING_TAC);; -let POLY_MUL_0 = prove +let POWSER_MUL_0 = prove (`(!r (p:(V->num)->A). - ring_polynomial r p ==> poly_mul r p (poly_0 r) = poly_0 r) /\ + ring_powerseries r p ==> poly_mul r p (poly_0 r) = poly_0 r) /\ (!r (q:(V->num)->A). - ring_polynomial r q ==> poly_mul r (poly_0 r) q = poly_0 r)`, - REWRITE_TAC[ring_polynomial; ring_powerseries; - poly_mul; poly_0; poly_const; COND_ID] THEN + ring_powerseries r q ==> poly_mul r (poly_0 r) q = poly_0 r)`, + REWRITE_TAC[ring_powerseries; poly_mul; poly_0; poly_const; COND_ID] THEN REPEAT STRIP_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN MATCH_MP_TAC RING_SUM_EQ_0 THEN ASM_SIMP_TAC[FORALL_PAIR_THM; RING_MUL_LZERO; RING_MUL_RZERO]);; -let POLY_MUL_MONOMIAL_1 = prove +let POLY_MUL_0 = prove + (`(!r (p:(V->num)->A). + ring_polynomial r p ==> poly_mul r p (poly_0 r) = poly_0 r) /\ + (!r (q:(V->num)->A). + ring_polynomial r q ==> poly_mul r (poly_0 r) q = poly_0 r)`, + MESON_TAC[POWSER_MUL_0; RING_POLYNOMIAL_IMP_POWERSERIES]);; + +let POWSER_MUL_MONOMIAL_1 = prove (`!r (p:(V->num)->A) q. - ring_polynomial r p /\ ring_polynomial r q + ring_powerseries r p /\ ring_powerseries r q ==> poly_mul r p q monomial_1 = ring_mul r (p monomial_1) (q monomial_1)`, - REWRITE_TAC[ring_polynomial; ring_powerseries] THEN + REWRITE_TAC[ring_powerseries] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[poly_mul; MONOMIAL_MUL_EQ_1] THEN REWRITE_TAC[SET_RULE `{x,y | x = a /\ y = b} = {(a,b)}`] THEN ASM_SIMP_TAC[RING_SUM_SING; RING_MUL]);; +let POLY_MUL_MONOMIAL_1 = prove + (`!r (p:(V->num)->A) q. + ring_polynomial r p /\ ring_polynomial r q + ==> poly_mul r p q monomial_1 = + ring_mul r (p monomial_1) (q monomial_1)`, + SIMP_TAC[POWSER_MUL_MONOMIAL_1; RING_POLYNOMIAL_IMP_POWERSERIES]);; + let POWSER_MUL_CONST = prove (`!r c (p:(V->num)->A). c IN ring_carrier r /\ ring_powerseries r p @@ -16658,6 +18445,58 @@ let POLY_MUL_CONST = prove ==> poly_mul r (poly_const r c) p = \m. ring_mul r c (p m)`, SIMP_TAC[ring_polynomial; POWSER_MUL_CONST]);; +let POWSER_VAR_MUL = prove + (`!r (p:(V->num)->A) x. + ring_powerseries r p + ==> poly_mul r (poly_var r x) p = + \m. if monomial_divides (monomial_var x) m + then p(monomial_div m (monomial_var x)) + else ring_0 r`, + let lemma = prove + (`monomial_mul m1 m2 = m <=> monomial_divides m1 m /\ monomial_div m m1 = m2`, + MONOMIAL_TAC) in + REWRITE_TAC[ring_powerseries; poly_mul; poly_var] THEN REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN + ASM_SIMP_TAC[RING_MUL_LZERO; RING_MUL_LID] THEN + GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `m:V->num` THEN + REWRITE_TAC[] THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [LAMBDA_PAIR] THEN + REWRITE_TAC[GSYM RING_SUM_RESTRICT_SET] THEN + REWRITE_TAC[SET_RULE `{x | x IN {f a b | P a b} /\ Q x} = + {f a b |a,b| P a b /\ Q(f a b)}`] THEN + SIMP_TAC[SET_RULE `{f a b |P a b /\ a = c} = IMAGE (f c) {b | P c b}`] THEN + REWRITE_TAC[lemma] THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[EMPTY_GSPEC; SING_GSPEC; IMAGE_CLAUSES; + RING_SUM_CLAUSES; RING_SUM_SING]);; + +let POWSER_MUL_VAR = prove + (`!r (p:(V->num)->A) x. + ring_powerseries r p + ==> poly_mul r p (poly_var r x) = + \m. if monomial_divides (monomial_var x) m + then p(monomial_div m (monomial_var x)) + else ring_0 r`, + SIMP_TAC[GSYM POWSER_VAR_MUL] THEN + MESON_TAC[POLY_MUL_SYM; RING_POWERSERIES_VAR]);; + +let POLY_VAR_MUL = prove + (`!r (p:(V->num)->A) x. + ring_polynomial r p + ==> poly_mul r (poly_var r x) p = + \m. if monomial_divides (monomial_var x) m + then p(monomial_div m (monomial_var x)) + else ring_0 r`, + SIMP_TAC[POWSER_VAR_MUL; RING_POLYNOMIAL_IMP_POWERSERIES]);; + +let POLY_MUL_VAR = prove + (`!r (p:(V->num)->A) x. + ring_polynomial r p + ==> poly_mul r p (poly_var r x) = + \m. if monomial_divides (monomial_var x) m + then p(monomial_div m (monomial_var x)) + else ring_0 r`, + SIMP_TAC[POWSER_MUL_VAR; RING_POLYNOMIAL_IMP_POWERSERIES]);; + let POLY_VARS_CONST = prove (`!(r:A ring) c. poly_vars r (poly_const r c) = {}`, REPEAT GEN_TAC THEN REWRITE_TAC[poly_vars; poly_const] THEN @@ -16850,6 +18689,13 @@ let POLY_RING = prove POLY_RING_SUBRING_OF_POWSER_RING] THEN REWRITE_TAC[SUBRING_GENERATED] THEN REWRITE_TAC[POWSER_RING]);; +let POLY_IN_POWSER_RING = prove + (`!(r:A ring) (v:V->bool) p. + p IN ring_carrier(poly_ring r v) + ==> p IN ring_carrier(powser_ring r v)`, + REWRITE_TAC[POLY_RING; POWSER_RING; IN_ELIM_THM] THEN + SIMP_TAC[RING_POLYNOMIAL_IMP_POWERSERIES]);; + let poly_pow = new_definition `poly_pow (r:A ring) = ring_pow (powser_ring r (:V))`;; @@ -16919,6 +18765,18 @@ let POWSER_RING_CLAUSES = prove REPLICATE_TAC 3 GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[POLY_POW; ring_pow; POWSER_RING]);; +let POWSER_CLAUSES = prove + (`(!(r:A ring). {p | ring_powerseries r p} = + ring_carrier (powser_ring r (:V))) /\ + (!(r:A ring). poly_0 r = ring_0 (powser_ring r (:V))) /\ + (!(r:A ring). poly_1 r = ring_1 (powser_ring r (:V))) /\ + (!(r:A ring). poly_neg r = ring_neg (powser_ring r (:V))) /\ + (!(r:A ring). poly_add r = ring_add (powser_ring r (:V))) /\ + (!(r:A ring). poly_sub r = ring_sub (powser_ring r (:V))) /\ + (!(r:A ring). poly_mul r = ring_mul (powser_ring r (:V))) /\ + (!(r:A ring). poly_pow r = ring_pow (powser_ring r (:V)))`, + REWRITE_TAC[POWSER_RING_CLAUSES; SUBSET_UNIV]);; + let POLY_RING_CLAUSES = prove (`(!(r:A ring) (s:V->bool). ring_carrier(poly_ring r s) = @@ -17153,11 +19011,77 @@ let POLY_CONST_MUL = prove ASM_SIMP_TAC[RING_SUM_DELTA; IN_ELIM_PAIR_THM; RING_MUL] THEN REWRITE_TAC[MONOMIAL_MUL_LID] THEN MESON_TAC[]);; +let RING_OF_NUM_POWSER_RING = prove + (`!(r:A ring) (s:V->bool) n. + ring_of_num (powser_ring r s) n = poly_const r (ring_of_num r n)`, + GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THEN + REWRITE_TAC[ring_of_num; POWSER_RING_CLAUSES] THENL + [REWRITE_TAC[GSYM POLY_CONST_0]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[GSYM POLY_CONST_1; GSYM POLY_CONST_ADD; RING_OF_NUM; RING_1]);; + +let RING_OF_NUM_POLY_RING = prove + (`!(r:A ring) (s:V->bool) n. + ring_of_num (poly_ring r s) n = poly_const r (ring_of_num r n)`, + REWRITE_TAC[POLY_RING_AS_SUBRING; RING_OF_NUM_SUBRING_GENERATED] THEN + REWRITE_TAC[RING_OF_NUM_POWSER_RING]);; + +let POLY_CONST_OF_NUM = prove + (`!(r:A ring) n. + poly_const r (ring_of_num r n) = ring_of_num (poly_ring r (:V)) n`, + REWRITE_TAC[RING_OF_NUM_POLY_RING]);; + let POLY_CONST_EQ = prove (`!r x y. poly_const r x :(V->num)->A = poly_const r y <=> x = y`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC LAND_CONV [FUN_EQ_THM] THEN REWRITE_TAC[poly_const] THEN MESON_TAC[]);; +let POLY_CONST_EQ_0 = prove + (`!r x. poly_const r x :(V->num)->A = poly_0 r <=> x = ring_0 r`, + REWRITE_TAC[GSYM POLY_CONST_0; POLY_CONST_EQ]);; + +let POLY_CONST_EQ_1 = prove + (`!r x. poly_const r x :(V->num)->A = poly_1 r <=> x = ring_1 r`, + REWRITE_TAC[GSYM POLY_CONST_1; POLY_CONST_EQ]);; + +let POWSER_VAR_MUL_EQ_0 = prove + (`(!(r:A ring) p (x:V). + ring_powerseries r p + ==> (poly_mul r (poly_var r x) p = poly_0 r <=> p = poly_0 r)) /\ + (!(r:A ring) p (x:V). + ring_powerseries r p + ==> (poly_mul r p (poly_var r x) = poly_0 r <=> p = poly_0 r))`, + MATCH_MP_TAC(TAUT `(p ==> q) /\ p ==> p /\ q`) THEN CONJ_TAC THENL + [MESON_TAC[POLY_MUL_SYM; RING_POWERSERIES_VAR]; + REPEAT STRIP_TAC] THEN + EQ_TAC THEN + SIMP_TAC[POWSER_MUL_0; RING_POLYNOMIAL_IMP_POWERSERIES; + RING_POWERSERIES_VAR] THEN + ASM_SIMP_TAC[POWSER_VAR_MUL] THEN GEN_REWRITE_TAC BINOP_CONV [FUN_EQ_THM] THEN + REWRITE_TAC[POLY_0] THEN DISCH_TAC THEN + X_GEN_TAC `m:V->num` THEN + FIRST_X_ASSUM(MP_TAC o SPEC `monomial_mul (monomial_var(x:V)) m`) THEN + REWRITE_TAC[MONOMIAL_VAR_DIVIDES_MUL; MONOMIAL_DIVIDES_REFL] THEN + REWRITE_TAC[MONOMIAL_RULE `monomial_div (monomial_mul m1 m2) m1 = m2`] THEN + MESON_TAC[]);; + +let POWSER_VARPOW_MUL_EQ_0 = prove + (`(!(r:A ring) p (x:V) k. + ring_powerseries r p + ==> (poly_mul r (poly_pow r (poly_var r x) k) p = poly_0 r <=> + p = poly_0 r)) /\ + (!(r:A ring) p (x:V) k. + ring_powerseries r p + ==> (poly_mul r p (poly_pow r (poly_var r x) k) = poly_0 r <=> + p = poly_0 r))`, + MATCH_MP_TAC(TAUT `(p ==> q) /\ p ==> p /\ q`) THEN CONJ_TAC THENL + [MESON_TAC[POLY_MUL_SYM; RING_POWERSERIES_VAR; RING_POWERSERIES_POW]; + REPEAT STRIP_TAC] THEN + SPEC_TAC(`k:num`,`k:num`) THEN INDUCT_TAC THEN + ASM_SIMP_TAC[POLY_POW; POLY_MUL_LID; RING_POWERSERIES_MUL; + GSYM POLY_MUL_ASSOC; RING_POWERSERIES_POW; RING_POWERSERIES_VAR; + POWSER_VAR_MUL_EQ_0]);; + let RING_HOMOMORPHISM_POLY_CONST = prove (`!(r:A ring) (s:V->bool). ring_homomorphism (r,poly_ring r s) (poly_const r)`, @@ -17438,6 +19362,20 @@ let TRIVIAL_POLY_RING = prove REWRITE_TAC[POLY_RING_AS_SUBRING; TRIVIAL_RING_SUBRING_GENERATED] THEN REWRITE_TAC[TRIVIAL_POWSER_RING]);; +let TRIVIAL_RING_POWSER_0 = prove + (`!r (p:(V->num)->A). + ring_powerseries r p /\ trivial_ring r ==> p = poly_0 r`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`r:A ring`; `(:V)`] TRIVIAL_POWSER_RING) THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[TRIVIAL_RING_SUBSET; SUBSET; POWSER_RING; IN_SING; IN_UNIV] THEN + ASM_SIMP_TAC[IN_ELIM_THM]);; + +let TRIVIAL_RING_POLY_0 = prove + (`!r (p:(V->num)->A). + ring_polynomial r p /\ trivial_ring r ==> p = poly_0 r`, + MESON_TAC[TRIVIAL_RING_POWSER_0; RING_POLYNOMIAL_IMP_POWERSERIES]);; + let RING_CARRIER_POWSER_RING = prove (`!(r:A ring) (s:V->bool). ring_carrier(powser_ring r s) = @@ -17800,16 +19738,35 @@ let RING_HOMOMORPHISM_POLY_EXTEND = prove REPEAT STRIP_TAC THEN MATCH_MP_TAC POLY_EXTEND_MUL THEN ASM SET_TAC[]);; +let POLY_EXTEND_RING_SUM = prove + (`!(r:A ring) (r':B ring) h (v:V->bool) (s:W->bool) f x. + ring_homomorphism(r,r') h /\ + (!i. i IN v ==> x i IN ring_carrier r') /\ + FINITE s /\ + (!a. a IN s ==> f a IN ring_carrier(poly_ring r v)) + ==> poly_extend (r,r') h x (ring_sum (poly_ring r v) s f) = + ring_sum r' s (\a. poly_extend (r,r') h x (f a))`, + REPEAT STRIP_TAC THEN SUBGOAL_THEN + `poly_extend (r:A ring,r':B ring) (h:A->B) (x:V->B) + (ring_sum (poly_ring r (v:V->bool)) (s:W->bool) + (f:W->(V->num)->A)) = + ring_sum r' s + (poly_extend (r,r') h x o f)` MP_TAC THENL + [MATCH_MP_TAC(REWRITE_RULE[IMP_IMP; RIGHT_IMP_FORALL_THM] + RING_HOMOMORPHISM_SUM) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC RING_HOMOMORPHISM_POLY_EXTEND THEN + ASM_REWRITE_TAC[]; + REWRITE_TAC[o_DEF] THEN + DISCH_THEN(fun th -> REWRITE_TAC[th])]);; + let POLY_EXTEND_RING_PRODUCT = prove (`!(r:A ring) (r':B ring) h (v:V->bool) (s:W->bool) f x. ring_homomorphism(r,r') h /\ (!i. i IN v ==> x i IN ring_carrier r') /\ FINITE s /\ (!a. a IN s ==> f a IN ring_carrier(poly_ring r v)) - ==> poly_extend (r,r') h x - (ring_product (poly_ring r v) s f) = - ring_product r' s - (\a. poly_extend (r,r') h x (f a))`, + ==> poly_extend (r,r') h x (ring_product (poly_ring r v) s f) = + ring_product r' s (\a. poly_extend (r,r') h x (f a))`, REPEAT STRIP_TAC THEN SUBGOAL_THEN `poly_extend (r:A ring,r':B ring) (h:A->B) (x:V->B) (ring_product (poly_ring r (v:V->bool)) (s:W->bool) @@ -17972,19 +19929,49 @@ let POLY_EXTEND_HOMOMORPHIC_IMAGE = prove RULE_ASSUM_TAC(REWRITE_RULE[poly_vars; UNIONS_SUBSET; IN_ELIM_THM]) THEN ASM SET_TAC[]);; +let POWSER_EXTEND_AT_0 = prove + (`!r s (h:A->B) (p:(V->num)->A). + ring_homomorphism (r,s) h /\ + ring_powerseries r p + ==> poly_extend (r,s) h (\x. ring_0 s) p = h(p monomial_1)`, + REWRITE_TAC[ring_powerseries] THEN REPEAT STRIP_TAC THEN + RULE_ASSUM_TAC(ONCE_REWRITE_RULE[GSYM CONTRAPOS_THM]) THEN + RULE_ASSUM_TAC(REWRITE_RULE[INFINITE]) THEN + REWRITE_TAC[poly_extend; RING_POW_ZERO] THEN + ONCE_REWRITE_TAC[GSYM COND_SWAP] THEN + REWRITE_TAC[GSYM RING_PRODUCT_RESTRICT_SET] THEN + REWRITE_TAC[RING_PRODUCT_0] THEN + ONCE_REWRITE_TAC[COND_RAND] THEN + RULE_ASSUM_TAC(REWRITE_RULE[ring_homomorphism; SUBSET; FORALL_IN_IMAGE]) THEN + ASM_SIMP_TAC[RING_MUL_RZERO; RING_MUL_RID] THEN + REWRITE_TAC[GSYM RING_SUM_RESTRICT_SET] THEN + REWRITE_TAC[IN_ELIM_THM; TAUT `p /\ (q \/ r) <=> ~(p ==> ~q /\ ~r)`] THEN + ASM_SIMP_TAC[INFINITE; FINITE_RESTRICT; monomial_vars; IN_ELIM_THM] THEN + REWRITE_TAC[GSYM monomial_vars; MONOMIAL_VARS_EQ_EMPTY] THEN + SIMP_TAC[CONTRAPOS_THM] THEN + ASM_CASES_TAC `(p:(V->num)->A) monomial_1 = ring_0 r` THEN + ASM_REWRITE_TAC[RING_SUM_CLAUSES; EMPTY_GSPEC] THEN + ASM_SIMP_TAC[SING_GSPEC; RING_SUM_SING]);; + let POLY_EXTEND_AT_0 = prove (`!r s (v:V->bool) (h:A->B) p. ring_homomorphism (r,s) h /\ p IN ring_carrier (poly_ring r v) ==> poly_extend (r,s) h (\x. ring_0 s) p = h(p monomial_1)`, - REPEAT STRIP_TAC THEN MATCH_MP_TAC POLY_EXTEND_UNIQUE THEN - EXISTS_TAC `v:V->bool` THEN - ASM_REWRITE_TAC[poly_var; poly_const; MONOMIAL_VAR_1] THEN - CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[RING_HOMOMORPHISM_0]] THEN - GEN_REWRITE_TAC RAND_CONV [GSYM o_DEF] THEN - MATCH_MP_TAC RING_HOMOMORPHISM_COMPOSE THEN - EXISTS_TAC `r:A ring` THEN - ASM_REWRITE_TAC[RING_HOMOMORPHISM_MONOMIAL_1]);; + REWRITE_TAC[POLY_RING; IN_ELIM_THM; ring_polynomial] THEN + ASM_SIMP_TAC[POWSER_EXTEND_AT_0]);; + +let RING_HOMOMORPHISM_POWSER_EXTEND_AT_0 = prove + (`!r r' (s:V->bool) (h:A->B). + ring_homomorphism(r,r') h + ==> ring_homomorphism (powser_ring r s,r') + (poly_extend(r,r') h (\i. ring_0 r'))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[RING_HOMOMORPHISM] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + ASM_SIMP_TAC[POWSER_EXTEND_AT_0; POWSER_RING; IN_ELIM_THM; POLY_EXTEND_1; + RING_POWERSERIES_ADD; RING_POWERSERIES_MUL] THEN + RULE_ASSUM_TAC(REWRITE_RULE[ring_homomorphism; SUBSET; FORALL_IN_IMAGE]) THEN + ASM_SIMP_TAC[ring_powerseries; poly_add; POWSER_MUL_MONOMIAL_1]);; let POLY_SUBRING_GENERATED = prove (`!(r:A ring) (s:V->bool). @@ -19259,72 +21246,67 @@ let POLY_RING_HOMOMORPHISM_I = prove IMAGE; SUBSET; IN_ELIM_THM] THEN ASM SET_TAC[]);; -(* If c divides every coefficient of p, then poly_const(c) | p *) - let POLY_CONST_DIVIDES_COEFFS = prove (`!(r:A ring) (s:V->bool) c (p:(V->num)->A). - integral_domain r /\ c IN ring_carrier r /\ ~(c = ring_0 r) /\ - p IN ring_carrier(poly_ring r s) /\ (!m. ring_divides r c (p m)) - ==> ring_divides (poly_ring r s) (poly_const r c) p`, - REPEAT STRIP_TAC THEN REWRITE_TAC[ring_divides] THEN - ASM_REWRITE_TAC[POLY_CONST] THEN - SUBGOAL_THEN `ring_polynomial r (p:(V->num)->A) /\ - poly_vars r p SUBSET (s:V->bool)` STRIP_ASSUME_TAC THENL - [ASM_REWRITE_TAC[GSYM IN_POLY_RING_CARRIER]; ALL_TAC] THEN - SUBGOAL_THEN `!m:V->num. ?d:A. d IN ring_carrier r /\ - (p:(V->num)->A) m = ring_mul r c d` MP_TAC THENL - [ASM_MESON_TAC[ring_divides]; ALL_TAC] THEN - REWRITE_TAC[SKOLEM_THM] THEN - DISCH_THEN(X_CHOOSE_THEN `q:(V->num)->A` - (STRIP_ASSUME_TAC o REWRITE_RULE[FORALL_AND_THM])) THEN - EXISTS_TAC `q:(V->num)->A` THEN - SUBGOAL_THEN `!m:V->num. (p:(V->num)->A) m = ring_0 r - ==> (q:(V->num)->A) m = ring_0 r` ASSUME_TAC THENL - [ASM_MESON_TAC[INTEGRAL_DOMAIN_MUL_EQ_0]; ALL_TAC] THEN - SUBGOAL_THEN `ring_polynomial r (q:(V->num)->A)` ASSUME_TAC THENL - [REWRITE_TAC[ring_polynomial; ring_powerseries] THEN - REPEAT CONJ_TAC THEN - TRY(ASM_MESON_TAC[ring_polynomial; ring_powerseries]) THEN - MATCH_MP_TAC FINITE_SUBSET THEN - EXISTS_TAC `{m:V->num | ~((p:(V->num)->A) m = ring_0 r)}` THEN - CONJ_TAC THENL - [ASM_MESON_TAC[ring_polynomial]; - REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ASM_MESON_TAC[]]; - ALL_TAC] THEN - CONJ_TAC THENL - [ASM_REWRITE_TAC[POLY_RING_CLAUSES; IN_ELIM_THM] THEN - REWRITE_TAC[poly_vars; UNIONS_SUBSET; FORALL_IN_GSPEC] THEN - RULE_ASSUM_TAC(REWRITE_RULE - [poly_vars; UNIONS_SUBSET; FORALL_IN_GSPEC]) THEN - ASM_MESON_TAC[]; - ASM_SIMP_TAC[POLY_RING_CLAUSES; POLY_MUL_CONST] THEN - REWRITE_TAC[FUN_EQ_THM] THEN ASM_MESON_TAC[]]);; + p IN ring_carrier(poly_ring r s) /\ + (!m. ring_divides r c (p m)) + ==> ring_divides (poly_ring r s) (poly_const r c) p`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE BINDER_CONV [ring_divides]) THEN + REWRITE_TAC[FORALL_AND_THM; SKOLEM_THM] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + ASM_REWRITE_TAC[ring_divides; RIGHT_AND_EXISTS_THM; POLY_CONST] THEN + DISCH_THEN(X_CHOOSE_THEN `q:(V->num)->A` STRIP_ASSUME_TAC) THEN + ABBREV_TAC + `q' = \m. if p m = ring_0 r then ring_0 r else (q:(V->num)->A) m` THEN + EXISTS_TAC `q':(V->num)->A` THEN + MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL + [UNDISCH_TAC `(p:(V->num)->A) IN ring_carrier (poly_ring r s)` THEN + REWRITE_TAC[POLY_RING; IN_ELIM_THM; ring_polynomial; ring_powerseries] THEN + ASM_REWRITE_TAC[poly_vars] THEN EXPAND_TAC "q'" THEN + REWRITE_TAC[GSYM CONJ_ASSOC] THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[MESON[] `(if p then z else x) = z <=> p \/ x = z`] THEN + DISCH_THEN(fun th -> + CONJ_TAC THENL [ASM_MESON_TAC[RING_0]; MP_TAC th]) THEN + MATCH_MP_TAC MONO_AND THEN SIMP_TAC[] THEN + MATCH_MP_TAC MONO_AND THEN CONJ_TAC THENL + [MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET) THEN SET_TAC[]; + SET_TAC[]]; + REWRITE_TAC[IN_POLY_RING_CARRIER] THEN + ASM_SIMP_TAC[POLY_MUL_CONST; CONJUNCT2 POLY_RING] THEN + EXPAND_TAC "q'" THEN REWRITE_TAC[FUN_EQ_THM] THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[RING_MUL_RZERO]]);; let POLY_CONST_DIVIDES_COEFFS_REV = prove (`!(r:A ring) (s:V->bool) c (p:(V->num)->A) m. - c IN ring_carrier r /\ p IN ring_carrier(poly_ring r s) /\ - ring_divides (poly_ring r s) (poly_const r c) p - ==> ring_divides r c (p m)`, - REPEAT GEN_TAC THEN STRIP_TAC THEN - FIRST_X_ASSUM(STRIP_ASSUME_TAC o GEN_REWRITE_RULE I [ring_divides]) THEN - SUBGOAL_THEN `ring_polynomial r (x:(V->num)->A) /\ - ring_polynomial r (p:(V->num)->A)` STRIP_ASSUME_TAC THENL - [RULE_ASSUM_TAC(REWRITE_RULE[IN_POLY_RING_CARRIER]) THEN - ASM_REWRITE_TAC[]; - ALL_TAC] THEN - SUBGOAL_THEN `!m:V->num. (p:(V->num)->A) m = - ring_mul r c ((x:(V->num)->A) m)` ASSUME_TAC THENL - [ASM_SIMP_TAC[POLY_RING_CLAUSES; POLY_MUL_CONST]; ALL_TAC] THEN - ASM_MESON_TAC[ring_divides; ring_polynomial; ring_powerseries]);; + ring_divides (poly_ring r s) (poly_const r c) p + ==> ring_divides r c (p m)`, + REPEAT GEN_TAC THEN REWRITE_TAC[ring_divides; POLY_CONST] THEN + REWRITE_TAC[IMP_CONJ; LEFT_IMP_EXISTS_THM] THEN + DISCH_TAC THEN DISCH_TAC THEN X_GEN_TAC `q:(V->num)->A` THEN + DISCH_TAC THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(ASSUME_TAC o SYM) THEN + CONJ_TAC THENL [ASM_MESON_TAC[POLY_MONOMIAL_IN_CARRIER]; ALL_TAC] THEN + EXISTS_TAC `(q:(V->num)->A) m` THEN + CONJ_TAC THENL [ASM_MESON_TAC[POLY_MONOMIAL_IN_CARRIER]; ALL_TAC] THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[POLY_RING] THEN + RULE_ASSUM_TAC(REWRITE_RULE[POLY_RING; IN_ELIM_THM]) THEN + ASM_SIMP_TAC[POLY_MUL_CONST]);; let POLY_CONST_DIVIDES_COEFFS_EQ = prove (`!(r:A ring) (s:V->bool) c (p:(V->num)->A). - integral_domain r /\ c IN ring_carrier r /\ - ~(c = ring_0 r) /\ - p IN ring_carrier(poly_ring r s) - ==> (ring_divides (poly_ring r s) (poly_const r c) p <=> - !m. ring_divides r c (p m))`, - MESON_TAC[POLY_CONST_DIVIDES_COEFFS; POLY_CONST_DIVIDES_COEFFS_REV]);; + ring_divides (poly_ring r s) (poly_const r c) p <=> + p IN ring_carrier(poly_ring r s) /\ + (!m. ring_divides r c (p m))`, + MESON_TAC[POLY_CONST_DIVIDES_COEFFS; POLY_CONST_DIVIDES_COEFFS_REV; + RING_DIVIDES_IN_CARRIER]);; + +let POLY_CONST_DIVIDES_CONST = prove + (`!(r:A ring) (s:V->bool) c d. + ring_divides (poly_ring r s) (poly_const r c) (poly_const r d) <=> + ring_divides r c d`, + REWRITE_TAC[POLY_CONST_DIVIDES_COEFFS_EQ; POLY_CONST] THEN + REWRITE_TAC[ring_divides; poly_const; FORALL_AND_THM] THEN + MESON_TAC[RING_0; RING_MUL_RZERO]);; (* ------------------------------------------------------------------------- *) (* Monomial divisibility is a partial order, and on a *finite* set of *) @@ -20037,6 +22019,14 @@ let LAMBDA_1_EQ = prove (`(\v:1. a:A) = (\v. b) <=> a = b`, REWRITE_TAC[FUN_EQ_THM; FORALL_ONE_THM]);; +let FUN_ONE_NUM_EQ = prove + (`!f:1->num c. f = (\v:1. c) <=> f one = c`, + REWRITE_TAC[FORALL_FUN_FROM_1; LAMBDA_1_EQ]);; + +let FUN_ONE_EQ_ONE = prove + (`!m:1->num. m = (\v:1. m one)`, + GEN_TAC THEN REWRITE_TAC[FUN_ONE_NUM_EQ]);; + let FINITE_FUN_FROM_1 = prove (`!P. FINITE {m:1->num | P m} <=> FINITE {d:num | P(\v:1. d)}`, GEN_TAC THEN EQ_TAC THEN DISCH_TAC THENL @@ -20056,6 +22046,19 @@ let FINITE_FUN_FROM_1 = prove (fun th -> ASM_REWRITE_TAC[th]) THEN REWRITE_TAC[FUN_EQ_THM; FORALL_ONE_THM]]);; +let MONOMIAL_DIVISORS_1 = prove + (`!n. {(m1,m2) | monomial_mul m1 m2 = (\v:1. n)} = + IMAGE (\i. ((\v:1. i), (\v:1. n - i))) (0..n)`, + GEN_TAC THEN + REWRITE_TAC[EXTENSION; FORALL_PAIR_THM; IN_IMAGE; IN_ELIM_PAIR_THM; + IN_NUMSEG; EXISTS_PAIR_THM; PAIR_EQ] THEN + MAP_EVERY X_GEN_TAC [`m1:1->num`; `m2:1->num`] THEN + REWRITE_TAC[monomial_mul; FUN_ONE_NUM_EQ] THEN EQ_TAC THENL + [DISCH_TAC THEN EXISTS_TAC `(m1:1->num) one` THEN + ASM_ARITH_TAC; + DISCH_THEN(X_CHOOSE_THEN `i:num` STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC]);; + (* ------------------------------------------------------------------------- *) (* Univariate polynomial coefficient accessor: coeff *) (* ------------------------------------------------------------------------- *) @@ -20067,6 +22070,10 @@ let COEFF = prove (`!i (p:(1->num)->A). coeff i p = p(\v:1. i)`, REWRITE_TAC[coeff]);; +let COEFF_0 = prove + (`!p:(1->num)->A. coeff 0 p = p(monomial_1)`, + REWRITE_TAC[monomial_1; coeff]);; + let FUN_EQ_COEFF = prove (`!(p:(1->num)->A) q. (!d. coeff d p = coeff d q) <=> p = q`, REPEAT GEN_TAC THEN EQ_TAC THENL @@ -20076,6 +22083,48 @@ let FUN_EQ_COEFF = prove [REWRITE_TAC[FUN_EQ_THM; FORALL_ONE_THM]; ASM_REWRITE_TAC[]]; DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[]]);; +let RING_POLYNOMIAL_POWERSERIES_COEFF = prove + (`!r p. ring_polynomial r p <=> + ring_powerseries r p /\ FINITE {i | ~(coeff i p:A = ring_0 r)}`, + REWRITE_TAC[ring_polynomial; FINITE_FUN_FROM_1; coeff]);; + +let RING_POWERSERIES_COEFF = prove + (`!r (p:(1->num)->A). + ring_powerseries r p <=> (!d. coeff d p IN ring_carrier r)`, + REPEAT GEN_TAC THEN REWRITE_TAC[ring_powerseries; coeff] THEN EQ_TAC THENL + [SIMP_TAC[]; + DISCH_TAC THEN CONJ_TAC THENL + [X_GEN_TAC `m:1->num` THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(m:1->num) one`) THEN + MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM; FORALL_ONE_THM]; + MESON_TAC[FINITE_MONOMIAL_VARS_1; INFINITE]]]);; + +let COEFF_IN_CARRIER = prove + (`!r (p:(1->num)->A) d. + ring_powerseries r p ==> coeff d p IN ring_carrier r`, + SIMP_TAC[RING_POWERSERIES_COEFF]);; + +let COEFF_IN_CARRIER_ALT = prove + (`!r (p:(1->num)->A) d. + ring_polynomial r p ==> coeff d p IN ring_carrier r`, + MESON_TAC[COEFF_IN_CARRIER; ring_polynomial]);; + +let RING_POLYNOMIAL_COEFF = prove + (`!r (p:(1->num)->A). + ring_polynomial r p <=> + (!d. coeff d p IN ring_carrier r) /\ + FINITE {d | ~(coeff d p = ring_0 r)}`, + REPEAT GEN_TAC THEN + REWRITE_TAC[ring_polynomial; RING_POWERSERIES_COEFF] THEN + AP_TERM_TAC THEN REWRITE_TAC[coeff] THEN + ONCE_REWRITE_TAC[GSYM FINITE_FUN_FROM_1] THEN + REFL_TAC);; + +let COEFF_COMPOSE = prove + (`!(h:A->B) p i. coeff i (h o p) = h(coeff i p)`, + REWRITE_TAC[coeff; o_THM]);; + let COEFF_POLY_CONST = prove (`!r c d. coeff d (poly_const r c :(1->num)->A) = if d = 0 then c else ring_0 r`, @@ -20090,6 +22139,11 @@ let COEFF_POLY_1 = prove if d = 0 then ring_1 r else ring_0 r`, REWRITE_TAC[poly_1; COEFF_POLY_CONST]);; +let COEFF_POLY_VAR = prove + (`!r d x. coeff d (poly_var r x) = if d = 1 then ring_1 r else ring_0 r`, + REWRITE_TAC[FORALL_ONE_THM; poly_var; coeff; monomial_var] THEN + ONCE_REWRITE_TAC[one] THEN REWRITE_TAC[LAMBDA_1_EQ]);; + let COEFF_POLY_NEG = prove (`!r p d. coeff d (poly_neg r p :(1->num)->A) = ring_neg r (coeff d p)`, REWRITE_TAC[coeff; poly_neg]);; @@ -20104,38 +22158,105 @@ let COEFF_POLY_SUB = prove ring_sub r (coeff d p) (coeff d q)`, REWRITE_TAC[coeff; poly_sub]);; +let COEFF_POLY_MUL_ALT = prove + (`!(r:A ring) p q d. + coeff d (poly_mul r p q :(1->num)->A) = + ring_sum r {i,j | i,j | i + j = d} + (\(i,j). ring_mul r (coeff i p) (coeff j q))`, + REPEAT GEN_TAC THEN REWRITE_TAC[poly_mul; coeff] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC RING_SUM_EQ_GENERAL_INVERSES THEN + EXISTS_TAC `\(m1,m2). m1 one:num,m2 one:num` THEN + EXISTS_TAC `\(i:num,j:num). (\v:1. i),(\v:1. j)` THEN + REWRITE_TAC[FORALL_IN_GSPEC] THEN REWRITE_TAC[IN_ELIM_PAIR_THM] THEN + SIMP_TAC[FORALL_FUN_FROM_1; monomial_mul] THEN SIMP_TAC[FUN_EQ_THM]);; + let COEFF_POLY_MUL = prove (`!r p q d. coeff d (poly_mul r p q :(1->num)->A) = ring_sum r (0..d) (\a. ring_mul r (coeff a p) (coeff (d - a) q))`, - REPEAT GEN_TAC THEN REWRITE_TAC[coeff; poly_mul] THEN - CONV_TAC SYM_CONV THEN - MATCH_MP_TAC RING_SUM_EQ_GENERAL_INVERSES THEN - EXISTS_TAC `\a:num. ((\v:1. a):1->num, (\v:1. d - a):1->num)` THEN - EXISTS_TAC `\(m1:1->num, m2:1->num). (m1:1->num) one` THEN - REWRITE_TAC[FORALL_IN_GSPEC; IN_NUMSEG; LE_0] THEN - CONJ_TAC THENL - [MAP_EVERY X_GEN_TAC [`m1:1->num`; `m2:1->num`] THEN - REWRITE_TAC[monomial_mul] THEN DISCH_TAC THEN CONJ_TAC THENL - [SUBGOAL_THEN `(m1:1->num) one + (m2:1->num) one = d` - (fun th -> MESON_TAC[th; LE_ADD]) THEN - FIRST_X_ASSUM(MP_TAC o C AP_THM `one:1`) THEN - REWRITE_TAC[]; - REWRITE_TAC[PAIR_EQ] THEN CONJ_TAC THEN - REWRITE_TAC[FUN_EQ_THM; FORALL_ONE_THM] THEN - FIRST_X_ASSUM(MP_TAC o C AP_THM `one:1`) THEN - REWRITE_TAC[] THEN ARITH_TAC]; - X_GEN_TAC `a:num` THEN DISCH_TAC THEN - REWRITE_TAC[IN_ELIM_PAIR_THM; monomial_mul; - PAIR_EQ; FUN_EQ_THM; FORALL_ONE_THM] THEN - REPEAT CONJ_TAC THEN TRY(ASM_ARITH_TAC) THEN - CONV_TAC(ONCE_DEPTH_CONV GEN_BETA_CONV) THEN REFL_TAC]);; - -let POLY_MUL_UNIVARIATE = prove - (`!r (p:(1->num)->R) q. - poly_mul r p q = - \m. ring_sum r (0..m one) - (\i. ring_mul r (coeff i p) (coeff (m one - i) q))`, + REPEAT GEN_TAC THEN REWRITE_TAC[poly_mul; coeff] THEN + REWRITE_TAC[MONOMIAL_DIVISORS_1] THEN + W(MP_TAC o PART_MATCH (lhand o rand) RING_SUM_IMAGE o lhand o snd) THEN + REWRITE_TAC[IN_NUMSEG; PAIR_EQ; FUN_ONE_NUM_EQ; o_DEF] THEN + DISCH_THEN MATCH_MP_TAC THEN ARITH_TAC);; + +let COEFF_POLY_VARPOW = prove + (`!(r:A ring) x k d. + coeff d (poly_pow r (poly_var r x) k) = + if d = k then ring_1 r else ring_0 r`, + REWRITE_TAC[FORALL_ONE_THM] THEN REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`r:A ring`; `(:1)`; `one`; `k:num`] + POLY_RING_VAR_POW) THEN + REWRITE_TAC[POLY_RING_CLAUSES] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[coeff; EQT_INTRO(SPEC_ALL one); LAMBDA_1_EQ]);; + +let COEFF_POLY_LMUL = prove + (`!r c (p:(1->num)->A) d. + c IN ring_carrier r /\ ring_powerseries r p + ==> coeff d (poly_mul r (poly_const r c) p) = + ring_mul r c (coeff d p)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[COEFF_POLY_MUL; COEFF_POLY_CONST] THEN + SUBGOAL_THEN + `!a. ring_mul r (if a = 0 then c else ring_0 r) + (coeff (d - a) (p:(1->num)->A)) = + if a = 0 then ring_mul r c (coeff d p) else ring_0 r` + (fun th -> REWRITE_TAC[th]) THENL + [X_GEN_TAC `a:num` THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[SUB_0] THEN + MATCH_MP_TAC RING_MUL_LZERO THEN ASM_SIMP_TAC[COEFF_IN_CARRIER]; + REWRITE_TAC[RING_SUM_DELTA; IN_NUMSEG; LE_0] THEN + ASM_SIMP_TAC[RING_MUL; COEFF_IN_CARRIER; RING_POWERSERIES_COEFF]]);; + +let COEFF_POLY_RMUL = prove + (`!r c (p:(1->num)->A) d. + c IN ring_carrier r /\ ring_powerseries r p + ==> coeff d (poly_mul r p (poly_const r c)) = + ring_mul r (coeff d p) c`, + MESON_TAC[COEFF_POLY_LMUL; POLY_MUL_SYM; RING_POWERSERIES_CONST; + RING_MUL_SYM; COEFF_IN_CARRIER]);; + +let COEFF_POLY_VAR_MUL = prove + (`!r (p:(1->num)->A) x d. + ring_powerseries r p + ==> coeff d (poly_mul r (poly_var r x) p) = + if d = 0 then ring_0 r else coeff (d - 1) p`, + REWRITE_TAC[FORALL_ONE_THM] THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[COEFF_POLY_MUL; COEFF_POLY_VAR] THEN + GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [COND_RAND; COND_RATOR] THEN + ASM_SIMP_TAC[COEFF_IN_CARRIER; RING_MUL_LZERO; RING_SUM_DELTA; RING_MUL_LID; + IN_NUMSEG; LE_0] THEN + REWRITE_TAC[ARITH_RULE `1 <= d <=> ~(d = 0)`; COND_SWAP]);; + +let COEFF_POLY_MUL_VAR = prove + (`!r (p:(1->num)->A) x d. + ring_powerseries r p + ==> coeff d (poly_mul r p (poly_var r x)) = + if d = 0 then ring_0 r else coeff (d - 1) p`, + MESON_TAC[COEFF_POLY_VAR_MUL; POLY_MUL_SYM; RING_POWERSERIES_VAR]);; + +let COEFF_POLY_VARPOW_MUL = prove + (`!r (p:(1->num)->A) x k d. + ring_powerseries r p + ==> coeff d (poly_mul r (poly_pow r (poly_var r x) k) p) = + if d < k then ring_0 r else coeff (d - k) p`, + REWRITE_TAC[FORALL_ONE_THM] THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[COEFF_POLY_MUL; COEFF_POLY_VARPOW] THEN + GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [COND_RAND; COND_RATOR] THEN + ASM_SIMP_TAC[COEFF_IN_CARRIER; RING_MUL_LZERO; RING_SUM_DELTA; RING_MUL_LID; + IN_NUMSEG; LE_0; GSYM NOT_LE; COND_SWAP]);; + +let COEFF_POLY_MUL_VARPOW = prove + (`!r (p:(1->num)->A) x k d. + ring_powerseries r p + ==> coeff d (poly_mul r p (poly_pow r (poly_var r x) k)) = + if d < k then ring_0 r else coeff (d - k) p`, + MESON_TAC[COEFF_POLY_VARPOW_MUL; POLY_MUL_SYM; + RING_POWERSERIES_VAR; RING_POWERSERIES_POW]);; + +let POLY_MUL_UNIVARIATE = prove + (`!r (p:(1->num)->R) q. + poly_mul r p q = + \m. ring_sum r (0..m one) + (\i. ring_mul r (coeff i p) (coeff (m one - i) q))`, REPEAT GEN_TAC THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `m:1->num` THEN REWRITE_TAC[] THEN @@ -20143,39 +22264,6 @@ let POLY_MUL_UNIVARIATE = prove [REWRITE_TAC[FUN_EQ_THM; FORALL_ONE_THM]; ALL_TAC] THEN REWRITE_TAC[GSYM COEFF; COEFF_POLY_MUL]);; -let RING_POWERSERIES_COEFF = prove - (`!r (p:(1->num)->A). - ring_powerseries r p <=> (!d. coeff d p IN ring_carrier r)`, - REPEAT GEN_TAC THEN REWRITE_TAC[ring_powerseries; coeff] THEN EQ_TAC THENL - [SIMP_TAC[]; - DISCH_TAC THEN CONJ_TAC THENL - [X_GEN_TAC `m:1->num` THEN - FIRST_X_ASSUM(MP_TAC o SPEC `(m:1->num) one`) THEN - MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN - AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM; FORALL_ONE_THM]; - MESON_TAC[FINITE_MONOMIAL_VARS_1; INFINITE]]]);; - -let COEFF_IN_CARRIER = prove - (`!r (p:(1->num)->A) d. - ring_powerseries r p ==> coeff d p IN ring_carrier r`, - SIMP_TAC[RING_POWERSERIES_COEFF]);; - -let COEFF_IN_CARRIER_ALT = prove - (`!r (p:(1->num)->A) d. - ring_polynomial r p ==> coeff d p IN ring_carrier r`, - MESON_TAC[COEFF_IN_CARRIER; ring_polynomial]);; - -let RING_POLYNOMIAL_COEFF = prove - (`!r (p:(1->num)->A). - ring_polynomial r p <=> - (!d. coeff d p IN ring_carrier r) /\ - FINITE {d | ~(coeff d p = ring_0 r)}`, - REPEAT GEN_TAC THEN - REWRITE_TAC[ring_polynomial; RING_POWERSERIES_COEFF] THEN - AP_TERM_TAC THEN REWRITE_TAC[coeff] THEN - ONCE_REWRITE_TAC[GSYM FINITE_FUN_FROM_1] THEN - REFL_TAC);; - let RING_POLYNOMIAL_SUBRING_COEFF = prove (`!r G (p:(1->num)->A). ring_polynomial r p /\ @@ -20288,6 +22376,18 @@ let POLY_DEG_GE = prove ==> n <= poly_deg r p`, MESON_TAC[POLY_DEG_GE_EQ]);; +let COEFF_ABOVE_DEG = prove + (`!r (p:(1->num)->A) d. + ring_polynomial r p /\ poly_deg r p < d + ==> coeff d p = ring_0 r`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(ISPECL [`r:A ring`; `p:(1->num)->A`; `poly_deg r (p:(1->num)->A)`] + POLY_DEG_LE_EQ) THEN + ASM_REWRITE_TAC[LE_REFL] THEN + DISCH_THEN(MP_TAC o SPEC `(\v:1. d):(1->num)`) THEN + REWRITE_TAC[MONOMIAL_DEG_UNIVARIATE; coeff; MONOMIAL_UNIV] THEN + ASM_MESON_TAC[NOT_LE]);; + let POLY_DEG_MONOMIAL_EXISTS = prove (`!r (p:(V->num)->A). ring_polynomial r p /\ ~(p = poly_0 r) @@ -20398,6 +22498,14 @@ let COEFF_NONZERO_LE = prove ==> d <= n`, MESON_TAC[COEFF_NONZERO_LE_DEG; LE_TRANS]);; +let POLY_DEG_LE_COEFF_EQ = prove + (`!r (p:(1->num)->A) n. + ring_polynomial r p + ==> (poly_deg r p <= n <=> + !d. ~(coeff d p = ring_0 r) ==> d <= n)`, + ASM_SIMP_TAC[POLY_DEG_LE_EQ] THEN + ASM_REWRITE_TAC[FORALL_FUN_FROM_1; MONOMIAL_DEG_UNIVARIATE; GSYM COEFF]);; + let POLY_DEG_LE_COEFF = prove (`!r (p:(1->num)->A) n. ring_powerseries r p /\ @@ -20407,14 +22515,33 @@ let POLY_DEG_LE_COEFF = prove SUBGOAL_THEN `ring_polynomial r (p:(1->num)->A)` ASSUME_TAC THENL [MATCH_MP_TAC RING_POLYNOMIAL_COEFF_BOUND THEN EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC[]; - ALL_TAC] THEN - MATCH_MP_TAC POLY_DEG_LE THEN ASM_REWRITE_TAC[] THEN - X_GEN_TAC `m:1->num` THEN DISCH_TAC THEN - REWRITE_TAC[MONOMIAL_DEG_ONE] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN - UNDISCH_TAC `~((p:(1->num)->A) m = ring_0 r)` THEN - SUBGOAL_THEN `(m:1->num) = (\v:1. m one)` SUBST1_TAC THENL - [REWRITE_TAC[FUN_EQ_THM; FORALL_ONE_THM]; - REWRITE_TAC[coeff]]);; + ASM_SIMP_TAC[POLY_DEG_LE_COEFF_EQ]]);; + +let POLY_DEG_GE_COEFF_EQ = prove + (`!r (p:(1->num)->A) n. + ring_polynomial r p + ==> (n <= poly_deg r p <=> + n = 0 \/ ?d. ~(coeff d p = ring_0 r) /\ n <= d)`, + ASM_SIMP_TAC[POLY_DEG_GE_EQ] THEN + ASM_REWRITE_TAC[EXISTS_FUN_FROM_1; MONOMIAL_DEG_UNIVARIATE; GSYM COEFF]);; + +let POLY_DEG_GE_COEFF = prove + (`!r (p:(1->num)->A) d n. + ring_polynomial r p /\ + ~(coeff d p = ring_0 r) /\ n <= d + ==> n <= poly_deg r p`, + MESON_TAC[POLY_DEG_GE_COEFF_EQ]);; + +let POLY_DEG_EQ_COEFF_EQ = prove + (`!r (p:(1->num)->A) n. + ring_polynomial r p + ==> (poly_deg r p = n <=> + (!d. ~(coeff d p = ring_0 r) ==> d <= n) /\ + (n = 0 \/ ~(coeff n p = ring_0 r)))`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[POLY_DEG_EQ] THEN + ASM_REWRITE_TAC[FORALL_FUN_FROM_1; EXISTS_FUN_FROM_1] THEN + REWRITE_TAC[MONOMIAL_DEG_UNIVARIATE; GSYM COEFF] THEN + MESON_TAC[LE_ANTISYM]);; let POLY_DEG_EQ_COEFF = prove (`!r (p:(1->num)->A) n. @@ -20426,21 +22553,9 @@ let POLY_DEG_EQ_COEFF = prove SUBGOAL_THEN `ring_polynomial r (p:(1->num)->A)` ASSUME_TAC THENL [MATCH_MP_TAC RING_POLYNOMIAL_COEFF_BOUND THEN EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC[]; - ALL_TAC] THEN - MATCH_MP_TAC POLY_DEG_UNIQUE THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL - [X_GEN_TAC `m:1->num` THEN DISCH_TAC THEN - REWRITE_TAC[MONOMIAL_DEG_ONE] THEN - FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[coeff]) THEN - UNDISCH_TAC `~((p:(1->num)->A) m = ring_0 r)` THEN - SUBGOAL_THEN `(m:1->num) = (\v:1. m one)` SUBST1_TAC THENL - [REWRITE_TAC[FUN_EQ_THM; FORALL_ONE_THM]; REWRITE_TAC[coeff]]; - ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[] THEN - EXISTS_TAC `(\v:1. n):1->num` THEN - REWRITE_TAC[MONOMIAL_DEG_UNIVARIATE] THEN - UNDISCH_TAC `~(coeff n (p:(1->num)->A) = ring_0 r)` THEN - REWRITE_TAC[coeff]]);; - -let POLY_DEG_EQ_COEFF_FROM_LE = prove + ASM_SIMP_TAC[POLY_DEG_EQ_COEFF_EQ]]);; + +let POLY_DEG_EQ_FROM_LE = prove (`!r (p:(1->num)->A) n. ring_polynomial r p /\ poly_deg r p <= n /\ @@ -20451,30 +22566,27 @@ let POLY_DEG_EQ_COEFF_FROM_LE = prove ASM_REWRITE_TAC[] THEN MATCH_MP_TAC COEFF_NONZERO_LE_DEG THEN ASM_REWRITE_TAC[]);; -let COEFF_POLY_SUM = prove +let COEFF_POWSER_SUM = prove (`!r (p:K->(1->num)->A) d (s:K->bool). FINITE s /\ (!x. x IN s ==> ring_powerseries r (p x)) ==> coeff d (ring_sum (powser_ring r (:1)) s p) = ring_sum r s (\x. coeff d (p x))`, - REPLICATE_TAC 3 GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN - MATCH_MP_TAC FINITE_INDUCT_STRONG THEN CONJ_TAC THENL - [REWRITE_TAC[RING_SUM_CLAUSES; POWSER_RING; COEFF_POLY_0]; ALL_TAC] THEN - MAP_EVERY X_GEN_TAC [`y:K`; `t:K->bool`] THEN - STRIP_TAC THEN REWRITE_TAC[IN_INSERT] THEN STRIP_TAC THEN - SUBGOAL_THEN `ring_powerseries r ((p:K->(1->num)->A) y)` ASSUME_TAC THENL - [ASM_MESON_TAC[]; ALL_TAC] THEN - SUBGOAL_THEN `!z:K. z IN t ==> ring_powerseries r ((p:K->(1->num)->A) z)` - ASSUME_TAC THENL - [ASM_MESON_TAC[]; ALL_TAC] THEN - SUBGOAL_THEN `(p:K->(1->num)->A) y IN ring_carrier(powser_ring r (:1))` - ASSUME_TAC THENL - [REWRITE_TAC[POWSER_RING; IN_ELIM_THM; SUBSET_UNIV] THEN - ASM_REWRITE_TAC[]; - ALL_TAC] THEN - SUBGOAL_THEN `coeff d ((p:K->(1->num)->A) y) IN ring_carrier r` - ASSUME_TAC THENL - [ASM_MESON_TAC[COEFF_IN_CARRIER]; ALL_TAC] THEN - ASM_SIMP_TAC[RING_SUM_CLAUSES; POWSER_RING; COEFF_POLY_ADD]);; + REWRITE_TAC[IMP_CONJ] THEN REPLICATE_TAC 3 GEN_TAC THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + ASM_SIMP_TAC[RING_SUM_CLAUSES; FORALL_IN_INSERT] THEN + SIMP_TAC[POWSER_RING; IN_ELIM_THM; COEFF_IN_CARRIER; SUBSET_UNIV] THEN + SIMP_TAC[COEFF_POLY_0; COEFF_POLY_ADD]);; + +let COEFF_POLY_SUM = prove + (`!r (p:K->(1->num)->A) d (s:K->bool). + FINITE s /\ (!x. x IN s ==> ring_polynomial r (p x)) + ==> coeff d (ring_sum (poly_ring r (:1)) s p) = + ring_sum r s (\x. coeff d (p x))`, + REWRITE_TAC[IMP_CONJ] THEN REPLICATE_TAC 3 GEN_TAC THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + ASM_SIMP_TAC[RING_SUM_CLAUSES; FORALL_IN_INSERT] THEN + SIMP_TAC[POLY_RING; IN_ELIM_THM; COEFF_IN_CARRIER_ALT; SUBSET_UNIV] THEN + SIMP_TAC[COEFF_POLY_0; COEFF_POLY_ADD]);; let POLY_DEG_NEG = prove (`!r (p:(V->num)->A). @@ -20618,6 +22730,120 @@ let POLY_DEG_MUL = prove ASM_SIMP_TAC[MONOMIAL_LT_LMUL; MONOMIAL_LT_RMUL] THEN ASM_SIMP_TAC[MONOMIAL_LT_MUL2; WOSET_IMP_POSET]);; +let POLY_DEG_CMUL = prove + (`!r (c:A) (p:(1->num)->A). + integral_domain r /\ + c IN ring_carrier r /\ ~(c = ring_0 r) /\ + ring_polynomial r p + ==> poly_deg r (poly_mul r (poly_const r c) p) = poly_deg r p`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + ASM_CASES_TAC `(p:(1->num)->A) = poly_0 (r:A ring)` THENL + [ASM_SIMP_TAC[POLY_MUL_0; POLY_DEG_0; RING_POLYNOMIAL_CONST]; + ALL_TAC] THEN + ASM_SIMP_TAC[POLY_DEG_MUL; RING_POLYNOMIAL_CONST; POLY_CONST_EQ_0] THEN + REWRITE_TAC[POLY_DEG_CONST; ADD_CLAUSES]);; + +let POLY_MUL_LEADING_COEFF = prove + (`!r (p:(1->num)->A) q. + ring_polynomial r p /\ ring_polynomial r q + ==> coeff (poly_deg r p + poly_deg r q) (poly_mul r p q) = + ring_mul r (coeff (poly_deg r p) p) (coeff (poly_deg r q) q)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[COEFF_POLY_MUL] THEN + SUBGOAL_THEN + `ring_sum (r:A ring) (0..poly_deg r p + poly_deg r q) + (\a. ring_mul r (coeff a p) + (coeff ((poly_deg r p + poly_deg r q) - a) q)) = + ring_sum r (0..poly_deg r p + poly_deg r q) + (\a. if a = poly_deg r p + then ring_mul r (coeff (poly_deg r p) p) (coeff (poly_deg r q) q) + else ring_0 r)` + SUBST1_TAC THENL + [MATCH_MP_TAC RING_SUM_EQ THEN + X_GEN_TAC `a:num` THEN REWRITE_TAC[IN_NUMSEG] THEN STRIP_TAC THEN + COND_CASES_TAC THENL + [FIRST_X_ASSUM SUBST_ALL_TAC THEN REWRITE_TAC[ADD_SUB2]; ALL_TAC] THEN + ASM_CASES_TAC `poly_deg r (p:(1->num)->A) < a` THENL + [SUBGOAL_THEN `coeff a (p:(1->num)->A) = ring_0 (r:A ring)` SUBST1_TAC THENL + [MATCH_MP_TAC COEFF_ABOVE_DEG THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC RING_MUL_LZERO THEN + MATCH_MP_TAC COEFF_IN_CARRIER_ALT THEN ASM_REWRITE_TAC[]]; + SUBGOAL_THEN + `coeff ((poly_deg r (p:(1->num)->A) + poly_deg r q) - a) + (q:(1->num)->A) = ring_0 (r:A ring)` + SUBST1_TAC THENL + [MATCH_MP_TAC COEFF_ABOVE_DEG THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; + MATCH_MP_TAC RING_MUL_RZERO THEN + MATCH_MP_TAC COEFF_IN_CARRIER_ALT THEN ASM_REWRITE_TAC[]]]; + REWRITE_TAC[RING_SUM_DELTA; IN_NUMSEG; LE_0; LE_ADD] THEN + ASM_SIMP_TAC[COEFF_IN_CARRIER_ALT; RING_MUL]]);; + +let POLY_DEG_MUL_UNIVARIATE = prove + (`!r (p:(1->num)->A) q. + ring_polynomial r p /\ ring_polynomial r q /\ + ~(ring_mul r (coeff (poly_deg r p) p) (coeff (poly_deg r q) q) = + ring_0 r) + ==> poly_deg r (poly_mul r p q) = poly_deg r p + poly_deg r q`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC POLY_DEG_EQ_FROM_LE THEN + ASM_SIMP_TAC[POLY_DEG_MUL_LE; RING_POLYNOMIAL_MUL] THEN + ASM_SIMP_TAC[POLY_MUL_LEADING_COEFF]);; + +let POLY_DEG_VAR_MUL = prove + (`!(r:A ring) p (x:V). + ring_polynomial r p + ==> poly_deg r (poly_mul r (poly_var r x) p) = + if p = poly_0 r then 0 else poly_deg r p + 1`, + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[POLY_MUL_0; POLY_DEG_0; RING_POLYNOMIAL_VAR] THEN + REWRITE_TAC[GSYM LE_ANTISYM] THEN CONJ_TAC THENL + [W(MP_TAC o PART_MATCH (lhand o rand) POLY_DEG_MUL_LE o lhand o snd) THEN + ASM_REWRITE_TAC[RING_POLYNOMIAL_VAR; POLY_DEG_VAR] THEN ASM_ARITH_TAC; + MATCH_MP_TAC POLY_DEG_GE THEN + ASM_SIMP_TAC[RING_POLYNOMIAL_MUL; RING_POLYNOMIAL_VAR]] THEN + MP_TAC(ISPECL [`r:A ring`; `p:(V->num)->A`] POLY_DEG_MONOMIAL_EXISTS) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `m:V->num` STRIP_ASSUME_TAC) THEN + ASM_CASES_TAC `monomial (:V) m` THENL + [ALL_TAC; ASM_MESON_TAC[RING_POLYNOMIAL_MONOMIAL]] THEN + EXISTS_TAC `monomial_mul (monomial_var (x:V)) m` THEN + ASM_SIMP_TAC[MONOMIAL_DEG_MUL; MONOMIAL_VAR; IN_UNIV] THEN + REWRITE_TAC[MONOMIAL_DEG_VAR; ADD_SYM; LE_REFL] THEN + ASM_SIMP_TAC[POLY_VAR_MUL; MONOMIAL_VAR_DIVIDES_MUL; MONOMIAL_DIVIDES_REFL; + MONOMIAL_RULE `monomial_div (monomial_mul m1 m2) m1 = m2`]);; + +let POLY_DEG_MUL_VAR = prove + (`!(r:A ring) p (x:V). + ring_polynomial r p + ==> poly_deg r (poly_mul r p (poly_var r x)) = + if p = poly_0 r then 0 else poly_deg r p + 1`, + MESON_TAC[POLY_DEG_VAR_MUL; POLY_MUL_SYM; RING_POLYNOMIAL_VAR; + RING_POLYNOMIAL_IMP_POWERSERIES]);; + +let POLY_DEG_VARPOW_MUL = prove + (`!(r:A ring) p (x:V) k. + ring_polynomial r p + ==> poly_deg r (poly_mul r (poly_pow r (poly_var r x) k) p) = + if p = poly_0 r then 0 else poly_deg r p + k`, + REPLICATE_TAC 3 GEN_TAC THEN REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN + DISCH_TAC THEN + ASM_CASES_TAC `p:(V->num)->A = poly_0 r` THEN + ASM_SIMP_TAC[POLY_MUL_0; RING_POLYNOMIAL_POW; + RING_POLYNOMIAL_VAR; POLY_DEG_0] THEN + INDUCT_TAC THEN + ASM_SIMP_TAC[GSYM POLY_MUL_ASSOC; RING_POLYNOMIAL_IMP_POWERSERIES; POLY_POW; + RING_POLYNOMIAL_VAR; RING_POLYNOMIAL_POW; POLY_DEG_0; POLY_MUL_LID; + ADD_CLAUSES; POLY_DEG_VAR_MUL; RING_POLYNOMIAL_MUL] THEN + ASM_SIMP_TAC[POLY_POW; POLY_MUL_LID; RING_POLYNOMIAL_IMP_POWERSERIES] THEN + ASM_SIMP_TAC[POWSER_VARPOW_MUL_EQ_0; RING_POLYNOMIAL_IMP_POWERSERIES] THEN + ARITH_TAC);; + +let POLY_DEG_MUL_VARPOW = prove + (`!(r:A ring) p (x:V) k. + ring_polynomial r p + ==> poly_deg r (poly_mul r p (poly_pow r (poly_var r x) k)) = + if p = poly_0 r then 0 else poly_deg r p + k`, + MESON_TAC[POLY_DEG_VARPOW_MUL; POLY_MUL_SYM; RING_POLYNOMIAL_VAR; + RING_POLYNOMIAL_POW; RING_POLYNOMIAL_IMP_POWERSERIES]);; + let INTEGRAL_DOMAIN_POLY_RING = prove (`!(r:A ring) (s:V->bool). integral_domain(poly_ring r s) <=> integral_domain r`, @@ -20662,6 +22888,30 @@ let POLY_DEG_POW = prove ASM_SIMP_TAC[GSYM RING_POLYNOMIAL; INTEGRAL_DOMAIN_POLY_RING] THEN ASM_REWRITE_TAC[POLY_RING_CLAUSES]);; +let POLY_DEG_DIVIDES_LE = prove + (`!(r:A ring) (v:V->bool) p q. + integral_domain r /\ + ring_divides (poly_ring r v) p q /\ + ~(q = poly_0 r) + ==> poly_deg r p <= poly_deg r q`, + REPEAT GEN_TAC THEN + REWRITE_TAC[ring_divides; IN_POLY_RING_CARRIER; POLY_RING] THEN + STRIP_TAC THEN + SUBGOAL_THEN + `~((p:(V->num)->A) = poly_0 r) /\ ~((x:(V->num)->A) = poly_0 r)` + STRIP_ASSUME_TAC THENL + [CONJ_TAC THEN DISCH_TAC THEN + UNDISCH_TAC `~(q:(V->num)->A = poly_0 r)` THEN + ASM_SIMP_TAC[CONJUNCT1 POLY_MUL_0; CONJUNCT2 POLY_MUL_0]; + ALL_TAC] THEN + SUBGOAL_THEN + `poly_deg r (poly_mul r (p:(V->num)->A) (x:(V->num)->A)) = + poly_deg r p + poly_deg r x` + MP_TAC THENL + [MATCH_MP_TAC POLY_DEG_MUL THEN ASM_REWRITE_TAC[] THEN + EQ_TAC THEN ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[] THEN ARITH_TAC]);; + let POLY_DEG_RING_ADD_LE = prove (`!r s p (q:(V->num)->A) n. p IN ring_carrier(poly_ring r s) /\ @@ -21043,15 +23293,24 @@ let POLY_EVALUATE_POW = prove ring_pow r (poly_evaluate r p x) n`, SIMP_TAC[poly_evaluate; POLY_EXTEND_POW; I_THM; RING_HOMOMORPHISM_I]);; +let POLY_EVALUATE_RING_SUM = prove + (`!(r:A ring) (v:V->bool) (s:W->bool) f x. + (!i. i IN v ==> x i IN ring_carrier r) /\ + FINITE s /\ + (!a. a IN s ==> f a IN ring_carrier(poly_ring r v)) + ==> poly_evaluate r (ring_sum (poly_ring r v) s f) x = + ring_sum r s (\a. poly_evaluate r (f a) x)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[poly_evaluate] THEN + MATCH_MP_TAC POLY_EXTEND_RING_SUM THEN + ASM_REWRITE_TAC[RING_HOMOMORPHISM_I] THEN ASM SET_TAC[]);; + let POLY_EVALUATE_RING_PRODUCT = prove (`!(r:A ring) (v:V->bool) (s:W->bool) f x. (!i. i IN v ==> x i IN ring_carrier r) /\ FINITE s /\ (!a. a IN s ==> f a IN ring_carrier(poly_ring r v)) - ==> poly_evaluate r - (ring_product (poly_ring r v) s f) x = - ring_product r s - (\a. poly_evaluate r (f a) x)`, + ==> poly_evaluate r (ring_product (poly_ring r v) s f) x = + ring_product r s (\a. poly_evaluate r (f a) x)`, REPEAT STRIP_TAC THEN REWRITE_TAC[poly_evaluate] THEN MATCH_MP_TAC POLY_EXTEND_RING_PRODUCT THEN ASM_REWRITE_TAC[RING_HOMOMORPHISM_I] THEN ASM SET_TAC[]);; @@ -21113,13 +23372,40 @@ let POLY_EVALUATE_EQ = prove MATCH_MP_TAC POLY_EXTEND_EQ THEN EXISTS_TAC `s:V->bool` THEN ASM_REWRITE_TAC[]);; -let POLY_EVALUATE_AT_0 = prove +let POWSER_EVALUATE_AT_0 = prove (`!r (p:(V->num)->A). + ring_powerseries r p + ==> poly_evaluate r p (\x. ring_0 r) = p monomial_1`, + REPEAT STRIP_TAC THEN REWRITE_TAC[poly_evaluate] THEN + ASM_MESON_TAC[POWSER_EXTEND_AT_0; RING_HOMOMORPHISM_I; I_THM]);; + +let POLY_EVALUATE_AT_0 = prove + (`!r v (p:(V->num)->A). p IN ring_carrier (poly_ring r v) ==> poly_evaluate r p (\x. ring_0 r) = p monomial_1`, REPEAT STRIP_TAC THEN REWRITE_TAC[poly_evaluate] THEN ASM_MESON_TAC[POLY_EXTEND_AT_0; RING_HOMOMORPHISM_I; I_THM]);; +let RING_HOMOMORPHISM_POWSER_EVALUATE_AT_0 = prove + (`!(r:A ring) (s:V->bool). + ring_homomorphism (powser_ring r s,r) + (\p. poly_evaluate r p (\i. ring_0 r))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[poly_evaluate; ETA_AX] THEN + MATCH_MP_TAC RING_HOMOMORPHISM_POWSER_EXTEND_AT_0 THEN + REWRITE_TAC[RING_HOMOMORPHISM_I] THEN ASM SET_TAC[]);; + +let RING_EPIMORPHISM_POWSER_EVALUATE_AT_0 = prove + (`!(r:A ring) (s:V->bool). + ring_epimorphism (powser_ring r s,r) + (\p. poly_evaluate r p (\i. ring_0 r))`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[RING_EPIMORPHISM_ALT; + RING_HOMOMORPHISM_POWSER_EVALUATE_AT_0] THEN + REWRITE_TAC[ring_image; SUBSET; IN_IMAGE] THEN + X_GEN_TAC `a:A` THEN DISCH_TAC THEN + EXISTS_TAC `poly_const r a:(V->num)->A` THEN + ASM_SIMP_TAC[POWSER_CONST; POLY_EVALUATE_CONST]);; + let POLY_EVALUATE_REINDEX = prove (`!(r:R ring) A B q f:X->Y c:Y->R. BIJ f A B /\ poly_vars r q SUBSET B @@ -21184,12 +23470,21 @@ let POLY_EVAL_POW = prove ring_pow r (poly_eval r p x) n`, SIMP_TAC[poly_eval; POLY_EVALUATE_POW]);; +let POLY_EVAL_RING_SUM = prove + (`!(r:A ring) (s:W->bool) (f:W->(1->num)->A) (x:A). + x IN ring_carrier r /\ FINITE s /\ + (!a. a IN s ==> f a IN ring_carrier(poly_ring r (:1))) + ==> poly_eval r (ring_sum (poly_ring r (:1)) s f) x = + ring_sum r s (\a. poly_eval r (f a) x)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[poly_eval] THEN + MATCH_MP_TAC POLY_EVALUATE_RING_SUM THEN + ASM_REWRITE_TAC[SUBSET; FORALL_IN_IMAGE]);; + let POLY_EVAL_RING_PRODUCT = prove (`!(r:A ring) (s:W->bool) (f:W->(1->num)->A) (x:A). x IN ring_carrier r /\ FINITE s /\ (!a. a IN s ==> f a IN ring_carrier(poly_ring r (:1))) - ==> poly_eval r - (ring_product (poly_ring r (:1)) s f) x = + ==> poly_eval r (ring_product (poly_ring r (:1)) s f) x = ring_product r s (\a. poly_eval r (f a) x)`, REPEAT STRIP_TAC THEN REWRITE_TAC[poly_eval] THEN MATCH_MP_TAC POLY_EVALUATE_RING_PRODUCT THEN @@ -21278,6 +23573,13 @@ let POLY_EXPAND = prove MATCH_MP_TAC POLY_EXTEND_UNIVARIATE THEN ASM_REWRITE_TAC[RING_HOMOMORPHISM_POLY_CONST; POLY_VAR_UNIV]);; +let POWSER_EVAL_AT_0 = prove + (`!(r:A ring) p. + ring_powerseries r p + ==> poly_eval r p (ring_0 r) = coeff 0 p`, + REPEAT STRIP_TAC THEN REWRITE_TAC[coeff; poly_eval; GSYM monomial_1] THEN + ASM_MESON_TAC[POWSER_EVALUATE_AT_0]);; + let POLY_EVAL_AT_0 = prove (`!(r:A ring) p. p IN ring_carrier (poly_ring r (:1)) @@ -21285,38 +23587,43 @@ let POLY_EVAL_AT_0 = prove REPEAT STRIP_TAC THEN REWRITE_TAC[coeff; poly_eval; GSYM monomial_1] THEN ASM_MESON_TAC[POLY_EVALUATE_AT_0]);; -let COEFF_POLY_CONST_MUL = prove - (`!r c (p:(1->num)->A) d. - c IN ring_carrier r /\ ring_powerseries r p - ==> coeff d (poly_mul r (poly_const r c) p) = - ring_mul r c (coeff d p)`, - REPEAT STRIP_TAC THEN REWRITE_TAC[COEFF_POLY_MUL; COEFF_POLY_CONST] THEN - SUBGOAL_THEN - `!a. ring_mul r (if a = 0 then c else ring_0 r) - (coeff (d - a) (p:(1->num)->A)) = - if a = 0 then ring_mul r c (coeff d p) else ring_0 r` - (fun th -> REWRITE_TAC[th]) THENL - [X_GEN_TAC `a:num` THEN COND_CASES_TAC THEN - ASM_REWRITE_TAC[SUB_0] THEN - MATCH_MP_TAC RING_MUL_LZERO THEN - ASM_SIMP_TAC[COEFF_IN_CARRIER]; - REWRITE_TAC[RING_SUM_DELTA; IN_NUMSEG; LE_0] THEN - ASM_SIMP_TAC[RING_MUL; COEFF_IN_CARRIER; - RING_POWERSERIES_COEFF]]);; - -let COEFF_POLY_MUL_CONST = prove - (`!r c (p:(1->num)->A) d. - c IN ring_carrier r /\ ring_powerseries r p - ==> coeff d (poly_mul r p (poly_const r c)) = - ring_mul r c (coeff d p)`, - REPEAT STRIP_TAC THEN - SUBGOAL_THEN - `poly_mul r (p:(1->num)->A) (poly_const r c) = - poly_mul r (poly_const r c) p` - SUBST1_TAC THENL - [MATCH_MP_TAC POLY_MUL_SYM THEN - ASM_SIMP_TAC[RING_POWERSERIES_CONST]; - ASM_SIMP_TAC[COEFF_POLY_CONST_MUL]]);; +let RING_HOMOMORPHISM_POWSER_EVAL_AT_0 = prove + (`!(r:A ring) s. ring_homomorphism (powser_ring r s,r) + (\p. poly_eval r p (ring_0 r))`, + SIMP_TAC[poly_eval; RING_HOMOMORPHISM_POWSER_EVALUATE_AT_0]);; + +let RING_EPIMORPHISM_POWSER_EVAL_AT_0 = prove + (`!(r:A ring) s. ring_epimorphism (powser_ring r s,r) + (\p. poly_eval r p (ring_0 r))`, + SIMP_TAC[poly_eval; RING_EPIMORPHISM_POWSER_EVALUATE_AT_0]);; + +let POWSER_RING_HOMOMORPHISM_COEFF_0 = prove + (`!(r:A ring) s. ring_homomorphism (powser_ring r s,r) (coeff 0)`, + REPEAT GEN_TAC THEN MATCH_MP_TAC RING_HOMOMORPHISM_EQ THEN + EXISTS_TAC `\p. poly_eval r p (ring_0 r:A)` THEN + ASM_SIMP_TAC[RING_HOMOMORPHISM_POWSER_EVAL_AT_0; POWSER_EVAL_AT_0; + POWSER_RING; IN_ELIM_THM]);; + +let POLY_RING_HOMOMORPHISM_COEFF_0 = prove + (`!(r:A ring) s. ring_homomorphism (poly_ring r s,r) (coeff 0)`, + REPEAT GEN_TAC THEN MATCH_MP_TAC RING_HOMOMORPHISM_EQ THEN + EXISTS_TAC `\p. poly_eval r p (ring_0 r:A)` THEN + ASM_SIMP_TAC[RING_HOMOMORPHISM_POLY_EVAL; RING_0; POWSER_EVAL_AT_0; + POLY_RING; ring_polynomial; IN_ELIM_THM]);; + +let POWSER_RING_EPIMORPHISM_COEFF_0 = prove + (`!(r:A ring) s. ring_epimorphism (powser_ring r s,r) (coeff 0)`, + REPEAT GEN_TAC THEN MATCH_MP_TAC RING_EPIMORPHISM_EQ THEN + EXISTS_TAC `\p. poly_eval r p (ring_0 r:A)` THEN + ASM_SIMP_TAC[RING_EPIMORPHISM_POWSER_EVAL_AT_0; POWSER_EVAL_AT_0; + POWSER_RING; IN_ELIM_THM]);; + +let POLY_RING_EPIMORPHISM_COEFF_0 = prove + (`!(r:A ring) s. ring_epimorphism (poly_ring r s,r) (coeff 0)`, + REPEAT GEN_TAC THEN MATCH_MP_TAC RING_EPIMORPHISM_EQ THEN + EXISTS_TAC `\p. poly_eval r p (ring_0 r:A)` THEN + ASM_SIMP_TAC[RING_EPIMORPHISM_POLY_EVAL; RING_0; POWSER_EVAL_AT_0; + POLY_RING; ring_polynomial; IN_ELIM_THM]);; let POLY_EVAL_COEFF = prove (`!r (p:(1->num)->A) x n. @@ -21365,6 +23672,34 @@ let IMAGE_POLY_EVAL = prove RING_HOMOMORPHISM_FROM_SUBRING_GENERATED; RING_HOMOMORPHISM_I; POLY_EXTEND_FROM_SUBRING_GENERATED]);; +let POLY_VAR_DIVIDES_UNIVARIATE = prove + (`!(r:A ring) p. + ring_divides (poly_ring r (:1)) (poly_var r one) p <=> + ring_polynomial r p /\ coeff 0 p = ring_0 r`, + REPEAT GEN_TAC THEN + ASM_CASES_TAC `ring_polynomial r (p:(1->num)->A)` THENL + [ASM_REWRITE_TAC[]; ASM_MESON_TAC[RING_POLYNOMIAL; ring_divides]] THEN + EQ_TAC THENL + [REWRITE_TAC[ring_divides; GSYM RING_POLYNOMIAL] THEN STRIP_TAC THEN + ASM_SIMP_TAC[COEFF_POLY_VAR_MUL; POLY_RING; RING_POLYNOMIAL_IMP_POWERSERIES]; + DISCH_TAC THEN ASM_SIMP_TAC[ring_divides; POLY_VAR_UNIV] THEN + ASM_REWRITE_TAC[GSYM RING_POLYNOMIAL] THEN + EXISTS_TAC `\m. (p:(1->num)->A) (\v. m one + 1)` THEN + MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [RING_POLYNOMIAL_COEFF]) THEN + REWRITE_TAC[RING_POLYNOMIAL_COEFF; coeff] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [FINITE_SUBSET_NUMSEG]) THEN + REWRITE_TAC[FINITE_SUBSET_NUMSEG] THEN MATCH_MP_TAC MONO_EXISTS THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_NUMSEG; LE_0] THEN GEN_TAC THEN + GEN_REWRITE_TAC (BINOP_CONV o ONCE_DEPTH_CONV) [GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[NOT_LE] THEN DISCH_TAC THEN GEN_TAC THEN DISCH_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; + DISCH_TAC THEN REWRITE_TAC[GSYM FUN_EQ_COEFF; POLY_RING] THEN + ASM_SIMP_TAC[COEFF_POLY_VAR_MUL; RING_POLYNOMIAL_IMP_POWERSERIES] THEN + GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[coeff; SUB_ADD; LE_1]]]);; + (* ------------------------------------------------------------------------- *) (* Composing polynomials and power series with homomorphisms. *) (* ------------------------------------------------------------------------- *) @@ -21814,7 +24149,6 @@ let RING_UNIT_POLY_RING = prove [REWRITE_TAC[SET_RULE `{x | P x} = a INSERT ({x | P x} DELETE a) <=> P a`] THEN ASM_MESON_TAC[RING_UNIT_0]; - ASM_SIMP_TAC[RING_SUM_CLAUSES; FINITE_DELETE; RING_MUL; POLY_CONST; RING_PRODUCT; IN_DELETE]] THEN MATCH_MP_TAC(CONJUNCT1 RING_UNIT_NILPOTENT_CLAUSES) THEN CONJ_TAC THENL @@ -21829,6 +24163,27 @@ let RING_UNIT_POLY_RING = prove EXISTS_TAC `r:A ring` THEN ASM_SIMP_TAC[RING_HOMOMORPHISM_POLY_CONST]]]);; +let RING_UNIT_POLY_RING_1 = prove + (`!(r:A ring) p. + ring_unit (poly_ring r (:1)) p <=> + p IN ring_carrier (poly_ring r (:1)) /\ + ring_unit r (coeff 0 p) /\ + !i. 0 < i ==> ring_nilpotent r (coeff i p)`, + REPEAT GEN_TAC THEN REWRITE_TAC[RING_UNIT_POLY_RING] THEN + REWRITE_TAC[FORALL_FUN_FROM_1; monomial_1; coeff] THEN + REWRITE_TAC[LAMBDA_1_EQ] THEN MESON_TAC[LE_1]);; + +let RING_UNIT_POLY_VAR = prove + (`!(r:A ring) (v:V->bool) x. + ring_unit (poly_ring r v) (poly_var r x) <=> trivial_ring r`, + REPEAT GEN_TAC THEN REWRITE_TAC[RING_UNIT_POLY_RING; POLY_VAR] THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV o LAND_CONV o ONCE_DEPTH_CONV) + [poly_var] THEN + REWRITE_TAC[MONOMIAL_VAR_1; RING_UNIT_0] THEN + ASM_CASES_TAC `trivial_ring(r:A ring)` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[poly_var] THEN + ASM_MESON_TAC[RING_NILPOTENT_0; RING_NILPOTENT_1]);; + let FIELD_POLY_RING = prove (`!(r:A ring) (s:V->bool). field(poly_ring r s) <=> field r /\ s = {}`, REPEAT GEN_TAC THEN @@ -21858,6 +24213,12 @@ let POLY_DEG_EQ_0_UNIT = prove FIELD_UNIT] THEN MESON_TAC[POLY_CONST_0; RING_0; POLY_RING]);; +let IRREDUCIBLE_IMP_POLY_DEG_NZ = prove + (`!(k:A ring) p. + field k /\ ring_irreducible (poly_ring k (:1)) p + ==> ~(poly_deg k p = 0)`, + MESON_TAC[POLY_DEG_EQ_0_UNIT; RING_POLYNOMIAL; ring_irreducible]);; + let POLY_DEG_1_IMP_IRREDUCIBLE = prove (`!(f:A ring) (s:V->bool) p. field f /\ p IN ring_carrier(poly_ring f s) /\ poly_deg f p = 1 @@ -21990,53 +24351,275 @@ let LOCAL_POWSER_RING = prove REPEAT GEN_TAC THEN STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM SET_TAC[RING_CARRIER_POWSER_RING]);; -(* ------------------------------------------------------------------------- *) -(* X - a divides p(X) - p(a) and consequences like finiteness of roots. *) -(* ------------------------------------------------------------------------- *) - -let POLY_DEG_X_MINUS_A = prove - (`!r (a:A). - ~trivial_ring r /\ a IN ring_carrier r - ==> poly_deg r (poly_sub r (poly_var r (one:1)) (poly_const r a)) = 1`, - REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`r:A ring`; - `poly_var (r:A ring) (one:1):(1->num)->A`; - `poly_const (r:A ring) (a:A):(1->num)->A`] POLY_DEG_SUB) THEN - ASM_REWRITE_TAC[RING_POLYNOMIAL_VAR; RING_POLYNOMIAL_CONST; - POLY_DEG_VAR; POLY_DEG_CONST; - GSYM TRIVIAL_RING_10] THEN ARITH_TAC);; - -let POLY_X_MINUS_A_NONZERO = prove - (`!r (a:A). - ~trivial_ring r /\ a IN ring_carrier r - ==> ~(poly_sub r (poly_var r (one:1)) - (poly_const r a) = poly_0 r)`, REPEAT STRIP_TAC THEN - MP_TAC(SPECL [`r:A ring`; `a:A`] POLY_DEG_X_MINUS_A) THEN - ASM_REWRITE_TAC[POLY_DEG_0] THEN ARITH_TAC);; +let RING_PRIME_POLY_VAR_UNIVARIATE = prove + (`!(r:A ring). + ring_prime (poly_ring r (:1)) (poly_var r one) <=> + integral_domain r`, + GEN_TAC THEN + TRANS_TAC EQ_TRANS + `prime_ideal (poly_ring (r:A ring) (:1)) + (ideal_generated (poly_ring r (:1)) {poly_var r one})` THEN + CONJ_TAC THENL + [REWRITE_TAC[PRIME_IDEAL_SING; POLY_VAR; IN_UNIV] THEN + REWRITE_TAC[POLY_VAR_EQ_CONST; POLY_RING; poly_0] THEN + REWRITE_TAC[INTEGRAL_DOMAIN_POLY_RING] THEN MATCH_MP_TAC(TAUT + `(i ==> ~t) /\ (p ==> ~t) ==> (p <=> if t then i else p)`) THEN + REWRITE_TAC[INTEGRAL_DOMAIN_IMP_NONTRIVIAL_RING] THEN + MESON_TAC[TRIVIAL_POLY_RING; RING_PRIME_IMP_NONTRIVIAL_RING]; + SIMP_TAC[RING_IDEAL_IDEAL_GENERATED; + GSYM INTEGRAL_DOMAIN_QUOTIENT_RING]] THEN + MATCH_MP_TAC ISOMORPHIC_RING_INTEGRAL_DOMAINNESS THEN + MP_TAC(ISPECL [`poly_ring (r:A ring) (:1)`; `r:A ring`; + `\p. poly_eval (r:A ring) p (ring_0 r)`] + FIRST_RING_EPIMORPHISM_THEOREM) THEN + SIMP_TAC[RING_EPIMORPHISM_POLY_EVAL; RING_0] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] ISOMORPHIC_RING_TRANS) THEN + MATCH_MP_TAC ISOMORPHIC_RING_EQ THEN AP_TERM_TAC THEN + SIMP_TAC[ring_kernel; IDEAL_GENERATED_SING; POLY_VAR; IN_UNIV] THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; POLY_VAR_DIVIDES_UNIVARIATE] THEN + REWRITE_TAC[RING_POLYNOMIAL] THEN MESON_TAC[POLY_EVAL_AT_0]);; + +let RING_PRIME_POLY_VAR = prove + (`!(r:A ring) v x:V. + ring_prime (poly_ring r v) (poly_var r x) <=> + integral_domain r /\ x IN v`, + let lemma = prove + (`!(r:A ring) x:V. + ring_prime (poly_ring r {x}) (poly_var r x) <=> + integral_domain r`, + REPEAT GEN_TAC THEN + MP_TAC(SPEC `r:A ring` RING_PRIME_POLY_VAR_UNIVARIATE) THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + SUBGOAL_THEN `BIJ (\v:V. one) {x} (:1)` ASSUME_TAC THENL + [REWRITE_TAC[BIJ; INJ; SURJ] THEN + REWRITE_TAC[FORALL_ONE_THM; FORALL_IN_INSERT; NOT_IN_EMPTY] THEN + SET_TAC[]; + MP_TAC(ISPECL [`r:A ring`; `{x:V}`; `(:1)`; `(\v:V. one)`] + RING_ISOMORPHISM_POLY_REINDEX) THEN ASM_REWRITE_TAC[]] THEN + DISCH_THEN(MP_TAC o SPEC `poly_var (r:A ring) one` o MATCH_MP + (REWRITE_RULE[IMP_CONJ] RING_PRIME_ISOMORPHIC_IMAGE_EQ)) THEN + REWRITE_TAC[POLY_VAR; IN_UNIV] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + MP_TAC(ISPECL + [`r:A ring`; `(\v:V. one)`; `{x:V}`; `(:1)`; `x:V`] + POLY_REINDEX_VAR) THEN + ASM_SIMP_TAC[IN_SING]) in + REPEAT GEN_TAC THEN ASM_CASES_TAC `(x:V) IN v` THEN ASM_REWRITE_TAC[] THENL + [ALL_TAC; + ASM_MESON_TAC[RING_PRIME_IN_CARRIER; RING_PRIME_IMP_NONTRIVIAL_RING; + POLY_VAR; TRIVIAL_POLY_RING]] THEN + MP_TAC(ISPECL [`r:A ring`; `v DELETE (x:V)`; `{x:V}`] + RING_ISOMORPHISMS_POLY_POLY_RING) THEN + ANTS_TAC THENL [SET_TAC[]; ALL_TAC] THEN + ASM_SIMP_TAC[SET_RULE `x IN v ==> v DELETE x UNION {x} = v`] THEN + ONCE_REWRITE_TAC[RING_ISOMORPHISMS_SYM] THEN + DISCH_THEN(MP_TAC o MATCH_MP RING_ISOMORPHISMS_IMP_ISOMORPHISM) THEN + DISCH_THEN(MP_TAC o SPEC `poly_var r x:(V->num)->A` o MATCH_MP + (REWRITE_RULE[IMP_CONJ] RING_PRIME_ISOMORPHIC_IMAGE_EQ)) THEN + ASM_REWRITE_TAC[POLY_VAR] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + MP_TAC(ISPECL [`poly_ring (r:A ring) (v DELETE (x:V))`; `x:V`] lemma) THEN + REWRITE_TAC[INTEGRAL_DOMAIN_POLY_RING] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN AP_TERM_TAC THEN + GEN_REWRITE_TAC I [FUN_EQ_THM] THEN REWRITE_TAC[poly_var] THEN + REWRITE_TAC[MONOMIAL_MUL_EQ_VAR] THEN X_GEN_TAC `m1:V->num` THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[MONOMIAL_VAR_1] THEN + GEN_REWRITE_TAC I [FUN_EQ_THM] THEN X_GEN_TAC `m2:V->num` THEN + REWRITE_TAC[POLY_RING; poly_0; poly_1; COND_ID; MONOMIAL_VAR; IN_SING; + poly_const] + THENL [MESON_TAC[MONOMIAL_1]; ALL_TAC] THEN + ASM_CASES_TAC `m2 = monomial_var (x:V)` THEN + ASM_REWRITE_TAC[MONOMIAL_VAR; IN_DELETE; COND_ID]);; + +let RING_IRREDUCIBLE_POLY_VAR = prove + (`!(r:A ring) v x:V. + integral_domain r /\ x IN v + ==> ring_irreducible (poly_ring r v) (poly_var r x)`, + MESON_TAC[INTEGRAL_DOMAIN_PRIME_IMP_IRREDUCIBLE; RING_PRIME_POLY_VAR; + INTEGRAL_DOMAIN_POLY_RING]);; -let POLY_X_MINUS_A_IN_CARRIER = prove - (`!r (a:A). - a IN ring_carrier r - ==> poly_sub r (poly_var r (one:1)) (poly_const r a) - IN ring_carrier(poly_ring r (:1))`, - REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM RING_POLYNOMIAL] THEN - MATCH_MP_TAC RING_POLYNOMIAL_SUB THEN - ASM_SIMP_TAC[RING_POLYNOMIAL_VAR; RING_POLYNOMIAL_CONST]);; +(* Prime in R gives prime poly_const in R[X] *) +(* Proof: quotient map to (R/(p))[X], integral domain *) -let POLY_DIVIDES_X_MINUS_A = prove - (`!r (a:A) p. - a IN ring_carrier r /\ p IN ring_carrier(poly_ring r (:1)) - ==> ring_divides (poly_ring r (:1)) - (poly_sub r (poly_var r one) (poly_const r a)) - (poly_sub r p (poly_const r (poly_eval r p a)))`, - let lemma = prove - (`!r a x x' y y':A. - x IN ring_carrier r /\ x' IN ring_carrier r /\ - y IN ring_carrier r /\ y' IN ring_carrier r /\ - ring_divides r a (ring_sub r x x') /\ - ring_divides r a (ring_sub r y y') - ==> ring_divides r a (ring_sub r (ring_add r x y) (ring_add r x' y')) /\ - ring_divides r a (ring_sub r (ring_mul r x y) (ring_mul r x' y'))`, - REPEAT GEN_TAC THEN REWRITE_TAC[ring_divides; IMP_CONJ] THEN +let RING_PRIME_POLY_CONST = prove + (`!(r:A ring) (s:V->bool) p. + ring_prime (poly_ring r s) (poly_const r p) <=> ring_prime r p`, + REPEAT GEN_TAC THEN EQ_TAC THENL + [REWRITE_TAC[ring_prime; POLY_CONST; RING_UNIT_POLY_CONST] THEN + ASM_CASES_TAC `(p:A) IN ring_carrier r` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `p:A = ring_0 r` THENL + [ASM_MESON_TAC[POLY_RING; POLY_CONST_EQ_0]; ALL_TAC] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC [`a:A`; `b:A`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`(poly_const r a):(V->num)->A`; `(poly_const r b):(V->num)->A`]) THEN + ASM_REWRITE_TAC[POLY_CONST; POLY_CONST_DIVIDES_CONST] THEN + ASM_SIMP_TAC[GSYM POLY_CONST_MUL; POLY_RING; POLY_CONST_DIVIDES_CONST]; + DISCH_TAC] THEN + FIRST_ASSUM(STRIP_ASSUME_TAC o + GEN_REWRITE_RULE I [ring_prime]) THEN + ABBREV_TAC + `j = ideal_generated r {p:A}` THEN + SUBGOAL_THEN `ring_ideal r (j:A->bool)` ASSUME_TAC THENL + [EXPAND_TAC "j" THEN REWRITE_TAC[RING_IDEAL_IDEAL_GENERATED]; ALL_TAC] THEN + SUBGOAL_THEN + `integral_domain + (poly_ring (quotient_ring r (j:A->bool)) (s:V->bool))` ASSUME_TAC THENL + [ASM_SIMP_TAC[INTEGRAL_DOMAIN_POLY_RING; + INTEGRAL_DOMAIN_QUOTIENT_RING] THEN + EXPAND_TAC "j" THEN ASM_SIMP_TAC[PRIME_IDEAL_SING]; + ALL_TAC] THEN + SUBGOAL_THEN + `ring_homomorphism (poly_ring r (s:V->bool), + poly_ring (quotient_ring r (j:A->bool)) s) + (\q:(V->num)->A. ring_coset r j o q)` ASSUME_TAC THENL + [ASM_SIMP_TAC[RING_HOMOMORPHISM_POLY_RINGS; RING_HOMOMORPHISM_RING_COSET]; + ALL_TAC] THEN + FIRST_ASSUM(ASSUME_TAC o REWRITE_RULE[SUBSET; FORALL_IN_IMAGE] o + CONJUNCT1 o GEN_REWRITE_RULE I [ring_homomorphism]) THEN + SUBGOAL_THEN + `(\q:(V->num)->A. ring_coset r (j:A->bool) o q) (poly_const r p) = + ring_0 (poly_ring (quotient_ring r j) (s:V->bool))` ASSUME_TAC THENL + [CONV_TAC(LAND_CONV BETA_CONV) THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN + X_GEN_TAC `m:V->num` THEN + REWRITE_TAC[o_THM; poly_const; POLY_RING; POLY_0] THEN + COND_CASES_TAC THEN + ASM_SIMP_TAC[QUOTIENT_RING; RING_COSET_0; RING_IDEAL_IMP_SUBSET] THEN + ASM_MESON_TAC[RING_COSET_EQ_IDEAL; IDEAL_GENERATED_INC; + IN_SING; SING_SUBSET]; + ALL_TAC] THEN + REWRITE_TAC[ring_prime] THEN REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[POLY_RING; POLY_CONST]; + ASM_MESON_TAC[POLY_RING; POLY_CONST_0; POLY_CONST_EQ]; + ASM_MESON_TAC[RING_UNIT_POLY_CONST; ring_prime]; + ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`f:(V->num)->A`; `g:(V->num)->A`] THEN + STRIP_TAC THEN + SUBGOAL_THEN + `(!m:V->num. ring_divides r p ((f:(V->num)->A) m)) \/ + (!m. ring_divides r p ((g:(V->num)->A) m))` MP_TAC THENL + [ALL_TAC; + DISCH_THEN DISJ_CASES_TAC THENL [DISJ1_TAC; DISJ2_TAC] THEN + MATCH_MP_TAC POLY_CONST_DIVIDES_COEFFS THEN ASM_REWRITE_TAC[]] THEN + SUBGOAL_THEN + `(\q:(V->num)->A. ring_coset r (j:A->bool) o q) + (ring_mul (poly_ring r (s:V->bool)) (f:(V->num)->A) g) = + ring_0 (poly_ring (quotient_ring r j) s)` ASSUME_TAC THENL + [SUBGOAL_THEN + `ring_divides (poly_ring (quotient_ring r (j:A->bool)) (s:V->bool)) + ((\q:(V->num)->A. ring_coset r j o q) (poly_const r p)) + ((\q. ring_coset r j o q) + (ring_mul (poly_ring r s) (f:(V->num)->A) g))` MP_TAC THENL + [MATCH_MP_TAC RING_DIVIDES_HOMOMORPHIC_IMAGE THEN + EXISTS_TAC `poly_ring (r:A ring) (s:V->bool)` THEN ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[RING_DIVIDES_ZERO]]; + ALL_TAC] THEN + SUBGOAL_THEN + `(\q:(V->num)->A. ring_coset r (j:A->bool) o q) (f:(V->num)->A) = + ring_0 (poly_ring (quotient_ring r j) (s:V->bool)) \/ + (\q:(V->num)->A. ring_coset r (j:A->bool) o q) (g:(V->num)->A) = + ring_0 (poly_ring (quotient_ring r j) s)` MP_TAC THENL + [MP_TAC(ISPEC `poly_ring (quotient_ring (r:A ring) (j:A->bool)) (s:V->bool)` + INTEGRAL_DOMAIN_MUL_EQ_0) THEN + ASM_SIMP_TAC[] THEN ASM_MESON_TAC[RING_HOMOMORPHISM_MUL]; + ALL_TAC] THEN + DISCH_THEN DISJ_CASES_TAC THENL [DISJ1_TAC; DISJ2_TAC] THEN + X_GEN_TAC `m:V->num` THEN + FIRST_X_ASSUM(MP_TAC o AP_TERM + `\(ff:(V->num)->(A->bool)). ff (m:V->num)`) THEN + CONV_TAC(DEPTH_CONV BETA_CONV) THEN + ASM_SIMP_TAC[o_THM; POLY_RING; POLY_0; QUOTIENT_RING; + RING_COSET_0; RING_IDEAL_IMP_SUBSET] THEN + DISCH_TAC THEN EXPAND_TAC "j" THEN + ASM_MESON_TAC[RING_COSET_EQ_IDEAL; IN_IDEAL_GENERATED_SING_EQ; + POLY_MONOMIAL_IN_CARRIER]);; + +(* There isn't a similarly simple equivalence for this in general so just *) +(* treat the common case of integral domain where the proof is quite easy *) + +let RING_IRREDUCIBLE_POLY_CONST = prove + (`!(r:A ring) (s:V->bool) p. + integral_domain r + ==> (ring_irreducible (poly_ring r s) (poly_const r p) <=> + ring_irreducible r p)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[ring_irreducible; POLY_CONST; RING_UNIT_POLY_CONST] THEN + ASM_CASES_TAC `(p:A) IN ring_carrier r` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[CONJUNCT1(CONJUNCT2 POLY_RING); POLY_CONST_EQ_0] THEN + EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THENL + [MAP_EVERY X_GEN_TAC [`a:A`; `b:A`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`(poly_const r a):(V->num)->A`; `(poly_const r b):(V->num)->A`]) THEN + ASM_REWRITE_TAC[POLY_CONST] THEN + ASM_SIMP_TAC[GSYM POLY_CONST_MUL; POLY_RING; RING_UNIT_POLY_CONST]; + MAP_EVERY X_GEN_TAC [`u:(V->num)->A`; `v:(V->num)->A`] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + SUBGOAL_THEN + `ring_polynomial r (u:(V->num)->A) /\ + ring_polynomial r (v:(V->num)->A)` + STRIP_ASSUME_TAC THENL [ASM_MESON_TAC[IN_POLY_RING_CARRIER]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SYM) THEN REWRITE_TAC[CONJUNCT2 POLY_RING] THEN + ASM_CASES_TAC `u:(V->num)->A = poly_0 r` THEN + ASM_SIMP_TAC[POLY_MUL_0; POLY_CONST_EQ_0] THEN + ASM_CASES_TAC `v:(V->num)->A = poly_0 r` THEN + ASM_SIMP_TAC[POLY_MUL_0; POLY_CONST_EQ_0] THEN + DISCH_THEN(ASSUME_TAC o SYM) THEN + MP_TAC(ISPECL [`r:A ring`; `u:(V->num)->A`; `v:(V->num)->A`] + POLY_DEG_MUL) THEN + ANTS_TAC THENL [ASM_MESON_TAC[IN_POLY_RING_CARRIER]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SYM) THEN ASM_REWRITE_TAC[POLY_DEG_CONST] THEN + ASM_SIMP_TAC[ADD_EQ_0; POLY_DEG_EQ_0] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM; IMP_CONJ] THEN + X_GEN_TAC `a:A` THEN DISCH_TAC THEN DISCH_THEN SUBST_ALL_TAC THEN + X_GEN_TAC `b:A` THEN DISCH_TAC THEN DISCH_THEN SUBST_ALL_TAC THEN + ASM_SIMP_TAC[RING_UNIT_POLY_CONST] THEN + ASM_MESON_TAC[POLY_CONST_MUL; POLY_CONST_EQ]]);; + +(* ------------------------------------------------------------------------- *) +(* X - a divides p(X) - p(a) and consequences like finiteness of roots. *) +(* ------------------------------------------------------------------------- *) + +let POLY_DEG_X_MINUS_A = prove + (`!r (a:A). + ~trivial_ring r /\ a IN ring_carrier r + ==> poly_deg r (poly_sub r (poly_var r (one:1)) (poly_const r a)) = 1`, + REPEAT STRIP_TAC THEN MP_TAC(ISPECL [`r:A ring`; + `poly_var (r:A ring) (one:1):(1->num)->A`; + `poly_const (r:A ring) (a:A):(1->num)->A`] POLY_DEG_SUB) THEN + ASM_REWRITE_TAC[RING_POLYNOMIAL_VAR; RING_POLYNOMIAL_CONST; + POLY_DEG_VAR; POLY_DEG_CONST; + GSYM TRIVIAL_RING_10] THEN ARITH_TAC);; + +let POLY_X_MINUS_A_NONZERO = prove + (`!r (a:A). + ~trivial_ring r /\ a IN ring_carrier r + ==> ~(poly_sub r (poly_var r (one:1)) + (poly_const r a) = poly_0 r)`, REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`r:A ring`; `a:A`] POLY_DEG_X_MINUS_A) THEN + ASM_REWRITE_TAC[POLY_DEG_0] THEN ARITH_TAC);; + +let POLY_X_MINUS_A_IN_CARRIER = prove + (`!r (a:A). + a IN ring_carrier r + ==> poly_sub r (poly_var r (one:1)) (poly_const r a) + IN ring_carrier(poly_ring r (:1))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM RING_POLYNOMIAL] THEN + MATCH_MP_TAC RING_POLYNOMIAL_SUB THEN + ASM_SIMP_TAC[RING_POLYNOMIAL_VAR; RING_POLYNOMIAL_CONST]);; + +let POLY_DIVIDES_X_MINUS_A = prove + (`!r (a:A) p. + a IN ring_carrier r /\ p IN ring_carrier(poly_ring r (:1)) + ==> ring_divides (poly_ring r (:1)) + (poly_sub r (poly_var r one) (poly_const r a)) + (poly_sub r p (poly_const r (poly_eval r p a)))`, + let lemma = prove + (`!r a x x' y y':A. + x IN ring_carrier r /\ x' IN ring_carrier r /\ + y IN ring_carrier r /\ y' IN ring_carrier r /\ + ring_divides r a (ring_sub r x x') /\ + ring_divides r a (ring_sub r y y') + ==> ring_divides r a (ring_sub r (ring_add r x y) (ring_add r x' y')) /\ + ring_divides r a (ring_sub r (ring_mul r x y) (ring_mul r x' y'))`, + REPEAT GEN_TAC THEN REWRITE_TAC[ring_divides; IMP_CONJ] THEN REWRITE_TAC[LEFT_IMP_EXISTS_THM] THEN REPEAT DISCH_TAC THEN X_GEN_TAC `d:A` THEN STRIP_TAC THEN REPEAT DISCH_TAC THEN X_GEN_TAC `e:A` THEN STRIP_TAC THEN REPEAT DISCH_TAC THEN @@ -22260,6 +24843,41 @@ let POLY_TOP_EQ_0 = prove ASM_REWRITE_TAC[coeff]; DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[COEFF_POLY_0]]);; +let POLY_DEG_LT_FROM_LE = prove + (`!r (p:(1->num)->A) n. + ring_polynomial r p /\ + (p = poly_0 r ==> 0 < n) /\ + poly_deg r p <= n /\ + coeff n p = ring_0 r + ==> poly_deg r p < n`, + REPEAT GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[] THENL + [ASM_MESON_TAC[LE; POLY_TOP_EQ_0]; ASM_SIMP_TAC[LE_1]] THEN + ASM_SIMP_TAC[POLY_DEG_LE_COEFF_EQ; ARITH_RULE + `~(n = 0) ==> (x < n <=> x <= n - 1)`] THEN + ASM_MESON_TAC[ARITH_RULE + `~(n = 0) ==> (d <= n - 1 <=> d <= n /\ ~(d = n))`]);; + +let POLY_DEG_DIVIDES_LE_UNIVARIATE = prove + (`!(r:A ring) p q. + ring_regular r (coeff (poly_deg r p) p) /\ + ring_divides (poly_ring r (:1)) p q /\ + ~(q = poly_0 r) + ==> poly_deg r p <= poly_deg r q`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ring_divides]) THEN + REWRITE_TAC[IMP_CONJ; GSYM RING_POLYNOMIAL; LEFT_IMP_EXISTS_THM] THEN + DISCH_TAC THEN DISCH_TAC THEN X_GEN_TAC `d:(1->num)->A` THEN + ASM_CASES_TAC `d:(1->num)->A = poly_0 r` THENL + [ASM_MESON_TAC[RING_MUL_RZERO; RING_POLYNOMIAL; POLY_RING]; + DISCH_TAC] THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[POLY_RING] THEN + W(MP_TAC o PART_MATCH (lhand o rand) POLY_DEG_MUL_UNIVARIATE o + rand o snd) THEN + ANTS_TAC THEN ASM_SIMP_TAC[LE_ADD] THEN + ASM_MESON_TAC[ring_regular; ring_zerodivisor; + COEFF_IN_CARRIER_ALT; POLY_TOP_EQ_0]);; + let POLY_DIVISION_GEN = prove (`!(r:A ring) p d. p IN ring_carrier(poly_ring r (:1)) /\ @@ -22511,94 +25129,1826 @@ let POLY_DEG_1_ROOT = prove ASM_MESON_TAC[INTEGRAL_DOMAIN_MUL_EQ_0; RING_MUL; POLY_EVAL]);; (* ------------------------------------------------------------------------- *) -(* Gauss's lemma and preservation of the UFD property in polynomial rings. *) +(* Actual "division" and "remainder" operations. *) +(* ------------------------------------------------------------------------- *) + +let poly_div = new_definition + `poly_div (r:A ring) p d = + if ring_unit r (coeff (poly_deg r d) d) + then @q. q IN ring_carrier(poly_ring r (:1)) /\ + ?t. t IN ring_carrier(poly_ring r (:1)) /\ + (poly_deg r t < poly_deg r d \/ + t = ring_0(poly_ring r (:1))) /\ + ring_add (poly_ring r (:1)) + (ring_mul (poly_ring r (:1)) q d) t = p + else ring_0(poly_ring r (:1))`;; + +let poly_rem = new_definition + `poly_rem (r:A ring) p d = + ring_sub (poly_ring r (:1)) + p (ring_mul (poly_ring r (:1)) (poly_div r p d) d)`;; + +let POLY_DIV_REM = prove + (`!(r:A ring) p d. + p IN ring_carrier(poly_ring r (:1)) /\ + d IN ring_carrier(poly_ring r (:1)) /\ + ring_unit r (coeff (poly_deg r d) d) + ==> poly_div r p d IN ring_carrier(poly_ring r (:1)) /\ + poly_rem r p d IN ring_carrier(poly_ring r (:1)) /\ + (poly_deg r (poly_rem r p d) < poly_deg r d \/ + poly_rem r p d = ring_0(poly_ring r (:1))) /\ + ring_add (poly_ring r (:1)) + (ring_mul (poly_ring r (:1)) (poly_div r p d) d) + (poly_rem r p d) = p`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP POLY_DIVISION_GEN) THEN + DISCH_THEN(MP_TAC o SELECT_RULE) THEN + MP_TAC(REWRITE_CONV[poly_div] `poly_div (r:A ring) p d`) THEN + ASM_REWRITE_TAC[RIGHT_EXISTS_AND_THM] THEN + DISCH_THEN(fun th -> REWRITE_TAC[GSYM th]) THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (X_CHOOSE_THEN `t:(1->num)->A` (REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC))) THEN + SUBGOAL_THEN `poly_rem (r:A ring) p d = t` + (fun th -> ASM_REWRITE_TAC[th]) THEN + REWRITE_TAC[poly_rem] THEN + ASM_SIMP_TAC[RING_MUL; RING_RULE + `ring_sub r p x = t <=> ring_add r x t = p`]);; + +let POLY_DIV = prove + (`!(r:A ring) p d. + p IN ring_carrier(poly_ring r (:1)) /\ + d IN ring_carrier(poly_ring r (:1)) + ==> poly_div r p d IN ring_carrier(poly_ring r (:1))`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `ring_unit r (coeff (poly_deg r d) d:A)` THENL + [ASM_SIMP_TAC[POLY_DIV_REM]; + ASM_REWRITE_TAC[poly_div; RING_0]]);; + +let RING_POLYNOMIAL_DIV = prove + (`!(r:A ring) p d. + ring_polynomial r p /\ ring_polynomial r d + ==> ring_polynomial r (poly_div r p d)`, + REWRITE_TAC[RING_POLYNOMIAL; POLY_DIV]);; + +let POLY_REM = prove + (`!(r:A ring) p d. + p IN ring_carrier(poly_ring r (:1)) /\ + d IN ring_carrier(poly_ring r (:1)) + ==> poly_rem r p d IN ring_carrier(poly_ring r (:1))`, + SIMP_TAC[poly_rem; POLY_DIV; RING_MUL; RING_SUB]);; + +let RING_POLYNOMIAL_REM = prove + (`!(r:A ring) p d. + ring_polynomial r p /\ ring_polynomial r d + ==> ring_polynomial r (poly_rem r p d)`, + REWRITE_TAC[RING_POLYNOMIAL; POLY_REM]);; + +let POLY_DIV_REM_SIMP = prove + (`!(r:A ring) p d. + p IN ring_carrier(poly_ring r (:1)) /\ + d IN ring_carrier(poly_ring r (:1)) + ==> ring_add (poly_ring r (:1)) + (ring_mul (poly_ring r (:1)) (poly_div r p d) d) + (poly_rem r p d) = p`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `ring_unit r (coeff (poly_deg r d) d:A)` THEN + ASM_SIMP_TAC[POLY_DIV_REM] THEN + ASM_REWRITE_TAC[poly_rem; poly_div] THEN REPEAT(POP_ASSUM MP_TAC) THEN + SPEC_TAC(`poly_ring (r:A ring) (:1)`,`R:((1->num)->A)ring`) THEN + RING_TAC);; + +let POLY_DEG_REM = prove + (`!(r:A ring) p d. + p IN ring_carrier(poly_ring r (:1)) /\ + d IN ring_carrier(poly_ring r (:1)) /\ + ring_unit r (coeff (poly_deg r d) d) + ==> poly_deg r (poly_rem r p d) < poly_deg r d \/ + poly_rem r p d = ring_0(poly_ring r (:1))`, + MESON_TAC[POLY_DIV_REM]);; + +let POLY_DEG_REM_ALT = prove + (`!(k:A ring) p d. + field k /\ + p IN ring_carrier(poly_ring k (:1)) /\ + d IN ring_carrier(poly_ring k (:1)) /\ + ~(d = ring_0(poly_ring k (:1))) + ==> poly_deg k (poly_rem k p d) < poly_deg k d \/ + poly_rem k p d = ring_0(poly_ring k (:1))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC POLY_DEG_REM THEN + ASM_MESON_TAC[FIELD_UNIT; POLY_TOP_EQ_0; RING_POLYNOMIAL; + POLY_CLAUSES; COEFF_IN_CARRIER_ALT]);; + +let POLY_DIVIDES_REM = prove + (`!(r:A ring) p d. + p IN ring_carrier(poly_ring r (:1)) /\ + d IN ring_carrier(poly_ring r (:1)) + ==> ring_divides (poly_ring r (:1)) d + (ring_sub (poly_ring r (:1)) p (poly_rem r p d))`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP POLY_DIV_REM_SIMP) THEN + DISCH_THEN(fun th -> GEN_REWRITE_TAC (RAND_CONV o LAND_CONV) [SYM th]) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP POLY_DIV) THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP POLY_REM) THEN + ASM_SIMP_TAC[ring_divides] THEN CONJ_TAC THENL + [RING_CARRIER_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + EXISTS_TAC `poly_div (r:A ring) p d` THEN + ASM_SIMP_TAC[POLY_DIV] THEN REPEAT(POP_ASSUM MP_TAC) THEN + SPEC_TAC(`poly_ring (r:A ring) (:1)`,`R:((1->num)->A)ring`) THEN RING_TAC);; + +let POLY_REM_UNIQUE = prove + (`!(r:A ring) p q t. + p IN ring_carrier(poly_ring r (:1)) /\ + q IN ring_carrier(poly_ring r (:1)) /\ + t IN ring_carrier(poly_ring r (:1)) + ==> (poly_rem r p q = t <=> + if ring_unit r (coeff (poly_deg r q) q) then + (poly_deg r t < poly_deg r q \/ + t = ring_0(poly_ring r (:1))) /\ + ring_divides (poly_ring r (:1)) + q (ring_sub (poly_ring r (:1)) p t) + else p = t)`, + let lemma = prove + (`!(r:A ring) p q d. + p IN ring_carrier(poly_ring r (:1)) /\ + q IN ring_carrier(poly_ring r (:1)) /\ + d IN ring_carrier(poly_ring r (:1)) /\ + ring_regular r (coeff (poly_deg r d) d) /\ + poly_deg r p < poly_deg r d /\ + poly_deg r q < poly_deg r d /\ + ring_divides (poly_ring r (:1)) + d (ring_sub (poly_ring r (:1)) p q) + ==> p = q`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`r:A ring`; `d:(1->num)->A`; + `ring_sub (poly_ring (r:A ring) (:1)) p q`] + POLY_DEG_DIVIDES_LE_UNIVARIATE) THEN + ASM_REWRITE_TAC[] THEN + GEN_REWRITE_TAC I [GSYM CONTRAPOS_THM] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`r:A ring`; `p:(1->num)->A`; `q:(1->num)->A`] + POLY_DEG_SUB_LE) THEN + ASM_SIMP_TAC[RING_SUB_EQ_0; CONJUNCT2 POLY_CLAUSES; RING_POLYNOMIAL] THEN + ASM_ARITH_TAC) in + REPEAT STRIP_TAC THEN COND_CASES_TAC THENL + [ALL_TAC; + ASM_REWRITE_TAC[poly_rem; poly_div] THEN REPEAT(POP_ASSUM MP_TAC) THEN + SPEC_TAC(`poly_ring (r:A ring) (:1)`,`R:((1->num)->A)ring`) THEN + RING_TAC] THEN + MP_TAC(ISPECL [`r:A ring`; `p:(1->num)->A`; `q:(1->num)->A`] + POLY_DIVIDES_REM) THEN + MP_TAC(ISPECL [`r:A ring`; `p:(1->num)->A`; `q:(1->num)->A`] + POLY_DEG_REM) THEN + ASM_REWRITE_TAC[IMP_IMP] THEN + DISCH_THEN(fun th -> EQ_TAC THENL [MESON_TAC[th]; MP_TAC th]) THEN + ASM_CASES_TAC `poly_deg r (q:(1->num)->A) = 0` THEN + ASM_SIMP_TAC[LT] THEN + SUBGOAL_THEN + `!p. p IN ring_carrier (poly_ring (r:A ring) (:1)) + ==> (poly_deg r p < poly_deg r q \/ p = ring_0 (poly_ring r (:1)) <=> + poly_deg r p < poly_deg r (q:(1->num)->A))` + (fun th -> ASM_SIMP_TAC[th; POLY_REM]) THENL + [REWRITE_TAC[POLY_RING] THEN ASM_MESON_TAC[POLY_DEG_0; LE_1]; ALL_TAC] THEN + ONCE_REWRITE_TAC[TAUT + `p /\ q ==> r /\ s ==> t <=> p /\ r ==> s /\ q ==> t`] THEN + STRIP_TAC THEN DISCH_TAC THEN MATCH_MP_TAC lemma THEN + MAP_EVERY EXISTS_TAC [`r:A ring`; `q:(1->num)->A`] THEN + ASM_SIMP_TAC[POLY_REM; RING_UNIT_IMP_REGULAR] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP RING_DIVIDES_SUB) THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + ABBREV_TAC `R = poly_ring (r:A ring) (:1)` THEN + POP_ASSUM(fun th -> RING_TAC THEN SUBST_ALL_TAC(SYM th)) THEN + ASM_SIMP_TAC[POLY_REM]);; + +(* ------------------------------------------------------------------------- *) +(* The Hilbert Basis Theorem *) +(* ------------------------------------------------------------------------- *) + +let NOETHERIAN_POLY_RING_1 = prove + (`!r:A ring. + noetherian_ring (poly_ring r (:1)) <=> noetherian_ring r`, + GEN_TAC THEN EQ_TAC THEN REWRITE_TAC + [MATCH_MP(REWRITE_RULE[IMP_CONJ] NOETHERIAN_RING_EPIMORPHIC_IMAGE) + (ISPEC `(:1)` (MATCH_MP RING_EPIMORPHISM_POLY_EVAL + (SPEC `r:A ring` RING_0)))] THEN + STRIP_TAC THEN REWRITE_TAC[noetherian_ring] THEN + X_GEN_TAC `j:((1->num)->A)->bool` THEN DISCH_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP RING_IDEAL_IMP_SUBSET) THEN + ASM_REWRITE_TAC[finitely_generated_ideal; MESON[] + `(?x. P x /\ Q x /\ R x) <=> ~(!x. P x /\ Q x ==> ~R x)`] THEN + DISCH_TAC THEN MP_TAC(ISPEC + `\(p:num->(1->num)->A) n q. + q IN j DIFF ideal_generated (poly_ring r (:1)) {p m | m < n} /\ + !q'. q' IN j DIFF ideal_generated (poly_ring r (:1)) {p m | m < n} + ==> poly_deg r q <= poly_deg r q'` + (MATCH_MP WF_REC_EXISTS WF_num)) THEN + REWRITE_TAC[NOT_IMP] THEN REPEAT CONJ_TAC THENL + [ONCE_REWRITE_TAC[SET_RULE + `{f x | P x} = {y | ?x. ~(P x ==> ~(f x = y))}`] THEN + SIMP_TAC[]; + MAP_EVERY X_GEN_TAC [`p:num->(1->num)->A`; `n:num`] THEN DISCH_TAC THEN + MP_TAC(fst(EQ_IMP_RULE(ISPEC + `\d. d IN IMAGE (poly_deg (r:A ring)) + (j DIFF ideal_generated (poly_ring r (:1)) {p m | m:num < n})` + num_WOP))) THEN + REWRITE_TAC[EXISTS_IN_IMAGE; MEMBER_NOT_EMPTY; IMAGE_EQ_EMPTY] THEN + ANTS_TAC THENL [ALL_TAC; SET_TAC[NOT_LE]] THEN + MATCH_MP_TAC(SET_RULE `i SUBSET j /\ ~(i = j) ==> ~(j DIFF i = {})`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC IDEAL_GENERATED_MINIMAL THEN ASM SET_TAC[]; + FIRST_X_ASSUM MATCH_MP_TAC THEN ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN] THEN + ASM_SIMP_TAC[FINITE_IMAGE; FINITE_NUMSEG_LT] THEN ASM SET_TAC[]]; + DISCH_THEN(X_CHOOSE_THEN `p:num->(1->num)->A` + (MP_TAC o CONV_RULE(RAND_CONV(ALPHA_CONV `n:num`)))) THEN + REWRITE_TAC[FORALL_AND_THM; IN_DIFF] THEN STRIP_TAC] THEN + SUBGOAL_THEN + `!n. ideal_generated (poly_ring (r:A ring) (:1)) {p m | m:num < n} SUBSET j` + ASSUME_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC IDEAL_GENERATED_MINIMAL THEN ASM SET_TAC[]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [NOETHERIAN_RING_EQ_ACC]) THEN + REWRITE_TAC[] THEN EXISTS_TAC + `\n:num. ideal_generated (r:A ring) + {coeff (poly_deg r (p m)) (p m) | m < n}` THEN + REWRITE_TAC[RING_IDEAL_IDEAL_GENERATED; PSUBSET] THEN + X_GEN_TAC `n:num` THEN CONJ_TAC THENL + [MATCH_MP_TAC IDEAL_GENERATED_MONO THEN + REWRITE_TAC[GSYM ADD1; LT] THEN SET_TAC[]; + MATCH_MP_TAC(SET_RULE `!x. x IN t /\ ~(x IN s) ==> ~(s = t)`)] THEN + EXISTS_TAC `coeff (poly_deg r (p(n:num))) (p n):A` THEN CONJ_TAC THENL + [MATCH_MP_TAC IDEAL_GENERATED_INC THEN + REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; GSYM ADD1; LT] THEN + CONJ_TAC THENL [ALL_TAC; SET_TAC[]] THEN + GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC COEFF_IN_CARRIER_ALT THEN + ASM_MESON_TAC[RING_POLYNOMIAL; SUBSET]; + DISCH_TAC] THEN + ABBREV_TAC `d = poly_deg r ((p:num->(1->num)->A) n)` THEN + SUBGOAL_THEN `!m. ring_polynomial r ((p:num->(1->num)->A) m)` + ASSUME_TAC THENL + [REWRITE_TAC[RING_POLYNOMIAL] THEN ASM SET_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `!m d. coeff d ((p:num->(1->num)->A) m) IN ring_carrier r` + ASSUME_TAC THENL [ASM_SIMP_TAC[COEFF_IN_CARRIER_ALT]; ALL_TAC] THEN + SUBGOAL_THEN + `!m. m < n ==> poly_deg r ((p:num->(1->num)->A) m) <= poly_deg r (p n)` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (SET_RULE + `(!n. ~(p n IN s n)) ==> s m SUBSET s n ==> ~(p n IN s m)`)) THEN + MATCH_MP_TAC IDEAL_GENERATED_MONO THEN ASM SET_TAC[LT_TRANS]; + ALL_TAC] THEN + SUBGOAL_THEN + `!c. c IN ideal_generated r {coeff (poly_deg r (p m)) (p m) | m < n} + ==> ?q. q IN ideal_generated (poly_ring r (:1)) {p m | m:num < n} /\ + poly_deg (r:A ring) q <= d /\ coeff d q = c` + (MP_TAC o SPEC `coeff d ((p:num->(1->num)->A) n)`) THENL + [MATCH_MP_TAC IDEAL_GENERATED_INDUCT_STRONG THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[IMP_CONJ_ALT; FORALL_IN_GSPEC] THEN + X_GEN_TAC `m:num` THEN REPEAT DISCH_TAC THEN + EXISTS_TAC `poly_mul r (poly_pow r (poly_var r one) + (poly_deg r (p n) - poly_deg r (p m))) + ((p:num->(1->num)->A) m)` THEN + CONJ_TAC THENL + [REWRITE_TAC[POLY_CLAUSES] THEN MATCH_MP_TAC IN_RING_IDEAL_LMUL THEN + SIMP_TAC[RING_IDEAL_IDEAL_GENERATED; RING_POW; POLY_VAR_UNIV] THEN + MATCH_MP_TAC IDEAL_GENERATED_INC THEN ASM SET_TAC[]; + ASM_SIMP_TAC[POLY_DEG_VARPOW_MUL; RING_POLYNOMIAL_CONST; + COEFF_POLY_VARPOW_MUL; RING_POLYNOMIAL_IMP_POWERSERIES; + COEFF_POLY_CONST; POLY_DEG_CONST] THEN + REWRITE_TAC[ARITH_RULE `~(d:num < d - a)`] THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + ASM_SIMP_TAC[ARITH_RULE + `m:num <= n ==> m + n - m = n /\ n - (n - m) = m`] THEN + ARITH_TAC]; + EXISTS_TAC `poly_0 r:(1->num)->A` THEN + REWRITE_TAC[POLY_DEG_0; COEFF_POLY_0; LE_0] THEN + REWRITE_TAC[POLY_CLAUSES] THEN MATCH_MP_TAC IN_RING_IDEAL_0 THEN + REWRITE_TAC[RING_IDEAL_IDEAL_GENERATED]; + MAP_EVERY X_GEN_TAC [`u:A`; `v:A`] THEN + REWRITE_TAC[IMP_CONJ; LEFT_IMP_EXISTS_THM] THEN + DISCH_TAC THEN DISCH_TAC THEN X_GEN_TAC `s:(1->num)->A` THEN + DISCH_TAC THEN DISCH_TAC THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN + X_GEN_TAC `t:(1->num)->A` THEN + DISCH_TAC THEN DISCH_TAC THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN + EXISTS_TAC `ring_add (poly_ring (r:A ring) (:1)) s t` THEN + ASM_SIMP_TAC[IN_RING_IDEAL_ADD; RING_IDEAL_IDEAL_GENERATED] THEN + REWRITE_TAC[CONJUNCT2 POLY_RING_CLAUSES] THEN + ASM_REWRITE_TAC[COEFF_POLY_ADD] THEN + W(MP_TAC o PART_MATCH (lhand o rand) POLY_DEG_ADD_LE o lhand o snd) THEN + ANTS_TAC THENL + [REWRITE_TAC[RING_POLYNOMIAL] THEN ASM SET_TAC[]; ASM_ARITH_TAC]; + MAP_EVERY X_GEN_TAC [`u:A`; `v:A`] THEN + REWRITE_TAC[IMP_CONJ; LEFT_IMP_EXISTS_THM] THEN + DISCH_TAC THEN DISCH_TAC THEN X_GEN_TAC `s:(1->num)->A` THEN + DISCH_TAC THEN DISCH_TAC THEN DISCH_THEN(SUBST_ALL_TAC o SYM) THEN + EXISTS_TAC `ring_mul (poly_ring (r:A ring) (:1)) (poly_const r u) s` THEN + ASM_SIMP_TAC[IN_RING_IDEAL_LMUL; RING_IDEAL_IDEAL_GENERATED; + POLY_CONST] THEN + REWRITE_TAC[POLY_RING_CLAUSES] THEN CONJ_TAC THENL + [W(MP_TAC o PART_MATCH (lhand o rand) POLY_DEG_MUL_LE o + lhand o snd) THEN + ASM_REWRITE_TAC[RING_POLYNOMIAL_CONST; POLY_DEG_CONST] THEN + ANTS_TAC THENL [ALL_TAC; ASM_ARITH_TAC]; + MATCH_MP_TAC COEFF_POLY_LMUL] THEN + ASM_MESON_TAC[IDEAL_GENERATED_SUBSET; SUBSET; + RING_POLYNOMIAL_IMP_POWERSERIES; RING_POLYNOMIAL]]; + ASM_REWRITE_TAC[NOT_EXISTS_THM] THEN + X_GEN_TAC `q:(1->num)->A` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`n:num`; `poly_sub r ((p:num->(1->num)->A) n) q`]) THEN + REWRITE_TAC[NOT_IMP; GSYM CONJ_ASSOC] THEN CONJ_TAC THENL + [REWRITE_TAC[POLY_CLAUSES] THEN MATCH_MP_TAC IN_RING_IDEAL_SUB THEN + ASM SET_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN CONJ_TAC THENL + [DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o check (is_neg o concl) o SPEC `n:num`) THEN + SUBGOAL_THEN + `(p:num->(1->num)->A) n = poly_add r (poly_sub r (p n) q) q` + SUBST1_TAC THENL + [REWRITE_TAC[POLY_CLAUSES] THEN MATCH_MP_TAC(RING_RULE + `x = ring_add r (ring_sub r x y) y`) THEN + ASM SET_TAC[]; + REWRITE_TAC[POLY_CLAUSES] THEN MATCH_MP_TAC IN_RING_IDEAL_ADD THEN + ASM_REWRITE_TAC[RING_IDEAL_IDEAL_GENERATED] THEN + ASM_REWRITE_TAC[POLY_RING_CLAUSES]]; + DISCH_TAC] THEN + ASM_REWRITE_TAC[NOT_LE] THEN MATCH_MP_TAC POLY_DEG_LT_FROM_LE THEN + REPEAT CONJ_TAC THENL + [ASM_MESON_TAC[RING_POLYNOMIAL_SUB; RING_POLYNOMIAL; SUBSET]; + ASM_MESON_TAC[POLY_CLAUSES; IN_RING_IDEAL_0; RING_IDEAL_IDEAL_GENERATED]; + W(MP_TAC o PART_MATCH (lhand o rand) POLY_DEG_SUB_LE o lhand o snd) THEN + ANTS_TAC THENL [ASM_MESON_TAC[RING_POLYNOMIAL; SUBSET]; ASM_ARITH_TAC]; + ASM_REWRITE_TAC[COEFF_POLY_SUB] THEN MATCH_MP_TAC RING_SUB_REFL THEN + ASM_MESON_TAC[RING_POLYNOMIAL; COEFF_IN_CARRIER_ALT; SUBSET]]]);; + +let NOETHERIAN_POLY_RING = prove + (`!(r:A ring) (s:V->bool). + noetherian_ring (poly_ring r s) <=> + noetherian_ring r /\ (FINITE s \/ trivial_ring r)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `FINITE(s:V->bool)` THEN + ASM_REWRITE_TAC[] THENL + [UNDISCH_TAC `FINITE(s:V->bool)` THEN + SPEC_TAC(`s:V->bool`,`s:V->bool`) THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN CONJ_TAC THENL + [MATCH_MP_TAC ISOMORPHIC_RING_NOETHERIANNESS THEN + REWRITE_TAC[ISOMORPHIC_POLY_RING_TRIVIAL]; + MAP_EVERY X_GEN_TAC [`x:V`; `s:V->bool`] THEN + DISCH_THEN(CONJUNCTS_THEN2 (SUBST1_TAC o SYM) STRIP_ASSUME_TAC) THEN + GEN_REWRITE_TAC RAND_CONV [GSYM NOETHERIAN_POLY_RING_1] THEN + MATCH_MP_TAC ISOMORPHIC_RING_NOETHERIANNESS THEN + ONCE_REWRITE_TAC[ISOMORPHIC_RING_SYM] THEN + MATCH_MP_TAC ISOMORPHIC_RING_POLY_POLY_GEN THEN + ASM_SIMP_TAC[CARD_EQ_CARD; CARD_ADD_C; FINITE_INSERT; CARD_CLAUSES; + CARD_ADD_FINITE_EQ; REWRITE_RULE[HAS_SIZE] HAS_SIZE_1] THEN + REWRITE_TAC[ISOMORPHIC_RING_REFL; ADD1]]; + ALL_TAC] THEN + ASM_CASES_TAC `trivial_ring(r:A ring)` THEN ASM_REWRITE_TAC[] THENL + [MATCH_MP_TAC ISOMORPHIC_RING_NOETHERIANNESS THEN + MATCH_MP_TAC ISOMORPHIC_TRIVIAL_RINGS THEN + ASM_REWRITE_TAC[TRIVIAL_POLY_RING]; + ALL_TAC] THEN + REWRITE_TAC[NOETHERIAN_RING_EQ_ACC] THEN + MP_TAC(ISPEC `s:V->bool` INFINITE_CARD_LE) THEN + ASM_REWRITE_TAC[INFINITE; le_c; INJECTIVE_ALT; IN_UNIV] THEN + DISCH_THEN(X_CHOOSE_THEN `v:num->V` STRIP_ASSUME_TAC) THEN + EXISTS_TAC + `(\n. ideal_generated (poly_ring r s) {poly_var r (v i) | i < n}) + :num->((V->num)->A)->bool` THEN + REWRITE_TAC[RING_IDEAL_IDEAL_GENERATED] THEN + X_GEN_TAC `n:num` THEN REWRITE_TAC[PSUBSET_ALT] THEN CONJ_TAC THENL + [MATCH_MP_TAC IDEAL_GENERATED_MONO THEN + REWRITE_TAC[ARITH_RULE `i < n + 1 <=> i < n \/ i = n`] THEN SET_TAC[]; + EXISTS_TAC `poly_var r (v(n:num)):(V->num)->A`] THEN + CONJ_TAC THENL + [MATCH_MP_TAC IDEAL_GENERATED_INC THEN + ASM_REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; POLY_VAR] THEN + REWRITE_TAC[ARITH_RULE `i < n + 1 <=> i < n \/ i = n`] THEN SET_TAC[]; + MATCH_MP_TAC(SET_RULE + `!P. ~P a /\ (!y. y IN s ==> P y) ==> ~(a IN s)`)] THEN + EXISTS_TAC `\p:(V->num)->A. poly_evaluate r p + (\i. if i = v(n:num) then ring_1 r else ring_0 r) = ring_0 r` THEN + ASM_SIMP_TAC[POLY_EVALUATE_VAR; RING_1; GSYM TRIVIAL_RING_10] THEN + MATCH_MP_TAC IDEAL_GENERATED_INDUCT_STRONG THEN REWRITE_TAC[] THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[IMP_CONJ_ALT; FORALL_IN_GSPEC] THEN X_GEN_TAC `m:num` THEN + DISCH_THEN(ASSUME_TAC o MATCH_MP LT_IMP_NE) THEN + ASM_SIMP_TAC[POLY_EVALUATE_VAR; RING_0]; + REWRITE_TAC[POLY_RING; POLY_EVALUATE_0]; + SIMP_TAC[POLY_RING; IN_ELIM_THM; POLY_EVALUATE_ADD] THEN + SIMP_TAC[RING_ADD_LZERO; RING_0]; + REWRITE_TAC[POLY_RING; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN + W(MP_TAC o PART_MATCH (lhand o rand) POLY_EVALUATE_MUL o lhand o snd) THEN + ASM_SIMP_TAC[POLY_EVALUATE; RING_MUL_RZERO] THEN + ASM_MESON_TAC[RING_0; RING_1]]);; + +let KAPLANSKY_LEMMA = prove + (`!(r:A ring) j. + prime_ideal (powser_ring r (:1)) j + ==> (finitely_generated_ideal (powser_ring r (:1)) j <=> + finitely_generated_ideal r (IMAGE (coeff 0) j))`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP PRIME_IDEAL_IMP_SUBSET) THEN + EQ_TAC THENL + [MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] + FINITELY_GENERATED_IDEAL_EPIMORPHIC_IMAGE) THEN + REWRITE_TAC[POWSER_RING_EPIMORPHISM_COEFF_0]; + REWRITE_TAC[FINITELY_GENERATED_IDEAL_SUBSET; + EXISTS_FINITE_SUBSET_IMAGE]] THEN + DISCH_THEN(X_CHOOSE_THEN `k:((1->num)->A)->bool` + (STRIP_ASSUME_TAC o GSYM)) THEN + SUBGOAL_THEN `!i:(1->num)->A. i IN k ==> ring_powerseries r i` + ASSUME_TAC THENL [ASM_MESON_TAC[RING_POWERSERIES; SUBSET]; ALL_TAC] THEN + SUBGOAL_THEN + `!p. p IN j + ==> ?q c. ring_powerseries (r:A ring) q /\ + (!i. i IN k ==> c i IN ring_carrier r) /\ + poly_add r (poly_mul r (poly_var r one) q) + (ring_sum (powser_ring r (:1)) k + (\i. poly_mul r (poly_const r (c i)) i)) = p` + MP_TAC THENL + [X_GEN_TAC `p:(1->num)->A` THEN DISCH_TAC THEN + SUBGOAL_THEN `ring_powerseries r (p:(1->num)->A)` ASSUME_TAC THENL + [ASM_MESON_TAC[RING_POWERSERIES; SUBSET]; ALL_TAC] THEN + GEN_REWRITE_TAC I [SWAP_EXISTS_THM] THEN + SUBGOAL_THEN + `coeff 0 (p:(1->num)->A) IN ideal_generated r (IMAGE (coeff 0) k)` + MP_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + ASM_SIMP_TAC[IDEAL_GENERATED_FINITE_IMAGE] THEN + REWRITE_TAC[IN_ELIM_THM] THEN MATCH_MP_TAC MONO_EXISTS THEN + X_GEN_TAC `c:((1->num)->A)->A` THEN + DISCH_THEN(STRIP_ASSUME_TAC o GSYM) THEN + ABBREV_TAC + `h = ring_sum (powser_ring (r:A ring) (:1)) k + (\i. poly_mul r (poly_const r (c i)) i)` THEN + SUBGOAL_THEN `ring_powerseries r (h:(1->num)->A)` ASSUME_TAC THENL + [ASM_MESON_TAC[RING_POWERSERIES; RING_SUM]; ALL_TAC] THEN + ABBREV_TAC `d:(1->num)->A = poly_sub r p h` THEN + SUBGOAL_THEN `ring_powerseries r (d:(1->num)->A)` ASSUME_TAC THENL + [ASM_MESON_TAC[RING_POWERSERIES_SUB]; ALL_TAC] THEN + ABBREV_TAC `q = \m. coeff (m one + 1) (d:(1->num)->A)` THEN + SUBGOAL_THEN + `ring_powerseries r (q:(1->num)->A) /\ + !i. coeff i q = coeff (i + 1) d` + STRIP_ASSUME_TAC THENL + [UNDISCH_TAC `ring_powerseries r (d:(1->num)->A)` THEN + EXPAND_TAC "q" THEN SIMP_TAC[RING_POWERSERIES_COEFF; coeff]; + EXISTS_TAC `q:(1->num)->A` THEN ASM_REWRITE_TAC[]] THEN + ASM_SIMP_TAC[GSYM FUN_EQ_COEFF; COEFF_POLY_ADD; COEFF_POLY_VAR_MUL] THEN + EXPAND_TAC "d" THEN REWRITE_TAC[COEFF_POLY_SUB] THEN + X_GEN_TAC `i:num` THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[SUB_ADD; LE_1; RING_ADD_LZERO; COEFF_IN_CARRIER] THENL + [ALL_TAC; RING_TAC THEN ASM_SIMP_TAC[COEFF_IN_CARRIER; RING_SUM]] THEN + EXPAND_TAC "h" THEN + ASM_SIMP_TAC[COEFF_POWSER_SUM; RING_POWERSERIES_MUL; + RING_POWERSERIES_CONST; COEFF_POLY_LMUL]; + GEN_REWRITE_TAC (LAND_CONV o TOP_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN + REWRITE_TAC[SKOLEM_THM; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC + [`h:((1->num)->A)->(1->num)->A`; + `tc:((1->num)->A)->((1->num)->A)->A`] THEN + DISCH_TAC] THEN + ASM_CASES_TAC `poly_var (r:A ring) one IN j` THENL + [EXISTS_TAC `poly_var (r:A ring) one INSERT k` THEN + ASM_REWRITE_TAC[FINITE_INSERT; INSERT_SUBSET; POWSER_VAR_UNIV] THEN + CONJ_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC SUBSET_ANTISYM] THEN + CONJ_TAC THENL + [MATCH_MP_TAC IDEAL_GENERATED_MINIMAL THEN + ASM_SIMP_TAC[PRIME_IMP_RING_IDEAL] THEN + ASM_REWRITE_TAC[INSERT_SUBSET; POWSER_VAR_UNIV]; + ALL_TAC] THEN + REWRITE_TAC[SUBSET] THEN X_GEN_TAC `p:(1->num)->A` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `p:(1->num)->A`) THEN ASM_REWRITE_TAC[] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN REWRITE_TAC[POWSER_CLAUSES] THEN + MATCH_MP_TAC IN_RING_IDEAL_ADD THEN + REWRITE_TAC[RING_IDEAL_IDEAL_GENERATED] THEN CONJ_TAC THENL + [MATCH_MP_TAC IN_RING_IDEAL_RMUL THEN + REWRITE_TAC[RING_IDEAL_IDEAL_GENERATED] THEN + ASM_REWRITE_TAC[GSYM RING_POWERSERIES] THEN + SIMP_TAC[IDEAL_GENERATED_INC_GEN; POWSER_VAR_UNIV; IN_INSERT]; + MATCH_MP_TAC IN_RING_IDEAL_SUM THEN + REWRITE_TAC[RING_IDEAL_IDEAL_GENERATED] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC IN_RING_IDEAL_LMUL THEN + ASM_SIMP_TAC[RING_IDEAL_IDEAL_GENERATED; POWSER_CONST] THEN + MATCH_MP_TAC IDEAL_GENERATED_INC_GEN THEN ASM SET_TAC[]]; + ALL_TAC] THEN + EXISTS_TAC `k:((1->num)->A)->bool` THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL [ASM SET_TAC[]; MATCH_MP_TAC SUBSET_ANTISYM] THEN + CONJ_TAC THENL + [MATCH_MP_TAC IDEAL_GENERATED_MINIMAL THEN + ASM_SIMP_TAC[PRIME_IMP_RING_IDEAL] THEN + ASM_REWRITE_TAC[INSERT_SUBSET; POWSER_VAR_UNIV]; + ALL_TAC] THEN + REWRITE_TAC[SUBSET] THEN X_GEN_TAC `p:(1->num)->A` THEN DISCH_TAC THEN + SUBGOAL_THEN `ring_powerseries r (p:(1->num)->A)` ASSUME_TAC THENL + [ASM_MESON_TAC[RING_POWERSERIES; SUBSET]; ALL_TAC] THEN + (MP_TAC o prove_recursive_functions_exist num_RECURSION) + `q 0 = p /\ + (!n. q(SUC n) = (h:((1->num)->A)->(1->num)->A) (q n))` THEN + STRIP_TAC THEN + ABBREV_TAC + `c = \i (n:num). (tc:((1->num)->A)->((1->num)->A)->A) (q n) i` THEN + SUBGOAL_THEN + `!n. ring_powerseries r (q n:(1->num)->A) /\ + q n IN j /\ + (!i. i IN k ==> c i n IN ring_carrier r) /\ + poly_add r (poly_mul r (poly_var r one) (q(SUC n))) + (ring_sum (powser_ring r (:1)) k + (\i. poly_mul r (poly_const r (c i n)) i)) = + q n` + MP_TAC THENL + [EXPAND_TAC "c" THEN REWRITE_TAC[] THEN MATCH_MP_TAC num_INDUCTION THEN + CONJ_TAC THENL [ASM_SIMP_TAC[]; X_GEN_TAC `n:num` THEN DISCH_TAC] THEN + FIRST_ASSUM(MP_TAC o SPEC `(q:num->(1->num)->A) n`) THEN + FIRST_ASSUM(SUBST1_TAC o SYM o SPEC `n:num`) THEN ANTS_TAC THENL + [ASM_REWRITE_TAC[]; DISCH_THEN(ASSUME_TAC o CONJUNCT1)] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(q:num->(1->num)->A) (SUC n)`) THEN + SUBGOAL_THEN `(q:num->(1->num)->A) (SUC n) IN j` ASSUME_TAC THENL + [ALL_TAC; + ASM_REWRITE_TAC[] THEN SIMP_TAC[] THEN + ASM_MESON_TAC[RING_POWERSERIES; SUBSET]] THEN + FIRST_ASSUM(MP_TAC o SPECL + [`poly_var (r:A ring) one`; `(q:num->(1->num)->A) (SUC n)`] o + CONJUNCT2 o GEN_REWRITE_RULE I [prime_ideal]) THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM o SPEC `n:num`) THEN + ASM_REWRITE_TAC[POWSER_VAR_UNIV] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[GSYM RING_POWERSERIES; POWSER_RING] THEN + FIRST_X_ASSUM(CONJUNCTS_THEN STRIP_ASSUME_TAC) THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP (MESON[] + `poly_add r x y = z + ==> poly_sub r z y IN j /\ + poly_sub r (poly_add r x y) y = x + ==> x IN j`)) THEN + CONJ_TAC THENL + [REWRITE_TAC[POWSER_CLAUSES] THEN MATCH_MP_TAC IN_RING_IDEAL_SUB THEN + ASM_SIMP_TAC[PRIME_IMP_RING_IDEAL] THEN + MATCH_MP_TAC IN_RING_IDEAL_SUM THEN + ASM_SIMP_TAC[PRIME_IMP_RING_IDEAL] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC IN_RING_IDEAL_LMUL THEN + ASM_SIMP_TAC[PRIME_IMP_RING_IDEAL] THEN + ASM_SIMP_TAC[POWSER_CONST] THEN ASM SET_TAC[]; + REWRITE_TAC[POWSER_CLAUSES] THEN + REPEAT(FIRST_X_ASSUM(K ALL_TAC o SYM)) THEN + ABBREV_TAC `R = powser_ring (r:A ring) (:1)` THEN + POP_ASSUM(fun th -> RING_TAC THEN SUBST1_TAC(SYM th)) THEN + REWRITE_TAC[RING_SUM; POWSER_VAR_UNIV] THEN + ASM_REWRITE_TAC[GSYM RING_POWERSERIES]]; + REWRITE_TAC[FORALL_AND_THM] THEN STRIP_TAC] THEN + ABBREV_TAC `cf:((1->num)->A)->(1->num)->A = \i m. c i (m one)` THEN + SUBGOAL_THEN + `!g k. coeff k (cf g) = (c:((1->num)->A)->num->A) g k` + ASSUME_TAC THENL [EXPAND_TAC "cf" THEN REWRITE_TAC[coeff]; ALL_TAC] THEN + SUBGOAL_THEN + `!g:(1->num)->A. g IN k ==> ring_powerseries r (cf g:(1->num)->A)` + ASSUME_TAC THENL[ASM_SIMP_TAC[RING_POWERSERIES_COEFF]; ALL_TAC] THEN + SUBGOAL_THEN + `p = ring_sum (powser_ring (r:A ring) (:1)) k + (\i. ring_mul (powser_ring r (:1)) (cf i) i)` + SUBST1_TAC THENL + [ALL_TAC; + MATCH_MP_TAC IN_RING_IDEAL_SUM THEN + REWRITE_TAC[RING_IDEAL_IDEAL_GENERATED] THEN + X_GEN_TAC `g:(1->num)->A` THEN DISCH_TAC THEN + MATCH_MP_TAC IN_RING_IDEAL_LMUL THEN + ASM_SIMP_TAC[RING_IDEAL_IDEAL_GENERATED; GSYM RING_POWERSERIES] THEN + MATCH_MP_TAC IDEAL_GENERATED_INC_GEN THEN ASM SET_TAC[]] THEN + ABBREV_TAC `cf':num->((1->num)->A)->(1->num)->A = + \n i m. if m one < n then cf i m else ring_0 r` THEN + SUBGOAL_THEN + `!g n d. coeff d ((cf':num->((1->num)->A)->(1->num)->A) n g) = + (if d < n then coeff d (cf g) else ring_0 r)` + ASSUME_TAC THENL + [EXPAND_TAC "cf'" THEN REWRITE_TAC[coeff]; ALL_TAC] THEN + SUBGOAL_THEN + `!(n:num) g:(1->num)->A. g IN k ==> ring_powerseries r (cf' n g:(1->num)->A)` + ASSUME_TAC THENL + [ASM_REWRITE_TAC[RING_POWERSERIES_COEFF] THEN + ASM_MESON_TAC[COEFF_IN_CARRIER; RING_0]; + ALL_TAC] THEN + SUBGOAL_THEN + `!n. poly_add r (poly_mul r (poly_pow r (poly_var r one) n) (q n)) + (ring_sum (powser_ring r (:1)) k + (\i. poly_mul (r:A ring) (cf' n i) i)) = + p` + ASSUME_TAC THENL + [INDUCT_TAC THENL + [ASM_SIMP_TAC[POLY_POW; POLY_MUL_LID] THEN + MATCH_MP_TAC(MESON[POLY_ADD_RZERO; RING_POWERSERIES_0] + `ring_powerseries r p /\ q = poly_0 r ==> poly_add r p q = p`) THEN + ASM_REWRITE_TAC[POWSER_CLAUSES] THEN MATCH_MP_TAC RING_SUM_EQ_0 THEN + REWRITE_TAC[POWSER_RING] THEN X_GEN_TAC `i:(1->num)->A` THEN + STRIP_TAC THEN MATCH_MP_TAC(MESON[POWSER_MUL_0] + `ring_powerseries r q /\ p = poly_0 r + ==> poly_mul r p q = poly_0 r`) THEN + ASM_SIMP_TAC[GSYM FUN_EQ_COEFF; COEFF_POLY_0; LT]; + ALL_TAC] THEN + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN + FIRST_X_ASSUM(fun th -> + GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o RAND_CONV) [GSYM th]) THEN + REWRITE_TAC[POLY_POW] THEN + W(MP_TAC o PART_MATCH (lhand o rand) POLY_ADD_LDISTRIB o + lhand o rand o snd) THEN + ANTS_TAC THENL + [ASM_MESON_TAC[RING_POWERSERIES_POW; RING_POWERSERIES_VAR; + RING_POWERSERIES_MUL; RING_POWERSERIES; RING_SUM]; + DISCH_THEN SUBST1_TAC] THEN + REWRITE_TAC[POWSER_CLAUSES] THEN + MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_IMP] (RING_RULE + `ring_sub r y y2 = y1 + ==> ring_add r (ring_mul r (ring_mul r x n) q) y = + ring_add r (ring_add r (ring_mul r n (ring_mul r x q)) y1) y2`)) THEN + CONJ_TAC THENL + [REPEAT CONJ_TAC THEN RING_CARRIER_TAC THEN + REWRITE_TAC[POWSER_VAR_UNIV; RING_SUM] THEN + ASM_MESON_TAC[RING_POWERSERIES]; + ALL_TAC] THEN + W(MP_TAC o PART_MATCH (rand o rand) RING_SUM_SUB o lhand o snd) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + RING_CARRIER_TAC THEN ASM_MESON_TAC[RING_POWERSERIES]; + DISCH_THEN(SUBST1_TAC o SYM)] THEN + W(MP_TAC o PART_MATCH (rand o rand) RING_SUM_LMUL o rand o snd) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + RING_CARRIER_TAC THEN REWRITE_TAC[POWSER_VAR_UNIV; POWSER_CONST] THEN + ASM_MESON_TAC[RING_POWERSERIES]; + DISCH_THEN(SUBST1_TAC o SYM)] THEN + MATCH_MP_TAC RING_SUM_EQ THEN X_GEN_TAC `i:(1->num)->A` THEN DISCH_TAC THEN + REWRITE_TAC[] THEN MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_IMP] (RING_RULE + `ring_add r x (ring_mul r c n) = y + ==> ring_sub r (ring_mul r y i) (ring_mul r x i) = + ring_mul r n (ring_mul r c i)`)) THEN + CONJ_TAC THENL + [REPEAT CONJ_TAC THEN RING_CARRIER_TAC THEN + REWRITE_TAC[POWSER_CONST; POWSER_VAR_UNIV] THEN + ASM_MESON_TAC[RING_POWERSERIES]; + ALL_TAC] THEN + REWRITE_TAC[GSYM FUN_EQ_COEFF; POWSER_RING_CLAUSES] THEN + ASM_SIMP_TAC[COEFF_POLY_ADD; COEFF_POLY_LMUL; COEFF_POLY_VARPOW; + RING_POWERSERIES_VAR; RING_POWERSERIES_POW] THEN + X_GEN_TAC `d:num` THEN REWRITE_TAC[LT] THEN + ASM_CASES_TAC `d:num = n` THEN ASM_REWRITE_TAC[LT_REFL] THEN + ASM_SIMP_TAC[RING_MUL_RID; RING_ADD_LZERO] THEN + COND_CASES_TAC THEN + ASM_SIMP_TAC[RING_MUL_RZERO; RING_ADD_RZERO; RING_0]; + ALL_TAC] THEN + REWRITE_TAC[GSYM FUN_EQ_COEFF] THEN X_GEN_TAC `d:num` THEN + FIRST_X_ASSUM(fun th -> GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) + [SYM(SPEC `SUC d` th)]) THEN + ASM_SIMP_TAC[COEFF_POLY_ADD; COEFF_POLY_VARPOW_MUL; LT] THEN + SIMP_TAC[RING_ADD_LZERO; COEFF_IN_CARRIER; RING_POWERSERIES; RING_SUM] THEN + ASM_SIMP_TAC[COEFF_POWSER_SUM; RING_POWERSERIES_MUL; POWSER_RING_CLAUSES; + RING_POWERSERIES_CONST; COEFF_POLY_LMUL] THEN + MATCH_MP_TAC RING_SUM_EQ THEN X_GEN_TAC `i:(1->num)->A` THEN + DISCH_TAC THEN REWRITE_TAC[COEFF_POLY_MUL] THEN + MATCH_MP_TAC RING_SUM_EQ THEN X_GEN_TAC `j:num` THEN + REWRITE_TAC[IN_NUMSEG; LE_0] THEN DISCH_TAC THEN + AP_THM_TAC THEN AP_TERM_TAC THEN ASM_REWRITE_TAC[LT_SUC_LE]);; + +let NOETHERIAN_POWSER_RING_1 = prove + (`!r:A ring. + noetherian_ring (powser_ring r (:1)) <=> noetherian_ring r`, + GEN_TAC THEN EQ_TAC THENL + [MESON_TAC[POWSER_RING_EPIMORPHISM_COEFF_0; + NOETHERIAN_RING_EPIMORPHIC_IMAGE]; + GEN_REWRITE_TAC LAND_CONV [noetherian_ring] THEN + DISCH_TAC THEN REWRITE_TAC[NOETHERIAN_RING_EQ_FG_PRIME_IDEALS]] THEN + X_GEN_TAC `j:((1->num)->A)->bool` THEN DISCH_TAC THEN + ASM_SIMP_TAC[KAPLANSKY_LEMMA] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_MESON_TAC[RING_IDEAL_EPIMORPHIC_IMAGE; POWSER_RING_EPIMORPHISM_COEFF_0; + PRIME_IMP_RING_IDEAL]);; + +let NOETHERIAN_POWSER_RING = prove + (`!(r:A ring) (s:V->bool). + noetherian_ring (powser_ring r s) <=> + noetherian_ring r /\ (FINITE s \/ trivial_ring r)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `FINITE(s:V->bool)` THEN + ASM_REWRITE_TAC[] THENL + [UNDISCH_TAC `FINITE(s:V->bool)` THEN + SPEC_TAC(`s:V->bool`,`s:V->bool`) THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN CONJ_TAC THENL + [MATCH_MP_TAC ISOMORPHIC_RING_NOETHERIANNESS THEN + REWRITE_TAC[ISOMORPHIC_POWSER_RING_TRIVIAL]; + MAP_EVERY X_GEN_TAC [`x:V`; `s:V->bool`] THEN + DISCH_THEN(CONJUNCTS_THEN2 (SUBST1_TAC o SYM) STRIP_ASSUME_TAC) THEN + GEN_REWRITE_TAC RAND_CONV [GSYM NOETHERIAN_POWSER_RING_1] THEN + MATCH_MP_TAC ISOMORPHIC_RING_NOETHERIANNESS THEN + ONCE_REWRITE_TAC[ISOMORPHIC_RING_SYM] THEN + MATCH_MP_TAC ISOMORPHIC_RING_POWSER_POWSER_GEN THEN + ASM_SIMP_TAC[CARD_EQ_CARD; CARD_ADD_C; FINITE_INSERT; CARD_CLAUSES; + CARD_ADD_FINITE_EQ; REWRITE_RULE[HAS_SIZE] HAS_SIZE_1] THEN + REWRITE_TAC[ISOMORPHIC_RING_REFL; ADD1]]; + ALL_TAC] THEN + ASM_CASES_TAC `trivial_ring(r:A ring)` THEN ASM_REWRITE_TAC[] THENL + [MATCH_MP_TAC ISOMORPHIC_RING_NOETHERIANNESS THEN + MATCH_MP_TAC ISOMORPHIC_TRIVIAL_RINGS THEN + ASM_REWRITE_TAC[TRIVIAL_POWSER_RING]; + ALL_TAC] THEN + REWRITE_TAC[NOETHERIAN_RING_EQ_ACC] THEN + MP_TAC(ISPEC `s:V->bool` INFINITE_CARD_LE) THEN + ASM_REWRITE_TAC[INFINITE; le_c; INJECTIVE_ALT; IN_UNIV] THEN + DISCH_THEN(X_CHOOSE_THEN `v:num->V` STRIP_ASSUME_TAC) THEN + EXISTS_TAC + `(\n. ideal_generated (powser_ring r s) {poly_var r (v i) | i < n}) + :num->((V->num)->A)->bool` THEN + REWRITE_TAC[RING_IDEAL_IDEAL_GENERATED] THEN + X_GEN_TAC `n:num` THEN REWRITE_TAC[PSUBSET_ALT] THEN CONJ_TAC THENL + [MATCH_MP_TAC IDEAL_GENERATED_MONO THEN + REWRITE_TAC[ARITH_RULE `i < n + 1 <=> i < n \/ i = n`] THEN SET_TAC[]; + EXISTS_TAC `poly_var r (v(n:num)):(V->num)->A`] THEN + CONJ_TAC THENL + [MATCH_MP_TAC IDEAL_GENERATED_INC THEN + ASM_REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; POWSER_VAR] THEN + REWRITE_TAC[ARITH_RULE `i < n + 1 <=> i < n \/ i = n`] THEN SET_TAC[]; + MATCH_MP_TAC(SET_RULE + `!P. ~P a /\ (!y. y IN s ==> P y) ==> ~(a IN s)`)] THEN + EXISTS_TAC `\p. (p:(V->num)->A) (monomial_var(v(n:num))) = ring_0 r` THEN + REWRITE_TAC[] THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[poly_var; GSYM TRIVIAL_RING_10]; + ONCE_REWRITE_TAC[SIMPLE_IMAGE_GEN]] THEN + ASM_SIMP_TAC[IDEAL_GENERATED_FINITE_IMAGE; FINITE_NUMSEG_LT; + SUBSET; FORALL_IN_IMAGE; POWSER_VAR] THEN + ASM_SIMP_TAC[POWSER_SUM; RING_MUL; POWSER_VAR; FORALL_IN_GSPEC; + FINITE_NUMSEG_LT] THEN + REWRITE_TAC[POWSER_RING_CLAUSES; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC RING_SUM_EQ_0 THEN REWRITE_TAC[IMP_CONJ; IN_ELIM_THM] THEN + X_GEN_TAC `m:num` THEN DISCH_TAC THEN DISCH_THEN(K ALL_TAC) THEN + ASM_SIMP_TAC[POWSER_MUL_VAR] THEN + REWRITE_TAC[MONOMIAL_VAR_DIVIDES; MONOMIAL_VARS_VAR] THEN + ASM_SIMP_TAC[IN_SING; LT_IMP_NE]);; + +(* ------------------------------------------------------------------------- *) +(* Monic polynomials (leading coefficient = ring identity). *) +(* ------------------------------------------------------------------------- *) + +let monic = new_definition + `monic (r:A ring) (p:(1->num)->A) <=> coeff (poly_deg r p) p = ring_1 r`;; + +let MONIC_POLY_1 = prove + (`!r:A ring. monic r (poly_1 r)`, + REWRITE_TAC[monic; POLY_DEG_1; COEFF_POLY_1]);; + +let MONIC_POLY_0 = prove + (`!r:A ring. monic r (poly_0 r) <=> trivial_ring r`, + REWRITE_TAC[monic; POLY_DEG_0; COEFF_POLY_0; TRIVIAL_RING_10] THEN + MESON_TAC[]);; + +let MONIC_IMP_NONZERO = prove + (`!r:A ring p. + ring_polynomial r p /\ monic r p /\ ~trivial_ring r + ==> ~(p = poly_0 r)`, + MESON_TAC[TRIVIAL_RING_POLY_0; MONIC_POLY_0]);; + +let MONIC_IN_TRIVIAL_RING = prove + (`!r:A ring p. + ring_powerseries r p /\ trivial_ring r ==> monic r p`, + REWRITE_TAC[trivial_ring; RING_POWERSERIES_COEFF; monic] THEN + SET_TAC[RING_1]);; + +let MONIC_POLY_CONST = prove + (`!r c:A. monic r (poly_const r c) <=> c = ring_1 r`, + REWRITE_TAC[monic; POLY_DEG_CONST; COEFF_POLY_CONST]);; + +let MONIC_DEG_0 = prove + (`!r:A ring p. + ring_polynomial r p /\ monic r p /\ poly_deg r p = 0 + ==> p = poly_1 r`, + MESON_TAC[POLY_DEG_EQ_0; POLY_CONST_1; MONIC_POLY_CONST]);; + +let MONIC_POLY_VAR = prove + (`!r:A ring. monic r (poly_var r one)`, + GEN_TAC THEN REWRITE_TAC[monic; POLY_DEG_VAR; COEFF_POLY_VAR] THEN + MESON_TAC[TRIVIAL_RING_10]);; + +let MONIC_SUBRING_GENERATED = prove + (`!r:A ring s p. monic (subring_generated r s) p <=> monic r p`, + REWRITE_TAC[monic; POLY_DEG_SUBRING_GENERATED; SUBRING_GENERATED]);; + +let POLY_DEG_MUL_MONIC = prove + (`!r (p:(1->num)->A) q. + ring_polynomial r p /\ ring_polynomial r q /\ + monic r p /\ monic r q + ==> poly_deg r (poly_mul r p q) = poly_deg r p + poly_deg r q`, + REWRITE_TAC[monic] THEN REPEAT STRIP_TAC THEN + ASM_CASES_TAC `trivial_ring(r:A ring)` THENL + [ASM_SIMP_TAC[TRIVIAL_RING_POLY_0] THEN + SIMP_TAC[POLY_MUL_0; RING_POLYNOMIAL_0; POLY_DEG_0; ADD_CLAUSES]; + MATCH_MP_TAC POLY_DEG_MUL_UNIVARIATE THEN + ASM_SIMP_TAC[RING_MUL_LID; RING_1; GSYM TRIVIAL_RING_10]]);; + +let MONIC_POLY_MUL = prove + (`!r p q:(1->num)->A. + ring_polynomial r p /\ ring_polynomial r q /\ monic r p /\ monic r q + ==> monic r (poly_mul r p q)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[monic] THEN + ASM_SIMP_TAC[POLY_DEG_MUL_MONIC; POLY_MUL_LEADING_COEFF] THEN + UNDISCH_TAC `monic (r:A ring) (p:(1->num)->A)` THEN + UNDISCH_TAC `monic (r:A ring) (q:(1->num)->A)` THEN + SIMP_TAC[monic; RING_MUL_LID; RING_1]);; + +let MONIC_POLY_POW = prove + (`!r (p:(1->num)->A) n. + ring_polynomial r p /\ monic r p ==> monic r (poly_pow r p n)`, + GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THENL + [REWRITE_TAC[POLY_POW] THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[MONIC_POLY_1]; + REWRITE_TAC[POLY_POW] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC MONIC_POLY_MUL THEN ASM_SIMP_TAC[] THEN + ASM_SIMP_TAC[RING_POLYNOMIAL_POW]]);; + +let MONIC_POLY_PRODUCT = prove + (`!r (f:K->(1->num)->A) s. + FINITE s /\ + (!i. i IN s ==> ring_polynomial r (f i)) /\ + (!i. i IN s ==> monic r (f i)) + ==> monic r (ring_product (poly_ring r (:1)) s f)`, + GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN CONJ_TAC THENL + [REWRITE_TAC[RING_PRODUCT_CLAUSES; NOT_IN_EMPTY; POLY_RING_CLAUSES] THEN + REWRITE_TAC[MONIC_POLY_1]; ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`x:K`; `t:K->bool`] THEN + STRIP_TAC THEN REPEAT DISCH_TAC THEN + SUBGOAL_THEN `(f:K->(1->num)->A) x IN ring_carrier(poly_ring r (:1))` + ASSUME_TAC THENL + [REWRITE_TAC[GSYM RING_POLYNOMIAL] THEN ASM_SIMP_TAC[IN_INSERT]; + ALL_TAC] THEN + ASM_SIMP_TAC[RING_PRODUCT_CLAUSES; GSYM POLY_RING] THEN + REWRITE_TAC[POLY_RING_CLAUSES] THEN + MATCH_MP_TAC MONIC_POLY_MUL THEN + ASM_SIMP_TAC[IN_INSERT] THEN + REWRITE_TAC[RING_POLYNOMIAL] THEN REWRITE_TAC[RING_PRODUCT]);; + +let MONIC_ASSOCIATES_EQ = prove + (`!r p q:(1->num)->A. + integral_domain r /\ + monic r p /\ monic r q /\ ring_associates (poly_ring r (:1)) p q + ==> p = q`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `ring_polynomial r (p:(1->num)->A) /\ ring_polynomial r (q:(1->num)->A)` + STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[RING_ASSOCIATES_IN_CARRIER; RING_POLYNOMIAL]; ALL_TAC] THEN + MP_TAC(ISPECL [`poly_ring (r:A ring) (:1)`; `p:(1->num)->A`; `q:(1->num)->A`] + INTEGRAL_DOMAIN_ASSOCIATES) THEN + ASM_SIMP_TAC[INTEGRAL_DOMAIN_POLY_RING; GSYM RING_POLYNOMIAL] THEN + ASM_SIMP_TAC[POLY_RING_CLAUSES; RING_UNIT_POLY_DOMAIN] THEN + REWRITE_TAC[LEFT_IMP_EXISTS_THM; LEFT_AND_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`u:(1->num)->A`; `c:A`] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) ASSUME_TAC) THEN + DISCH_THEN SUBST_ALL_TAC THEN UNDISCH_TAC `monic r (q:(1->num)->A)` THEN + FIRST_X_ASSUM(SUBST_ALL_TAC o SYM) THEN + SUBGOAL_THEN `(c:A) IN ring_carrier r /\ ~(c = ring_0 r)` + STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[ring_unit; RING_UNIT_0; INTEGRAL_DOMAIN_IMP_NONTRIVIAL_RING]; + ALL_TAC] THEN + SUBGOAL_THEN `~(p:(1->num)->A = poly_0 r)` ASSUME_TAC THENL + [ASM_MESON_TAC[MONIC_IMP_NONZERO; INTEGRAL_DOMAIN_IMP_NONTRIVIAL_RING]; + REWRITE_TAC[monic]] THEN + ASM_SIMP_TAC[POLY_DEG_MUL; POLY_CONST_EQ_0; RING_POLYNOMIAL_CONST] THEN + ASM_SIMP_TAC[POLY_MUL_LEADING_COEFF; RING_POLYNOMIAL_CONST] THEN + RULE_ASSUM_TAC(REWRITE_RULE[monic]) THEN + ASM_SIMP_TAC[POLY_DEG_CONST; COEFF_POLY_CONST; RING_MUL_LID] THEN + ASM_SIMP_TAC[POLY_CONST_1; RING_POLYNOMIAL_IMP_POWERSERIES; POLY_MUL_RID]);; + +let MONIC_CMUL = prove + (`!r (p:(1->num)->A). + integral_domain r /\ + ring_polynomial r p /\ + ring_unit r (coeff (poly_deg r p) p) + ==> monic r (poly_mul r + (poly_const r (ring_inv r (coeff (poly_deg r p) p))) p)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `p:(1->num)->A = poly_0 r` THENL + [ASM_REWRITE_TAC[COEFF_POLY_0; RING_UNIT_0] THEN + MESON_TAC[INTEGRAL_DOMAIN_IMP_NONTRIVIAL_RING]; + STRIP_TAC THEN REWRITE_TAC[monic]] THEN + W(MP_TAC o PART_MATCH (lhand o rand) POLY_DEG_MUL o lhand o lhand o snd) + THEN ANTS_TAC THENL + [ASM_MESON_TAC[RING_UNIT_0; INTEGRAL_DOMAIN_IMP_NONTRIVIAL_RING; + RING_INV_INV; RING_INV_0; RING_INV; COEFF_IN_CARRIER_ALT; + POLY_CONST_EQ_0; RING_POLYNOMIAL_CONST]; + DISCH_THEN SUBST1_TAC] THEN + ASM_SIMP_TAC[POLY_MUL_LEADING_COEFF; RING_POLYNOMIAL_CONST; + COEFF_IN_CARRIER_ALT; RING_INV] THEN + ASM_SIMP_TAC[COEFF_POLY_CONST; POLY_DEG_CONST; RING_MUL_LINV]);; + +let FIELD_MONIC_ASSOCIATE = prove + (`!f (p:(1->num)->A). + field f /\ ring_polynomial f p /\ ~(p = poly_0 f) + ==> ?q. ring_polynomial f q /\ + monic f q /\ + ring_associates (poly_ring f (:1)) p q /\ + poly_deg f q = poly_deg f p`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `integral_domain (f:A ring)` ASSUME_TAC THENL + [ASM_SIMP_TAC[FIELD_IMP_INTEGRAL_DOMAIN]; ALL_TAC] THEN + SUBGOAL_THEN `coeff (poly_deg (f:A ring) p) p IN ring_carrier f` + ASSUME_TAC THENL [ASM_MESON_TAC[COEFF_IN_CARRIER_ALT]; ALL_TAC] THEN + SUBGOAL_THEN `~(coeff (poly_deg (f:A ring) p) p = ring_0 f)` ASSUME_TAC THENL + [MATCH_MP_TAC POLY_TOP_NONZERO THEN + ASM_REWRITE_TAC[GSYM RING_POLYNOMIAL; POLY_RING_CLAUSES]; + ALL_TAC] THEN + SUBGOAL_THEN `ring_unit (f:A ring) (coeff (poly_deg f p) p)` ASSUME_TAC THENL + [ASM_SIMP_TAC[FIELD_UNIT]; ALL_TAC] THEN + ABBREV_TAC `c_inv = ring_inv (f:A ring) (coeff (poly_deg f p) p)` THEN + SUBGOAL_THEN `(c_inv:A) IN ring_carrier f` ASSUME_TAC THENL + [EXPAND_TAC "c_inv" THEN ASM_SIMP_TAC[RING_INV]; ALL_TAC] THEN + EXISTS_TAC `poly_mul f (poly_const f c_inv) (p:(1->num)->A)` THEN + ASM_SIMP_TAC[RING_POLYNOMIAL_MUL; RING_POLYNOMIAL_CONST] THEN + REPEAT CONJ_TAC THENL + [EXPAND_TAC "c_inv" THEN MATCH_MP_TAC MONIC_CMUL THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[POLY_CLAUSES] THEN MATCH_MP_TAC RING_ASSOCIATES_LMUL THEN + ASM_REWRITE_TAC[RING_UNIT_POLY_CONST; GSYM POLY_CLAUSES; IN_ELIM_THM] THEN + ASM_MESON_TAC[RING_UNIT_INV]; + MATCH_MP_TAC POLY_DEG_CMUL THEN ASM_MESON_TAC[RING_INV_INV; RING_INV_0]]);; + +let FIELD_MONIC_IRREDUCIBLE_ASSOCIATE = prove + (`!f (p:(1->num)->A). + field f /\ ring_irreducible (poly_ring f (:1)) p + ==> ?q. ring_polynomial f q /\ + monic f q /\ + ring_irreducible (poly_ring f (:1)) q /\ + ring_associates (poly_ring f (:1)) p q /\ + poly_deg f q = poly_deg f p`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `ring_polynomial (f:A ring) (p:(1->num)->A) /\ + ~(p = poly_0 f)` STRIP_ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ring_irreducible]) THEN + REWRITE_TAC[POLY_RING_CLAUSES; IN_ELIM_THM; SUBSET_UNIV] THEN + MESON_TAC[]; + MP_TAC(ISPECL [`f:A ring`; `p:(1->num)->A`] FIELD_MONIC_ASSOCIATE) THEN + ASM_MESON_TAC[RING_ASSOCIATES_IRREDUCIBLE; FIELD_IMP_INTEGRAL_DOMAIN; + INTEGRAL_DOMAIN_POLY_RING]]);; + +let RING_COPRIME_DISTINCT_MONIC_IRREDUCIBLES = prove + (`!r (p:(1->num)->A) q. + integral_domain r /\ + monic r p /\ monic r q /\ + ring_irreducible (poly_ring r (:1)) p /\ + ring_irreducible (poly_ring r (:1)) q /\ + ~(p = q) + ==> ring_coprime (poly_ring r (:1)) (p, q)`, + MESON_TAC[RING_IRREDUCIBLES_COPRIME_OR_ASSOCIATES; + MONIC_ASSOCIATES_EQ]);; + +let POLY_DEG_DIVIDES_LE_MONIC = prove + (`!(r:A ring) p q. + ring_divides (poly_ring r (:1)) p q /\ + monic r p /\ + ~(q = poly_0 r) + ==> poly_deg r p <= poly_deg r q`, + MESON_TAC[POLY_DEG_DIVIDES_LE_UNIVARIATE; RING_REGULAR_1; monic]);; + +(* ------------------------------------------------------------------------- *) +(* Reciprocal / reflection of univaraate polynomial, reversing coeffs. *) +(* ------------------------------------------------------------------------- *) + +let poly_recip = new_definition + `poly_recip (r:A ring) p = + \m. if m one <= poly_deg r p then p(\v:1. poly_deg r p - m one) + else ring_0 r`;; + +let COEFF_POLY_RECIP = prove + (`!(r:A ring) p i. + coeff i (poly_recip r p) = + if i <= poly_deg r p then coeff (poly_deg r p - i) p else ring_0 r`, + REWRITE_TAC[coeff; poly_recip]);; + +let RING_POWERSERIES_RECIP = prove + (`!(r:A ring) p. + ring_powerseries r p ==> ring_powerseries r (poly_recip r p)`, + REWRITE_TAC[RING_POWERSERIES_COEFF; COEFF_POLY_RECIP] THEN + MESON_TAC[RING_0]);; + +let RING_POLYNOMIAL_RECIP = prove + (`!(r:A ring) p. ring_polynomial r p ==> ring_polynomial r (poly_recip r p)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC RING_POLYNOMIAL_COEFF_BOUND THEN + ASM_SIMP_TAC[RING_POWERSERIES_RECIP; RING_POLYNOMIAL_IMP_POWERSERIES] THEN + EXISTS_TAC `poly_deg r (p:(1->num)->A)` THEN + REWRITE_TAC[COEFF_POLY_RECIP] THEN MESON_TAC[]);; + +let POLY_RECIP_IN_CARRIER = prove + (`!(r:A ring) p. + p IN ring_carrier(poly_ring r (:1)) + ==> poly_recip r p IN ring_carrier(poly_ring r (:1))`, + REWRITE_TAC[GSYM RING_POLYNOMIAL; RING_POLYNOMIAL_RECIP]);; + +let COEFF_0_POLY_RECIP_EQ_0 = prove + (`!(r:A ring) p. + ring_polynomial r p + ==> (coeff 0 (poly_recip r p) = ring_0 r <=> p = poly_0 r)`, + SIMP_TAC[COEFF_POLY_RECIP; LE_0; SUB_0; POLY_TOP_EQ_0]);; + +let POLY_DEG_RECIP_LE = prove + (`!(r:A ring) p. + ring_polynomial r p + ==> poly_deg r (poly_recip r p) <= poly_deg r p`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[POLY_DEG_LE_COEFF_EQ; RING_POLYNOMIAL_RECIP] THEN + REWRITE_TAC[COEFF_POLY_RECIP] THEN MESON_TAC[]);; + +let POLY_DEG_RECIP = prove + (`!(r:A ring) p. + ring_polynomial r p /\ ~(coeff 0 p = ring_0 r) + ==> poly_deg r (poly_recip r p) = poly_deg r p`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC POLY_DEG_EQ_FROM_LE THEN + ASM_SIMP_TAC[RING_POLYNOMIAL_RECIP; POLY_DEG_RECIP_LE] THEN + ASM_REWRITE_TAC[COEFF_POLY_RECIP; SUB_REFL; LE_REFL]);; + +let POLY_RECIP_RECIP = prove + (`!(r:A ring) p. + ring_polynomial r p /\ ~(coeff 0 p = ring_0 r) + ==> poly_recip r (poly_recip r p) = p`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[GSYM FUN_EQ_COEFF; COEFF_POLY_RECIP; POLY_DEG_RECIP] THEN + SIMP_TAC[ARITH_RULE `d:num <= p ==> p - (p - d) = d`] THEN + GEN_TAC THEN REWRITE_TAC[ARITH_RULE `p - d:num <= p`] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[COEFF_ABOVE_DEG; NOT_LE]);; + +let POLY_VARPOW_RECIP_RECIP = prove + (`!(r:A ring) x p. + ring_polynomial r p + ==> poly_mul r (poly_pow r (poly_var r x) + (poly_deg r p - poly_deg r (poly_recip r p))) + (poly_recip r (poly_recip r p)) = p`, + REWRITE_TAC[FORALL_ONE_THM; GSYM FUN_EQ_COEFF] THEN REPEAT STRIP_TAC THEN + W(MP_TAC o PART_MATCH (lhand o rand) + COEFF_POLY_VARPOW_MUL o lhand o snd) THEN + ANTS_TAC THENL + [ASM_MESON_TAC[RING_POLYNOMIAL_IMP_POWERSERIES; RING_POLYNOMIAL_RECIP]; + DISCH_THEN SUBST1_TAC] THEN + REWRITE_TAC[COEFF_POLY_RECIP] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP POLY_DEG_RECIP_LE) THEN DISCH_TAC THEN + REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THENL + [MP_TAC(ISPECL [`r:A ring`; `poly_recip (r:A ring) p`; + `poly_deg r (p:(1->num)->A) - d`] COEFF_ABOVE_DEG) THEN + ASM_SIMP_TAC[RING_POLYNOMIAL_RECIP] THEN + ANTS_TAC THENL [ASM_ARITH_TAC; DISCH_THEN(SUBST1_TAC o SYM)] THEN + REWRITE_TAC[COEFF_POLY_RECIP; ARITH_RULE `n - m:num <= n`] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN ASM_ARITH_TAC; + AP_THM_TAC THEN AP_TERM_TAC THEN ASM_ARITH_TAC; + ASM_ARITH_TAC; + CONV_TAC SYM_CONV THEN MATCH_MP_TAC COEFF_ABOVE_DEG THEN + ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC]);; + +let POLY_DIVIDES_RECIP_RECIP = prove + (`!(r:A ring) p. + ring_polynomial r p + ==> ring_divides (poly_ring r (:1)) (poly_recip r (poly_recip r p)) p`, + REPEAT STRIP_TAC THEN REWRITE_TAC[RING_DIVIDES_ALT] THEN + ASM_SIMP_TAC[GSYM RING_POLYNOMIAL; RING_POLYNOMIAL_RECIP] THEN + EXISTS_TAC `poly_pow r (poly_var (r:A ring) one) + (poly_deg r p - poly_deg r (poly_recip r p))` THEN + ASM_SIMP_TAC[POLY_VARPOW_RECIP_RECIP; POLY_RING] THEN + ASM_SIMP_TAC[RING_POLYNOMIAL_POW; RING_POLYNOMIAL_VAR]);; + +let POLY_RECIP_CONST = prove + (`!r c:A. poly_recip r (poly_const r c) = poly_const r c`, + REWRITE_TAC[GSYM FUN_EQ_COEFF; COEFF_POLY_RECIP; COEFF_POLY_CONST] THEN + REWRITE_TAC[POLY_DEG_CONST; CONJUNCT1 LE; SUB_0]);; + +let RING_UNIT_POLY_RECIP = prove + (`!(r:A ring) p. + integral_domain r /\ + ring_unit (poly_ring r (:1)) p + ==> ring_unit (poly_ring r (:1)) (poly_recip r p)`, + MESON_TAC[RING_UNIT_POLY_DOMAIN; POLY_RECIP_CONST]);; + +let RING_UNIT_POLY_RECIP_EQ = prove + (`!(r:A ring) p. + integral_domain r /\ ring_polynomial r p /\ ~(coeff 0 p = ring_0 r) + ==> (ring_unit (poly_ring r (:1)) (poly_recip r p) <=> + ring_unit (poly_ring r (:1)) p)`, + MESON_TAC[RING_UNIT_POLY_RECIP; POLY_RECIP_RECIP]);; + +let POLY_RECIP_0 = prove + (`!(r:A ring). poly_recip r (poly_0 r) = poly_0 r`, + REWRITE_TAC[GSYM POLY_CONST_0; POLY_RECIP_CONST]);; + +let POLY_RECIP_EQ_0 = prove + (`!(r:A ring) p. + ring_polynomial r p + ==> (poly_recip r p = poly_0 r <=> p = poly_0 r)`, + MESON_TAC[COEFF_0_POLY_RECIP_EQ_0; COEFF_POLY_0; POLY_RECIP_0]);; + +let POLY_RECIP_RECIP_EQ = prove + (`!(r:A ring) p. + ring_polynomial r p + ==> (poly_recip r (poly_recip r p) = p <=> + coeff 0 p = ring_0 r ==> p = poly_0 r)`, + MESON_TAC[POLY_RECIP_RECIP; POLY_RECIP_EQ_0; RING_POLYNOMIAL_RECIP; + COEFF_0_POLY_RECIP_EQ_0]);; + +let POLY_RECIP_1 = prove + (`!(r:A ring). poly_recip r (poly_1 r) = poly_1 r`, + REWRITE_TAC[GSYM POLY_CONST_1; POLY_RECIP_CONST]);; + +let POLY_RECIP_NEG = prove + (`!(r:A ring) p. + ring_polynomial r p + ==> poly_recip r (poly_neg r p) = poly_neg r (poly_recip r p)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[GSYM FUN_EQ_COEFF; COEFF_POLY_RECIP; COEFF_POLY_NEG] THEN + GEN_TAC THEN ASM_SIMP_TAC[POLY_DEG_NEG] THEN ASM_MESON_TAC[RING_NEG_0]);; + +let POLY_RECIP_MUL_GEN = prove + (`!(r:A ring) p q. + ring_polynomial r p /\ + ring_polynomial r q /\ + (ring_mul r (coeff (poly_deg r p) p) (coeff (poly_deg r q) q) = ring_0 r + ==> coeff (poly_deg r p) p = ring_0 r \/ + coeff (poly_deg r q) q = ring_0 r) + ==> poly_recip r (poly_mul r p q) = + poly_mul r (poly_recip r p) (poly_recip r q)`, + REPEAT GEN_TAC THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + ASM_SIMP_TAC[POLY_TOP_EQ_0] THEN + ASM_CASES_TAC `p:(1->num)->A = poly_0 r` THEN + ASM_SIMP_TAC[POLY_MUL_0; POLY_RECIP_0; RING_POLYNOMIAL_RECIP] THEN + ASM_CASES_TAC `q:(1->num)->A = poly_0 r` THEN + ASM_SIMP_TAC[POLY_MUL_0; POLY_RECIP_0; RING_POLYNOMIAL_RECIP] THEN + DISCH_TAC THEN + REWRITE_TAC[GSYM FUN_EQ_COEFF; COEFF_POLY_RECIP; COEFF_POLY_MUL_ALT] THEN + SUBGOAL_THEN + `poly_deg r (poly_mul r p q:(1->num)->A) = poly_deg r p + poly_deg r q` + SUBST1_TAC THENL + [MATCH_MP_TAC POLY_DEG_EQ_FROM_LE THEN + ASM_SIMP_TAC[RING_POLYNOMIAL_MUL; POLY_DEG_MUL_LE] THEN + ASM_SIMP_TAC[POLY_MUL_LEADING_COEFF]; + X_GEN_TAC `n:num`] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL + [ONCE_REWRITE_TAC[GSYM RING_SUM_SUPPORT] THEN + MATCH_MP_TAC RING_SUM_EQ_GENERAL_INVERSES THEN + REPEAT(EXISTS_TAC + `\(i,j). poly_deg r (p:(1->num)->A) - i, + poly_deg r (q:(1->num)->A) - j`) THEN + REWRITE_TAC[FORALL_PAIR_THM; IN_ELIM_PAIR_THM] THEN + ONCE_REWRITE_TAC[IN_ELIM_THM] THEN + REWRITE_TAC[IN_ELIM_PAIR_THM] THEN + REWRITE_TAC[ARITH_RULE `n - i:num <= n`; PAIR_EQ] THEN + CONJ_TAC THEN MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THENL + [REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN + ASM_SIMP_TAC[RING_MUL_LZERO; RING_MUL_RZERO; COEFF_IN_CARRIER; RING_0; + RING_POLYNOMIAL_IMP_POWERSERIES] THEN + ASM_ARITH_TAC; + ASM_CASES_TAC `i <= poly_deg r (p:(1->num)->A)` THENL + [ALL_TAC; + ASM_MESON_TAC[COEFF_ABOVE_DEG; NOT_LE; RING_MUL_LZERO; + COEFF_IN_CARRIER; RING_POLYNOMIAL_IMP_POWERSERIES]] THEN + ASM_CASES_TAC `j <= poly_deg r (q:(1->num)->A)` THENL + [ALL_TAC; + ASM_MESON_TAC[COEFF_ABOVE_DEG; NOT_LE; RING_MUL_RZERO; + COEFF_IN_CARRIER; RING_POLYNOMIAL_IMP_POWERSERIES]] THEN + ASM_SIMP_TAC[ARITH_RULE `i:num <= n ==> n - (n - i) = i`] THEN + ASM_ARITH_TAC]; + CONV_TAC SYM_CONV THEN MATCH_MP_TAC RING_SUM_EQ_0 THEN + REWRITE_TAC[FORALL_PAIR_THM; IN_ELIM_PAIR_THM] THEN + REPEAT STRIP_TAC THEN + REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN + ASM_SIMP_TAC[RING_MUL_LZERO; RING_MUL_RZERO; COEFF_IN_CARRIER; RING_0; + RING_POLYNOMIAL_IMP_POWERSERIES] THEN + ASM_ARITH_TAC]);; + +let POLY_RECIP_MUL = prove + (`!(r:A ring) p q. + integral_domain r /\ + ring_polynomial r p /\ + ring_polynomial r q + ==> poly_recip r (poly_mul r p q) = + poly_mul r (poly_recip r p) (poly_recip r q)`, + REWRITE_TAC[integral_domain] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC POLY_RECIP_MUL_GEN THEN + ASM_MESON_TAC[COEFF_IN_CARRIER_ALT]);; + +let POLY_DIVIDES_RECIP = prove + (`!(r:A ring) p q. + integral_domain r /\ + ring_divides (poly_ring r (:1)) p q + ==> ring_divides (poly_ring r (:1)) (poly_recip r p) (poly_recip r q)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[ring_divides; LEFT_IMP_EXISTS_THM; IMP_CONJ] THEN + REWRITE_TAC[GSYM RING_POLYNOMIAL; CONJUNCT2 POLY_RING] THEN + REPEAT DISCH_TAC THEN X_GEN_TAC `s:(1->num)->A` THEN + REPEAT DISCH_TAC THEN ASM_SIMP_TAC[RING_POLYNOMIAL_RECIP] THEN + EXISTS_TAC `poly_recip (r:A ring) s` THEN + ASM_SIMP_TAC[RING_POLYNOMIAL_RECIP; POLY_RECIP_MUL]);; + +let POLY_DIVIDES_RECIP_GALOIS = prove + (`!(r:A ring) p q. + integral_domain r /\ + ring_polynomial r q /\ + ring_divides (poly_ring r (:1)) p (poly_recip r q) + ==> ring_divides (poly_ring r (:1)) (poly_recip r p) q`, + MESON_TAC[POLY_DIVIDES_RECIP; POLY_DIVIDES_RECIP_RECIP; + RING_DIVIDES_TRANS]);; + +let POLY_DIVIDES_RECIP_EQ = prove + (`!(r:A ring) p q. + integral_domain r /\ + ring_polynomial r p /\ ring_polynomial r q /\ + ~(coeff 0 p = ring_0 r) + ==> (ring_divides (poly_ring r (:1)) (poly_recip r p) (poly_recip r q) <=> + ring_divides (poly_ring r (:1)) p q)`, + MESON_TAC[POLY_DIVIDES_RECIP; POLY_DIVIDES_RECIP_GALOIS; POLY_RECIP_RECIP]);; + +let RING_PRIME_POLY_RECIP = prove + (`!(r:A ring) p. + integral_domain r /\ ~(coeff 0 p = ring_0 r) /\ + ring_prime (poly_ring r (:1)) p + ==> ring_prime (poly_ring r (:1)) (poly_recip r p)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[ring_prime; POLY_RING; SUBSET_UNIV; IN_ELIM_THM] THEN + STRIP_TAC THEN + ASM_SIMP_TAC[RING_UNIT_POLY_RECIP_EQ; RING_POLYNOMIAL_RECIP; + POLY_RECIP_EQ_0] THEN + MAP_EVERY X_GEN_TAC [`d:(1->num)->A`; `e:(1->num)->A`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL + [`poly_recip (r:A ring) d`; `poly_recip (r:A ring) e`]) THEN + ASM_SIMP_TAC[RING_POLYNOMIAL_RECIP] THEN ANTS_TAC THENL + [ASM_MESON_TAC[POLY_DIVIDES_RECIP; POLY_RECIP_RECIP; POLY_RECIP_MUL]; + MATCH_MP_TAC MONO_OR] THEN + ASM_MESON_TAC[POLY_DIVIDES_RECIP; POLY_DIVIDES_RECIP_RECIP; + RING_DIVIDES_TRANS]);; + +let RING_PRIME_POLY_RECIP_EQ = prove + (`!(r:A ring) p. + integral_domain r /\ ring_polynomial r p /\ ~(coeff 0 p = ring_0 r) + ==> (ring_prime (poly_ring r (:1)) (poly_recip r p) <=> + ring_prime (poly_ring r (:1)) p)`, + MESON_TAC[RING_PRIME_POLY_RECIP; POLY_RECIP_RECIP; + COEFF_0_POLY_RECIP_EQ_0; COEFF_POLY_0]);; + +let RING_IRREDUCIBLE_POLY_RECIP = prove + (`!(r:A ring) p. + integral_domain r /\ ~(coeff 0 p = ring_0 r) /\ + ring_irreducible (poly_ring r (:1)) p + ==> ring_irreducible (poly_ring r (:1)) (poly_recip r p)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[ring_irreducible; POLY_RING; SUBSET_UNIV; IN_ELIM_THM] THEN + STRIP_TAC THEN + ASM_SIMP_TAC[RING_UNIT_POLY_RECIP_EQ; RING_POLYNOMIAL_RECIP; + POLY_RECIP_EQ_0] THEN + MAP_EVERY X_GEN_TAC [`d:(1->num)->A`; `e:(1->num)->A`] THEN STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o SYM o AP_TERM `coeff 0:((1->num)->A)->A`) THEN + REWRITE_TAC[COEFF_POLY_MUL; NUMSEG_SING; RING_SUM_SING] THEN + ASM_SIMP_TAC[RING_MUL; COEFF_IN_CARRIER_ALT; SUB_0] THEN + MAP_EVERY ASM_CASES_TAC + [`coeff 0 d:A = ring_0 r`; `coeff 0 e:A = ring_0 r`] THEN + ASM_SIMP_TAC[RING_MUL_LZERO; RING_MUL_RZERO; COEFF_IN_CARRIER_ALT; RING_0; + COEFF_0_POLY_RECIP_EQ_0] THEN + DISCH_THEN(K ALL_TAC) THEN FIRST_X_ASSUM(MP_TAC o SPECL + [`poly_recip (r:A ring) d`; `poly_recip (r:A ring) e`]) THEN + ASM_SIMP_TAC[RING_POLYNOMIAL_RECIP; RING_UNIT_POLY_RECIP_EQ] THEN + ASM_SIMP_TAC[GSYM POLY_RECIP_MUL; POLY_RECIP_RECIP]);; + +let RING_IRREDUCIBLE_POLY_RECIP_EQ = prove + (`!(r:A ring) p. + integral_domain r /\ ring_polynomial r p /\ ~(coeff 0 p = ring_0 r) + ==> (ring_irreducible (poly_ring r (:1)) (poly_recip r p) <=> + ring_irreducible (poly_ring r (:1)) p)`, + MESON_TAC[RING_IRREDUCIBLE_POLY_RECIP; POLY_RECIP_RECIP; + COEFF_0_POLY_RECIP_EQ_0; COEFF_POLY_0]);; + +let POLY_EVAL_RECIP = prove + (`!r p x:A. + ring_polynomial r p /\ ring_unit r x + ==> poly_eval r (poly_recip r p) x = + ring_mul r (ring_pow r x (poly_deg r p)) + (poly_eval r p (ring_inv r x))`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP RING_UNIT_IN_CARRIER) THEN + ASM_SIMP_TAC[POLY_EVAL_EXPAND; RING_INV; RING_POLYNOMIAL_RECIP; GSYM + RING_POLYNOMIAL] THEN + W(MP_TAC o PART_MATCH (lhand o rand) RING_SUM_REFLECT o + rand o rand o snd) THEN + REWRITE_TAC[CONJUNCT1 LT; SUB_0] THEN + ANTS_TAC THENL [ALL_TAC; DISCH_THEN SUBST1_TAC] THEN + ASM (CONV_TAC o GEN_SIMPLIFY_CONV TOP_DEPTH_SQCONV (basic_ss []) 4) + [POLY_EVAL_EXPAND; GSYM RING_POLYNOMIAL; RING_INV; FINITE_NUMSEG; + RING_POLYNOMIAL_RECIP; POLY_DEG_RECIP; GSYM RING_SUM_LMUL; + RING_MUL; RING_POW; COEFF_IN_CARRIER_ALT] THEN + MATCH_MP_TAC(MESON[] + `ring_sum r t g = ring_sum r s g /\ + ring_sum r s f = ring_sum r s g + ==> ring_sum r s f = ring_sum r t g`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC RING_SUM_SUPERSET THEN + REWRITE_TAC[SUBSET_NUMSEG; CONJUNCT1 LT; LE_0; IN_NUMSEG] THEN + ASM_SIMP_TAC[POLY_DEG_RECIP_LE; NOT_LE] THEN + X_GEN_TAC `i:num` THEN STRIP_TAC THEN + MP_TAC(ISPECL [`r:A ring`; `poly_recip (r:A ring) p`; `i:num`] + COEFF_ABOVE_DEG) THEN + ASM_SIMP_TAC[RING_POLYNOMIAL_RECIP; COEFF_POLY_RECIP] THEN + RING_TAC THEN ASM_SIMP_TAC[COEFF_IN_CARRIER_ALT; RING_INV]; + MATCH_MP_TAC RING_SUM_EQ THEN X_GEN_TAC `i:num` THEN + REWRITE_TAC[IN_NUMSEG; LE_0; COEFF_POLY_RECIP] THEN + DISCH_TAC THEN COND_CASES_TAC THENL + [ALL_TAC; ASM_MESON_TAC[POLY_DEG_RECIP_LE; LE_TRANS]] THEN + FIRST_ASSUM(MP_TAC o SPECL [`poly_deg r (p:(1->num)->A) - i`; `i:num`] o + MATCH_MP RING_POW_ADD) THEN + ASM_SIMP_TAC[ARITH_RULE `i:num <= p ==> (p - i) + i = p`] THEN + DISCH_THEN SUBST1_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP RING_MUL_RINV) THEN + DISCH_THEN(MP_TAC o AP_TERM + `\x:A. ring_pow r x (poly_deg r (p:(1->num)->A) - i)`) THEN + ASM_SIMP_TAC[RING_MUL_POW; RING_INV; RING_POW_ONE] THEN + RING_TAC THEN ASM_SIMP_TAC[COEFF_IN_CARRIER_ALT; RING_INV]]);; + +(* ------------------------------------------------------------------------- *) +(* Formal derivative of a univariate polynomial. *) +(* For p = sum a_n x^n, the derivative is sum (n+1)*a_{n+1} x^n. *) +(* The coefficient of x^k in p' is (k+1) * coefficient of x^{k+1} in p. *) (* ------------------------------------------------------------------------- *) -(* Prime in R gives prime poly_const in R[X] *) -(* Proof: quotient map to (R/(p))[X], integral domain *) +let poly_deriv = new_definition + `poly_deriv (r:A ring) (p:(1->num)->A) = + \m:1->num. ring_mul r (ring_of_num r (SUC(m one))) + (coeff (SUC(m one)) p)`;; -let RING_PRIME_POLY_CONST = prove - (`!(r:A ring) (s:V->bool) p. - integral_domain r /\ ring_prime r p - ==> ring_prime (poly_ring r s) (poly_const r p)`, +let POLY_DERIV_SUBRING_GENERATED = prove + (`!(r:A ring) (s:A->bool) p. + poly_deriv (subring_generated r s) p = poly_deriv r p`, + REWRITE_TAC[poly_deriv; SUBRING_GENERATED; RING_OF_NUM_SUBRING_GENERATED]);; + +let COEFF_POLY_DERIV = prove + (`!(r:A ring) p d. + coeff d (poly_deriv r p) = + ring_mul r (ring_of_num r (d + 1)) (coeff (d + 1) p)`, + REWRITE_TAC[COEFF; poly_deriv; ADD1]);; + +let RING_POWERSERIES_POLY_DERIV = prove + (`!(r:A ring) p. + ring_powerseries r p ==> ring_powerseries r (poly_deriv r p)`, + REWRITE_TAC[RING_POWERSERIES_COEFF; COEFF_POLY_DERIV] THEN + SIMP_TAC[RING_MUL; RING_OF_NUM]);; + +let POWSER_DERIV_IN_CARRIER = prove + (`!(r:A ring) p. + p IN ring_carrier(powser_ring r (:1)) + ==> poly_deriv r p IN ring_carrier(powser_ring r (:1))`, + REWRITE_TAC[GSYM RING_POWERSERIES; RING_POWERSERIES_POLY_DERIV]);; + +let RING_POLYNOMIAL_POLY_DERIV = prove + (`!(r:A ring) p. + ring_polynomial r p ==> ring_polynomial r (poly_deriv r p)`, + REPEAT GEN_TAC THEN + SIMP_TAC[RING_POLYNOMIAL_COEFF; COEFF_POLY_DERIV] THEN + MATCH_MP_TAC MONO_AND THEN SIMP_TAC[RING_MUL; RING_OF_NUM] THEN + REWRITE_TAC[FINITE_SUBSET_NUMSEG] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_NUMSEG; LE_0] THEN + REWRITE_TAC[GSYM NOT_LT; CONTRAPOS_THM] THEN + MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[ARITH_RULE `n < x ==> n < x + 1`] THEN + SIMP_TAC[RING_MUL_RZERO; RING_OF_NUM]);; + +let POLY_DERIV_IN_CARRIER = prove + (`!(r:A ring) p. + p IN ring_carrier(poly_ring r (:1)) + ==> poly_deriv r p IN ring_carrier(poly_ring r (:1))`, + REWRITE_TAC[GSYM RING_POLYNOMIAL; RING_POLYNOMIAL_POLY_DERIV]);; + +let POLY_DEG_DERIV_LE = prove + (`!(r:A ring) p. + ring_polynomial r p ==> poly_deg r (poly_deriv r p) <= poly_deg r p - 1`, REPEAT STRIP_TAC THEN - FIRST_ASSUM(STRIP_ASSUME_TAC o - GEN_REWRITE_RULE I [ring_prime]) THEN - ABBREV_TAC - `j = ideal_generated r {p:A}` THEN - SUBGOAL_THEN `ring_ideal r (j:A->bool)` ASSUME_TAC THENL - [EXPAND_TAC "j" THEN REWRITE_TAC[RING_IDEAL_IDEAL_GENERATED]; ALL_TAC] THEN - SUBGOAL_THEN - `integral_domain - (poly_ring (quotient_ring r (j:A->bool)) (s:V->bool))` ASSUME_TAC THENL - [ASM_SIMP_TAC[INTEGRAL_DOMAIN_POLY_RING; - INTEGRAL_DOMAIN_QUOTIENT_RING] THEN - EXPAND_TAC "j" THEN ASM_SIMP_TAC[PRIME_IDEAL_SING]; - ALL_TAC] THEN - SUBGOAL_THEN - `ring_homomorphism (poly_ring r (s:V->bool), - poly_ring (quotient_ring r (j:A->bool)) s) - (\q:(V->num)->A. ring_coset r j o q)` ASSUME_TAC THENL - [ASM_SIMP_TAC[RING_HOMOMORPHISM_POLY_RINGS; RING_HOMOMORPHISM_RING_COSET]; - ALL_TAC] THEN - FIRST_ASSUM(ASSUME_TAC o REWRITE_RULE[SUBSET; FORALL_IN_IMAGE] o - CONJUNCT1 o GEN_REWRITE_RULE I [ring_homomorphism]) THEN - SUBGOAL_THEN - `(\q:(V->num)->A. ring_coset r (j:A->bool) o q) (poly_const r p) = - ring_0 (poly_ring (quotient_ring r j) (s:V->bool))` ASSUME_TAC THENL - [CONV_TAC(LAND_CONV BETA_CONV) THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN - X_GEN_TAC `m:V->num` THEN - REWRITE_TAC[o_THM; poly_const; POLY_RING; POLY_0] THEN - COND_CASES_TAC THEN - ASM_SIMP_TAC[QUOTIENT_RING; RING_COSET_0; RING_IDEAL_IMP_SUBSET] THEN - ASM_MESON_TAC[RING_COSET_EQ_IDEAL; IDEAL_GENERATED_INC; - IN_SING; SING_SUBSET]; - ALL_TAC] THEN - REWRITE_TAC[ring_prime] THEN REPEAT CONJ_TAC THENL - [ASM_REWRITE_TAC[POLY_RING; POLY_CONST]; - ASM_MESON_TAC[POLY_RING; POLY_CONST_0; POLY_CONST_EQ]; - ASM_MESON_TAC[RING_UNIT_POLY_CONST; ring_prime]; - ALL_TAC] THEN - MAP_EVERY X_GEN_TAC [`f:(V->num)->A`; `g:(V->num)->A`] THEN - STRIP_TAC THEN - SUBGOAL_THEN - `(!m:V->num. ring_divides r p ((f:(V->num)->A) m)) \/ - (!m. ring_divides r p ((g:(V->num)->A) m))` MP_TAC THENL - [ALL_TAC; - DISCH_THEN DISJ_CASES_TAC THENL [DISJ1_TAC; DISJ2_TAC] THEN - MATCH_MP_TAC POLY_CONST_DIVIDES_COEFFS THEN ASM_REWRITE_TAC[]] THEN + ASM_SIMP_TAC[POLY_DEG_LE_COEFF_EQ; RING_POLYNOMIAL_POLY_DERIV] THEN + REWRITE_TAC[COEFF_POLY_DERIV] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC(ARITH_RULE `d + 1 <= i ==> d <= i - 1`) THEN + MATCH_MP_TAC POLY_DEG_GE_COEFF THEN EXISTS_TAC `d + 1` THEN + ASM_MESON_TAC[RING_MUL_RZERO; RING_OF_NUM; LE_REFL]);; + +let POLY_DEG_DERIV = prove + (`!(r:A ring) (p:(1->num)->A). + integral_domain r /\ ring_char r = 0 /\ ring_polynomial r p + ==> poly_deg r (poly_deriv r p) = poly_deg r p - 1`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP POLY_DEG_DERIV_LE) THEN + ASM_CASES_TAC `poly_deg r (p:(1->num)->A) = 0` THENL + [ASM_ARITH_TAC; MATCH_MP_TAC POLY_DEG_EQ_FROM_LE] THEN + ASM_SIMP_TAC[RING_POLYNOMIAL_POLY_DERIV; COEFF_POLY_DERIV] THEN + ASM_SIMP_TAC[COEFF_IN_CARRIER_ALT; INTEGRAL_DOMAIN_MUL_EQ_0; RING_OF_NUM; + ARITH_RULE `~(n = 0) ==> n - 1 + 1 = n`] THEN + ASM_SIMP_TAC[POLY_TOP_EQ_0; RING_OF_NUM_EQ_0; DIVIDES_ZERO] THEN + ASM_MESON_TAC[POLY_DEG_0]);; + +let POLY_DERIV_NONZERO_CHAR0 = prove + (`!(k:A ring) p. + integral_domain k /\ ring_char k = 0 /\ + ring_polynomial k p /\ + 1 <= poly_deg k p + ==> ~(poly_deriv k p = poly_0 k)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + REWRITE_TAC[GSYM FUN_EQ_COEFF; COEFF_POLY_DERIV; COEFF_POLY_0] THEN + DISCH_THEN(MP_TAC o SPEC `poly_deg k (p:(1->num)->A) - 1`) THEN + ASM_SIMP_TAC[COEFF_IN_CARRIER_ALT; INTEGRAL_DOMAIN_MUL_EQ_0; RING_OF_NUM; + SUB_ADD; POLY_TOP_EQ_0; RING_OF_NUM_EQ_0; DIVIDES_ZERO] THEN + ASM_MESON_TAC[POLY_DEG_0; LE_1]);; + +let POLY_DERIV_CONST = prove + (`!(r:A ring) c. poly_deriv r (poly_const r c) = poly_0 r`, + REPEAT GEN_TAC THEN + REWRITE_TAC[GSYM FUN_EQ_COEFF; COEFF_POLY_DERIV] THEN + REWRITE_TAC[COEFF_POLY_0; COEFF_POLY_CONST] THEN + SIMP_TAC[ADD_EQ_0; ARITH_EQ; RING_MUL_RZERO; RING_OF_NUM]);; + +let POLY_DERIV_0 = prove + (`!(r:A ring). poly_deriv r (poly_0 r) = poly_0 r`, + SIMP_TAC[GSYM POLY_CONST_0; POLY_DERIV_CONST; RING_0]);; + +let POLY_DERIV_1 = prove + (`!(r:A ring). poly_deriv r (poly_1 r) = poly_0 r`, + SIMP_TAC[GSYM POLY_CONST_1; POLY_DERIV_CONST; RING_1]);; + +let POLY_DERIV_VAR = prove + (`!(r:A ring). poly_deriv r (poly_var r (one:1)) = poly_const r (ring_1 r)`, + REWRITE_TAC[GSYM FUN_EQ_COEFF] THEN + REWRITE_TAC[COEFF_POLY_DERIV; COEFF_POLY_VAR; COEFF_POLY_CONST] THEN + REWRITE_TAC[ARITH_RULE `d + 1 = 1 <=> d = 0`] THEN + REPEAT GEN_TAC THEN COND_CASES_TAC THEN + ASM_SIMP_TAC[RING_MUL_RZERO; RING_OF_NUM] THEN + SIMP_TAC[ADD_CLAUSES; RING_OF_NUM_1; RING_MUL_LID; RING_1]);; + +let POLY_DERIV_ADD = prove + (`!(r:A ring) p q. + ring_powerseries r p /\ ring_powerseries r q + ==> poly_deriv r (poly_add r p q) = + poly_add r (poly_deriv r p) (poly_deriv r q)`, + REWRITE_TAC[GSYM FUN_EQ_COEFF] THEN + REWRITE_TAC[COEFF_POLY_DERIV; COEFF_POLY_ADD] THEN + MESON_TAC[COEFF_IN_CARRIER; RING_OF_NUM; RING_ADD_LDISTRIB]);; + +let POLY_DERIV_NEG = prove + (`!(r:A ring) p. + ring_powerseries r p + ==> poly_deriv r (poly_neg r p) = poly_neg r (poly_deriv r p)`, + REWRITE_TAC[GSYM FUN_EQ_COEFF] THEN + REWRITE_TAC[COEFF_POLY_DERIV; COEFF_POLY_NEG] THEN + MESON_TAC[COEFF_IN_CARRIER; RING_OF_NUM; RING_MUL_RNEG]);; + +let POLY_DERIV_SUB = prove + (`!(r:A ring) p q. + ring_powerseries r p /\ ring_powerseries r q + ==> poly_deriv r (poly_sub r p q) = + poly_sub r (poly_deriv r p) (poly_deriv r q)`, + REWRITE_TAC[POLY_SUB] THEN + ASM_SIMP_TAC[POLY_DERIV_ADD; POLY_DERIV_NEG; RING_POWERSERIES_NEG]);; + +let POLY_DERIV_CMUL = prove + (`!(r:A ring) c p. + c IN ring_carrier r /\ ring_powerseries r p + ==> poly_deriv r (poly_mul r (poly_const r c) p) = + poly_mul r (poly_const r c) (poly_deriv r p)`, + REWRITE_TAC[GSYM FUN_EQ_COEFF] THEN + ASM_SIMP_TAC[COEFF_POLY_DERIV; COEFF_POLY_LMUL; + RING_POWERSERIES_POLY_DERIV] THEN + ASM_SIMP_TAC[RING_MUL_AC; RING_OF_NUM; RING_MUL; COEFF_IN_CARRIER]);; + +let POLY_DERIV_HOMOMORPHIC_IMAGE = prove + (`!(k:A ring) (l:B ring) (h:A->B) (p:(1->num)->A). + ring_homomorphism(k,l) h /\ ring_powerseries k p + ==> poly_deriv l (h o p) = h o poly_deriv k p`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM FUN_EQ_COEFF] THEN + GEN_TAC THEN ASM_SIMP_TAC[COEFF_POLY_DERIV; COEFF_COMPOSE] THEN + ASM_MESON_TAC[RING_HOMOMORPHISM_RING_OF_NUM; RING_HOMOMORPHISM_MUL; + RING_OF_NUM; COEFF_IN_CARRIER]);; + +let POLY_DERIV_MUL = prove + (`!(r:A ring) p q. + ring_powerseries r p /\ ring_powerseries r q + ==> poly_deriv r (poly_mul r p q) = + poly_add r (poly_mul r (poly_deriv r p) q) + (poly_mul r p (poly_deriv r q))`, + REWRITE_TAC[RING_POWERSERIES_COEFF] THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[GSYM FUN_EQ_COEFF] THEN X_GEN_TAC `n:num` THEN + REWRITE_TAC[COEFF_POLY_DERIV; COEFF_POLY_ADD; COEFF_POLY_MUL] THEN + ASM_SIMP_TAC[GSYM RING_SUM_LMUL; FINITE_NUMSEG; RING_MUL; RING_OF_NUM] THEN + GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o ONCE_DEPTH_CONV) + [ARITH_RULE `n - i = (n + 1) - (i + 1)`] THEN + REWRITE_TAC[GSYM(SPEC `1` RING_SUM_OFFSET)] THEN + SIMP_TAC[RING_SUM_CLAUSES_LEFT; LE_0] THEN + SIMP_TAC[RING_SUM_CLAUSES_RIGHT; ARITH_RULE + `0 < n + 1 /\ 0 + 1 <= n + 1`] THEN + ASM_SIMP_TAC[RING_MUL; RING_OF_NUM; RING_SUM; SUB_0; RING_ADD] THEN + REWRITE_TAC[ADD_SUB; ADD_CLAUSES] THEN MATCH_MP_TAC + (REWRITE_RULE[IMP_IMP] (RING_RULE + `t0' = t0 /\ t1' = t1 /\ ring_add r s2 s3 = s1 + ==> ring_add r t0 (ring_add r s1 t1) = + ring_add r (ring_add r s2 t1') (ring_add r t0' s3)`)) THEN + ASM_SIMP_TAC[RING_MUL; RING_OF_NUM; RING_SUM; SUB_0; RING_ADD] THEN + REPEAT(CONJ_TAC THENL [RING_TAC; ALL_TAC]) THEN + ASM_SIMP_TAC[GSYM RING_SUM_ADD; FINITE_NUMSEG; RING_MUL; RING_OF_NUM] THEN + MATCH_MP_TAC RING_SUM_EQ THEN REWRITE_TAC[IN_NUMSEG] THEN + X_GEN_TAC `i:num` THEN DISCH_TAC THEN + SUBGOAL_THEN `(n + 1) - i = n - i + 1` SUBST1_TAC THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `n + 1 = i + (n - i + 1)` SUBST1_TAC THENL + [ASM_ARITH_TAC; REWRITE_TAC[RING_OF_NUM_ADD] THEN RING_TAC]);; + +let POLY_DERIV_SUM = prove + (`!(r:A ring) (f:B->(1->num)->A) s. + FINITE s /\ (!x. x IN s ==> ring_powerseries r (f x)) + ==> poly_deriv r (ring_sum (powser_ring r (:1)) s f) = + ring_sum (powser_ring r (:1)) s (\x. poly_deriv r (f x))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM FUN_EQ_COEFF] THEN + X_GEN_TAC `d:num` THEN REWRITE_TAC[COEFF_POLY_DERIV] THEN + ASM_SIMP_TAC[COEFF_POWSER_SUM; RING_POWERSERIES_POLY_DERIV] THEN + REWRITE_TAC[COEFF_POLY_DERIV] THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC RING_SUM_LMUL THEN + ASM_SIMP_TAC[RING_OF_NUM; COEFF_IN_CARRIER]);; + +let POLY_DERIV_PRODUCT = prove + (`!(r:A ring) (f:K->(1->num)->A) s. + FINITE s /\ (!x. x IN s ==> ring_powerseries r (f x)) + ==> poly_deriv r (ring_product (powser_ring r (:1)) s f) = + ring_sum (powser_ring r (:1)) s + (\x. poly_mul r (poly_deriv r (f x)) + (ring_product (powser_ring r (:1)) + (s DELETE x) f))`, + GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN + SIMP_TAC[NOT_IN_EMPTY; RING_PRODUCT_CLAUSES; FORALL_IN_INSERT; + RING_SUM_CLAUSES; POWSER_CLAUSES; RING_POWERSERIES; + RING_MUL; RING_PRODUCT; POWSER_DERIV_IN_CARRIER] THEN + REWRITE_TAC[GSYM POWSER_CLAUSES; IN_ELIM_THM; POLY_DERIV_1] THEN + MAP_EVERY X_GEN_TAC [`i:K`; `k:K->bool`] THEN + DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + ASM_SIMP_TAC[POLY_DERIV_MUL; RING_POWERSERIES; RING_PRODUCT] THEN + ASM_SIMP_TAC[SET_RULE `~(i IN k) ==> (i INSERT k) DELETE i = k`] THEN + AP_TERM_TAC THEN ASM_SIMP_TAC[SET_RULE + `~(i IN k) /\ j IN k ==> (i INSERT k) DELETE j = i INSERT (k DELETE j)`] THEN + RULE_ASSUM_TAC(REWRITE_RULE[RING_POWERSERIES]) THEN + REWRITE_TAC[POWSER_CLAUSES] THEN + W(MP_TAC o PART_MATCH (rand o rand) RING_SUM_LMUL o lhand o snd) THEN + ASM_SIMP_TAC[RING_PRODUCT; RING_MUL; POWSER_DERIV_IN_CARRIER] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC RING_SUM_EQ THEN + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[RING_PRODUCT_CLAUSES; FINITE_DELETE; IN_DELETE] THEN + ASM_SIMP_TAC[RING_PRODUCT; RING_MUL; POWSER_DERIV_IN_CARRIER; + RING_MUL_AC]);; + +let POLY_DERIV_POW = prove + (`!(r:A ring) (p:(1->num)->A) n. + ring_powerseries r p + ==> poly_deriv r (poly_pow r p n) = + poly_mul r (poly_const r (ring_of_num r n)) + (poly_mul r (poly_deriv r p) (poly_pow r p (n - 1)))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`r:A ring`; `(\i. p):num->(1->num)->A`; `1..n`] + POLY_DERIV_PRODUCT) THEN + ASM_REWRITE_TAC[FINITE_NUMSEG] THEN + RULE_ASSUM_TAC(REWRITE_RULE[RING_POWERSERIES]) THEN + ASM_SIMP_TAC[RING_PRODUCT_CONST; FINITE_NUMSEG; CARD_NUMSEG_1; + FINITE_DELETE; CARD_DELETE] THEN + ASM_SIMP_TAC[POWSER_CLAUSES; RING_MUL; POWSER_DERIV_IN_CARRIER; + RING_POW; RING_SUM_CONST; FINITE_NUMSEG; CARD_NUMSEG_1] THEN + REWRITE_TAC[RING_OF_NUM_POWSER_RING]);; + +let POLY_DERIV_VAR_POW = prove + (`!(r:A ring) n. + poly_deriv r (poly_pow r (poly_var r one) n) = + ring_mul (poly_ring r (:1)) + (poly_const r (ring_of_num r n)) + (poly_pow r (poly_var r one) (n - 1))`, + REPEAT GEN_TAC THEN + MP_TAC(ISPECL [`r:A ring`; `poly_var (r:A ring) (one:1)`; `n:num`] + POLY_DERIV_POW) THEN + REWRITE_TAC[RING_POWERSERIES_VAR; POLY_DERIV_VAR] THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[POLY_RING_CLAUSES] THEN + REWRITE_TAC[GSYM poly_1] THEN + SIMP_TAC[POLY_MUL_LID; RING_POWERSERIES_POW; RING_POWERSERIES_VAR]);; + +(* ------------------------------------------------------------------------- *) +(* Separable polynomials and relation to squarefree-ness *) +(* ------------------------------------------------------------------------- *) + +let POLY_NONCONSTANT_IRREDUCIBLE_IMP_SEPARABLE = prove + (`!(r:A ring) p. + integral_domain r /\ ring_char r = 0 /\ + ring_irreducible(poly_ring r (:1)) p /\ ~(poly_deg r p = 0) + ==> ring_coprime(poly_ring r (:1)) (p, poly_deriv r p)`, + REPEAT STRIP_TAC THEN + W(MP_TAC o PART_MATCH (rand o rand) RING_IRREDUCIBLE_DIVIDES_OR_COPRIME o + snd) THEN + ASM_SIMP_TAC[POLY_DERIV_IN_CARRIER; RING_IRREDUCIBLE_IN_CARRIER] THEN + MATCH_MP_TAC(TAUT `~p ==> p \/ q ==> q`) THEN DISCH_TAC THEN + MP_TAC(ISPECL [`r:A ring`; `p:(1->num)->A`] POLY_DEG_DERIV_LE) THEN + ANTS_TAC THENL + [ASM_MESON_TAC[RING_POLYNOMIAL; ring_irreducible]; + MATCH_MP_TAC(ARITH_RULE `d <= d' /\ ~(d = 0) ==> d' <= d - 1 ==> F`)] THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC POLY_DEG_DIVIDES_LE THEN + EXISTS_TAC `(:1)` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC POLY_DERIV_NONZERO_CHAR0 THEN ASM_SIMP_TAC[LE_1] THEN + ASM_MESON_TAC[RING_POLYNOMIAL; ring_irreducible]);; + +let POLY_IRREDUCIBLE_IMP_SEPARABLE = prove + (`!(k:A ring) p. + field k /\ ring_char k = 0 /\ + ring_irreducible(poly_ring k (:1)) p + ==> ring_coprime(poly_ring k (:1)) (p, poly_deriv k p)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC POLY_NONCONSTANT_IRREDUCIBLE_IMP_SEPARABLE THEN + ASM_SIMP_TAC[FIELD_IMP_INTEGRAL_DOMAIN] THEN + ASM_MESON_TAC[IRREDUCIBLE_IMP_POLY_DEG_NZ]);; + +let POLY_SQUARE_DIVIDES_DERIV = prove + (`!(r:A ring) (p:(1->num)->A) f. + ring_polynomial r p /\ + ring_divides (poly_ring r (:1)) (poly_pow r p 2) f + ==> ring_divides (poly_ring r (:1)) p (poly_deriv r f)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[ring_divides; LEFT_IMP_EXISTS_THM; IMP_CONJ] THEN + REWRITE_TAC[GSYM RING_POLYNOMIAL; CONJUNCT2 POLY_RING_CLAUSES] THEN + REPEAT DISCH_TAC THEN X_GEN_TAC `q:(1->num)->A` THEN DISCH_TAC THEN + DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[RING_POLYNOMIAL_POLY_DERIV; RING_POLYNOMIAL_MUL] THEN + ASM_SIMP_TAC[POLY_DERIV_MUL; RING_POLYNOMIAL_IMP_POWERSERIES; + POLY_DERIV_POW; RING_POWERSERIES_POW; ARITH] THEN + EXISTS_TAC + `poly_add r (poly_mul r (poly_const r (ring_of_num r 2:A)) + (poly_mul r (poly_deriv r p) q)) + (poly_mul r p (poly_deriv r q)):(1->num)->A` THEN + CONJ_TAC THENL + [ASM_MESON_TAC[RING_POLYNOMIAL_CONST; RING_OF_NUM; RING_POLYNOMIAL_MUL; + RING_POLYNOMIAL_ADD; RING_POLYNOMIAL_POLY_DERIV]; + REWRITE_TAC[CONJUNCT2 POLY_CLAUSES; GSYM RING_POLYNOMIAL] THEN + REWRITE_TAC[POLY_CONST_OF_NUM] THEN + ABBREV_TAC `R = poly_ring (r:A ring) (:1)` THEN + POP_ASSUM(fun th -> RING_TAC THEN SUBST1_TAC(SYM th)) THEN + ASM_SIMP_TAC[GSYM RING_POLYNOMIAL; RING_POLYNOMIAL_POLY_DERIV]]);; + +let REPEATED_ROOT_POLY_DERIV_ZERO = prove + (`!(r:A ring) p a. + a IN ring_carrier r /\ + ring_divides (poly_ring r (:1)) + (poly_pow r (poly_sub r (poly_var r one) (poly_const r a)) 2) p + ==> poly_eval r (poly_deriv r p) a = ring_0 r`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ_ALT] + POLY_SQUARE_DIVIDES_DERIV)) THEN + ASM_SIMP_TAC[ring_divides; RING_POLYNOMIAL_SUB; RING_POLYNOMIAL_VAR; + RING_POLYNOMIAL_CONST; GSYM RING_POLYNOMIAL] THEN + DISCH_THEN(X_CHOOSE_THEN `d:(1->num)->A` + (CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC) o CONJUNCT2) THEN + ASM_SIMP_TAC[CONJUNCT2 POLY_RING; POLY_EVAL_MUL; POLY_EVAL_SUB; + RING_POLYNOMIAL_SUB; RING_POLYNOMIAL_VAR; POLY_EVAL_VAR; + RING_POLYNOMIAL_CONST; POLY_EVAL_CONST] THEN + ASM_SIMP_TAC[RING_SUB_REFL; RING_MUL_LZERO; POLY_EVAL]);; + +let POLY_SEPARABLE_IMP_SQUAREFREE = prove + (`!(k:A ring) p. + ring_coprime(poly_ring k (:1)) (p, poly_deriv k p) + ==> ring_squarefree (poly_ring k (:1)) p`, + REPEAT STRIP_TAC THEN REWRITE_TAC[ring_squarefree] THEN CONJ_TAC THENL + [ASM_MESON_TAC[ring_coprime]; ALL_TAC] THEN + X_GEN_TAC `q:(1->num)->A` THEN STRIP_TAC THEN SUBGOAL_THEN - `(\q:(V->num)->A. ring_coset r (j:A->bool) o q) - (ring_mul (poly_ring r (s:V->bool)) (f:(V->num)->A) g) = - ring_0 (poly_ring (quotient_ring r j) s)` ASSUME_TAC THENL - [SUBGOAL_THEN - `ring_divides (poly_ring (quotient_ring r (j:A->bool)) (s:V->bool)) - ((\q:(V->num)->A. ring_coset r j o q) (poly_const r p)) - ((\q. ring_coset r j o q) - (ring_mul (poly_ring r s) (f:(V->num)->A) g))` MP_TAC THENL - [MATCH_MP_TAC RING_DIVIDES_HOMOMORPHIC_IMAGE THEN - EXISTS_TAC `poly_ring (r:A ring) (s:V->bool)` THEN ASM_REWRITE_TAC[]; - ASM_REWRITE_TAC[RING_DIVIDES_ZERO]]; - ALL_TAC] THEN + `ring_divides (poly_ring (k:A ring) (:1)) (q:(1->num)->A) (p:(1->num)->A)` + ASSUME_TAC THENL + [MATCH_MP_TAC RING_DIVIDES_TRANS THEN + EXISTS_TAC `ring_pow (poly_ring (k:A ring) (:1)) (q:(1->num)->A) 2` THEN + ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[RING_POW_2] THEN + ASM_SIMP_TAC[RING_DIVIDES_RMUL; RING_DIVIDES_REFL]; + ALL_TAC] THEN SUBGOAL_THEN - `(\q:(V->num)->A. ring_coset r (j:A->bool) o q) (f:(V->num)->A) = - ring_0 (poly_ring (quotient_ring r j) (s:V->bool)) \/ - (\q:(V->num)->A. ring_coset r (j:A->bool) o q) (g:(V->num)->A) = - ring_0 (poly_ring (quotient_ring r j) s)` MP_TAC THENL - [MP_TAC(ISPEC `poly_ring (quotient_ring (r:A ring) (j:A->bool)) (s:V->bool)` - INTEGRAL_DOMAIN_MUL_EQ_0) THEN - ASM_SIMP_TAC[] THEN ASM_MESON_TAC[RING_HOMOMORPHISM_MUL]; - ALL_TAC] THEN - DISCH_THEN DISJ_CASES_TAC THENL [DISJ1_TAC; DISJ2_TAC] THEN - X_GEN_TAC `m:V->num` THEN - FIRST_X_ASSUM(MP_TAC o AP_TERM - `\(ff:(V->num)->(A->bool)). ff (m:V->num)`) THEN - CONV_TAC(DEPTH_CONV BETA_CONV) THEN - ASM_SIMP_TAC[o_THM; POLY_RING; POLY_0; QUOTIENT_RING; - RING_COSET_0; RING_IDEAL_IMP_SUBSET] THEN - DISCH_TAC THEN EXPAND_TAC "j" THEN - ASM_MESON_TAC[RING_COSET_EQ_IDEAL; IN_IDEAL_GENERATED_SING_EQ; - POLY_MONOMIAL_IN_CARRIER]);; + `ring_divides (poly_ring (k:A ring) (:1)) + (q:(1->num)->A) (poly_deriv k p)` ASSUME_TAC THENL + [MATCH_MP_TAC POLY_SQUARE_DIVIDES_DERIV THEN + ASM_REWRITE_TAC[RING_POLYNOMIAL; POLY_POW_ALT]; + ASM_MESON_TAC[ring_coprime]]);; + +let POLY_SQUARE_DIVIDES_DERIV_EQ = prove + (`!(k:A ring) (p:(1->num)->A) f. + field k /\ ring_char k = 0 /\ + ring_irreducible (poly_ring k (:1)) p + ==> (ring_divides (poly_ring k (:1)) p f /\ + ring_divides (poly_ring k (:1)) p (poly_deriv k f) <=> + ring_divides (poly_ring k (:1)) (poly_pow k p 2) f)`, + REPEAT STRIP_TAC THEN EQ_TAC THENL + [DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC); + FIRST_X_ASSUM(ASSUME_TAC o MATCH_MP RING_IRREDUCIBLE_IN_CARRIER) THEN + ASM_SIMP_TAC[POLY_SQUARE_DIVIDES_DERIV; RING_POLYNOMIAL] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] RING_DIVIDES_TRANS) THEN + ASM_SIMP_TAC[POLY_POW_ALT; RING_POW_2; RING_DIVIDES_RMUL; + RING_DIVIDES_REFL]] THEN + GEN_REWRITE_TAC LAND_CONV [ring_divides] THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + DISCH_THEN(X_CHOOSE_THEN `s:(1->num)->A` STRIP_ASSUME_TAC o GSYM) THEN + ASM_SIMP_TAC[RING_POW_2; POLY_POW_ALT] THEN + EXPAND_TAC "f" THEN MATCH_MP_TAC RING_DIVIDES_LMUL2 THEN + ASM_REWRITE_TAC[] THEN MP_TAC(ISPECL [`k:A ring`; `p:(1->num)->A`] + POLY_IRREDUCIBLE_IMP_SEPARABLE) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MATCH_MP_TAC RING_COPRIME_DIVPROD_RIGHT THEN + EXISTS_TAC `poly_deriv (k:A ring) p` THEN + ASM_SIMP_TAC[PID_POLY_RING; PID_IMP_UFD; POLY_DERIV_IN_CARRIER] THEN + CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[RING_COPRIME_SYM]] THEN + ASM_SIMP_TAC[RING_MUL; POLY_DERIV_IN_CARRIER; ring_divides] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ring_divides]) THEN + REPEAT(DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC)) THEN + MP_TAC(ISPECL + [`k:A ring`; `p:(1->num)->A`; `s:(1->num)->A`] POLY_DERIV_MUL) THEN + ANTS_TAC THENL + [ASM_MESON_TAC[RING_POLYNOMIAL; RING_POLYNOMIAL_IMP_POWERSERIES]; + ASM_REWRITE_TAC[CONJUNCT2 POLY_CLAUSES] THEN DISCH_THEN SUBST1_TAC] THEN + DISCH_THEN(X_CHOOSE_TAC `d:(1->num)->A`) THEN + EXISTS_TAC `ring_sub (poly_ring (k:A ring) (:1)) d (poly_deriv k s)` THEN + ASM_SIMP_TAC[RING_SUB; POLY_DERIV_IN_CARRIER] THEN + FIRST_X_ASSUM(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ABBREV_TAC `R = poly_ring (k:A ring) (:1)` THEN + POP_ASSUM(fun th -> RING_TAC THEN SUBST_ALL_TAC(SYM th)) THEN + ASM_SIMP_TAC[POLY_DERIV_IN_CARRIER]);; + +let POLY_SQUAREFREE_IMP_SEPARABLE = prove + (`!(k:A ring) p. + field k /\ ring_char k = 0 /\ + ring_squarefree (poly_ring k (:1)) p + ==> ring_coprime(poly_ring k (:1)) (p, poly_deriv k p)`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP RING_SQUAREFREE_IN_CARRIER) THEN + ASM_SIMP_TAC[ring_coprime; POLY_DERIV_IN_CARRIER] THEN + X_GEN_TAC `d:(1->num)->A` THEN + ASM_CASES_TAC `d = ring_0(poly_ring (k:A ring) (:1))` THENL + [ASM_REWRITE_TAC[RING_DIVIDES_ZERO] THEN + ASM_MESON_TAC[RING_SQUAREFREE_0; TRIVIAL_POLY_RING; + FIELD_IMP_NONTRIVIAL_RING]; + STRIP_TAC THEN + GEN_REWRITE_TAC I [TAUT `p <=> ~p ==> F`] THEN DISCH_TAC] THEN + MP_TAC(ISPECL [`poly_ring (k:A ring) (:1)`; `d:(1->num)->A`] + NOETHERIAN_DOMAIN_IRREDUCIBLE_FACTOR_EXISTS) THEN + ASM_SIMP_TAC[PID_POLY_RING; PID_IMP_UFD; NOT_IMP] THEN + MATCH_MP_TAC(TAUT `p /\ (p ==> q) ==> p /\ q`) THEN + CONJ_TAC THENL [ASM_MESON_TAC[ring_divides]; DISCH_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `q:(1->num)->A` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ring_squarefree]) THEN + ASM_REWRITE_TAC[NOT_FORALL_THM] THEN EXISTS_TAC `q:(1->num)->A` THEN + ASM_SIMP_TAC[RING_IRREDUCIBLE_IN_CARRIER; NOT_IMP] THEN + CONJ_TAC THENL [ALL_TAC; ASM_MESON_TAC[ring_irreducible]] THEN + ASM_SIMP_TAC[GSYM POLY_SQUARE_DIVIDES_DERIV_EQ; GSYM POLY_POW_ALT] THEN + ASM_MESON_TAC[RING_DIVIDES_TRANS]);; + +let POLY_SEPARABLE_EQ_SQUAREFREE = prove + (`!(k:A ring) p. + field k /\ ring_char k = 0 + ==> (ring_coprime(poly_ring k (:1)) (p, poly_deriv k p) <=> + ring_squarefree (poly_ring k (:1)) p)`, + MESON_TAC[POLY_SEPARABLE_IMP_SQUAREFREE; POLY_SQUAREFREE_IMP_SEPARABLE]);; + +let POLY_ROOT_COUNT_IMP_SQUAREFREE = prove + (`!(k:A ring) p. + field k /\ + p IN ring_carrier (poly_ring k (:1)) /\ + ~(p = ring_0 (poly_ring k (:1))) /\ + CARD {x | x IN ring_carrier k /\ poly_eval k p x = ring_0 k} = poly_deg k p + ==> ring_squarefree (poly_ring k (:1)) p`, + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[ring_squarefree] THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP FIELD_IMP_INTEGRAL_DOMAIN) THEN + X_GEN_TAC `d:(1->num)->A` THEN + REWRITE_TAC[IMP_CONJ; LEFT_IMP_EXISTS_THM; ring_divides] THEN + DISCH_TAC THEN REPEAT(DISCH_THEN(K ALL_TAC)) THEN + X_GEN_TAC `q:(1->num)->A` THEN DISCH_TAC THEN + ASM_CASES_TAC `d:(1->num)->A = ring_0 (poly_ring k (:1))` THEN + ASM_SIMP_TAC[RING_POW_ZERO; ARITH_EQ; RING_MUL_LZERO] THEN + ASM_CASES_TAC `q:(1->num)->A = ring_0 (poly_ring k (:1))` THEN + ASM_SIMP_TAC[RING_POW; RING_MUL_RZERO] THEN + DISCH_THEN(ASSUME_TAC o SYM) THEN + MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (ARITH_RULE + `a:num = b ==> a < b ==> F`)) THEN + MATCH_MP_TAC LET_TRANS THEN + EXISTS_TAC + `CARD{x | x IN ring_carrier k /\ poly_eval k (d:(1->num)->A) x = ring_0 k} + + CARD{x | x IN ring_carrier k /\ poly_eval k (q:(1->num)->A) x = ring_0 k}` + THEN CONJ_TAC THENL + [W(MP_TAC o PART_MATCH (rand o rand) CARD_UNION_LE o rand o snd) THEN + ASM_SIMP_TAC[POLY_ROOT_BOUND] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] LE_TRANS) THEN + MATCH_MP_TAC CARD_SUBSET THEN + ASM_SIMP_TAC[POLY_ROOT_BOUND; FINITE_UNION] THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_UNION] THEN + X_GEN_TAC `x:A` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + ASM_SIMP_TAC[REWRITE_RULE[RING_POLYNOMIAL; CONJUNCT2 POLY_CLAUSES] + (CONJ POLY_EVAL_MUL POLY_EVAL_POW); RING_POW] THEN + ASM_SIMP_TAC[INTEGRAL_DOMAIN_MUL_EQ_0; RING_POW; POLY_EVAL; + INTEGRAL_DOMAIN_POW_EQ_0; ARITH_EQ]; + ALL_TAC] THEN + TRANS_TAC LET_TRANS + `poly_deg k (d:(1->num)->A) + poly_deg k (q:(1->num)->A)` THEN + CONJ_TAC THENL [ASM_SIMP_TAC[POLY_ROOT_BOUND; LE_ADD2]; ALL_TAC] THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[CONJUNCT2 POLY_RING] THEN + W(MP_TAC o PART_MATCH (lhand o rand) POLY_DEG_MUL o rand o snd) THEN + ASM_SIMP_TAC[RING_POLYNOMIAL; CONJUNCT2 POLY_CLAUSES] THEN + ASM_SIMP_TAC[RING_POW; INTEGRAL_DOMAIN_POW_EQ_0; ARITH_EQ; + INTEGRAL_DOMAIN_POLY_RING] THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[CONJUNCT2 POLY_RING_CLAUSES] THEN + W(MP_TAC o PART_MATCH (lhand o rand) POLY_DEG_POW o lhand o rand o snd) THEN + ASM_REWRITE_TAC[RING_POLYNOMIAL] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[ARITH_RULE `d + q < 2 * d + q <=> ~(d = 0)`] THEN + ASM_MESON_TAC[POLY_DEG_EQ_0_UNIT; RING_POLYNOMIAL]);; + +(* ------------------------------------------------------------------------- *) +(* Gauss's lemma and preservation of the UFD property in polynomial rings. *) +(* ------------------------------------------------------------------------- *) (* Gauss's Lemma (divisibility form): a primitive polynomial *) (* that divides c * a for a constant c must divide a. *) @@ -22914,8 +27264,7 @@ let POLY_MAKE_PRIMITIVE = prove let RING_PRIME_POLY_RING_MONO = prove (`!(r:A ring) (t:V->bool) s (q:(V->num)->A). - t SUBSET s /\ integral_domain r /\ - ring_prime (poly_ring r t) q + t SUBSET s /\ ring_prime (poly_ring r t) q ==> ring_prime (poly_ring r s) q`, let lemma = prove (`!(r:A ring) (t:V->bool) u s (q:(V->num)->A). @@ -23489,7 +27838,7 @@ let POLY_CLEAR_DENOMINATORS = prove `ring_fractionate (r:A ring) {a | ring_regular r a} = (frc:A->(A#A->bool))` (fun _ -> ALL_TAC) THEN ASM_REWRITE_TAC[fraction_ring] THEN - MATCH_MP_TAC LOCALEQUIV_MUL_CANCEL THEN + MATCH_MP_TAC LOCALEQUIV_MUL_RCANCEL THEN ASM_REWRITE_TAC[IN_ELIM_THM]; ALL_TAC] THEN EXISTS_TAC `b:A` THEN @@ -24236,160 +28585,6 @@ let IRREDUCIBLE_PRIMITIVE_POLY_FRACTION_RING = prove (* Eisenstein irreducibility criterion *) (* ----------------------------------------------------------- *) -(* Shift lemma: coefficient of (x * q) at k+1 equals q at k *) - -let POLY_MUL_VAR_COEFF_UNIVARIATE = prove - (`!(r:A ring) (q:(1->num)->A) k. - q IN ring_carrier(poly_ring r (:1)) - ==> (ring_mul (poly_ring r (:1)) (poly_var r one) q) - (\v:1. k + 1) = q(\v:1. k)`, - REPEAT STRIP_TAC THEN - SUBGOAL_THEN `ring_powerseries r (q:(1->num)->A)` MP_TAC THENL - [ASM_MESON_TAC[IN_POLY_RING_CARRIER; ring_polynomial]; ALL_TAC] THEN - REWRITE_TAC[ring_powerseries] THEN DISCH_TAC THEN - REWRITE_TAC[POLY_RING_CLAUSES; poly_mul; poly_var] THEN - ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN - ASM_SIMP_TAC[RING_MUL_LZERO] THEN - GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [LAMBDA_PAIR] THEN - REWRITE_TAC[GSYM RING_SUM_RESTRICT_SET; GSYM LAMBDA_PAIR] THEN - REWRITE_TAC[SET_RULE - `{p:(1->num)#(1->num) | - p IN {((x:1->num),(y:1->num)) |x,y| P x y} /\ - Q p} = - {(x,y) |x,y| P x y /\ - Q(x:1->num,y:1->num)}`] THEN - REWRITE_TAC[MESON[MONOMIAL_MUL_VAR_ONE; MONOMIAL_MUL_LCANCEL] - `monomial_mul m1 m2 = (\v:1. k + 1) /\ - m1 = monomial_var (one:1) <=> - m1 = monomial_var one /\ m2 = (\v:1. k)`] THEN - REWRITE_TAC[SET_RULE - `{((x:1->num),(y:1->num)) | x = a /\ y = b} = - {(a:1->num,b:1->num)}`] THEN - ASM_SIMP_TAC[RING_SUM_SING; RING_MUL; RING_1; - RING_MUL_LID]);; - -(* Division by poly_var: x divides f iff constant term is zero *) - -let POLY_VAR_DIVIDES_UNIVARIATE = prove - (`!(r:A ring) (f:(1->num)->A). - integral_domain r /\ - f IN ring_carrier(poly_ring r (:1)) - ==> (ring_divides (poly_ring r (:1)) - (poly_var r (one:1)) f <=> - f monomial_1 = ring_0 r)`, - REPEAT STRIP_TAC THEN EQ_TAC THENL - [(* Forward: x | f ==> f(0) = 0 *) - DISCH_TAC THEN - MP_TAC(ISPECL [`poly_ring (r:A ring) (:1)`; - `r:A ring`; `\p:(1->num)->A. p monomial_1`; - `poly_var r (one:1):(1->num)->A`; `f:(1->num)->A`] - RING_DIVIDES_HOMOMORPHIC_IMAGE) THEN - ASM_REWRITE_TAC[RING_HOMOMORPHISM_MONOMIAL_1; POLY_VAR_MONOMIAL_1] THEN - REWRITE_TAC[ring_divides] THEN - ASM_MESON_TAC[RING_MUL_LZERO; RING_0]; - (* Backward: f(0) = 0 ==> x | f *) - DISCH_TAC THEN - SUBGOAL_THEN `~trivial_ring (r:A ring)` ASSUME_TAC THENL - [ASM_MESON_TAC[INTEGRAL_DOMAIN_IMP_NONTRIVIAL_RING]; ALL_TAC] THEN - MP_TAC(REWRITE_RULE[coeff] (ISPECL [`r:A ring`; `f:(1->num)->A`; - `poly_var r (one:1):(1->num)->A`] POLY_DIVISION_GEN)) THEN - ASM_REWRITE_TAC[POLY_VAR_UNIV] THEN - ANTS_TAC THENL - [SUBGOAL_THEN `poly_deg r (poly_var r (one:1):(1->num)->A) = 1` - (fun th -> ASM_REWRITE_TAC[th]) THENL - [ASM_SIMP_TAC[POLY_DEG_VAR; GSYM TRIVIAL_RING_10]; ALL_TAC] THEN - REWRITE_TAC[poly_var] THEN - SUBGOAL_THEN `(\v:1. 1) = monomial_var (one:1)` SUBST1_TAC THENL - [REWRITE_TAC[monomial_var; FUN_EQ_THM] THEN MESON_TAC[one]; - REWRITE_TAC[REFL_CLAUSE] THEN - CONV_TAC(ONCE_DEPTH_CONV COND_ELIM_CONV) THEN - REWRITE_TAC[RING_UNIT_1]]; ALL_TAC] THEN - DISCH_THEN(X_CHOOSE_THEN `q:(1->num)->A` (X_CHOOSE_THEN `t:(1->num)->A` - (REPEAT_TCL CONJUNCTS_THEN ASSUME_TAC))) THEN - (* Show t = 0 by evaluating at monomial_1 *) - SUBGOAL_THEN `t = ring_0(poly_ring r (:1)):(1->num)->A` - SUBST_ALL_TAC THENL - [SUBGOAL_THEN `(t:(1->num)->A) monomial_1 = ring_0 r` MP_TAC THENL - [SUBGOAL_THEN - `(q:(1->num)->A) monomial_1 IN ring_carrier r /\ - (t:(1->num)->A) monomial_1 IN ring_carrier r` - STRIP_ASSUME_TAC THENL - [ASM_MESON_TAC[POLY_MONOMIAL_IN_CARRIER]; ALL_TAC] THEN - SUBGOAL_THEN `ring_polynomial r (q:(1->num)->A) /\ - ring_polynomial r (poly_var r (one:1):(1->num)->A) /\ - ring_polynomial r (t:(1->num)->A) /\ - ring_polynomial r (f:(1->num)->A)` - STRIP_ASSUME_TAC THENL - [RULE_ASSUM_TAC(REWRITE_RULE[IN_POLY_RING_CARRIER]) THEN - ASM_REWRITE_TAC[RING_POLYNOMIAL_VAR]; ALL_TAC] THEN - FIRST_X_ASSUM(MP_TAC o - AP_TERM `\(p:(1->num)->A). p (monomial_1:(1->num))`) THEN - CONV_TAC(DEPTH_CONV BETA_CONV) THEN - REWRITE_TAC[POLY_RING_CLAUSES; poly_add] THEN - ASM_SIMP_TAC[POLY_MUL_MONOMIAL_1; POLY_VAR_MONOMIAL_1; - RING_MUL_RZERO; RING_ADD_LZERO]; ALL_TAC] THEN - DISCH_TAC THEN FIRST_X_ASSUM DISJ_CASES_TAC THENL - [SUBGOAL_THEN `ring_polynomial r (t:(1->num)->A)` ASSUME_TAC THENL - [RULE_ASSUM_TAC(REWRITE_RULE[IN_POLY_RING_CARRIER]) THEN - ASM_REWRITE_TAC[]; ALL_TAC] THEN - SUBGOAL_THEN `poly_deg r (poly_var r (one:1):(1->num)->A) = 1` - ASSUME_TAC THENL - [ASM_SIMP_TAC[POLY_DEG_VAR; GSYM TRIVIAL_RING_10]; ALL_TAC] THEN - SUBGOAL_THEN `poly_deg r (t:(1->num)->A) = 0` ASSUME_TAC THENL - [ASM_ARITH_TAC; ALL_TAC] THEN - FIRST_ASSUM(fun th -> MP_TAC(MATCH_MP POLY_DEG_EQ_0_ALT th)) THEN - ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN - REWRITE_TAC[POLY_RING_CLAUSES; POLY_CONST_0]; - ASM_REWRITE_TAC[]]; ALL_TAC] THEN - REWRITE_TAC[ring_divides] THEN ASM_REWRITE_TAC[POLY_VAR_UNIV] THEN - EXISTS_TAC `q:(1->num)->A` THEN ASM_REWRITE_TAC[] THEN - FIRST_X_ASSUM(MP_TAC o SYM) THEN - ASM_SIMP_TAC[RING_ADD_RZERO; RING_MUL; POLY_VAR_UNIV] THEN - DISCH_TAC THEN - ASM_MESON_TAC[RING_MUL_SYM; POLY_VAR_UNIV]]);; - -(* poly_var r one is prime in poly_ring r (:1) over integral domain *) - -let RING_PRIME_POLY_VAR_UNIVARIATE = prove - (`!(r:A ring). - integral_domain r - ==> ring_prime (poly_ring r (:1)) (poly_var r (one:1))`, - REPEAT STRIP_TAC THEN REWRITE_TAC[ring_prime] THEN - SUBGOAL_THEN `~trivial_ring (r:A ring)` ASSUME_TAC THENL - [ASM_MESON_TAC[INTEGRAL_DOMAIN_IMP_NONTRIVIAL_RING]; ALL_TAC] THEN - REPEAT CONJ_TAC THENL - [REWRITE_TAC[POLY_VAR_UNIV]; - ASM_SIMP_TAC[GSYM TRIVIAL_RING_10; POLY_RING_CLAUSES; poly_0; - POLY_VAR_EQ_CONST]; - ASM_SIMP_TAC[RING_UNIT_POLY_DOMAIN] THEN - REWRITE_TAC[NOT_EXISTS_THM; TAUT `~(p /\ q) <=> p ==> ~q`] THEN - X_GEN_TAC `c:A` THEN DISCH_TAC THEN - ASM_SIMP_TAC[POLY_VAR_EQ_CONST; GSYM TRIVIAL_RING_10]; ALL_TAC] THEN - MAP_EVERY X_GEN_TAC [`a:(1->num)->A`; `b:(1->num)->A`] THEN - STRIP_TAC THEN - SUBGOAL_THEN `ring_polynomial r (a:(1->num)->A) /\ - ring_polynomial r (b:(1->num)->A)` - STRIP_ASSUME_TAC THENL - [RULE_ASSUM_TAC(REWRITE_RULE[IN_POLY_RING_CARRIER]) THEN - ASM_REWRITE_TAC[]; ALL_TAC] THEN - SUBGOAL_THEN - `(a:(1->num)->A) monomial_1 IN ring_carrier r /\ - (b:(1->num)->A) monomial_1 IN ring_carrier r` - STRIP_ASSUME_TAC THENL - [ASM_MESON_TAC[POLY_MONOMIAL_IN_CARRIER]; ALL_TAC] THEN - UNDISCH_TAC - `ring_divides (poly_ring (r:A ring) (:1)) - (poly_var r (one:1)) - (ring_mul (poly_ring r (:1)) - (a:(1->num)->A) (b:(1->num)->A))` THEN - ASM_SIMP_TAC[POLY_VAR_DIVIDES_UNIVARIATE; RING_MUL] THEN - REWRITE_TAC[POLY_RING_CLAUSES] THEN - ASM_SIMP_TAC[POLY_MUL_MONOMIAL_1] THEN - DISCH_TAC THEN MP_TAC(ISPECL [`r:A ring`; `(a:(1->num)->A) monomial_1`; - `(b:(1->num)->A) monomial_1`] INTEGRAL_DOMAIN_MUL_EQ_0) THEN - ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN - DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC[]);; - (* Eisenstein irreducibility criterion *) let EISENSTEIN_IRREDUCIBILITY_GEN = prove @@ -24404,8 +28599,14 @@ let EISENSTEIN_IRREDUCIBILITY_GEN = prove h IN ring_carrier(poly_ring r (:1)) /\ ring_mul (poly_ring r (:1)) g h = f ==> poly_deg r g = 0 \/ poly_deg r h = 0`, - - REWRITE_TAC[coeff] THEN + let coeff_poly_varmul_alt = prove + (`!(r:A ring) (q:(1->num)->A) k. + q IN ring_carrier(poly_ring r (:1)) + ==> (ring_mul (poly_ring r (:1)) (poly_var r one) q) + (\v:1. k + 1) = q(\v:1. k)`, + REWRITE_TAC[POLY_RING; IN_ELIM_THM; SUBSET_UNIV] THEN + SIMP_TAC[RING_POLYNOMIAL_IMP_POWERSERIES; REWRITE_RULE[coeff] + COEFF_POLY_VAR_MUL; ADD_EQ_0; ARITH_EQ; ADD_SUB]) in let peeling_lemma = prove (`!d (r:A ring) (a:(1->num)->A) (b:(1->num)->A). integral_domain r /\ @@ -24436,7 +28637,8 @@ let EISENSTEIN_IRREDUCIBILITY_GEN = prove (* Step: deg(a) >= 1. Get a' with a = x * a' *) SUBGOAL_THEN `ring_divides (poly_ring r (:1)) (poly_var r (one:1)) (a:(1->num)->A)` MP_TAC THENL - [ASM_SIMP_TAC[POLY_VAR_DIVIDES_UNIVARIATE]; ALL_TAC] THEN + [ASM_SIMP_TAC[POLY_VAR_DIVIDES_UNIVARIATE; RING_POLYNOMIAL; COEFF_0]; + ALL_TAC] THEN REWRITE_TAC[ring_divides; POLY_VAR_UNIV] THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_THEN `a':(1->num)->A` (CONJUNCTS_THEN2 ASSUME_TAC (LABEL_TAC "a_eq"))) THEN @@ -24476,7 +28678,7 @@ let EISENSTEIN_IRREDUCIBILITY_GEN = prove (ring_mul (poly_ring r (:1)) a' b)` SUBST1_TAC THENL [ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[GSYM RING_MUL_ASSOC; POLY_VAR_UNIV]; ALL_TAC] THEN - MATCH_MP_TAC(GSYM POLY_MUL_VAR_COEFF_UNIVARIATE) THEN + MATCH_MP_TAC(GSYM coeff_poly_varmul_alt) THEN ASM_SIMP_TAC[RING_MUL]; ALL_TAC] THEN (* a'(monomial_1) = 0 using POLY_MUL_MONOMIAL_1 *) SUBGOAL_THEN `(a':(1->num)->A) monomial_1 = ring_0 r` @@ -24522,6 +28724,7 @@ let EISENSTEIN_IRREDUCIBILITY_GEN = prove X_GEN_TAC `k:num` THEN DISCH_TAC THEN USE_THEN "a_eq" (SUBST1_TAC o SYM) THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC) in + REWRITE_TAC[coeff] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN MAP_EVERY X_GEN_TAC [`g:(1->num)->A`; `h:(1->num)->A`] THEN STRIP_TAC THEN @@ -25114,6 +29317,184 @@ let EISENSTEIN_IRREDUCIBILITY_FRACTION_RING = prove ASM_REWRITE_TAC[]]; DISCH_THEN(fun th -> ASM_REWRITE_TAC[GSYM th])]);; +(* ------------------------------------------------------------------------- *) +(* The order of an element in a ring (or in its multiplicative monoid). *) +(* ------------------------------------------------------------------------- *) + +let RING_ORDER_DIVIDES = + let eth = prove + (`!r x:A. ?d. !n. x IN ring_carrier r ==> ring_pow r x n = ring_1 r <=> + d divides n`, + REPEAT GEN_TAC THEN MP_TAC(ISPECL + [`\y. (x:A) IN ring_carrier r ==> y = ring_1 r`; `\n. ring_pow r (x:A) n`] + ORDER_EXISTENCE_GEN) THEN + REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + SIMP_TAC[ring_pow; RING_POW_ADD; RING_MUL_LID; RING_POW]) in + new_specification ["ring_order"] (REWRITE_RULE[SKOLEM_THM] (GSYM eth));; + +let RING_POW_EQ_1 = prove + (`!r (x:A) n. + x IN ring_carrier r + ==> (ring_pow r x n = ring_1 r <=> ring_order r x divides n)`, + SIMP_TAC[RING_ORDER_DIVIDES]);; + +let RING_ORDER_EQ_0 = prove + (`!r (x:A). + x IN ring_carrier r + ==> (ring_order r x = 0 <=> + !n. ring_pow r x n = ring_1 r <=> n = 0)`, + SIMP_TAC[RING_POW_EQ_1] THEN MESON_TAC[NUMBER_RULE + `(!n:num. n divides n) /\ (!n. 0 divides n <=> n = 0)`]);; + +let RING_ORDER_EQ_1 = prove + (`!r (x:A). + x IN ring_carrier r + ==> (ring_order r x = 1 <=> x = ring_1 r)`, + SIMP_TAC[GSYM DIVIDES_ONE; RING_ORDER_DIVIDES; RING_POW_1]);; + +let RING_ORDER_UNIQUE = prove + (`!r (x:A) d. + x IN ring_carrier r + ==> (ring_order r x = d <=> + !n. ring_pow r x n = ring_1 r <=> d divides n)`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(ASSUME_TAC o MATCH_MP RING_POW_EQ_1) THEN + EQ_TAC THENL [ASM_MESON_TAC[]; ASM_REWRITE_TAC[]] THEN + MESON_TAC[DIVIDES_ANTISYM; NUMBER_RULE `(n:num) divides n`]);; + +let RING_POW_RING_ORDER = prove + (`!r (x:A). x IN ring_carrier r ==> ring_pow r x (ring_order r x) = ring_1 r`, + SIMP_TAC[RING_POW_EQ_1; DIVIDES_REFL]);; + +let RING_ORDER_1 = prove + (`!r:A ring. ring_order r (ring_1 r) = 1`, + SIMP_TAC[RING_ORDER_EQ_1; RING_1]);; + +let RING_POW_GCD_EQ_1 = prove + (`!r (x:A) m n. + x IN ring_carrier r + ==> (ring_pow r x (gcd(m,n)) = ring_1 r <=> + ring_pow r x m = ring_1 r /\ ring_pow r x n = ring_1 r)`, + SIMP_TAC[RING_POW_EQ_1] THEN CONV_TAC NUMBER_RULE);; + +let RING_POW_COPRIME_EQ_1 = prove + (`!r (x:A) m n. + x IN ring_carrier r /\ coprime(m,n) + ==> (ring_pow r x m = ring_1 r /\ ring_pow r x n = ring_1 r <=> + x = ring_1 r)`, + SIMP_TAC[GSYM RING_POW_GCD_EQ_1; COPRIME_GCD; RING_POW_1]);; + +let RING_ORDER_MUL_DIVIDES_GEN = prove + (`!r (x:A) y n. + x IN ring_carrier r /\ y IN ring_carrier r /\ + ring_order r x divides n /\ ring_order r y divides n + ==> ring_order r (ring_mul r x y) divides n`, + REPEAT GEN_TAC THEN + SIMP_TAC[GSYM RING_POW_EQ_1; IMP_CONJ; RING_MUL] THEN + SIMP_TAC[RING_MUL_POW; RING_MUL_LID; RING_1]);; + +let RING_ORDER_MUL_DIVIDES = prove + (`!r (x:A) y. + x IN ring_carrier r /\ y IN ring_carrier r + ==> ring_order r (ring_mul r x y) divides + (ring_order r x * ring_order r y)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC RING_ORDER_MUL_DIVIDES_GEN THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUMBER_RULE);; + +let RING_ORDER_MUL_DIVIDES_LCM = prove + (`!r (x:A) y. + x IN ring_carrier r /\ y IN ring_carrier r + ==> ring_order r (ring_mul r x y) divides + lcm(ring_order r x,ring_order r y)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC RING_ORDER_MUL_DIVIDES_GEN THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUMBER_RULE);; + +let RING_POW_MOD_ORDER_GEN = prove + (`!r (x:A) d k. + x IN ring_carrier r /\ ring_pow r x d = ring_1 r + ==> ring_pow r x k = ring_pow r x (k MOD d)`, + REPEAT STRIP_TAC THEN + TRANS_TAC EQ_TRANS `ring_pow r (x:A) (d * k DIV d + k MOD d)` THEN + CONJ_TAC THENL [REWRITE_TAC[DIVISION_SIMP]; ALL_TAC] THEN + ASM_SIMP_TAC[RING_POW_ADD; RING_POW_MUL; RING_POW_ONE] THEN + ASM_SIMP_TAC[RING_MUL_LID; RING_POW]);; + +let RING_POW_MOD_ORDER = prove + (`!r (x:A) n. + x IN ring_carrier r + ==> ring_pow r x (n MOD ring_order r x) = ring_pow r x n`, + MESON_TAC[RING_POW_RING_ORDER; RING_POW_MOD_ORDER_GEN]);; + +let RING_ORDER_POW = prove + (`!r (x:A) k. x IN ring_carrier r /\ ~(k = 0) /\ + k divides ring_order r x + ==> ring_order r (ring_pow r x k) = ring_order r x DIV k`, + SIMP_TAC[RING_ORDER_UNIQUE; RING_POW; GSYM RING_POW_MUL] THEN + SIMP_TAC[RING_POW_EQ_1] THEN REWRITE_TAC[divides] THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM SUBST1_TAC THEN + ASM_SIMP_TAC[GSYM divides; DIV_MULT] THEN + UNDISCH_TAC `~(k = 0)` THEN CONV_TAC NUMBER_RULE);; + +let RING_ORDER_POW_GEN = prove + (`!r (x:A) k. x IN ring_carrier r + ==> ring_order r (ring_pow r x k) = + if k = 0 then 1 + else ring_order r x DIV gcd(ring_order r x,k)`, + REPEAT STRIP_TAC THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[ring_pow; RING_ORDER_1] THEN + ASM_SIMP_TAC[RING_ORDER_UNIQUE; RING_POW] THEN + ASM_SIMP_TAC[GSYM RING_POW_MUL] THEN + ASM_SIMP_TAC[RING_POW_EQ_1] THEN X_GEN_TAC `n:num` THEN + SPEC_TAC(`ring_order r (x:A)`,`d:num`) THEN GEN_TAC THEN + MP_TAC(NUMBER_RULE `gcd(d:num,k) divides d`) THEN + GEN_REWRITE_TAC LAND_CONV [divides] THEN + DISCH_THEN(X_CHOOSE_THEN `m:num` MP_TAC) THEN + DISCH_THEN(fun th -> + GEN_REWRITE_TAC (RAND_CONV o LAND_CONV o LAND_CONV) [th] THEN + MP_TAC(SYM th)) THEN + ASM_SIMP_TAC[DIV_MULT; NUMBER_RULE `gcd(d,k) = 0 <=> d = 0 /\ k = 0`] THEN + UNDISCH_TAC `~(k = 0)` THEN NUMBER_TAC);; + +let RING_ORDER_POW_DIVIDES = prove + (`!r (x:A) n. x IN ring_carrier r + ==> ring_order r (ring_pow r x n) divides ring_order r x`, + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[GSYM RING_POW_EQ_1; RING_POW] THEN + ASM_SIMP_TAC[GSYM RING_POW_MUL] THEN + ASM_SIMP_TAC[RING_POW_EQ_1] THEN CONV_TAC NUMBER_RULE);; + +let RING_ORDER_UNIQUE_PRIME = prove + (`!r (x:A) p. x IN ring_carrier r /\ prime p + ==> (ring_order r x = p <=> + ~(x = ring_1 r) /\ ring_pow r x p = ring_1 r)`, + SIMP_TAC[RING_POW_EQ_1; GSYM RING_ORDER_EQ_1] THEN + REWRITE_TAC[prime] THEN + MESON_TAC[NUMBER_RULE `1 divides n /\ n divides n`]);; + +let RING_ORDER_MUL = prove + (`!r (x:A) y. + x IN ring_carrier r /\ y IN ring_carrier r /\ + coprime(ring_order r x, ring_order r y) + ==> ring_order r (ring_mul r x y) = ring_order r x * ring_order r y`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM DIVIDES_ANTISYM] THEN + ASM_SIMP_TAC[RING_ORDER_MUL_DIVIDES] THEN + MATCH_MP_TAC(NUMBER_RULE + `(a:num) divides (b * c) /\ b divides (a * c) /\ coprime(a,b) + ==> (a * b) divides c`) THEN + ASM_SIMP_TAC[GSYM RING_POW_EQ_1] THEN + MATCH_MP_TAC(MESON[] + `(ring_mul r (ring_pow r x m) (ring_pow r y m) = ring_pow r x m /\ + ring_mul r (ring_pow r x n) (ring_pow r y n) = ring_pow r (y:A) n) /\ + (ring_mul r (ring_pow r x m) (ring_pow r y m) = ring_1 r /\ + ring_mul r (ring_pow r x n) (ring_pow r y n) = ring_1 r) + ==> ring_pow r x m = ring_1 r /\ ring_pow r y n = ring_1 r`) THEN + CONJ_TAC THENL + [ASM_SIMP_TAC[RING_POW_MUL; RING_POW_RING_ORDER; RING_POW_ONE] THEN + ASM_SIMP_TAC[RING_MUL_LID; RING_MUL_RID; RING_POW]; + ASM_SIMP_TAC[GSYM RING_MUL_POW] THEN + ONCE_REWRITE_TAC[MULT_SYM] THEN + ASM_SIMP_TAC[RING_POW_MUL; RING_MUL; RING_POW_RING_ORDER] THEN + REWRITE_TAC[RING_POW_ONE]]);; + (* ------------------------------------------------------------------------- *) (* The Frobenius automorphism. *) (* ------------------------------------------------------------------------- *) diff --git a/Library/symmetric_group.ml b/Library/symmetric_group.ml index 45c0f695..1ba0354a 100644 --- a/Library/symmetric_group.ml +++ b/Library/symmetric_group.ml @@ -156,14 +156,11 @@ let CHAIN_STEP_THREE_CYCLES_GEN = prove MP_TAC(ISPECL [`a:A`; `b:A`; `c:A`; `d:A`] CARD_LE_4) THEN ASM_ARITH_TAC; ALL_TAC] THEN - MP_TAC(ISPECL [`H:(A->A) group`; `n:(A->A)->bool`] + MP_TAC(ISPECL [`H:(A->A) group`; `n:(A->A)->bool`; + `three_cycle d a (c:A)`; `three_cycle c e (b:A)`] ABELIAN_QUOTIENT_COMMUTATOR) THEN - ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN - DISCH_THEN(MP_TAC o SPECL - [`three_cycle d a (c:A)`; `three_cycle c e (b:A)`]) THEN ANTS_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN - ASM_REWRITE_TAC[] THEN - DISCH_TAC THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN SUBGOAL_THEN `three_cycle a b (c:A) = inverse(three_cycle d a c) o (inverse(three_cycle c e b) o @@ -710,8 +707,8 @@ let TRANSPOSITION_PCYCLE_GENERATES = prove ALL_TAC] THEN SUBGOAL_THEN `swap(x':A,y') = group_mul (symmetric_group (s:A->bool)) - (swap(a,x')) - (group_mul (symmetric_group s) (swap(a,y')) (swap(a:A,x')))` + (swap(a,x')) + (group_mul (symmetric_group s) (swap(a,y')) (swap(a:A,x')))` SUBST1_TAC THENL [REWRITE_TAC[SYMMETRIC_GROUP] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SWAP_TRIPLE_ALT THEN @@ -731,7 +728,7 @@ let TRANSPOSITION_PCYCLE_GENERATES = prove DISCH_THEN(X_CHOOSE_THEN `m:num` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `0 < m` ASSUME_TAC THENL [ASM_CASES_TAC `m = 0` THEN ASM_REWRITE_TAC[LT_NZ] THEN - UNDISCH_TAC + UNDISCH_TAC `group_pow (symmetric_group (s:A->bool)) (sigma:A->A) m a = b` THEN ASM_REWRITE_TAC[group_pow; SYMMETRIC_GROUP; I_THM] THEN ASM_MESON_TAC[]; ALL_TAC] THEN @@ -765,7 +762,7 @@ let TRANSPOSITION_PCYCLE_GENERATES = prove DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THEN SUBGOAL_THEN `0 < n` ASSUME_TAC THENL [ASM_CASES_TAC `n = 0` THEN ASM_REWRITE_TAC[LT_NZ] THEN - UNDISCH_TAC + UNDISCH_TAC `group_pow (symmetric_group (s:A->bool)) (tau:A->A) n a = c` THEN ASM_REWRITE_TAC[group_pow; SYMMETRIC_GROUP; I_THM] THEN ASM_MESON_TAC[]; ALL_TAC] THEN @@ -783,7 +780,7 @@ let TRANSPOSITION_PCYCLE_GENERATES = prove [(* Base: n = 1, tau^1(a) = tau(a) = b, swap(a,b) IN h *) ASM_REWRITE_TAC[ONE; group_pow; SYMMETRIC_GROUP; o_THM; I_THM]; ALL_TAC] THEN - SUBGOAL_THEN + SUBGOAL_THEN `swap(a:A, group_pow (symmetric_group (s:A->bool)) (tau:A->A) k a) IN h` ASSUME_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; ALL_TAC] THEN @@ -793,7 +790,7 @@ let TRANSPOSITION_PCYCLE_GENERATES = prove tau(group_pow (symmetric_group s) tau k a)` SUBST1_TAC THENL [REWRITE_TAC[group_pow; SYMMETRIC_GROUP; o_THM]; ALL_TAC] THEN - ABBREV_TAC + ABBREV_TAC `x0 = group_pow (symmetric_group (s:A->bool)) (tau:A->A) k (a:A)` THEN (* x0 IN s *) SUBGOAL_THEN `(x0:A) IN s` ASSUME_TAC THENL @@ -880,8 +877,8 @@ let TRANSPOSITION_PCYCLE_GENERATES = prove (* swap(a, tau(x0)) = swap(a,x0) o swap(x0,tau x0) o swap(a,x0) *) SUBGOAL_THEN `swap(a:A, (tau:A->A) x0) = group_mul (symmetric_group (s:A->bool)) - (swap(a,x0)) - (group_mul (symmetric_group s) (swap(x0, tau x0)) (swap(a:A,x0)))` + (swap(a,x0)) + (group_mul (symmetric_group s) (swap(x0, tau x0)) (swap(a:A,x0)))` SUBST1_TAC THENL [REWRITE_TAC[SYMMETRIC_GROUP] THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SWAP_TRIPLE THEN diff --git a/Makefile b/Makefile index 24f5bacf..2ae14410 100644 --- a/Makefile +++ b/Makefile @@ -140,20 +140,40 @@ hol.sh: pa_j.cmo ${HOLSRC} bignum.cmo hol_loader.cmo update_database.ml fi # If HOLLIGHT_USE_MODULE is set, add hol_lib.cmo to dependency of hol.sh -# Also, build unit_tests using OCaml bytecode compiler as well as OCaml native compiler. +# Also, build the test suites in UnitTests/ using both OCaml bytecode compiler +# and OCaml native compiler. Native builds go via `hol.sh compile/link`; +# bytecode builds invoke ocamlfind directly because hol.sh has no byte mode. ifeq ($(HOLLIGHT_USE_MODULE),1) hol.sh: hol_lib.cmo -unit_tests_inlined.ml: unit_tests.ml inline_load.ml ; \ - HOLLIGHT_DIR="`pwd`" ocaml inline_load.ml unit_tests.ml unit_tests_inlined.ml -unit_tests.byte: unit_tests_inlined.ml hol_lib.cmo inline_load.ml hol.sh ; \ - ocamlfind ocamlc -package zarith -linkpkg -pp "`./hol.sh -pp`" \ - -I . bignum.cmo hol_loader.cmo hol_lib.cmo unit_tests_inlined.ml -o unit_tests.byte -unit_tests.native: unit_tests_inlined.ml hol_lib.cmx inline_load.ml hol.sh ; \ - ocamlfind ocamlopt -package zarith -linkpkg -pp "`./hol.sh -pp`" \ - -I . bignum.cmx hol_loader.cmx hol_lib.cmx unit_tests_inlined.ml -o unit_tests.native -default: hol_lib.cma hol_lib.cmxa unit_tests.byte unit_tests.native +# UnitTests/basic_tests.ml: general HOL Light correctness checks. +UnitTests/basic_tests_inlined.ml: UnitTests/basic_tests.ml inline_load.ml hol.sh ; \ + ./hol.sh inline-load UnitTests/basic_tests.ml UnitTests/basic_tests_inlined.ml +UnitTests/basic_tests.byte: UnitTests/basic_tests_inlined.ml hol_lib.cmo hol.sh ; \ + ocamlfind ocamlc -package zarith -linkpkg -pp "`./hol.sh -pp`" \ + -I . bignum.cmo hol_loader.cmo hol_lib.cmo \ + UnitTests/basic_tests_inlined.ml -o UnitTests/basic_tests.byte +UnitTests/basic_tests.native: UnitTests/basic_tests_inlined.cmx hol_lib.cmxa hol.sh ; \ + ./hol.sh link UnitTests/basic_tests_inlined.cmx -o UnitTests/basic_tests.native +UnitTests/basic_tests_inlined.cmx: UnitTests/basic_tests_inlined.ml hol_lib.cmxa hol.sh ; \ + ./hol.sh compile UnitTests/basic_tests_inlined.ml + +# UnitTests/printer_tests.ml: pp_print_term output verification. +UnitTests/printer_tests_inlined.ml: UnitTests/printer_tests.ml inline_load.ml hol.sh ; \ + ./hol.sh inline-load UnitTests/printer_tests.ml UnitTests/printer_tests_inlined.ml +UnitTests/printer_tests.byte: UnitTests/printer_tests_inlined.ml hol_lib.cmo hol.sh ; \ + ocamlfind ocamlc -package zarith -linkpkg -pp "`./hol.sh -pp`" \ + -I . bignum.cmo hol_loader.cmo hol_lib.cmo \ + UnitTests/printer_tests_inlined.ml -o UnitTests/printer_tests.byte +UnitTests/printer_tests.native: UnitTests/printer_tests_inlined.cmx hol_lib.cmxa hol.sh ; \ + ./hol.sh link UnitTests/printer_tests_inlined.cmx -o UnitTests/printer_tests.native +UnitTests/printer_tests_inlined.cmx: UnitTests/printer_tests_inlined.ml hol_lib.cmxa hol.sh ; \ + ./hol.sh compile UnitTests/printer_tests_inlined.ml + +default: hol_lib.cma hol_lib.cmxa \ + UnitTests/basic_tests.byte UnitTests/basic_tests.native \ + UnitTests/printer_tests.byte UnitTests/printer_tests.native endif # Build a standalone hol image called "hol" (needs Linux and DMTCP) @@ -251,7 +271,10 @@ clean:; \ update_database.ml pa_j.ml pa_j.cmi pa_j.cmo \ hol_lib.a hol_lib.c* hol_lib.o hol_lib_inlined.ml \ hol_loader.c* hol_loader.o \ - unit_tests_inlined.* unit_tests.native unit_tests.byte \ + UnitTests/basic_tests_inlined.* \ + UnitTests/basic_tests.byte UnitTests/basic_tests.native \ + UnitTests/printer_tests_inlined.* \ + UnitTests/printer_tests.byte UnitTests/printer_tests.native \ ocaml-hol hol.sh hol hol.ckpt \ hol.multivariate hol.multivariate.ckpt \ hol.sosa hol.sosa.ckpt \ diff --git a/Multivariate/complex_database.ml b/Multivariate/complex_database.ml index 720fa70d..6207c0d9 100644 --- a/Multivariate/complex_database.ml +++ b/Multivariate/complex_database.ml @@ -46,12 +46,16 @@ theorems := "ABELIAN_GROUP_TORSION_ISOMORPHISM",ABELIAN_GROUP_TORSION_ISOMORPHISM; "ABELIAN_GROUP_TORSION_STRUCTURE",ABELIAN_GROUP_TORSION_STRUCTURE; "ABELIAN_HOMOLOGY_GROUP",ABELIAN_HOMOLOGY_GROUP; +"ABELIAN_IMP_SOLVABLE_GROUP",ABELIAN_IMP_SOLVABLE_GROUP; "ABELIAN_INTEGER_GROUP",ABELIAN_INTEGER_GROUP; "ABELIAN_INTEGER_MOD_GROUP",ABELIAN_INTEGER_MOD_GROUP; "ABELIAN_OPPOSITE_GROUP",ABELIAN_OPPOSITE_GROUP; "ABELIAN_PRODUCT_GROUP",ABELIAN_PRODUCT_GROUP; "ABELIAN_PROD_GROUP",ABELIAN_PROD_GROUP; +"ABELIAN_QUOTIENT_COMMUTATOR",ABELIAN_QUOTIENT_COMMUTATOR; +"ABELIAN_QUOTIENT_EPIMORPHIC_IMAGE",ABELIAN_QUOTIENT_EPIMORPHIC_IMAGE; "ABELIAN_QUOTIENT_GROUP",ABELIAN_QUOTIENT_GROUP; +"ABELIAN_QUOTIENT_GROUP_DIV",ABELIAN_QUOTIENT_GROUP_DIV; "ABELIAN_RELATIVE_HOMOLOGY_GROUP",ABELIAN_RELATIVE_HOMOLOGY_GROUP; "ABELIAN_RELCYCLE_GROUP",ABELIAN_RELCYCLE_GROUP; "ABELIAN_SIMPLE_GROUP",ABELIAN_SIMPLE_GROUP; @@ -1191,6 +1195,7 @@ theorems := "BOREL_DOMAIN_OF_INJECTIVITY_CONTINUOUS",BOREL_DOMAIN_OF_INJECTIVITY_CONTINUOUS; "BOREL_DOMAIN_OF_INJECTIVITY_CONTINUOUS_GEN",BOREL_DOMAIN_OF_INJECTIVITY_CONTINUOUS_GEN; "BOREL_EMPTY",BOREL_EMPTY; +"BOREL_FROM_SUBTOPOLOGY",BOREL_FROM_SUBTOPOLOGY; "BOREL_IMP_ANALYTIC",BOREL_IMP_ANALYTIC; "BOREL_IMP_LEBESGUE_MEASURABLE",BOREL_IMP_LEBESGUE_MEASURABLE; "BOREL_INDUCT_CLOSED_UNIONS_INTERS",BOREL_INDUCT_CLOSED_UNIONS_INTERS; @@ -1201,6 +1206,24 @@ theorems := "BOREL_INDUCT_UNIONS_INTERS",BOREL_INDUCT_UNIONS_INTERS; "BOREL_INTER",BOREL_INTER; "BOREL_INTERS",BOREL_INTERS; +"BOREL_IN_COMPLEMENT",BOREL_IN_COMPLEMENT; +"BOREL_IN_COMPLEMENT_EQ",BOREL_IN_COMPLEMENT_EQ; +"BOREL_IN_CONTINUOUS_MAP_PREIMAGE",BOREL_IN_CONTINUOUS_MAP_PREIMAGE; +"BOREL_IN_DIFF",BOREL_IN_DIFF; +"BOREL_IN_EMPTY",BOREL_IN_EMPTY; +"BOREL_IN_EUCLIDEAN",BOREL_IN_EUCLIDEAN; +"BOREL_IN_HOMEOMORPHIC_MAPS_IMAGE_EQ",BOREL_IN_HOMEOMORPHIC_MAPS_IMAGE_EQ; +"BOREL_IN_HOMEOMORPHIC_MAP_IMAGE",BOREL_IN_HOMEOMORPHIC_MAP_IMAGE; +"BOREL_IN_HOMEOMORPHIC_MAP_IMAGE_EQ",BOREL_IN_HOMEOMORPHIC_MAP_IMAGE_EQ; +"BOREL_IN_INTER",BOREL_IN_INTER; +"BOREL_IN_INTERS",BOREL_IN_INTERS; +"BOREL_IN_INTER_SUBTOPOLOGY",BOREL_IN_INTER_SUBTOPOLOGY; +"BOREL_IN_SUBSET_TOPSPACE",BOREL_IN_SUBSET_TOPSPACE; +"BOREL_IN_SUBTOPOLOGY",BOREL_IN_SUBTOPOLOGY; +"BOREL_IN_SUBTOPOLOGY_EQ",BOREL_IN_SUBTOPOLOGY_EQ; +"BOREL_IN_TOPSPACE",BOREL_IN_TOPSPACE; +"BOREL_IN_UNION",BOREL_IN_UNION; +"BOREL_IN_UNIONS",BOREL_IN_UNIONS; "BOREL_LINEAR_IMAGE",BOREL_LINEAR_IMAGE; "BOREL_MEASURABLE_ADD",BOREL_MEASURABLE_ADD; "BOREL_MEASURABLE_BILINEAR",BOREL_MEASURABLE_BILINEAR; @@ -1214,6 +1237,18 @@ theorems := "BOREL_MEASURABLE_EXTENSION",BOREL_MEASURABLE_EXTENSION; "BOREL_MEASURABLE_IMP_MEASURABLE_ON",BOREL_MEASURABLE_IMP_MEASURABLE_ON; "BOREL_MEASURABLE_INDICATOR",BOREL_MEASURABLE_INDICATOR; +"BOREL_MEASURABLE_MAP_CLOSED_IN",BOREL_MEASURABLE_MAP_CLOSED_IN; +"BOREL_MEASURABLE_MAP_COMPOSE",BOREL_MEASURABLE_MAP_COMPOSE; +"BOREL_MEASURABLE_MAP_CONST",BOREL_MEASURABLE_MAP_CONST; +"BOREL_MEASURABLE_MAP_EQ",BOREL_MEASURABLE_MAP_EQ; +"BOREL_MEASURABLE_MAP_EUCLIDEAN",BOREL_MEASURABLE_MAP_EUCLIDEAN; +"BOREL_MEASURABLE_MAP_EUCLIDEAN_SUBTOPOLOGY",BOREL_MEASURABLE_MAP_EUCLIDEAN_SUBTOPOLOGY; +"BOREL_MEASURABLE_MAP_FROM_SUBTOPOLOGY",BOREL_MEASURABLE_MAP_FROM_SUBTOPOLOGY; +"BOREL_MEASURABLE_MAP_ID",BOREL_MEASURABLE_MAP_ID; +"BOREL_MEASURABLE_MAP_IMAGE_SUBSET_TOPSPACE",BOREL_MEASURABLE_MAP_IMAGE_SUBSET_TOPSPACE; +"BOREL_MEASURABLE_MAP_INTO_SUBTOPOLOGY",BOREL_MEASURABLE_MAP_INTO_SUBTOPOLOGY; +"BOREL_MEASURABLE_MAP_LIMIT",BOREL_MEASURABLE_MAP_LIMIT; +"BOREL_MEASURABLE_MAP_OPEN_IN",BOREL_MEASURABLE_MAP_OPEN_IN; "BOREL_MEASURABLE_MAX",BOREL_MEASURABLE_MAX; "BOREL_MEASURABLE_MIN",BOREL_MEASURABLE_MIN; "BOREL_MEASURABLE_MUL",BOREL_MEASURABLE_MUL; @@ -1674,6 +1709,9 @@ theorems := "CARD_LET_TOTAL",CARD_LET_TOTAL; "CARD_LET_TRANS",CARD_LET_TRANS; "CARD_LE_1",CARD_LE_1; +"CARD_LE_2",CARD_LE_2; +"CARD_LE_3",CARD_LE_3; +"CARD_LE_4",CARD_LE_4; "CARD_LE_ADD",CARD_LE_ADD; "CARD_LE_ADDL",CARD_LE_ADDL; "CARD_LE_ADDR",CARD_LE_ADDR; @@ -2176,6 +2214,7 @@ theorems := "CLOSED_IMP_ANALYTIC",CLOSED_IMP_ANALYTIC; "CLOSED_IMP_BAIRE1_INDICATOR",CLOSED_IMP_BAIRE1_INDICATOR; "CLOSED_IMP_BOREL",CLOSED_IMP_BOREL; +"CLOSED_IMP_BOREL_IN",CLOSED_IMP_BOREL_IN; "CLOSED_IMP_FIP",CLOSED_IMP_FIP; "CLOSED_IMP_FIP_COMPACT",CLOSED_IMP_FIP_COMPACT; "CLOSED_IMP_FSIGMA",CLOSED_IMP_FSIGMA; @@ -2288,6 +2327,7 @@ theorems := "CLOSED_IN_SUBSET_TRANS",CLOSED_IN_SUBSET_TRANS; "CLOSED_IN_SUBTOPOLOGY",CLOSED_IN_SUBTOPOLOGY; "CLOSED_IN_SUBTOPOLOGY_ALT",CLOSED_IN_SUBTOPOLOGY_ALT; +"CLOSED_IN_SUBTOPOLOGY_BOREL_IN",CLOSED_IN_SUBTOPOLOGY_BOREL_IN; "CLOSED_IN_SUBTOPOLOGY_DIFF_OPEN",CLOSED_IN_SUBTOPOLOGY_DIFF_OPEN; "CLOSED_IN_SUBTOPOLOGY_EMPTY",CLOSED_IN_SUBTOPOLOGY_EMPTY; "CLOSED_IN_SUBTOPOLOGY_INTER_CLOSED",CLOSED_IN_SUBTOPOLOGY_INTER_CLOSED; @@ -2656,6 +2696,7 @@ theorems := "COLUMN_TRANSP",COLUMN_TRANSP; "COMMA_DEF",COMMA_DEF; "COMMON_FRONTIER_DOMAINS",COMMON_FRONTIER_DOMAINS; +"COMMUTATOR_IMP_ABELIAN_QUOTIENT",COMMUTATOR_IMP_ABELIAN_QUOTIENT; "COMMUTING_MATRIX_INV_COVARIANCE",COMMUTING_MATRIX_INV_COVARIANCE; "COMMUTING_MATRIX_INV_NORMAL",COMMUTING_MATRIX_INV_NORMAL; "COMMUTING_WITH_DIAGONAL_MATRIX",COMMUTING_WITH_DIAGONAL_MATRIX; @@ -3766,6 +3807,7 @@ theorems := "CONTINUOUS_IMAGE_NESTED_INTERS_GEN",CONTINUOUS_IMAGE_NESTED_INTERS_GEN; "CONTINUOUS_IMAGE_SUBSET_INTERIOR",CONTINUOUS_IMAGE_SUBSET_INTERIOR; "CONTINUOUS_IMAGE_SUBSET_RELATIVE_INTERIOR",CONTINUOUS_IMAGE_SUBSET_RELATIVE_INTERIOR; +"CONTINUOUS_IMP_BOREL_MEASURABLE_MAP",CONTINUOUS_IMP_BOREL_MEASURABLE_MAP; "CONTINUOUS_IMP_BOREL_MEASURABLE_ON",CONTINUOUS_IMP_BOREL_MEASURABLE_ON; "CONTINUOUS_IMP_CAUCHY_CONTINUOUS_MAP",CONTINUOUS_IMP_CAUCHY_CONTINUOUS_MAP; "CONTINUOUS_IMP_CLOSED_MAP",CONTINUOUS_IMP_CLOSED_MAP; @@ -6943,6 +6985,7 @@ theorems := "FSIGMA_GDELTA_GEN",FSIGMA_GDELTA_GEN; "FSIGMA_IMP_ANALYTIC",FSIGMA_IMP_ANALYTIC; "FSIGMA_IMP_BOREL",FSIGMA_IMP_BOREL; +"FSIGMA_IMP_BOREL_IN",FSIGMA_IMP_BOREL_IN; "FSIGMA_IMP_LEBESGUE_MEASURABLE",FSIGMA_IMP_LEBESGUE_MEASURABLE; "FSIGMA_INTER",FSIGMA_INTER; "FSIGMA_INTERS",FSIGMA_INTERS; @@ -7116,6 +7159,7 @@ theorems := "GDELTA_HOMEOMORPHIC_SPACE_CLOSED_IN_PRODUCT",GDELTA_HOMEOMORPHIC_SPACE_CLOSED_IN_PRODUCT; "GDELTA_IMP_ANALYTIC",GDELTA_IMP_ANALYTIC; "GDELTA_IMP_BOREL",GDELTA_IMP_BOREL; +"GDELTA_IMP_BOREL_IN",GDELTA_IMP_BOREL_IN; "GDELTA_IMP_LEBESGUE_MEASURABLE",GDELTA_IMP_LEBESGUE_MEASURABLE; "GDELTA_INTER",GDELTA_INTER; "GDELTA_INTERS",GDELTA_INTERS; @@ -10604,6 +10648,7 @@ theorems := "INVERSE_LIPSCHITZ_CONVEX_SPHERICAL_PROJECTION",INVERSE_LIPSCHITZ_CONVEX_SPHERICAL_PROJECTION; "INVERSE_LIPSCHITZ_CONVEX_SPHERICAL_PROJECTION_EXPLICIT",INVERSE_LIPSCHITZ_CONVEX_SPHERICAL_PROJECTION_EXPLICIT; "INVERSE_SWAP",INVERSE_SWAP; +"INVERSE_UNIQUE_ALT",INVERSE_UNIQUE_ALT; "INVERSE_UNIQUE_o",INVERSE_UNIQUE_o; "INVERTIBLE_CMUL",INVERTIBLE_CMUL; "INVERTIBLE_COFACTOR",INVERTIBLE_COFACTOR; @@ -10628,6 +10673,8 @@ theorems := "INVOLUTION_EVEN_NOFIXPOINTS",INVOLUTION_EVEN_NOFIXPOINTS; "INVOLUTION_IMP_HOMEOMORPHISM",INVOLUTION_IMP_HOMEOMORPHISM; "INVOLUTION_IMP_HOMEOMORPHISM_GEN",INVOLUTION_IMP_HOMEOMORPHISM_GEN; +"INVOLUTION_MOVES_2_IS_SWAP",INVOLUTION_MOVES_2_IS_SWAP; +"INVOLUTION_SIZE_2_IS_SWAP",INVOLUTION_SIZE_2_IS_SWAP; "IN_AFFINE_ADD_MUL",IN_AFFINE_ADD_MUL; "IN_AFFINE_ADD_MUL_DIFF",IN_AFFINE_ADD_MUL_DIFF; "IN_AFFINE_HULL_LINEAR_IMAGE",IN_AFFINE_HULL_LINEAR_IMAGE; @@ -10870,6 +10917,7 @@ theorems := "ISOMORPHIC_GROUP_RELATIVE_HOMOLOGY_BY_SING",ISOMORPHIC_GROUP_RELATIVE_HOMOLOGY_BY_SING; "ISOMORPHIC_GROUP_RELATIVE_HOMOLOGY_OF_CONTRACTIBLE",ISOMORPHIC_GROUP_RELATIVE_HOMOLOGY_OF_CONTRACTIBLE; "ISOMORPHIC_GROUP_SINGLETON_GROUP",ISOMORPHIC_GROUP_SINGLETON_GROUP; +"ISOMORPHIC_GROUP_SOLVABILITY",ISOMORPHIC_GROUP_SOLVABILITY; "ISOMORPHIC_GROUP_SUM_GROUP",ISOMORPHIC_GROUP_SUM_GROUP; "ISOMORPHIC_GROUP_SYM",ISOMORPHIC_GROUP_SYM; "ISOMORPHIC_GROUP_TORSION",ISOMORPHIC_GROUP_TORSION; @@ -14042,6 +14090,7 @@ theorems := "OPEN_IMP_ANR",OPEN_IMP_ANR; "OPEN_IMP_BAIRE1_INDICATOR",OPEN_IMP_BAIRE1_INDICATOR; "OPEN_IMP_BOREL",OPEN_IMP_BOREL; +"OPEN_IMP_BOREL_IN",OPEN_IMP_BOREL_IN; "OPEN_IMP_ENR",OPEN_IMP_ENR; "OPEN_IMP_FSIGMA",OPEN_IMP_FSIGMA; "OPEN_IMP_FSIGMA_IN",OPEN_IMP_FSIGMA_IN; @@ -14158,6 +14207,7 @@ theorems := "OPEN_IN_SUBSET_TRANS",OPEN_IN_SUBSET_TRANS; "OPEN_IN_SUBTOPOLOGY",OPEN_IN_SUBTOPOLOGY; "OPEN_IN_SUBTOPOLOGY_ALT",OPEN_IN_SUBTOPOLOGY_ALT; +"OPEN_IN_SUBTOPOLOGY_BOREL_IN",OPEN_IN_SUBTOPOLOGY_BOREL_IN; "OPEN_IN_SUBTOPOLOGY_DIFF_CLOSED",OPEN_IN_SUBTOPOLOGY_DIFF_CLOSED; "OPEN_IN_SUBTOPOLOGY_EMPTY",OPEN_IN_SUBTOPOLOGY_EMPTY; "OPEN_IN_SUBTOPOLOGY_INTER_OPEN",OPEN_IN_SUBTOPOLOGY_INTER_OPEN; @@ -14976,6 +15026,7 @@ theorems := "PERMUTES_SUPERSET",PERMUTES_SUPERSET; "PERMUTES_SURJECTIVE",PERMUTES_SURJECTIVE; "PERMUTES_SWAP",PERMUTES_SWAP; +"PERMUTES_THREE_CYCLE",PERMUTES_THREE_CYCLE; "PERMUTES_TRANSFER",PERMUTES_TRANSFER; "PERMUTES_TRANSFER_BIJECTIONS",PERMUTES_TRANSFER_BIJECTIONS; "PERMUTES_UNIV",PERMUTES_UNIV; @@ -17348,6 +17399,11 @@ theorems := "RESTRICTION_UNIQUE",RESTRICTION_UNIQUE; "RESTRICTION_UNIQUE_ALT",RESTRICTION_UNIQUE_ALT; "RESTRICTION_UNIV",RESTRICTION_UNIV; +"RESTRICT_COMPOSE",RESTRICT_COMPOSE; +"RESTRICT_I",RESTRICT_I; +"RESTRICT_INVERSE",RESTRICT_INVERSE; +"RESTRICT_PERMUTES_SUBSET",RESTRICT_PERMUTES_SUBSET; +"RESTRICT_SWAP",RESTRICT_SWAP; "RETRACTION",RETRACTION; "RETRACTION_ARC",RETRACTION_ARC; "RETRACTION_CLOSEST_POINT",RETRACTION_CLOSEST_POINT; @@ -18281,6 +18337,13 @@ theorems := "SNDCART_VEC",SNDCART_VEC; "SNDCART_VSUM",SNDCART_VSUM; "SND_DEF",SND_DEF; +"SOLVABLE_GROUP_ALT",SOLVABLE_GROUP_ALT; +"SOLVABLE_GROUP_EPIMORPHIC_IMAGE",SOLVABLE_GROUP_EPIMORPHIC_IMAGE; +"SOLVABLE_GROUP_MONOMORPHIC_PREIMAGE",SOLVABLE_GROUP_MONOMORPHIC_PREIMAGE; +"SOLVABLE_GROUP_NORMAL_EXTENSION",SOLVABLE_GROUP_NORMAL_EXTENSION; +"SOLVABLE_GROUP_QUOTIENT",SOLVABLE_GROUP_QUOTIENT; +"SOLVABLE_GROUP_SOLVABLE_QUOTIENT",SOLVABLE_GROUP_SOLVABLE_QUOTIENT; +"SOLVABLE_GROUP_SUBGROUP",SOLVABLE_GROUP_SUBGROUP; "SPANNING_SUBSET_INDEPENDENT",SPANNING_SUBSET_INDEPENDENT; "SPANNING_SURJECTIVE_IMAGE",SPANNING_SURJECTIVE_IMAGE; "SPANS_IMAGE",SPANS_IMAGE; @@ -18970,14 +19033,20 @@ theorems := "SWAPSEQ_SWAP",SWAPSEQ_SWAP; "SWAP_COMMON",SWAP_COMMON; "SWAP_COMMON'",SWAP_COMMON'; +"SWAP_CONJUGATE",SWAP_CONJUGATE; "SWAP_EXISTS_THM",SWAP_EXISTS_THM; "SWAP_FORALL_THM",SWAP_FORALL_THM; "SWAP_GALOIS",SWAP_GALOIS; "SWAP_GENERAL",SWAP_GENERAL; "SWAP_IDEMPOTENT",SWAP_IDEMPOTENT; "SWAP_INDEPENDENT",SWAP_INDEPENDENT; +"SWAP_LEFT",SWAP_LEFT; +"SWAP_OTHER",SWAP_OTHER; "SWAP_REFL",SWAP_REFL; +"SWAP_RIGHT",SWAP_RIGHT; "SWAP_SYM",SWAP_SYM; +"SWAP_TRIPLE",SWAP_TRIPLE; +"SWAP_TRIPLE_ALT",SWAP_TRIPLE_ALT; "SYLOW_THEOREM",SYLOW_THEOREM; "SYLOW_THEOREM_CONJUGATE",SYLOW_THEOREM_CONJUGATE; "SYLOW_THEOREM_CONJUGATE_ALT",SYLOW_THEOREM_CONJUGATE_ALT; @@ -19124,6 +19193,11 @@ theorems := "THIN_FRONTIER_OF_ICI",THIN_FRONTIER_OF_ICI; "THIN_FRONTIER_OF_SUBSET",THIN_FRONTIER_OF_SUBSET; "THIN_FRONTIER_SUBSET",THIN_FRONTIER_SUBSET; +"THREE_CYCLE_AS_COMMUTATOR",THREE_CYCLE_AS_COMMUTATOR; +"THREE_CYCLE_COMMUTATOR",THREE_CYCLE_COMMUTATOR; +"THREE_CYCLE_COMPOSE_REVERSE",THREE_CYCLE_COMPOSE_REVERSE; +"THREE_CYCLE_INVERSE",THREE_CYCLE_INVERSE; +"THREE_CYCLE_NOT_I",THREE_CYCLE_NOT_I; "TIETZE",TIETZE; "TIETZE_CLOSED_INTERVAL",TIETZE_CLOSED_INTERVAL; "TIETZE_CLOSED_INTERVAL_1",TIETZE_CLOSED_INTERVAL_1; @@ -19337,6 +19411,7 @@ theorems := "TRIVIAL_IMP_CYCLIC_GROUP",TRIVIAL_IMP_CYCLIC_GROUP; "TRIVIAL_IMP_FINITELY_GENERATED_GROUP",TRIVIAL_IMP_FINITELY_GENERATED_GROUP; "TRIVIAL_IMP_FINITE_GROUP",TRIVIAL_IMP_FINITE_GROUP; +"TRIVIAL_IMP_SOLVABLE_GROUP",TRIVIAL_IMP_SOLVABLE_GROUP; "TRIVIAL_INTEGER_MOD_GROUP",TRIVIAL_INTEGER_MOD_GROUP; "TRIVIAL_LIMIT_AT",TRIVIAL_LIMIT_AT; "TRIVIAL_LIMIT_ATPOINTOF",TRIVIAL_LIMIT_ATPOINTOF; @@ -20105,9 +20180,13 @@ theorems := "borel_CASES",borel_CASES; "borel_INDUCT",borel_INDUCT; "borel_RULES",borel_RULES; +"borel_in_CASES",borel_in_CASES; +"borel_in_INDUCT",borel_in_INDUCT; +"borel_in_RULES",borel_in_RULES; "borel_measurable_CASES",borel_measurable_CASES; "borel_measurable_INDUCT",borel_measurable_INDUCT; "borel_measurable_RULES",borel_measurable_RULES; +"borel_measurable_map",borel_measurable_map; "borsukian",borsukian; "bounded",bounded; "brouwer_degree",brouwer_degree; @@ -20783,6 +20862,7 @@ theorems := "singular_subdivision",singular_subdivision; "slice",slice; "sndcart",sndcart; +"solvable_group",solvable_group; "span",span; "sphere",sphere; "sqrt",sqrt; @@ -20827,6 +20907,7 @@ theorems := "tendsto",tendsto; "tendsto_real",tendsto_real; "tendsto_real_def",tendsto_real_def; +"three_cycle",three_cycle; "topcontinuous_at",topcontinuous_at; "topology_tybij",topology_tybij; "topology_tybij_th",topology_tybij_th; diff --git a/Multivariate/lpspaces.ml b/Multivariate/lpspaces.ml index e394ab7e..02008ad4 100644 --- a/Multivariate/lpspaces.ml +++ b/Multivariate/lpspaces.ml @@ -617,6 +617,352 @@ let HOELDER_BOUND = prove ASM_SIMP_TAC[MEASURE_POS_LE; RPOW_POS_LE] THEN REWRITE_TAC[NORM_1; REAL_ABS_LE]]);; +(* ========================================================================= *) +(* The complex L^2 inner product (f|g) = INT f cnj(g) on an arbitrary set. *) +(* A companion to lspace / lnorm above (which are real-valued): for complex- *) +(* valued functions this is the natural sesquilinear pairing, with Cauchy- *) +(* Schwarz obtained from HOELDER_INEQUALITY at p = q = 2. *) +(* ========================================================================= *) + +let lproduct = new_definition + `lproduct (s:real^N->bool) (f:real^N->complex) (g:real^N->complex) = + integral s (\x. f x * cnj(g x))`;; + +(* ------------------------------------------------------------------------- *) +(* Conjugate symmetry: (f|g) = cnj(g|f) (integrand assumed integrable). *) +(* ------------------------------------------------------------------------- *) + +let LPRODUCT_SYM = prove + (`!s (f:real^N->complex) g. + (\x. f x * cnj(g x)) integrable_on s + ==> lproduct s f g = cnj(lproduct s g f)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[lproduct] THEN + SUBGOAL_THEN `(\x. (g:real^N->complex) x * cnj(f x)) = (\x. cnj(f x * cnj(g x)))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; CNJ_MUL; CNJ_CNJ] THEN REWRITE_TAC[COMPLEX_MUL_SYM]; + ALL_TAC] THEN + MP_TAC(ISPECL [`\x. (f:real^N->complex) x * cnj(g x)`; `s:real^N->bool`; `cnj`] + INTEGRAL_LINEAR) THEN + ASM_REWRITE_TAC[LINEAR_CNJ; o_DEF] THEN + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[CNJ_CNJ]);; + +(* ------------------------------------------------------------------------- *) +(* Cx(drop .) commutes with the integral of a real^1-valued integrand. *) +(* (Reusable bridge: real-valued integral -> its complex embedding.) *) +(* ------------------------------------------------------------------------- *) + +let CXDROP_LINEAR = prove + (`linear (\y:real^1. Cx(drop y))`, + REWRITE_TAC[linear; DROP_ADD; DROP_CMUL; COMPLEX_CMUL; CX_ADD; CX_MUL] THEN + CONV_TAC COMPLEX_RING);; + +let CX_DROP_INTEGRAL = prove + (`!s (gg:real^N->real^1). gg integrable_on s + ==> integral s (\x. Cx(drop(gg x))) = Cx(drop(integral s gg))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`gg:real^N->real^1`; `s:real^N->bool`; `\y:real^1. Cx(drop y)`] + INTEGRAL_LINEAR) THEN + ASM_REWRITE_TAC[CXDROP_LINEAR; o_DEF]);; + +(* ------------------------------------------------------------------------- *) +(* Self inner product: (f|f) = Cx(INT |f|^2) (real, nonneg). *) +(* ------------------------------------------------------------------------- *) + +let LPRODUCT_SELF = prove + (`!s (f:real^N->complex). + (\x. lift(norm(f x) pow 2)) integrable_on s + ==> lproduct s f f = Cx(drop(integral s (\x. lift(norm(f x) pow 2))))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[lproduct] THEN + SUBGOAL_THEN `(\x. (f:real^N->complex) x * cnj(f x)) = + (\x. Cx(drop(lift(norm(f x) pow 2))))` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; LIFT_DROP; COMPLEX_MUL_CNJ; CX_POW]; ALL_TAC] THEN + ASM_SIMP_TAC[CX_DROP_INTEGRAL]);; + +(* Self inner product against the norm: (f|f) = Cx(||f||_2^2). The bridge *) +(* tying lproduct to lnorm (via LNORM_RPOW), specialised to p = 2. *) +let LPRODUCT_SELF_LNORM = prove + (`!s (f:real^N->complex). f IN lspace s (&2) + ==> lproduct s f f = Cx((lnorm s (&2) f) pow 2)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(\x. lift(norm((f:real^N->complex) x) pow 2)) integrable_on s` + ASSUME_TAC THENL + [FIRST_ASSUM(MP_TAC o REWRITE_RULE[lspace; IN_ELIM_THM]) THEN + SIMP_TAC[RPOW_POW]; ALL_TAC] THEN + ASM_SIMP_TAC[LPRODUCT_SELF] THEN AP_TERM_TAC THEN + MP_TAC(ISPECL [`s:real^N->bool`; `&2`; `f:real^N->complex`] LNORM_RPOW) THEN + ASM_REWRITE_TAC[REAL_ARITH `~(&2 = &0)`] THEN + REWRITE_TAC[RPOW_POW] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REFL_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Complex Cauchy-Schwarz: |(f|g)| <= ||f||_2 ||g||_2 (f,g in L^2). *) +(* Chains through the real-valued HOELDER_INEQUALITY (p=q=2) above via *) +(* norm(INT .) <= INT norm(.) and norm(f cnj g) = ||f|| ||g||. *) +(* ------------------------------------------------------------------------- *) + +let LPRODUCT_CAUCHY_SCHWARZ = prove + (`!s (f:real^N->complex) g. + f IN lspace s (&2) /\ g IN lspace s (&2) /\ + (\x. f x * cnj(g x)) integrable_on s + ==> norm(lproduct s f g) <= lnorm s (&2) f * lnorm s (&2) g`, + REPEAT STRIP_TAC THEN REWRITE_TAC[lproduct] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `drop(integral s + (\x. lift(norm((f:real^N->complex) x) * norm((g:real^N->complex) x))))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC INTEGRAL_NORM_BOUND_INTEGRAL THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MP_TAC(ISPECL + [`s:real^N->bool`; `&2`; `&2`; + `f:real^N->complex`; `g:real^N->complex`] + LSPACE_INTEGRABLE_PRODUCT) THEN ASM_REWRITE_TAC[] THEN + CONV_TAC REAL_RAT_REDUCE_CONV; + GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[LIFT_DROP; COMPLEX_NORM_MUL; COMPLEX_NORM_CNJ; REAL_LE_REFL]]; + MP_TAC(ISPECL + [`s:real^N->bool`; `&2`; `&2`; + `f:real^N->complex`; `g:real^N->complex`] + HOELDER_INEQUALITY) THEN + ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV]);; + +(* ------------------------------------------------------------------------- *) +(* Right-conjugate-linearity of the pairing: scaling the second argument *) +(* by a complex constant pulls out its conjugate; summing the second *) +(* argument over a finite family distributes. *) +(* ------------------------------------------------------------------------- *) + +let LPRODUCT_RMUL = prove + (`!s (f:real^N->complex) (h:real^N->complex) c. + (\x. f x * cnj(h x)) integrable_on s + ==> lproduct s f (\x. c * h x) = cnj c * lproduct s f h`, + REPEAT STRIP_TAC THEN REWRITE_TAC[lproduct] THEN + SUBGOAL_THEN `(\x. (f:real^N->complex) x * cnj(c * h x)) = + (\x. cnj c * (f x * cnj(h x)))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; CNJ_MUL] THEN CONV_TAC COMPLEX_RING; ALL_TAC] THEN + ASM_SIMP_TAC[INTEGRAL_COMPLEX_LMUL]);; + +let LPRODUCT_RSUM = prove + (`!s (f:real^N->complex) (g:A->real^N->complex) k. + FINITE k /\ (!i. i IN k ==> (\x. f x * cnj(g i x)) integrable_on s) + ==> lproduct s f (\x. vsum k (\i. g i x)) = + vsum k (\i. lproduct s f (g i))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[lproduct] THEN + SUBGOAL_THEN + `(\x. (f:real^N->complex) x * cnj(vsum k (\i. (g:A->real^N->complex) i x))) = + (\x. vsum k (\i. f x * cnj(g i x)))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:real^N` THEN + ASM_SIMP_TAC[CNJ_VSUM; GSYM VSUM_COMPLEX_LMUL]; ALL_TAC] THEN + MP_TAC(BETA_RULE(ISPECL + [`\(i:A) (x:real^N). (f:real^N->complex) x * cnj(g i x)`; + `s:real^N->bool`; `k:A->bool`] INTEGRAL_VSUM)) THEN + ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Left-linearity (first argument), the duals of LPRODUCT_RMUL/RSUM. All *) +(* four together give full sesquilinearity. *) +(* ------------------------------------------------------------------------- *) + +let LPRODUCT_LMUL = prove + (`!s (f:real^N->complex) (g:real^N->complex) c. + (\x. f x * cnj(g x)) integrable_on s + ==> lproduct s (\x. c * f x) g = c * lproduct s f g`, + REPEAT STRIP_TAC THEN REWRITE_TAC[lproduct] THEN + SUBGOAL_THEN `(\x. (c * (f:real^N->complex) x) * cnj(g x)) = + (\x. c * (f x * cnj(g x)))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN CONV_TAC COMPLEX_RING; ALL_TAC] THEN + ASM_SIMP_TAC[INTEGRAL_COMPLEX_LMUL]);; + +let LPRODUCT_LSUM = prove + (`!s (g:A->real^N->complex) (h:real^N->complex) k. + FINITE k /\ (!i. i IN k ==> (\x. g i x * cnj(h x)) integrable_on s) + ==> lproduct s (\x. vsum k (\i. g i x)) h = + vsum k (\i. lproduct s (g i) h)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[lproduct] THEN + SUBGOAL_THEN + `(\x. vsum k (\i. (g:A->real^N->complex) i x) * cnj(h x)) = + (\x. vsum k (\i. g i x * cnj(h x)))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:real^N` THEN + ASM_SIMP_TAC[GSYM VSUM_COMPLEX_RMUL]; ALL_TAC] THEN + MP_TAC(BETA_RULE(ISPECL + [`\(i:A) (x:real^N). (g:A->real^N->complex) i x * cnj(h x)`; + `s:real^N->bool`; `k:A->bool`] INTEGRAL_VSUM)) THEN + ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* L^p is closed under complex-scalar multiplication and under conjugation; *) +(* conjugation preserves measurability (on any set, via the zero-extension *) +(* bridge MEASURABLE_ON_UNIV); and the product f cnj(g) of two L^2 functions *) +(* is integrable. *) +(* ------------------------------------------------------------------------- *) + +let LSPACE_COMPLEX_LMUL = prove + (`!(h:real^N->complex) (c:complex) p. + h IN lspace (:real^N) p ==> (\x. c * h x) IN lspace (:real^N) p`, + REPEAT GEN_TAC THEN REWRITE_TAC[lspace; IN_ELIM_THM] THEN STRIP_TAC THEN + CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_ON_COMPLEX_MUL THEN + ASM_REWRITE_TAC[MEASURABLE_ON_CONST]; ALL_TAC] THEN + SUBGOAL_THEN + `(\x. lift(norm((c:complex) * h x) rpow p)) = + (\x. (norm c rpow p) % lift(norm((h:real^N->complex) x) rpow p))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; COMPLEX_NORM_MUL; RPOW_MUL; LIFT_CMUL]; ALL_TAC] THEN + MATCH_MP_TAC INTEGRABLE_CMUL THEN ASM_REWRITE_TAC[]);; + +(* Conjugation preserves measurability on an ARBITRARY set s (not just the *) +(* whole space): reduce to the zero-extension via MEASURABLE_ON_UNIV, using *) +(* cnj(vec 0) = vec 0, then apply whole-space conjugation-measurability. *) +let MEASURABLE_ON_CNJ = prove + (`!(g:real^N->complex) s. g measurable_on s + ==> (\x. cnj(g x)) measurable_on s`, + REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[GSYM MEASURABLE_ON_UNIV] THEN REWRITE_TAC[] THEN + SUBGOAL_THEN + `(\x. if x IN s then cnj((g:real^N->complex) x) else vec 0) = + cnj o (\x. if x IN s then g x else vec 0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; o_THM] THEN GEN_TAC THEN COND_CASES_TAC THEN + REWRITE_TAC[COMPLEX_VEC_0; CNJ_CX]; ALL_TAC] THEN + MATCH_MP_TAC MEASURABLE_ON_COMPOSE_CONTINUOUS THEN + ASM_REWRITE_TAC[MEASURABLE_ON_UNIV] THEN + MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN REWRITE_TAC[LINEAR_CNJ]);; + +let L2_CNJ_PRODUCT_INTEGRABLE = prove + (`!s (f:real^N->complex) (g:real^N->complex). + f IN lspace s (&2) /\ g IN lspace s (&2) + ==> (\x. f x * cnj(g x)) integrable_on s`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC ABSOLUTELY_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_ABSOLUTELY_INTEGRABLE THEN + EXISTS_TAC + `\x:real^N. lift(norm((f:real^N->complex) x) * norm((g:real^N->complex) x))` THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_ON_COMPLEX_MUL THEN CONJ_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE[lspace; IN_ELIM_THM]) THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC MEASURABLE_ON_CNJ THEN + RULE_ASSUM_TAC(REWRITE_RULE[lspace; IN_ELIM_THM]) THEN ASM_REWRITE_TAC[]]; + MP_TAC(ISPECL + [`s:real^N->bool`; `&2`; `&2`; `f:real^N->complex`; `g:real^N->complex`] + LSPACE_INTEGRABLE_PRODUCT) THEN + ASM_REWRITE_TAC[REAL_ARITH `&0 < &2`; REAL_ARITH `inv(&2)+inv(&2)= &1`]; + GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[LIFT_DROP; COMPLEX_NORM_MUL; COMPLEX_NORM_CNJ; REAL_LE_REFL]]);; + +let LSPACE_CNJ = prove + (`!(f:real^N->complex) s. f IN lspace s (&2) + ==> (\x. cnj(f x)) IN lspace s (&2)`, + REWRITE_TAC[lspace; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[MEASURABLE_ON_CNJ; COMPLEX_NORM_CNJ]);; + +(* ------------------------------------------------------------------------- *) +(* Left-subtractivity of the inner product: - = . *) +(* ------------------------------------------------------------------------- *) + +let LPRODUCT_LSUB = prove + (`!(a:real^N->complex) b c (s:real^N->bool). + a IN lspace s (&2) /\ b IN lspace s (&2) /\ c IN lspace s (&2) + ==> lproduct s a c - lproduct s b c = + lproduct s (\x. a x - b x) c`, + REPEAT STRIP_TAC THEN REWRITE_TAC[lproduct] THEN + MP_TAC(ISPECL [`s:real^N->bool`; `a:real^N->complex`; `c:real^N->complex`] + L2_CNJ_PRODUCT_INTEGRABLE) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`s:real^N->bool`; `b:real^N->complex`; `c:real^N->complex`] + L2_CNJ_PRODUCT_INTEGRABLE) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + ASM_SIMP_TAC[GSYM INTEGRAL_SUB] THEN + MATCH_MP_TAC INTEGRAL_EQ THEN X_GEN_TAC `x:real^N` THEN DISCH_TAC THEN + REWRITE_TAC[] THEN SIMPLE_COMPLEX_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Continuity of the inner product under L^2 convergence in the first slot: *) +(* if gn ---> g in L^2 norm (all in L^2) and h is a fixed L^2 function, then *) +(* ---> . The workhorse for extending bilinear identities from *) +(* a dense class to all of L^2. *) +(* ------------------------------------------------------------------------- *) + +let LPRODUCT_L2LIM = prove + (`!(gn:num->real^N->complex) (g:real^N->complex) (h:real^N->complex) + (s:real^N->bool). + (!n. gn n IN lspace s (&2)) /\ g IN lspace s (&2) /\ + h IN lspace s (&2) /\ + (!e. &0 < e ==> ?M. !n. n >= M + ==> lnorm s (&2) (\x. gn n x - g x) < e) + ==> ((\n. lproduct s (gn n) h) --> lproduct s g h) + sequentially`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[LIM_SEQUENTIALLY; dist] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + SUBGOAL_THEN `&0 <= lnorm s (&2) (h:real^N->complex)` ASSUME_TAC THENL + [ASM_SIMP_TAC[LNORM_POS_LE]; ALL_TAC] THEN + SUBGOAL_THEN `&0 < lnorm s (&2) (h:real^N->complex) + &1` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC + `e / (lnorm s (&2) (h:real^N->complex) + &1)`) THEN + ASM_SIMP_TAC[REAL_LT_DIV] THEN + DISCH_THEN(X_CHOOSE_TAC `M:num`) THEN EXISTS_TAC `M:num` THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN + SUBGOAL_THEN + `lproduct s (gn n) h - lproduct s g h = + lproduct s (\x. (gn:num->real^N->complex) n x - g x) h` + SUBST1_TAC THENL + [MATCH_MP_TAC LPRODUCT_LSUB THEN ASM_REWRITE_TAC[ETA_AX]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `lnorm s (&2) (\x. (gn:num->real^N->complex) n x - g x) * + lnorm s (&2) (h:real^N->complex)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC LPRODUCT_CAUCHY_SCHWARZ THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [MATCH_MP_TAC LSPACE_SUB THEN ASM_REWRITE_TAC[REAL_POS; ETA_AX]; + MATCH_MP_TAC L2_CNJ_PRODUCT_INTEGRABLE THEN + ASM_SIMP_TAC[LSPACE_SUB; REAL_POS; ETA_AX]]; + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `lnorm s (&2) (\x. (gn:num->real^N->complex) n x - g x) * + (lnorm s (&2) (h:real^N->complex) + &1)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC LNORM_POS_LE THEN ASM_SIMP_TAC[LSPACE_SUB; REAL_POS; ETA_AX]; + ASM_REAL_ARITH_TAC]; + SUBGOAL_THEN `e = (e / (lnorm s (&2) (h:real^N->complex) + &1)) * + (lnorm s (&2) h + &1)` SUBST1_TAC THENL + [ASM_SIMP_TAC[REAL_DIV_RMUL; REAL_LT_IMP_NZ]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LT_RMUL THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[GE] THEN + ASM_ARITH_TAC]]);; + +(* ------------------------------------------------------------------------- *) +(* Continuity of the inner product in the SECOND slot: mn -> m in L^2 *) +(* (with d a fixed L^2 function) ==> -> . Via conjugate *) +(* symmetry (LPRODUCT_SYM) and first-slot continuity (LPRODUCT_L2LIM). *) +(* ------------------------------------------------------------------------- *) + +let LPRODUCT_L2LIM_RSLOT = prove + (`!(mn:num->real^N->complex) (m:real^N->complex) (d:real^N->complex) + (s:real^N->bool). + (!n. mn n IN lspace s (&2)) /\ m IN lspace s (&2) /\ + d IN lspace s (&2) /\ + (!e. &0 < e ==> ?M. !n. n >= M + ==> lnorm s (&2) (\x. mn n x - m x) < e) + ==> ((\n. lproduct s d (mn n)) --> lproduct s d m) + sequentially`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\n. lproduct s d (mn n)) = + (\n. cnj(lproduct s ((mn:num->real^N->complex) n) d))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `k:num` THEN + MATCH_MP_TAC LPRODUCT_SYM THEN + MATCH_MP_TAC L2_CNJ_PRODUCT_INTEGRABLE THEN ASM_SIMP_TAC[ETA_AX]; + ALL_TAC] THEN + SUBGOAL_THEN + `lproduct s d m = cnj(lproduct s (m:real^N->complex) d)` + SUBST1_TAC THENL + [MATCH_MP_TAC LPRODUCT_SYM THEN + MATCH_MP_TAC L2_CNJ_PRODUCT_INTEGRABLE THEN ASM_SIMP_TAC[ETA_AX]; + ALL_TAC] THEN + REWRITE_TAC[LIM_CNJ] THEN + MATCH_MP_TAC LPRODUCT_L2LIM THEN ASM_REWRITE_TAC[]);; + (* ------------------------------------------------------------------------- *) (* Completeness (Riesz-Fischer). *) (* ------------------------------------------------------------------------- *) diff --git a/Multivariate/metric.ml b/Multivariate/metric.ml index cb7cab48..ace56416 100644 --- a/Multivariate/metric.ml +++ b/Multivariate/metric.ml @@ -11175,6 +11175,399 @@ let GDELTA_IN_GDELTA_SUBTOPOLOGY = prove EQ_TAC THEN STRIP_TAC THEN ASM_SIMP_TAC[INTER_SUBSET; GDELTA_IN_INTER] THEN EXISTS_TAC `t:A->bool` THEN ASM_REWRITE_TAC[] THEN ASM SET_TAC[]);; +(* ------------------------------------------------------------------------- *) +(* Borel sets *) +(* ------------------------------------------------------------------------- *) + +let borel_in_RULES,borel_in_INDUCT,borel_in_CASES = new_inductive_definition + `(!s:A->bool. open_in top s ==> borel_in top s) /\ + (!s:A->bool. borel_in top s ==> borel_in top (topspace top DIFF s)) /\ + (!u:(A->bool)->bool. + COUNTABLE u /\ (!s. s IN u ==> borel_in top s) + ==> borel_in top (UNIONS u))`;; + +let OPEN_IMP_BOREL_IN = prove + (`!top s:A->bool. open_in top s ==> borel_in top s`, + REWRITE_TAC[borel_in_RULES]);; + +let BOREL_IN_COMPLEMENT = prove + (`!top s:A->bool. + borel_in top s ==> borel_in top (topspace top DIFF s)`, + REWRITE_TAC[borel_in_RULES]);; + +let BOREL_IN_COMPLEMENT_EQ = prove + (`!top s:A->bool. + s SUBSET topspace top + ==> (borel_in top (topspace top DIFF s) <=> borel_in top s)`, + MESON_TAC[borel_in_RULES; SET_RULE `s SUBSET u ==> u DIFF (u DIFF s) = s`]);; + +let BOREL_IN_UNIONS = prove + (`!top (u:(A->bool)->bool). + COUNTABLE u /\ (!s. s IN u ==> borel_in top s) + ==> borel_in top (UNIONS u)`, + REWRITE_TAC[borel_in_RULES]);; + +let BOREL_IN_SUBSET_TOPSPACE = prove + (`!top s:A->bool. borel_in top s ==> s SUBSET topspace top`, + GEN_TAC THEN MATCH_MP_TAC borel_in_INDUCT THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[OPEN_IN_SUBSET]; + REPEAT STRIP_TAC THEN SET_TAC[]; + REPEAT STRIP_TAC THEN REWRITE_TAC[UNIONS_SUBSET] THEN ASM_MESON_TAC[]]);; + +let BOREL_IN_TOPSPACE = prove + (`!top:A topology. borel_in top (topspace top)`, + GEN_TAC THEN MATCH_MP_TAC OPEN_IMP_BOREL_IN THEN + REWRITE_TAC[OPEN_IN_TOPSPACE]);; + +let BOREL_IN_EMPTY = prove + (`!top:A topology. borel_in top {}`, + GEN_TAC THEN MATCH_MP_TAC OPEN_IMP_BOREL_IN THEN + REWRITE_TAC[OPEN_IN_EMPTY]);; + +let BOREL_IN_INTERS = prove + (`!top (u:(A->bool)->bool). + COUNTABLE u /\ ~(u = {}) /\ (!s. s IN u ==> borel_in top s) + ==> borel_in top (INTERS u)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `INTERS u:A->bool = + topspace top DIFF UNIONS (IMAGE (\s. topspace top DIFF s) u)` + SUBST1_TAC THENL + [SUBGOAL_THEN `!s:A->bool. s IN u ==> s SUBSET topspace top` MP_TAC THENL + [ASM_MESON_TAC[BOREL_IN_SUBSET_TOPSPACE]; ASM SET_TAC[]]; + MATCH_MP_TAC BOREL_IN_COMPLEMENT THEN MATCH_MP_TAC BOREL_IN_UNIONS THEN + ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN + ASM_MESON_TAC[borel_in_RULES]]);; + +let BOREL_IN_UNION = prove + (`!top s t:A->bool. + borel_in top s /\ borel_in top t ==> borel_in top (s UNION t)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM UNIONS_2] THEN + MATCH_MP_TAC BOREL_IN_UNIONS THEN + ASM_REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY] THEN + ASM_REWRITE_TAC[COUNTABLE_INSERT; COUNTABLE_EMPTY]);; + +let BOREL_IN_INTER = prove + (`!top s t:A->bool. + borel_in top s /\ borel_in top t ==> borel_in top (s INTER t)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM INTERS_2] THEN + MATCH_MP_TAC BOREL_IN_INTERS THEN + ASM_REWRITE_TAC[FORALL_IN_INSERT; NOT_IN_EMPTY; NOT_INSERT_EMPTY] THEN + ASM_REWRITE_TAC[COUNTABLE_INSERT; COUNTABLE_EMPTY]);; + +let BOREL_IN_DIFF = prove + (`!top s t:A->bool. + borel_in top s /\ borel_in top t ==> borel_in top (s DIFF t)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `s DIFF t:A->bool = s INTER (topspace top DIFF t)` + SUBST1_TAC THENL + [MP_TAC(ISPECL[`top:A topology`; `s:A->bool`] BOREL_IN_SUBSET_TOPSPACE) THEN + ASM_REWRITE_TAC[] THEN SET_TAC[]; + ASM_SIMP_TAC[BOREL_IN_INTER; BOREL_IN_COMPLEMENT]]);; + +let CLOSED_IMP_BOREL_IN = prove + (`!top s:A->bool. closed_in top s ==> borel_in top s`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [closed_in]) THEN + STRIP_TAC THEN + SUBGOAL_THEN `s:A->bool = topspace top DIFF (topspace top DIFF s)` + SUBST1_TAC THENL + [ASM SET_TAC[]; ASM_SIMP_TAC[BOREL_IN_COMPLEMENT; OPEN_IMP_BOREL_IN]]);; + +let FSIGMA_IMP_BOREL_IN = prove + (`!top s:A->bool. fsigma_in top s ==> borel_in top s`, + REPEAT GEN_TAC THEN REWRITE_TAC[fsigma_in; UNION_OF] THEN + DISCH_THEN(X_CHOOSE_THEN `u:(A->bool)->bool` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC BOREL_IN_UNIONS THEN ASM_REWRITE_TAC[] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC CLOSED_IMP_BOREL_IN THEN + ASM_MESON_TAC[]);; + +let GDELTA_IMP_BOREL_IN = prove + (`!top s:A->bool. gdelta_in top s ==> borel_in top s`, + MESON_TAC[GDELTA_IN_FSIGMA_IN; FSIGMA_IMP_BOREL_IN; BOREL_IN_COMPLEMENT_EQ]);; + +let OPEN_IN_SUBTOPOLOGY_BOREL_IN = prove + (`!top t s:A->bool. + open_in (subtopology top t) s /\ borel_in top t ==> borel_in top s`, + REPEAT GEN_TAC THEN REWRITE_TAC[OPEN_IN_SUBTOPOLOGY] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC BOREL_IN_INTER THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC OPEN_IMP_BOREL_IN THEN ASM_REWRITE_TAC[]);; + +let CLOSED_IN_SUBTOPOLOGY_BOREL_IN = prove + (`!top t s:A->bool. + closed_in (subtopology top t) s /\ borel_in top t ==> borel_in top s`, + REPEAT GEN_TAC THEN REWRITE_TAC[CLOSED_IN_SUBTOPOLOGY] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC BOREL_IN_INTER THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC CLOSED_IMP_BOREL_IN THEN ASM_REWRITE_TAC[]);; + +let BOREL_IN_SUBTOPOLOGY = prove + (`!top (u:A->bool) s. + borel_in (subtopology top u) s <=> + ?t. borel_in top t /\ s = t INTER u`, + REPEAT GEN_TAC THEN EQ_TAC THENL + [SPEC_TAC(`s:A->bool`,`s:A->bool`); + DISCH_THEN(X_CHOOSE_THEN `t:A->bool` + (CONJUNCTS_THEN2 MP_TAC SUBST1_TAC)) THEN + SPEC_TAC(`t:A->bool`,`t:A->bool`)] THEN + MATCH_MP_TAC borel_in_INDUCT THEN REPEAT CONJ_TAC THENL + [MESON_TAC[OPEN_IN_SUBTOPOLOGY; OPEN_IMP_BOREL_IN]; + X_GEN_TAC `s:A->bool` THEN DISCH_THEN + (X_CHOOSE_THEN `t:A->bool` (CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC)) THEN + EXISTS_TAC `topspace top DIFF t:A->bool` THEN + ASM_SIMP_TAC[BOREL_IN_COMPLEMENT; TOPSPACE_SUBTOPOLOGY] THEN SET_TAC[]; + REWRITE_TAC[FORALL_COUNTABLE_SUBSET_IMAGE; SET_RULE + `(!s. s IN u ==> ?t. P t /\ s = f t) <=> u SUBSET IMAGE f {t | P t}`] THEN + REWRITE_TAC[GSYM(REWRITE_RULE[SIMPLE_IMAGE] INTER_UNIONS)] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN MESON_TAC[BOREL_IN_UNIONS]; + MESON_TAC[OPEN_IN_SUBTOPOLOGY; OPEN_IMP_BOREL_IN]; + X_GEN_TAC `s:A->bool` THEN DISCH_TAC THEN + SUBGOAL_THEN + `(topspace top DIFF s) INTER u:A->bool = + topspace(subtopology top u) DIFF (s INTER u)` + SUBST1_TAC THENL + [REWRITE_TAC[TOPSPACE_SUBTOPOLOGY] THEN SET_TAC[]; + ASM_SIMP_TAC[BOREL_IN_COMPLEMENT]]; + X_GEN_TAC `f:(A->bool)->bool` THEN STRIP_TAC THEN + SUBGOAL_THEN + `UNIONS f INTER u:A->bool = UNIONS (IMAGE (\u'. u' INTER u) f)` + SUBST1_TAC THENL + [REWRITE_TAC[UNIONS_IMAGE; UNIONS_GSPEC] THEN SET_TAC[]; + MATCH_MP_TAC BOREL_IN_UNIONS THEN + ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE]]]);; + +let BOREL_FROM_SUBTOPOLOGY = prove + (`!top (u:A->bool) s. + borel_in (subtopology top u) s /\ borel_in top u ==> borel_in top s`, + MESON_TAC[BOREL_IN_SUBTOPOLOGY; BOREL_IN_INTER]);; + +let BOREL_IN_INTER_SUBTOPOLOGY = prove + (`!top s t:A->bool. + borel_in top t ==> borel_in (subtopology top s) (t INTER s)`, + MESON_TAC[BOREL_IN_SUBTOPOLOGY]);; + +let BOREL_IN_SUBTOPOLOGY_EQ = prove + (`!top u s:A->bool. + borel_in top u + ==> (borel_in (subtopology top u) s <=> borel_in top s /\ s SUBSET u)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[BOREL_IN_SUBTOPOLOGY] THEN EQ_TAC THENL + [ASM_MESON_TAC[BOREL_IN_INTER; INTER_SUBSET]; SET_TAC[]]);; + +let BOREL_IN_CONTINUOUS_MAP_PREIMAGE = prove + (`!top1 top2 (f:A->B) t. + continuous_map (top1,top2) f /\ borel_in top2 t + ==> borel_in top1 {x | x IN topspace top1 /\ f x IN t}`, + REPEAT GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN DISCH_TAC THEN + SPEC_TAC(`t:B->bool`, `t:B->bool`) THEN + MATCH_MP_TAC borel_in_INDUCT THEN REPEAT CONJ_TAC THENL + [X_GEN_TAC `u:B->bool` THEN DISCH_TAC THEN + MATCH_MP_TAC OPEN_IMP_BOREL_IN THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [continuous_map]) THEN + DISCH_THEN(MP_TAC o SPEC `u:B->bool` o CONJUNCT2) THEN + ASM_REWRITE_TAC[]; + X_GEN_TAC `s:B->bool` THEN DISCH_TAC THEN + SUBGOAL_THEN + `{x:A | x IN topspace top1 /\ (f:A->B) x IN topspace top2 DIFF s} = + topspace top1 DIFF {x | x IN topspace top1 /\ f x IN s}` + SUBST1_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [continuous_map]) THEN + DISCH_THEN(MP_TAC o CONJUNCT1) THEN SET_TAC[]; + ASM_SIMP_TAC[BOREL_IN_COMPLEMENT]]; + X_GEN_TAC `u:(B->bool)->bool` THEN STRIP_TAC THEN + SUBGOAL_THEN + `{x:A | x IN topspace top1 /\ (f:A->B) x IN UNIONS u} = + UNIONS (IMAGE (\s. {x | x IN topspace top1 /\ f x IN s}) u)` + SUBST1_TAC THENL + [REWRITE_TAC[UNIONS_IMAGE] THEN SET_TAC[]; + MATCH_MP_TAC BOREL_IN_UNIONS THEN + ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN + ASM_MESON_TAC[]]]);; + +let BOREL_IN_HOMEOMORPHIC_MAP_IMAGE = prove + (`!top top' (f:A->B) s. + homeomorphic_map (top,top') f /\ borel_in top s + ==> borel_in top' (IMAGE f s)`, + REWRITE_TAC[HOMEOMORPHIC_MAP_MAPS; homeomorphic_maps] THEN + REPEAT GEN_TAC THEN REWRITE_TAC[IMP_CONJ; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `g:B->A` THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `s SUBSET topspace(top:A topology)` ASSUME_TAC THENL + [ASM_MESON_TAC[BOREL_IN_SUBSET_TOPSPACE]; ALL_TAC] THEN + SUBGOAL_THEN `IMAGE (f:A->B) s = {y | y IN topspace top' /\ g y IN s}` + SUBST1_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE[continuous_map]) THEN ASM SET_TAC[]; + MATCH_MP_TAC BOREL_IN_CONTINUOUS_MAP_PREIMAGE THEN + EXISTS_TAC `top:A topology` THEN ASM_REWRITE_TAC[]]);; + +let BOREL_IN_HOMEOMORPHIC_MAPS_IMAGE_EQ = prove + (`!top top' (f:A->B) g s. + homeomorphic_maps (top,top') (f,g) /\ s SUBSET topspace top + ==> (borel_in top' (IMAGE f s) <=> borel_in top s)`, + REWRITE_TAC[HOMEOMORPHIC_MAPS_MAP] THEN REPEAT STRIP_TAC THEN + EQ_TAC THENL [DISCH_TAC; ASM_MESON_TAC[BOREL_IN_HOMEOMORPHIC_MAP_IMAGE]] THEN + SUBGOAL_THEN `s = IMAGE (g:B->A) (IMAGE (f:A->B) s)` SUBST1_TAC THENL + [ASM SET_TAC[]; ASM_MESON_TAC[BOREL_IN_HOMEOMORPHIC_MAP_IMAGE]]);; + +let BOREL_IN_HOMEOMORPHIC_MAP_IMAGE_EQ = prove + (`!top top' (f:A->B) s. + homeomorphic_map (top,top') f /\ s SUBSET topspace top + ==> (borel_in top' (IMAGE f s) <=> borel_in top s)`, + REWRITE_TAC[HOMEOMORPHIC_MAP_MAPS; LEFT_IMP_EXISTS_THM] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC BOREL_IN_HOMEOMORPHIC_MAPS_IMAGE_EQ THEN + EXISTS_TAC `g:B->A` THEN ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Borel measurable maps. *) +(* ------------------------------------------------------------------------- *) + +let borel_measurable_map = new_definition + `borel_measurable_map (top1,top2) (f:A->B) <=> + (!x. x IN topspace top1 ==> f x IN topspace top2) /\ + (!u. borel_in top2 u + ==> borel_in top1 {x | x IN topspace top1 /\ f x IN u})`;; + +let BOREL_MEASURABLE_MAP_OPEN_IN = prove + (`!top1 top2 (f:A->B). + borel_measurable_map (top1,top2) f <=> + (!x. x IN topspace top1 ==> f x IN topspace top2) /\ + (!c. open_in top2 c + ==> borel_in top1 {x | x IN topspace top1 /\ f x IN c})`, + REPEAT GEN_TAC THEN REWRITE_TAC[borel_measurable_map] THEN + EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THENL + [ASM_MESON_TAC[OPEN_IMP_BOREL_IN]; ALL_TAC] THEN + MATCH_MP_TAC borel_in_INDUCT THEN REPEAT CONJ_TAC THENL + [REPEAT GEN_TAC THEN DISCH_TAC THEN ASM_SIMP_TAC[]; + X_GEN_TAC `s:B->bool` THEN DISCH_TAC THEN + SUBGOAL_THEN + `{x:A | x IN topspace top1 /\ (f:A->B) x IN topspace top2 DIFF s} = + topspace top1 DIFF {x | x IN topspace top1 /\ f x IN s}` + SUBST1_TAC THENL [ASM SET_TAC[]; ASM_SIMP_TAC[BOREL_IN_COMPLEMENT]]; + X_GEN_TAC `u:(B->bool)->bool` THEN STRIP_TAC THEN + SUBGOAL_THEN + `{x:A | x IN topspace top1 /\ (f:A->B) x IN UNIONS u} = + UNIONS (IMAGE (\s. {x | x IN topspace top1 /\ f x IN s}) u)` + SUBST1_TAC THENL + [REWRITE_TAC[UNIONS_IMAGE] THEN SET_TAC[]; + MATCH_MP_TAC BOREL_IN_UNIONS THEN + ASM_SIMP_TAC[COUNTABLE_IMAGE; FORALL_IN_IMAGE] THEN ASM_MESON_TAC[]]]);; + +let BOREL_MEASURABLE_MAP_CLOSED_IN = prove + (`!top1 top2 (f:A->B). + borel_measurable_map (top1,top2) f <=> + (!x. x IN topspace top1 ==> f x IN topspace top2) /\ + (!c. closed_in top2 c + ==> borel_in top1 {x | x IN topspace top1 /\ f x IN c})`, + REPEAT GEN_TAC THEN EQ_TAC THEN STRIP_TAC THENL + [CONJ_TAC THENL [ASM_MESON_TAC[BOREL_MEASURABLE_MAP_OPEN_IN]; ALL_TAC] THEN + ASM_MESON_TAC[borel_measurable_map; CLOSED_IMP_BOREL_IN]; + REWRITE_TAC[BOREL_MEASURABLE_MAP_OPEN_IN] THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `u:B->bool` THEN DISCH_TAC THEN + SUBGOAL_THEN + `{x:A | x IN topspace top1 /\ (f:A->B) x IN u} = + topspace top1 DIFF + {x | x IN topspace top1 /\ f x IN (topspace top2 DIFF u)}` + SUBST1_TAC THENL + [FIRST_X_ASSUM(MP_TAC o MATCH_MP OPEN_IN_SUBSET) THEN ASM SET_TAC[]; + MATCH_MP_TAC BOREL_IN_COMPLEMENT THEN + ASM_MESON_TAC[CLOSED_IN_DIFF; CLOSED_IN_TOPSPACE]]]);; + +let BOREL_MEASURABLE_MAP_IMAGE_SUBSET_TOPSPACE = prove + (`!top1 top2 (f:A->B). + borel_measurable_map (top1,top2) f + ==> IMAGE f (topspace top1) SUBSET topspace top2`, + REWRITE_TAC[BOREL_MEASURABLE_MAP_OPEN_IN] THEN SET_TAC[]);; + +let CONTINUOUS_IMP_BOREL_MEASURABLE_MAP = prove + (`!top1 top2 (f:A->B). + continuous_map (top1,top2) f ==> borel_measurable_map (top1,top2) f`, + REPEAT GEN_TAC THEN + REWRITE_TAC[continuous_map; BOREL_MEASURABLE_MAP_OPEN_IN] THEN + ASM_MESON_TAC[OPEN_IMP_BOREL_IN]);; + +let BOREL_MEASURABLE_MAP_ID = prove + (`!top:A topology. borel_measurable_map (top,top) (\x. x)`, + SIMP_TAC[CONTINUOUS_IMP_BOREL_MEASURABLE_MAP; CONTINUOUS_MAP_ID]);; + +let BOREL_MEASURABLE_MAP_CONST = prove + (`!top1 top2 (c:B). + borel_measurable_map (top1,top2) (\x:A. c) <=> + topspace top1 = {} \/ c IN topspace top2`, + REPEAT GEN_TAC THEN REWRITE_TAC[BOREL_MEASURABLE_MAP_OPEN_IN] THEN + ASM_CASES_TAC `topspace top1:A->bool = {}` THEN + ASM_REWRITE_TAC[NOT_IN_EMPTY; EMPTY_GSPEC; BOREL_IN_EMPTY] THEN + ASM_CASES_TAC `(c:B) IN topspace top2` THEN ASM_REWRITE_TAC[] THENL + [X_GEN_TAC `u:B->bool` THEN DISCH_TAC THEN + ASM_CASES_TAC `(c:B) IN u` THENL + [SUBGOAL_THEN `{x:A | x IN topspace top1 /\ (c:B) IN u} = topspace top1` + SUBST1_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[BOREL_IN_TOPSPACE]]; + SUBGOAL_THEN `{x:A | x IN topspace top1 /\ (c:B) IN u} = {}` + SUBST1_TAC THENL [ASM SET_TAC[]; REWRITE_TAC[BOREL_IN_EMPTY]]]; + ASM SET_TAC[]]);; + +let BOREL_MEASURABLE_MAP_EQ = prove + (`!top1 top2 (f:A->B) g. + (!x. x IN topspace top1 ==> f x = g x) /\ + borel_measurable_map (top1,top2) f + ==> borel_measurable_map (top1,top2) g`, + REPEAT GEN_TAC THEN + REWRITE_TAC[BOREL_MEASURABLE_MAP_OPEN_IN] THEN STRIP_TAC THEN + CONJ_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + X_GEN_TAC `u:B->bool` THEN DISCH_TAC THEN + SUBGOAL_THEN + `{x:A | x IN topspace top1 /\ (g:A->B) x IN u} = + {x | x IN topspace top1 /\ f x IN u}` + SUBST1_TAC THENL [ASM SET_TAC[]; ASM_SIMP_TAC[]]);; + +let BOREL_MEASURABLE_MAP_COMPOSE = prove + (`!top1 top2 top3 (f:A->B) (g:B->C). + borel_measurable_map (top1,top2) f /\ borel_measurable_map (top2,top3) g + ==> borel_measurable_map (top1,top3) (g o f)`, + REPEAT GEN_TAC THEN REWRITE_TAC[borel_measurable_map] THEN STRIP_TAC THEN + CONJ_TAC THENL [REWRITE_TAC[o_THM] THEN ASM_MESON_TAC[]; ALL_TAC] THEN + X_GEN_TAC `t:C->bool` THEN DISCH_TAC THEN + SUBGOAL_THEN + `{x:A | x IN topspace top1 /\ ((g:B->C) o (f:A->B)) x IN t} = + {x | x IN topspace top1 /\ f x IN {y | y IN topspace top2 /\ g y IN t}}` + SUBST1_TAC THENL + [REWRITE_TAC[o_THM; EXTENSION; IN_ELIM_THM] THEN ASM_MESON_TAC[]; + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_SIMP_TAC[]]);; + +let BOREL_MEASURABLE_MAP_FROM_SUBTOPOLOGY = prove + (`!top1 top2 (f:A->B) s. + borel_measurable_map (top1,top2) f + ==> borel_measurable_map (subtopology top1 s,top2) f`, + REPEAT GEN_TAC THEN + REWRITE_TAC[BOREL_MEASURABLE_MAP_OPEN_IN; TOPSPACE_SUBTOPOLOGY] THEN + STRIP_TAC THEN CONJ_TAC THENL [ASM SET_TAC[]; ALL_TAC] THEN + X_GEN_TAC `u:B->bool` THEN DISCH_TAC THEN + SUBGOAL_THEN + `{x:A | x IN topspace top1 INTER s /\ (f:A->B) x IN u} = + {x | x IN topspace top1 /\ f x IN u} INTER s` + SUBST1_TAC THENL + [SET_TAC[]; MATCH_MP_TAC BOREL_IN_INTER_SUBTOPOLOGY THEN ASM_SIMP_TAC[]]);; + +let BOREL_MEASURABLE_MAP_INTO_SUBTOPOLOGY = prove + (`!top1 top2 (f:A->B) s. + borel_measurable_map (top1,subtopology top2 s) f <=> + borel_measurable_map (top1,top2) f /\ IMAGE f (topspace top1) SUBSET s`, + REPEAT GEN_TAC THEN + REWRITE_TAC[BOREL_MEASURABLE_MAP_OPEN_IN; TOPSPACE_SUBTOPOLOGY] THEN + REWRITE_TAC[OPEN_IN_SUBTOPOLOGY; LEFT_IMP_EXISTS_THM] THEN EQ_TAC THEN + STRIP_TAC THENL + [REPEAT CONJ_TAC THENL + [ASM SET_TAC[]; + X_GEN_TAC `u:B->bool` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`u INTER s:B->bool`; `u:B->bool`]) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN + ASM SET_TAC[]; + ASM SET_TAC[]]; + CONJ_TAC THENL + [ASM SET_TAC[]; + MAP_EVERY X_GEN_TAC [`u:B->bool`; `t:B->bool`] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `t:B->bool`) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC EQ_IMP THEN AP_TERM_TAC THEN ASM SET_TAC[]]]);; + (* ------------------------------------------------------------------------- *) (* Metric spaces. *) (* ------------------------------------------------------------------------- *) @@ -19253,6 +19646,230 @@ let LIMIT_SUP = prove COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN MATCH_MP_TAC LIMIT_REAL_MAX THEN ASM_REWRITE_TAC[]);; +(* ------------------------------------------------------------------------- *) +(* Closure of Borel measurable functions under pointwise limits. This *) +(* version needs a metric space for the codomain, though the result can be *) +(* further generalized to perfectly normal topological spaces. *) +(* ------------------------------------------------------------------------- *) + +let BOREL_MEASURABLE_MAP_LIMIT = prove + (`!top1 top2 (f:num->A->B) g. + metrizable_space top2 /\ + (!n. borel_measurable_map (top1,top2) (f n)) /\ + (!x. x IN topspace top1 ==> limit top2 (\k. f k x) (g x) sequentially) + ==> borel_measurable_map (top1,top2) g`, + let mbuf_open_in = prove + (`!m (s:A->bool) n. + closed_in (mtopology m) s + ==> open_in (mtopology m) + {z | z IN mspace m /\ ?y. y IN s /\ mdist m (z,y) < inv(&n + &1)}`, + REPEAT STRIP_TAC THEN REWRITE_TAC[OPEN_IN_MTOPOLOGY; SUBSET_RESTRICT] THEN + REWRITE_TAC[IN_ELIM_THM] THEN X_GEN_TAC `z:A` THEN STRIP_TAC THEN + EXISTS_TAC `inv(&n + &1) - mdist m (z:A,y)` THEN + ASM_REWRITE_TAC[REAL_SUB_LT; SUBSET; IN_MBALL; IN_ELIM_THM] THEN + X_GEN_TAC `w:A` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + EXISTS_TAC `y:A` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `(y:A) IN mspace m` ASSUME_TAC THENL + [ASM_MESON_TAC[CLOSED_IN_SUBSET; SUBSET; TOPSPACE_MTOPOLOGY]; + REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC METRIC_ARITH]) in + let mbuf_superset = prove + (`!m (s:A->bool) n. + closed_in (mtopology m) s + ==> s SUBSET + {z | z IN mspace m /\ ?y. y IN s /\ mdist m (z,y) < inv(&n + &1)}`, + REPEAT STRIP_TAC THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + SUBGOAL_THEN `(x:A) IN mspace m` ASSUME_TAC THENL + [ASM_MESON_TAC[CLOSED_IN_SUBSET; SUBSET; TOPSPACE_MTOPOLOGY]; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN EXISTS_TAC `x:A` THEN + ASM_SIMP_TAC[MDIST_REFL; REAL_LT_INV_EQ] THEN REAL_ARITH_TAC) in + let mbuf_inters = prove + (`!m (s:A->bool). + closed_in (mtopology m) s + ==> INTERS {{z | z IN mspace m /\ + ?y. y IN s /\ mdist m (z,y) < inv(&n + &1)} + | n IN (:num)} = s`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET; INTERS_GSPEC; IN_ELIM_THM; IN_UNIV] THEN + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + SUBGOAL_THEN `(x:A) IN mspace m` ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `0`) THEN SIMP_TAC[]; ALL_TAC] THEN + GEN_REWRITE_TAC I [TAUT `p <=> ~ ~p`] THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [closed_in]) THEN + REWRITE_TAC[OPEN_IN_MTOPOLOGY] THEN + DISCH_THEN(MP_TAC o SPEC `x:A` o CONJUNCT2 o CONJUNCT2) THEN + ASM_REWRITE_TAC[IN_DIFF; TOPSPACE_MTOPOLOGY; SUBSET; IN_MBALL] THEN + DISCH_THEN(X_CHOOSE_THEN `r:real` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPEC `r:real` REAL_ARCH_INV) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN + DISCH_THEN(MP_TAC o CONJUNCT2) THEN + DISCH_THEN(X_CHOOSE_THEN `y:A` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `y:A`) THEN + SUBGOAL_THEN `(y:A) IN mspace m` ASSUME_TAC THENL + [ASM_MESON_TAC[CLOSED_IN_SUBSET; SUBSET; TOPSPACE_MTOPOLOGY]; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `mdist m (x:A,y) < r` ASSUME_TAC THENL + [SUBGOAL_THEN `inv(&n + &1) <= inv(&n)` MP_TAC THENL + [ALL_TAC; ASM_REAL_ARITH_TAC] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + REWRITE_TAC[REAL_OF_NUM_LT; REAL_OF_NUM_LE; REAL_OF_NUM_ADD] THEN + ASM_ARITH_TAC; + ASM_REWRITE_TAC[]]; + REWRITE_TAC[SUBSET; INTERS_GSPEC; IN_ELIM_THM; IN_UNIV] THEN + X_GEN_TAC `x:A` THEN DISCH_TAC THEN X_GEN_TAC `n:num` THEN + SUBGOAL_THEN `(x:A) IN mspace m` ASSUME_TAC THENL + [ASM_MESON_TAC[CLOSED_IN_SUBSET; SUBSET; TOPSPACE_MTOPOLOGY]; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN EXISTS_TAC `x:A` THEN + ASM_SIMP_TAC[MDIST_REFL; REAL_LT_INV_EQ] THEN REAL_ARITH_TAC]) in + let mlimit_preimage_closed_eq = prove + (`!(m:B metric) (f:num->A->B) g (C:B->bool) dom. + closed_in (mtopology m) C /\ + (!x. x IN dom ==> limit (mtopology m) (\k. f k x) (g x) sequentially) + ==> {x | x IN dom /\ g x IN C} = + INTERS {{x | x IN dom /\ + ?N. !k. N <= k ==> + f k x IN {z | z IN mspace m /\ + ?y. y IN C /\ mdist m (z,y) < inv(&n + &1)}} + | n IN (:num)}`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET; INTERS_GSPEC; IN_ELIM_THM; IN_UNIV] THEN + X_GEN_TAC `x:A` THEN STRIP_TAC THEN X_GEN_TAC `n:num` THEN + ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:A`) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[LIMIT_SEQUENTIALLY] THEN + DISCH_THEN(MP_TAC o SPEC + `{z:B | z IN mspace(m:B metric) /\ + ?y. y IN C /\ mdist m (z,y) < inv(&n + &1)}` o + CONJUNCT2) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC mbuf_open_in THEN ASM_REWRITE_TAC[]; + MP_TAC(ISPECL [`m:B metric`; `C:B->bool`; `n:num`] mbuf_superset) THEN + ASM_REWRITE_TAC[SUBSET] THEN + DISCH_THEN(MP_TAC o SPEC `(g:A->B) x`) THEN + ASM_REWRITE_TAC[IN_ELIM_THM]]; + REWRITE_TAC[IN_ELIM_THM]]; + REWRITE_TAC[SUBSET; INTERS_GSPEC; IN_ELIM_THM; IN_UNIV] THEN + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + SUBGOAL_THEN `x:A IN dom` ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `0`) THEN SIMP_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`m:B metric`; `C:B->bool`] mbuf_inters) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(fun th -> GEN_REWRITE_TAC RAND_CONV [SYM th]) THEN + REWRITE_TAC[INTERS_GSPEC; IN_ELIM_THM; IN_UNIV] THEN + X_GEN_TAC `n:num` THEN + FIRST_X_ASSUM(MP_TAC o SPEC `2 * n + 1`) THEN + DISCH_THEN(MP_TAC o CONJUNCT2) THEN + DISCH_THEN(X_CHOOSE_THEN `N1:num` (LABEL_TAC "buf")) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:A`) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[LIMIT_METRIC] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `inv(&(2 * n + 1) + &1)`) THEN ANTS_TAC THENL + [REWRITE_TAC[REAL_LT_INV_EQ] THEN REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN + DISCH_THEN(X_CHOOSE_THEN `N2:num` (LABEL_TAC "lim")) THEN + CONJ_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + REMOVE_THEN "buf" (MP_TAC o SPEC `N1 + N2:num`) THEN + REWRITE_TAC[LE_ADD] THEN DISCH_THEN(MP_TAC o CONJUNCT2) THEN + DISCH_THEN(X_CHOOSE_THEN `y:B` STRIP_ASSUME_TAC) THEN + REMOVE_THEN "lim" (MP_TAC o SPEC `N1 + N2:num`) THEN + REWRITE_TAC[LE_ADDR] THEN STRIP_TAC THEN + EXISTS_TAC `y:B` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `(y:B) IN mspace m` ASSUME_TAC THENL + [ASM_MESON_TAC[CLOSED_IN_SUBSET; SUBSET; TOPSPACE_MTOPOLOGY]; + ALL_TAC] THEN + SUBGOAL_THEN + `mdist m ((g:A->B) x, y:B) <= + mdist m (g x, (f:num->A->B) (N1 + N2) x) + mdist m (f (N1 + N2) x, y)` + ASSUME_TAC THENL + [MAP_EVERY UNDISCH_TAC + [`(g:A->B) x IN mspace m`; `(f:num->A->B) (N1 + N2) x IN mspace m`; + `(y:B) IN mspace m`] THEN + CONV_TAC METRIC_ARITH; + ALL_TAC] THEN + MP_TAC(ISPECL [`m:B metric`; `(g:A->B) x`; `(f:num->A->B) (N1 + N2) x`] + MDIST_SYM) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + SUBGOAL_THEN + `inv(&(2 * n + 1) + &1) + inv(&(2 * n + 1) + &1) = inv(&n + &1)` + ASSUME_TAC THENL + [SUBGOAL_THEN `&(2 * n + 1) + &1 = &2 * (&n + &1)` SUBST1_TAC THENL + [REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN + REAL_ARITH_TAC; + MATCH_MP_TAC(REAL_FIELD + `&0 < &n + &1 + ==> inv(&2 * (&n + &1)) + inv(&2 * (&n + &1)) = inv(&n + &1)`) THEN + REAL_ARITH_TAC]; + ASM_REAL_ARITH_TAC]]) in + let bmm_eventually_preimage_open = prove + (`!top1 m (f:num->A->B) (u:B->bool). + (!n. borel_measurable_map (top1,mtopology m) (f n)) /\ + open_in (mtopology m) u + ==> borel_in top1 + {x | x IN topspace top1 /\ ?N. !k. N <= k ==> f k x IN u}`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `{x | x IN topspace top1 /\ ?N. !k. N <= k ==> (f:num->A->B) k x IN u} = + UNIONS {INTERS {{x | x IN topspace top1 /\ f k x IN u} | k IN from N} + | N IN (:num)}` + SUBST1_TAC THENL + [REWRITE_TAC[UNIONS_GSPEC; INTERS_GSPEC; IN_FROM; EXTENSION] THEN + X_GEN_TAC `x:A` THEN REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN + EQ_TAC THEN STRIP_TAC THENL + [EXISTS_TAC `N:num` THEN ASM_SIMP_TAC[]; + FIRST_ASSUM(MP_TAC o SPEC `N:num`) THEN REWRITE_TAC[LE_REFL] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN EXISTS_TAC `N:num` THEN + X_GEN_TAC `k:num` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `k:num`) THEN ASM_SIMP_TAC[]]; + ALL_TAC] THEN + MATCH_MP_TAC BOREL_IN_UNIONS THEN CONJ_TAC THENL + [SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; NUM_COUNTABLE]; + REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN X_GEN_TAC `N:num` THEN + MATCH_MP_TAC BOREL_IN_INTERS THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[SIMPLE_IMAGE] THEN MATCH_MP_TAC COUNTABLE_IMAGE THEN + MATCH_MP_TAC COUNTABLE_SUBSET THEN EXISTS_TAC `(:num)` THEN + REWRITE_TAC[NUM_COUNTABLE; SUBSET_UNIV]; + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM; IN_FROM] THEN + MAP_EVERY EXISTS_TAC + [`{x:A | x IN topspace top1 /\ (f:num->A->B) N x IN u}`; `N:num`] THEN + REWRITE_TAC[LE_REFL]; + REWRITE_TAC[FORALL_IN_GSPEC; IN_FROM] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `k:num` o + REWRITE_RULE[borel_measurable_map]) THEN + DISCH_THEN(MATCH_MP_TAC o CONJUNCT2) THEN + MATCH_MP_TAC OPEN_IMP_BOREL_IN THEN ASM_REWRITE_TAC[]]]) in + REWRITE_TAC[IMP_CONJ; RIGHT_FORALL_IMP_THM; FORALL_METRIZABLE_SPACE] THEN + MAP_EVERY X_GEN_TAC [`top1:A topology`; `m:B metric`; `f:num->A->B`] THEN + DISCH_TAC THEN X_GEN_TAC `g:A->B` THEN DISCH_TAC THEN + REWRITE_TAC[BOREL_MEASURABLE_MAP_CLOSED_IN] THEN CONJ_TAC THENL + [REWRITE_TAC[TOPSPACE_MTOPOLOGY] THEN ASM_MESON_TAC[LIMIT_METRIC]; + ALL_TAC] THEN + X_GEN_TAC `C:B->bool` THEN DISCH_TAC THEN + MP_TAC(ISPECL [`m:B metric`; `f:num->A->B`; `g:A->B`; `C:B->bool`; + `topspace top1:A->bool`] mlimit_preimage_closed_eq) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + MATCH_MP_TAC BOREL_IN_INTERS THEN REPEAT CONJ_TAC THENL + [SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; NUM_COUNTABLE]; + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN + EXISTS_TAC `{x:A | x IN topspace top1 /\ + ?N. !k. N <= k ==> + (f:num->A->B) k x IN + {z | z IN mspace m /\ + ?y. y IN C /\ mdist m (z,y) < inv(&0 + &1)}}` THEN + EXISTS_TAC `0` THEN REWRITE_TAC[IN_ELIM_THM]; + REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN X_GEN_TAC `n:num` THEN + MP_TAC(ISPECL + [`top1:A topology`; `m:B metric`; `f:num->A->B`; + `{z:B | z IN mspace m /\ ?y. y IN C /\ mdist m (z,y) < inv(&n + &1)}`] + bmm_eventually_preimage_open) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + MATCH_MP_TAC mbuf_open_in THEN ASM_REWRITE_TAC[]]);; + (* ------------------------------------------------------------------------- *) (* Cauchy sequences and complete metric spaces. *) (* ------------------------------------------------------------------------- *) @@ -49527,4 +50144,3 @@ let KURATOWSKI_COMPONENT_NUMBER_INVARIANCE = prove CONTINUOUS_MAP_IN_SUBTOPOLOGY]) THEN RULE_ASSUM_TAC(REWRITE_RULE[TOPSPACE_SUBTOPOLOGY]) THEN ASM SET_TAC[]);; - diff --git a/Multivariate/multivariate_database.ml b/Multivariate/multivariate_database.ml index de4b29d3..b07593dc 100644 --- a/Multivariate/multivariate_database.ml +++ b/Multivariate/multivariate_database.ml @@ -46,12 +46,16 @@ theorems := "ABELIAN_GROUP_TORSION_ISOMORPHISM",ABELIAN_GROUP_TORSION_ISOMORPHISM; "ABELIAN_GROUP_TORSION_STRUCTURE",ABELIAN_GROUP_TORSION_STRUCTURE; "ABELIAN_HOMOLOGY_GROUP",ABELIAN_HOMOLOGY_GROUP; +"ABELIAN_IMP_SOLVABLE_GROUP",ABELIAN_IMP_SOLVABLE_GROUP; "ABELIAN_INTEGER_GROUP",ABELIAN_INTEGER_GROUP; "ABELIAN_INTEGER_MOD_GROUP",ABELIAN_INTEGER_MOD_GROUP; "ABELIAN_OPPOSITE_GROUP",ABELIAN_OPPOSITE_GROUP; "ABELIAN_PRODUCT_GROUP",ABELIAN_PRODUCT_GROUP; "ABELIAN_PROD_GROUP",ABELIAN_PROD_GROUP; +"ABELIAN_QUOTIENT_COMMUTATOR",ABELIAN_QUOTIENT_COMMUTATOR; +"ABELIAN_QUOTIENT_EPIMORPHIC_IMAGE",ABELIAN_QUOTIENT_EPIMORPHIC_IMAGE; "ABELIAN_QUOTIENT_GROUP",ABELIAN_QUOTIENT_GROUP; +"ABELIAN_QUOTIENT_GROUP_DIV",ABELIAN_QUOTIENT_GROUP_DIV; "ABELIAN_RELATIVE_HOMOLOGY_GROUP",ABELIAN_RELATIVE_HOMOLOGY_GROUP; "ABELIAN_RELCYCLE_GROUP",ABELIAN_RELCYCLE_GROUP; "ABELIAN_SIMPLE_GROUP",ABELIAN_SIMPLE_GROUP; @@ -975,6 +979,7 @@ theorems := "BOREL_DOMAIN_OF_INJECTIVITY_CONTINUOUS",BOREL_DOMAIN_OF_INJECTIVITY_CONTINUOUS; "BOREL_DOMAIN_OF_INJECTIVITY_CONTINUOUS_GEN",BOREL_DOMAIN_OF_INJECTIVITY_CONTINUOUS_GEN; "BOREL_EMPTY",BOREL_EMPTY; +"BOREL_FROM_SUBTOPOLOGY",BOREL_FROM_SUBTOPOLOGY; "BOREL_IMP_ANALYTIC",BOREL_IMP_ANALYTIC; "BOREL_IMP_LEBESGUE_MEASURABLE",BOREL_IMP_LEBESGUE_MEASURABLE; "BOREL_INDUCT_CLOSED_UNIONS_INTERS",BOREL_INDUCT_CLOSED_UNIONS_INTERS; @@ -985,6 +990,24 @@ theorems := "BOREL_INDUCT_UNIONS_INTERS",BOREL_INDUCT_UNIONS_INTERS; "BOREL_INTER",BOREL_INTER; "BOREL_INTERS",BOREL_INTERS; +"BOREL_IN_COMPLEMENT",BOREL_IN_COMPLEMENT; +"BOREL_IN_COMPLEMENT_EQ",BOREL_IN_COMPLEMENT_EQ; +"BOREL_IN_CONTINUOUS_MAP_PREIMAGE",BOREL_IN_CONTINUOUS_MAP_PREIMAGE; +"BOREL_IN_DIFF",BOREL_IN_DIFF; +"BOREL_IN_EMPTY",BOREL_IN_EMPTY; +"BOREL_IN_EUCLIDEAN",BOREL_IN_EUCLIDEAN; +"BOREL_IN_HOMEOMORPHIC_MAPS_IMAGE_EQ",BOREL_IN_HOMEOMORPHIC_MAPS_IMAGE_EQ; +"BOREL_IN_HOMEOMORPHIC_MAP_IMAGE",BOREL_IN_HOMEOMORPHIC_MAP_IMAGE; +"BOREL_IN_HOMEOMORPHIC_MAP_IMAGE_EQ",BOREL_IN_HOMEOMORPHIC_MAP_IMAGE_EQ; +"BOREL_IN_INTER",BOREL_IN_INTER; +"BOREL_IN_INTERS",BOREL_IN_INTERS; +"BOREL_IN_INTER_SUBTOPOLOGY",BOREL_IN_INTER_SUBTOPOLOGY; +"BOREL_IN_SUBSET_TOPSPACE",BOREL_IN_SUBSET_TOPSPACE; +"BOREL_IN_SUBTOPOLOGY",BOREL_IN_SUBTOPOLOGY; +"BOREL_IN_SUBTOPOLOGY_EQ",BOREL_IN_SUBTOPOLOGY_EQ; +"BOREL_IN_TOPSPACE",BOREL_IN_TOPSPACE; +"BOREL_IN_UNION",BOREL_IN_UNION; +"BOREL_IN_UNIONS",BOREL_IN_UNIONS; "BOREL_LINEAR_IMAGE",BOREL_LINEAR_IMAGE; "BOREL_MEASURABLE_ADD",BOREL_MEASURABLE_ADD; "BOREL_MEASURABLE_BILINEAR",BOREL_MEASURABLE_BILINEAR; @@ -998,6 +1021,18 @@ theorems := "BOREL_MEASURABLE_EXTENSION",BOREL_MEASURABLE_EXTENSION; "BOREL_MEASURABLE_IMP_MEASURABLE_ON",BOREL_MEASURABLE_IMP_MEASURABLE_ON; "BOREL_MEASURABLE_INDICATOR",BOREL_MEASURABLE_INDICATOR; +"BOREL_MEASURABLE_MAP_CLOSED_IN",BOREL_MEASURABLE_MAP_CLOSED_IN; +"BOREL_MEASURABLE_MAP_COMPOSE",BOREL_MEASURABLE_MAP_COMPOSE; +"BOREL_MEASURABLE_MAP_CONST",BOREL_MEASURABLE_MAP_CONST; +"BOREL_MEASURABLE_MAP_EQ",BOREL_MEASURABLE_MAP_EQ; +"BOREL_MEASURABLE_MAP_EUCLIDEAN",BOREL_MEASURABLE_MAP_EUCLIDEAN; +"BOREL_MEASURABLE_MAP_EUCLIDEAN_SUBTOPOLOGY",BOREL_MEASURABLE_MAP_EUCLIDEAN_SUBTOPOLOGY; +"BOREL_MEASURABLE_MAP_FROM_SUBTOPOLOGY",BOREL_MEASURABLE_MAP_FROM_SUBTOPOLOGY; +"BOREL_MEASURABLE_MAP_ID",BOREL_MEASURABLE_MAP_ID; +"BOREL_MEASURABLE_MAP_IMAGE_SUBSET_TOPSPACE",BOREL_MEASURABLE_MAP_IMAGE_SUBSET_TOPSPACE; +"BOREL_MEASURABLE_MAP_INTO_SUBTOPOLOGY",BOREL_MEASURABLE_MAP_INTO_SUBTOPOLOGY; +"BOREL_MEASURABLE_MAP_LIMIT",BOREL_MEASURABLE_MAP_LIMIT; +"BOREL_MEASURABLE_MAP_OPEN_IN",BOREL_MEASURABLE_MAP_OPEN_IN; "BOREL_MEASURABLE_MAX",BOREL_MEASURABLE_MAX; "BOREL_MEASURABLE_MIN",BOREL_MEASURABLE_MIN; "BOREL_MEASURABLE_MUL",BOREL_MEASURABLE_MUL; @@ -1400,6 +1435,9 @@ theorems := "CARD_LET_TOTAL",CARD_LET_TOTAL; "CARD_LET_TRANS",CARD_LET_TRANS; "CARD_LE_1",CARD_LE_1; +"CARD_LE_2",CARD_LE_2; +"CARD_LE_3",CARD_LE_3; +"CARD_LE_4",CARD_LE_4; "CARD_LE_ADD",CARD_LE_ADD; "CARD_LE_ADDL",CARD_LE_ADDL; "CARD_LE_ADDR",CARD_LE_ADDR; @@ -1773,6 +1811,7 @@ theorems := "CLOSED_IMP_ANALYTIC",CLOSED_IMP_ANALYTIC; "CLOSED_IMP_BAIRE1_INDICATOR",CLOSED_IMP_BAIRE1_INDICATOR; "CLOSED_IMP_BOREL",CLOSED_IMP_BOREL; +"CLOSED_IMP_BOREL_IN",CLOSED_IMP_BOREL_IN; "CLOSED_IMP_FIP",CLOSED_IMP_FIP; "CLOSED_IMP_FIP_COMPACT",CLOSED_IMP_FIP_COMPACT; "CLOSED_IMP_FSIGMA",CLOSED_IMP_FSIGMA; @@ -1885,6 +1924,7 @@ theorems := "CLOSED_IN_SUBSET_TRANS",CLOSED_IN_SUBSET_TRANS; "CLOSED_IN_SUBTOPOLOGY",CLOSED_IN_SUBTOPOLOGY; "CLOSED_IN_SUBTOPOLOGY_ALT",CLOSED_IN_SUBTOPOLOGY_ALT; +"CLOSED_IN_SUBTOPOLOGY_BOREL_IN",CLOSED_IN_SUBTOPOLOGY_BOREL_IN; "CLOSED_IN_SUBTOPOLOGY_DIFF_OPEN",CLOSED_IN_SUBTOPOLOGY_DIFF_OPEN; "CLOSED_IN_SUBTOPOLOGY_EMPTY",CLOSED_IN_SUBTOPOLOGY_EMPTY; "CLOSED_IN_SUBTOPOLOGY_INTER_CLOSED",CLOSED_IN_SUBTOPOLOGY_INTER_CLOSED; @@ -2228,6 +2268,7 @@ theorems := "COLUMN_TRANSP",COLUMN_TRANSP; "COMMA_DEF",COMMA_DEF; "COMMON_FRONTIER_DOMAINS",COMMON_FRONTIER_DOMAINS; +"COMMUTATOR_IMP_ABELIAN_QUOTIENT",COMMUTATOR_IMP_ABELIAN_QUOTIENT; "COMMUTING_MATRIX_INV_COVARIANCE",COMMUTING_MATRIX_INV_COVARIANCE; "COMMUTING_MATRIX_INV_NORMAL",COMMUTING_MATRIX_INV_NORMAL; "COMMUTING_WITH_DIAGONAL_MATRIX",COMMUTING_WITH_DIAGONAL_MATRIX; @@ -3040,6 +3081,7 @@ theorems := "CONTINUOUS_IMAGE_NESTED_INTERS_GEN",CONTINUOUS_IMAGE_NESTED_INTERS_GEN; "CONTINUOUS_IMAGE_SUBSET_INTERIOR",CONTINUOUS_IMAGE_SUBSET_INTERIOR; "CONTINUOUS_IMAGE_SUBSET_RELATIVE_INTERIOR",CONTINUOUS_IMAGE_SUBSET_RELATIVE_INTERIOR; +"CONTINUOUS_IMP_BOREL_MEASURABLE_MAP",CONTINUOUS_IMP_BOREL_MEASURABLE_MAP; "CONTINUOUS_IMP_BOREL_MEASURABLE_ON",CONTINUOUS_IMP_BOREL_MEASURABLE_ON; "CONTINUOUS_IMP_CAUCHY_CONTINUOUS_MAP",CONTINUOUS_IMP_CAUCHY_CONTINUOUS_MAP; "CONTINUOUS_IMP_CLOSED_MAP",CONTINUOUS_IMP_CLOSED_MAP; @@ -5928,6 +5970,7 @@ theorems := "FSIGMA_GDELTA_GEN",FSIGMA_GDELTA_GEN; "FSIGMA_IMP_ANALYTIC",FSIGMA_IMP_ANALYTIC; "FSIGMA_IMP_BOREL",FSIGMA_IMP_BOREL; +"FSIGMA_IMP_BOREL_IN",FSIGMA_IMP_BOREL_IN; "FSIGMA_IMP_LEBESGUE_MEASURABLE",FSIGMA_IMP_LEBESGUE_MEASURABLE; "FSIGMA_INTER",FSIGMA_INTER; "FSIGMA_INTERS",FSIGMA_INTERS; @@ -6088,6 +6131,7 @@ theorems := "GDELTA_HOMEOMORPHIC_SPACE_CLOSED_IN_PRODUCT",GDELTA_HOMEOMORPHIC_SPACE_CLOSED_IN_PRODUCT; "GDELTA_IMP_ANALYTIC",GDELTA_IMP_ANALYTIC; "GDELTA_IMP_BOREL",GDELTA_IMP_BOREL; +"GDELTA_IMP_BOREL_IN",GDELTA_IMP_BOREL_IN; "GDELTA_IMP_LEBESGUE_MEASURABLE",GDELTA_IMP_LEBESGUE_MEASURABLE; "GDELTA_INTER",GDELTA_INTER; "GDELTA_INTERS",GDELTA_INTERS; @@ -9023,6 +9067,7 @@ theorems := "INVERSE_LIPSCHITZ_CONVEX_SPHERICAL_PROJECTION",INVERSE_LIPSCHITZ_CONVEX_SPHERICAL_PROJECTION; "INVERSE_LIPSCHITZ_CONVEX_SPHERICAL_PROJECTION_EXPLICIT",INVERSE_LIPSCHITZ_CONVEX_SPHERICAL_PROJECTION_EXPLICIT; "INVERSE_SWAP",INVERSE_SWAP; +"INVERSE_UNIQUE_ALT",INVERSE_UNIQUE_ALT; "INVERSE_UNIQUE_o",INVERSE_UNIQUE_o; "INVERTIBLE_CMUL",INVERTIBLE_CMUL; "INVERTIBLE_COFACTOR",INVERTIBLE_COFACTOR; @@ -9047,6 +9092,8 @@ theorems := "INVOLUTION_EVEN_NOFIXPOINTS",INVOLUTION_EVEN_NOFIXPOINTS; "INVOLUTION_IMP_HOMEOMORPHISM",INVOLUTION_IMP_HOMEOMORPHISM; "INVOLUTION_IMP_HOMEOMORPHISM_GEN",INVOLUTION_IMP_HOMEOMORPHISM_GEN; +"INVOLUTION_MOVES_2_IS_SWAP",INVOLUTION_MOVES_2_IS_SWAP; +"INVOLUTION_SIZE_2_IS_SWAP",INVOLUTION_SIZE_2_IS_SWAP; "IN_AFFINE_ADD_MUL",IN_AFFINE_ADD_MUL; "IN_AFFINE_ADD_MUL_DIFF",IN_AFFINE_ADD_MUL_DIFF; "IN_AFFINE_HULL_LINEAR_IMAGE",IN_AFFINE_HULL_LINEAR_IMAGE; @@ -9279,6 +9326,7 @@ theorems := "ISOMORPHIC_GROUP_RELATIVE_HOMOLOGY_BY_SING",ISOMORPHIC_GROUP_RELATIVE_HOMOLOGY_BY_SING; "ISOMORPHIC_GROUP_RELATIVE_HOMOLOGY_OF_CONTRACTIBLE",ISOMORPHIC_GROUP_RELATIVE_HOMOLOGY_OF_CONTRACTIBLE; "ISOMORPHIC_GROUP_SINGLETON_GROUP",ISOMORPHIC_GROUP_SINGLETON_GROUP; +"ISOMORPHIC_GROUP_SOLVABILITY",ISOMORPHIC_GROUP_SOLVABILITY; "ISOMORPHIC_GROUP_SUM_GROUP",ISOMORPHIC_GROUP_SUM_GROUP; "ISOMORPHIC_GROUP_SYM",ISOMORPHIC_GROUP_SYM; "ISOMORPHIC_GROUP_TORSION",ISOMORPHIC_GROUP_TORSION; @@ -12215,6 +12263,7 @@ theorems := "OPEN_IMP_ANR",OPEN_IMP_ANR; "OPEN_IMP_BAIRE1_INDICATOR",OPEN_IMP_BAIRE1_INDICATOR; "OPEN_IMP_BOREL",OPEN_IMP_BOREL; +"OPEN_IMP_BOREL_IN",OPEN_IMP_BOREL_IN; "OPEN_IMP_ENR",OPEN_IMP_ENR; "OPEN_IMP_FSIGMA",OPEN_IMP_FSIGMA; "OPEN_IMP_FSIGMA_IN",OPEN_IMP_FSIGMA_IN; @@ -12331,6 +12380,7 @@ theorems := "OPEN_IN_SUBSET_TRANS",OPEN_IN_SUBSET_TRANS; "OPEN_IN_SUBTOPOLOGY",OPEN_IN_SUBTOPOLOGY; "OPEN_IN_SUBTOPOLOGY_ALT",OPEN_IN_SUBTOPOLOGY_ALT; +"OPEN_IN_SUBTOPOLOGY_BOREL_IN",OPEN_IN_SUBTOPOLOGY_BOREL_IN; "OPEN_IN_SUBTOPOLOGY_DIFF_CLOSED",OPEN_IN_SUBTOPOLOGY_DIFF_CLOSED; "OPEN_IN_SUBTOPOLOGY_EMPTY",OPEN_IN_SUBTOPOLOGY_EMPTY; "OPEN_IN_SUBTOPOLOGY_INTER_OPEN",OPEN_IN_SUBTOPOLOGY_INTER_OPEN; @@ -13068,6 +13118,7 @@ theorems := "PERMUTES_SUPERSET",PERMUTES_SUPERSET; "PERMUTES_SURJECTIVE",PERMUTES_SURJECTIVE; "PERMUTES_SWAP",PERMUTES_SWAP; +"PERMUTES_THREE_CYCLE",PERMUTES_THREE_CYCLE; "PERMUTES_TRANSFER",PERMUTES_TRANSFER; "PERMUTES_TRANSFER_BIJECTIONS",PERMUTES_TRANSFER_BIJECTIONS; "PERMUTES_UNIV",PERMUTES_UNIV; @@ -14464,6 +14515,11 @@ theorems := "RESTRICTION_UNIQUE",RESTRICTION_UNIQUE; "RESTRICTION_UNIQUE_ALT",RESTRICTION_UNIQUE_ALT; "RESTRICTION_UNIV",RESTRICTION_UNIV; +"RESTRICT_COMPOSE",RESTRICT_COMPOSE; +"RESTRICT_I",RESTRICT_I; +"RESTRICT_INVERSE",RESTRICT_INVERSE; +"RESTRICT_PERMUTES_SUBSET",RESTRICT_PERMUTES_SUBSET; +"RESTRICT_SWAP",RESTRICT_SWAP; "RETRACTION",RETRACTION; "RETRACTION_ARC",RETRACTION_ARC; "RETRACTION_CLOSEST_POINT",RETRACTION_CLOSEST_POINT; @@ -15149,6 +15205,13 @@ theorems := "SNDCART_VEC",SNDCART_VEC; "SNDCART_VSUM",SNDCART_VSUM; "SND_DEF",SND_DEF; +"SOLVABLE_GROUP_ALT",SOLVABLE_GROUP_ALT; +"SOLVABLE_GROUP_EPIMORPHIC_IMAGE",SOLVABLE_GROUP_EPIMORPHIC_IMAGE; +"SOLVABLE_GROUP_MONOMORPHIC_PREIMAGE",SOLVABLE_GROUP_MONOMORPHIC_PREIMAGE; +"SOLVABLE_GROUP_NORMAL_EXTENSION",SOLVABLE_GROUP_NORMAL_EXTENSION; +"SOLVABLE_GROUP_QUOTIENT",SOLVABLE_GROUP_QUOTIENT; +"SOLVABLE_GROUP_SOLVABLE_QUOTIENT",SOLVABLE_GROUP_SOLVABLE_QUOTIENT; +"SOLVABLE_GROUP_SUBGROUP",SOLVABLE_GROUP_SUBGROUP; "SPANNING_SUBSET_INDEPENDENT",SPANNING_SUBSET_INDEPENDENT; "SPANNING_SURJECTIVE_IMAGE",SPANNING_SURJECTIVE_IMAGE; "SPANS_IMAGE",SPANS_IMAGE; @@ -15806,14 +15869,20 @@ theorems := "SWAPSEQ_SWAP",SWAPSEQ_SWAP; "SWAP_COMMON",SWAP_COMMON; "SWAP_COMMON'",SWAP_COMMON'; +"SWAP_CONJUGATE",SWAP_CONJUGATE; "SWAP_EXISTS_THM",SWAP_EXISTS_THM; "SWAP_FORALL_THM",SWAP_FORALL_THM; "SWAP_GALOIS",SWAP_GALOIS; "SWAP_GENERAL",SWAP_GENERAL; "SWAP_IDEMPOTENT",SWAP_IDEMPOTENT; "SWAP_INDEPENDENT",SWAP_INDEPENDENT; +"SWAP_LEFT",SWAP_LEFT; +"SWAP_OTHER",SWAP_OTHER; "SWAP_REFL",SWAP_REFL; +"SWAP_RIGHT",SWAP_RIGHT; "SWAP_SYM",SWAP_SYM; +"SWAP_TRIPLE",SWAP_TRIPLE; +"SWAP_TRIPLE_ALT",SWAP_TRIPLE_ALT; "SYLOW_THEOREM",SYLOW_THEOREM; "SYLOW_THEOREM_CONJUGATE",SYLOW_THEOREM_CONJUGATE; "SYLOW_THEOREM_CONJUGATE_ALT",SYLOW_THEOREM_CONJUGATE_ALT; @@ -15925,6 +15994,11 @@ theorems := "THIN_FRONTIER_OF_ICI",THIN_FRONTIER_OF_ICI; "THIN_FRONTIER_OF_SUBSET",THIN_FRONTIER_OF_SUBSET; "THIN_FRONTIER_SUBSET",THIN_FRONTIER_SUBSET; +"THREE_CYCLE_AS_COMMUTATOR",THREE_CYCLE_AS_COMMUTATOR; +"THREE_CYCLE_COMMUTATOR",THREE_CYCLE_COMMUTATOR; +"THREE_CYCLE_COMPOSE_REVERSE",THREE_CYCLE_COMPOSE_REVERSE; +"THREE_CYCLE_INVERSE",THREE_CYCLE_INVERSE; +"THREE_CYCLE_NOT_I",THREE_CYCLE_NOT_I; "TIETZE",TIETZE; "TIETZE_CLOSED_INTERVAL",TIETZE_CLOSED_INTERVAL; "TIETZE_CLOSED_INTERVAL_1",TIETZE_CLOSED_INTERVAL_1; @@ -16133,6 +16207,7 @@ theorems := "TRIVIAL_IMP_CYCLIC_GROUP",TRIVIAL_IMP_CYCLIC_GROUP; "TRIVIAL_IMP_FINITELY_GENERATED_GROUP",TRIVIAL_IMP_FINITELY_GENERATED_GROUP; "TRIVIAL_IMP_FINITE_GROUP",TRIVIAL_IMP_FINITE_GROUP; +"TRIVIAL_IMP_SOLVABLE_GROUP",TRIVIAL_IMP_SOLVABLE_GROUP; "TRIVIAL_INTEGER_MOD_GROUP",TRIVIAL_INTEGER_MOD_GROUP; "TRIVIAL_LIMIT_AT",TRIVIAL_LIMIT_AT; "TRIVIAL_LIMIT_ATPOINTOF",TRIVIAL_LIMIT_ATPOINTOF; @@ -16773,9 +16848,13 @@ theorems := "borel_CASES",borel_CASES; "borel_INDUCT",borel_INDUCT; "borel_RULES",borel_RULES; +"borel_in_CASES",borel_in_CASES; +"borel_in_INDUCT",borel_in_INDUCT; +"borel_in_RULES",borel_in_RULES; "borel_measurable_CASES",borel_measurable_CASES; "borel_measurable_INDUCT",borel_measurable_INDUCT; "borel_measurable_RULES",borel_measurable_RULES; +"borel_measurable_map",borel_measurable_map; "bounded",bounded; "brouwer_degree",brouwer_degree; "brouwer_degree1",brouwer_degree1; @@ -17366,6 +17445,7 @@ theorems := "singular_simplex",singular_simplex; "singular_subdivision",singular_subdivision; "sndcart",sndcart; +"solvable_group",solvable_group; "span",span; "sphere",sphere; "sqrt",sqrt; @@ -17407,6 +17487,7 @@ theorems := "tailadmissible",tailadmissible; "tendsto",tendsto; "tendsto_real_def",tendsto_real_def; +"three_cycle",three_cycle; "topcontinuous_at",topcontinuous_at; "topology_tybij",topology_tybij; "topology_tybij_th",topology_tybij_th; diff --git a/Multivariate/realanalysis.ml b/Multivariate/realanalysis.ml index ee6eddcb..1561269a 100644 --- a/Multivariate/realanalysis.ml +++ b/Multivariate/realanalysis.ml @@ -14190,40 +14190,41 @@ let CONTINUOUS_ON_VECTOR_POLYNOMIAL_FUNCTION = prove SIMP_TAC[CONTINUOUS_AT_IMP_CONTINUOUS_ON; CONTINUOUS_VECTOR_POLYNOMIAL_FUNCTION]);; +let REAL_POLY_DERIVATIVE = prove + (`!p:real^1->real. + real_polynomial_function p + ==> ?p'. real_polynomial_function p' /\ + !x. ((p o lift) has_real_derivative (p'(lift x))) (atreal x)`, + MATCH_MP_TAC + (derive_strong_induction(real_polynomial_function_RULES, + real_polynomial_function_INDUCT)) THEN + REWRITE_TAC[DIMINDEX_1; FORALL_1; o_DEF; GSYM drop; LIFT_DROP] THEN + CONJ_TAC THENL + [EXISTS_TAC `\x:real^1. &1` THEN + REWRITE_TAC[real_polynomial_function_RULES; HAS_REAL_DERIVATIVE_ID]; + ALL_TAC] THEN + CONJ_TAC THENL + [X_GEN_TAC `c:real` THEN EXISTS_TAC `\x:real^1. &0` THEN + REWRITE_TAC[real_polynomial_function_RULES; HAS_REAL_DERIVATIVE_CONST]; + ALL_TAC] THEN + CONJ_TAC THEN + MAP_EVERY X_GEN_TAC [`f:real^1->real`; `g:real^1->real`] THEN + DISCH_THEN(CONJUNCTS_THEN2 + (CONJUNCTS_THEN2 ASSUME_TAC + (X_CHOOSE_THEN `f':real^1->real` STRIP_ASSUME_TAC)) + (CONJUNCTS_THEN2 ASSUME_TAC + (X_CHOOSE_THEN `g':real^1->real` STRIP_ASSUME_TAC))) + THENL + [EXISTS_TAC `\x. (f':real^1->real) x + g' x`; + EXISTS_TAC `\x. (f:real^1->real) x * g' x + f' x * g x`] THEN + ASM_SIMP_TAC[real_polynomial_function_RULES; HAS_REAL_DERIVATIVE_ADD; + HAS_REAL_DERIVATIVE_MUL_ATREAL]);; + let HAS_VECTOR_DERIVATIVE_VECTOR_POLYNOMIAL_FUNCTION = prove (`!p:real^1->real^N. vector_polynomial_function p ==> ?p'. vector_polynomial_function p' /\ !x. (p has_vector_derivative p'(x)) (at x)`, - let lemma = prove - (`!p:real^1->real. - real_polynomial_function p - ==> ?p'. real_polynomial_function p' /\ - !x. ((p o lift) has_real_derivative (p'(lift x))) (atreal x)`, - MATCH_MP_TAC - (derive_strong_induction(real_polynomial_function_RULES, - real_polynomial_function_INDUCT)) THEN - REWRITE_TAC[DIMINDEX_1; FORALL_1; o_DEF; GSYM drop; LIFT_DROP] THEN - CONJ_TAC THENL - [EXISTS_TAC `\x:real^1. &1` THEN - REWRITE_TAC[real_polynomial_function_RULES; HAS_REAL_DERIVATIVE_ID]; - ALL_TAC] THEN - CONJ_TAC THENL - [X_GEN_TAC `c:real` THEN EXISTS_TAC `\x:real^1. &0` THEN - REWRITE_TAC[real_polynomial_function_RULES; HAS_REAL_DERIVATIVE_CONST]; - ALL_TAC] THEN - CONJ_TAC THEN - MAP_EVERY X_GEN_TAC [`f:real^1->real`; `g:real^1->real`] THEN - DISCH_THEN(CONJUNCTS_THEN2 - (CONJUNCTS_THEN2 ASSUME_TAC - (X_CHOOSE_THEN `f':real^1->real` STRIP_ASSUME_TAC)) - (CONJUNCTS_THEN2 ASSUME_TAC - (X_CHOOSE_THEN `g':real^1->real` STRIP_ASSUME_TAC))) - THENL - [EXISTS_TAC `\x. (f':real^1->real) x + g' x`; - EXISTS_TAC `\x. (f:real^1->real) x * g' x + f' x * g x`] THEN - ASM_SIMP_TAC[real_polynomial_function_RULES; HAS_REAL_DERIVATIVE_ADD; - HAS_REAL_DERIVATIVE_MUL_ATREAL]) in GEN_TAC THEN REWRITE_TAC[vector_polynomial_function] THEN DISCH_TAC THEN SUBGOAL_THEN `!i. 1 <= i /\ i <= dimindex(:N) @@ -14234,7 +14235,7 @@ let HAS_VECTOR_DERIVATIVE_VECTOR_POLYNOMIAL_FUNCTION = prove [X_GEN_TAC `i:num` THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN - DISCH_THEN(MP_TAC o MATCH_MP lemma) THEN + DISCH_THEN(MP_TAC o MATCH_MP REAL_POLY_DERIVATIVE) THEN REWRITE_TAC[HAS_REAL_VECTOR_DERIVATIVE_AT] THEN REWRITE_TAC[o_DEF; LIFT_DROP; FORALL_DROP]; GEN_REWRITE_TAC (LAND_CONV o ONCE_DEPTH_CONV) [RIGHT_IMP_EXISTS_THM] THEN diff --git a/Multivariate/topology.ml b/Multivariate/topology.ml index 058757a8..04d538ae 100644 --- a/Multivariate/topology.ml +++ b/Multivariate/topology.ml @@ -30995,6 +30995,31 @@ let borel_RULES,borel_INDUCT,borel_CASES = new_inductive_definition (!s. borel s ==> borel((:real^N) DIFF s)) /\ (!u. COUNTABLE u /\ (!s. s IN u ==> borel s) ==> borel(UNIONS u))`;; +let BOREL_IN_EUCLIDEAN = prove + (`borel_in euclidean = borel:(real^N->bool)->bool`, + REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `s:real^N->bool` THEN EQ_TAC THENL + [SPEC_TAC(`s:real^N->bool`, `s:real^N->bool`) THEN + MATCH_MP_TAC borel_in_INDUCT THEN REPEAT CONJ_TAC THENL + [REPEAT GEN_TAC THEN REWRITE_TAC[OPEN_IN_EUCLIDEAN] THEN + DISCH_TAC THEN MATCH_MP_TAC(CONJUNCT1 borel_RULES) THEN + ASM_REWRITE_TAC[]; + REPEAT GEN_TAC THEN REWRITE_TAC[TOPSPACE_EUCLIDEAN] THEN + DISCH_TAC THEN MATCH_MP_TAC(CONJUNCT1(CONJUNCT2 borel_RULES)) THEN + ASM_REWRITE_TAC[]; + REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC(CONJUNCT2(CONJUNCT2 borel_RULES)) THEN + ASM_MESON_TAC[]]; + SPEC_TAC(`s:real^N->bool`, `s:real^N->bool`) THEN + MATCH_MP_TAC borel_INDUCT THEN REPEAT CONJ_TAC THENL + [REPEAT STRIP_TAC THEN MATCH_MP_TAC OPEN_IMP_BOREL_IN THEN + ASM_REWRITE_TAC[OPEN_IN_EUCLIDEAN]; + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(:real^N) DIFF s = topspace euclidean DIFF s` + SUBST1_TAC THENL [REWRITE_TAC[TOPSPACE_EUCLIDEAN]; ALL_TAC] THEN + MATCH_MP_TAC BOREL_IN_COMPLEMENT THEN ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC THEN MATCH_MP_TAC BOREL_IN_UNIONS THEN + ASM_MESON_TAC[]]]);; + let BOREL_INDUCT_COMPACT = prove (`!P. (!s. compact s ==> P s) /\ (!s. P s ==> P ((:real^N) DIFF s)) /\ @@ -35086,6 +35111,27 @@ let BOREL_MEASURABLE_RESTRICT = prove REPEAT STRIP_TAC THEN MATCH_MP_TAC BOREL_MEASURABLE_CASES THEN ASM_REWRITE_TAC[BOREL_MEASURABLE_CONST]);; +(* ------------------------------------------------------------------------- *) +(* The relation with the general borel_measurable is slightly subtler *) +(* ------------------------------------------------------------------------- *) + +let BOREL_MEASURABLE_MAP_EUCLIDEAN_SUBTOPOLOGY = prove + (`!(f:real^M->real^N) s. + borel s + ==> (borel_measurable_map(subtopology euclidean s,euclidean) f <=> + f borel_measurable_on s)`, + REWRITE_TAC[borel_measurable_map; TOPSPACE_EUCLIDEAN; IN_UNIV] THEN + SIMP_TAC[GSYM BOREL_IN_EUCLIDEAN; BOREL_IN_SUBTOPOLOGY_EQ] THEN + REWRITE_TAC[TOPSPACE_EUCLIDEAN_SUBTOPOLOGY; SUBSET_RESTRICT] THEN + SIMP_TAC[BOREL_IN_EUCLIDEAN; GSYM BOREL_MEASURABLE_PREIMAGE_BOREL]);; + +let BOREL_MEASURABLE_MAP_EUCLIDEAN = prove + (`!(f:real^M->real^N). + borel_measurable_map(euclidean,euclidean) f <=> + f borel_measurable_on (:real^M)`, + SIMP_TAC[GSYM BOREL_MEASURABLE_MAP_EUCLIDEAN_SUBTOPOLOGY; BOREL_UNIV] THEN + REWRITE_TAC[SUBTOPOLOGY_UNIV]);; + (* ------------------------------------------------------------------------- *) (* Analytic sets. *) (* ------------------------------------------------------------------------- *) diff --git a/Probability/characteristic_functions.ml b/Probability/characteristic_functions.ml index 7641261f..1c9ec573 100644 --- a/Probability/characteristic_functions.ml +++ b/Probability/characteristic_functions.ml @@ -2974,24 +2974,8 @@ let HOEFFDING_SUM_GENERAL = prove (* AZUMA-HOEFFDING INEQUALITY *) (* ========================================================================= *) -(* Level sets of G-measurable functions are in G *) -let MEASURABLE_WRT_LEVEL_SET = prove - (`!p:A prob_space G (X:A->real) v. - sub_sigma_algebra p G /\ measurable_wrt p G X - ==> {x | x IN prob_carrier p /\ X x = v} IN G`, - REPEAT STRIP_TAC THEN - (* {X = v} = {X <= v} DIFF {X < v} *) - SUBGOAL_THEN - `{x:A | x IN prob_carrier p /\ (X:A->real) x = v} = - {x | x IN prob_carrier p /\ X x <= v} DIFF - {x | x IN prob_carrier p /\ X x < v}` - SUBST1_TAC THENL - [SET_TAC[REAL_ARITH `!x v:real. x = v <=> x <= v /\ ~(x < v)`]; - ALL_TAC] THEN - MATCH_MP_TAC(ISPEC `p:A prob_space` SUB_SIGMA_ALGEBRA_DIFF) THEN - ASM_REWRITE_TAC[] THEN CONJ_TAC THENL - [ASM_MESON_TAC[measurable_wrt]; - MATCH_MP_TAC MEASURABLE_WRT_STRICT_LT THEN ASM_REWRITE_TAC[]]);; +(* MEASURABLE_WRT_LEVEL_SET relocated to martingale_convergence.ml (used by the *) +(* general take-out lemmas there); available here via the earlier load. *) (* Martingale difference has zero expectation on any F_n-event *) let SIMPLE_MARTINGALE_DIFF_INDICATOR_ZERO = prove @@ -6449,6 +6433,7 @@ let COND_EXP_BOUNDED_VARIATION = prove ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC]; DISCH_TAC THEN ASM_REWRITE_TAC[]]]);; + (* Key lemma: bounded differences implies bounded Doob simple_martingale increments. Under mutual independence and bounded differences, the cond_exp increments along the rv_sigma filtration are bounded by [-c_i, c_i]. @@ -6972,6 +6957,7 @@ let DOOB_DECOMPOSITION_SUPER = prove UNDISCH_TAC `!n x:A. x IN prob_carrier (p:A prob_space) ==> --((X:num->A->real) n x) = (M':num->A->real) n x + (A':num->A->real) n x` THEN DISCH_THEN(MP_TAC o SPECL [`n:num`; `x:A`]) THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC]);; + (* ========================================================================= *) (* CLT COMPLETION: CONVERGENCE IN DISTRIBUTION TO STANDARD NORMAL *) (* ========================================================================= *) @@ -7009,7 +6995,7 @@ let HAS_REAL_INTEGRAL_STRETCH_UNIV = prove (* ========================================================================= *) (* GAUSSIAN INTEGRAL PROOF *) -(* Proved via the H(a)+J(a)=pi/4 approach (no gamma.ml needed) *) +(* Proved via the H(a)+J(a)=pi/4 approach (no gamma.ml needed) *) (* ========================================================================= *) @@ -8261,6 +8247,51 @@ let COS_TAYLOR2_BOUND = prove REWRITE_TAC[REAL_ABS_REFL; REAL_LE_POW_2]; ALL_TAC] THEN MP_TAC (SPEC `h:real` REAL_LE_POW_2) THEN REAL_ARITH_TAC]);; +(* SIN analog of COS_TAYLOR2_BOUND: second-order Taylor bound for sine *) +let SIN_TAYLOR2_BOUND = prove + (`!x h. abs(sin(x + h) - sin x - h * cos x) <= h pow 2`, + REPEAT GEN_TAC THEN + MP_TAC (ISPECL + [`\(i:num) (t:real). + if i = 0 then sin t + else if i = 1 then cos t + else --(sin t)`; + `1`; `(:real)`; `&1`] REAL_TAYLOR) THEN + REWRITE_TAC[IS_REALINTERVAL_UNIV; IN_UNIV] THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [REPEAT STRIP_TAC THEN + SUBGOAL_THEN `i = 0 \/ i = 1` DISJ_CASES_TAC THENL + [ASM_ARITH_TAC; ALL_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[WITHINREAL_UNIV; ETA_AX] THENL + [REWRITE_TAC[HAS_REAL_DERIVATIVE_SIN]; + REWRITE_TAC[HAS_REAL_DERIVATIVE_COS]]; + GEN_TAC THEN CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[REAL_ABS_NEG; SIN_BOUND]]; + ALL_TAC] THEN + DISCH_THEN (MP_TAC o SPECL [`x:real`; `x + h:real`]) THEN + REWRITE_TAC[REAL_ARITH `(x + h) - x = h:real`] THEN + SIMP_TAC[SUM_CLAUSES_LEFT; LE_0] THEN + CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[SUM_SING_NUMSEG] THEN + CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[FACT] THEN CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[CONJUNCT1 real_pow; REAL_POW_1; REAL_MUL_LID; REAL_MUL_RID; + REAL_DIV_1; REAL_ADD_RID] THEN + DISCH_TAC THEN + SUBGOAL_THEN `sin(x + h) - sin x - h * cos x = + sin(x + h) - (sin x + cos x * h)` SUBST1_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `abs h pow 2 / &2` THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + SUBGOAL_THEN `abs h pow 2 = h pow 2` SUBST1_TAC THENL + [ONCE_REWRITE_TAC[GSYM REAL_ABS_POW] THEN + REWRITE_TAC[REAL_ABS_REFL; REAL_LE_POW_2]; ALL_TAC] THEN + MP_TAC (SPEC `h:real` REAL_LE_POW_2) THEN REAL_ARITH_TAC]);; + (* General bound on the antiderivative *) let GAUSSIAN_ANTIDERIV_BOUND = prove (`!a b t. &0 < a @@ -8857,6 +8888,87 @@ let GAUSSIAN_FT_SIN = prove ASM_MESON_TAC[HAS_REAL_INTEGRAL_UNIQUE]; ALL_TAC] THEN ASM_MESON_TAC[REAL_INTEGRABLE_INTEGRAL]);; +(* Half-line Gaussian FT: integral over [0,infty) = half of full-line *) +let GAUSSIAN_FT_HALFLINE = prove + (`!b. ((\t. exp(--(t pow 2 / &2)) * cos(b * t)) has_real_integral + sqrt(&2 * pi) / &2 * exp(--(b pow 2 / &2))) {t | &0 <= t}`, + GEN_TAC THEN + ABBREV_TAC `f = \t:real. exp(--(t pow 2 / &2)) * cos(b * t)` THEN + SUBGOAL_THEN `(f has_real_integral + sqrt(&2 * pi) * exp(--(b pow 2 / &2))) (:real)` ASSUME_TAC THENL + [MP_TAC(SPECL [`&1`; `b:real`] GAUSSIAN_FT) THEN + REWRITE_TAC[REAL_LT_01; REAL_MUL_LID; REAL_MUL_RID; REAL_DIV_1] THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + (* f is even: f(-t) = f(t) *) + SUBGOAL_THEN `!t:real. (f:real->real)(--t) = f t` ASSUME_TAC THENL + [EXPAND_TAC "f" THEN GEN_TAC THEN + REWRITE_TAC[REAL_POW_NEG; ARITH; REAL_MUL_LNEG; REAL_NEG_NEG; + REAL_MUL_RNEG; COS_NEG]; ALL_TAC] THEN + (* f integrable on (:real) *) + SUBGOAL_THEN `f real_integrable_on (:real)` ASSUME_TAC THENL + [REWRITE_TAC[real_integrable_on] THEN ASM_MESON_TAC[]; ALL_TAC] THEN + (* f integrable on {t | 0 <= t} *) + SUBGOAL_THEN `f real_integrable_on {t | &0 <= t}` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_ON_SUBINTERVAL_GEN THEN + EXISTS_TAC `(:real)` THEN ASM_REWRITE_TAC[SUBSET_UNIV] THEN + REWRITE_TAC[is_realinterval; IN_ELIM_THM] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + (* f integrable on {t | t <= 0} *) + SUBGOAL_THEN `f real_integrable_on {t:real | t <= &0}` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_ON_SUBINTERVAL_GEN THEN + EXISTS_TAC `(:real)` THEN ASM_REWRITE_TAC[SUBSET_UNIV] THEN + REWRITE_TAC[is_realinterval; IN_ELIM_THM] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + (* By reflection: integral over {t<=0} = integral over {t>=0} *) + SUBGOAL_THEN `(f has_real_integral real_integral {t | &0 <= t} f) + {t:real | t <= &0}` ASSUME_TAC THENL + [MP_TAC(ISPECL [`f:real->real`; + `real_integral {t:real | &0 <= t} (f:real->real)`; + `{t:real | &0 <= t}`] HAS_REAL_INTEGRAL_REFLECT_GEN) THEN + SUBGOAL_THEN `IMAGE ((--):real->real) {t | &0 <= t} = {t:real | t <= &0}` + (fun th -> REWRITE_TAC[th]) THENL + [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM] THEN GEN_TAC THEN EQ_TAC THENL + [STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + DISCH_TAC THEN EXISTS_TAC `--x:real` THEN + ASM_REWRITE_TAC[REAL_NEG_NEG] THEN ASM_REAL_ARITH_TAC]; ALL_TAC] THEN + SUBGOAL_THEN `(\x. (f:real->real)(--x)) = f` (fun th -> REWRITE_TAC[th]) THENL + [REWRITE_TAC[FUN_EQ_THM] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + DISCH_THEN(fun th -> + MP_TAC(fst(EQ_IMP_RULE th)) THEN + ANTS_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_INTEGRAL THEN ASM_REWRITE_TAC[]; + MESON_TAC[]]); ALL_TAC] THEN + (* Combine: integral over R = 2 * integral over [0,infty) *) + SUBGOAL_THEN + `(f has_real_integral (real_integral {t | &0 <= t} f + + real_integral {t | &0 <= t} f)) + ({t:real | &0 <= t} UNION {t | t <= &0})` ASSUME_TAC THENL + [MATCH_MP_TAC HAS_REAL_INTEGRAL_UNION THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_INTEGRAL THEN ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + SUBGOAL_THEN `{t:real | &0 <= t} INTER {t | t <= &0} = {&0}` + (fun th -> REWRITE_TAC[th; REAL_NEGLIGIBLE_SING]) THEN + REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM; IN_SING] THEN + REAL_ARITH_TAC]; ALL_TAC] THEN + SUBGOAL_THEN `{t:real | &0 <= t} UNION {t | t <= &0} = (:real)` + ASSUME_TAC THENL + [REWRITE_TAC[EXTENSION; IN_UNION; IN_ELIM_THM; IN_UNIV] THEN + REAL_ARITH_TAC; ALL_TAC] THEN + (* By uniqueness: 2*I = full integral *) + SUBGOAL_THEN + `real_integral {t | &0 <= t} f + real_integral {t | &0 <= t} f = + sqrt(&2 * pi) * exp(--(b pow 2 / &2))` ASSUME_TAC THENL + [MATCH_MP_TAC HAS_REAL_INTEGRAL_UNIQUE THEN + EXISTS_TAC `f:real->real` THEN EXISTS_TAC `(:real)` THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; ALL_TAC] THEN + (* I = full/2 *) + SUBGOAL_THEN `real_integral {t | &0 <= t} f = + sqrt(&2 * pi) / &2 * exp(--(b pow 2 / &2))` ASSUME_TAC THENL + [MATCH_MP_TAC(REAL_ARITH `x + x = y * z ==> x = y / &2 * z`) THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + FIRST_X_ASSUM(fun th -> ONCE_REWRITE_TAC[GSYM th]) THEN + MATCH_MP_TAC REAL_INTEGRABLE_INTEGRAL THEN ASM_REWRITE_TAC[]);; + (* --- Phase 2: Standard Normal Distribution --- *) let std_normal_density = new_definition @@ -9076,6 +9188,74 @@ let STD_NORMAL_DENSITY_INTEGRABLE_UPPER_HALFLINE = prove DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[is_realinterval; IN_ELIM_THM] THEN REAL_ARITH_TAC);; +(* CDF at zero: by symmetry of the density, Phi(0) = 1/2 *) +let STD_NORMAL_CDF_ZERO = prove + (`std_normal_cdf(&0) = &1 / &2`, + REWRITE_TAC[std_normal_cdf] THEN + (* By reflection: integral over {t <= 0} = integral over {0 <= t} *) + SUBGOAL_THEN + `real_integral {t:real | t <= &0} std_normal_density = + real_integral {t:real | &0 <= t} std_normal_density` ASSUME_TAC THENL + [SUBGOAL_THEN `(std_normal_density has_real_integral + real_integral {t:real | &0 <= t} std_normal_density) + {t:real | t <= &0}` ASSUME_TAC THENL + [MP_TAC(ISPECL [`std_normal_density`; + `real_integral {t:real | &0 <= t} std_normal_density`; + `{t:real | &0 <= t}`] HAS_REAL_INTEGRAL_REFLECT_GEN) THEN + SUBGOAL_THEN `IMAGE ((--):real->real) {t | &0 <= t} = {t:real | t <= &0}` + (fun th -> REWRITE_TAC[th]) THENL + [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM] THEN GEN_TAC THEN EQ_TAC THENL + [STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + DISCH_TAC THEN EXISTS_TAC `--x:real` THEN + ASM_REWRITE_TAC[REAL_NEG_NEG] THEN ASM_REAL_ARITH_TAC]; ALL_TAC] THEN + SUBGOAL_THEN `(\x. std_normal_density(--x)) = std_normal_density` + (fun th -> REWRITE_TAC[th]) THENL + [REWRITE_TAC[FUN_EQ_THM; STD_NORMAL_DENSITY_SYM]; ALL_TAC] THEN + DISCH_THEN(fun th -> + MP_TAC(fst(EQ_IMP_RULE th)) THEN + ANTS_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_INTEGRAL THEN + REWRITE_TAC[STD_NORMAL_DENSITY_INTEGRABLE_UPPER_HALFLINE]; + MESON_TAC[]]); ALL_TAC] THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_UNIQUE THEN + EXISTS_TAC `std_normal_density` THEN EXISTS_TAC `{t:real | t <= &0}` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_INTEGRABLE_INTEGRAL THEN + MATCH_MP_TAC REAL_INTEGRABLE_ON_SUBINTERVAL_GEN THEN + EXISTS_TAC `(:real)` THEN + REWRITE_TAC[SUBSET_UNIV; STD_NORMAL_DENSITY_INTEGRABLE] THEN + REWRITE_TAC[is_realinterval; IN_ELIM_THM] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + (* 2 * integral_{t<=0} = 1 from full integral = 1 *) + SUBGOAL_THEN + `real_integral {t:real | t <= &0} std_normal_density + + real_integral {t:real | &0 <= t} std_normal_density = &1` ASSUME_TAC THENL + [SUBGOAL_THEN `(std_normal_density has_real_integral + (real_integral {t:real | t <= &0} std_normal_density + + real_integral {t:real | &0 <= t} std_normal_density)) + ({t:real | t <= &0} UNION {t | &0 <= t})` ASSUME_TAC THENL + [MATCH_MP_TAC HAS_REAL_INTEGRAL_UNION THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_INTEGRAL THEN + MATCH_MP_TAC REAL_INTEGRABLE_ON_SUBINTERVAL_GEN THEN + EXISTS_TAC `(:real)` THEN + REWRITE_TAC[SUBSET_UNIV; STD_NORMAL_DENSITY_INTEGRABLE] THEN + REWRITE_TAC[is_realinterval; IN_ELIM_THM] THEN REAL_ARITH_TAC; + MATCH_MP_TAC REAL_INTEGRABLE_INTEGRAL THEN + REWRITE_TAC[STD_NORMAL_DENSITY_INTEGRABLE_UPPER_HALFLINE]; + SUBGOAL_THEN `{t:real | t <= &0} INTER {t | &0 <= t} = {&0}` + (fun th -> REWRITE_TAC[th; REAL_NEGLIGIBLE_SING]) THEN + REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM; IN_SING] THEN + REAL_ARITH_TAC]; ALL_TAC] THEN + SUBGOAL_THEN `{t:real | t <= &0} UNION {t | &0 <= t} = (:real)` + ASSUME_TAC THENL + [REWRITE_TAC[EXTENSION; IN_UNION; IN_ELIM_THM; IN_UNIV] THEN + REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_UNIQUE THEN + EXISTS_TAC `std_normal_density` THEN EXISTS_TAC `(:real)` THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[STD_NORMAL_DENSITY_INTEGRAL]; + ALL_TAC] THEN + (* int_{t<=0} = int_{0<=t} and sum = 1, so int_{t<=0} = 1/2 *) + ASM_MESON_TAC[REAL_ARITH `a = b ==> a + b = &1 ==> a = &1 / &2`]);; + (* --- Phase 3: CLT Bridge --- *) (* The characteristic function of the standard normal distribution @@ -9299,6 +9479,7 @@ let X2_MINUS_1_GAUSSIAN_HAS_INTEGRAL_0 = prove MP_TAC(SPEC `a pow 2 / &4` REAL_EXP_POS_LE) THEN REAL_ARITH_TAC]]]);; + (* x^2 * exp(-x^2/2) has integral sqrt(2*pi) over (:real). Proof: x^2*exp = (x^2-1)*exp + exp, and integral of (x^2-1)*exp = 0, integral of exp = sqrt(2*pi). *) @@ -9537,6 +9718,104 @@ let CONVERGENCE_SET_IN_EVENTS = prove MATCH_MP_TAC LIMINF_EVENTS_IN_EVENTS THEN GEN_TAC THEN ASM_REWRITE_TAC[]);; +(* ------------------------------------------------------------------------- *) +(* Riesz subsequence theorem: convergence in probability implies almost-sure *) +(* convergence along a strictly increasing subsequence. Uses the adaptive *) +(* selector and off-limsup convergence lemmas from expectation.ml, the first *) +(* Borel-Cantelli lemma, and measurability of the convergence set above. *) +(* ------------------------------------------------------------------------- *) + +(* Given a strictly increasing r whose successor terms approach L at a dyadic *) +(* rate in probability, the subsequence converges to L almost surely. *) +let CONVERGES_AS_FROM_RATE = prove + (`!p:A prob_space X L (r:num->num). + (!n. random_variable p (X n)) /\ random_variable p L /\ + (!k. r k < r(SUC k)) /\ + (!k. prob p {x:A | x IN prob_carrier p /\ + abs(X (r(SUC k)) x - L x) >= inv(&2 pow k)} < inv(&2 pow k)) + ==> converges_as p (\k x. X (r k) x) L`, + REPEAT STRIP_TAC THEN + ABBREV_TAC `B = \k. {x:A | x IN prob_carrier p /\ abs((X:num->A->real) (r(SUC k)) x - L x) >= inv(&2 pow k)}` THEN + SUBGOAL_THEN `!k. (B:num->A->bool) k IN prob_events p` ASSUME_TAC THENL + [GEN_TAC THEN EXPAND_TAC "B" THEN MATCH_MP_TAC RV_PREIMAGE_GE THEN + MATCH_MP_TAC RANDOM_VARIABLE_ABS THEN MATCH_MP_TAC RANDOM_VARIABLE_SUB THEN + ASM_REWRITE_TAC[ETA_AX]; ALL_TAC] THEN + SUBGOAL_THEN `prob p (limsup_events (B:num->A->bool)) = &0` ASSUME_TAC THENL + [MATCH_MP_TAC FIRST_BOREL_CANTELLI THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_SUMMABLE_COMPARISON THEN + EXISTS_TAC `\k:num. inv(&2 pow k)` THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM REAL_POW_INV] THEN MATCH_MP_TAC REAL_SUMMABLE_GP THEN + REWRITE_TAC[REAL_ABS_INV; REAL_ABS_NUM] THEN CONV_TAC REAL_RAT_REDUCE_CONV; + EXISTS_TAC `0` THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN BETA_TAC THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= q /\ q < b ==> abs q <= b`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC PROB_POSITIVE THEN ASM_REWRITE_TAC[]; + EXPAND_TAC "B" THEN ASM_REWRITE_TAC[]]]; + ALL_TAC] THEN + REWRITE_TAC[converges_as] THEN + MP_TAC(ISPECL [`p:A prob_space`; `\k:num. \x:A. (X:num->A->real) (r k) x`; `L:A->real`] + CONVERGENCE_SET_IN_EVENTS) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [GEN_TAC THEN BETA_TAC THEN ASM_REWRITE_TAC[ETA_AX]; ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + BETA_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(REAL_ARITH `&1 <= q /\ q <= &1 ==> q = &1`) THEN + CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC PROB_LE_1 THEN ASM_REWRITE_TAC[]] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `prob p (prob_carrier p DIFF limsup_events (B:num->A->bool))` THEN + CONJ_TAC THENL + [ASM_SIMP_TAC[PROB_COMPL; LIMSUP_EVENTS_IN_EVENTS] THEN ASM_REWRITE_TAC[] THEN + REAL_ARITH_TAC; + MATCH_MP_TAC PROB_MONO THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [MATCH_MP_TAC PROB_DIFF_IN_EVENTS THEN + ASM_SIMP_TAC[PROB_CARRIER_IN_EVENTS; LIMSUP_EVENTS_IN_EVENTS]; + ALL_TAC] THEN + REWRITE_TAC[SUBSET; IN_DIFF; IN_ELIM_THM] THEN X_GEN_TAC `x:A` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`X:num->A->real`; `L:A->real`; `r:num->num`; `x:A`; + `B:num->A->bool`; `p:A prob_space`] OFF_LIMSUP_CONVERGES) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + GEN_TAC THEN EXPAND_TAC "B" THEN REWRITE_TAC[]]);; + +let CONVERGES_IN_PROB_AE_SUBSEQUENCE = prove + (`!p:A prob_space X L. + (!n. random_variable p (X n)) /\ random_variable p L /\ + converges_in_prob p X L + ==> ?r:num->num. (!k. r k < r(SUC k)) /\ + converges_as p (\k x. X (r k) x) L`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPEC + `\k n. prob p {x:A | x IN prob_carrier p /\ abs((X:num->A->real) n x - L x) >= inv(&2 pow k)} < inv(&2 pow k)` + ADAPTIVE_SELECTOR_DEP) THEN + ANTS_TAC THENL + [REWRITE_TAC[] THEN MAP_EVERY X_GEN_TAC [`k:num`; `m:num`] THEN + FIRST_ASSUM(MP_TAC o SPEC `inv(&2 pow k)` o REWRITE_RULE[converges_in_prob]) THEN + ANTS_TAC THENL + [REWRITE_TAC[REAL_LT_INV_EQ] THEN MATCH_MP_TAC REAL_POW_LT THEN REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + DISCH_THEN(MP_TAC o SPEC `inv(&2 pow k)`) THEN + ANTS_TAC THENL + [REWRITE_TAC[REAL_LT_INV_EQ] THEN MATCH_MP_TAC REAL_POW_LT THEN REAL_ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_TAC `NN:num`) THEN + EXISTS_TAC `NN + m + 1` THEN CONJ_TAC THENL [ARITH_TAC; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `NN + m + 1`) THEN + REWRITE_TAC[ARITH_RULE `NN <= NN + m + 1`] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= q ==> abs(q - &0) < e ==> q < e`) THEN + MATCH_MP_TAC PROB_POSITIVE THEN MATCH_MP_TAC RV_PREIMAGE_GE THEN + MATCH_MP_TAC RANDOM_VARIABLE_ABS THEN MATCH_MP_TAC RANDOM_VARIABLE_SUB THEN + ASM_REWRITE_TAC[ETA_AX]; + ALL_TAC] THEN + REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `r:num->num` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `r:num->num` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC CONVERGES_AS_FROM_RATE THEN ASM_REWRITE_TAC[]);; + (* Helper: INTERS of tail unions SUBSET complement of convergence set *) let INTERS_TAIL_UNIONS_SUBSET_COMPL = prove (`!p:A prob_space (X:num->A->real) (L:A->real) (e:real). @@ -9750,6 +10029,44 @@ let REALLIM_SUBSEQUENCE = prove ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `k:num`) THEN ASM_ARITH_TAC);; +(* A subsequence of a sequence converging in probability converges in *) +(* probability to the same limit (the per-epsilon probabilities form a *) +(* convergent real sequence, so any subsequence shares the limit). *) +let CONVERGES_IN_PROB_SUBSEQUENCE = prove + (`!p:A prob_space X L (r:num->num). + converges_in_prob p X L /\ (!m n. m < n ==> r m < r n) + ==> converges_in_prob p (\k x. X (r k) x) L`, + REPEAT GEN_TAC THEN REWRITE_TAC[converges_in_prob] THEN STRIP_TAC THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MP_TAC(ISPECL + [`\n. prob p {x:A | x IN prob_carrier p /\ abs((X:num->A->real) n x - L x) >= e}`; + `&0`; `r:num->num`] REALLIM_SUBSEQUENCE) THEN ASM_REWRITE_TAC[]);; + +(* Subsequence principle (forward direction): if X converges to L in *) +(* probability, then every subsequence has a further subsequence converging *) +(* to L almost surely. A subsequence still converges in probability, and *) +(* Riesz extracts an almost-surely convergent sub-subsequence. *) +let CONVERGES_IN_PROB_SUBSEQUENCE_PRINCIPLE = prove + (`!p:A prob_space X L (r:num->num). + (!n. random_variable p (X n)) /\ random_variable p L /\ + converges_in_prob p X L /\ (!m n. m < n ==> r m < r n) + ==> ?s:num->num. (!m n. m < n ==> s m < s n) /\ + converges_as p (\k x. X (r(s k)) x) L`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `\k:num. \x:A. (X:num->A->real) (r k) x`; `L:A->real`] + CONVERGES_IN_PROB_AE_SUBSEQUENCE) THEN + ANTS_TAC THENL + [REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [GEN_TAC THEN REWRITE_TAC[ETA_AX] THEN ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + MATCH_MP_TAC CONVERGES_IN_PROB_SUBSEQUENCE THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `s:num->num` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `s:num->num` THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSEQUENCE_STEPWISE] THEN ASM_REWRITE_TAC[]; + RULE_ASSUM_TAC(BETA_RULE) THEN ASM_REWRITE_TAC[]]);; + (* ---- Helper lemmas for the sandwich argument ---- *) (* CDF as expectation of indicator *) @@ -13614,7 +13931,7 @@ let ABS_GE_IN_EVENTS = prove [SET_TAC[REAL_ARITH `!x M:real. abs x >= M <=> x >= M \/ x <= --M`]; MATCH_MP_TAC PROB_UNION_IN_EVENTS THEN CONJ_TAC THENL - [MATCH_MP_TAC RANDOM_VARIABLE_GE THEN ASM_REWRITE_TAC[]; + [MATCH_MP_TAC RV_PREIMAGE_GE THEN ASM_REWRITE_TAC[]; REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC DIST_FN_IN_EVENTS THEN ASM_REWRITE_TAC[]]]);; @@ -14744,3 +15061,2605 @@ let QUANTITATIVE_CDF_LOWER = prove REWRITE_TAC[REAL_SUB_SUB2]; ALL_TAC] THEN ASM_REAL_ARITH_TAC);; + +(* ======================================================================== *) +(* Dirichlet integral: int_0^T sin(t)/t dt = pi/2 - R(T) with |R(T)|<=1/T *) +(* Proof via Laplace transform of sin + Fubini + arctan limit. *) +(* ======================================================================== *) + +(* Laplace transform of sin on [0,T]: int_0^T sin(t)exp(-vt) dt *) +let LAPLACE_SIN = prove + (`!v TT. &0 < v /\ &0 <= TT ==> + ((\t. sin(t) * exp(--v * t)) has_real_integral + (&1 - exp(--v * TT) * (cos TT + v * sin TT)) / (&1 + v pow 2)) + (real_interval[&0, TT])`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `~(&1 + v pow 2 = &0)` ASSUME_TAC THENL + [MATCH_MP_TAC(REAL_ARITH `&0 < x ==> ~(x = &0)`) THEN + MATCH_MP_TAC REAL_LTE_ADD THEN REWRITE_TAC[REAL_LT_01; REAL_LE_POW_2]; + ALL_TAC] THEN + SUBGOAL_THEN + `(&1 - exp(--v * TT) * (cos TT + v * sin TT)) / (&1 + v pow 2) = + exp(--v * TT) * (--v * sin TT - cos TT) * inv(&1 + v pow 2) - + exp(--v * &0) * (--v * sin(&0) - cos(&0)) * inv(&1 + v pow 2)` + SUBST1_TAC THENL + [REWRITE_TAC[REAL_MUL_RZERO; REAL_NEG_0; SIN_0; COS_0; REAL_EXP_0; + REAL_MUL_LZERO; REAL_SUB_RZERO; REAL_MUL_LID; real_div] THEN + REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS THEN + ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_REAL_DERIVATIVE_ATREAL_WITHIN THEN + REAL_DIFF_TAC THEN + UNDISCH_TAC `~(&1 + v pow 2 = &0)` THEN CONV_TAC REAL_FIELD);; + +(* Integral representation: int_0^s exp(-ut) du = (1-exp(-st))/t for t>0 *) +let EXP_INTEGRAL_REP = prove + (`!s t. &0 <= s /\ &0 < t ==> + ((\u. exp(--u * t)) has_real_integral ((&1 - exp(--s * t)) / t)) + (real_interval[&0, s])`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `~(t = &0)` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `(&1 - exp(--s * t)) / t = + (--inv(t)) * exp(--s * t) - (--inv(t)) * exp(--(&0) * t)` + SUBST1_TAC THENL + [REWRITE_TAC[REAL_MUL_LZERO; REAL_NEG_0; REAL_EXP_0] THEN + ASM_SIMP_TAC[REAL_FIELD `~(t = &0) ==> + --inv t * e - --inv t * &1 = (&1 - e) / t`]; ALL_TAC] THEN + MATCH_MP_TAC REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS THEN + ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_REAL_DERIVATIVE_ATREAL_WITHIN THEN + SUBGOAL_THEN `exp(--x * t) = --inv(t) * (--t * exp(--x * t))` SUBST1_TAC + THENL + [ASM_SIMP_TAC[REAL_FIELD `~(t = &0) ==> --inv t * (--t * e) = e`]; + ALL_TAC] THEN + MATCH_MP_TAC HAS_REAL_DERIVATIVE_LMUL_ATREAL THEN + REAL_DIFF_TAC THEN REAL_ARITH_TAC);; + +(* Integral of 1/(1+u^2) on [0,s] equals arctan(s) *) +let INTEGRAL_INV_ONE_PLUS_SQ = prove + (`!s. &0 <= s ==> + ((\u. inv(&1 + u pow 2)) has_real_integral atn(s)) + (real_interval[&0, s])`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `atn(s) = atn(s) - atn(&0)` SUBST1_TAC THENL + [REWRITE_TAC[ATN_0; REAL_SUB_RZERO]; ALL_TAC] THEN + MATCH_MP_TAC REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS THEN + ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_REAL_DERIVATIVE_ATREAL_WITHIN THEN + REWRITE_TAC[HAS_REAL_DERIVATIVE_ATN]);; + +(* 2D continuity of the Fubini integrand sin(t)*exp(-u*t) *) +let SIN_EXP_2D_CONTINUOUS = prove + (`(\z. lift(sin(drop(fstcart z)) * exp(--drop(sndcart z) * drop(fstcart z)))) + continuous_on (:real^(1,1)finite_sum)`, + SUBGOAL_THEN + `(\z:real^(1,1)finite_sum. lift(sin(drop(fstcart z)) * + exp(--drop(sndcart z) * drop(fstcart z)))) = + (\z. lift(((lift(sin(drop(fstcart z))):real^1) dot + (lift(exp(--drop(sndcart z) * drop(fstcart z))):real^1))))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; DOT_1; LIFT_COMPONENT; DIMINDEX_1; ARITH]; + ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_LIFT_DOT2 THEN CONJ_TAC THENL + [(* sin(drop(fstcart z)) = (lift o sin o drop) o fstcart *) + SUBGOAL_THEN + `(\z:real^(1,1)finite_sum. lift(sin(drop(fstcart z)))) = + (lift o sin o drop) o (fstcart:real^(1,1)finite_sum->real^1)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; o_DEF]; ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL + [MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN REWRITE_TAC[LINEAR_FSTCART]; + MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `(:real^1)` THEN + REWRITE_TAC[SUBSET_UNIV; GSYM IMAGE_LIFT_UNIV; GSYM REAL_CONTINUOUS_ON; + REAL_CONTINUOUS_ON_SIN]]; + (* exp(--drop(sndcart z) * drop(fstcart z)) *) + SUBGOAL_THEN + `(\z:real^(1,1)finite_sum. + lift(exp(--drop(sndcart z) * drop(fstcart z)))) = + (lift o exp o drop) o + (\z:real^(1,1)finite_sum. + lift(--drop(sndcart z) * drop(fstcart z)))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; o_DEF; LIFT_DROP]; ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL + [SUBGOAL_THEN + `(\z:real^(1,1)finite_sum. + lift(--drop(sndcart z) * drop(fstcart z))) = + (\z. --(lift((sndcart z:real^1) dot (fstcart z:real^1))))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; DOT_1; DIMINDEX_1; ARITH; GSYM drop; + GSYM LIFT_NEG; LIFT_EQ; REAL_MUL_LNEG]; ALL_TAC] THEN + MATCH_MP_TAC CONTINUOUS_ON_NEG THEN + MATCH_MP_TAC CONTINUOUS_ON_LIFT_DOT2 THEN CONJ_TAC THEN + MATCH_MP_TAC LINEAR_CONTINUOUS_ON THEN + REWRITE_TAC[LINEAR_SNDCART; LINEAR_FSTCART]; + MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `(:real^1)` THEN + REWRITE_TAC[SUBSET_UNIV; GSYM IMAGE_LIFT_UNIV; GSYM REAL_CONTINUOUS_ON; + REAL_CONTINUOUS_ON_EXP]]]);; + +(* Fubini swap for sin(t)*exp(-u*t) on [0,TT] x [0,s] *) +let SIN_EXP_FUBINI = prove + (`!s TT. &0 <= s /\ &0 <= TT ==> + integral (interval [lift (&0),lift TT]) + (\t. integral (interval [lift (&0),lift s]) + (\u. lift (sin (drop t) * exp (--drop u * drop t)))) = + integral (interval [lift (&0),lift s]) + (\u. integral (interval [lift (&0),lift TT]) + (\t. lift (sin (drop t) * exp (--drop u * drop t))))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`\t u:real^1. lift(sin(drop t) * exp(--drop u * drop t))`; + `lift(&0):real^1`; `lift TT:real^1`; `lift(&0):real^1`; `lift s:real^1`] + INTEGRAL_SWAP_CONTINUOUS) THEN + REWRITE_TAC[BETA_THM] THEN DISCH_THEN MATCH_MP_TAC THEN + MATCH_MP_TAC CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `(:real^(1,1)finite_sum)` THEN + REWRITE_TAC[SUBSET_UNIV; SIN_EXP_2D_CONTINUOUS]);; + +(* Bridge: has_real_integral gives vector integral value *) +let LIFT_INTEGRAL_BRIDGE = prove + (`!f a b y. (f has_real_integral y) (real_interval[a,b]) ==> + integral (interval[lift a, lift b]) (\x. lift(f(drop x))) = lift y`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRAL_UNIQUE THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [has_real_integral]) THEN + REWRITE_TAC[o_DEF; IMAGE_LIFT_REAL_INTERVAL; LIFT_DROP]);; + +(* Inner integral over u for fixed t: evaluates to sin(t)*(1-exp(-st))/t *) +let INNER_INTEGRAL_U = prove + (`!s t. &0 <= s /\ &0 <= t ==> + integral (interval [lift (&0),lift s]) + (\u. lift (sin t * exp (--drop u * t))) = + lift (sin t * (&1 - exp (--s * t)) / t)`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `t = &0` THENL + [ASM_REWRITE_TAC[SIN_0; REAL_MUL_LZERO; REAL_EXP_0; REAL_MUL_RZERO; + REAL_NEG_0; REAL_SUB_REFL; real_div; LIFT_NUM] THEN + REWRITE_TAC[GSYM LIFT_NUM; INTEGRAL_0]; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < t` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `(\u:real^1. lift (sin t * exp (--drop u * t))) = + (\u. sin(t) % lift(exp(--drop u * t)))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; GSYM LIFT_CMUL]; ALL_TAC] THEN + SUBGOAL_THEN + `integral (interval[lift(&0), lift s]) (\u:real^1. lift(exp(--drop u * t))) + = lift((&1 - exp(--s * t)) / t)` ASSUME_TAC THENL + [MATCH_MP_TAC LIFT_INTEGRAL_BRIDGE THEN + MATCH_MP_TAC EXP_INTEGRAL_REP THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `(\u:real^1. lift(exp(--drop u * t))) integrable_on interval[lift(&0), lift s]` + ASSUME_TAC THENL + [REWRITE_TAC[integrable_on] THEN + EXISTS_TAC `lift((&1 - exp(--s * t)) / t)` THEN + MP_TAC(SPECL [`s:real`; `t:real`] EXP_INTEGRAL_REP) THEN + ASM_REWRITE_TAC[has_real_integral; o_DEF; IMAGE_LIFT_REAL_INTERVAL; + LIFT_DROP]; + ALL_TAC] THEN + ASM_SIMP_TAC[INTEGRAL_CMUL] THEN + REWRITE_TAC[GSYM LIFT_CMUL] THEN AP_TERM_TAC THEN ASM_REWRITE_TAC[]);; + +(* Inner integral over t for fixed u: evaluates Laplace transform of sin *) +let INNER_INTEGRAL_T = prove + (`!u TT. &0 <= u /\ &0 <= TT ==> + integral (interval [lift (&0),lift TT]) + (\t. lift (sin (drop t) * exp (--u * drop t))) = + lift ((&1 - exp (--u * TT) * (cos TT + u * sin TT)) / (&1 + u pow 2))`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `u = &0` THENL + [ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_NEG_0; REAL_EXP_0; REAL_MUL_LID; + REAL_MUL_RZERO; REAL_MUL_RID; REAL_ADD_RID] THEN + CONV_TAC(ONCE_DEPTH_CONV REAL_RAT_REDUCE_CONV) THEN + REWRITE_TAC[REAL_DIV_1] THEN + MATCH_MP_TAC LIFT_INTEGRAL_BRIDGE THEN + SUBGOAL_THEN `&1 - cos TT = --cos TT - --cos(&0)` SUBST1_TAC THENL + [REWRITE_TAC[COS_0] THEN REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS THEN + ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_REAL_DERIVATIVE_ATREAL_WITHIN THEN + REAL_DIFF_TAC THEN REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < u` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC LIFT_INTEGRAL_BRIDGE THEN + MATCH_MP_TAC LAPLACE_SIN THEN ASM_REWRITE_TAC[]);; + +(* Factoring: sin(t)*(1-exp(-st))/t = sinc(t)*(1-exp(-st)) *) +let SINC_EXP_EQ = prove + (`!s t. sin(t) * (&1 - exp(--(s * t))) * inv(t) = + (if t = &0 then &1 else sin(t) * inv(t)) * (&1 - exp(--(s * t)))`, + REPEAT GEN_TAC THEN COND_CASES_TAC THENL + [ASM_REWRITE_TAC[SIN_0; REAL_MUL_LZERO; REAL_MUL_RZERO; REAL_NEG_0; + REAL_EXP_0; REAL_SUB_REFL; REAL_MUL_LID]; + REWRITE_TAC[REAL_MUL_AC]]);; + +(* Integrability of sin(t)*(1-exp(-st))/t on [0,TT] via sinc factoring *) +let LHS_INTEGRABLE = prove + (`!s TT. &0 <= s /\ &0 <= TT ==> + (\t. sin t * (&1 - exp(--(s * t))) * inv t) + real_integrable_on real_interval[&0,TT]`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRABLE_EQ THEN + EXISTS_TAC `\t. (if t = &0 then &1 else sin t * inv t) * + (&1 - exp(--(s * t)))` THEN + CONJ_TAC THENL + [REWRITE_TAC[BETA_THM] THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[GSYM SINC_EXP_EQ]; + MATCH_MP_TAC REAL_INTEGRABLE_CONTINUOUS THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_MUL THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM real_div; SINC_CONTINUOUS]; + MATCH_MP_TAC REAL_CONTINUOUS_ON_SUB THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_CONST] THEN + MATCH_MP_TAC(REWRITE_RULE[o_DEF] REAL_CONTINUOUS_ON_COMPOSE) THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_ON_NEG THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_LMUL THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_ID]; + REWRITE_TAC[REAL_CONTINUOUS_ON_EXP]]]]);; + +(* Integrability of the RHS integrand on [0,s] *) +let RHS_INTEGRABLE = prove + (`!s TT. &0 <= s /\ &0 <= TT ==> + (\u. (&1 - exp(--u * TT) * (cos TT + u * sin TT)) / (&1 + u pow 2)) + real_integrable_on real_interval[&0,s]`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRABLE_CONTINUOUS THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_DIV THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_ON_SUB THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_CONST] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC(REWRITE_RULE[o_DEF] REAL_CONTINUOUS_ON_COMPOSE) THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_ON_MUL THEN + SUBGOAL_THEN `(--) = (\x:real. --x)` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM]; ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_ON_NEG THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_ID]; + REWRITE_TAC[REAL_CONTINUOUS_ON_CONST]]; + REWRITE_TAC[REAL_CONTINUOUS_ON_EXP]]; + MATCH_MP_TAC REAL_CONTINUOUS_ON_ADD THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_CONST] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_MUL THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_ID; REAL_CONTINUOUS_ON_CONST]]; + ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_ON_ADD THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_CONST] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_POW THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_ID]; + REPEAT STRIP_TAC THEN + MP_TAC(SPEC `u:real` REAL_LE_POW_2) THEN ASM_REAL_ARITH_TAC]);; + +(* Main Fubini identity: int_0^T sin(t)(1-exp(-st))/t dt = int_0^s g(u) du *) +let SINC_INTEGRAL_IDENTITY = prove + (`!s TT. &0 <= s /\ &0 < TT ==> + real_integral (real_interval[&0,TT]) + (\t. sin t * (&1 - exp(--(s * t))) * inv t) = + real_integral (real_interval[&0,s]) + (\u. (&1 - exp(--u * TT) * (cos TT + u * sin TT)) / (&1 + u pow 2))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&0 <= TT` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `(\t. sin t * (&1 - exp(--(s * t))) * inv t) + real_integrable_on real_interval[&0,TT]` ASSUME_TAC THENL + [MATCH_MP_TAC LHS_INTEGRABLE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `(\u. (&1 - exp(--u * TT) * (cos TT + u * sin TT)) / + (&1 + u pow 2)) real_integrable_on real_interval[&0,s]` ASSUME_TAC THENL + [MATCH_MP_TAC RHS_INTEGRABLE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_INTEGRAL; IMAGE_LIFT_REAL_INTERVAL] THEN + REWRITE_TAC[o_DEF] THEN AP_TERM_TAC THEN + (* LHS_vec = Fubini_LHS *) + SUBGOAL_THEN + `integral (interval [lift (&0),lift TT]) + (\x. lift (sin (drop x) * (&1 - exp (--(s * drop x))) * inv (drop x))) = + integral (interval [lift (&0),lift TT]) + (\t. integral (interval [lift (&0),lift s]) + (\u. lift (sin (drop t) * exp (--drop u * drop t))))` + SUBST1_TAC THENL + [MATCH_MP_TAC INTEGRAL_EQ THEN REWRITE_TAC[BETA_THM] THEN + X_GEN_TAC `t:real^1` THEN DISCH_TAC THEN + MP_TAC(SPECL [`s:real`; `drop(t:real^1)`] INNER_INTEGRAL_U) THEN + SUBGOAL_THEN `&0 <= s /\ &0 <= drop t` ASSUME_TAC THENL + [ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `t IN interval [lift (&0),lift TT]` THEN + REWRITE_TAC[IN_INTERVAL; DIMINDEX_1; FORALL_1; GSYM drop; LIFT_DROP] THEN + REAL_ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + ASM_REWRITE_TAC[] THEN AP_TERM_TAC THEN + REWRITE_TAC[real_div; REAL_MUL_LNEG]; + ALL_TAC] THEN + (* Fubini_LHS = Fubini_RHS *) + SUBGOAL_THEN + `integral (interval [lift (&0),lift TT]) + (\t. integral (interval [lift (&0),lift s]) + (\u. lift (sin (drop t) * exp (--drop u * drop t)))) = + integral (interval [lift (&0),lift s]) + (\u. integral (interval [lift (&0),lift TT]) + (\t. lift (sin (drop t) * exp (--drop u * drop t))))` + SUBST1_TAC THENL + [MP_TAC(SPECL [`s:real`; `TT:real`] SIN_EXP_FUBINI) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + (* Fubini_RHS = RHS_vec *) + MATCH_MP_TAC INTEGRAL_EQ THEN REWRITE_TAC[BETA_THM] THEN + X_GEN_TAC `u:real^1` THEN DISCH_TAC THEN + MP_TAC(SPECL [`drop(u:real^1)`; `TT:real`] INNER_INTEGRAL_T) THEN + SUBGOAL_THEN `&0 <= drop u` ASSUME_TAC THENL + [UNDISCH_TAC `u IN interval [lift (&0),lift s]` THEN + REWRITE_TAC[IN_INTERVAL; DIMINDEX_1; FORALL_1; GSYM drop; LIFT_DROP] THEN + REAL_ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[]);; + +(* Split RHS integral: int_0^s g(u) du = atn(s) - error_term *) +let SINC_INTEGRAL_SPLIT = prove + (`!s TT. &0 <= s /\ &0 <= TT ==> + real_integral (real_interval[&0,s]) + (\u. (&1 - exp(--u * TT) * (cos TT + u * sin TT)) / (&1 + u pow 2)) = + atn(s) - + real_integral (real_interval[&0,s]) + (\u. exp(--u * TT) * (cos TT + u * sin TT) / (&1 + u pow 2))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `!u. (&1 - exp(--u * TT) * (cos TT + u * sin TT)) / (&1 + u pow 2) = + inv(&1 + u pow 2) - + exp(--u * TT) * (cos TT + u * sin TT) / (&1 + u pow 2)` + (fun th -> REWRITE_TAC[th]) THENL + [GEN_TAC THEN REWRITE_TAC[real_div; REAL_SUB_RDISTRIB; REAL_MUL_LID] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC]; + ALL_TAC] THEN + SUBGOAL_THEN `(\u. inv(&1 + u pow 2)) real_integrable_on + real_interval[&0,s]` ASSUME_TAC THENL + [REWRITE_TAC[real_integrable_on] THEN EXISTS_TAC `atn(s)` THEN + MATCH_MP_TAC INTEGRAL_INV_ONE_PLUS_SQ THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `(\u. exp(--u * TT) * (cos TT + u * sin TT) / (&1 + u pow 2)) + real_integrable_on real_interval[&0,s]` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_CONTINUOUS THEN + REWRITE_TAC[real_div] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC(REWRITE_RULE[o_DEF] REAL_CONTINUOUS_ON_COMPOSE) THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_ON_MUL THEN + SUBGOAL_THEN `(--) = (\x:real. --x)` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM]; ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_ON_NEG THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_ID]; + REWRITE_TAC[REAL_CONTINUOUS_ON_CONST]]; + REWRITE_TAC[REAL_CONTINUOUS_ON_EXP]]; + MATCH_MP_TAC REAL_CONTINUOUS_ON_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_ON_ADD THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_CONST] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_MUL THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_ID; REAL_CONTINUOUS_ON_CONST]; + SUBGOAL_THEN `(\u:real. inv (&1 + u pow 2)) = + (\u. inv((\u. &1 + u pow 2) u))` SUBST1_TAC THENL + [REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + X_GEN_TAC `u:real` THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_WITHINREAL THEN + MATCH_MP_TAC REAL_DIFFERENTIABLE_IMP_CONTINUOUS_ATREAL THEN + REWRITE_TAC[real_differentiable] THEN + EXISTS_TAC `--(&2 * u) / (&1 + u pow 2) pow 2` THEN + REAL_DIFF_TAC THEN CONJ_TAC THENL + [SUBGOAL_THEN `&0 < &1 + u pow 2` MP_TAC THENL + [MATCH_MP_TAC REAL_LTE_ADD THEN REWRITE_TAC[REAL_LT_01; REAL_LE_POW_2]; + REAL_ARITH_TAC]; + CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[REAL_POW_1] THEN + REAL_ARITH_TAC]]]; + ALL_TAC] THEN + ASM_SIMP_TAC[REAL_INTEGRAL_SUB] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + MATCH_MP_TAC INTEGRAL_INV_ONE_PLUS_SQ THEN ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Dirichlet integral: lim_{T->inf} int_0^T sin(t)/t dt = pi/2 *) +(* Proved via Laplace transform + Fubini on compact rectangles: *) +(* int sin(t)/t = int sin(t)(1-exp(-Tt))/t + int sin(t)exp(-Tt)/t *) +(* First part = atn(T) - error_integral, second bounded by 1/T *) +(* ------------------------------------------------------------------------- *) + +let SINC_INV_INTEGRABLE = prove + (`!TT. &0 < TT ==> + (\t. sin t * inv t) real_integrable_on real_interval[&0,TT]`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`\t:real. if t = &0 then &1 else sin t / t`; + `\t:real. sin t * inv t`; + `{&0:real}`; + `real_interval[&0,TT]`] REAL_INTEGRABLE_SPIKE) THEN + ANTS_TAC THENL + [REWRITE_TAC[REAL_NEGLIGIBLE_SING] THEN + X_GEN_TAC `t:real` THEN REWRITE_TAC[IN_DIFF; IN_SING] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[real_div]; + DISCH_THEN MATCH_MP_TAC THEN + MATCH_MP_TAC SINC_INTEGRABLE THEN ASM_REAL_ARITH_TAC]);; + +let SINC_EXP_DECAY_INTEGRABLE = prove + (`!TT. &0 < TT ==> + (\t. sin t * exp(--(TT * t)) * inv t) real_integrable_on + real_interval[&0,TT]`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`\t:real. (if t = &0 then &1 else sin t / t) * + exp(--(TT * t))`; + `\t:real. sin t * exp(--(TT * t)) * inv t`; + `{&0:real}`; + `real_interval[&0,TT]`] REAL_INTEGRABLE_SPIKE) THEN + ANTS_TAC THENL + [REWRITE_TAC[REAL_NEGLIGIBLE_SING] THEN + X_GEN_TAC `t:real` THEN REWRITE_TAC[IN_DIFF; IN_SING] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[real_div] THEN REAL_ARITH_TAC; + DISCH_THEN MATCH_MP_TAC THEN + MATCH_MP_TAC REAL_INTEGRABLE_CONTINUOUS THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_MUL THEN CONJ_TAC THENL + [REWRITE_TAC[SINC_CONTINUOUS]; + MATCH_MP_TAC(REWRITE_RULE[o_DEF] REAL_CONTINUOUS_ON_COMPOSE) THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_ON_NEG THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_MUL THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_CONST; REAL_CONTINUOUS_ON_ID]; + REWRITE_TAC[REAL_CONTINUOUS_ON_EXP]]]]);; + +let SINC_DECOMPOSITION = prove + (`!TT. &0 < TT ==> + real_integral (real_interval[&0,TT]) (\t. sin t * inv t) = + real_integral (real_interval[&0,TT]) + (\t. sin t * (&1 - exp(--(TT * t))) * inv t) + + real_integral (real_interval[&0,TT]) + (\t. sin t * exp(--(TT * t)) * inv t)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\t. sin t * inv t) = + (\t. (sin t * (&1 - exp(--(TT * t))) * inv t) + + (sin t * exp(--(TT * t)) * inv t))` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `t:real` THEN REAL_ARITH_TAC; + MATCH_MP_TAC REAL_INTEGRAL_ADD THEN CONJ_TAC THENL + [SUBGOAL_THEN + `(\t. sin t * (&1 - exp(--(TT * t))) * inv t) = + (\t. sin t * inv t - sin t * exp(--(TT * t)) * inv t)` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `t:real` THEN REAL_ARITH_TAC; + MATCH_MP_TAC REAL_INTEGRABLE_SUB THEN CONJ_TAC THENL + [MATCH_MP_TAC SINC_INV_INTEGRABLE THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC SINC_EXP_DECAY_INTEGRABLE THEN ASM_REWRITE_TAC[]]]; + MATCH_MP_TAC SINC_EXP_DECAY_INTEGRABLE THEN ASM_REWRITE_TAC[]]]);; + +let EXP_DECAY_INTEGRAL = prove + (`!TT. &0 < TT ==> + ((\t. exp(--(TT * t))) has_real_integral + inv TT * (&1 - exp(--(TT * TT)))) (real_interval[&0,TT])`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `((\x. TT * exp(--(TT * x))) has_real_integral + (&1 - exp(--(TT * TT)))) (real_interval[&0,TT])` + ASSUME_TAC THENL + [MP_TAC(ISPECL [`\x:real. --exp(--(TT * x))`; + `\x:real. TT * exp(--(TT * x))`; + `&0`; `TT:real`] + REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN ANTS_TAC THENL + [REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_REAL_DERIVATIVE_ATREAL_WITHIN THEN + REAL_DIFF_TAC THEN REAL_ARITH_TAC; + REWRITE_TAC[REAL_MUL_RZERO; REAL_NEG_0; REAL_EXP_0] THEN + REWRITE_TAC[REAL_ARITH `--a - --(&1) = &1 - a`]]; + MATCH_MP_TAC HAS_REAL_INTEGRAL_EQ THEN + EXISTS_TAC `\x:real. inv TT * (TT * exp(--(TT * x)))` THEN CONJ_TAC THENL + [X_GEN_TAC `x:real` THEN DISCH_TAC THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN + SUBGOAL_THEN `inv TT * TT = &1` SUBST1_TAC THENL + [MATCH_MP_TAC REAL_MUL_LINV THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[REAL_MUL_LID]]; + MATCH_MP_TAC HAS_REAL_INTEGRAL_LMUL THEN ASM_REWRITE_TAC[]]]);; + +let SINC_EXP_DECAY_BOUND = prove + (`!TT. &0 < TT ==> + abs(real_integral (real_interval[&0,TT]) + (\t. sin t * exp(--(TT * t)) * inv t)) <= inv TT`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `real_integral (real_interval[&0,TT]) + (\t. exp(--(TT * t)))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_ABS_BOUND_INTEGRAL THEN BETA_TAC THEN + CONJ_TAC THENL + [MATCH_MP_TAC SINC_EXP_DECAY_INTEGRABLE THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_CONTINUOUS THEN + MATCH_MP_TAC(REWRITE_RULE[o_DEF] REAL_CONTINUOUS_ON_COMPOSE) THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_ON_NEG THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_MUL THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_CONST; REAL_CONTINUOUS_ON_ID]; + REWRITE_TAC[REAL_CONTINUOUS_ON_EXP]]; + X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN + STRIP_TAC THEN + SUBGOAL_THEN `sin x * exp(--(TT * x)) * inv x = + (sin x * inv x) * exp(--(TT * x))` SUBST1_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_EXP] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN + REWRITE_TAC[REAL_ABS_POS; REAL_EXP_POS_LE; REAL_LE_REFL] THEN + REWRITE_TAC[GSYM REAL_ABS_MUL] THEN + CONJ_TAC THENL [REWRITE_TAC[REAL_ABS_POS]; ALL_TAC] THEN + ASM_CASES_TAC `x = &0` THENL + [ASM_REWRITE_TAC[SIN_0; REAL_MUL_LZERO; REAL_ABS_NUM; REAL_POS]; + MP_TAC(SPEC `x:real` SINC_BOUND) THEN ASM_REWRITE_TAC[real_div]]]; + SUBGOAL_THEN + `real_integral (real_interval[&0,TT]) (\t. exp(--(TT * t))) = + inv TT * (&1 - exp(--(TT * TT)))` SUBST1_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + MATCH_MP_TAC EXP_DECAY_INTEGRAL THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INV THEN ASM_REAL_ARITH_TAC; + MP_TAC(SPEC `(--(TT * TT)):real` REAL_EXP_POS_LE) THEN + REAL_ARITH_TAC]]);; + +let ATN_PI2_BOUND = prove + (`!TT. &0 < TT ==> abs(atn TT - pi / &2) <= inv TT`, + REPEAT STRIP_TAC THEN + MP_TAC(SPEC `TT:real` ATN_INV) THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN + SUBGOAL_THEN `atn TT - pi / &2 = --(atn(inv TT))` SUBST1_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_ABS_NEG] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs(inv TT)` THEN + REWRITE_TAC[ATN_ABS_LE_X] THEN + REWRITE_TAC[REAL_ABS_INV] THEN + SUBGOAL_THEN `abs TT = TT` SUBST1_TAC THENL + [ASM_REAL_ARITH_TAC; REWRITE_TAC[REAL_LE_REFL]]);; + +let ERROR_INTEGRAL_BOUND = prove + (`!TT. &0 < TT ==> + abs(real_integral (real_interval[&0,TT]) + (\u. exp(--u * TT) * (cos TT + u * sin TT) / (&1 + u pow 2))) + <= &3 / &2 * inv TT`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `real_integral (real_interval[&0,TT]) + (\u. &3 / &2 * exp(--(TT * u)))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_ABS_BOUND_INTEGRAL THEN BETA_TAC THEN + SUBGOAL_THEN + `(\u. exp(--u * TT) * (cos TT + u * sin TT) / (&1 + u pow 2)) + real_integrable_on real_interval[&0,TT]` + (fun th -> REWRITE_TAC[th]) THENL + [MATCH_MP_TAC REAL_INTEGRABLE_CONTINUOUS THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC(REWRITE_RULE[o_DEF] REAL_CONTINUOUS_ON_COMPOSE) THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_ON_MUL THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_CONST] THEN + SUBGOAL_THEN `(--) = (\x:real. --x)` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM]; ALL_TAC] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_NEG THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_ID]; + REWRITE_TAC[REAL_CONTINUOUS_ON_EXP]]; + REWRITE_TAC[real_div] THEN MATCH_MP_TAC REAL_CONTINUOUS_ON_MUL THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_ON_ADD THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_CONST] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_MUL THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_ID; REAL_CONTINUOUS_ON_CONST]; + MATCH_MP_TAC REAL_CONTINUOUS_ON_INV THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_ON_ADD THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_CONST] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_POW THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_ID]; + X_GEN_TAC `u:real` THEN DISCH_TAC THEN + MP_TAC(SPEC `u:real` REAL_LE_POW_2) THEN REAL_ARITH_TAC]]]; + ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_CONTINUOUS THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_MUL THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_CONST] THEN + MATCH_MP_TAC(REWRITE_RULE[o_DEF] REAL_CONTINUOUS_ON_COMPOSE) THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_ON_NEG THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_MUL THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_ID; REAL_CONTINUOUS_ON_CONST]; + REWRITE_TAC[REAL_CONTINUOUS_ON_EXP]]; + X_GEN_TAC `u:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN + STRIP_TAC THEN + REWRITE_TAC[REAL_MUL_LNEG; REAL_ARITH `x * y = y * x:real`] THEN + REWRITE_TAC[real_div; REAL_ABS_MUL; REAL_ABS_EXP] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_EXP_POS_LE] THEN + REWRITE_TAC[GSYM REAL_ABS_MUL] THEN REWRITE_TAC[REAL_ABS_MUL] THEN + SUBGOAL_THEN `&0 < &1 + u pow 2` ASSUME_TAC THENL + [MP_TAC(SPEC `u:real` REAL_LE_POW_2) THEN REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `abs(inv(&1 + u pow 2)) = inv(&1 + u pow 2)` + SUBST1_TAC THENL + [REWRITE_TAC[REAL_ABS_REFL] THEN MATCH_MP_TAC REAL_LE_INV THEN + ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(&1 + u) * inv(&1 + u pow 2)` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_RMUL THEN CONJ_TAC THENL + [ALL_TAC; MATCH_MP_TAC REAL_LE_INV THEN ASM_REAL_ARITH_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `abs(cos TT) + abs(u * sin TT)` THEN + REWRITE_TAC[REAL_ABS_TRIANGLE] THEN + REWRITE_TAC[REAL_ABS_MUL] THEN + MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THENL + [MP_TAC(SPEC `TT:real` COS_BOUND) THEN REAL_ARITH_TAC; + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 <= u ==> abs u = u`] THEN + CONJ_TAC THENL [REWRITE_TAC[REAL_ABS_POS]; ALL_TAC] THEN + MP_TAC(SPEC `TT:real` SIN_BOUND) THEN REAL_ARITH_TAC]; + REWRITE_TAC[GSYM real_div] THEN + SUBGOAL_THEN `&0 < &1 + u pow 2` ASSUME_TAC THENL + [MP_TAC(SPEC `u:real` REAL_LE_POW_2) THEN REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ] THEN + SUBGOAL_THEN `&3 / &2 * (&1 + u pow 2) = &3 * (&1 + u pow 2) / &2` + SUBST1_TAC THENL + [REWRITE_TAC[real_div; REAL_MUL_ASSOC]; ALL_TAC] THEN + SIMP_TAC[REAL_LE_RDIV_EQ; REAL_ARITH `&0 < &2`] THEN + MP_TAC(SPEC `u - &1 / &3` REAL_LE_POW_2) THEN + REWRITE_TAC[REAL_POW_2] THEN REAL_ARITH_TAC]]; + SUBGOAL_THEN + `(\t. exp(--(TT * t))) real_integrable_on real_interval[&0,TT]` + ASSUME_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_CONTINUOUS THEN + MATCH_MP_TAC(REWRITE_RULE[o_DEF] REAL_CONTINUOUS_ON_COMPOSE) THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_ON_NEG THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_MUL THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_ID; REAL_CONTINUOUS_ON_CONST]; + REWRITE_TAC[REAL_CONTINUOUS_ON_EXP]]; + ALL_TAC] THEN + ASM_SIMP_TAC[REAL_INTEGRAL_LMUL] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `real_integral (real_interval[&0,TT]) (\t. exp(--(TT * t))) = + inv TT * (&1 - exp(--(TT * TT)))` SUBST1_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + MATCH_MP_TAC EXP_DECAY_INTEGRAL THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INV THEN ASM_REAL_ARITH_TAC; + MP_TAC(SPEC `(--(TT * TT)):real` REAL_EXP_POS_LE) THEN + REAL_ARITH_TAC]]);; + +let SINC_INTEGRAL_BOUND = prove + (`!TT. &0 < TT ==> + abs(real_integral (real_interval[&0,TT]) (\t. sin t * inv t) - pi / &2) + <= &4 * inv TT`, + REPEAT STRIP_TAC THEN + MP_TAC(SPEC `TT:real` SINC_DECOMPOSITION) THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN + MP_TAC(SPECL [`TT:real`; `TT:real`] SINC_INTEGRAL_IDENTITY) THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN DISCH_TAC THEN + MP_TAC(SPECL [`TT:real`; `TT:real`] SINC_INTEGRAL_SPLIT) THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `abs(atn TT - pi / &2) + + abs(real_integral (real_interval[&0,TT]) + (\u. exp(--u * TT) * (cos TT + u * sin TT) / (&1 + u pow 2))) + + abs(real_integral (real_interval[&0,TT]) + (\t. sin t * exp(--(TT * t)) * inv t))` THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `inv TT + &3 / &2 * inv TT + inv TT` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THENL + [MATCH_MP_TAC ATN_PI2_BOUND THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THENL + [MATCH_MP_TAC ERROR_INTEGRAL_BOUND THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC SINC_EXP_DECAY_BOUND THEN ASM_REWRITE_TAC[]]]; + SUBGOAL_THEN `&0 <= inv TT` MP_TAC THENL + [MATCH_MP_TAC REAL_LE_INV THEN ASM_REAL_ARITH_TAC; + REAL_ARITH_TAC]]);; + +let DIRICHLET_INTEGRAL = prove + (`((\TT. real_integral (real_interval[&0,TT]) (\t. sin t * inv t)) + ---> pi / &2) at_posinfinity`, + REWRITE_TAC[REALLIM_AT_POSINFINITY] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + EXISTS_TAC `&4 * inv e + &1` THEN + X_GEN_TAC `TT:real` THEN REWRITE_TAC[real_ge] THEN DISCH_TAC THEN + SUBGOAL_THEN `&0 < TT` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&4 * inv e + &1` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LTE_TRANS THEN + EXISTS_TAC `&0 + &1` THEN CONJ_TAC THENL + [REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LE_ADD2 THEN REWRITE_TAC[REAL_LE_REFL] THEN + MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [REAL_ARITH_TAC; MATCH_MP_TAC REAL_LE_INV THEN ASM_REAL_ARITH_TAC]]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `&4 * inv TT` THEN CONJ_TAC THENL + [MATCH_MP_TAC SINC_INTEGRAL_BOUND THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `&4 < e * TT` MP_TAC THENL + [MATCH_MP_TAC REAL_LTE_TRANS THEN + EXISTS_TAC `e * (&4 * inv e + &1)` THEN CONJ_TAC THENL + [SUBGOAL_THEN `e * (&4 * inv e + &1) = &4 + e` SUBST1_TAC THENL + [SUBGOAL_THEN `e * inv e = &1` MP_TAC THENL + [MATCH_MP_TAC REAL_MUL_RINV THEN ASM_REAL_ARITH_TAC; + REAL_ARITH_TAC]; + ASM_REAL_ARITH_TAC]; + MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REAL_ARITH_TAC]; + DISCH_TAC THEN + SUBGOAL_THEN `&4 * inv TT = &4 / TT` SUBST1_TAC THENL + [REWRITE_TAC[real_div]; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LT_LDIV_EQ] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_REWRITE_TAC[]]);; + +(* Bound on the Dirichlet integral tail: |int_T^B sin(t)/t dt| <= 8/T. *) +(* Uses SINC_INTEGRAL_BOUND on [0,B] and [0,T] with triangle inequality. *) +let DIRICHLET_TAIL_BOUND = prove + (`!TT B. &0 < TT /\ TT <= B ==> + abs(real_integral (real_interval[TT,B]) (\t. sin t * inv t)) <= + &8 * inv TT`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&0 < B` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `(\t:real. sin t * inv t) real_integrable_on + real_interval[&0,B]` ASSUME_TAC THENL + [MATCH_MP_TAC SINC_INV_INTEGRABLE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `real_integral (real_interval[TT,B]) (\t. sin t * inv t) = + real_integral (real_interval[&0,B]) (\t. sin t * inv t) - + real_integral (real_interval[&0,TT]) (\t. sin t * inv t)` + SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN + MATCH_MP_TAC(REAL_ARITH `a + b:real = c ==> c - a = b`) THEN + MATCH_MP_TAC REAL_INTEGRAL_COMBINE THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `abs(real_integral (real_interval[&0,B]) (\t. sin t * inv t) - + pi / &2) + + abs(real_integral (real_interval[&0,TT]) (\t. sin t * inv t) - + pi / &2)` THEN + CONJ_TAC THENL + [REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&4 * inv B + &4 * inv TT` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THENL + [MATCH_MP_TAC SINC_INTEGRAL_BOUND THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC SINC_INTEGRAL_BOUND THEN ASM_REWRITE_TAC[]]; + SUBGOAL_THEN `&4 * inv B <= &4 * inv TT` MP_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC]; + REAL_ARITH_TAC]]]);; + + +(* ------------------------------------------------------------------------- *) +(* Fejer kernel infrastructure for Berry-Esseen smoothing bound. *) +(* Phase 1: sin^2(x)/x^2 integral equals pi/2 (as improper integral). *) +(* ------------------------------------------------------------------------- *) + +(* Integration by parts: int_[a,b] sin^2(x)/x^2 on intervals away from 0 *) +let SIN_SQUARED_IBP = prove + (`!a b. &0 < a /\ a <= b ==> + ((\x. sin(x) pow 2 * inv(x pow 2)) has_real_integral + (sin(a) pow 2 * inv(a) - sin(b) pow 2 * inv(b) + + real_integral (real_interval[a,b]) (\x. sin(&2 * x) * inv(x)))) + (real_interval[a,b])`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\x:real. sin(&2 * x) * inv x) real_integrable_on real_interval[a,b]` + ASSUME_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_CONTINUOUS THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_MUL THEN CONJ_TAC THENL + [SUBGOAL_THEN `(\x:real. sin(&2 * x)) = sin o (\x. &2 * x)` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; o_THM]; ALL_TAC] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_ON_LMUL THEN REWRITE_TAC[REAL_CONTINUOUS_ON_ID]; + REWRITE_TAC[REAL_CONTINUOUS_ON_SIN]]; + SUBGOAL_THEN `(inv:real->real) = (\x. inv((\x. x) x))` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM]; ALL_TAC] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_INV THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_ID] THEN + REWRITE_TAC[IN_REAL_INTERVAL] THEN + REPEAT STRIP_TAC THEN ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN + `(\x:real. sin x pow 2 * inv(x pow 2)) = (\x. inv(x pow 2) * sin x pow 2)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_INTEGRATION_BY_PARTS_SIMPLE THEN + EXISTS_TAC `\x:real. --(inv x)` THEN EXISTS_TAC `\x:real. sin(&2 * x)` THEN + BETA_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN STRIP_TAC THEN + CONJ_TAC THENL + [MATCH_MP_TAC HAS_REAL_DERIVATIVE_ATREAL_WITHIN THEN + MP_TAC(SPEC `x:real` HAS_REAL_DERIVATIVE_INV_BASIC) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_REAL_DERIVATIVE_NEG) THEN + REWRITE_TAC[REAL_NEG_NEG]; + MATCH_MP_TAC HAS_REAL_DERIVATIVE_ATREAL_WITHIN THEN + SUBGOAL_THEN `sin(&2 * x) = &2 * sin x pow 1 * cos x` SUBST1_TAC THENL + [REWRITE_TAC[REAL_POW_1; SIN_DOUBLE] THEN REAL_ARITH_TAC; + MP_TAC(SPECL [`sin`; `cos x`; `x:real`; `2`] + HAS_REAL_DERIVATIVE_POW_ATREAL) THEN + REWRITE_TAC[ARITH_RULE `2 - 1 = 1`; HAS_REAL_DERIVATIVE_SIN] THEN + SIMP_TAC[]]]; + SUBGOAL_THEN + `--inv b * sin b pow 2 - --inv a * sin a pow 2 - + (sin a pow 2 * inv a - sin b pow 2 * inv b + + real_integral (real_interval [a,b]) (\x. sin (&2 * x) * inv x)) = + --(real_integral (real_interval [a,b]) (\x. sin (&2 * x) * inv x))` + SUBST1_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `(\x:real. --inv x * sin(&2 * x)) = (\x. --((\x. sin(&2 * x) * inv x) x))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_NEG THEN + MATCH_MP_TAC REAL_INTEGRABLE_INTEGRAL THEN ASM_REWRITE_TAC[]]);; + +(* Substitution: int_[a,b] sin(2x)/x = int_[2a,2b] sin(t)/t *) +let SIN2X_INV_X_SUBSTITUTION = prove + (`!a b. &0 < a /\ a <= b ==> + ((\x. sin(&2 * x) * inv x) has_real_integral + real_integral (real_interval[&2 * a, &2 * b]) (\t. sin t * inv t)) + (real_interval[a,b])`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(\t:real. sin t * inv t) real_integrable_on + real_interval[&2*a, &2*b]` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_CONTINUOUS THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_MUL THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_CONTINUOUS_ON_SIN]; + SUBGOAL_THEN `(inv:real->real) = (\x. inv((\x. x) x))` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM]; ALL_TAC] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_INV THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_ID; IN_REAL_INTERVAL] THEN + REPEAT STRIP_TAC THEN ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN + `!x:real. sin(&2 * x) * inv x = (sin(&2 * x) * inv(&2 * x)) * &2` + (fun th -> REWRITE_TAC[th]) THENL + [X_GEN_TAC `x:real` THEN + ASM_CASES_TAC `x = &0` THENL + [ASM_REWRITE_TAC[REAL_MUL_RZERO; REAL_INV_0; REAL_MUL_LZERO]; + SUBGOAL_THEN `inv(&2 * x) * &2 = inv x` (fun th -> + REWRITE_TAC[GSYM REAL_MUL_ASSOC; th]) THEN + MATCH_MP_TAC(REAL_FIELD `~(x = &0) ==> inv(&2 * x) * &2 = inv x`) THEN + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + MP_TAC(ISPECL [`\t:real. sin t * inv t`; + `real_integral (real_interval [&2 * a, &2 * b]) (\t:real. sin t * inv t)`; + `&2 * a`; `&2 * b`; `&2`; `&0`] HAS_REAL_INTEGRAL_AFFINITY) THEN + REWRITE_TAC[REAL_MUL_RZERO; REAL_SUB_RZERO; REAL_ABS_NUM; + REAL_INV_INV; REAL_ADD_RID] THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_INTEGRAL THEN ASM_REWRITE_TAC[]; + REAL_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN + `IMAGE (\x. inv (&2) * x) (real_interval [&2 * a, &2 * b]) = + real_interval[a, b]` + SUBST1_TAC THENL + [SUBGOAL_THEN `(\x:real. inv(&2) * x) = (\x. inv(&2) * x + &0)` + SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM; REAL_ADD_RID]; ALL_TAC] THEN + REWRITE_TAC[IMAGE_AFFINITY_REAL_INTERVAL] THEN + COND_CASES_TAC THENL + [SUBGOAL_THEN `F` (fun th -> REWRITE_TAC[th]) THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REAL_INTERVAL_EQ_EMPTY]) THEN + ASM_REAL_ARITH_TAC; + COND_CASES_TAC THENL + [AP_TERM_TAC THEN + SUBGOAL_THEN `inv(&2) * (&2 * a) + &0 = a /\ + inv(&2) * (&2 * b) + &0 = b` + (fun th -> REWRITE_TAC[th]) THEN + CONJ_TAC THEN CONV_TAC REAL_FIELD; + SUBGOAL_THEN `F` (fun th -> REWRITE_TAC[th]) THEN + FIRST_X_ASSUM(MP_TAC) THEN REAL_ARITH_TAC]]; + ALL_TAC] THEN + DISCH_TAC THEN + SUBGOAL_THEN + `real_integral (real_interval [&2 * a,&2 * b]) (\t:real. sin t * inv t) = + &2 * (inv(&2) * real_integral (real_interval [&2 * a,&2 * b]) + (\t. sin t * inv t))` + SUBST1_TAC THENL + [CONV_TAC REAL_FIELD; ALL_TAC] THEN + SUBGOAL_THEN + `(\x:real. (sin(&2 * x) * inv(&2 * x)) * &2) = + (\x. &2 * (sin(&2 * x) * inv(&2 * x)))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN REAL_ARITH_TAC; + MATCH_MP_TAC HAS_REAL_INTEGRAL_LMUL THEN ASM_REWRITE_TAC[]]);; + +(* Continuity of sin^2(x)/x^2 (with removable singularity at 0) *) +let SINC_SQUARED_CONTINUOUS = prove + (`!s. (\x. if x = &0 then &1 else sin x pow 2 * inv(x pow 2)) + real_continuous_on s`, + GEN_TAC THEN + SUBGOAL_THEN + `(\x:real. (if x = &0 then &1 else sin x / x) * + (if x = &0 then &1 else sin x / x)) + real_continuous_on s` + MP_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_ON_MUL THEN + REWRITE_TAC[SINC_CONTINUOUS]; + ALL_TAC] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_CONTINUOUS_ON_EQ) THEN + X_GEN_TAC `x:real` THEN DISCH_TAC THEN + ASM_CASES_TAC `x = &0` THENL + [ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[real_div; GSYM REAL_MUL_ASSOC] THEN + REWRITE_TAC[REAL_POW_2; REAL_INV_MUL] THEN REAL_ARITH_TAC);; + +(* Pointwise bound: |sin^2(x)/x^2| <= 1 for all x *) +let SINC_SQUARED_LE_ONE = prove + (`!x. abs(sin x pow 2 * inv(x pow 2)) <= &1`, + GEN_TAC THEN ASM_CASES_TAC `x = &0` THENL + [ASM_REWRITE_TAC[SIN_0; REAL_POW_ZERO; ARITH; REAL_MUL_LZERO; + REAL_ABS_NUM; REAL_LE_01]; + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_INV; REAL_ABS_POW] THEN + SUBGOAL_THEN `abs(sin x) pow 2 * inv(abs x pow 2) = + (abs(sin x) * inv(abs x)) pow 2` SUBST1_TAC THENL + [REWRITE_TAC[REAL_POW_MUL; REAL_POW_INV]; ALL_TAC] THEN + MATCH_MP_TAC REAL_POW_1_LE THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_ABS_POS]; + MATCH_MP_TAC REAL_LE_INV THEN REWRITE_TAC[REAL_ABS_POS]]; + REWRITE_TAC[GSYM real_div; REAL_ABS_DIV] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; + REAL_ARITH `~(x = &0) ==> &0 < abs x`] THEN + REWRITE_TAC[REAL_MUL_LID; REAL_ABS_SIN_BOUND_LE]]]);; + +(* Pointwise bound: |sin(t)/t| <= 1 for all t *) +let SINC_LE_ONE = prove + (`!t. abs(sin t * inv t) <= &1`, + GEN_TAC THEN ASM_CASES_TAC `t = &0` THENL + [ASM_REWRITE_TAC[SIN_0; REAL_MUL_LZERO; REAL_ABS_NUM; REAL_LE_01]; + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_INV] THEN + REWRITE_TAC[GSYM real_div; REAL_ABS_DIV] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; + REAL_ARITH `~(t = &0) ==> &0 < abs t`] THEN + REWRITE_TAC[REAL_MUL_LID; REAL_ABS_SIN_BOUND_LE]]);; + +(* sin^2(a)/a <= a for a > 0 *) +let SIN_SQUARED_INV_LE = prove + (`!a. &0 < a ==> abs(sin a pow 2 * inv a) <= a`, + GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN `abs(sin a pow 2 * inv a) = sin a pow 2 * inv a` + SUBST1_TAC THENL + [REWRITE_TAC[REAL_ABS_REFL] THEN MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_LE_POW_2]; + MATCH_MP_TAC REAL_LE_INV THEN ASM_REAL_ARITH_TAC]; + ASM_SIMP_TAC[GSYM real_div; REAL_LE_LDIV_EQ] THEN + REWRITE_TAC[GSYM REAL_POW_2] THEN + SUBGOAL_THEN `sin a pow 2 = abs(sin a) pow 2` SUBST1_TAC THENL + [REWRITE_TAC[REAL_POW2_ABS]; ALL_TAC] THEN + SUBGOAL_THEN `a pow 2 = abs a pow 2` SUBST1_TAC THENL + [REWRITE_TAC[REAL_POW2_ABS]; ALL_TAC] THEN + MATCH_MP_TAC REAL_POW_LE2 THEN + REWRITE_TAC[REAL_ABS_POS; REAL_ABS_SIN_BOUND_LE]]);; + +(* sin(t)*inv(t) is integrable on [0,T] for T >= 0 *) +let SINC_MUL_INTEGRABLE = prove + (`!TT. &0 <= TT ==> + (\t. sin t * inv t) real_integrable_on real_interval[&0,TT]`, + GEN_TAC THEN DISCH_TAC THEN + MP_TAC(ISPECL [`(\t. if t = &0 then &1 else sin t * inv t)`; + `(\t:real. sin t * inv t)`; + `{&0:real}`; + `real_interval[&0,TT]`] + (REWRITE_RULE[IMP_CONJ] REAL_INTEGRABLE_SPIKE)) THEN + ANTS_TAC THENL [REWRITE_TAC[REAL_NEGLIGIBLE_SING]; ALL_TAC] THEN + ANTS_TAC THENL + [REWRITE_TAC[IN_DIFF; IN_SING] THEN REPEAT STRIP_TAC THEN + BETA_TAC THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + DISCH_THEN MATCH_MP_TAC THEN + MATCH_MP_TAC REAL_INTEGRABLE_CONTINUOUS THEN + SUBGOAL_THEN `(\t:real. if t = &0 then &1 else sin t * inv t) = + (\t. if t = &0 then &1 else sin t / t)` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; real_div]; ALL_TAC] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `(:real)` THEN + REWRITE_TAC[SUBSET_UNIV; SINC_CONTINUOUS]);; + +(* sin^2(x)/x^2 is integrable on [0,T] for all T *) +let SINC_SQUARED_INTEGRABLE = prove + (`!TT. (\x. sin(x) pow 2 * inv(x pow 2)) real_integrable_on + real_interval[&0,TT]`, + GEN_TAC THEN + ASM_CASES_TAC `TT < &0` THENL + [SUBGOAL_THEN `real_interval[&0,TT] = {}` SUBST1_TAC THENL + [REWRITE_TAC[REAL_INTERVAL_EQ_EMPTY] THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[REAL_INTEGRABLE_ON_EMPTY]]; + ALL_TAC] THEN + MP_TAC(ISPECL [`(\x. if x = &0 then &1 else sin x pow 2 * inv(x pow 2))`; + `(\x. sin x pow 2 * inv(x pow 2))`; + `{&0:real}`; + `real_interval[&0,TT]`] + (REWRITE_RULE[IMP_CONJ] REAL_INTEGRABLE_SPIKE)) THEN + ANTS_TAC THENL [REWRITE_TAC[REAL_NEGLIGIBLE_SING]; ALL_TAC] THEN + ANTS_TAC THENL + [REWRITE_TAC[IN_DIFF; IN_SING] THEN REPEAT STRIP_TAC THEN + BETA_TAC THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + DISCH_THEN MATCH_MP_TAC THEN + MATCH_MP_TAC REAL_INTEGRABLE_CONTINUOUS THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `(:real)` THEN + REWRITE_TAC[SUBSET_UNIV; SINC_SQUARED_CONTINUOUS]);; + +(* Key identity: int_[0,T] sin^2/x^2 = -sin^2(T)/T + int_[0,2T] sin/t *) +let SINC_SQUARED_IDENTITY = prove + (`!TT. &0 < TT ==> + real_integral (real_interval[&0,TT]) + (\x. sin(x) pow 2 * inv(x pow 2)) = + --(sin(TT) pow 2 * inv(TT)) + + real_integral (real_interval[&0, &2 * TT]) (\t. sin t * inv t)`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(REAL_ARITH `abs(a - b) = &0 ==> a = b`) THEN + MATCH_MP_TAC(REAL_ARITH `abs x <= &0 ==> abs x = &0`) THEN + MATCH_MP_TAC(prove(`(!e. &0 < e ==> abs(x:real) <= e) ==> abs x <= &0`, + DISCH_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `abs(x:real) / &2`) THEN + ASM_REAL_ARITH_TAC)) THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + ABBREV_TAC `a = min (e / &5) (TT / &2)` THEN + SUBGOAL_THEN `&0 < a /\ a < TT /\ a <= TT /\ &4 * a < e` + STRIP_ASSUME_TAC THENL + [EXPAND_TAC "a" THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&4 * a` THEN + CONJ_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN + (* Split integral [0,TT] at a *) + SUBGOAL_THEN + `real_integral (real_interval[&0,TT]) (\x. sin x pow 2 * inv(x pow 2)) = + real_integral (real_interval[&0,a]) (\x. sin x pow 2 * inv(x pow 2)) + + real_integral (real_interval[a,TT]) (\x. sin x pow 2 * inv(x pow 2))` + SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_INTEGRAL_COMBINE THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE; SINC_SQUARED_INTEGRABLE]; + ALL_TAC] THEN + (* Apply IBP on [a,TT] *) + SUBGOAL_THEN + `real_integral (real_interval[a,TT]) (\x. sin x pow 2 * inv(x pow 2)) = + sin(a) pow 2 * inv(a) - sin(TT) pow 2 * inv(TT) + + real_integral (real_interval[a,TT]) (\x. sin(&2 * x) * inv(x))` + SUBST1_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + MATCH_MP_TAC SIN_SQUARED_IBP THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + (* Apply substitution: int_[a,T] sin(2x)/x = int_[2a,2T] sin(t)/t *) + SUBGOAL_THEN + `real_integral (real_interval[a,TT]) (\x. sin(&2 * x) * inv x) = + real_integral (real_interval[&2 * a, &2 * TT]) (\t. sin t * inv t)` + SUBST1_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + MATCH_MP_TAC SIN2X_INV_X_SUBSTITUTION THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + (* Simplify: -sin^2(T)/T cancels with +sin^2(T)/T from RHS *) + SUBGOAL_THEN + `(real_integral (real_interval [&0,a]) (\x. sin x pow 2 * inv(x pow 2)) + + sin a pow 2 * inv a - sin TT pow 2 * inv TT + + real_integral (real_interval [&2*a,&2*TT]) (\t. sin t * inv t)) - + (--(sin TT pow 2 * inv TT) + + real_integral (real_interval [&0,&2*TT]) (\t. sin t * inv t)) = + real_integral (real_interval [&0,a]) (\x. sin x pow 2 * inv(x pow 2)) + + sin a pow 2 * inv a + + real_integral (real_interval [&2*a,&2*TT]) (\t. sin t * inv t) - + real_integral (real_interval [&0,&2*TT]) (\t. sin t * inv t)` + SUBST1_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + (* Establish integrability of sin(t)/t on [0,2T] *) + SUBGOAL_THEN + `(\t:real. sin t * inv t) real_integrable_on real_interval[&0, &2 * TT]` + ASSUME_TAC THENL + [MATCH_MP_TAC SINC_MUL_INTEGRABLE THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + (* Split [0,2T] = [0,2a] + [2a,2T] *) + SUBGOAL_THEN + `real_integral (real_interval[&0, &2 * TT]) (\t. sin t * inv t) = + real_integral (real_interval[&0, &2 * a]) (\t. sin t * inv t) + + real_integral (real_interval[&2 * a, &2 * TT]) (\t. sin t * inv t)` + SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_INTEGRAL_COMBINE THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + (* Cancel integral_[2a,2T] terms *) + SUBGOAL_THEN + `real_integral (real_interval [&0,a]) (\x. sin x pow 2 * inv(x pow 2)) + + sin a pow 2 * inv a + + real_integral (real_interval [&2*a,&2*TT]) (\t. sin t * inv t) - + (real_integral (real_interval [&0,&2*a]) (\t. sin t * inv t) + + real_integral (real_interval [&2*a,&2*TT]) (\t. sin t * inv t)) = + real_integral (real_interval [&0,a]) (\x. sin x pow 2 * inv(x pow 2)) + + sin a pow 2 * inv a - + real_integral (real_interval [&0,&2*a]) (\t. sin t * inv t)` + SUBST1_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + (* Triangle inequality: |A + B - C| <= |A| + |B| + |C| <= a + a + 2a *) + MATCH_MP_TAC(REAL_ARITH + `abs x <= a /\ abs y <= a /\ abs z <= &2 * a + ==> abs(x + y - z) <= &4 * a`) THEN + REPEAT CONJ_TAC THENL + [(* |integral_[0,a] sin^2/x^2| <= 1 * a *) + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&1 * (a - &0)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC(ISPECL + [`\x:real. sin x pow 2 * inv(x pow 2)`; + `&0`; `a:real`; + `real_integral (real_interval[&0,a]) (\x. sin x pow 2 * inv(x pow 2))`; + `&1`] HAS_REAL_INTEGRAL_BOUND) THEN + REWRITE_TAC[REAL_POS] THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_INTEGRAL THEN + REWRITE_TAC[SINC_SQUARED_INTEGRABLE]; + REWRITE_TAC[IN_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[SINC_SQUARED_LE_ONE]]; + ASM_REAL_ARITH_TAC]; + (* |sin^2(a)/a| <= a *) + MATCH_MP_TAC SIN_SQUARED_INV_LE THEN ASM_REWRITE_TAC[]; + (* |integral_[0,2a] sin(t)/t| <= 1 * 2a *) + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&1 * (&2 * a - &0)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC(ISPECL + [`\t:real. sin t * inv t`; + `&0`; `&2 * a`; + `real_integral (real_interval[&0,&2*a]) (\t. sin t * inv t)`; + `&1`] HAS_REAL_INTEGRAL_BOUND) THEN + REWRITE_TAC[REAL_POS] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < a ==> &0 <= &2 * a`] THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_INTEGRAL THEN + MATCH_MP_TAC SINC_MUL_INTEGRABLE THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[IN_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[SINC_LE_ONE]]; + ASM_REAL_ARITH_TAC]]);; + +(* Quantitative bound for the sinc-squared integral *) +let SINC_SQUARED_INTEGRAL_BOUND = prove + (`!TT. &0 < TT ==> + abs(real_integral (real_interval[&0,TT]) + (\x. sin(x) pow 2 * inv(x pow 2)) - pi / &2) + <= &7 * inv TT`, + REPEAT STRIP_TAC THEN + MP_TAC(SPEC `TT:real` SINC_SQUARED_IDENTITY) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN SUBST1_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `abs(sin TT pow 2 * inv TT) + + abs(real_integral (real_interval[&0,&2 * TT]) + (\t. sin t * inv t) - pi / &2)` THEN + CONJ_TAC THENL + [REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&1 * inv TT + &6 * inv TT` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&1 * inv(abs TT)` THEN + CONJ_TAC THENL + [REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_INV] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN CONJ_TAC THENL + [MP_TAC(SPECL [`sin TT`; `2`] REAL_ABS_POW) THEN + DISCH_THEN SUBST1_TAC THEN + MATCH_MP_TAC REAL_POW_1_LE THEN + REWRITE_TAC[REAL_ABS_POS; SIN_BOUND]; + REWRITE_TAC[REAL_LE_INV_EQ; REAL_ABS_POS]]; + SUBGOAL_THEN `abs TT = TT` SUBST1_TAC THENL + [REWRITE_TAC[REAL_ABS_REFL] THEN ASM_REAL_ARITH_TAC; + REAL_ARITH_TAC]]; + MP_TAC(SPEC `&2 * TT` SINC_INTEGRAL_BOUND) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `b <= c ==> a <= b ==> a <= c`) THEN + REWRITE_TAC[REAL_INV_MUL] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 <= x ==> &4 * (inv(&2) * x) <= &6 * x`) THEN + MATCH_MP_TAC REAL_LE_INV THEN ASM_REAL_ARITH_TAC]; + REAL_ARITH_TAC]]);; + +(* The sinc-squared integral converges to pi/2 *) +let SINC_SQUARED_INTEGRAL = prove + (`((\TT. real_integral (real_interval[&0,TT]) + (\x. sin(x) pow 2 * inv(x pow 2))) ---> pi / &2) at_posinfinity`, + REWRITE_TAC[REALLIM_AT_POSINFINITY] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + EXISTS_TAC `&7 * inv e + &1` THEN + X_GEN_TAC `TT:real` THEN REWRITE_TAC[real_ge] THEN DISCH_TAC THEN + SUBGOAL_THEN `&0 < TT` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&7 * inv e + &1` THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= a ==> &0 < a + &1`) THEN + MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [REAL_ARITH_TAC; MATCH_MP_TAC REAL_LE_INV THEN ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `&7 * inv TT` THEN CONJ_TAC THENL + [MATCH_MP_TAC SINC_SQUARED_INTEGRAL_BOUND THEN ASM_REWRITE_TAC[]; + SUBGOAL_THEN `&7 < e * TT` MP_TAC THENL + [MATCH_MP_TAC REAL_LTE_TRANS THEN + EXISTS_TAC `e * (&7 * inv e + &1)` THEN CONJ_TAC THENL + [SUBGOAL_THEN `e * (&7 * inv e + &1) = &7 + e` SUBST1_TAC THENL + [SUBGOAL_THEN `e * inv e = &1` MP_TAC THENL + [MATCH_MP_TAC REAL_MUL_RINV THEN ASM_REAL_ARITH_TAC; REAL_ARITH_TAC]; + ASM_REAL_ARITH_TAC]; + MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REAL_ARITH_TAC]; + DISCH_TAC THEN + SUBGOAL_THEN `&7 * inv TT = &7 / TT` SUBST1_TAC THENL + [REWRITE_TAC[real_div]; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LT_LDIV_EQ] THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_REWRITE_TAC[]]]);; + +(* ------------------------------------------------------------------------- *) +(* Real-line Fejer kernel: K_T(x) = 2*sin^2(Tx/2) / (pi*T*x^2) *) +(* with K_T(0) = T/(2*pi). This is the Cesaro summation kernel for Fourier *) +(* inversion on the real line. *) +(* ------------------------------------------------------------------------- *) + +let fejer_kernel_real = new_definition + `fejer_kernel_real TT x = + if x = &0 then TT / (&2 * pi) + else &2 * sin(TT * x / &2) pow 2 / (pi * TT * x pow 2)`;; + +(* Non-negativity of the Fejer kernel *) +let FEJER_KERNEL_REAL_POS = prove + (`!TT x. &0 < TT ==> &0 <= fejer_kernel_real TT x`, + REPEAT STRIP_TAC THEN REWRITE_TAC[fejer_kernel_real] THEN + COND_CASES_TAC THENL + [MATCH_MP_TAC REAL_LE_DIV THEN + MP_TAC PI_POS THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_DIV THEN + REWRITE_TAC[REAL_LE_POW_2] THEN + MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [MP_TAC PI_POS THEN REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LE_MUL THEN + REWRITE_TAC[REAL_LE_POW_2] THEN ASM_REAL_ARITH_TAC]]);; + +(* Tail bound: K_T(x) <= 2/(pi*T*x^2) for x != 0. + Follows from sin^2 <= 1. *) +let FEJER_KERNEL_REAL_TAIL_BOUND = prove + (`!TT x. &0 < TT /\ ~(x = &0) ==> + fejer_kernel_real TT x <= &2 / (pi * TT * x pow 2)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[fejer_kernel_real] THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[real_div] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN CONJ_TAC THENL + [SUBGOAL_THEN `sin(TT * x * inv(&2)) pow 2 = + abs(sin(TT * x * inv(&2))) pow 2` SUBST1_TAC THENL + [REWRITE_TAC[REAL_POW2_ABS]; ALL_TAC] THEN + MATCH_MP_TAC REAL_POW_1_LE THEN + REWRITE_TAC[REAL_ABS_POS; SIN_BOUND]; + REWRITE_TAC[REAL_LE_INV_EQ] THEN + MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [MP_TAC PI_POS THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LE_MUL THEN + REWRITE_TAC[REAL_LE_POW_2] THEN ASM_REAL_ARITH_TAC]]);; + +(* The sinc-squared function integrates to pi over all of R *) +let SINC_SQUARED_HAS_REAL_INTEGRAL_UNIV = prove + (`((\x. if x = &0 then &1 else sin x pow 2 * inv(x pow 2)) + has_real_integral pi) (:real)`, + REWRITE_TAC[HAS_REAL_INTEGRAL_ALT; IN_UNIV] THEN + CONV_TAC(ONCE_DEPTH_CONV COND_ELIM_CONV) THEN REWRITE_TAC[] THEN + CONJ_TAC THENL + [REPEAT GEN_TAC THEN + MATCH_MP_TAC REAL_INTEGRABLE_CONTINUOUS THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `(:real)` THEN + REWRITE_TAC[SUBSET_UNIV; SINC_SQUARED_CONTINUOUS]; + ALL_TAC] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + EXISTS_TAC `&14 * inv e + &1` THEN + CONJ_TAC THENL + [MATCH_MP_TAC(REAL_ARITH `&0 <= a ==> &0 < a + &1`) THEN + MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [REAL_ARITH_TAC; MATCH_MP_TAC REAL_LE_INV THEN ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`a:real`; `b:real`] THEN DISCH_TAC THEN + SUBGOAL_THEN `&0 < &14 * inv e + &1` ASSUME_TAC THENL + [MATCH_MP_TAC(REAL_ARITH `&0 <= a ==> &0 < a + &1`) THEN + MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [REAL_ARITH_TAC; MATCH_MP_TAC REAL_LE_INV THEN ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN `a <= --(&14 * inv e + &1) /\ &14 * inv e + &1 <= b` + STRIP_ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET_REAL_INTERVAL]) THEN + ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `&0 < b` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `a < &0` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `a <= b:real` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + (* Split integral at 0 *) + SUBGOAL_THEN + `real_integral (real_interval[a,b]) + (\x. if x = &0 then &1 else sin x pow 2 * inv(x pow 2)) = + real_integral (real_interval[a,&0]) + (\x. if x = &0 then &1 else sin x pow 2 * inv(x pow 2)) + + real_integral (real_interval[&0,b]) + (\x. if x = &0 then &1 else sin x pow 2 * inv(x pow 2))` + SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_INTEGRAL_COMBINE THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN + MATCH_MP_TAC REAL_INTEGRABLE_CONTINUOUS THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `(:real)` THEN REWRITE_TAC[SUBSET_UNIV; SINC_SQUARED_CONTINUOUS]; + ALL_TAC] THEN + (* Reflect the [a,0] part *) + SUBGOAL_THEN + `real_integral (real_interval[a,&0]) + (\x. if x = &0 then &1 else sin x pow 2 * inv(x pow 2)) = + real_integral (real_interval[&0,--a]) + (\x. if x = &0 then &1 else sin x pow 2 * inv(x pow 2))` + SUBST1_TAC THENL + [MP_TAC(ISPECL + [`\x:real. if x = &0 then &1 else sin x pow 2 * inv(x pow 2)`; + `real_interval[&0,--a]`] REAL_INTEGRAL_REFLECT_GEN) THEN + SIMP_TAC[] THEN + SUBGOAL_THEN + `(!x:real. (if --x = &0 then &1 else sin(--x) pow 2 * inv((--x) pow 2)) = + (if x = &0 then &1 else sin x pow 2 * inv(x pow 2)))` + (fun th -> REWRITE_TAC[th]) THENL + [GEN_TAC THEN + SUBGOAL_THEN `(--x = &0) <=> (x = &0)` SUBST1_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + COND_CASES_TAC THEN REWRITE_TAC[] THEN + REWRITE_TAC[SIN_NEG; REAL_POW_NEG; ARITH; REAL_NEG_NEG]; ALL_TAC] THEN + SUBGOAL_THEN `IMAGE (--) (real_interval[&0,--a]) = real_interval[a,&0]` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_REAL_INTERVAL] THEN + X_GEN_TAC `y:real` THEN EQ_TAC THENL + [STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + STRIP_TAC THEN EXISTS_TAC `--y:real` THEN ASM_REAL_ARITH_TAC]; + SIMP_TAC[]]; + ALL_TAC] THEN + (* Now use spike theorem to relate to sinc_squared on [0,T] *) + SUBGOAL_THEN + `!TT. &0 < TT ==> + real_integral (real_interval[&0,TT]) + (\x. if x = &0 then &1 else sin x pow 2 * inv(x pow 2)) = + real_integral (real_interval[&0,TT]) + (\x. sin x pow 2 * inv(x pow 2))` + ASSUME_TAC THENL + [GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_INTEGRAL_SPIKE THEN + EXISTS_TAC `{&0:real}` THEN REWRITE_TAC[REAL_NEGLIGIBLE_SING] THEN + REWRITE_TAC[IN_DIFF; IN_SING] THEN + REPEAT STRIP_TAC THEN BETA_TAC THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + (* Key lemma: 7 * inv(14*inv(e)+1) < e/2 *) + SUBGOAL_THEN `&7 * inv(&14 * inv e + &1) < e / &2` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LTE_TRANS THEN + EXISTS_TAC `&7 * inv(&14 * inv e)` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LT_LMUL THEN CONJ_TAC THENL + [REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LT_INV2 THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LT_MUL THEN CONJ_TAC THENL + [REAL_ARITH_TAC; MATCH_MP_TAC REAL_LT_INV THEN ASM_REAL_ARITH_TAC]; + REAL_ARITH_TAC]]; + SUBGOAL_THEN `&7 * inv(&14 * inv e) = e / &2` SUBST1_TAC THENL + [REWRITE_TAC[REAL_INV_MUL; REAL_INV_INV] THEN + SUBGOAL_THEN `~(e = &0)` MP_TAC THENL + [ASM_REAL_ARITH_TAC; CONV_TAC REAL_FIELD]; + REAL_ARITH_TAC]]; + ALL_TAC] THEN + (* Use SINC_SQUARED_INTEGRAL_BOUND *) + SUBGOAL_THEN + `abs(real_integral (real_interval[&0,--a]) + (\x. if x = &0 then &1 else sin x pow 2 * inv(x pow 2)) - + pi / &2) < e / &2` + ASSUME_TAC THENL + [SUBGOAL_THEN `&0 < --a` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `&7 * inv(--a)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SINC_SQUARED_INTEGRAL_BOUND THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `&7 * inv(&14 * inv e + &1)` THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REAL_ARITH_TAC]]; + ALL_TAC] THEN + SUBGOAL_THEN + `abs(real_integral (real_interval[&0,b]) + (\x. if x = &0 then &1 else sin x pow 2 * inv(x pow 2)) - + pi / &2) < e / &2` + ASSUME_TAC THENL + [ASM_SIMP_TAC[] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `&7 * inv b` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SINC_SQUARED_INTEGRAL_BOUND THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `&7 * inv(&14 * inv e + &1)` THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REAL_ARITH_TAC]]; + ALL_TAC] THEN + SUBGOAL_THEN `pi = pi / &2 + pi / &2` SUBST1_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + ASM_REAL_ARITH_TAC);; + +(* The sinc-squared function integrates to pi/2 over the positive half-line *) +let SINC_SQUARED_HAS_REAL_INTEGRAL_HALFLINE = prove + (`((\x. if x = &0 then &1 else sin x pow 2 * inv(x pow 2)) + has_real_integral (pi / &2)) {t | &0 <= t}`, + ABBREV_TAC `f = \x:real. if x = &0 then &1 else sin x pow 2 * inv(x pow 2)` THEN + SUBGOAL_THEN `(f has_real_integral pi) (:real)` ASSUME_TAC THENL + [EXPAND_TAC "f" THEN REWRITE_TAC[SINC_SQUARED_HAS_REAL_INTEGRAL_UNIV]; ALL_TAC] THEN + SUBGOAL_THEN `!t:real. (f:real->real)(--t) = f t` ASSUME_TAC THENL + [EXPAND_TAC "f" THEN GEN_TAC THEN + ASM_CASES_TAC `t = &0` THEN ASM_REWRITE_TAC[REAL_NEG_0] THEN + SUBGOAL_THEN `~(--t = &0)` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ASM_REWRITE_TAC[SIN_NEG; REAL_POW_NEG; ARITH]]; + ALL_TAC] THEN + SUBGOAL_THEN `f real_integrable_on (:real)` ASSUME_TAC THENL + [REWRITE_TAC[real_integrable_on] THEN ASM_MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `f real_integrable_on {t | &0 <= t}` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_ON_SUBINTERVAL_GEN THEN + EXISTS_TAC `(:real)` THEN ASM_REWRITE_TAC[SUBSET_UNIV] THEN + REWRITE_TAC[is_realinterval; IN_ELIM_THM] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `f real_integrable_on {t:real | t <= &0}` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_ON_SUBINTERVAL_GEN THEN + EXISTS_TAC `(:real)` THEN ASM_REWRITE_TAC[SUBSET_UNIV] THEN + REWRITE_TAC[is_realinterval; IN_ELIM_THM] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `(f has_real_integral real_integral {t | &0 <= t} f) + {t:real | t <= &0}` ASSUME_TAC THENL + [MP_TAC(ISPECL [`f:real->real`; + `real_integral {t:real | &0 <= t} (f:real->real)`; + `{t:real | &0 <= t}`] HAS_REAL_INTEGRAL_REFLECT_GEN) THEN + SUBGOAL_THEN `IMAGE ((--):real->real) {t | &0 <= t} = {t:real | t <= &0}` + (fun th -> REWRITE_TAC[th]) THENL + [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM] THEN GEN_TAC THEN EQ_TAC THENL + [STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + DISCH_TAC THEN EXISTS_TAC `--x:real` THEN + ASM_REWRITE_TAC[REAL_NEG_NEG] THEN ASM_REAL_ARITH_TAC]; ALL_TAC] THEN + SUBGOAL_THEN `(\x. (f:real->real)(--x)) = f` (fun th -> REWRITE_TAC[th]) THENL + [REWRITE_TAC[FUN_EQ_THM] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + DISCH_THEN(fun th -> + MP_TAC(fst(EQ_IMP_RULE th)) THEN + ANTS_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_INTEGRAL THEN ASM_REWRITE_TAC[]; + MESON_TAC[]]); + ALL_TAC] THEN + SUBGOAL_THEN + `(f has_real_integral (real_integral {t | &0 <= t} f + + real_integral {t | &0 <= t} f)) + ({t:real | &0 <= t} UNION {t | t <= &0})` ASSUME_TAC THENL + [MATCH_MP_TAC HAS_REAL_INTEGRAL_UNION THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_INTEGRAL THEN ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + SUBGOAL_THEN `{t:real | &0 <= t} INTER {t | t <= &0} = {&0}` + (fun th -> REWRITE_TAC[th; REAL_NEGLIGIBLE_SING]) THEN + REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM; IN_SING] THEN + REAL_ARITH_TAC]; ALL_TAC] THEN + SUBGOAL_THEN `{t:real | &0 <= t} UNION {t | t <= &0} = (:real)` + ASSUME_TAC THENL + [REWRITE_TAC[EXTENSION; IN_UNION; IN_ELIM_THM; IN_UNIV] THEN + REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `real_integral {t | &0 <= t} f + real_integral {t | &0 <= t} f = pi` + ASSUME_TAC THENL + [MATCH_MP_TAC HAS_REAL_INTEGRAL_UNIQUE THEN + EXISTS_TAC `f:real->real` THEN EXISTS_TAC `(:real)` THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `real_integral {t | &0 <= t} f = pi / &2` ASSUME_TAC THENL + [MATCH_MP_TAC(REAL_ARITH `x + x = y ==> x = y / &2`) THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + FIRST_X_ASSUM(fun th -> ONCE_REWRITE_TAC[GSYM th]) THEN + MATCH_MP_TAC REAL_INTEGRABLE_INTEGRAL THEN ASM_REWRITE_TAC[]);; + +(* (1-cos(t))/t^2 integrates to pi over all of R *) +(* Derived from SINC_SQUARED via sin^2(x) = (1-cos(2x))/2 and substitution *) +let ONE_MINUS_COS_HAS_REAL_INTEGRAL_UNIV = prove + (`((\t. if t = &0 then &1 / &2 else (&1 - cos t) * inv(t pow 2)) + has_real_integral pi) (:real)`, + ABBREV_TAC `h = \t:real. if t = &0 then &1 / &2 + else (&1 - cos t) * inv(t pow 2)` THEN + ABBREV_TAC `f = \x:real. if x = &0 then &1 + else sin x pow 2 * inv(x pow 2)` THEN + SUBGOAL_THEN `(f has_real_integral pi) (:real)` ASSUME_TAC THENL + [EXPAND_TAC "f" THEN REWRITE_TAC[SINC_SQUARED_HAS_REAL_INTEGRAL_UNIV]; ALL_TAC] THEN + SUBGOAL_THEN `(\x. h(&2 * x)) = (\x. inv(&2) * (f:real->real) x)` ASSUME_TAC THENL + [EXPAND_TAC "h" THEN EXPAND_TAC "f" THEN REWRITE_TAC[FUN_EQ_THM] THEN + X_GEN_TAC `x:real` THEN REWRITE_TAC[] THEN + ASM_CASES_TAC `x = &0` THENL + [ASM_REWRITE_TAC[REAL_MUL_RZERO] THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `~(&2 * x = &0)` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(SPEC `x:real` COS_DOUBLE_SIN) THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN + REWRITE_TAC[REAL_POW_MUL] THEN + UNDISCH_TAC `~(x = &0)` THEN CONV_TAC REAL_FIELD; + ALL_TAC] THEN + SUBGOAL_THEN `((\x. h(&2 * x)) has_real_integral (pi / &2)) (:real)` + ASSUME_TAC THENL + [ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `pi / &2 = inv(&2) * pi` SUBST1_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_LMUL THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MP_TAC(ISPECL [`\x:real. (h:real->real)(&2 * x)`; `pi / &2`; `inv(&2)`] + HAS_REAL_INTEGRAL_STRETCH_UNIV) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `(\x. (\x. (h:real->real) (&2 * x)) (inv (&2) * x)) = h` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:real` THEN BETA_TAC THEN + AP_TERM_TAC THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `inv(inv(&2)) * pi / &2 = pi` SUBST1_TAC THENL + [REWRITE_TAC[REAL_INV_INV] THEN REAL_ARITH_TAC; SIMP_TAC[]]);; + +(* (1-cos(t))/t^2 integrates to pi/2 over the positive half-line *) +let ONE_MINUS_COS_HAS_REAL_INTEGRAL_HALFLINE = prove + (`((\t. if t = &0 then &1 / &2 else (&1 - cos t) * inv(t pow 2)) + has_real_integral (pi / &2)) {t | &0 <= t}`, + ABBREV_TAC `h = \t:real. if t = &0 then &1 / &2 + else (&1 - cos t) * inv(t pow 2)` THEN + SUBGOAL_THEN `(h has_real_integral pi) (:real)` ASSUME_TAC THENL + [EXPAND_TAC "h" THEN REWRITE_TAC[ONE_MINUS_COS_HAS_REAL_INTEGRAL_UNIV]; + ALL_TAC] THEN + SUBGOAL_THEN `!t:real. (h:real->real)(--t) = h t` ASSUME_TAC THENL + [EXPAND_TAC "h" THEN GEN_TAC THEN + ASM_CASES_TAC `t = &0` THEN ASM_REWRITE_TAC[REAL_NEG_0] THEN + SUBGOAL_THEN `~(--t = &0)` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; + ASM_REWRITE_TAC[COS_NEG; REAL_POW_NEG; ARITH]]; + ALL_TAC] THEN + SUBGOAL_THEN `h real_integrable_on (:real)` ASSUME_TAC THENL + [REWRITE_TAC[real_integrable_on] THEN ASM_MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `h real_integrable_on {t | &0 <= t}` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_ON_SUBINTERVAL_GEN THEN + EXISTS_TAC `(:real)` THEN ASM_REWRITE_TAC[SUBSET_UNIV] THEN + REWRITE_TAC[is_realinterval; IN_ELIM_THM] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `h real_integrable_on {t:real | t <= &0}` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_ON_SUBINTERVAL_GEN THEN + EXISTS_TAC `(:real)` THEN ASM_REWRITE_TAC[SUBSET_UNIV] THEN + REWRITE_TAC[is_realinterval; IN_ELIM_THM] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `(h has_real_integral real_integral {t | &0 <= t} h) + {t:real | t <= &0}` ASSUME_TAC THENL + [MP_TAC(ISPECL [`h:real->real`; + `real_integral {t:real | &0 <= t} (h:real->real)`; + `{t:real | &0 <= t}`] HAS_REAL_INTEGRAL_REFLECT_GEN) THEN + SUBGOAL_THEN `IMAGE ((--):real->real) {t | &0 <= t} = {t:real | t <= &0}` + (fun th -> REWRITE_TAC[th]) THENL + [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM] THEN GEN_TAC THEN EQ_TAC THENL + [STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + DISCH_TAC THEN EXISTS_TAC `--x:real` THEN + ASM_REWRITE_TAC[REAL_NEG_NEG] THEN ASM_REAL_ARITH_TAC]; ALL_TAC] THEN + SUBGOAL_THEN `(\x. (h:real->real)(--x)) = h` (fun th -> REWRITE_TAC[th]) THENL + [REWRITE_TAC[FUN_EQ_THM] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + DISCH_THEN(fun th -> + MP_TAC(fst(EQ_IMP_RULE th)) THEN + ANTS_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_INTEGRAL THEN ASM_REWRITE_TAC[]; + MESON_TAC[]]); + ALL_TAC] THEN + SUBGOAL_THEN + `(h has_real_integral (real_integral {t | &0 <= t} h + + real_integral {t | &0 <= t} h)) + ({t:real | &0 <= t} UNION {t | t <= &0})` ASSUME_TAC THENL + [MATCH_MP_TAC HAS_REAL_INTEGRAL_UNION THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_INTEGRAL THEN ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + SUBGOAL_THEN `{t:real | &0 <= t} INTER {t | t <= &0} = {&0}` + (fun th -> REWRITE_TAC[th; REAL_NEGLIGIBLE_SING]) THEN + REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM; IN_SING] THEN + REAL_ARITH_TAC]; ALL_TAC] THEN + SUBGOAL_THEN `{t:real | &0 <= t} UNION {t | t <= &0} = (:real)` + ASSUME_TAC THENL + [REWRITE_TAC[EXTENSION; IN_UNION; IN_ELIM_THM; IN_UNIV] THEN + REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `real_integral {t | &0 <= t} h + real_integral {t | &0 <= t} h = pi` + ASSUME_TAC THENL + [MATCH_MP_TAC HAS_REAL_INTEGRAL_UNIQUE THEN + EXISTS_TAC `h:real->real` THEN EXISTS_TAC `(:real)` THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `real_integral {t | &0 <= t} h = pi / &2` ASSUME_TAC THENL + [MATCH_MP_TAC(REAL_ARITH `x + x = y ==> x = y / &2`) THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + FIRST_X_ASSUM(fun th -> ONCE_REWRITE_TAC[GSYM th]) THEN + MATCH_MP_TAC REAL_INTEGRABLE_INTEGRAL THEN ASM_REWRITE_TAC[]);; + +(* Scaled version: int_[0,inf) (1-cos(c*t))/t^2 dt = pi*c/2 for c > 0 *) +let ONE_MINUS_COS_SCALED_HAS_REAL_INTEGRAL_HALFLINE = prove + (`!c. &0 < c ==> + ((\t. if t = &0 then c pow 2 / &2 else (&1 - cos(c * t)) * inv(t pow 2)) + has_real_integral (pi * c / &2)) {t | &0 <= t}`, + GEN_TAC THEN DISCH_TAC THEN + MP_TAC(ISPECL [`\t:real. if t = &0 then &1 / &2 + else (&1 - cos t) * inv(t pow 2)`; + `pi:real`; `c:real`] HAS_REAL_INTEGRAL_STRETCH_UNIV) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[ONE_MINUS_COS_HAS_REAL_INTEGRAL_UNIV]; ALL_TAC] THEN + SUBGOAL_THEN `(\x. (\t. if t = &0 then &1 / &2 + else (&1 - cos t) * inv(t pow 2)) (c * x)) + = (\x. if x = &0 then &1 / &2 + else (&1 - cos(c * x)) * inv((c * x) pow 2))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN BETA_TAC THEN + ASM_CASES_TAC `x = &0` THENL + [ASM_REWRITE_TAC[REAL_MUL_RZERO]; ALL_TAC] THEN + SUBGOAL_THEN `~(c * x = &0)` (fun th -> REWRITE_TAC[th]) THEN + ASM_SIMP_TAC[REAL_ENTIRE; REAL_LT_IMP_NZ]; ALL_TAC] THEN + DISCH_TAC THEN + ABBREV_TAC `f = \t:real. if t = &0 then c pow 2 / &2 + else (&1 - cos(c * t)) * inv(t pow 2)` THEN + SUBGOAL_THEN + `(f has_real_integral (c pow 2 * (inv c * pi))) (:real)` ASSUME_TAC THENL + [SUBGOAL_THEN + `(f:real->real) = (\t. c pow 2 * (if t = &0 then &1 / &2 + else (&1 - cos(c * t)) * inv((c * t) pow 2)))` + SUBST1_TAC THENL + [EXPAND_TAC "f" THEN REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `t:real` THEN + ASM_CASES_TAC `t = &0` THENL + [ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + ASM_REWRITE_TAC[REAL_POW_MUL; REAL_INV_MUL] THEN + MATCH_MP_TAC(REAL_FIELD + `~(c = &0) /\ ~(t = &0) ==> + (&1 - cos(c * t)) * inv(t pow 2) = + c pow 2 * ((&1 - cos(c * t)) * (inv(c pow 2) * inv(t pow 2)))`) THEN + ASM_REAL_ARITH_TAC]; + MATCH_MP_TAC HAS_REAL_INTEGRAL_LMUL THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN `c pow 2 * inv c * pi = c * pi` ASSUME_TAC THENL + [UNDISCH_TAC `&0 < c` THEN CONV_TAC REAL_FIELD; ALL_TAC] THEN + SUBGOAL_THEN `(f has_real_integral (c * pi)) (:real)` ASSUME_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `!t:real. (f:real->real)(--t) = f t` ASSUME_TAC THENL + [EXPAND_TAC "f" THEN GEN_TAC THEN + ASM_CASES_TAC `t = &0` THEN ASM_REWRITE_TAC[REAL_NEG_0] THEN + SUBGOAL_THEN `~(--t = &0)` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[REAL_MUL_RNEG; COS_NEG; REAL_POW_NEG; ARITH]; + ALL_TAC] THEN + SUBGOAL_THEN `f real_integrable_on (:real)` ASSUME_TAC THENL + [REWRITE_TAC[real_integrable_on] THEN ASM_MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `f real_integrable_on {t | &0 <= t}` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_ON_SUBINTERVAL_GEN THEN + EXISTS_TAC `(:real)` THEN ASM_REWRITE_TAC[SUBSET_UNIV] THEN + REWRITE_TAC[is_realinterval; IN_ELIM_THM] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `f real_integrable_on {t:real | t <= &0}` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_ON_SUBINTERVAL_GEN THEN + EXISTS_TAC `(:real)` THEN ASM_REWRITE_TAC[SUBSET_UNIV] THEN + REWRITE_TAC[is_realinterval; IN_ELIM_THM] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `(f has_real_integral real_integral {t | &0 <= t} f) + {t:real | t <= &0}` ASSUME_TAC THENL + [MP_TAC(ISPECL [`f:real->real`; + `real_integral {t:real | &0 <= t} (f:real->real)`; + `{t:real | &0 <= t}`] HAS_REAL_INTEGRAL_REFLECT_GEN) THEN + SUBGOAL_THEN `IMAGE ((--):real->real) {t | &0 <= t} = {t:real | t <= &0}` + (fun th -> REWRITE_TAC[th]) THENL + [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM] THEN GEN_TAC THEN EQ_TAC THENL + [STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + DISCH_TAC THEN EXISTS_TAC `--x:real` THEN + ASM_REWRITE_TAC[REAL_NEG_NEG] THEN ASM_REAL_ARITH_TAC]; ALL_TAC] THEN + SUBGOAL_THEN `(\x. (f:real->real)(--x)) = f` (fun th -> REWRITE_TAC[th]) THENL + [REWRITE_TAC[FUN_EQ_THM] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + DISCH_THEN(fun th -> + MP_TAC(fst(EQ_IMP_RULE th)) THEN + ANTS_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_INTEGRAL THEN ASM_REWRITE_TAC[]; + MESON_TAC[]]); + ALL_TAC] THEN + SUBGOAL_THEN + `(f has_real_integral (real_integral {t | &0 <= t} f + + real_integral {t | &0 <= t} f)) + ({t:real | &0 <= t} UNION {t | t <= &0})` ASSUME_TAC THENL + [MATCH_MP_TAC HAS_REAL_INTEGRAL_UNION THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_INTEGRAL THEN ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + SUBGOAL_THEN `{t:real | &0 <= t} INTER {t | t <= &0} = {&0}` + (fun th -> REWRITE_TAC[th; REAL_NEGLIGIBLE_SING]) THEN + REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM; IN_SING] THEN + REAL_ARITH_TAC]; ALL_TAC] THEN + SUBGOAL_THEN + `real_integral {t | &0 <= t} f + real_integral {t | &0 <= t} f = c * pi` + ASSUME_TAC THENL + [MATCH_MP_TAC HAS_REAL_INTEGRAL_UNIQUE THEN + EXISTS_TAC `f:real->real` THEN EXISTS_TAC `(:real)` THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `{t:real | &0 <= t} UNION {t | t <= &0} = (:real)` ASSUME_TAC THENL + [REWRITE_TAC[EXTENSION; IN_UNION; IN_ELIM_THM; IN_UNIV] THEN + REAL_ARITH_TAC; ALL_TAC] THEN + ASM_MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `pi * c / &2 = c * pi / &2` SUBST1_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `real_integral {t | &0 <= t} (f:real->real) = c * pi / &2` + (fun th -> REWRITE_TAC[GSYM th]) THENL + [ABBREV_TAC `J = real_integral {t | &0 <= t} (f:real->real)` THEN + UNDISCH_TAC `J + J = c * pi` THEN REAL_ARITH_TAC; + MATCH_MP_TAC REAL_INTEGRABLE_INTEGRAL THEN ASM_REWRITE_TAC[]]);; + +(* Cosine difference integral: int_[0,inf) (cos(at)-cos(bt))/t^2 = pi*(b-a)/2 *) +let COS_DIFF_HAS_REAL_INTEGRAL_HALFLINE = prove + (`!a b. &0 < a /\ &0 < b ==> + ((\t. if t = &0 then (b pow 2 - a pow 2) / &2 + else (cos(a * t) - cos(b * t)) * inv(t pow 2)) + has_real_integral (pi * (b - a) / &2)) {t | &0 <= t}`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\t. if t = &0 then (b pow 2 - a pow 2) / &2 + else (cos(a * t) - cos(b * t)) * inv(t pow 2)) = + (\t. (if t = &0 then b pow 2 / &2 else (&1 - cos(b * t)) * inv(t pow 2)) - + (if t = &0 then a pow 2 / &2 else (&1 - cos(a * t)) * inv(t pow 2)))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `t:real` THEN + ASM_CASES_TAC `t = &0` THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `pi * (b - a) / &2 = pi * b / &2 - pi * a / &2` SUBST1_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_SUB THEN CONJ_TAC THEN + MATCH_MP_TAC ONE_MINUS_COS_SCALED_HAS_REAL_INTEGRAL_HALFLINE THEN + ASM_REWRITE_TAC[]);; + +(* Generalized cosine difference for arbitrary nonzero alpha, beta *) +(* Uses COS_ABS to reduce to the positive case *) +let COS_DIFF_HAS_REAL_INTEGRAL_HALFLINE_GEN = prove + (`!alpha beta. ~(alpha = &0) /\ ~(beta = &0) ==> + ((\t. if t = &0 then (beta pow 2 - alpha pow 2) / &2 + else (cos(alpha * t) - cos(beta * t)) * inv(t pow 2)) + has_real_integral (pi * (abs beta - abs alpha) / &2)) {t | &0 <= t}`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_SPIKE THEN + EXISTS_TAC `\t. if t = &0 then (abs beta pow 2 - abs alpha pow 2) / &2 + else (cos(abs alpha * t) - cos(abs beta * t)) * inv(t pow 2)` THEN + EXISTS_TAC `{}:real->bool` THEN + REWRITE_TAC[REAL_NEGLIGIBLE_EMPTY; IN_DIFF; NOT_IN_EMPTY] THEN CONJ_TAC THENL + [REWRITE_TAC[IN_ELIM_THM] THEN X_GEN_TAC `x:real` THEN DISCH_TAC THEN + COND_CASES_TAC THENL [REWRITE_TAC[REAL_POW2_ABS]; ALL_TAC] THEN + SUBGOAL_THEN `&0 < x` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[] THEN AP_THM_TAC THEN AP_TERM_TAC THEN + SUBGOAL_THEN `cos(alpha * x) = cos(abs alpha * x) /\ + cos(beta * x) = cos(abs beta * x)` + (fun th -> REWRITE_TAC[th]) THEN + CONJ_TAC THEN ONCE_REWRITE_TAC[GSYM COS_ABS] THEN AP_TERM_TAC THEN + REWRITE_TAC[REAL_ABS_MUL] THEN + SUBGOAL_THEN `abs x = x` (fun th -> REWRITE_TAC[th]) THEN + ASM_REAL_ARITH_TAC; + MATCH_MP_TAC COS_DIFF_HAS_REAL_INTEGRAL_HALFLINE THEN + ASM_REWRITE_TAC[GSYM REAL_ABS_NZ]]);; + +(* Full cosine difference for a < b (covers case when a or b is zero) *) +let COS_DIFF_HAS_REAL_INTEGRAL_HALFLINE_FULL = prove + (`!a b. a < b ==> + ((\t. if t = &0 then (b pow 2 - a pow 2) / &2 + else (cos(a * t) - cos(b * t)) * inv(t pow 2)) + has_real_integral (pi * (abs b - abs a) / &2)) {t | &0 <= t}`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `a = &0` THENL + [ASM_REWRITE_TAC[REAL_MUL_LZERO; COS_0; REAL_ABS_NUM; REAL_SUB_LZERO; + REAL_POW_ZERO; ARITH_EQ; REAL_SUB_RZERO] THEN + SUBGOAL_THEN `&0 < b` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `abs b = b` SUBST1_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC ONE_MINUS_COS_SCALED_HAS_REAL_INTEGRAL_HALFLINE THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + ASM_CASES_TAC `b = &0` THENL + [ASM_REWRITE_TAC[REAL_MUL_LZERO; COS_0; REAL_ABS_NUM; REAL_SUB_RZERO; + REAL_POW_ZERO; ARITH_EQ] THEN + SUBGOAL_THEN `a < &0` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `abs a = --a` SUBST1_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `&0 < --a` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_SPIKE THEN + EXISTS_TAC `\t. --((if t = &0 then (--a) pow 2 / &2 + else (&1 - cos((--a) * t)) * inv(t pow 2)))` THEN + EXISTS_TAC `{&0}` THEN REWRITE_TAC[REAL_NEGLIGIBLE_SING] THEN CONJ_TAC THENL + [REWRITE_TAC[IN_DIFF; IN_ELIM_THM; IN_SING] THEN + X_GEN_TAC `t:real` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[REAL_MUL_LNEG; COS_NEG] THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `pi * (&0 - --a) / &2 = --(pi * (--a) / &2)` SUBST1_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_NEG THEN + MATCH_MP_TAC ONE_MINUS_COS_SCALED_HAS_REAL_INTEGRAL_HALFLINE THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC COS_DIFF_HAS_REAL_INTEGRAL_HALFLINE_GEN THEN + ASM_REWRITE_TAC[]);; + +(* Algebraic identity: trapezoidal function = 1/2 + abs difference / (2h) *) +let TRAPEZOIDAL_ALG_IDENTITY = prove + (`!x h y. &0 < h ==> + max (&0) (min (&1) (&1 - (y - x) / h)) = + &1 / &2 + (abs(x + h - y) - abs(x - y)) / (&2 * h)`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `y <= x` THENL + [SUBGOAL_THEN `abs(x + h - y) = x + h - y` SUBST1_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `abs(x - y) = x - y` SUBST1_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `(y - x) / h <= &0` ASSUME_TAC THENL + [ASM_SIMP_TAC[REAL_LE_LDIV_EQ] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `min (&1) (&1 - (y - x) / h) = &1` SUBST1_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_ARITH `max (&0) (&1) = &1`] THEN + MP_TAC(REAL_FIELD `&0 < h ==> (x + h - y - (x - y)) / (&2 * h) = &1 / &2`) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + ASM_CASES_TAC `y <= x + h` THENL + [SUBGOAL_THEN `abs(x + h - y) = x + h - y` SUBST1_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `abs(x - y) = y - x` SUBST1_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `(y - x) / h <= &1` ASSUME_TAC THENL + [ASM_SIMP_TAC[REAL_LE_LDIV_EQ] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `&0 <= (y - x) / h` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_DIV THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `min (&1) (&1 - (y - x) / h) = &1 - (y - x) / h` SUBST1_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `max (&0) (&1 - (y - x) / h) = &1 - (y - x) / h` SUBST1_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(REAL_FIELD `&0 < h ==> ((x + h - y) - (y - x)) / (&2 * h) = &1 - (y - x) / h - &1 / &2`) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + SUBGOAL_THEN `abs(x + h - y) = y - x - h` SUBST1_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `abs(x - y) = y - x` SUBST1_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `&1 < (y - x) / h` ASSUME_TAC THENL + [ASM_SIMP_TAC[REAL_LT_RDIV_EQ] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `min (&1) (&1 - (y - x) / h) = &1 - (y - x) / h` SUBST1_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `max (&0) (&1 - (y - x) / h) = &0` SUBST1_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(REAL_FIELD `&0 < h ==> ((y - x - h) - (y - x)) / (&2 * h) = -- &1 / &2`) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC]]);; + +(* Fourier identity for the trapezoidal function *) +let TRAPEZOIDAL_FOURIER_IDENTITY = prove + (`!x h y. &0 < h ==> + max (&0) (min (&1) (&1 - (y - x) / h)) = + &1 / &2 + inv(pi * h) * + real_integral {t | &0 <= t} + (\t. if t = &0 then ((x + h - y) pow 2 - (x - y) pow 2) / &2 + else (cos((x - y) * t) - cos((x + h - y) * t)) * inv(t pow 2))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `((\t. if t = &0 then ((x + h - y) pow 2 - (x - y) pow 2) / &2 + else (cos((x - y) * t) - cos((x + h - y) * t)) * inv(t pow 2)) + has_real_integral (pi * (abs(x + h - y) - abs(x - y)) / &2)) {t | &0 <= t}` + ASSUME_TAC THENL + [MATCH_MP_TAC COS_DIFF_HAS_REAL_INTEGRAL_HALFLINE_FULL THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `real_integral {t | &0 <= t} + (\t. if t = &0 then ((x + h - y) pow 2 - (x - y) pow 2) / &2 + else (cos((x - y) * t) - cos((x + h - y) * t)) * inv(t pow 2)) = + pi * (abs(x + h - y) - abs(x - y)) / &2` + SUBST1_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `~(pi = &0) /\ ~(h = &0)` STRIP_ASSUME_TAC THENL + [MP_TAC PI_POS THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `inv(pi * h) * pi * (abs(x + h - y) - abs(x - y)) / &2 = + (abs(x + h - y) - abs(x - y)) / (&2 * h)` SUBST1_TAC THENL + [REWRITE_TAC[real_div; REAL_INV_MUL] THEN + SUBGOAL_THEN `(inv pi * inv h) * pi * (abs(x + h - y) - abs(x - y)) * inv(&2) = + (inv pi * pi) * (abs(x + h - y) - abs(x - y)) * inv(&2) * inv h` + SUBST1_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_MUL_LINV] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[GSYM TRAPEZOIDAL_ALG_IDENTITY]);; + +(* Trigonometric expansion: cos((x-u)t) - cos((x+h-u)t) factors through *) +(* cos(tu) and sin(tu), enabling connection to characteristic functions *) +let TRIG_COS_DIFF_EXPAND = prove + (`!x h u t:real. + cos((x - u) * t) - cos((x + h - u) * t) = + cos(t * u) * (cos(t * x) - cos(t * (x + h))) - + sin(t * u) * (sin(t * (x + h)) - sin(t * x))`, + REWRITE_TAC[REAL_RING `!x u t:real. (x - u) * t = t * x - t * u`; + REAL_RING `!x h u t:real. (x + h - u) * t = t * (x + h) - t * u`] THEN + REWRITE_TAC[COS_SUB] THEN REAL_ARITH_TAC);; + +(* Factor a sum of trig products: sum (pp*[cos*A - sin*B]*C) factors *) +let SUM_TRIG_FACTOR = prove + (`!S:real->bool. FINITE S ==> + !(pp:real->real) a1 b1 c1 t:real. + sum S (\u. pp u * (cos(t * u) * a1 - sin(t * u) * b1) * c1) = + (sum S (\u. pp u * cos(t * u)) * a1 - sum S (\u. pp u * sin(t * u)) * b1) * c1`, + GEN_TAC THEN DISCH_TAC THEN REPEAT GEN_TAC THEN + SUBGOAL_THEN `!u:real. (pp:real->real) u * (cos(t * u) * a1 - sin(t * u) * b1) * c1 = + (pp u * cos(t * u)) * (a1 * c1) - (pp u * sin(t * u)) * (b1 * c1)` + (fun th -> REWRITE_TAC[th]) THENL + [GEN_TAC THEN CONV_TAC REAL_RING; ALL_TAC] THEN + MP_TAC(ISPECL [`\u:real. ((pp:real->real) u * cos(t * u)) * a1 * c1`; + `\u:real. ((pp:real->real) u * sin(t * u)) * b1 * c1`; `S:real->bool`] SUM_SUB) THEN + ASM_REWRITE_TAC[] THEN BETA_TAC THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[SUM_RMUL] THEN REAL_ARITH_TAC);; + +(* Exact Fourier identity for simple RV expectation of trapezoidal function *) +let SIMPLE_EXPECTATION_TRAPEZOIDAL_FOURIER = prove + (`!p:A prob_space Y x h. + simple_rv p Y /\ &0 < h + ==> simple_expectation p + (\a. max (&0) (min (&1) (&1 - (Y a - x) / h))) = + &1 / &2 + + inv (pi * h) * + real_integral {t | &0 <= t} + (\t. (simple_char_fn_re p Y t * (cos(t * x) - cos(t * (x + h))) - + simple_char_fn_im p Y t * (sin(t * (x + h)) - sin(t * x))) * + inv (t pow 2))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + ABBREV_TAC `S = IMAGE (Y:A->real) (prob_carrier p)` THEN + ABBREV_TAC `pp = (\u:real. prob p {a:A | a IN prob_carrier p /\ Y a = u})` THEN + SUBGOAL_THEN `FINITE (S:real->bool)` ASSUME_TAC THENL [ + EXPAND_TAC "S" THEN REWRITE_TAC[GSYM SIMPLE_IMAGE] THEN + ASM_MESON_TAC[simple_rv]; + ALL_TAC] THEN + SUBGOAL_THEN `sum S (pp:real->real) = &1` ASSUME_TAC THENL [ + EXPAND_TAC "pp" THEN EXPAND_TAC "S" THEN + MATCH_MP_TAC SIMPLE_PROB_SUM_ONE THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MP_TAC(ISPECL [`p:A prob_space`; `Y:A->real`; + `(\y. max (&0) (min (&1) (&1 - (y - x) / h))):real->real`] + SIMPLE_EXPECTATION_COMPOSE_SUM) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `(\u:real. max (&0) (min (&1) (&1 - (u - x) / h)) * + prob p {a:A | a IN prob_carrier p /\ Y a = u}) = + (\u. pp u * max (&0) (min (&1) (&1 - (u - x) / h)))` + SUBST1_TAC THENL [ + EXPAND_TAC "pp" THEN REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + REWRITE_TAC[REAL_MUL_SYM]; + ALL_TAC] THEN + SUBGOAL_THEN + `!u:real. u IN S ==> max (&0) (min (&1) (&1 - (u - x) / h)) = + &1 / &2 + inv(pi * h) * real_integral {t | &0 <= t} + (\t. if t = &0 then ((x + h - u) pow 2 - (x - u) pow 2) / &2 + else (cos((x - u) * t) - cos((x + h - u) * t)) * inv(t pow 2))` + ASSUME_TAC THENL [ + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`x:real`; `h:real`; `u:real`] TRAPEZOIDAL_FOURIER_IDENTITY) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + ASM_SIMP_TAC[] THEN + SUBGOAL_THEN `!u:real. pp u * (&1 / &2 + inv(pi * h) * real_integral {t | &0 <= t} + (\t. if t = &0 then ((x + h - u) pow 2 - (x - u) pow 2) / &2 + else (cos((x - u) * t) - cos((x + h - u) * t)) * inv(t pow 2))) = + pp u * &1 / &2 + pp u * (inv(pi * h) * real_integral {t | &0 <= t} + (\t. if t = &0 then ((x + h - u) pow 2 - (x - u) pow 2) / &2 + else (cos((x - u) * t) - cos((x + h - u) * t)) * inv(t pow 2)))` + (fun th -> REWRITE_TAC[th]) THENL [ + GEN_TAC THEN REWRITE_TAC[REAL_ADD_LDISTRIB]; ALL_TAC] THEN + ASM_SIMP_TAC[SUM_ADD] THEN + REWRITE_TAC[SUM_RMUL] THEN + ASM_REWRITE_TAC[REAL_ARITH `&1 * &1 / &2 = &1 / &2`] THEN + AP_TERM_TAC THEN + SUBGOAL_THEN `!u:real. pp u * (inv (pi * h) * + real_integral {t | &0 <= t} + (\t. if t = &0 then ((x + h - u) pow 2 - (x - u) pow 2) / &2 + else (cos ((x - u) * t) - cos ((x + h - u) * t)) * inv (t pow 2))) = + inv(pi * h) * (pp u * real_integral {t | &0 <= t} + (\t. if t = &0 then ((x + h - u) pow 2 - (x - u) pow 2) / &2 + else (cos ((x - u) * t) - cos ((x + h - u) * t)) * inv (t pow 2)))` + (fun th -> REWRITE_TAC[th]) THENL [ + GEN_TAC THEN REWRITE_TAC[REAL_MUL_AC]; ALL_TAC] THEN + REWRITE_TAC[SUM_LMUL] THEN + AP_TERM_TAC THEN + ABBREV_TAC `V = sum S (\u:real. pp u * pi * (abs(x + h - u) - abs(x - u)) / &2)` THEN + SUBGOAL_THEN `sum S (\x':real. pp x' * real_integral {t | &0 <= t} + (\t. if t = &0 then ((x + h - x') pow 2 - (x - x') pow 2) / &2 + else (cos((x - x') * t) - cos((x + h - x') * t)) * inv(t pow 2))) = V` + SUBST1_TAC THENL [ + EXPAND_TAC "V" THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN + X_GEN_TAC `u:real` THEN AP_TERM_TAC THEN + MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + MATCH_MP_TAC(SPECL [`x - u:real`; `x + h - u:real`] + COS_DIFF_HAS_REAL_INTEGRAL_HALFLINE_FULL) THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + EXPAND_TAC "V" THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_SPIKE THEN + EXISTS_TAC `(\t. sum S (\u:real. pp u * (cos((x - u) * t) - cos((x + h - u) * t)) * + inv(t pow 2)))` THEN + EXISTS_TAC `{&0}` THEN + REPEAT CONJ_TAC THENL [ + REWRITE_TAC[REAL_NEGLIGIBLE_SING]; + REWRITE_TAC[IN_DIFF; IN_SING; IN_ELIM_THM] THEN + X_GEN_TAC `t:real` THEN STRIP_TAC THEN BETA_TAC THEN + CONV_TAC SYM_CONV THEN + SUBGOAL_THEN `!u':real. pp u' * (cos((x - u') * t) - cos((x + h - u') * t)) * + inv(t pow 2) = + pp u' * (cos(t * u') * (cos(t * x) - cos(t * (x + h))) - + sin(t * u') * (sin(t * (x + h)) - sin(t * x))) * inv(t pow 2)` + (fun th -> REWRITE_TAC[th]) THENL [ + GEN_TAC THEN + SUBGOAL_THEN `cos((x - u') * t) - cos((x + h - u') * t) = + cos(t * u') * (cos(t * x) - cos(t * (x + h))) - + sin(t * u') * (sin(t * (x + h)) - sin(t * x))` + (fun th -> REWRITE_TAC[th]) THEN + MP_TAC(SPECL [`x:real`; `h:real`; `u':real`; `t:real`] TRIG_COS_DIFF_EXPAND) THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(ISPEC `S:real->bool` SUM_TRIG_FACTOR) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN + REWRITE_TAC[simple_char_fn_re; simple_char_fn_im] THEN + EXPAND_TAC "pp" THEN EXPAND_TAC "S" THEN + MP_TAC(ISPECL [`p:A prob_space`; `Y:A->real`; `\y:real. cos(t * y)`] + SIMPLE_EXPECTATION_COMPOSE_SUM) THEN + MP_TAC(ISPECL [`p:A prob_space`; `Y:A->real`; `\y:real. sin(t * y)`] + SIMPLE_EXPECTATION_COMPOSE_SUM) THEN + ASM_REWRITE_TAC[] THEN + REPEAT(DISCH_THEN(fun th -> REWRITE_TAC[th])) THEN + REWRITE_TAC[REAL_MUL_SYM]; + MATCH_MP_TAC HAS_REAL_INTEGRAL_SUM THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `u:real` THEN DISCH_TAC THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_SPIKE THEN + EXISTS_TAC `(\t. pp u * (if t = &0 + then ((x + h - u) pow 2 - (x - u) pow 2) / &2 + else (cos((x - u) * t) - cos((x + h - u) * t)) * inv(t pow 2))):real->real` THEN + EXISTS_TAC `{&0}` THEN + REPEAT CONJ_TAC THENL [ + REWRITE_TAC[REAL_NEGLIGIBLE_SING]; + REWRITE_TAC[IN_DIFF; IN_SING; IN_ELIM_THM] THEN + X_GEN_TAC `t:real` THEN STRIP_TAC THEN BETA_TAC THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC HAS_REAL_INTEGRAL_LMUL THEN + MATCH_MP_TAC(SPECL [`x - u:real`; `x + h - u:real`] + COS_DIFF_HAS_REAL_INTEGRAL_HALFLINE_FULL) THEN ASM_REAL_ARITH_TAC]]);; + +(* Fejer kernel equals a rescaled sinc-squared *) +let FEJER_KERNEL_REAL_EQ_SINC_SQUARED = prove + (`!TT x. &0 < TT ==> + fejer_kernel_real TT x = + inv(pi) * (TT / &2) * + (if (TT / &2) * x = &0 then &1 + else sin((TT / &2) * x) pow 2 * inv(((TT / &2) * x) pow 2))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[fejer_kernel_real] THEN + SUBGOAL_THEN `~(TT / &2 = &0)` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `((TT / &2) * x = &0) <=> (x = &0)` SUBST1_TAC THENL + [EQ_TAC THENL + [ASM_SIMP_TAC[REAL_ENTIRE] THEN ASM_REAL_ARITH_TAC; + DISCH_TAC THEN ASM_REWRITE_TAC[REAL_MUL_RZERO]]; + ALL_TAC] THEN + COND_CASES_TAC THENL + [SUBGOAL_THEN `~(pi = &0)` MP_TAC THENL + [MP_TAC PI_POS THEN REAL_ARITH_TAC; CONV_TAC REAL_FIELD]; + REWRITE_TAC[REAL_POW_MUL; REAL_INV_MUL] THEN + SUBGOAL_THEN `TT * x / &2 = (TT / &2) * x` SUBST1_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `~(pi = &0) /\ ~(TT = &0) /\ ~(x = &0)` MP_TAC THENL + [MP_TAC PI_POS THEN ASM_REAL_ARITH_TAC; CONV_TAC REAL_FIELD]]);; + +(* The Fejer kernel full-line integral equals 1 *) +let FEJER_KERNEL_REAL_INTEGRAL = prove + (`!TT. &0 < TT ==> + ((\x. fejer_kernel_real TT x) has_real_integral &1) (:real)`, + GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN `&0 < TT / &2` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ABBREV_TAC `m = TT / &2` THEN + SUBGOAL_THEN `&0 < m` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + (* Step 1: Use HAS_REAL_INTEGRAL_EQ to reduce to scaled sinc-squared *) + MATCH_MP_TAC HAS_REAL_INTEGRAL_EQ THEN + EXISTS_TAC `\x:real. inv(pi) * m * + (if m * x = &0 then &1 + else sin(m * x) pow 2 * inv((m * x) pow 2))` THEN + CONJ_TAC THENL + [X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_UNIV] THEN BETA_TAC THEN + CONV_TAC SYM_CONV THEN + ASM_SIMP_TAC[FEJER_KERNEL_REAL_EQ_SINC_SQUARED] THEN + EXPAND_TAC "m" THEN REWRITE_TAC[]; + (* Step 2: Prove integral via stretch + scale of sinc-squared *) + BETA_TAC THEN + MP_TAC SINC_SQUARED_HAS_REAL_INTEGRAL_UNIV THEN + DISCH_THEN(fun th -> MP_TAC(CONJ th (ASSUME `&0 < m`))) THEN + DISCH_THEN(MP_TAC o MATCH_MP HAS_REAL_INTEGRAL_STRETCH_UNIV) THEN + DISCH_THEN(fun th -> + MP_TAC(SPEC `inv(pi) * m` (MATCH_MP HAS_REAL_INTEGRAL_LMUL th))) THEN + SUBGOAL_THEN `(inv(pi) * m) * (inv m * pi) = &1` SUBST1_TAC THENL + [SUBGOAL_THEN `~(pi = &0) /\ ~(m = &0)` MP_TAC THENL + [MP_TAC PI_POS THEN ASM_REAL_ARITH_TAC; CONV_TAC REAL_FIELD]; + DISCH_THEN(fun th -> ACCEPT_TAC(REWRITE_RULE[GSYM REAL_MUL_ASSOC] th))]]);; + +(* Helper: integral of cos(tx) on [0,T] *) +let COS_HAS_REAL_INTEGRAL = prove + (`!TT x. &0 < TT /\ ~(x = &0) ==> + ((\t. cos(t * x)) has_real_integral (sin(TT * x) * inv x)) + (real_interval[&0, TT])`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `sin(TT * x) * inv x = + (sin(TT * x) * inv x) - (sin(&0 * x) * inv x)` SUBST1_TAC THENL + [REWRITE_TAC[SIN_0; REAL_MUL_LZERO; REAL_SUB_RZERO]; ALL_TAC] THEN + MATCH_MP_TAC REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN + X_GEN_TAC `u:real` THEN DISCH_TAC THEN + SUBGOAL_THEN `cos(u * x) = + ((&1 * x) * cos(u * x)) * inv x` SUBST1_TAC THENL + [MATCH_MP_TAC(REAL_FIELD `~(x = &0) ==> c = ((&1 * x) * c) * inv x`) THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC HAS_REAL_DERIVATIVE_ATREAL_WITHIN THEN + ACCEPT_TAC(SPEC `u:real` (GEN `t:real` + (REAL_DIFF_CONV `((\t. sin(t * x) * inv x) has_real_derivative f) (atreal t)`)))]);; + +(* Helper: integral of t*cos(tx) on [0,T] *) +let T_COS_HAS_REAL_INTEGRAL = prove + (`!TT x. &0 < TT /\ ~(x = &0) ==> + ((\t. t * cos(t * x)) has_real_integral + (TT * sin(TT * x) * inv x + cos(TT * x) * inv(x pow 2) - inv(x pow 2))) + (real_interval[&0, TT])`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `TT * sin(TT * x) * inv x + cos(TT * x) * inv(x pow 2) - inv(x pow 2) = + (TT * sin(TT * x) * inv x + cos(TT * x) * inv(x pow 2)) - + (&0 * sin(&0 * x) * inv x + cos(&0 * x) * inv(x pow 2))` SUBST1_TAC THENL + [REWRITE_TAC[SIN_0; COS_0; REAL_MUL_LZERO; REAL_MUL_LID] THEN + REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN + X_GEN_TAC `u:real` THEN DISCH_TAC THEN + SUBGOAL_THEN `u * cos(u * x) = + ((u * ((&1 * x) * cos(u * x)) * inv x + &1 * sin(u * x) * inv x) + + ((&1 * x) * --sin(u * x)) * inv(x pow 2))` SUBST1_TAC THENL + [REWRITE_TAC[REAL_POW_2] THEN + MATCH_MP_TAC(REAL_FIELD `~(x = &0) ==> + u * c = ((u * ((&1 * x) * c) * inv x + &1 * s * inv x) + + ((&1 * x) * --s) * inv(x * x))`) THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC HAS_REAL_DERIVATIVE_ATREAL_WITHIN THEN + ACCEPT_TAC(SPEC `u:real` (GEN `t:real` + (REAL_DIFF_CONV + `((\t. t * sin(t * x) * inv x + cos(t * x) * inv(x pow 2)) + has_real_derivative f) (atreal t)`)))]);; + +(* Cosine integral representation of Fejer kernel *) +let FEJER_KERNEL_REAL_COSINE = prove + (`!TT x. &0 < TT ==> + fejer_kernel_real TT x = + inv pi * real_integral (real_interval[&0,TT]) + (\t. (&1 - t / TT) * cos(t * x))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[fejer_kernel_real] THEN + ASM_CASES_TAC `x = &0` THENL + [(* Case x = 0: integral of (1-t/T)*1 = T/2, so inv(pi)*T/2 = T/(2*pi) *) + ASM_REWRITE_TAC[REAL_MUL_RZERO; COS_0; REAL_MUL_RID] THEN + SUBGOAL_THEN `real_integral (real_interval[&0,TT]) (\t:real. &1 - t / TT) = + TT / &2` SUBST1_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + SUBGOAL_THEN `TT / &2 = (\t:real. t - t pow 2 / (&2 * TT)) TT - + (\t:real. t - t pow 2 / (&2 * TT)) (&0)` SUBST1_TAC THENL + [BETA_TAC THEN SUBGOAL_THEN `~(TT = &0)` MP_TAC THENL + [ASM_REAL_ARITH_TAC; CONV_TAC REAL_FIELD]; ALL_TAC] THEN + MATCH_MP_TAC REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN + X_GEN_TAC `u:real` THEN DISCH_TAC THEN + MP_TAC(SPEC `u:real` (GEN `t:real` + (REAL_DIFF_CONV + `((\t. t - t pow 2 / (&2 * TT)) has_real_derivative f) (atreal t)`))) THEN + CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[REAL_MUL_RID; REAL_POW_1] THEN + SUBGOAL_THEN `&1 - (&2 * u) / (&2 * TT) = &1 - u / TT` + (fun th -> REWRITE_TAC[th]) THENL + [SUBGOAL_THEN `~(TT = &0)` MP_TAC THENL + [ASM_REAL_ARITH_TAC; CONV_TAC REAL_FIELD]; ALL_TAC] THEN + DISCH_TAC THEN MATCH_MP_TAC HAS_REAL_DERIVATIVE_ATREAL_WITHIN THEN + ASM_REWRITE_TAC[]; + SUBGOAL_THEN `~(TT = &0)` MP_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC PI_POS THEN CONV_TAC REAL_FIELD]; + (* Case x != 0: use the integral computations *) + ASM_REWRITE_TAC[] THEN + (* The integral of (1-t/T)*cos(tx) = integral cos(tx) - (1/T)*integral t*cos(tx) *) + SUBGOAL_THEN + `real_integral (real_interval[&0,TT]) (\t. (&1 - t / TT) * cos(t * x)) = + real_integral (real_interval[&0,TT]) (\t. cos(t * x)) - + inv TT * real_integral (real_interval[&0,TT]) (\t. t * cos(t * x))` + SUBST1_TAC THENL + [SUBGOAL_THEN `(\t:real. (&1 - t / TT) * cos(t * x)) = + (\t. cos(t * x) - inv TT * (t * cos(t * x)))` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; real_div] THEN GEN_TAC THEN REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `(\t. cos(t * x)) real_integrable_on real_interval[&0,TT] /\ + (\t. t * cos(t * x)) real_integrable_on real_interval[&0,TT]` + STRIP_ASSUME_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_CONTINUOUS THEN + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_COMPOSE THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_COS] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_RMUL THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_ID]; + MATCH_MP_TAC REAL_INTEGRABLE_CONTINUOUS THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_MUL THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_CONTINUOUS_ON_ID]; + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_COMPOSE THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_COS] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_RMUL THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_ID]]]; + ASM_SIMP_TAC[REAL_INTEGRAL_SUB; REAL_INTEGRABLE_LMUL] THEN + ASM_SIMP_TAC[REAL_INTEGRAL_LMUL]]; + ALL_TAC] THEN + (* Now substitute the integral values *) + MP_TAC(SPECL [`TT:real`; `x:real`] COS_HAS_REAL_INTEGRAL) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MP_TAC(SPECL [`TT:real`; `x:real`] T_COS_HAS_REAL_INTEGRAL) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + SUBGOAL_THEN `real_integral (real_interval [&0,TT]) (\t. cos (t * x)) = + sin(TT * x) * inv x` SUBST1_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `real_integral (real_interval [&0,TT]) (\t. t * cos (t * x)) = + TT * sin(TT * x) * inv x + cos(TT * x) * inv(x pow 2) - inv(x pow 2)` + SUBST1_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + (* Simplify to (1 - cos(TT*x))/(pi*TT*x^2) *) + SUBGOAL_THEN `sin (TT * x) * inv x - + inv TT * (TT * sin (TT * x) * inv x + cos (TT * x) * inv (x pow 2) - + inv (x pow 2)) = + (&1 - cos(TT * x)) * inv(TT * x pow 2)` SUBST1_TAC THENL + [REWRITE_TAC[REAL_POW_2; real_div; REAL_INV_MUL] THEN + SUBGOAL_THEN `~(TT = &0) /\ ~(x = &0)` MP_TAC THENL + [ASM_REAL_ARITH_TAC; CONV_TAC REAL_FIELD]; ALL_TAC] THEN + (* Use 1 - cos(a) = 2*sin^2(a/2) *) + SUBGOAL_THEN `&1 - cos(TT * x) = &2 * sin(TT * x / &2) pow 2` + SUBST1_TAC THENL + [MP_TAC(SPEC `TT * x / &2` COS_DOUBLE_SIN) THEN + SUBGOAL_THEN `&2 * (TT * x / &2) = TT * x` (fun th -> REWRITE_TAC[th]) THENL + [REAL_ARITH_TAC; REAL_ARITH_TAC]; + ALL_TAC] THEN + REWRITE_TAC[real_div; REAL_INV_MUL] THEN + SUBGOAL_THEN `~(pi = &0)` MP_TAC THENL + [MP_TAC PI_POS THEN REAL_ARITH_TAC; CONV_TAC REAL_FIELD]]);; + + +(* ------------------------------------------------------------------------- *) +(* Esseen smoothing inequality for simple RVs. *) +(* Bounds |F(x) - Phi(x)| by the integral of char fn error over [0,T] *) +(* plus a 1/T tail term. The proof splits into a trivial case (T small, *) +(* where the 1/T term alone dominates) and a non-trivial case requiring *) +(* Fourier analysis (Beurling-Selberg majorant/minorant technique). *) +(* Constant 24/(pi*sqrt(2*pi)) is non-optimal but explicit. *) +(* ------------------------------------------------------------------------- *) + +(* Helper: the smoothing integrand is integrable on [0, TT] for simple RVs. *) + +(* Continuity of simple characteristic function components as functions of t. *) +(* These follow from the finite sum representation. *) +let SIMPLE_CHAR_FN_RE_CONTINUOUS = prove + (`!p:A prob_space Y:A->real. + simple_rv p Y ==> + (\t. simple_char_fn_re p Y t) real_continuous_on (:real)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[simple_char_fn_re] THEN + SUBGOAL_THEN `!t:real. simple_expectation (p:A prob_space) + (\x:A. cos(t * (Y:A->real) x)) = + sum (IMAGE Y (prob_carrier p)) + (\u. cos(t * u) * prob p {x | x IN prob_carrier p /\ Y x = u})` + (fun th -> REWRITE_TAC[th]) THENL + [GEN_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `Y:A->real`; `\y:real. cos(t * y)`] + SIMPLE_EXPECTATION_COMPOSE_SUM) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_SUM THEN + REWRITE_TAC[] THEN CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o REWRITE_RULE[simple_rv]) THEN + STRIP_TAC THEN ASM_REWRITE_TAC[IMAGE; GSYM SIMPLE_IMAGE]; + ALL_TAC] THEN + X_GEN_TAC `u:real` THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_MUL THEN CONJ_TAC THENL + [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_ON_RMUL THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_ID]; + REWRITE_TAC[REAL_CONTINUOUS_ON_COS]]; + REWRITE_TAC[REAL_CONTINUOUS_ON_CONST]]);; + +let SIMPLE_CHAR_FN_IM_CONTINUOUS = prove + (`!p:A prob_space Y:A->real. + simple_rv p Y ==> + (\t. simple_char_fn_im p Y t) real_continuous_on (:real)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[simple_char_fn_im] THEN + SUBGOAL_THEN `!t:real. simple_expectation (p:A prob_space) + (\x:A. sin(t * (Y:A->real) x)) = + sum (IMAGE Y (prob_carrier p)) + (\u. sin(t * u) * prob p {x | x IN prob_carrier p /\ Y x = u})` + (fun th -> REWRITE_TAC[th]) THENL + [GEN_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `Y:A->real`; `\y:real. sin(t * y)`] + SIMPLE_EXPECTATION_COMPOSE_SUM) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_SUM THEN + REWRITE_TAC[] THEN CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o REWRITE_RULE[simple_rv]) THEN + STRIP_TAC THEN ASM_REWRITE_TAC[IMAGE; GSYM SIMPLE_IMAGE]; + ALL_TAC] THEN + X_GEN_TAC `u:real` THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_MUL THEN CONJ_TAC THENL + [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_ON_RMUL THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_ID]; + REWRITE_TAC[REAL_CONTINUOUS_ON_SIN]]; + REWRITE_TAC[REAL_CONTINUOUS_ON_CONST]]);; + +(* Measurability of the smoothing integrand on any interval [a,b]. *) +(* The numerator is continuous (char fns are continuous for simple RVs) *) +(* and division by t introduces at most a negligible singularity at t=0. *) +let SMOOTHING_INTEGRAND_MEASURABLE = prove + (`!p:A prob_space Y:A->real D:real a b. + simple_rv p Y /\ &0 < D ==> + (\t. (abs(simple_char_fn_re p Y (t / D) - exp(--(t pow 2 / &2))) + + abs(simple_char_fn_im p Y (t / D))) / t) + real_measurable_on real_interval[a,b]`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_MEASURABLE_ON_DIV THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_IMP_REAL_MEASURABLE_ON_CLOSED_SUBSET THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `(:real)` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_ON_ADD THEN CONJ_TAC THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_ABS THENL + [MATCH_MP_TAC REAL_CONTINUOUS_ON_SUB THEN CONJ_TAC THENL + [SUBGOAL_THEN `(\t:real. simple_char_fn_re (p:A prob_space) (Y:A->real) (t / D)) = + (\t. simple_char_fn_re p Y t) o (\t. t * inv D)` SUBST1_TAC THENL + [REWRITE_TAC[o_DEF; real_div]; ALL_TAC] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_ON_RMUL THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_ID]; + MATCH_MP_TAC REAL_CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `(:real)` THEN CONJ_TAC THENL + [MATCH_MP_TAC SIMPLE_CHAR_FN_RE_CONTINUOUS THEN ASM_REWRITE_TAC[]; + SET_TAC[]]]; + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_ON_NEG THEN REWRITE_TAC[real_div] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_RMUL THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_POW THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_ID]; + MATCH_MP_TAC REAL_CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `(:real)` THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_EXP] THEN SET_TAC[]]]; + SUBGOAL_THEN `(\t:real. simple_char_fn_im (p:A prob_space) (Y:A->real) (t / D)) = + (\t. simple_char_fn_im p Y t) o (\t. t * inv D)` SUBST1_TAC THENL + [REWRITE_TAC[o_DEF; real_div]; ALL_TAC] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_ON_RMUL THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_ID]; + MATCH_MP_TAC REAL_CONTINUOUS_ON_SUBSET THEN + EXISTS_TAC `(:real)` THEN CONJ_TAC THENL + [MATCH_MP_TAC SIMPLE_CHAR_FN_IM_CONTINUOUS THEN ASM_REWRITE_TAC[]; + SET_TAC[]]]]; + SET_TAC[]]; + REWRITE_TAC[REAL_CLOSED_REAL_INTERVAL]]; + MATCH_MP_TAC CONTINUOUS_IMP_REAL_MEASURABLE_ON THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_ID]; + SUBGOAL_THEN `{x:real | x = &0} = {&0}` SUBST1_TAC THENL + [SET_TAC[]; REWRITE_TAC[REAL_NEGLIGIBLE_SING]]]);; + +(* The integrand (|Delta_re(t)| + |Delta_im(t)|)/t has a removable *) +(* singularity at t=0: the numerator is O(t) near 0 by Taylor expansion *) +(* of cos and sin, so the ratio is bounded. Combined with measurability *) +(* from SMOOTHING_INTEGRAND_MEASURABLE, this gives integrability. *) +(* Proof: measurable (from SMOOTHING_INTEGRAND_MEASURABLE with D=1) and *) +(* bounded a.e. by TT*(M^2+1)/2 + M where |Y(x)| <= M on carrier. *) +let SMOOTHING_INTEGRAND_INTEGRABLE = prove + (`!p:A prob_space Y TT. + simple_rv p Y /\ &0 < TT + ==> (\t. (abs(simple_char_fn_re p Y t - exp(--(t pow 2 / &2))) + + abs(simple_char_fn_im p Y t)) / t) + real_integrable_on real_interval[&0, TT]`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `?M:real. !x:A. x IN prob_carrier p ==> abs((Y:A->real) x) <= M` + STRIP_ASSUME_TAC THENL + [MP_TAC(SPECL [`p:A prob_space`; `\x:A. abs((Y:A->real) x)`] + SIMPLE_RV_BOUNDED) THEN + ASM_SIMP_TAC[SIMPLE_RV_ABS] THEN MESON_TAC[REAL_ABS_ABS]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_MEASURABLE_BOUNDED_AE_BY_INTEGRABLE_IMP_INTEGRABLE THEN + EXISTS_TAC `(\t:real. TT * (M pow 2 + &1) / &2 + M):real->real` THEN + EXISTS_TAC `{&0:real}` THEN + REPEAT CONJ_TAC THENL + [(* Measurability from SMOOTHING_INTEGRAND_MEASURABLE with D=1 *) + MP_TAC(ISPECL [`p:A prob_space`; `Y:A->real`; `&1`; `&0`; `TT:real`] + SMOOTHING_INTEGRAND_MEASURABLE) THEN + ASM_REWRITE_TAC[REAL_LT_01; REAL_DIV_1]; + (* Constant function integrability *) + REWRITE_TAC[REAL_INTEGRABLE_CONST]; + (* Negligible singleton *) + REWRITE_TAC[REAL_NEGLIGIBLE_SING]; + (* Main bound: for t in (0,TT], integrand <= TT*(M^2+1)/2 + M *) + X_GEN_TAC `t:real` THEN REWRITE_TAC[IN_DIFF; IN_SING; IN_REAL_INTERVAL] THEN + BETA_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `&0 < t` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + (* Simplify abs of non-negative quotient *) + SUBGOAL_THEN `abs((abs (simple_char_fn_re (p:A prob_space) (Y:A->real) t - + exp (--(t pow 2 / &2))) + + abs (simple_char_fn_im p Y t)) / t) = + (abs (simple_char_fn_re p Y t - exp (--(t pow 2 / &2))) + + abs (simple_char_fn_im p Y t)) / t` SUBST1_TAC THENL + [REWRITE_TAC[REAL_ABS_REFL] THEN MATCH_MP_TAC REAL_LE_DIV THEN + CONJ_TAC THENL + [MATCH_MP_TAC(REAL_ARITH `&0 <= a /\ &0 <= b ==> &0 <= a + b`) THEN + REWRITE_TAC[REAL_ABS_POS]; ASM_REAL_ARITH_TAC]; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ] THEN + (* Upper bound: char_re <= 1 *) + SUBGOAL_THEN `simple_char_fn_re (p:A prob_space) (Y:A->real) t <= &1` + ASSUME_TAC THENL + [REWRITE_TAC[simple_char_fn_re] THEN + SUBGOAL_THEN `&1 = simple_expectation (p:A prob_space) (\x:A. &1)` + SUBST1_TAC THENL + [REWRITE_TAC[SIMPLE_EXPECTATION_CONST]; ALL_TAC] THEN + MATCH_MP_TAC SIMPLE_EXPECTATION_MONO THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC SIMPLE_RV_REAL_COMPOSE THEN + MATCH_MP_TAC SIMPLE_RV_REAL_COMPOSE THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[SIMPLE_RV_CONST]; + GEN_TAC THEN DISCH_TAC THEN + MP_TAC(SPEC `t * (Y:A->real) x` COS_BOUNDS) THEN REAL_ARITH_TAC]; + ALL_TAC] THEN + (* Lower bound: char_re >= 1 - t^2*M^2/2 *) + SUBGOAL_THEN `&1 - t pow 2 * M pow 2 / &2 <= + simple_char_fn_re (p:A prob_space) (Y:A->real) t` ASSUME_TAC THENL + [REWRITE_TAC[simple_char_fn_re] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `simple_expectation (p:A prob_space) + (\x:A. &1 - (t * (Y:A->real) x) pow 2 / &2)` THEN + CONJ_TAC THENL + [(* constant <= E[1 - (tY)^2/2]: since (tY)^2 <= (tM)^2 *) + SUBGOAL_THEN `&1 - t pow 2 * M pow 2 / &2 = + simple_expectation (p:A prob_space) + (\x:A. &1 - t pow 2 * M pow 2 / &2)` SUBST1_TAC THENL + [REWRITE_TAC[SIMPLE_EXPECTATION_CONST]; ALL_TAC] THEN + MATCH_MP_TAC SIMPLE_EXPECTATION_MONO THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[SIMPLE_RV_CONST]; + SUBGOAL_THEN `(\x:A. &1 - (t * (Y:A->real) x) pow 2 / &2) = + (\x. (\y:real. &1 - (t * y) pow 2 / &2) (Y x))` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN BETA_TAC THEN REFL_TAC; + MATCH_MP_TAC SIMPLE_RV_REAL_COMPOSE THEN ASM_REWRITE_TAC[]]; + BETA_TAC THEN GEN_TAC THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:A`) THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN + SUBGOAL_THEN `(t * (Y:A->real) x) pow 2 <= t pow 2 * M pow 2` MP_TAC THENL + [REWRITE_TAC[REAL_POW_MUL] THEN MATCH_MP_TAC REAL_LE_LMUL THEN + REWRITE_TAC[REAL_LE_POW_2] THEN + ONCE_REWRITE_TAC[GSYM REAL_POW2_ABS] THEN + MATCH_MP_TAC REAL_POW_LE2 THEN ASM_REWRITE_TAC[REAL_ABS_POS] THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[real_div] THEN REAL_ARITH_TAC]]; + (* E[1 - (tY)^2/2] <= E[cos(tY)]: from cos(u) >= 1 - u^2/2 *) + MATCH_MP_TAC SIMPLE_EXPECTATION_MONO THEN REPEAT CONJ_TAC THENL + [SUBGOAL_THEN `(\x:A. &1 - (t * (Y:A->real) x) pow 2 / &2) = + (\x. (\y:real. &1 - (t * y) pow 2 / &2) (Y x))` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN BETA_TAC THEN REFL_TAC; + MATCH_MP_TAC SIMPLE_RV_REAL_COMPOSE THEN ASM_REWRITE_TAC[]]; + MATCH_MP_TAC SIMPLE_RV_REAL_COMPOSE THEN + MATCH_MP_TAC SIMPLE_RV_REAL_COMPOSE THEN ASM_REWRITE_TAC[]; + GEN_TAC THEN DISCH_TAC THEN + MP_TAC(SPEC `t * (Y:A->real) x` ONE_MINUS_COS_LE) THEN + REWRITE_TAC[real_div] THEN REAL_ARITH_TAC]]; + ALL_TAC] THEN + (* Bound on char_im: |E[sin(tY)]| <= tM *) + SUBGOAL_THEN `abs(simple_char_fn_im (p:A prob_space) (Y:A->real) t) + <= t * M` ASSUME_TAC THENL + [REWRITE_TAC[simple_char_fn_im] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `simple_expectation (p:A prob_space) + (\x:A. abs(sin(t * (Y:A->real) x)))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SIMPLE_EXPECTATION_ABS_LE THEN + MATCH_MP_TAC SIMPLE_RV_REAL_COMPOSE THEN + MATCH_MP_TAC SIMPLE_RV_REAL_COMPOSE THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `simple_expectation (p:A prob_space) (\x:A. t * M)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SIMPLE_EXPECTATION_MONO THEN REPEAT CONJ_TAC THENL + [SUBGOAL_THEN `(\x:A. abs(sin(t * (Y:A->real) x))) = + (\x. (\y:real. abs(sin(t * y))) (Y x))` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN BETA_TAC THEN REFL_TAC; + MATCH_MP_TAC SIMPLE_RV_REAL_COMPOSE THEN ASM_REWRITE_TAC[]]; + REWRITE_TAC[SIMPLE_RV_CONST]; + GEN_TAC THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:A`) THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN + MP_TAC(SPEC `t * (Y:A->real) x` REAL_ABS_SIN_BOUND_LE) THEN + REWRITE_TAC[REAL_ABS_MUL] THEN + SUBGOAL_THEN `abs t = t` SUBST1_TAC THENL + [REWRITE_TAC[REAL_ABS_REFL] THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC(REAL_ARITH `a <= b ==> c <= a ==> c <= b`) THEN + MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REAL_ARITH_TAC]]; + REWRITE_TAC[SIMPLE_EXPECTATION_CONST] THEN REAL_ARITH_TAC]]; + ALL_TAC] THEN + (* Bounds on exp(-t^2/2) *) + SUBGOAL_THEN `exp(--(t pow 2 / &2)) <= &1` ASSUME_TAC THENL + [GEN_REWRITE_TAC RAND_CONV [GSYM REAL_EXP_0] THEN + REWRITE_TAC[REAL_EXP_MONO_LE] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> --x <= &0`) THEN + MATCH_MP_TAC REAL_LE_DIV THEN REWRITE_TAC[REAL_LE_POW_2] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `&1 - t pow 2 / &2 <= exp(--(t pow 2 / &2))` + ASSUME_TAC THENL + [MP_TAC(SPEC `t pow 2 / &2` ONE_MINUS_EXP_NEG_LE) THEN + SUBGOAL_THEN `&0 <= t pow 2 / &2` MP_TAC THENL + [MATCH_MP_TAC REAL_LE_DIV THEN REWRITE_TAC[REAL_LE_POW_2] THEN + REAL_ARITH_TAC; REAL_ARITH_TAC]; + ALL_TAC] THEN + (* Combine: |char_re - exp| <= t^2*M^2/2 + t^2/2 *) + SUBGOAL_THEN `abs(simple_char_fn_re (p:A prob_space) (Y:A->real) t - + exp(--(t pow 2 / &2))) <= t pow 2 * M pow 2 / &2 + t pow 2 / &2` + ASSUME_TAC THENL + [MP_TAC(ASSUME `&1 - t pow 2 * M pow 2 / &2 <= + simple_char_fn_re (p:A prob_space) (Y:A->real) t`) THEN + MP_TAC(ASSUME `simple_char_fn_re (p:A prob_space) (Y:A->real) t <= &1`) THEN + MP_TAC(ASSUME `&1 - t pow 2 / &2 <= exp(--(t pow 2 / &2))`) THEN + MP_TAC(ASSUME `exp(--(t pow 2 / &2)) <= &1`) THEN + REWRITE_TAC[real_div] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + (* Final assembly: sum bound + algebraic step *) + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(t pow 2 * M pow 2 / &2 + t pow 2 / &2) + t * M` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_ADD2 THEN ASM_REWRITE_TAC[]; + SUBGOAL_THEN `t pow 2 * M pow 2 / &2 + t pow 2 / &2 = + t pow 2 * (M pow 2 + &1) / &2` SUBST1_TAC THENL + [REWRITE_TAC[real_div] THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `t pow 2 * (M pow 2 + &1) / &2 + t * M = + t * (t * (M pow 2 + &1) / &2 + M)` SUBST1_TAC THENL + [REWRITE_TAC[REAL_POW_2; real_div] THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `(TT * (M pow 2 + &1) / &2 + M) * t = + t * (TT * (M pow 2 + &1) / &2 + M)` SUBST1_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_RMUL THEN CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LE_DIV THEN CONJ_TAC THENL + [MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> &0 <= x + &1`) THEN + REWRITE_TAC[REAL_LE_POW_2]; REAL_ARITH_TAC]]; + REAL_ARITH_TAC]]]]);; + +(* Helper lemmas for the smoothing inequality *) +let COS_LIPSCHITZ = prove + (`!a b. abs(cos a - cos b) <= abs(a - b)`, + REPEAT GEN_TAC THEN + MP_TAC(ISPECL [`(a + b) / &2`; `(a - b) / &2`] COS_ADD) THEN + MP_TAC(ISPECL [`(a + b) / &2`; `(a - b) / &2`] COS_SUB) THEN + SUBGOAL_THEN `(a + b) / &2 + (a - b) / &2 = a /\ + (a + b) / &2 - (a - b) / &2 = b` + (fun th -> REWRITE_TAC[th]) THENL + [CONV_TAC REAL_FIELD; ALL_TAC] THEN + REPEAT DISCH_TAC THEN + SUBGOAL_THEN `cos a - cos b = -- &2 * sin((a + b) / &2) * sin((a - b) / &2)` + SUBST1_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NEG; REAL_ABS_NUM] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&2 * &1 * abs((a - b) / &2)` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LE_MUL2 THEN + REWRITE_TAC[REAL_ABS_POS] THEN + CONJ_TAC THENL [REWRITE_TAC[SIN_BOUND]; REWRITE_TAC[REAL_ABS_SIN_BOUND_LE]]]; + REWRITE_TAC[REAL_ABS_DIV; REAL_ABS_NUM] THEN REAL_ARITH_TAC]);; + +let SIN_LIPSCHITZ = prove + (`!a b. abs(sin a - sin b) <= abs(a - b)`, + REPEAT GEN_TAC THEN + MP_TAC(ISPECL [`(a + b) / &2`; `(a - b) / &2`] SIN_ADD) THEN + MP_TAC(ISPECL [`(a + b) / &2`; `(a - b) / &2`] SIN_SUB) THEN + SUBGOAL_THEN `(a + b) / &2 + (a - b) / &2 = a /\ + (a + b) / &2 - (a - b) / &2 = b` + (fun th -> REWRITE_TAC[th]) THENL + [CONV_TAC REAL_FIELD; ALL_TAC] THEN + REPEAT DISCH_TAC THEN + SUBGOAL_THEN `sin a - sin b = &2 * cos((a + b) / &2) * sin((a - b) / &2)` + SUBST1_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NUM] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&2 * &1 * abs((a - b) / &2)` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LE_MUL2 THEN + REWRITE_TAC[REAL_ABS_POS; COS_BOUND; REAL_ABS_SIN_BOUND_LE]]; + REWRITE_TAC[REAL_ABS_DIV; REAL_ABS_NUM] THEN REAL_ARITH_TAC]);; diff --git a/Probability/clt.ml b/Probability/clt.ml index c48026e5..7a7cfa0f 100644 --- a/Probability/clt.ml +++ b/Probability/clt.ml @@ -210,6 +210,70 @@ let IN_PROB_IMP_IN_DIST = prove UNDISCH_TAC `(pn:real) < e / &2` THEN REAL_ARITH_TAC);; +(* Almost sure convergence implies convergence in probability + (clean version with random_variable hypotheses only) *) +let AS_IMP_IN_PROB = prove + (`!p:A prob_space (X:num->A->real) (L:A->real). + (!n. random_variable p (X n)) /\ + random_variable p L /\ + converges_as p X L + ==> converges_in_prob p X L`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC ALMOST_SURE_IMP_IN_PROB THEN + REPEAT CONJ_TAC THENL + [REPEAT STRIP_TAC THEN MATCH_MP_TAC RV_PREIMAGE_GE THEN + MATCH_MP_TAC RANDOM_VARIABLE_ABS THEN + MATCH_MP_TAC RANDOM_VARIABLE_SUB THEN + ASM_REWRITE_TAC[ETA_AX]; + MATCH_MP_TAC CONVERGENCE_SET_IN_EVENTS THEN + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]]);; + +(* L2 convergence implies convergence in distribution *) +let L2_IMP_IN_DIST = prove + (`!p:A prob_space (X:num->A->real) (L:A->real). + (!n. random_variable p (X n)) /\ + random_variable p L /\ + (!n. integrable p (\x. (X n x - L x) pow 2)) /\ + converges_L2 p X L + ==> converges_in_distribution p X (cdf p L)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[converges_in_distribution] THEN + X_GEN_TAC `x:real` THEN DISCH_TAC THEN + SUBGOAL_THEN + `converges_in_prob (p:A prob_space) (X:num->A->real) (L:A->real)` + ASSUME_TAC THENL + [MATCH_MP_TAC CONVERGES_L2_IMP_IN_PROB THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MP_TAC(ISPECL [`p:A prob_space`; `X:num->A->real`; `L:A->real`] + IN_PROB_IMP_IN_DIST) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `x:real`) THEN + REWRITE_TAC[ETA_AX] THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[]);; + +(* Almost sure convergence implies convergence in distribution *) +let AS_IMP_IN_DIST = prove + (`!p:A prob_space (X:num->A->real) (L:A->real). + (!n. random_variable p (X n)) /\ + random_variable p L /\ + converges_as p X L + ==> converges_in_distribution p X (cdf p L)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[converges_in_distribution] THEN + X_GEN_TAC `x:real` THEN DISCH_TAC THEN + SUBGOAL_THEN + `converges_in_prob (p:A prob_space) (X:num->A->real) (L:A->real)` + ASSUME_TAC THENL + [MATCH_MP_TAC AS_IMP_IN_PROB THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MP_TAC(ISPECL [`p:A prob_space`; `X:num->A->real`; `L:A->real`] + IN_PROB_IMP_IN_DIST) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `x:real`) THEN + REWRITE_TAC[ETA_AX] THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[]);; + (* ========================================================================= *) (* Phase 19: Characteristic function bounds for integrable RVs *) (* ========================================================================= *) @@ -385,7 +449,7 @@ let VARIANCE_MEAN_ZERO = prove (* ========================================================================= *) (* For independent RVs, the CDF factorization extends to strict inequalities. - Uses PROB_CONTINUITY_FROM_BELOW and REALLIM_UNIQUE. *) + Uses PROB_STRICT_INEQ_LIMIT and REALLIM_UNIQUE. *) let INDEP_RV_STRICT_INEQ = prove (`!p:A prob_space (X:A->real) (Y:A->real) a b. indep_rv p X Y @@ -393,195 +457,66 @@ let INDEP_RV_STRICT_INEQ = prove prob p {x | x IN prob_carrier p /\ X x < a} * prob p {x | x IN prob_carrier p /\ Y x < b}`, REPEAT GEN_TAC THEN REWRITE_TAC[indep_rv] THEN STRIP_TAC THEN - (* Union characterization for X *) - SUBGOAL_THEN - `!c:real. UNIONS {(\n:num. {x:A | x IN prob_carrier p /\ - (X:A->real) x <= c - &1 / &(SUC n)}) n | n IN (:num)} = - {x | x IN prob_carrier p /\ X x < c}` ASSUME_TAC THENL - [X_GEN_TAC `c:real` THEN - REWRITE_TAC[SIMPLE_IMAGE; UNIONS_IMAGE; IN_UNIV] THEN BETA_TAC THEN - REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `z:A` THEN - EQ_TAC THENL - [DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THEN - ASM_REWRITE_TAC[] THEN - SUBGOAL_THEN `&0 < &1 / &(SUC n)` MP_TAC THENL - [SIMP_TAC[REAL_LT_DIV; REAL_LT_01; REAL_OF_NUM_LT; LT_0]; - ASM_REAL_ARITH_TAC]; - STRIP_TAC THEN - SUBGOAL_THEN `?m:num. ~(m = 0) /\ &0 < inv(&m) /\ - inv(&m) < c - (X:A->real) z` MP_TAC THENL - [REWRITE_TAC[GSYM REAL_ARCH_INV] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN - DISCH_THEN(X_CHOOSE_THEN `m:num` STRIP_ASSUME_TAC) THEN - EXISTS_TAC `m:num` THEN ASM_REWRITE_TAC[] THEN - SUBGOAL_THEN `&1 / &(SUC m) <= inv(&m:real)` ASSUME_TAC THENL - [REWRITE_TAC[real_div; REAL_MUL_LID] THEN - MATCH_MP_TAC REAL_LE_INV2 THEN CONJ_TAC THENL - [REWRITE_TAC[REAL_OF_NUM_LT] THEN ASM_ARITH_TAC; - REWRITE_TAC[REAL_OF_NUM_LE] THEN ARITH_TAC]; - ASM_REAL_ARITH_TAC]]; - ALL_TAC] THEN - (* X marginal convergence *) - SUBGOAL_THEN - `((\n. prob p {x:A | x IN prob_carrier p /\ - (X:A->real) x <= a - &1 / &(SUC n)}) ---> - prob p {x | x IN prob_carrier p /\ X x < a}) sequentially` - ASSUME_TAC THENL - [MP_TAC(ISPECL [`p:A prob_space`; - `\n:num. {x:A | x IN prob_carrier p /\ - (X:A->real) x <= a - &1 / &(SUC n)}`] - PROB_CONTINUITY_FROM_BELOW) THEN - BETA_TAC THEN - ANTS_TAC THENL - [CONJ_TAC THENL - [GEN_TAC THEN ASM_MESON_TAC[random_variable]; - GEN_TAC THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `z:A` THEN - STRIP_TAC THEN ASM_REWRITE_TAC[] THEN - MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `a - &1 / &(SUC n)` THEN - ASM_REWRITE_TAC[REAL_LE_SUB_LADD; - REAL_ARITH `a - x + y <= a <=> y <= x`] THEN - REWRITE_TAC[real_div; REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LE_INV2 THEN - REWRITE_TAC[REAL_OF_NUM_LT; REAL_OF_NUM_LE] THEN ARITH_TAC]; - FIRST_X_ASSUM(MP_TAC o SPEC `a:real`) THEN - DISCH_THEN(SUBST1_TAC o SYM) THEN - REWRITE_TAC[SIMPLE_IMAGE] THEN DISCH_THEN ACCEPT_TAC]; - ALL_TAC] THEN - (* Y union characterization *) - SUBGOAL_THEN - `!c:real. UNIONS {(\n:num. {x:A | x IN prob_carrier p /\ - (Y:A->real) x <= c - &1 / &(SUC n)}) n | n IN (:num)} = - {x | x IN prob_carrier p /\ Y x < c}` ASSUME_TAC THENL - [X_GEN_TAC `c:real` THEN - REWRITE_TAC[SIMPLE_IMAGE; UNIONS_IMAGE; IN_UNIV] THEN BETA_TAC THEN - REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `z:A` THEN - EQ_TAC THENL - [DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THEN - ASM_REWRITE_TAC[] THEN - SUBGOAL_THEN `&0 < &1 / &(SUC n)` MP_TAC THENL - [SIMP_TAC[REAL_LT_DIV; REAL_LT_01; REAL_OF_NUM_LT; LT_0]; - ASM_REAL_ARITH_TAC]; - STRIP_TAC THEN - SUBGOAL_THEN `?m:num. ~(m = 0) /\ &0 < inv(&m) /\ - inv(&m) < c - (Y:A->real) z` MP_TAC THENL - [REWRITE_TAC[GSYM REAL_ARCH_INV] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN - DISCH_THEN(X_CHOOSE_THEN `m:num` STRIP_ASSUME_TAC) THEN - EXISTS_TAC `m:num` THEN ASM_REWRITE_TAC[] THEN - SUBGOAL_THEN `&1 / &(SUC m) <= inv(&m:real)` ASSUME_TAC THENL - [REWRITE_TAC[real_div; REAL_MUL_LID] THEN - MATCH_MP_TAC REAL_LE_INV2 THEN CONJ_TAC THENL - [REWRITE_TAC[REAL_OF_NUM_LT] THEN ASM_ARITH_TAC; - REWRITE_TAC[REAL_OF_NUM_LE] THEN ARITH_TAC]; - ASM_REAL_ARITH_TAC]]; - ALL_TAC] THEN - (* Y marginal convergence *) - SUBGOAL_THEN - `((\n. prob p {x:A | x IN prob_carrier p /\ - (Y:A->real) x <= b - &1 / &(SUC n)}) ---> - prob p {x | x IN prob_carrier p /\ Y x < b}) sequentially` - ASSUME_TAC THENL - [MP_TAC(ISPECL [`p:A prob_space`; - `\n:num. {x:A | x IN prob_carrier p /\ - (Y:A->real) x <= b - &1 / &(SUC n)}`] - PROB_CONTINUITY_FROM_BELOW) THEN - BETA_TAC THEN - ANTS_TAC THENL - [CONJ_TAC THENL - [GEN_TAC THEN ASM_MESON_TAC[random_variable]; - GEN_TAC THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `z:A` THEN - STRIP_TAC THEN ASM_REWRITE_TAC[] THEN - MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `b - &1 / &(SUC n)` THEN - ASM_REWRITE_TAC[REAL_LE_SUB_LADD; - REAL_ARITH `a - x + y <= a <=> y <= x`] THEN - REWRITE_TAC[real_div; REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LE_INV2 THEN - REWRITE_TAC[REAL_OF_NUM_LT; REAL_OF_NUM_LE] THEN ARITH_TAC]; - FIRST_X_ASSUM(MP_TAC o SPEC `b:real`) THEN - DISCH_THEN(SUBST1_TAC o SYM) THEN - REWRITE_TAC[SIMPLE_IMAGE] THEN DISCH_THEN ACCEPT_TAC]; - ALL_TAC] THEN - (* Joint union characterization *) - SUBGOAL_THEN - `UNIONS {(\n:num. {x:A | x IN prob_carrier p /\ - (X:A->real) x <= a - &1 / &(SUC n) /\ - (Y:A->real) x <= b - &1 / &(SUC n)}) n | n IN (:num)} = - {x | x IN prob_carrier p /\ X x < a /\ Y x < b}` ASSUME_TAC THENL - [REWRITE_TAC[SIMPLE_IMAGE; UNIONS_IMAGE; IN_UNIV] THEN BETA_TAC THEN - REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `z:A` THEN - EQ_TAC THENL - [DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THEN - ASM_REWRITE_TAC[] THEN CONJ_TAC THEN - SUBGOAL_THEN `&0 < &1 / &(SUC n)` MP_TAC THENL - [SIMP_TAC[REAL_LT_DIV; REAL_LT_01; REAL_OF_NUM_LT; LT_0]; - ASM_REAL_ARITH_TAC; - SIMP_TAC[REAL_LT_DIV; REAL_LT_01; REAL_OF_NUM_LT; LT_0]; - ASM_REAL_ARITH_TAC]; - STRIP_TAC THEN - SUBGOAL_THEN `?m1:num. ~(m1 = 0) /\ &0 < inv(&m1) /\ - inv(&m1) < a - (X:A->real) z` MP_TAC THENL - [REWRITE_TAC[GSYM REAL_ARCH_INV] THEN ASM_REAL_ARITH_TAC; - ALL_TAC] THEN - DISCH_THEN(X_CHOOSE_THEN `m1:num` STRIP_ASSUME_TAC) THEN - SUBGOAL_THEN `?m2:num. ~(m2 = 0) /\ &0 < inv(&m2) /\ - inv(&m2) < b - (Y:A->real) z` MP_TAC THENL - [REWRITE_TAC[GSYM REAL_ARCH_INV] THEN ASM_REAL_ARITH_TAC; - ALL_TAC] THEN - DISCH_THEN(X_CHOOSE_THEN `m2:num` STRIP_ASSUME_TAC) THEN - EXISTS_TAC `m1 + m2:num` THEN ASM_REWRITE_TAC[] THEN - SUBGOAL_THEN `&1 / &(SUC (m1 + m2)) <= inv(&m1:real) /\ - &1 / &(SUC (m1 + m2)) <= inv(&m2:real)` STRIP_ASSUME_TAC THENL - [REWRITE_TAC[real_div; REAL_MUL_LID] THEN CONJ_TAC THEN - MATCH_MP_TAC REAL_LE_INV2 THEN - REWRITE_TAC[REAL_OF_NUM_LT; REAL_OF_NUM_LE] THEN ASM_ARITH_TAC; - ASM_REAL_ARITH_TAC]]; - ALL_TAC] THEN - (* Joint sets are in prob_events *) - SUBGOAL_THEN - `!c d. {x:A | x IN prob_carrier p /\ (X:A->real) x <= c /\ - (Y:A->real) x <= d} IN prob_events p` ASSUME_TAC THENL - [REPEAT GEN_TAC THEN - SUBGOAL_THEN `{x:A | x IN prob_carrier p /\ (X:A->real) x <= c /\ - (Y:A->real) x <= d} = - {x | x IN prob_carrier p /\ X x <= c} INTER - {x | x IN prob_carrier p /\ Y x <= d}` SUBST1_TAC THENL - [REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM] THEN MESON_TAC[]; - MATCH_MP_TAC PROB_INTER_IN_EVENTS THEN - ASM_MESON_TAC[random_variable]]; - ALL_TAC] THEN - (* Joint convergence via PROB_CONTINUITY_FROM_BELOW *) - MP_TAC(ISPECL [`p:A prob_space`; - `\n:num. {x:A | x IN prob_carrier p /\ (X:A->real) x <= a - &1 / &(SUC n) /\ - (Y:A->real) x <= b - &1 / &(SUC n)}`] - PROB_CONTINUITY_FROM_BELOW) THEN - BETA_TAC THEN - ANTS_TAC THENL - [CONJ_TAC THENL - [GEN_TAC THEN ASM_REWRITE_TAC[]; - GEN_TAC THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `z:A` THEN - STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN - MATCH_MP_TAC REAL_LE_TRANS THENL - [EXISTS_TAC `a - &1 / &(SUC n)`; EXISTS_TAC `b - &1 / &(SUC n)`] THEN - ASM_REWRITE_TAC[REAL_LE_SUB_LADD; - REAL_ARITH `a - x + y <= a <=> y <= x`] THEN - REWRITE_TAC[real_div; REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LE_INV2 THEN - REWRITE_TAC[REAL_OF_NUM_LT; REAL_OF_NUM_LE] THEN ARITH_TAC]; - ALL_TAC] THEN - (* Rewrite UNIONS to target set, use independence, then limits *) - SUBGOAL_THEN - `UNIONS {{x:A | x IN prob_carrier p /\ (X:A->real) x <= a - &1 / &(SUC n) /\ - (Y:A->real) x <= b - &1 / &(SUC n)} | n IN (:num)} = - UNIONS {(\n. {x | x IN prob_carrier p /\ X x <= a - &1 / &(SUC n) /\ - Y x <= b - &1 / &(SUC n)}) n | n IN (:num)}` - SUBST1_TAC THENL - [AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN - MESON_TAC[]; - ALL_TAC] THEN - ASM_REWRITE_TAC[] THEN DISCH_TAC THEN - (* Now have joint product convergence; use REALLIM_MUL + REALLIM_UNIQUE *) MATCH_MP_TAC(ISPEC `sequentially` REALLIM_UNIQUE) THEN EXISTS_TAC `\n:num. prob (p:A prob_space) {x:A | x IN prob_carrier p /\ (X:A->real) x <= a - &1 / &(SUC n)} * prob p {x | x IN prob_carrier p /\ (Y:A->real) x <= b - &1 / &(SUC n)}` THEN - REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN - ASM_REWRITE_TAC[] THEN - MATCH_MP_TAC REALLIM_MUL THEN ASM_REWRITE_TAC[]);; + REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN CONJ_TAC THENL + [SUBGOAL_THEN `(\n. prob (p:A prob_space) {x:A | x IN prob_carrier p /\ + (X:A->real) x <= a - &1 / &(SUC n)} * prob p {x | x IN prob_carrier p /\ + (Y:A->real) x <= b - &1 / &(SUC n)}) = (\n. prob p {x | x IN + prob_carrier p /\ X x <= a - &1 / &(SUC n) /\ Y x <= b - &1 / &(SUC n)})` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN CONV_TAC SYM_CONV THEN + ASM_REWRITE_TAC[]; + MP_TAC(ISPECL [`p:A prob_space`; + `\n:num. {x:A | x IN prob_carrier p /\ (X:A->real) x <= a - &1 / &(SUC n) + /\ (Y:A->real) x <= b - &1 / &(SUC n)}`] + PROB_CONTINUITY_FROM_BELOW) THEN + BETA_TAC THEN ANTS_TAC THENL + [CONJ_TAC THENL + [GEN_TAC THEN + SUBGOAL_THEN `{x:A | x IN prob_carrier p /\ (X:A->real) x <= + a - &1 / &(SUC n) /\ (Y:A->real) x <= b - &1 / &(SUC n)} = + {x | x IN prob_carrier p /\ X x <= a - &1 / &(SUC n)} INTER + {x | x IN prob_carrier p /\ Y x <= b - &1 / &(SUC n)}` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM] THEN MESON_TAC[]; + MATCH_MP_TAC PROB_INTER_IN_EVENTS THEN ASM_MESON_TAC[random_variable]]; + GEN_TAC THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN GEN_TAC THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THENL + [EXISTS_TAC `a - &1 / &(SUC n)`; EXISTS_TAC `b - &1 / &(SUC n)`] THEN + ASM_REWRITE_TAC[REAL_ARITH `a - x <= a - y <=> y <= x`] THEN + REWRITE_TAC[real_div; REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LE_INV2 THEN + REWRITE_TAC[REAL_OF_NUM_LT; REAL_OF_NUM_LE] THEN ARITH_TAC]; + SUBGOAL_THEN + `UNIONS {{x:A | x IN prob_carrier p /\ (X:A->real) x <= + a - &1 / &(SUC n) /\ (Y:A->real) x <= b - &1 / &(SUC n)} | + n IN (:num)} = + {x | x IN prob_carrier p /\ X x < a /\ Y x < b}` + (fun th -> REWRITE_TAC[th]) THEN + REWRITE_TAC[UNIONS_GSPEC; IN_UNIV; EXTENSION; IN_ELIM_THM] THEN + GEN_TAC THEN EQ_TAC THENL + [STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN + (SUBGOAL_THEN `&0 < &1 / &(SUC n)` MP_TAC THENL + [MATCH_MP_TAC REAL_LT_DIV THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN + ARITH_TAC; ASM_REAL_ARITH_TAC]); + STRIP_TAC THEN + MP_TAC(SPEC `a - (X:A->real) x` REAL_ARCH_INV) THEN + MP_TAC(SPEC `b - (Y:A->real) x` REAL_ARCH_INV) THEN + ASM_SIMP_TAC[REAL_SUB_LT] THEN + DISCH_THEN(X_CHOOSE_THEN `m2:num` STRIP_ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `m1:num` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `m1 + m2:num` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THENL + [EXISTS_TAC `a - inv(&m1)`; EXISTS_TAC `b - inv(&m2)`] THEN + (CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN + REWRITE_TAC[REAL_ARITH `a - x <= a - y <=> y <= x`; + real_div; REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + REWRITE_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN ASM_ARITH_TAC]]]; + MATCH_MP_TAC REALLIM_MUL THEN CONJ_TAC THEN + MATCH_MP_TAC PROB_STRICT_INEQ_LIMIT THEN ASM_REWRITE_TAC[]]);; (* ========================================================================= *) (* NSFA CDF and level set characterizations *) @@ -1270,34 +1205,8 @@ let EXPECTATION_PRODUCT_BOUNDED_INDEP = prove (* Generalization: E[XY] = E[X]*E[Y] for integrable independent RVs *) (* ========================================================================= *) -(* Simple random variables are bounded on the carrier *) -let SIMPLE_RV_ABS_BOUNDED = prove - (`!p:A prob_space f. simple_rv p f ==> - ?M. !x. x IN prob_carrier p ==> abs(f x) <= M`, - REPEAT GEN_TAC THEN REWRITE_TAC[simple_rv] THEN STRIP_TAC THEN - MP_TAC(ISPEC `p:A prob_space` PROB_CARRIER_NONEMPTY) THEN - REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN - DISCH_THEN(X_CHOOSE_THEN `z:A` STRIP_ASSUME_TAC) THEN - SUBGOAL_THEN `FINITE {abs((f:A->real) x) | x IN prob_carrier (p:A prob_space)}` - ASSUME_TAC THENL - [SUBGOAL_THEN `{abs((f:A->real) x) | x IN prob_carrier (p:A prob_space)} = - IMAGE abs {f x | x IN prob_carrier p}` SUBST1_TAC THENL - [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM] THEN MESON_TAC[]; - MATCH_MP_TAC FINITE_IMAGE THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN - SUBGOAL_THEN - `~({abs((f:A->real) x) | x IN prob_carrier (p:A prob_space)} = {})` - ASSUME_TAC THENL - [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN - EXISTS_TAC `abs((f:A->real) z)` THEN EXISTS_TAC `z:A` THEN - ASM_REWRITE_TAC[]; ALL_TAC] THEN - MP_TAC(ISPEC - `{abs((f:A->real) x) | x IN prob_carrier (p:A prob_space)}` SUP_FINITE) THEN - ASM_REWRITE_TAC[] THEN STRIP_TAC THEN - EXISTS_TAC - `sup {abs((f:A->real) x) | x IN prob_carrier (p:A prob_space)}` THEN - X_GEN_TAC `w:A` THEN DISCH_TAC THEN - FIRST_X_ASSUM MATCH_MP_TAC THEN - REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `w:A` THEN ASM_REWRITE_TAC[]);; +(* SIMPLE_RV_ABS_BOUNDED relocated to martingale_convergence.ml (used by the *) +(* simple-multiplier take-out); available here via the earlier load. *) (* Truncation of expectation converges *) let EXPECTATION_TRUNCATION_LIMIT = prove @@ -4615,11 +4524,11 @@ let INDEP_RV_NEG = prove (* Events membership for strict inequality sets *) SUBGOAL_THEN `{x:A | x IN prob_carrier p /\ X x < --a} IN prob_events p` ASSUME_TAC THENL - [MATCH_MP_TAC RANDOM_VARIABLE_OPEN_HALFLINE THEN ASM_REWRITE_TAC[]; + [MATCH_MP_TAC RV_PREIMAGE_LT THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `{x:A | x IN prob_carrier p /\ Y x < --b} IN prob_events p` ASSUME_TAC THENL - [MATCH_MP_TAC RANDOM_VARIABLE_OPEN_HALFLINE THEN ASM_REWRITE_TAC[]; + [MATCH_MP_TAC RV_PREIMAGE_LT THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN (* Use PROB_COMPL and PROB_UNION *) SUBGOAL_THEN `prob (p:A prob_space) (prob_carrier p DIFF @@ -5050,6 +4959,25 @@ let KOLMOGOROV_SLLN = prove [REAL_ARITH_TAC; MATCH_MP_TAC REALLIM_SUB THEN ASM_REWRITE_TAC[]]);; +(* KOLMOGOROV_SLLN without explicit mu_plus parameter *) +let KOLMOGOROV_SLLN' = prove + (`!p:A prob_space (X:num->A->real) mu. + (!n. integrable p (X n)) /\ + (!n. integrable p (\x. X n x pow 2)) /\ + (!n. expectation p (X n) = mu) /\ + (!n. expectation p (\x. max (X n x) (&0)) = + expectation p (\x. max (X 0 x) (&0))) /\ + (!i j. ~(i = j) ==> indep_rv p (X i) (X j)) /\ + real_summable (from 0) (\n. variance p (X n) / &(SUC n) pow 2) + ==> almost_surely p + {x | ((\n. inv(&(SUC n)) * sum(0..n) (\i. X i x)) ---> mu) + sequentially}`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `X:num->A->real`; `mu:real`; + `expectation (p:A prob_space) (\x. max ((X:num->A->real) 0 x) (&0))`] + KOLMOGOROV_SLLN) THEN + ASM_MESON_TAC[]);; + (* ===================================================================== *) (* IID STRONG LAW OF LARGE NUMBERS (finite first moment only) *) (* ===================================================================== *) @@ -5716,79 +5644,23 @@ let EQUIDIST_PROB_LT = prove ==> prob p {x | x IN prob_carrier p /\ X x < c} = prob p {x | x IN prob_carrier p /\ Y x < c}`, REPEAT STRIP_TAC THEN - SUBGOAL_THEN - `!f:A->real. random_variable p f ==> - ((\m. prob p {x:A | x IN prob_carrier p /\ f x <= c - inv(&(m + 1))}) - ---> prob p {x | x IN prob_carrier p /\ f x < c}) sequentially` - ASSUME_TAC THENL - [X_GEN_TAC `f:A->real` THEN DISCH_TAC THEN - MP_TAC(ISPECL [`p:A prob_space`; - `\m:num. {x:A | x IN prob_carrier p /\ f x <= c - inv(&(m + 1))}`] - PROB_CONTINUITY_FROM_BELOW) THEN - REWRITE_TAC[] THEN ANTS_TAC THENL - [CONJ_TAC THENL - [GEN_TAC THEN - FIRST_ASSUM(fun th -> - ACCEPT_TAC(SPEC `c - inv(&(n + 1))` - (REWRITE_RULE[random_variable] th))); - GEN_TAC THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN - GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN - MATCH_MP_TAC REAL_LE_TRANS THEN - EXISTS_TAC `c - inv(&(n + 1))` THEN ASM_REWRITE_TAC[] THEN - REWRITE_TAC[REAL_ARITH `c - x <= c - y <=> y <= x`] THEN - MATCH_MP_TAC REAL_LE_INV2 THEN - REWRITE_TAC[REAL_OF_NUM_LT; REAL_OF_NUM_LE] THEN ARITH_TAC]; - ALL_TAC] THEN - SUBGOAL_THEN - `UNIONS {{x:A | x IN prob_carrier p /\ f x <= c - inv(&(n + 1))} | - n IN (:num)} = - {x | x IN prob_carrier p /\ f x < c}` - (fun th -> REWRITE_TAC[th]) THEN - REWRITE_TAC[EXTENSION] THEN X_GEN_TAC `y:A` THEN - REWRITE_TAC[IN_UNIONS; IN_ELIM_THM; IN_UNIV] THEN - EQ_TAC THENL - [DISCH_THEN(X_CHOOSE_THEN `t:A->bool` - (CONJUNCTS_THEN2 (X_CHOOSE_TAC `n:num`) ASSUME_TAC)) THEN - FIRST_X_ASSUM SUBST_ALL_TAC THEN - FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_ELIM_THM]) THEN - STRIP_TAC THEN ASM_REWRITE_TAC[] THEN - MATCH_MP_TAC REAL_LET_TRANS THEN - EXISTS_TAC `c - inv(&(n + 1))` THEN ASM_REWRITE_TAC[] THEN - REWRITE_TAC[REAL_ARITH `c - x < c <=> &0 < x`] THEN - MATCH_MP_TAC REAL_LT_INV THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN - ARITH_TAC; - STRIP_TAC THEN - MP_TAC(GEN_REWRITE_RULE I [REAL_ARCH_INV] - (REAL_ARITH `(f:A->real) y < c ==> &0 < c - f y` - |> C MP (ASSUME `(f:A->real) y < c`))) THEN - DISCH_THEN(X_CHOOSE_THEN `m:num` STRIP_ASSUME_TAC) THEN - EXISTS_TAC `{y':A | y' IN prob_carrier p /\ - f y' <= c - inv(&((m - 1) + 1))}` THEN - CONJ_TAC THENL - [EXISTS_TAC `m - 1` THEN REWRITE_TAC[]; - REWRITE_TAC[IN_ELIM_THM] THEN ASM_REWRITE_TAC[] THEN - SUBGOAL_THEN `(m - 1) + 1 = m` SUBST1_TAC THENL - [ASM_ARITH_TAC; ASM_REAL_ARITH_TAC]]]; - ALL_TAC] THEN - MP_TAC(ISPECL - [`sequentially`; - `\m:num. prob (p:A prob_space) - {x:A | x IN prob_carrier p /\ X x <= c - inv(&(m + 1))}`; - `prob (p:A prob_space) {x:A | x IN prob_carrier p /\ X x < c}`; - `prob (p:A prob_space) {x:A | x IN prob_carrier p /\ Y x < c}`] + MP_TAC(ISPECL [`sequentially`; + `\n:num. prob (p:A prob_space) + {x:A | x IN prob_carrier p /\ (X:A->real) x <= c - &1 / &(SUC n)}`; + `prob (p:A prob_space) {x:A | x IN prob_carrier p /\ X x < c}`; + `prob (p:A prob_space) {x:A | x IN prob_carrier p /\ Y x < c}`] REALLIM_UNIQUE) THEN - DISCH_THEN MATCH_MP_TAC THEN REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN + REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL - [FIRST_X_ASSUM(MP_TAC o SPEC `X:A->real`) THEN ASM_REWRITE_TAC[]; + [MATCH_MP_TAC PROB_STRICT_INEQ_LIMIT THEN ASM_REWRITE_TAC[]; SUBGOAL_THEN - `(\m. prob p {x:A | x IN prob_carrier p /\ - X x <= c - inv (&(m + 1))}) = - (\m. prob p {x:A | x IN prob_carrier p /\ - Y x <= c - inv (&(m + 1))})` - SUBST1_TAC THENL + `(\n. prob (p:A prob_space) {x:A | x IN prob_carrier p /\ + (X:A->real) x <= c - &1 / &(SUC n)}) = + (\n. prob p {x | x IN prob_carrier p /\ + (Y:A->real) x <= c - &1 / &(SUC n)})` SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN ASM_REWRITE_TAC[GSYM distribution_fn]; - FIRST_X_ASSUM(MP_TAC o SPEC `Y:A->real`) THEN ASM_REWRITE_TAC[]]]);; + MATCH_MP_TAC PROB_STRICT_INEQ_LIMIT THEN ASM_REWRITE_TAC[]]]);; (* Equidist neg-max-zero: distribution_fn of max(-X, 0) *) let EQUIDIST_NEG_MAX_ZERO = prove @@ -6859,7 +6731,7 @@ let KOLMOGOROV_CONVERGENCE_CRITERION = prove MATCH_MP_TAC PROB_FINITE_UNION_IN_EVENTS THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN X_GEN_TAC `k:num` THEN DISCH_TAC THEN - MATCH_MP_TAC RANDOM_VARIABLE_GE THEN + MATCH_MP_TAC RV_PREIMAGE_GE THEN MATCH_MP_TAC RANDOM_VARIABLE_ABS THEN SUBGOAL_THEN `(\x:A. sum(a..a+k) (\i. (X:num->A->real) i x)) = (\x. sum(0..k) (\i. X (a + i) x))` SUBST1_TAC THENL @@ -7491,82 +7363,6 @@ let ALMOST_SURELY_NONEMPTY = prove ASM_REWRITE_TAC[PROB_SPACE; PROB_CARRIER_IN_EVENTS] THEN ASM_REAL_ARITH_TAC);; -(* Three-Series Necessity: Condition 1 - If independent events (abs X_n > c) and sum X_n converges a.s., - then sum P(abs X_n > c) < infinity. - Proof: Second Borel-Cantelli contrapositive. *) -let THREE_SERIES_CONDITION1 = prove - (`!p:A prob_space (X:num->A->real) c. - &0 < c /\ - (!n. integrable p (X n)) /\ - indep_events_seq p (\n. {x | x IN prob_carrier p /\ abs(X n x) > c}) /\ - almost_surely p {x | ?L. ((\n. sum(0..n) (\i. X i x)) ---> L) sequentially} - ==> real_summable (from 0) - (\n. prob p {x | x IN prob_carrier p /\ abs(X n x) > c})`, - REPEAT GEN_TAC THEN STRIP_TAC THEN - MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN - MP_TAC(ISPECL [`p:A prob_space`; - `\n. {x:A | x IN prob_carrier p /\ abs((X:num->A->real) n x) > c}`] - SECOND_BOREL_CANTELLI) THEN - ASM_REWRITE_TAC[] THEN DISCH_TAC THEN - MP_TAC(ISPECL [`p:A prob_space`; `X:num->A->real`; `c:real`] - CONVERGENT_SERIES_TERMS_VANISH) THEN - ASM_REWRITE_TAC[] THEN - REWRITE_TAC[almost_surely] THEN - DISCH_THEN(X_CHOOSE_THEN `NE:A->bool` STRIP_ASSUME_TAC) THEN - SUBGOAL_THEN `limsup_events - (\n. {x:A | x IN prob_carrier p /\ abs((X:num->A->real) n x) > c}) - SUBSET (NE:A->bool)` ASSUME_TAC THENL - [MATCH_MP_TAC SUBSET_TRANS THEN - EXISTS_TAC `{x:A | x IN prob_carrier p /\ - ~(x IN {x | ?N. !n:num. N <= n ==> abs((X:num->A->real) n x) <= c})}` THEN - ASM_REWRITE_TAC[] THEN - REWRITE_TAC[SUBSET; limsup_events; IN_INTERS; IN_ELIM_THM; IN_UNIV] THEN - X_GEN_TAC `y:A` THEN DISCH_TAC THEN CONJ_TAC THENL - [FIRST_X_ASSUM(MP_TAC o SPEC - `UNIONS {(\n. {x:A | x IN prob_carrier p /\ - abs((X:num->A->real) n x) > c}) n | n >= 0}`) THEN - ANTS_TAC THENL [EXISTS_TAC `0` THEN REWRITE_TAC[]; ALL_TAC] THEN - REWRITE_TAC[IN_UNIONS; IN_ELIM_THM] THEN - DISCH_THEN(X_CHOOSE_THEN `t:A->bool` MP_TAC) THEN - DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN - DISCH_THEN(X_CHOOSE_THEN `n:num` - (CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC)) THEN - FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_ELIM_THM]) THEN - SIMP_TAC[]; - REWRITE_TAC[NOT_EXISTS_THM; NOT_FORALL_THM; NOT_IMP] THEN - X_GEN_TAC `N:num` THEN - FIRST_X_ASSUM(MP_TAC o SPEC - `UNIONS {(\n. {x:A | x IN prob_carrier p /\ - abs((X:num->A->real) n x) > c}) n | n >= N}`) THEN - ANTS_TAC THENL [EXISTS_TAC `N:num` THEN REWRITE_TAC[]; ALL_TAC] THEN - REWRITE_TAC[IN_UNIONS; IN_ELIM_THM] THEN - DISCH_THEN(X_CHOOSE_THEN `t:A->bool` MP_TAC) THEN - DISCH_THEN(CONJUNCTS_THEN2 MP_TAC ASSUME_TAC) THEN - DISCH_THEN(X_CHOOSE_THEN `m:num` - (CONJUNCTS_THEN2 ASSUME_TAC SUBST_ALL_TAC)) THEN - EXISTS_TAC `m:num` THEN - FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_ELIM_THM]) THEN - REWRITE_TAC[real_gt; REAL_NOT_LE; GE] THEN - STRIP_TAC THEN ASM_REWRITE_TAC[GSYM GE]]; - ALL_TAC] THEN - SUBGOAL_THEN `prob (p:A prob_space) (limsup_events - (\n. {x:A | x IN prob_carrier p /\ abs((X:num->A->real) n x) > c})) - <= prob p NE` MP_TAC THENL - [MATCH_MP_TAC PROB_MONO THEN ASM_REWRITE_TAC[] THEN - CONJ_TAC THENL - [MATCH_MP_TAC LIMSUP_EVENTS_IN_EVENTS THEN - GEN_TAC THEN CONV_TAC(ONCE_DEPTH_CONV BETA_CONV) THEN - MATCH_MP_TAC RV_LEVEL_GT_IN_EVENTS THEN - MATCH_MP_TAC RANDOM_VARIABLE_ABS THEN - MATCH_MP_TAC INTEGRABLE_IMP_RANDOM_VARIABLE THEN - CONV_TAC(ONCE_DEPTH_CONV ETA_CONV) THEN ASM_REWRITE_TAC[]; - FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [null_event]) THEN - SIMP_TAC[]]; - ALL_TAC] THEN - FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [null_event]) THEN - STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC);; - (* Reduction to bounded case: First BC gives Y_n = X_n eventually, then tail equivalence gives sum Y_n converges a.s. *) let THREE_SERIES_REDUCTION = prove @@ -8465,6 +8261,7 @@ let THREE_SERIES_CONDITION3 = prove REWRITE_TAC[REALLIM_CONST]]; ASM_MESON_TAC[]]);; + (* Three-Series Necessity: Condition (2) sum E[Y_n] converges. Uses Condition (3) + Kolmogorov convergence criterion. Proof: Apply KCC to Z_n = Y_n - E[Y_n] to get sum Z_n converges a.s. @@ -9294,33 +9091,6 @@ let AS_CONVERGENCE_TRUNCATED = prove (* A1: Weaken INTEGRABLE_CLT -- replace char_fn identity with same CDF *) (* ========================================================================= *) -(* Cosine is Lipschitz with constant 1 *) -let COS_LIPSCHITZ = prove - (`!a b. abs(cos a - cos b) <= abs(a - b)`, - REPEAT GEN_TAC THEN - SUBGOAL_THEN `!u v. cos(u + v) - cos(u - v) = -- &2 * sin u * sin v` - (fun th -> MP_TAC(SPECL [`(a + b) / &2`; `(a - b) / &2`] th)) THENL - [REPEAT GEN_TAC THEN REWRITE_TAC[COS_ADD; COS_SUB] THEN REAL_ARITH_TAC; - ALL_TAC] THEN - SUBGOAL_THEN `(a + b) / &2 + (a - b) / &2 = a /\ - (a + b) / &2 - (a - b) / &2 = b` - (fun th -> REWRITE_TAC[th]) THENL - [CONV_TAC REAL_FIELD; ALL_TAC] THEN - DISCH_THEN SUBST1_TAC THEN - REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NEG; REAL_ABS_NUM] THEN - MP_TAC(SPEC `(a + b) / &2` SIN_BOUND) THEN - MP_TAC(SPEC `(a - b) / &2` REAL_ABS_SIN_BOUND_LE) THEN - REWRITE_TAC[REAL_ABS_DIV; REAL_ABS_NUM] THEN - REPEAT STRIP_TAC THEN - MATCH_MP_TAC REAL_LE_TRANS THEN - EXISTS_TAC `&2 * &1 * (abs(a - b) / &2)` THEN - CONJ_TAC THENL - [MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL - [REAL_ARITH_TAC; ALL_TAC] THEN - MATCH_MP_TAC REAL_LE_MUL2 THEN - ASM_REWRITE_TAC[REAL_ABS_POS]; - REAL_ARITH_TAC]);; - (* Same CDF implies same CDF of clamped versions *) let CLAMP_DISTRIBUTION_EQ = prove (`!p:A prob_space (X:A->real) (Y:A->real) c. @@ -9424,33 +9194,6 @@ let PARTITION_EXISTENCE = prove REWRITE_TAC[REAL_OF_NUM_EQ] THEN UNDISCH_TAC `k = k - 1 + 1` THEN ARITH_TAC]);; -(* sin is Lipschitz with constant 1 *) -let SIN_LIPSCHITZ = prove - (`!a b. abs(sin a - sin b) <= abs(a - b)`, - REPEAT GEN_TAC THEN - SUBGOAL_THEN `!u v. sin(u + v) - sin(u - v) = &2 * cos u * sin v` - (fun th -> MP_TAC(SPECL [`(a + b) / &2`; `(a - b) / &2`] th)) THENL - [REPEAT GEN_TAC THEN REWRITE_TAC[SIN_ADD; SIN_SUB] THEN REAL_ARITH_TAC; - ALL_TAC] THEN - SUBGOAL_THEN `(a + b) / &2 + (a - b) / &2 = a /\ - (a + b) / &2 - (a - b) / &2 = b` - (fun th -> REWRITE_TAC[th]) THENL - [CONV_TAC REAL_FIELD; ALL_TAC] THEN - DISCH_THEN SUBST1_TAC THEN - REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_NUM] THEN - MP_TAC(SPEC `(a + b) / &2` COS_BOUND) THEN - MP_TAC(SPEC `(a - b) / &2` REAL_ABS_SIN_BOUND_LE) THEN - REWRITE_TAC[REAL_ABS_DIV; REAL_ABS_NUM] THEN - REPEAT STRIP_TAC THEN - MATCH_MP_TAC REAL_LE_TRANS THEN - EXISTS_TAC `&2 * &1 * (abs(a - b) / &2)` THEN - CONJ_TAC THENL - [MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL - [REAL_ARITH_TAC; ALL_TAC] THEN - MATCH_MP_TAC REAL_LE_MUL2 THEN - ASM_REWRITE_TAC[REAL_ABS_POS]; - REAL_ARITH_TAC]);; - (* Bounded equidistributed RVs have same expectation of Lipschitz functions *) let EQUIDIST_BOUNDED_LIPSCHITZ = prove (`!p:A prob_space X Y (g:real->real) L c. @@ -10126,8 +9869,8 @@ let INTEGRABLE_CLT_IID = prove REPEAT GEN_TAC THEN DISCH_THEN(fun th -> let ths = CONJUNCTS th in - MAP_EVERY ASSUME_TAC (List.filteri (fun i _ -> i <> 6) ths) THEN - LABEL_TAC "dist_eq" (List.nth ths 6)) THEN + MAP_EVERY ASSUME_TAC (subtract ths [el 6 ths]) THEN + LABEL_TAC "dist_eq" (el 6 ths)) THEN SUBGOAL_THEN `!i t. char_fn_re (p:A prob_space) ((X:num->A->real) i) t = char_fn_re p (X 0) t /\ char_fn_im p (X i) t = char_fn_im p (X 0) t` ASSUME_TAC THENL @@ -10143,6 +9886,7 @@ let INTEGRABLE_CLT_IID = prove MATCH_MP_TAC INTEGRABLE_CLT THEN REPEAT CONJ_TAC THEN FIRST_ASSUM MATCH_ACCEPT_TAC);; + (* ======================================================================== *) (* General Levy Continuity Theorem *) (* ======================================================================== *) @@ -10956,38 +10700,2613 @@ let LEVY_CONTINUITY_GENERAL_CID = prove EXISTS_TAC `H:real->real` THEN ASM_REWRITE_TAC[converges_in_distribution]);; (* ================================================================== *) -(* LINDEBERG-FELLER CLT *) +(* CDF RIGHT-CONTINUITY AND CHARACTERISTIC FUNCTION UNIQUENESS *) (* ================================================================== *) -(* L1: Telescoping product inequality *) -let PRODUCT_DIFF_SUM_BOUND = prove - (`!n (a:num->real) (b:num->real). - (!i. i <= n ==> abs(a i) <= &1) /\ - (!i. i <= n ==> abs(b i) <= &1) - ==> abs(product(0..n) a - product(0..n) b) - <= sum(0..n) (\i. abs(a i - b i))`, - INDUCT_TAC THENL - [REWRITE_TAC[PRODUCT_CLAUSES_NUMSEG; SUM_CLAUSES_NUMSEG; LE_0; LE; ARITH] THEN - BETA_TAC THEN REAL_ARITH_TAC; +(* CDF monotonicity (via distribution_fn) *) +let CDF_MONO = prove + (`!p:A prob_space (X:A->real) a b. + random_variable p X /\ a <= b + ==> cdf p X a <= cdf p X b`, + REPEAT STRIP_TAC THEN REWRITE_TAC[cdf] THEN + MATCH_MP_TAC PROB_MONO THEN CONJ_TAC THENL + [FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [random_variable]) THEN + DISCH_THEN(MP_TAC o SPEC `a:real`) THEN REWRITE_TAC[]; ALL_TAC] THEN + CONJ_TAC THENL + [FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [random_variable]) THEN + DISCH_THEN(MP_TAC o SPEC `b:real`) THEN REWRITE_TAC[]; + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN + GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC]);; + +(* CDF right-continuity *) +let CDF_RIGHT_CONTINUOUS = prove + (`!p:A prob_space (X:A->real) x e. + random_variable p X /\ &0 < e + ==> ?d. &0 < d /\ !y. x <= y /\ y < x + d + ==> abs(cdf p X y - cdf p X x) < e`, REPEAT GEN_TAC THEN STRIP_TAC THEN - SIMP_TAC[PRODUCT_CLAUSES_NUMSEG; SUM_CLAUSES_NUMSEG; - ARITH_RULE `0 <= SUC n`] THEN BETA_TAC THEN - ABBREV_TAC `Pa = product(0..n) (a:num->real)` THEN - ABBREV_TAC `Pb = product(0..n) (b:num->real)` THEN - SUBGOAL_THEN `Pa * (a:num->real)(SUC n) - Pb * b(SUC n) = - a(SUC n) * (Pa - Pb) + (a(SUC n) - b(SUC n)) * Pb` - SUBST1_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN - SUBGOAL_THEN `abs((a:num->real)(SUC n)) <= &1` ASSUME_TAC THENL - [FIRST_ASSUM MATCH_MP_TAC THEN ARITH_TAC; ALL_TAC] THEN - SUBGOAL_THEN `abs(Pa - Pb) <= - sum(0..n) (\i. abs((a:num->real) i - b i))` ASSUME_TAC THENL - [EXPAND_TAC "Pa" THEN EXPAND_TAC "Pb" THEN - FIRST_X_ASSUM MATCH_MP_TAC THEN - ASM_MESON_TAC[ARITH_RULE `i <= n ==> i <= SUC n`]; + (* Establish convergence: cdf(x + 1/(n+1)) -> cdf(x) *) + SUBGOAL_THEN + `((\n. cdf p (X:A->real) (x + inv(&(SUC n)))) ---> cdf p X x) sequentially` + MP_TAC THENL + [REWRITE_TAC[cdf] THEN + SUBGOAL_THEN + `INTERS {{a:A | a IN prob_carrier p /\ (X:A->real) a <= x + inv(&(SUC n))} | + n IN (:num)} = {a | a IN prob_carrier p /\ X a <= x}` + (LABEL_TAC "intrs") THENL + [REWRITE_TAC[INTERS_GSPEC; IN_UNIV; EXTENSION; IN_ELIM_THM] THEN + BETA_TAC THEN X_GEN_TAC `a:A` THEN EQ_TAC THENL + [DISCH_TAC THEN CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `0`) THEN SIMP_TAC[]; + REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN + SUBGOAL_THEN `?m. ~(m = 0) /\ &0 < inv(&m) /\ inv(&m) < (X:A->real) a - x` + STRIP_ASSUME_TAC THENL + [REWRITE_TAC[GSYM REAL_ARCH_INV] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `m:num`) THEN STRIP_TAC THEN + SUBGOAL_THEN `inv(&(SUC m)) <= inv(&m)` MP_TAC THENL + [MATCH_MP_TAC REAL_LE_INV2 THEN + REWRITE_TAC[REAL_OF_NUM_LT; REAL_OF_NUM_LE] THEN + UNDISCH_TAC `~(m = 0)` THEN ARITH_TAC; + ASM_REAL_ARITH_TAC]]; + STRIP_TAC THEN GEN_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `x:real` THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REAL_ARITH `&0 < d ==> x <= x + d`) THEN + MATCH_MP_TAC REAL_LT_INV THEN + REWRITE_TAC[REAL_OF_NUM_LT] THEN ARITH_TAC]; + ALL_TAC] THEN + MP_TAC(ISPECL [`p:A prob_space`; + `\n. {a:A | a IN prob_carrier p /\ (X:A->real) a <= x + inv(&(SUC n))}`] + PROB_CONTINUITY_FROM_ABOVE) THEN BETA_TAC THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [GEN_TAC THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [random_variable]) THEN + DISCH_THEN(MP_TAC o SPEC `x + inv(&(SUC n))`) THEN REWRITE_TAC[]; + GEN_TAC THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN + X_GEN_TAC `a:A` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `x + inv(&(SUC(SUC n)))` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_LADD_IMP THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + REWRITE_TAC[REAL_OF_NUM_LT; REAL_OF_NUM_LE] THEN ARITH_TAC]; + USE_THEN "intrs" SUBST1_TAC THEN REWRITE_TAC[]]; ALL_TAC] THEN - SUBGOAL_THEN `abs Pb <= &1` ASSUME_TAC THENL - [EXPAND_TAC "Pb" THEN + (* Extract d from convergence *) + REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` ASSUME_TAC) THEN + EXISTS_TAC `inv(&(SUC N))` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LT_INV THEN + REWRITE_TAC[REAL_OF_NUM_LT] THEN ARITH_TAC; + ALL_TAC] THEN + X_GEN_TAC `y:real` THEN STRIP_TAC THEN + (* cdf(x) <= cdf(y) <= cdf(x + 1/(N+1)), and |cdf(x+1/(N+1)) - cdf(x)| < e *) + SUBGOAL_THEN `cdf p (X:A->real) x <= cdf p X y` ASSUME_TAC THENL + [MATCH_MP_TAC CDF_MONO THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `cdf p (X:A->real) y <= cdf p X (x + inv(&(SUC N)))` ASSUME_TAC THENL + [MATCH_MP_TAC CDF_MONO THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `N:num`) THEN + REWRITE_TAC[LE_REFL] THEN ASM_REAL_ARITH_TAC);; + +(* Right-continuous monotone functions that agree on a dense set agree everywhere *) +let RIGHT_CONTINUOUS_MONOTONE_AGREE = prove + (`!f g. (!x y:real. x <= y ==> f x <= f y) /\ + (!x y:real. x <= y ==> g x <= g y) /\ + (!x e. &0 < e ==> ?d. &0 < d /\ + !y. x <= y /\ y < x + d ==> abs(f y - f x) < e) /\ + (!x e. &0 < e ==> ?d. &0 < d /\ + !y. x <= y /\ y < x + d ==> abs(g y - g x) < e) /\ + (!a b. a < b ==> ?c. a < c /\ c < b /\ f c = g c) + ==> !x. f x = g x`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN CONJ_TAC THENL + [(* Case f(x) > g(x): use g right-continuity + f monotonicity *) + REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN + ABBREV_TAC `eps = (f:real->real) x - g x` THEN + SUBGOAL_THEN `&0 < eps` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + UNDISCH_TAC `!x e. &0 < e ==> ?d. &0 < d /\ + (!y. x <= y /\ y < x + d ==> abs((g:real->real) y - g x) < e)` THEN + DISCH_THEN(MP_TAC o SPECL [`x:real`; `eps:real`]) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + UNDISCH_TAC `!a b. a < b ==> ?c. a < c /\ c < b /\ + (f:real->real) c = g c` THEN + DISCH_THEN(MP_TAC o SPECL [`x:real`; `x + d:real`]) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `c:real` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `(f:real->real) x <= f c` ASSUME_TAC THENL + [FIRST_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `abs((g:real->real) c - g x) < eps` ASSUME_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_REAL_ARITH_TAC; + (* Case g(x) > f(x): use f right-continuity + g monotonicity *) + REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN + ABBREV_TAC `eps = (g:real->real) x - f x` THEN + SUBGOAL_THEN `&0 < eps` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + UNDISCH_TAC `!x e. &0 < e ==> ?d. &0 < d /\ + (!y. x <= y /\ y < x + d ==> abs((f:real->real) y - f x) < e)` THEN + DISCH_THEN(MP_TAC o SPECL [`x:real`; `eps:real`]) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + UNDISCH_TAC `!a b. a < b ==> ?c. a < c /\ c < b /\ + (f:real->real) c = g c` THEN + DISCH_THEN(MP_TAC o SPECL [`x:real`; `x + d:real`]) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `c:real` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `(g:real->real) x <= g c` ASSUME_TAC THENL + [FIRST_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `abs((f:real->real) c - f x) < eps` ASSUME_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_REAL_ARITH_TAC]);; + +(* Helper: sequences that are within eps of each other for all eps > 0 are equal *) +let REAL_EQ_FROM_APPROX = prove + (`!a b:real. (!e. &0 < e ==> abs(a - b) < e) ==> a = b`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN + CONJ_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `a - b:real`) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; REAL_ARITH_TAC]; + FIRST_X_ASSUM(MP_TAC o SPEC `b - a:real`) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; REAL_ARITH_TAC]]);; + +(* Characteristic function uniqueness *) +let CHAR_FN_UNIQUENESS = prove + (`!p:A prob_space (X:A->real) (Y:A->real). + random_variable p X /\ random_variable p Y /\ + integrable p X /\ integrable p Y /\ + integrable p (\x. X x pow 2) /\ integrable p (\x. Y x pow 2) /\ + (!t. char_fn_re p X t = char_fn_re p Y t) /\ + (!t. char_fn_im p X t = char_fn_im p Y t) + ==> !x. cdf p X x = cdf p Y x`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + (* Define interleaving sequence Z_n = X if EVEN n, Y if ODD n *) + ABBREV_TAC `Z = \n:num. if EVEN n then (X:A->real) else Y` THEN + (* All Z_n are random variables *) + SUBGOAL_THEN `!n. random_variable p ((Z:num->A->real) n)` ASSUME_TAC THENL + [GEN_TAC THEN EXPAND_TAC "Z" THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + (* All Z_n are integrable *) + SUBGOAL_THEN `!n. integrable p ((Z:num->A->real) n)` ASSUME_TAC THENL + [GEN_TAC THEN EXPAND_TAC "Z" THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + (* All Z_n have integrable squares *) + SUBGOAL_THEN `!n. integrable p (\x:A. (Z:num->A->real) n x pow 2)` ASSUME_TAC THENL + [GEN_TAC THEN EXPAND_TAC "Z" THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + (* Bounded second moments *) + SUBGOAL_THEN + `?C. &0 < C /\ !n. expectation p (\x:A. (Z:num->A->real) n x pow 2) <= C` + ASSUME_TAC THENL + [EXISTS_TAC `abs(expectation p (\x:A. (X:A->real) x pow 2)) + + abs(expectation p (\x:A. (Y:A->real) x pow 2)) + &1` THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + GEN_TAC THEN EXPAND_TAC "Z" THEN COND_CASES_TAC THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + (* Char fn of Z_n converges (trivially, since all equal) *) + SUBGOAL_THEN + `!t. ((\n. char_fn_re p ((Z:num->A->real) n) t) ---> + char_fn_re p X t) sequentially` + ASSUME_TAC THENL + [GEN_TAC THEN REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + X_GEN_TAC `eps:real` THEN DISCH_TAC THEN + EXISTS_TAC `0` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + EXPAND_TAC "Z" THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `!t. ((\n. char_fn_im p ((Z:num->A->real) n) t) ---> + char_fn_im p X t) sequentially` + ASSUME_TAC THENL + [GEN_TAC THEN REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + X_GEN_TAC `eps:real` THEN DISCH_TAC THEN + EXISTS_TAC `0` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + EXPAND_TAC "Z" THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + (* Apply Levy continuity theorem *) + MP_TAC(ISPECL [`p:A prob_space`; `Z:num->A->real`; + `\t. char_fn_re p (X:A->real) t`; + `\t. char_fn_im p (X:A->real) t`] + LEVY_CONTINUITY_GENERAL) THEN + BETA_TAC THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `H:real->real` STRIP_ASSUME_TAC) THEN + (* At continuity points of H: cdf(Z_n, x) -> H(x) *) + (* Since Z_{2n} = X, cdf(X, x) = H(x) at continuity points *) + (* Since Z_{2n+1} = Y, cdf(Y, x) = H(x) at continuity points *) + SUBGOAL_THEN + `!x. H real_continuous atreal x + ==> cdf p (X:A->real) x = H x /\ cdf p Y x = H x` + ASSUME_TAC THENL + [X_GEN_TAC `c:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `c:real`) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN DISCH_TAC THEN + CONJ_TAC THENL + [(* cdf(X, c) = H(c): use even subsequence Z_{2N} = X *) + MATCH_MP_TAC REAL_EQ_FROM_APPROX THEN + X_GEN_TAC `eps:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `eps:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` MP_TAC) THEN + DISCH_THEN(MP_TAC o SPEC `2 * N`) THEN + ANTS_TAC THENL [ARITH_TAC; ALL_TAC] THEN + EXPAND_TAC "Z" THEN BETA_TAC THEN REWRITE_TAC[EVEN_DOUBLE] THEN + SIMP_TAC[]; + (* cdf(Y, c) = H(c): use odd subsequence Z_{2N+1} = Y *) + MATCH_MP_TAC REAL_EQ_FROM_APPROX THEN + X_GEN_TAC `eps:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `eps:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` MP_TAC) THEN + DISCH_THEN(MP_TAC o SPEC `2 * N + 1`) THEN + ANTS_TAC THENL [ARITH_TAC; ALL_TAC] THEN + EXPAND_TAC "Z" THEN BETA_TAC THEN + REWRITE_TAC[EVEN_ADD; EVEN_DOUBLE; EVEN; ARITH] THEN + SIMP_TAC[]]; + ALL_TAC] THEN + (* CDFs agree at continuity points of H *) + SUBGOAL_THEN + `!x. H real_continuous atreal x + ==> cdf p (X:A->real) x = cdf p Y x` + ASSUME_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + (* Apply RIGHT_CONTINUOUS_MONOTONE_AGREE *) + MATCH_MP_TAC RIGHT_CONTINUOUS_MONOTONE_AGREE THEN + REPEAT CONJ_TAC THENL + [REPEAT STRIP_TAC THEN MATCH_MP_TAC CDF_MONO THEN ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC THEN MATCH_MP_TAC CDF_MONO THEN ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC THEN MATCH_MP_TAC CDF_RIGHT_CONTINUOUS THEN + ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC THEN MATCH_MP_TAC CDF_RIGHT_CONTINUOUS THEN + ASM_REWRITE_TAC[]; + (* Dense agreement via continuity points of H *) + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`H:real->real`; `a:real`; `b:real`] + MONOTONE_CONTINUITY_DENSE) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `c:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `c:real` THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]);; + +(* ================================================================== *) +(* LEVY INVERSION FORMULA *) +(* The characteristic function determines the distribution via an *) +(* explicit integral formula: for continuity points a < b of F, *) +(* F(b) - F(a) = lim_{T->inf} (1/(2pi)) int_{-T}^T *) +(* [(sin(tb)-sin(ta))*phi_re(t) - (cos(tb)-cos(ta))*phi_im(t)]/t *) +(* ================================================================== *) + +(* Trig identity: the inversion integrand simplifies via sin subtraction *) +let INVERSION_TRIG_IDENTITY = prove + (`!t a b x:real. + (sin(t * b) - sin(t * a)) * cos(t * x) - + (cos(t * b) - cos(t * a)) * sin(t * x) = + sin(t * (b - x)) - sin(t * (a - x))`, + REPEAT GEN_TAC THEN + REWRITE_TAC[REAL_SUB_LDISTRIB] THEN + REWRITE_TAC[SIN_SUB] THEN REAL_ARITH_TAC);; + +(* Kernel boundedness: |(sin(t(b-x)) - sin(t(a-x))) / t| <= |b - a| *) +let INVERSION_KERNEL_BOUNDED = prove + (`!t a b x:real. abs((sin(t * (b - x)) - sin(t * (a - x))) * inv t) + <= abs(b - a)`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `t = &0` THENL + [ASM_REWRITE_TAC[REAL_MUL_LZERO; SIN_0; REAL_SUB_REFL; REAL_MUL_LZERO; + REAL_ABS_NUM] THEN + REWRITE_TAC[REAL_ABS_POS]; + ALL_TAC] THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_INV] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `abs(t * (b - x) - t * (a - x)) * inv(abs t)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_RMUL THEN CONJ_TAC THENL + [REWRITE_TAC[SIN_LIPSCHITZ]; + MATCH_MP_TAC REAL_LE_INV THEN REWRITE_TAC[REAL_ABS_POS]]; + ALL_TAC] THEN + SUBGOAL_THEN `abs(t * (b - x) - t * (a - x)) = abs t * abs(b - a:real)` + SUBST1_TAC THENL + [REWRITE_TAC[GSYM REAL_ABS_MUL] THEN AP_TERM_TAC THEN CONV_TAC REAL_RING; + ALL_TAC] THEN + SUBGOAL_THEN `(abs t * abs(b - a)) * inv(abs t) = + abs(b - a:real) * (abs t * inv(abs t))` SUBST1_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `abs t * inv(abs t) = &1` SUBST1_TAC THENL + [MATCH_MP_TAC REAL_MUL_RINV THEN ASM_REWRITE_TAC[REAL_ABS_ZERO]; + REWRITE_TAC[REAL_MUL_RID; REAL_LE_REFL]]);; + +(* Integrability of sin(c*t)/t on [0,M] for c > 0 *) +let SINC_SCALED_INTEGRABLE = prove + (`!c M. &0 < c /\ &0 <= M ==> + (\t. sin(c * t) * inv t) real_integrable_on real_interval[&0,M]`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN + EXISTS_TAC `\t:real. abs c` THEN REPEAT CONJ_TAC THENL + [(* Measurability: sin(c*t)*inv(t) measurable on [0,M] *) + MATCH_MP_TAC REAL_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN + EXISTS_TAC `(:real)` THEN + REWRITE_TAC[SUBSET_UNIV; REAL_LEBESGUE_MEASURABLE_INTERVAL] THEN + MATCH_MP_TAC REAL_MEASURABLE_ON_MUL THEN CONJ_TAC THENL + [(* sin(c*t) measurable on (:real) *) + SUBGOAL_THEN `(\t. sin(c * t)) = sin o (\t:real. c * t)` SUBST1_TAC THENL + [REWRITE_TAC[o_DEF]; ALL_TAC] THEN + MATCH_MP_TAC REAL_MEASURABLE_ON_COMPOSE_CONTINUOUS THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_SIN] THEN + MATCH_MP_TAC REAL_CONTINUOUS_IMP_REAL_MEASURABLE_ON_CLOSED_SUBSET THEN + REWRITE_TAC[REAL_CLOSED_UNIV] THEN + SIMP_TAC[REAL_CONTINUOUS_ON_LMUL; REAL_CONTINUOUS_ON_ID]; + (* inv(t) measurable on (:real) *) + SUBGOAL_THEN `inv:real->real = (\x. inv x)` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM]; ALL_TAC] THEN + MATCH_MP_TAC REAL_MEASURABLE_ON_INV THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_IMP_REAL_MEASURABLE_ON_CLOSED_SUBSET THEN + REWRITE_TAC[REAL_CLOSED_UNIV; REAL_CONTINUOUS_ON_ID]; + REWRITE_TAC[SET_RULE `{x | x = &0} = {&0}`; REAL_NEGLIGIBLE_SING]]]; + (* Bounding function integrable *) + REWRITE_TAC[REAL_INTEGRABLE_CONST]; + (* Bound: |sin(c*t)*inv(t)| <= |c| *) + X_GEN_TAC `t:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN + STRIP_TAC THEN REWRITE_TAC[REAL_ABS_MUL] THEN + ASM_CASES_TAC `t = &0` THENL + [ASM_REWRITE_TAC[REAL_INV_0; REAL_ABS_NUM; REAL_MUL_RZERO; REAL_ABS_POS]; + ALL_TAC] THEN + SUBGOAL_THEN `abs(sin(c * t)) <= abs(c * t)` ASSUME_TAC THENL + [MP_TAC(SPECL [`c * t:real`; `&0`] SIN_LIPSCHITZ) THEN + REWRITE_TAC[SIN_0; REAL_SUB_RZERO]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs(c * t) * abs(inv t)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_RMUL THEN ASM_REWRITE_TAC[REAL_ABS_POS]; + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_INV; GSYM REAL_MUL_ASSOC] THEN + SUBGOAL_THEN `abs t * inv(abs t) = &1` SUBST1_TAC THENL + [MATCH_MP_TAC REAL_MUL_RINV THEN ASM_REWRITE_TAC[REAL_ABS_ZERO]; + REWRITE_TAC[REAL_MUL_RID; REAL_LE_REFL]]]]);; + +(* Scaled Dirichlet integral: int_0^T sin(c*t)/t dt -> pi/2 for c > 0 *) +let DIRICHLET_INTEGRAL_SCALED = prove + (`!c. &0 < c ==> + ((\T. real_integral (real_interval[&0,T]) (\t. sin(c * t) * inv t)) + ---> pi / &2) at_posinfinity`, + X_GEN_TAC `c:real` THEN DISCH_TAC THEN + REWRITE_TAC[REALLIM_AT_POSINFINITY] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(REWRITE_RULE[REALLIM_AT_POSINFINITY] DIRICHLET_INTEGRAL) THEN + DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` (ASSUME_TAC o REWRITE_RULE[])) THEN + EXISTS_TAC `(abs B + &1) * inv c` THEN + X_GEN_TAC `M:real` THEN REWRITE_TAC[real_ge] THEN DISCH_TAC THEN + SUBGOAL_THEN `&0 < M` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `(abs B + &1) * inv c` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_MUL THEN + CONJ_TAC THENL [REAL_ARITH_TAC; MATCH_MP_TAC REAL_LT_INV THEN + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < c * M` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + (* Key: int_0^T sin(ct)/t dt = int_0^{cT} sin(u)/u du by substitution *) + SUBGOAL_THEN + `real_integral (real_interval[&0,M]) (\t. sin(c * t) * inv t) = + real_integral (real_interval[&0,c * M]) (\t. sin t * inv t)` + SUBST1_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + MP_TAC(ISPECL [`\t:real. sin t * inv t`; + `\t:real. c * t`; + `\(t:real). c:real`; + `&0:real`; `M:real`; + `&0:real`; `c * M:real`; + `{&0:real}`] + HAS_REAL_INTEGRAL_SUBSTITUTION_STRONG) THEN + REWRITE_TAC[COUNTABLE_SING] THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [MP_TAC(SPECL [`&1`; `c * M:real`] SINC_SCALED_INTEGRABLE) THEN + REWRITE_TAC[REAL_MUL_LID] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_REAL_ARITH_TAC; + SIMP_TAC[REAL_CONTINUOUS_ON_LMUL; REAL_CONTINUOUS_ON_ID]; + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_REAL_INTERVAL] THEN + X_GEN_TAC `y:real` THEN STRIP_TAC THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REAL_ARITH_TAC]; + X_GEN_TAC `x:real` THEN + REWRITE_TAC[IN_DIFF; IN_REAL_INTERVAL; IN_SING] THEN + STRIP_TAC THEN CONJ_TAC THENL + [GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV) [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC HAS_REAL_DERIVATIVE_LMUL_WITHIN THEN + REWRITE_TAC[HAS_REAL_DERIVATIVE_ID]; + MATCH_MP_TAC REAL_CONTINUOUS_MUL THEN + REWRITE_TAC[REAL_CONTINUOUS_WITHIN_SIN] THEN + SUBGOAL_THEN `inv:real->real = (\x:real. inv x)` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM]; ALL_TAC] THEN + MATCH_MP_TAC REAL_CONTINUOUS_INV THEN + REWRITE_TAC[REAL_CONTINUOUS_WITHIN_ID; NETLIMIT_WITHINREAL] THEN + MATCH_MP_TAC(REAL_ARITH `&0 < x ==> ~(x = &0)`) THEN + MATCH_MP_TAC REAL_LT_MUL THEN ASM_REAL_ARITH_TAC]; + ASM_REAL_ARITH_TAC; + ASM_REAL_ARITH_TAC; + REWRITE_TAC[REAL_MUL_RZERO] THEN ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + SIMP_TAC[REAL_MUL_RZERO] THEN + DISCH_TAC THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_EQ THEN + EXISTS_TAC `\x:real. sin(c * x) * inv(c * x) * c` THEN + CONJ_TAC THENL + [X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN + STRIP_TAC THEN ASM_CASES_TAC `x = &0` THENL + [ASM_REWRITE_TAC[REAL_MUL_RZERO; SIN_0; REAL_MUL_LZERO]; + ALL_TAC] THEN + MATCH_MP_TAC(REAL_FIELD + `~(c = &0) /\ ~(x = &0) ==> + sin(c * x) * inv(c * x) * c = sin(c * x) * inv x`) THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[REAL_MUL_ASSOC] THEN FIRST_X_ASSUM ACCEPT_TAC]; + ALL_TAC] THEN + (* Apply DIRICHLET_INTEGRAL bound: c*M >= B *) + FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[real_ge] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs B + &1` THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `c * ((abs B + &1) * inv c)` THEN + CONJ_TAC THENL + [SUBGOAL_THEN `c * ((abs B + &1) * inv c) = abs B + &1` SUBST1_TAC THENL + [MATCH_MP_TAC(REAL_FIELD `~(c = &0) ==> c * ((abs B + &1) * inv c) = abs B + &1`) THEN + ASM_REAL_ARITH_TAC; + REAL_ARITH_TAC]; + MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REAL_ARITH_TAC]);; + +(* Scaled Dirichlet integral for negative c *) +let DIRICHLET_INTEGRAL_SCALED_NEG = prove + (`!c. c < &0 ==> + ((\T. real_integral (real_interval[&0,T]) (\t. sin(c * t) * inv t)) + ---> --(pi / &2)) at_posinfinity`, + X_GEN_TAC `c:real` THEN DISCH_TAC THEN + SUBGOAL_THEN `&0 < --c` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(SPEC `--c:real` DIRICHLET_INTEGRAL_SCALED) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + (* Show sin(c*t)/t = --(sin(--c*t)/t) pointwise, hence integrals related *) + SUBGOAL_THEN + `!M:real. real_integral (real_interval[&0,M]) (\t. sin(c * t) * inv t) = + --(real_integral (real_interval[&0,M]) (\t. sin(--c * t) * inv t))` + (fun th -> REWRITE_TAC[th]) THENL + [X_GEN_TAC `M:real` THEN + SUBGOAL_THEN + `real_integral (real_interval[&0,M]) (\t. sin(c * t) * inv t) = + real_integral (real_interval[&0,M]) (\t. --(sin(--c * t) * inv t))` + SUBST1_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_EQ THEN + X_GEN_TAC `t:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN + STRIP_TAC THEN REWRITE_TAC[REAL_MUL_LNEG; SIN_NEG; REAL_NEG_NEG]; + MATCH_MP_TAC REAL_INTEGRAL_NEG THEN + ASM_CASES_TAC `&0 <= M:real` THENL + [MATCH_MP_TAC SINC_SCALED_INTEGRABLE THEN ASM_REAL_ARITH_TAC; + SUBGOAL_THEN `real_interval[&0,M:real] = {}` SUBST1_TAC THENL + [REWRITE_TAC[REAL_INTERVAL_EQ_EMPTY] THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[REAL_INTEGRABLE_ON_EMPTY]]]]; + MATCH_MP_TAC REALLIM_NEG THEN ASM_REWRITE_TAC[]]);; + +(* Uniform bound on scaled sinc integral *) +let SINC_INTEGRAL_UNIFORM_BOUND = prove + (`!c TT. &0 < c /\ &0 < TT ==> + abs(real_integral (real_interval[&0,TT]) (\t. sin(c * t) * inv t)) <= + pi / &2 + &4`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `real_integral (real_interval[&0,TT]) (\t. sin(c * t) * inv t) = + real_integral (real_interval[&0,c * TT]) (\t. sin t * inv t)` + SUBST1_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + MP_TAC(ISPECL [`\t:real. sin t * inv t`; + `\t:real. c * t`; + `\(t:real). c:real`; + `&0:real`; `TT:real`; + `&0:real`; `c * TT:real`; + `{&0:real}`] + HAS_REAL_INTEGRAL_SUBSTITUTION_STRONG) THEN + REWRITE_TAC[COUNTABLE_SING] THEN ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [MP_TAC(SPECL [`&1`; `c * TT:real`] SINC_SCALED_INTEGRABLE) THEN + REWRITE_TAC[REAL_MUL_LID] THEN DISCH_THEN MATCH_MP_TAC THEN + CONJ_TAC THENL [REAL_ARITH_TAC; + MATCH_MP_TAC(REAL_ARITH `&0 < x ==> &0 <= x`) THEN + MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[]]; + SIMP_TAC[REAL_CONTINUOUS_ON_LMUL; REAL_CONTINUOUS_ON_ID]; + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_REAL_INTERVAL] THEN + X_GEN_TAC `y:real` THEN STRIP_TAC THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REAL_ARITH_TAC]; + X_GEN_TAC `x:real` THEN + REWRITE_TAC[IN_DIFF; IN_REAL_INTERVAL; IN_SING] THEN + STRIP_TAC THEN CONJ_TAC THENL + [GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV) [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC HAS_REAL_DERIVATIVE_LMUL_WITHIN THEN + REWRITE_TAC[HAS_REAL_DERIVATIVE_ID]; + MATCH_MP_TAC REAL_CONTINUOUS_MUL THEN + REWRITE_TAC[REAL_CONTINUOUS_WITHIN_SIN] THEN + SUBGOAL_THEN `inv:real->real = (\x:real. inv x)` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM]; ALL_TAC] THEN + MATCH_MP_TAC REAL_CONTINUOUS_INV THEN + REWRITE_TAC[REAL_CONTINUOUS_WITHIN_ID; NETLIMIT_WITHINREAL] THEN + MATCH_MP_TAC(REAL_ARITH `&0 < x ==> ~(x = &0)`) THEN + MATCH_MP_TAC REAL_LT_MUL THEN ASM_REAL_ARITH_TAC]; + ASM_REAL_ARITH_TAC; + MATCH_MP_TAC(REAL_ARITH `&0 < x ==> &0 <= x`) THEN + MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_MUL_RZERO] THEN + MATCH_MP_TAC(REAL_ARITH `&0 < x ==> &0 <= x`) THEN + MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + SIMP_TAC[REAL_MUL_RZERO] THEN + DISCH_TAC THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_EQ THEN + EXISTS_TAC `\x:real. sin(c * x) * inv(c * x) * c` THEN + CONJ_TAC THENL + [X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN + STRIP_TAC THEN ASM_CASES_TAC `x = &0` THENL + [ASM_REWRITE_TAC[REAL_MUL_RZERO; SIN_0; REAL_MUL_LZERO]; + ALL_TAC] THEN + MATCH_MP_TAC(REAL_FIELD + `~(c = &0) /\ ~(x = &0) ==> + sin(c * x) * inv(c * x) * c = sin(c * x) * inv x`) THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[REAL_MUL_ASSOC] THEN FIRST_X_ASSUM ACCEPT_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < c * TT` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_CASES_TAC `&1 <= c * TT` THENL + [MP_TAC(SPEC `c * TT:real` SINC_INTEGRAL_BOUND) THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN + SUBGOAL_THEN `&4 * inv(c * TT) <= &4` ASSUME_TAC THENL + [SUBGOAL_THEN `inv(c * TT) <= &1` MP_TAC THENL + [SUBGOAL_THEN `inv(c * TT) <= inv(&1)` MP_TAC THENL + [MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[REAL_INV_1]]; + REAL_ARITH_TAC]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `abs(real_integral (real_interval [&0,c * TT]) + (\t. sin t * inv t) - pi / &2) + abs(pi / &2)` THEN + CONJ_TAC THENL + [REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&4 + abs(pi / &2)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; REAL_ARITH_TAC]; + MP_TAC PI_POS THEN REAL_ARITH_TAC]]; + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `c * TT:real` THEN CONJ_TAC THENL + [ALL_TAC; MP_TAC PI_POS THEN ASM_REAL_ARITH_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `real_integral (real_interval[&0, c * TT]) (\t:real. &1)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_ABS_BOUND_INTEGRAL THEN REPEAT CONJ_TAC THENL + [MP_TAC(SPECL [`&1`; `c * TT:real`] SINC_SCALED_INTEGRABLE) THEN + REWRITE_TAC[REAL_MUL_LID] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[REAL_INTEGRABLE_CONST]; + X_GEN_TAC `t:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN STRIP_TAC THEN + BETA_TAC THEN REWRITE_TAC[REAL_ABS_MUL] THEN + ASM_CASES_TAC `t = &0` THENL + [ASM_REWRITE_TAC[REAL_INV_0; REAL_ABS_NUM; REAL_MUL_RZERO; REAL_POS]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs t * abs(inv t)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN + MP_TAC(SPECL [`t:real`; `&0`] SIN_LIPSCHITZ) THEN + REWRITE_TAC[SIN_0; REAL_SUB_RZERO] THEN REAL_ARITH_TAC; + REWRITE_TAC[REAL_ABS_INV; GSYM REAL_ABS_MUL] THEN + ASM_SIMP_TAC[REAL_MUL_RINV; REAL_ABS_NUM; REAL_LE_REFL]]]; + SUBGOAL_THEN `real_integral (real_interval[&0, c * TT]) (\t:real. &1) = + &1 * (c * TT - &0)` SUBST1_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_CONST THEN ASM_REAL_ARITH_TAC; + REAL_ARITH_TAC]]]);; + +(* Inversion kernel bounded by |b - a| (conditional version) *) +let INVERSION_KERNEL_BOUNDED_NZ = prove + (`!a b x t. ~(t = &0) ==> + abs((sin(t * (b - x)) - sin(t * (a - x))) * inv t) <= abs(b - a)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_INV] THEN + SUBGOAL_THEN `abs(sin(t * (b - x)) - sin(t * (a - x))) <= abs(t) * abs(b - a)` + ASSUME_TAC THENL + [MP_TAC(SPECL [`t * (b - x):real`; `t * (a - x):real`] SIN_LIPSCHITZ) THEN + REWRITE_TAC[GSYM REAL_SUB_LDISTRIB; REAL_ABS_MUL; + REAL_ARITH `(b - x) - (a - x) = b - a:real`]; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < abs t` ASSUME_TAC THENL + [ASM_REWRITE_TAC[GSYM REAL_ABS_NZ]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(abs t * abs(b - a)) * inv(abs t)` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_RMUL THEN + ASM_REWRITE_TAC[REAL_LE_INV_EQ; REAL_ABS_POS]; + SUBGOAL_THEN `(abs t * abs(b - a)) * inv(abs t) = abs(b - a)` + SUBST1_TAC THENL + [MATCH_MP_TAC(REAL_FIELD + `~(t = &0) ==> (abs t * abs(b - a)) * inv(abs t) = abs(b - a)`) THEN + ASM_REWRITE_TAC[REAL_ABS_ZERO]; + REAL_ARITH_TAC]]);; + +(* Integrability of sin(c*t)/t for c < 0 *) +let SINC_SCALED_NEG_INTEGRABLE = prove + (`!c M. c < &0 /\ &0 <= M ==> + (\t. sin(c * t) * inv t) real_integrable_on real_interval[&0,M]`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\t. sin(c * t) * inv t) = (\t:real. --(sin((--c) * t) * inv t))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `t:real` THEN + SUBGOAL_THEN `sin(c * t):real = sin(--((--c) * t))` SUBST1_TAC THENL + [AP_TERM_TAC THEN REAL_ARITH_TAC; + REWRITE_TAC[SIN_NEG] THEN REAL_ARITH_TAC]; + MATCH_MP_TAC REAL_INTEGRABLE_NEG THEN + MATCH_MP_TAC SINC_SCALED_INTEGRABLE THEN ASM_REAL_ARITH_TAC]);; + +(* Integrability of sin(c*t)/t for nonzero c *) +let SINC_SCALED_INTEGRABLE_NZ = prove + (`!c M. ~(c = &0) /\ &0 <= M ==> + (\t. sin(c * t) * inv t) real_integrable_on real_interval[&0,M]`, + REPEAT STRIP_TAC THEN + ASM_CASES_TAC `&0 < c` THENL + [MATCH_MP_TAC SINC_SCALED_INTEGRABLE THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC SINC_SCALED_NEG_INTEGRABLE THEN ASM_REAL_ARITH_TAC]);; + +(* Inversion kernel converges to 1 inside (a,b) *) +let INVERSION_KERNEL_CONVERGES_INSIDE = prove + (`!a b v. a < v /\ v < b ==> + ((\TT. inv(pi) * real_integral (real_interval[&0,TT]) + (\t. (sin(t * (b - v)) - sin(t * (a - v))) * inv t)) + ---> &1) at_posinfinity`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&0 < b - v /\ ~(b - v = &0)` STRIP_ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `a - v < &0 /\ ~(a - v = &0)` STRIP_ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `~(pi = &0)` ASSUME_TAC THENL + [MP_TAC PI_POS THEN REAL_ARITH_TAC; ALL_TAC] THEN + GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV) + [MATCH_MP (REAL_FIELD + `~(pi = &0) ==> &1 = inv(pi) * (pi / &2 - --(pi / &2))`) + (ASSUME `~(pi = &0)`)] THEN + MATCH_MP_TAC REALLIM_LMUL THEN + MATCH_MP_TAC REALLIM_TRANSFORM_EVENTUALLY THEN + EXISTS_TAC `\TT. real_integral (real_interval[&0,TT]) + (\t. sin((b - v) * t) * inv t) - + real_integral (real_interval[&0,TT]) + (\t. sin((a - v) * t) * inv t)` THEN + CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_AT_POSINFINITY] THEN + EXISTS_TAC `&1` THEN X_GEN_TAC `TT:real` THEN + REWRITE_TAC[real_ge] THEN DISCH_TAC THEN BETA_TAC THEN + SUBGOAL_THEN `&0 < TT` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + CONV_TAC SYM_CONV THEN + SUBGOAL_THEN + `(\t. (sin(t * (b - v)) - sin(t * (a - v))) * inv t) = + (\t:real. sin((b - v) * t) * inv t - sin((a - v) * t) * inv t)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; REAL_SUB_RDISTRIB] THEN GEN_TAC THEN + BINOP_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + REAL_ARITH_TAC; + MATCH_MP_TAC REAL_INTEGRAL_SUB THEN CONJ_TAC THEN + MATCH_MP_TAC SINC_SCALED_INTEGRABLE_NZ THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < TT ==> &0 <= TT`]]; + MATCH_MP_TAC REALLIM_SUB THEN CONJ_TAC THENL + [MATCH_MP_TAC(SPEC `b - v:real` DIRICHLET_INTEGRAL_SCALED) THEN + ASM_REAL_ARITH_TAC; + MATCH_MP_TAC(SPEC `a - v:real` DIRICHLET_INTEGRAL_SCALED_NEG) THEN + ASM_REAL_ARITH_TAC]]);; + +(* Inversion kernel converges to 0 outside [a,b] *) +let INVERSION_KERNEL_CONVERGES_OUTSIDE = prove + (`!a b v. a < b /\ (v < a \/ b < v) ==> + ((\TT. inv(pi) * real_integral (real_interval[&0,TT]) + (\t. (sin(t * (b - v)) - sin(t * (a - v))) * inv t)) + ---> &0) at_posinfinity`, + REPEAT GEN_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + DISCH_TAC THEN + SUBGOAL_THEN `~(b - v = &0) /\ ~(a - v = &0)` STRIP_ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REALLIM_NULL_LMUL THEN + MATCH_MP_TAC REALLIM_TRANSFORM_EVENTUALLY THEN + EXISTS_TAC `\TT. real_integral (real_interval[&0,TT]) + (\t. sin((b - v) * t) * inv t) - + real_integral (real_interval[&0,TT]) + (\t. sin((a - v) * t) * inv t)` THEN + CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_AT_POSINFINITY] THEN + EXISTS_TAC `&1` THEN X_GEN_TAC `TT:real` THEN + REWRITE_TAC[real_ge] THEN DISCH_TAC THEN BETA_TAC THEN + SUBGOAL_THEN `&0 < TT` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + CONV_TAC SYM_CONV THEN + SUBGOAL_THEN + `(\t. (sin(t * (b - v)) - sin(t * (a - v))) * inv t) = + (\t:real. sin((b - v) * t) * inv t - sin((a - v) * t) * inv t)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; REAL_SUB_RDISTRIB] THEN GEN_TAC THEN + BINOP_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + REAL_ARITH_TAC; + MATCH_MP_TAC REAL_INTEGRAL_SUB THEN CONJ_TAC THEN + MATCH_MP_TAC SINC_SCALED_INTEGRABLE_NZ THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < TT ==> &0 <= TT`]]; + FIRST_X_ASSUM DISJ_CASES_TAC THENL + [GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV) + [REAL_ARITH `&0 = pi / &2 - pi / &2`] THEN + MATCH_MP_TAC REALLIM_SUB THEN CONJ_TAC THENL + [MATCH_MP_TAC(SPEC `b - v:real` DIRICHLET_INTEGRAL_SCALED) THEN + ASM_REAL_ARITH_TAC; + MATCH_MP_TAC(SPEC `a - v:real` DIRICHLET_INTEGRAL_SCALED) THEN + ASM_REAL_ARITH_TAC]; + GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV) + [REAL_ARITH `&0 = --(pi / &2) - --(pi / &2)`] THEN + MATCH_MP_TAC REALLIM_SUB THEN CONJ_TAC THENL + [MATCH_MP_TAC(SPEC `b - v:real` DIRICHLET_INTEGRAL_SCALED_NEG) THEN + ASM_REAL_ARITH_TAC; + MATCH_MP_TAC(SPEC `a - v:real` DIRICHLET_INTEGRAL_SCALED_NEG) THEN + ASM_REAL_ARITH_TAC]]]);; + +(* ================================================================== *) +(* LEVY INVERSION FORMULA: Phase 4-5 *) +(* ================================================================== *) + +(* Extend SINC_INTEGRAL_UNIFORM_BOUND to all real c (not just c > 0) *) +let SINC_INTEGRAL_BOUND_ALL = prove + (`!c TT. &0 < TT ==> + abs(real_integral (real_interval[&0,TT]) (\t. sin(c * t) * inv t)) <= + pi / &2 + &4`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `&0 < c` THENL + [ASM_SIMP_TAC[SINC_INTEGRAL_UNIFORM_BOUND]; ALL_TAC] THEN + ASM_CASES_TAC `c = &0` THENL + [ASM_REWRITE_TAC[REAL_MUL_LZERO; SIN_0; REAL_MUL_LZERO; + REAL_INTEGRAL_0; REAL_ABS_NUM] THEN + MP_TAC PI_POS THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `&0 < --c` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `(\t. sin(c * t) * inv t) = (\t:real. --(sin(--c * t) * inv t))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `t:real` THEN + SUBGOAL_THEN `c * t:real = --(--c * t)` (fun th -> REWRITE_TAC[th]) THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[SIN_NEG] THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `(\t:real. sin(--c * t) * inv t) real_integrable_on + real_interval[&0,TT]` ASSUME_TAC THENL + [MATCH_MP_TAC SINC_SCALED_INTEGRABLE_NZ THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_SIMP_TAC[REAL_INTEGRAL_NEG; REAL_ABS_NEG] THEN + ASM_SIMP_TAC[SINC_INTEGRAL_UNIFORM_BOUND]);; + +(* Uniform bound on the inversion kernel g_T(v) *) +let INVERSION_KERNEL_UNIFORM_BOUND = prove + (`!a b TT v. &0 < TT ==> + abs(inv(pi) * real_integral (real_interval[&0,TT]) + (\t. (sin(t * (b - v)) - sin(t * (a - v))) * inv t)) <= + &1 + &8 * inv(pi)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_INV] THEN + SUBGOAL_THEN `abs pi = pi` SUBST1_TAC THENL + [REWRITE_TAC[REAL_ABS_REFL] THEN MP_TAC PI_POS THEN REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `inv(pi) * (pi / &2 + &4 + (pi / &2 + &4))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INV THEN MP_TAC PI_POS THEN REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `(\t. (sin(t * (b - v)) - sin(t * (a - v))) * inv t) = + (\t:real. sin((b-v) * t) * inv t - sin((a-v) * t) * inv t)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + SUBGOAL_THEN `x * (b - v:real) = (b - v) * x` + (fun th -> REWRITE_TAC[th]) THENL [REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `x * (a - v:real) = (a - v) * x` + (fun th -> REWRITE_TAC[th]) THENL [REAL_ARITH_TAC; ALL_TAC] THEN + REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `(\t:real. sin((b-v) * t) * inv t) real_integrable_on + real_interval[&0,TT] /\ + (\t:real. sin((a-v) * t) * inv t) real_integrable_on + real_interval[&0,TT]` ASSUME_TAC THENL + [CONJ_TAC THENL + [ASM_CASES_TAC `b - v = &0` THENL + [ASM_REWRITE_TAC[REAL_MUL_LZERO; SIN_0; REAL_MUL_LZERO; + REAL_INTEGRABLE_0]; + MATCH_MP_TAC SINC_SCALED_INTEGRABLE_NZ THEN ASM_REAL_ARITH_TAC]; + ASM_CASES_TAC `a - v = &0` THENL + [ASM_REWRITE_TAC[REAL_MUL_LZERO; SIN_0; REAL_MUL_LZERO; + REAL_INTEGRABLE_0]; + MATCH_MP_TAC SINC_SCALED_INTEGRABLE_NZ THEN ASM_REAL_ARITH_TAC]]; + ALL_TAC] THEN + SUBGOAL_THEN + `real_integral (real_interval[&0,TT]) + (\t. sin((b-v) * t) * inv t - sin((a-v) * t) * inv t) = + real_integral (real_interval[&0,TT]) (\t. sin((b-v) * t) * inv t) - + real_integral (real_interval[&0,TT]) (\t. sin((a-v) * t) * inv t)` + SUBST1_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_SUB THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(pi / &2 + &4) + (pi / &2 + &4)` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `abs(real_integral (real_interval[&0,TT]) + (\t. sin((b-v) * t) * inv t)) + + abs(real_integral (real_interval[&0,TT]) + (\t. sin((a-v) * t) * inv t))` THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THEN + MATCH_MP_TAC SINC_INTEGRAL_BOUND_ALL THEN ASM_REWRITE_TAC[]; + REAL_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN `inv(pi) * (pi / &2 + &4 + (pi / &2 + &4)) = + inv(pi) * (pi + &8)` SUBST1_TAC THENL + [AP_TERM_TAC THEN REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_ADD_LDISTRIB; REAL_MUL_ASSOC] THEN + SUBGOAL_THEN `inv pi * pi = &1` SUBST1_TAC THENL + [MATCH_MP_TAC REAL_MUL_LINV THEN + MP_TAC PI_POS THEN REAL_ARITH_TAC; ALL_TAC] THEN + REAL_ARITH_TAC);; + +(* Integral of an even function over [-T,T] equals twice the integral over [0,T] *) +let REAL_INTEGRAL_EVEN_SYMMETRIC = prove + (`!f TT. &0 <= TT /\ + (!t. f(--t) = f t) /\ + f real_integrable_on real_interval[--TT, TT] + ==> real_integral (real_interval[--TT, TT]) f = + &2 * real_integral (real_interval[&0, TT]) f`, + REPEAT STRIP_TAC THEN + (* Split integral [-T,T] into [-T,0] + [0,T] *) + SUBGOAL_THEN + `real_integral (real_interval[--TT, TT]) (f:real->real) = + real_integral (real_interval[--TT, &0]) f + + real_integral (real_interval[&0, TT]) f` + SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_INTEGRAL_COMBINE THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + (* Show integral [-T,0] f = integral [0,T] f using reflection *) + SUBGOAL_THEN + `real_integral (real_interval[--TT, &0]) (f:real->real) = + real_integral (real_interval[&0, TT]) f` + SUBST1_TAC THENL + [(* Rewrite f to (\x. f(-x)) using evenness *) + SUBGOAL_THEN + `real_integral (real_interval[--TT, &0]) (f:real->real) = + real_integral (real_interval[--TT, &0]) (\x. f(--x))` + SUBST1_TAC THENL + [AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + (* Apply reflection: int[--T, --0] (\x. f(-x)) = int[0, T] f *) + MP_TAC(ISPECL [`f:real->real`; `&0`; `TT:real`] REAL_INTEGRAL_REFLECT) THEN + REWRITE_TAC[REAL_NEG_0] THEN MESON_TAC[]; + (* x + x = 2*x *) + REAL_ARITH_TAC]);; + +(* The inversion integrand sin(t(b-x))*inv(t) is even in t *) +let INVERSION_SINC_EVEN = prove + (`!a b x t. (sin(--t * (b - x)) - sin(--t * (a - x))) * inv(--t) = + (sin(t * (b - x)) - sin(t * (a - x))) * inv t`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `--t * (b - x) = --(t * (b - x:real))` SUBST1_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `--t * (a - x) = --(t * (a - x:real))` SUBST1_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[SIN_NEG; REAL_INV_NEG] THEN REAL_ARITH_TAC);; + +(* Sequential extraction from at_posinfinity: if f -> l at posinfinity + and s is a sequence with s(n) >= n, then f(s(n)) -> l sequentially *) +let REALLIM_AT_POSINFINITY_IMP_SEQUENTIALLY = prove + (`!f l (s:num->real). (f ---> l) at_posinfinity /\ (!n. s n >= &n) + ==> ((\n. f(s n)) ---> l) sequentially`, + REWRITE_TAC[REALLIM_AT_POSINFINITY; REALLIM_SEQUENTIALLY; real_ge] THEN + REPEAT GEN_TAC THEN STRIP_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `B:real` ASSUME_TAC) THEN + MP_TAC(SPEC `B:real` REAL_ARCH_SIMPLE) THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` ASSUME_TAC) THEN + EXISTS_TAC `N:num` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&n:real` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&N:real` THEN + ASM_REWRITE_TAC[REAL_OF_NUM_LE]; + ASM_REWRITE_TAC[]]);; + +(* Converse: if every divergent subsequence converges to l, + then the at_posinfinity limit is l. Proof by contradiction. *) +let REALLIM_AT_POSINFINITY_FROM_SUBSEQUENCES = prove + (`!f l. (!s:num->real. (!n. s n >= &n) + ==> ((\n. f(s n)) ---> l) sequentially) + ==> (f ---> l) at_posinfinity`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[REALLIM_AT_POSINFINITY] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + (* By contradiction: assume forall B, exists T >= B with |f(T)-l| >= e *) + MATCH_MP_TAC(TAUT `(~p ==> F) ==> p`) THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o REWRITE_RULE[NOT_EXISTS_THM; NOT_FORALL_THM; + NOT_IMP; REAL_NOT_LT]) THEN + REWRITE_TAC[real_ge] THEN + (* Construct bad sequence via Skolem *) + DISCH_THEN(MP_TAC o GEN `n:num` o SPEC `&n:real`) THEN + REWRITE_TAC[SKOLEM_THM] THEN + DISCH_THEN(X_CHOOSE_TAC `s:num->real`) THEN + (* Apply hypothesis to get f(s n) -> l sequentially *) + FIRST_X_ASSUM(MP_TAC o SPEC `s:num->real`) THEN + ANTS_TAC THENL + [GEN_TAC THEN REWRITE_TAC[real_ge] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN MESON_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` MP_TAC) THEN + DISCH_THEN(MP_TAC o SPEC `N:num`) THEN REWRITE_TAC[LE_REFL] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `N:num`) THEN REAL_ARITH_TAC);; + +(* Inversion kernel at boundary v=a: converges to 1/2 *) +let INVERSION_KERNEL_CONVERGES_AT_A = prove + (`!a b. a < b ==> + ((\TT. inv(pi) * real_integral (real_interval[&0,TT]) + (\t. (sin(t * (b - a)) - sin(t * (a - a))) * inv t)) + ---> inv(&2)) at_posinfinity`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `a - a = &0` SUBST1_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_MUL_RZERO; SIN_0; REAL_SUB_RZERO] THEN + SUBGOAL_THEN `&0 < b - a` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `~(pi = &0)` ASSUME_TAC THENL + [MP_TAC PI_POS THEN REAL_ARITH_TAC; ALL_TAC] THEN + GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV) + [MATCH_MP (REAL_FIELD `~(pi = &0) ==> inv(&2) = inv(pi) * (pi / &2)`) + (ASSUME `~(pi = &0)`)] THEN + MATCH_MP_TAC REALLIM_LMUL THEN + MATCH_MP_TAC REALLIM_TRANSFORM_EVENTUALLY THEN + EXISTS_TAC `\TT. real_integral (real_interval[&0,TT]) + (\t. sin((b - a) * t) * inv t)` THEN + CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_AT_POSINFINITY] THEN + EXISTS_TAC `&1` THEN X_GEN_TAC `TT:real` THEN + REWRITE_TAC[real_ge] THEN DISCH_TAC THEN BETA_TAC THEN + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN REAL_ARITH_TAC; + MATCH_MP_TAC(SPEC `b - a:real` DIRICHLET_INTEGRAL_SCALED) THEN + ASM_REAL_ARITH_TAC]);; + +(* Inversion kernel at boundary v=b: converges to 1/2 *) +let INVERSION_KERNEL_CONVERGES_AT_B = prove + (`!a b. a < b ==> + ((\TT. inv(pi) * real_integral (real_interval[&0,TT]) + (\t. (sin(t * (b - b)) - sin(t * (a - b))) * inv t)) + ---> inv(&2)) at_posinfinity`, + REPEAT STRIP_TAC THEN + (* Reduce to AT_A case: both integrands equal sin(t*(b-a))*inv(t) *) + MATCH_MP_TAC REALLIM_TRANSFORM_EVENTUALLY THEN + EXISTS_TAC `\TT. inv(pi) * real_integral (real_interval[&0,TT]) + (\t. (sin(t * (b - a)) - sin(t * (a - a))) * inv t)` THEN + CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_AT_POSINFINITY] THEN + EXISTS_TAC `&1` THEN X_GEN_TAC `TT:real` THEN + REWRITE_TAC[real_ge] THEN DISCH_TAC THEN BETA_TAC THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN + X_GEN_TAC `t:real` THEN + SUBGOAL_THEN `t * (b - b:real) = &0` SUBST1_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `t * (a - a:real) = &0` SUBST1_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `t * (a - b:real) = --(t * (b - a))` SUBST1_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[SIN_0; SIN_NEG] THEN REAL_ARITH_TAC; + MATCH_MP_TAC INVERSION_KERNEL_CONVERGES_AT_A THEN ASM_REWRITE_TAC[]]);; + +(* CDF continuity at a point implies zero probability mass there. + If distribution_fn p X is continuous at a, then P(X = a) = 0. + Proof: {X = a} = INTERS_n {a - 1/(n+1) < X <= a} (decreasing events), + P of each = F(a) - F(a - 1/(n+1)) -> 0 by continuity, so P(X=a) = 0. *) +let DISTRIBUTION_FN_CONTINUOUS_PROB_ZERO = prove + (`!p:A prob_space X a. + random_variable p X /\ + (distribution_fn p X) real_continuous (atreal a) + ==> prob p {x | x IN prob_carrier p /\ X x = a} = &0`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `{x:A | x IN prob_carrier p /\ X x = a} = + {x | x IN prob_carrier p /\ X x <= a} DIFF + {x | x IN prob_carrier p /\ X x < a}` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_DIFF; IN_ELIM_THM] THEN + GEN_TAC THEN ASM_CASES_TAC `(x:A) IN prob_carrier p` THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `{x:A | x IN prob_carrier p /\ X x < a} SUBSET + {x | x IN prob_carrier p /\ X x <= a}` ASSUME_TAC THENL + [REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `{x:A | x IN prob_carrier p /\ X x < a} IN prob_events p` + ASSUME_TAC THENL + [MATCH_MP_TAC RV_PREIMAGE_LT THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `{x:A | x IN prob_carrier p /\ X x <= a} IN prob_events p` + ASSUME_TAC THENL + [FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [random_variable]) THEN + DISCH_THEN(MP_TAC o SPEC `a:real`) THEN REWRITE_TAC[]; + ALL_TAC] THEN + ASM_SIMP_TAC[PROB_DIFF_SUBSET] THEN + REWRITE_TAC[GSYM distribution_fn] THEN + MATCH_MP_TAC(REAL_ARITH `x = y ==> y - x = &0`) THEN + MATCH_MP_TAC(ISPEC `sequentially` REALLIM_UNIQUE) THEN + EXISTS_TAC `\n. distribution_fn (p:A prob_space) X (a - &1 / &(SUC n))` THEN + REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN CONJ_TAC THENL + [REWRITE_TAC[distribution_fn] THEN + MATCH_MP_TAC PROB_STRICT_INEQ_LIMIT THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC REALLIM_CONTINUOUS_FUNCTION THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(SPEC `inv(e:real)` REAL_ARCH_SIMPLE) THEN + DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `N:num` THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN + REWRITE_TAC[REAL_ARITH `(a - x) - a:real = --x`; REAL_ABS_NEG; + real_div; REAL_MUL_LID; REAL_ABS_INV; REAL_ABS_NUM] THEN + SUBGOAL_THEN `inv(e:real) < &(SUC n)` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `&n:real` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&N:real` THEN + ASM_REWRITE_TAC[REAL_OF_NUM_LE] THEN ASM_ARITH_TAC; + REWRITE_TAC[REAL_OF_NUM_LT] THEN ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < inv(e:real)` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LT_INV THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MP_TAC(SPECL [`inv(e:real)`; `&(SUC n)`] REAL_LT_INV2) THEN + ASM_REWRITE_TAC[REAL_INV_INV]]);; + +(* Random variable property of the inversion kernel g_T(X). + g_T(v) = inv(pi) * int_0^T (sin(t(b-v)) - sin(t(a-v)))/t dt + is continuous in v (parametric integral of jointly continuous integrand + over compact [0,T]), so g_T o X is a random variable when X is. *) +let INVERSION_KERNEL_RV = prove + (`!p:A prob_space X a b TT. + random_variable p X /\ &0 <= TT /\ a < b ==> + random_variable p (\x. inv(pi) * real_integral (real_interval[&0,TT]) + (\t. (sin(t * (b - X x)) - sin(t * (a - X x))) * inv t))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + ASM_CASES_TAC `TT = &0` THENL + [ASM_REWRITE_TAC[REAL_INTEGRAL_REFL; REAL_MUL_RZERO] THEN + REWRITE_TAC[RANDOM_VARIABLE_CONST]; ALL_TAC] THEN + SUBGOAL_THEN `&0 < TT` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC(BETA_RULE(ISPECL [`p:A prob_space`; `X:A->real`; + `\v:real. inv(pi) * real_integral (real_interval[&0,TT]) + (\t. (sin(t * (b - v)) - sin(t * (a - v))) * inv t)`] + RANDOM_VARIABLE_COMP_CONTINUOUS)) THEN + ASM_REWRITE_TAC[] THEN + (* Need: (\v. inv(pi) * int_0^T ...) real_continuous_on (:real) *) + MATCH_MP_TAC REAL_CONTINUOUS_ON_LMUL THEN + SIMP_TAC[REAL_CONTINUOUS_ON_EQ_REAL_CONTINUOUS_AT; REAL_OPEN_UNIV; + IN_UNIV] THEN + X_GEN_TAC `v:real` THEN + REWRITE_TAC[REAL_CONTINUOUS_ATREAL; REALLIM_ATREAL] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + EXISTS_TAC `e / (&2 * TT)` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LT_DIV THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LT_MUL THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + X_GEN_TAC `w:real` THEN STRIP_TAC THEN + (* |int_0^T f(t,v) dt - int_0^T f(t,w) dt| <= int_0^T |f(t,v)-f(t,w)| dt + <= int_0^T 2*|v-w| dt = 2*T*|v-w| < 2*T*(e/(2T)) = e *) + (* Step 1: Establish integrability of both integrands *) + SUBGOAL_THEN + `!u:real. (\t. (sin(t * (b - u)) - sin(t * (a - u))) * inv t) + real_integrable_on real_interval[&0,TT]` + ASSUME_TAC THENL + [GEN_TAC THEN + SUBGOAL_THEN `(\t:real. (sin(t * (b - u)) - sin(t * (a - u))) * inv t) = + (\t. sin((b - u) * t) * inv t - sin((a - u) * t) * inv t)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `t:real` THEN + SUBGOAL_THEN `t * (b - u:real) = (b - u) * t` (fun th -> REWRITE_TAC[th]) THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `t * (a - u:real) = (a - u) * t` (fun th -> REWRITE_TAC[th]) THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_INTEGRABLE_SUB THEN CONJ_TAC THENL + [ASM_CASES_TAC `b - u = &0` THENL + [ASM_REWRITE_TAC[REAL_MUL_LZERO; SIN_0; REAL_MUL_LZERO; + REAL_INTEGRABLE_0]; + MATCH_MP_TAC SINC_SCALED_INTEGRABLE_NZ THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC]; + ASM_CASES_TAC `a - u = &0` THENL + [ASM_REWRITE_TAC[REAL_MUL_LZERO; SIN_0; REAL_MUL_LZERO; + REAL_INTEGRABLE_0]; + MATCH_MP_TAC SINC_SCALED_INTEGRABLE_NZ THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC]]; + ALL_TAC] THEN + (* Step 2: Bound abs of integral difference *) + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `(&2 * abs(v - w)) * TT` THEN CONJ_TAC THENL + [SUBGOAL_THEN + `real_integral (real_interval[&0,TT]) + (\t. (sin(t * (b - w)) - sin(t * (a - w))) * inv t) - + real_integral (real_interval[&0,TT]) + (\t. (sin(t * (b - v)) - sin(t * (a - v))) * inv t) = + real_integral (real_interval[&0,TT]) + (\t. ((sin(t * (b - w)) - sin(t * (a - w))) * inv t) - + ((sin(t * (b - v)) - sin(t * (a - v))) * inv t))` + SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_INTEGRAL_SUB THEN + CONJ_TAC THEN FIRST_ASSUM MATCH_ACCEPT_TAC; ALL_TAC] THEN + (* Apply HAS_REAL_INTEGRAL_BOUND: abs(i) <= B * (b - a) *) + MP_TAC(ISPECL + [`\t:real. ((sin(t * (b - w)) - sin(t * (a - w))) * inv t) - + ((sin(t * (b - v)) - sin(t * (a - v))) * inv t)`; + `&0`; `TT:real`; + `real_integral (real_interval[&0,TT]) + (\t:real. ((sin(t * (b - w)) - sin(t * (a - w))) * inv t) - + ((sin(t * (b - v)) - sin(t * (a - v))) * inv t))`; + `&2 * abs(v - w:real)`] HAS_REAL_INTEGRAL_BOUND) THEN + REWRITE_TAC[REAL_SUB_RZERO] THEN ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [REAL_ARITH_TAC; REWRITE_TAC[REAL_ABS_POS]]; + ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_INTEGRABLE_INTEGRAL THEN + MATCH_MP_TAC REAL_INTEGRABLE_SUB THEN + CONJ_TAC THEN FIRST_ASSUM MATCH_ACCEPT_TAC; + (* Bound: |f_w(t) - f_v(t)| <= 2*|v-w| for all t in [0,TT] *) + X_GEN_TAC `t:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN + DISCH_TAC THEN + ASM_CASES_TAC `t = &0` THENL + [ASM_REWRITE_TAC[REAL_MUL_LZERO; SIN_0; REAL_SUB_REFL; + REAL_MUL_LZERO; REAL_SUB_REFL; REAL_ABS_NUM] THEN + MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [REAL_ARITH_TAC; REWRITE_TAC[REAL_ABS_POS]]; ALL_TAC] THEN + SUBGOAL_THEN `&0 < t` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + (* Factor out inv t from the difference *) + REWRITE_TAC[REAL_ARITH `!a b c d e:real. + (a - b) * c - (d - e) * c = ((a - d) - (b - e)) * c`] THEN + REWRITE_TAC[REAL_ABS_MUL] THEN + SUBGOAL_THEN `abs(inv t) = inv t` SUBST1_TAC THENL + [REWRITE_TAC[REAL_ABS_REFL] THEN MATCH_MP_TAC REAL_LE_INV THEN + ASM_REAL_ARITH_TAC; ALL_TAC] THEN + (* Use triangle: |x - y| <= |x| + |y| *) + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(abs(sin(t * (b - w)) - sin(t * (b - v))) + + abs(sin(t * (a - w)) - sin(t * (a - v)))) * inv t` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_RMUL THEN CONJ_TAC THENL + [REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LE_INV THEN ASM_REAL_ARITH_TAC]; ALL_TAC] THEN + (* Use SIN_LIPSCHITZ: |sin a - sin b| <= |a - b| *) + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(abs(t * (b - w) - t * (b - v)) + + abs(t * (a - w) - t * (a - v))) * inv t` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_RMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_ADD2 THEN REWRITE_TAC[SIN_LIPSCHITZ]; + MATCH_MP_TAC REAL_LE_INV THEN ASM_REAL_ARITH_TAC]; ALL_TAC] THEN + (* Simplify: t*(b-w) - t*(b-v) = t*(v-w), same for a *) + SUBGOAL_THEN `t * (b - w) - t * (b - v) = t * (v - w:real)` + SUBST1_TAC THENL [CONV_TAC REAL_RING; ALL_TAC] THEN + SUBGOAL_THEN `t * (a - w) - t * (a - v) = t * (v - w:real)` + SUBST1_TAC THENL [CONV_TAC REAL_RING; ALL_TAC] THEN + REWRITE_TAC[REAL_ABS_MUL] THEN + SUBGOAL_THEN `abs t = t` SUBST1_TAC THENL + [REWRITE_TAC[REAL_ABS_REFL] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `(t * abs(v - w) + t * abs(v - w)) * inv t = + &2 * abs(v - w:real)` + (fun th -> REWRITE_TAC[th; REAL_LE_REFL]) THEN + UNDISCH_TAC `&0 < t` THEN CONV_TAC REAL_FIELD]; + SIMP_TAC[]]; + (* Step 3: (&2*|v-w|)*TT < e *) + REWRITE_TAC[REAL_ABS_SUB] THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN + EXISTS_TAC `(&2 * (e / (&2 * TT))) * TT` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LT_RMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LT_LMUL THEN CONJ_TAC THENL + [REAL_ARITH_TAC; + UNDISCH_TAC `abs(w - v:real) < e / (&2 * TT)` THEN REAL_ARITH_TAC]; + UNDISCH_TAC `&0 < TT` THEN REAL_ARITH_TAC]; + MATCH_MP_TAC REAL_EQ_IMP_LE THEN + UNDISCH_TAC `&0 < TT` THEN CONV_TAC REAL_FIELD]]);; + +(* Helper: integrability of the inversion kernel on [0,TT] for any a,b,v,TT *) +let SINC_SCALED_DIFF_INTEGRABLE = prove + (`!a b v TT. &0 <= TT ==> + (\t. (sin(t * (b - v)) - sin(t * (a - v))) * inv t) + real_integrable_on real_interval[&0,TT]`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(\t:real. (sin(t * (b - v)) - sin(t * (a - v))) * inv t) = + (\t. sin((b - v) * t) * inv t - sin((a - v) * t) * inv t)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `t:real` THEN + SUBGOAL_THEN `t * (b - v:real) = (b - v) * t` (fun th -> REWRITE_TAC[th]) THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `t * (a - v:real) = (a - v) * t` (fun th -> REWRITE_TAC[th]) THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_INTEGRABLE_SUB THEN CONJ_TAC THENL + [ASM_CASES_TAC `b - v = &0` THENL + [ASM_REWRITE_TAC[REAL_MUL_LZERO; SIN_0; REAL_MUL_LZERO; + REAL_INTEGRABLE_0]; + MATCH_MP_TAC SINC_SCALED_INTEGRABLE_NZ THEN + ASM_REWRITE_TAC[]]; + ASM_CASES_TAC `a - v = &0` THENL + [ASM_REWRITE_TAC[REAL_MUL_LZERO; SIN_0; REAL_MUL_LZERO; + REAL_INTEGRABLE_0]; + MATCH_MP_TAC SINC_SCALED_INTEGRABLE_NZ THEN + ASM_REWRITE_TAC[]]]);; + +(* Helper: integral over [0,(n+1)*h] = sum of integrals over subintervals *) +let INTEGRAL_SPLIT_NUMSEG = prove + (`!f h n. &0 < h /\ f real_integrable_on real_interval[&0, &(SUC n) * h] + ==> real_integral (real_interval[&0, &(SUC n) * h]) f = + sum(0..n) (\k. real_integral (real_interval[&k * h, &(SUC k) * h]) f)`, + GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THENL + [STRIP_TAC THEN REWRITE_TAC[SUM_SING_NUMSEG] THEN + REWRITE_TAC[REAL_MUL_LZERO; REAL_MUL_LID; ARITH_RULE `SUC 0 = 1`]; + STRIP_TAC THEN + SUBGOAL_THEN `&(SUC(SUC n)) * h = &(SUC n) * h + h` SUBST1_TAC THENL + [REWRITE_TAC[GSYM REAL_OF_NUM_SUC; REAL_ADD_RDISTRIB; REAL_MUL_LID]; + ALL_TAC] THEN + SUBGOAL_THEN `real_integral (real_interval [&0,&(SUC n) * h + h]) f = + real_integral (real_interval [&0, &(SUC n) * h]) f + + real_integral (real_interval [&(SUC n) * h, &(SUC n) * h + h]) f` + SUBST1_TAC THENL + [MATCH_MP_TAC(GSYM REAL_INTEGRAL_COMBINE) THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_POS] THEN + ASM_REAL_ARITH_TAC; ALL_TAC] THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `real_interval[&0, &(SUC(SUC n)) * h]` THEN + ASM_REWRITE_TAC[SUBSET_REAL_INTERVAL; GSYM REAL_OF_NUM_SUC] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[SUM_CLAUSES_NUMSEG; LE_0] THEN + SUBGOAL_THEN `real_integral (real_interval [&0,&(SUC n) * h]) f = + sum (0..n) (\k. real_integral (real_interval [&k * h,&(SUC k) * h]) f)` + SUBST1_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `real_interval[&0, &(SUC(SUC n)) * h]` THEN + ASM_REWRITE_TAC[SUBSET_REAL_INTERVAL; GSYM REAL_OF_NUM_SUC] THEN + ASM_REAL_ARITH_TAC; + SUBGOAL_THEN `&(SUC n) * h + h = &(SUC(SUC n)) * h` + (fun th -> REWRITE_TAC[th]) THEN + REWRITE_TAC[GSYM REAL_OF_NUM_SUC; REAL_ADD_RDISTRIB; REAL_MUL_LID]]]);; + +(* Riemann sum convergence for bounded functions continuous on (0,TT]. + Uses uniform continuity on [eta,TT] plus epsilon-delta. *) +let RIEMANN_SUM_CONVERGES = prove + (`!f TT M. + f real_integrable_on real_interval[&0,TT] /\ + &0 < TT /\ &0 < M /\ + (!t. t IN real_interval[&0,TT] ==> abs(f t) <= M) /\ + (!t. t IN real_interval[&0,TT] /\ &0 < t ==> + f real_continuous (atreal t within real_interval[&0,TT])) + ==> ((\n. sum(0..n) (\k. TT / &(SUC n) * + f(&k * TT / &(SUC n)))) ---> + real_integral (real_interval[&0,TT]) f) sequentially`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + ABBREV_TAC `eta = min (TT / &2) (e / (&8 * M))` THEN + (* Establish properties of eta *) + SUBGOAL_THEN `&0 < eta /\ eta <= TT / &2 /\ eta <= e / (&8 * M)` + STRIP_ASSUME_TAC THENL + [EXPAND_TAC "eta" THEN + ASM_SIMP_TAC[REAL_LT_MIN; REAL_LE_MIN; REAL_LT_DIV; REAL_LT_MUL; + REAL_ARITH `&0 < &2`; REAL_ARITH `&0 < &8`; + REAL_ARITH `min a b <= a /\ min a b <= b`] THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_MUL; REAL_ARITH `&0 < &8`]; + ALL_TAC] THEN + (* f is continuous on [eta, TT] *) + SUBGOAL_THEN `f real_continuous_on real_interval[eta,TT]` ASSUME_TAC THENL + [REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN] THEN + X_GEN_TAC `t:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN + DISCH_TAC THEN + MATCH_MP_TAC REAL_CONTINUOUS_WITHINREAL_SUBSET THEN + EXISTS_TAC `real_interval[&0,TT]` THEN CONJ_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[IN_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + (* f is uniformly continuous on [eta, TT] *) + SUBGOAL_THEN `f real_uniformly_continuous_on real_interval[eta,TT]` + ASSUME_TAC THENL + [MATCH_MP_TAC REAL_COMPACT_UNIFORMLY_CONTINUOUS THEN + ASM_REWRITE_TAC[REAL_COMPACT_INTERVAL]; + ALL_TAC] THEN + (* Get delta from uniform continuity *) + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [real_uniformly_continuous_on]) THEN + DISCH_THEN(MP_TAC o SPEC `e / (&2 * TT)`) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_MUL; REAL_ARITH `&0 < &2`]; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN + (* Choose N *) + MP_TAC(SPEC `TT / min eta d` REAL_ARCH_SIMPLE) THEN + DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN + EXISTS_TAC `N:num` THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN + ABBREV_TAC `h = TT / &(SUC n)` THEN + (* Key properties of h *) + SUBGOAL_THEN `&0 < h /\ h < eta /\ h < d` STRIP_ASSUME_TAC THENL + [SUBGOAL_THEN `&0 < &(SUC n)` ASSUME_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_LT; LT_0]; ALL_TAC] THEN + SUBGOAL_THEN `&0 < min eta d` ASSUME_TAC THENL + [ASM_REWRITE_TAC[REAL_LT_MIN]; ALL_TAC] THEN + SUBGOAL_THEN `TT / &(SUC n) < min eta d` ASSUME_TAC THENL + [SUBGOAL_THEN `TT / min eta d < &(SUC n)` MP_TAC THENL + [MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `&N` THEN + ASM_REWRITE_TAC[REAL_OF_NUM_LT] THEN ASM_ARITH_TAC; + ASM_SIMP_TAC[REAL_LT_LDIV_EQ] THEN DISCH_TAC THEN + ASM_SIMP_TAC[REAL_LT_RDIV_EQ] THEN ASM_REAL_ARITH_TAC]; + ASM_MESON_TAC[REAL_LT_MIN; REAL_LT_DIV]]; + ALL_TAC] THEN + SUBGOAL_THEN `&(SUC n) * h = TT` ASSUME_TAC THENL + [EXPAND_TAC "h" THEN + ASM_SIMP_TAC[REAL_DIV_LMUL; REAL_OF_NUM_EQ; NOT_SUC]; ALL_TAC] THEN + (* Use INTEGRAL_SPLIT_NUMSEG *) + SUBGOAL_THEN + `real_integral (real_interval [&0,TT]) f = + sum(0..n) (\k. real_integral (real_interval[&k * h, &(SUC k) * h]) f)` + ASSUME_TAC THENL + [MP_TAC(ISPECL [`f:real->real`; `h:real`; `n:num`] INTEGRAL_SPLIT_NUMSEG) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + (* Rewrite the difference as a sum *) + SUBGOAL_THEN + `sum(0..n) (\k. h * f(&k * h)) - + real_integral (real_interval [&0,TT]) f = + sum(0..n) (\k. h * f(&k * h) - + real_integral (real_interval[&k * h, &(SUC k) * h]) f)` + SUBST1_TAC THENL + [ASM_REWRITE_TAC[GSYM SUM_SUB_NUMSEG]; ALL_TAC] THEN + (* Find cutoff index p *) + SUBGOAL_THEN `?p. p <= n /\ &p * h < eta /\ eta <= &(SUC p) * h` + STRIP_ASSUME_TAC THENL + [MP_TAC(ISPEC `\k. k <= n /\ eta <= &k * h` num_WOP) THEN + DISCH_THEN(MP_TAC o fst o EQ_IMP_RULE) THEN + ANTS_TAC THENL + [EXISTS_TAC `n:num` THEN REWRITE_TAC[] THEN + CONJ_TAC THENL + [ARITH_TAC; + UNDISCH_TAC `&(SUC n) * h = TT` THEN + REWRITE_TAC[GSYM REAL_OF_NUM_SUC; REAL_ADD_RDISTRIB; REAL_MUL_LID] THEN + UNDISCH_TAC `h < eta` THEN UNDISCH_TAC `eta <= TT / &2` THEN + REAL_ARITH_TAC]; + ALL_TAC] THEN + REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `q:num` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `0 < q` ASSUME_TAC THENL + [ASM_CASES_TAC `q = 0` THEN ASM_REWRITE_TAC[] THENL + [UNDISCH_TAC `eta <= &q * h` THEN + ASM_REWRITE_TAC[REAL_MUL_LZERO] THEN ASM_REAL_ARITH_TAC; + ASM_ARITH_TAC]; + ALL_TAC] THEN + EXISTS_TAC `q - 1` THEN + SUBGOAL_THEN `SUC(q - 1) = q` ASSUME_TAC THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `q - 1`) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[DE_MORGAN_THM; NOT_LE; REAL_NOT_LE] THEN + DISCH_THEN DISJ_CASES_TAC THENL + [ASM_ARITH_TAC; ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + (* Split the sum at index p *) + SUBGOAL_THEN + `sum(0..n) (\k. h * f(&k * h) - + real_integral (real_interval[&k * h, &(SUC k) * h]) f) = + sum(0..p) (\k. h * f(&k * h) - + real_integral (real_interval[&k * h, &(SUC k) * h]) f) + + sum(p + 1..n) (\k. h * f(&k * h) - + real_integral (real_interval[&k * h, &(SUC k) * h]) f)` + SUBST1_TAC THENL + [MATCH_MP_TAC(GSYM SUM_COMBINE_R) THEN ASM_ARITH_TAC; ALL_TAC] THEN + (* Bound: |A + B| <= |A| + |B| < 4*M*eta + e/2 <= e *) + MATCH_MP_TAC(REAL_ARITH + `abs a < &4 * M * eta /\ abs b <= e / &2 /\ &4 * M * eta + e / &2 <= e + ==> abs(a + b) < e`) THEN + REPEAT CONJ_TAC THENL + [(* Bound for near-zero part: |sum(0..p)(...)| < 4*M*eta *) + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `sum(0..p) (\k. abs(h * (f:real->real)(&k * h) - + real_integral (real_interval[&k * h, &(SUC k) * h]) f))` THEN + CONJ_TAC THENL [MATCH_MP_TAC SUM_ABS_LE THEN REWRITE_TAC[FINITE_NUMSEG; REAL_LE_REFL]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `sum(0..p) (\k. &2 * M * h)` THEN CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE_NUMSEG THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN + BETA_TAC THEN + (* Each |h*f(kh) - integral[kh,(k+1)h] f| <= 2*M*h *) + MATCH_MP_TAC(REAL_ARITH + `abs a <= M * h /\ abs b <= M * h ==> abs(a - b) <= &2 * M * h`) THEN + CONJ_TAC THENL + [(* |h * f(kh)| <= M * h *) + REWRITE_TAC[REAL_ABS_MUL] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < h ==> abs h = h`] THEN + GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN + ASM_SIMP_TAC[REAL_LE_LMUL_EQ] THEN + SUBGOAL_THEN `&k * h IN real_interval[&0,TT]` MP_TAC THENL + [REWRITE_TAC[IN_REAL_INTERVAL] THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_POS] THEN + ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&(SUC n) * h` THEN + CONJ_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[REAL_LE_REFL]] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN + REWRITE_TAC[REAL_OF_NUM_LE] THEN ASM_ARITH_TAC]; + ASM_MESON_TAC[]]; + (* |integral[kh,(k+1)h] f| <= M * h *) + MP_TAC(ISPECL [`f:real->real`; `&k * h`; `&(SUC k) * h`; + `real_integral (real_interval[&k * h, &(SUC k) * h]) f`; + `M:real`] HAS_REAL_INTEGRAL_BOUND) THEN + ANTS_TAC THENL + [CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_RMUL THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_LE] THEN ARITH_TAC; + ASM_REAL_ARITH_TAC]; ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_INTEGRAL THEN + MATCH_MP_TAC REAL_INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `real_interval[&0,TT]` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN + DISJ2_TAC THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_POS] THEN + ASM_REAL_ARITH_TAC; + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_RMUL THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_LE] THEN ARITH_TAC; + ASM_REAL_ARITH_TAC]; + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&(SUC n) * h` THEN + CONJ_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[REAL_LE_REFL]] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN + REWRITE_TAC[REAL_OF_NUM_LE] THEN ASM_ARITH_TAC]]; + X_GEN_TAC `t:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN + DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[IN_REAL_INTERVAL] THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&k * h` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_MUL THEN + REWRITE_TAC[REAL_POS] THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&(SUC k) * h` THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&(SUC n) * h` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_RMUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN + REWRITE_TAC[REAL_OF_NUM_LE] THEN ASM_ARITH_TAC; + ASM_REWRITE_TAC[REAL_LE_REFL]]]]; + REWRITE_TAC[GSYM REAL_OF_NUM_SUC; REAL_ADD_RDISTRIB; REAL_MUL_LID] THEN + REAL_ARITH_TAC]]; + (* (p+1) * 2*M*h < 4*M*eta *) + REWRITE_TAC[SUM_CONST_NUMSEG; SUB_0] THEN + SUBGOAL_THEN `&(p + 1) * h < &2 * eta` ASSUME_TAC THENL + [REWRITE_TAC[GSYM REAL_OF_NUM_ADD; REAL_ADD_RDISTRIB; REAL_MUL_LID] THEN + ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `&(p + 1) * (&2 * M * h) = &2 * M * (&(p + 1) * h)` + SUBST1_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `&4 * M * eta = &2 * M * (&2 * eta)` + SUBST1_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LT_LMUL THEN CONJ_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LT_LMUL THEN CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; ASM_REAL_ARITH_TAC]]; + (* Bound for far part: |sum(p+1..n)(...)| <= e/2 *) + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(p + 1..n) (\k. abs(h * (f:real->real)(&k * h) - + real_integral (real_interval[&k * h, &(SUC k) * h]) f))` THEN + CONJ_TAC THENL [MATCH_MP_TAC SUM_ABS_LE THEN REWRITE_TAC[FINITE_NUMSEG; REAL_LE_REFL]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(p + 1..n) (\k. (e / (&2 * TT)) * h)` THEN CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE_NUMSEG THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN + BETA_TAC THEN + (* For k >= p+1: kh >= eta, use uniform continuity *) + SUBGOAL_THEN `eta <= &k * h` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&(SUC p) * h` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_RMUL THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN + REWRITE_TAC[REAL_OF_NUM_LE] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + (* |h*f(kh) - integral[kh,(k+1)h]f| = |integral (\t. f(kh) - f(t))| *) + SUBGOAL_THEN `h * (f:real->real)(&k * h) - + real_integral (real_interval[&k * h, &(SUC k) * h]) f = + real_integral (real_interval[&k * h, &(SUC k) * h]) + (\t. f(&k * h) - f t)` SUBST1_TAC THENL + [SUBGOAL_THEN `f real_integrable_on real_interval[&k * h, &(SUC k) * h]` + ASSUME_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `real_interval[&0,TT]` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN DISJ2_TAC THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_POS] THEN + ASM_REAL_ARITH_TAC; + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_RMUL THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_LE] THEN ARITH_TAC; + ASM_REAL_ARITH_TAC]; + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&(SUC n) * h` THEN + CONJ_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[REAL_LE_REFL]] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN + REWRITE_TAC[REAL_OF_NUM_LE] THEN ASM_ARITH_TAC]]; + ALL_TAC] THEN + ASM_SIMP_TAC[REAL_INTEGRAL_SUB; REAL_INTEGRABLE_CONST] THEN + SUBGOAL_THEN `&k * h <= &(SUC k) * h` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_RMUL THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_LE] THEN ARITH_TAC; + ASM_REAL_ARITH_TAC]; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_INTEGRAL_CONST] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_SUC; REAL_ADD_RDISTRIB; REAL_MUL_LID] THEN + CONV_TAC REAL_RING; + ALL_TAC] THEN + (* Bound using HAS_REAL_INTEGRAL_BOUND *) + MP_TAC(ISPECL + [`\t. (f:real->real)(&k * h) - f t`; + `&k * h`; `&(SUC k) * h`; + `real_integral (real_interval[&k * h, &(SUC k) * h]) + (\t. (f:real->real)(&k * h) - f t)`; + `e / (&2 * TT)`] + HAS_REAL_INTEGRAL_BOUND) THEN + ANTS_TAC THENL + [CONJ_TAC THENL [ASM_SIMP_TAC[REAL_LT_IMP_LE; REAL_LT_DIV; + REAL_LT_MUL; REAL_ARITH `&0 < &2`]; ALL_TAC] THEN + CONJ_TAC THENL + [REWRITE_TAC[GSYM REAL_OF_NUM_SUC; REAL_ADD_RDISTRIB; REAL_MUL_LID] THEN + ASM_REAL_ARITH_TAC; ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_INTEGRAL THEN + MATCH_MP_TAC REAL_INTEGRABLE_SUB THEN + REWRITE_TAC[REAL_INTEGRABLE_CONST] THEN + MATCH_MP_TAC REAL_INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `real_interval[&0,TT]` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN DISJ2_TAC THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_POS] THEN + ASM_REAL_ARITH_TAC; + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_RMUL THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_LE] THEN ARITH_TAC; + ASM_REAL_ARITH_TAC]; + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&(SUC n) * h` THEN + CONJ_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[REAL_LE_REFL]] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN + REWRITE_TAC[REAL_OF_NUM_LE] THEN ASM_ARITH_TAC]]; + ALL_TAC] THEN + (* Bound |f(kh) - f(t)| < e/(2*TT) using uniform continuity *) + X_GEN_TAC `t:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN + DISCH_TAC THEN REWRITE_TAC[REAL_ABS_SUB] THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[IN_REAL_INTERVAL] THEN + REPEAT CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&(SUC n) * h` THEN + CONJ_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[REAL_LE_REFL]] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN + ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN + REWRITE_TAC[REAL_OF_NUM_LE] THEN ASM_ARITH_TAC; + ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&(SUC k) * h` THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&(SUC n) * h` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_RMUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE] THEN + REWRITE_TAC[REAL_OF_NUM_LE] THEN ASM_ARITH_TAC; + ASM_REWRITE_TAC[REAL_LE_REFL]]; + REWRITE_TAC[REAL_ABS_SUB] THEN + MATCH_MP_TAC(REAL_ARITH `a <= t /\ t <= a + h /\ h < d + ==> abs(t - a) < d`) THEN + ASM_REWRITE_TAC[GSYM REAL_OF_NUM_SUC; REAL_ADD_RDISTRIB; + REAL_MUL_LID] THEN + UNDISCH_TAC `&k * h <= t /\ t <= &(SUC k) * h` THEN + REWRITE_TAC[GSYM REAL_OF_NUM_SUC; REAL_ADD_RDISTRIB; REAL_MUL_LID] THEN + REAL_ARITH_TAC]; + MATCH_MP_TAC(REAL_ARITH `a = b ==> x <= a ==> x <= b`) THEN + REWRITE_TAC[GSYM REAL_OF_NUM_SUC; REAL_ADD_RDISTRIB; REAL_MUL_LID] THEN + REAL_ARITH_TAC]; + (* Sum of (e/(2*TT))*h over (SUC p)..n <= e/2 *) + REWRITE_TAC[SUM_CONST_NUMSEG] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&(SUC n) * (e / (&2 * TT)) * h` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_RMUL THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_LE] THEN ARITH_TAC; + MATCH_MP_TAC REAL_LT_IMP_LE THEN MATCH_MP_TAC REAL_LT_MUL THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_MUL; REAL_ARITH `&0 < &2`]]; + SUBGOAL_THEN `&(SUC n) * (e / (&2 * TT)) * h = e / &2` + (fun th -> REWRITE_TAC[th]) THENL + [UNDISCH_TAC `&(SUC n) * h = TT` THEN + UNDISCH_TAC `&0 < TT` THEN + CONV_TAC REAL_FIELD; + REAL_ARITH_TAC]]]; + (* 4*M*eta + e/2 <= e, from eta <= e/(8*M) *) + MATCH_MP_TAC(REAL_ARITH + `x <= e / &2 ==> x + e / &2 <= e`) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&4 * M * (e / (&8 * M))` THEN + CONJ_TAC THENL + [REWRITE_TAC[REAL_MUL_ASSOC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN ASM_REAL_ARITH_TAC; + ASM_REWRITE_TAC[]]; + SUBGOAL_THEN `&4 * M * (e / (&8 * M)) = e / &2` (fun th -> REWRITE_TAC[th]) THENL + [UNDISCH_TAC `&0 < M` THEN CONV_TAC REAL_FIELD; REAL_ARITH_TAC]]]);; + + +(* Fubini exchange for bounded kernels: int_[0,TT] E[h(t,X)] = E[int_[0,TT] h(t,X)] + Uses: REALLIM_UNIQUE with Riemann sums as common sequence. + Branch 1: Riemann sums -> LHS via RIEMANN_SUM_CONVERGES + Branch 2: Riemann sums -> RHS via BOUNDED_CONVERGENCE_EXPECTATION_GEN + Extra hypotheses: integrability and continuity of t -> E[h(t,X)] *) +let INTEGRAL_EXPECTATION_EXCHANGE = prove + (`!p:A prob_space X (h:real->real->real) TT M. + random_variable p X /\ &0 < TT /\ &0 < M /\ + (!t v. abs(h t v) <= M) /\ + (!v. (\t. h t v) real_integrable_on real_interval[&0,TT]) /\ + (!t. integrable p (\x. h t (X x))) /\ + (!v t. &0 < t /\ t <= TT ==> + (\s. h s v) real_continuous (atreal t within real_interval[&0,TT])) /\ + (\t. expectation p (\x. h t (X x))) + real_integrable_on real_interval[&0,TT] /\ + (!t. t IN real_interval[&0,TT] /\ &0 < t ==> + (\s. expectation p (\x. h s (X x))) + real_continuous (atreal t within real_interval[&0,TT])) + ==> real_integral (real_interval [&0,TT]) + (\t. expectation p (\x. h t (X x))) = + expectation p (\x. real_integral (real_interval [&0,TT]) + (\t. h t (X x)))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC(ISPEC `sequentially` REALLIM_UNIQUE) THEN + REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN + EXISTS_TAC `\n:num. sum(0..n) (\k. TT / &(SUC n) * + expectation (p:A prob_space) (\x:A. (h:real->real->real) + (&k * TT / &(SUC n)) (X x)))` THEN + CONJ_TAC THENL + [(* Branch 1: Riemann sums -> integral of E[h(t,X)] *) + MP_TAC(ISPECL [`\t:real. expectation (p:A prob_space) + (\x:A. (h:real->real->real) t (X x))`; `TT:real`; `M:real`] + RIEMANN_SUM_CONVERGES) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + (* Bound: |E[h(t,X)]| <= M *) + BETA_TAC THEN GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC EXPECTATION_BOUND THEN + CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_IMP_RANDOM_VARIABLE THEN ASM_REWRITE_TAC[]; + GEN_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[]]; + (* Continuity of E[h(t,X)] at t > 0 *) + BETA_TAC THEN GEN_TAC THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `t:real`) THEN + ASM_REWRITE_TAC[] THEN SIMP_TAC[]]; + REWRITE_TAC[]]; + (* Branch 2: Riemann sums -> E[integral h(t,X)] *) + (* Step 1: Rewrite sum of delta*E[h_k] as E[sum of delta*h_k] *) + SUBGOAL_THEN `!n:num. sum(0..n) (\k. TT / &(SUC n) * + expectation (p:A prob_space) (\x:A. (h:real->real->real) + (&k * TT / &(SUC n)) (X x))) = + expectation p (\x. sum(0..n) (\k. TT / &(SUC n) * + h (&k * TT / &(SUC n)) (X x)))` ASSUME_TAC THENL + [GEN_TAC THEN + SUBGOAL_THEN `sum(0..n) (\k. TT / &(SUC n) * + expectation (p:A prob_space) (\x:A. (h:real->real->real) + (&k * TT / &(SUC n)) (X x))) = + sum(0..n) (\k. expectation p (\x. TT / &(SUC n) * + h (&k * TT / &(SUC n)) (X x)))` SUBST1_TAC THENL + [MATCH_MP_TAC SUM_EQ_NUMSEG THEN REPEAT STRIP_TAC THEN + BETA_TAC THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC EXPECTATION_CMUL THEN ASM_REWRITE_TAC[]; + CONV_TAC SYM_CONV THEN + MP_TAC(ISPECL [`p:A prob_space`; + `\k (x:A). TT / &(SUC n) * + (h:real->real->real) (&k * TT / &(SUC n)) ((X:A->real) x)`; + `n:num`] EXPECTATION_SUM) THEN + ANTS_TAC THENL + [GEN_TAC THEN DISCH_TAC THEN BETA_TAC THEN + MATCH_MP_TAC INTEGRABLE_CMUL THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[]]]; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + (* Step 2: Apply bounded convergence *) + SUBGOAL_THEN + `integrable (p:A prob_space) + (\x:A. real_integral (real_interval[&0,TT]) + (\t. (h:real->real->real) t (X x))) /\ + ((\n. expectation p (\x. sum(0..n) (\k. TT / &(SUC n) * + h (&k * TT / &(SUC n)) (X x)))) ---> + expectation p (\x. real_integral (real_interval[&0,TT]) + (\t. h t (X x)))) sequentially` + (fun th -> ACCEPT_TAC(CONJUNCT2 th)) THEN + MP_TAC(ISPECL [`p:A prob_space`; + `\n (x:A). sum(0..n) (\k. TT / &(SUC n) * + (h:real->real->real) (&k * TT / &(SUC n)) ((X:A->real) x))`; + `\x:A. real_integral (real_interval[&0,TT]) + (\t. (h:real->real->real) t ((X:A->real) x))`; + `(M:real) * (TT:real)`] BOUNDED_CONVERGENCE_EXPECTATION_GEN) THEN + ANTS_TAC THENL + [BETA_TAC THEN REPEAT CONJ_TAC THENL + [(* random_variable p (\x. sum ...) for each n *) + GEN_TAC THEN MATCH_MP_TAC INTEGRABLE_IMP_RANDOM_VARIABLE THEN + MATCH_MP_TAC INTEGRABLE_SUM THEN GEN_TAC THEN DISCH_TAC THEN + BETA_TAC THEN MATCH_MP_TAC INTEGRABLE_CMUL THEN ASM_REWRITE_TAC[]; + (* Bound: |sum(0..n)(\k. delta*h(k*delta, X x))| <= M*TT *) + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(0..n) (\k:num. TT / &(SUC n) * M)` THEN CONJ_TAC THENL + [MATCH_MP_TAC SUM_ABS_LE THEN + REWRITE_TAC[FINITE_NUMSEG] THEN BETA_TAC THEN + X_GEN_TAC `k:num` THEN DISCH_TAC THEN + SUBGOAL_THEN `&0 <= TT / &(SUC n)` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_DIV THEN + CONJ_TAC THENL [ASM_SIMP_TAC[REAL_LT_IMP_LE]; REWRITE_TAC[REAL_POS]]; + ALL_TAC] THEN + REWRITE_TAC[REAL_ABS_MUL] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 <= x ==> abs x = x`] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[]; + REWRITE_TAC[SUM_CONST_NUMSEG; SUB_0; GSYM ADD1] THEN + SUBGOAL_THEN `~(&(SUC n) = &0)` ASSUME_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_EQ; NOT_SUC]; ALL_TAC] THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN + ASM_SIMP_TAC[REAL_DIV_LMUL] THEN REAL_ARITH_TAC]; + (* Pointwise convergence: Riemann sums -> integral for each x *) + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + MP_TAC(ISPECL [`\t:real. (h:real->real->real) t ((X:A->real) x)`; + `TT:real`; `M:real`] RIEMANN_SUM_CONVERGES) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [ASM_SIMP_TAC[]; + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]; + BETA_TAC THEN GEN_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[]; + GEN_TAC THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`(X:A->real) x`; `t:real`]) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_REAL_INTERVAL]) THEN + REAL_ARITH_TAC; + SIMP_TAC[]]]; + REWRITE_TAC[]]]; + SIMP_TAC[]]]);; + +(* Sequential characterization implies real continuity (bridge lemma). *) +let REAL_CONTINUOUS_ATREAL_SEQUENTIALLY = prove + (`!f x. (!s. (s ---> x) sequentially ==> ((\n. f(s n)) ---> f x) sequentially) + ==> f real_continuous (atreal x)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[REAL_CONTINUOUS_CONTINUOUS_ATREAL; CONTINUOUS_AT_SEQUENTIALLY] THEN + X_GEN_TAC `s:num->real^1` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(drop:real^1->real) o (s:num->real^1)`) THEN + ANTS_TAC THENL + [UNDISCH_TAC `(s:num->real^1 --> lift x) sequentially` THEN + REWRITE_TAC[REAL_TENDSTO; LIFT_DROP]; + REWRITE_TAC[TENDSTO_REAL; o_DEF; LIFT_DROP]]);; + +(* Continuity of characteristic function (real and imaginary parts). + Proof uses bounded convergence: for t_n -> t, + cos(t_n * X) -> cos(t * X) pointwise with |cos(t_n * X)| <= 1, + so E[cos(t_n * X)] -> E[cos(t * X)] by BCT. *) +let CHAR_FN_RE_CONTINUOUS = prove + (`!p:A prob_space X. random_variable p X ==> + char_fn_re p X real_continuous_on (:real)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; IN_UNIV; + WITHINREAL_UNIV] THEN + X_GEN_TAC `t:real` THEN + MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_SEQUENTIALLY THEN + X_GEN_TAC `s:num->real` THEN DISCH_TAC THEN + REWRITE_TAC[char_fn_re] THEN + MP_TAC(ISPECL [`p:A prob_space`; `(\n:num. \x:A. cos(s n * X x)):num->A->real`; + `(\x:A. cos(t * X x)):A->real`; `&1`] + BOUNDED_CONVERGENCE_EXPECTATION_GEN) THEN + BETA_TAC THEN REWRITE_TAC[] THEN ANTS_TAC THENL + [CONJ_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC RANDOM_VARIABLE_COS THEN + MATCH_MP_TAC RANDOM_VARIABLE_CMUL THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + CONJ_TAC THENL + [REPEAT STRIP_TAC THEN REWRITE_TAC[COS_BOUND]; + REPEAT STRIP_TAC THEN MATCH_MP_TAC REALLIM_COS THEN + MATCH_MP_TAC REALLIM_RMUL THEN ASM_REWRITE_TAC[]]; + SIMP_TAC[]]);; + +let CHAR_FN_IM_CONTINUOUS = prove + (`!p:A prob_space X. random_variable p X ==> + char_fn_im p X real_continuous_on (:real)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_EQ_CONTINUOUS_WITHIN; IN_UNIV; + WITHINREAL_UNIV] THEN + X_GEN_TAC `t:real` THEN + MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_SEQUENTIALLY THEN + X_GEN_TAC `s:num->real` THEN DISCH_TAC THEN + REWRITE_TAC[char_fn_im] THEN + MP_TAC(ISPECL [`p:A prob_space`; `(\n:num. \x:A. sin(s n * X x)):num->A->real`; + `(\x:A. sin(t * X x)):A->real`; `&1`] + BOUNDED_CONVERGENCE_EXPECTATION_GEN) THEN + BETA_TAC THEN REWRITE_TAC[] THEN ANTS_TAC THENL + [CONJ_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC RANDOM_VARIABLE_SIN THEN + MATCH_MP_TAC RANDOM_VARIABLE_CMUL THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + CONJ_TAC THENL + [REPEAT STRIP_TAC THEN REWRITE_TAC[SIN_BOUND]; + REPEAT STRIP_TAC THEN MATCH_MP_TAC REALLIM_SIN THEN + MATCH_MP_TAC REALLIM_RMUL THEN ASM_REWRITE_TAC[]]; + SIMP_TAC[]]);; + +(* Fubini exchange: connect inversion integral to expectation of kernel. + For T > 0, the inversion integral equals E[g_T(X)] where + g_T(v) = inv(pi) * int_0^T (sin(t(b-v)) - sin(t(a-v)))/t dt. + The proof uses: + - Algebraic rewriting of char_fn_re/im as expectations + - The trig identity INVERSION_TRIG_IDENTITY + - Evenness of the integrand (REAL_INTEGRAL_EVEN_SYMMETRIC) + - Exchange of bounded integral with expectation (Fubini) *) +let INVERSION_FUBINI = prove + (`!p:A prob_space X a b TT. + random_variable p X /\ &0 < TT /\ a < b ==> + inv(&2 * pi) * + real_integral (real_interval [--TT, TT]) + (\t. ((sin(t * b) - sin(t * a)) * char_fn_re p X t - + (cos(t * b) - cos(t * a)) * char_fn_im p X t) * inv t) = + expectation p (\x. inv(pi) * real_integral (real_interval[&0,TT]) + (\t. (sin(t * (b - X x)) - sin(t * (a - X x))) * inv t))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + ABBREV_TAC `h = \t v:real. (sin(t * (b - v)) - sin(t * (a - v))) * inv t` THEN + (* Integrability facts needed throughout *) + SUBGOAL_THEN `!t:real. integrable (p:A prob_space) (\x. cos(t * X x))` + ASSUME_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC INTEGRABLE_COS_CMUL THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `!t:real. integrable (p:A prob_space) (\x. sin(t * X x))` + ASSUME_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC INTEGRABLE_SIN_CMUL THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + (* Step 2: Show for each t the integrand = E[h(t,X)] *) + SUBGOAL_THEN `!t:real. + ((sin(t * b) - sin(t * a)) * char_fn_re (p:A prob_space) X t - + (cos(t * b) - cos(t * a)) * char_fn_im p X t) * inv t = + expectation p (\x:A. (h:real->real->real) t (X x))` ASSUME_TAC THENL + [X_GEN_TAC `t:real` THEN EXPAND_TAC "h" THEN BETA_TAC THEN + REWRITE_TAC[char_fn_re; char_fn_im] THEN + SUBGOAL_THEN + `((sin(t * b) - sin(t * a)) * expectation (p:A prob_space) (\x. cos(t * X x)) - + (cos(t * b) - cos(t * a)) * expectation p (\x. sin(t * X x))) * inv t = + expectation p (\x. ((sin(t * b) - sin(t * a)) * cos(t * X x) - + (cos(t * b) - cos(t * a)) * sin(t * X x)) * inv t)` SUBST1_TAC THENL + [SUBGOAL_THEN `integrable (p:A prob_space) + (\x. (sin(t * b) - sin(t * a)) * cos(t * X x))` ASSUME_TAC THENL + [REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC INTEGRABLE_CMUL THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `integrable (p:A prob_space) + (\x. (cos(t * b) - cos(t * a)) * sin(t * X x))` ASSUME_TAC THENL + [REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC INTEGRABLE_CMUL THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_SIMP_TAC[EXPECTATION_SUB] THEN + SUBGOAL_THEN `integrable (p:A prob_space) (\x. + (sin(t * b) - sin(t * a)) * cos(t * X x) - + (cos(t * b) - cos(t * a)) * sin(t * X x))` ASSUME_TAC THENL + [MATCH_MP_TAC INTEGRABLE_SUB THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `(\x:A. ((sin(t * b) - sin(t * a)) * cos(t * (X:A->real) x) - + (cos(t * b) - cos(t * a)) * sin(t * X x)) * inv t) = + (\x. inv t * ((sin(t * b) - sin(t * a)) * cos(t * X x) - + (cos(t * b) - cos(t * a)) * sin(t * X x)))` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[EXPECTATION_CMUL] THEN + ASM_SIMP_TAC[EXPECTATION_SUB] THEN + ASM_SIMP_TAC[EXPECTATION_CMUL] THEN REAL_ARITH_TAC; + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN + X_GEN_TAC `x:A` THEN BETA_TAC THEN + MP_TAC(SPECL [`t:real`; `a:real`; `b:real`; `(X:A->real) x`] + INVERSION_TRIG_IDENTITY) THEN + DISCH_THEN(fun th -> REWRITE_TAC[th])]; + ALL_TAC] THEN + (* Integrability of h(t, X x) for each t *) + SUBGOAL_THEN `!t:real. integrable (p:A prob_space) + (\x:A. (h:real->real->real) t (X x))` ASSUME_TAC THENL + [X_GEN_TAC `t:real` THEN EXPAND_TAC "h" THEN BETA_TAC THEN + MATCH_MP_TAC INTEGRABLE_BOUNDED THEN EXISTS_TAC `abs(b - a:real)` THEN + CONJ_TAC THENL + [SUBGOAL_THEN `(\x:A. (sin(t * (b - X x)) - sin(t * (a - X x))) * inv t) = + (\x. (\v:real. (sin(t * (b - v)) - sin(t * (a - v))) * inv t) (X x))` + SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM]; ALL_TAC] THEN + MATCH_MP_TAC RANDOM_VARIABLE_COMP_CONTINUOUS THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_ON_SUB THEN CONJ_TAC THENL + [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_COMPOSE THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_SIN] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_LMUL THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_SUB THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_CONST; REAL_CONTINUOUS_ON_ID]; + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_COMPOSE THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_SIN] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_LMUL THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_SUB THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_CONST; REAL_CONTINUOUS_ON_ID]]; + REWRITE_TAC[REAL_CONTINUOUS_ON_CONST]]; + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[INVERSION_KERNEL_BOUNDED]]; + ALL_TAC] THEN + (* Step 3: Rewrite the integral *) + SUBGOAL_THEN + `real_integral (real_interval [--TT, TT]) + (\t. ((sin(t * b) - sin(t * a)) * char_fn_re (p:A prob_space) X t - + (cos(t * b) - cos(t * a)) * char_fn_im p X t) * inv t) = + real_integral (real_interval [--TT, TT]) + (\t. expectation p (\x:A. (h:real->real->real) t (X x)))` + SUBST1_TAC THENL + [AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + (* Integrability on [-TT,TT] via measurability + boundedness *) + SUBGOAL_THEN `(\t. expectation (p:A prob_space) + (\x:A. (h:real->real->real) t (X x))) + real_integrable_on real_interval[--TT,TT]` ASSUME_TAC THENL + [SUBGOAL_THEN `(\t. expectation (p:A prob_space) + (\x:A. (h:real->real->real) t (X x))) = + (\t. ((sin(t * b) - sin(t * a)) * char_fn_re p X t - + (cos(t * b) - cos(t * a)) * char_fn_im p X t) * inv t)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + CONV_TAC SYM_CONV THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_MEASURABLE_BOUNDED_BY_INTEGRABLE_IMP_INTEGRABLE THEN + EXISTS_TAC `\t:real. abs(b - a:real)` THEN REPEAT CONJ_TAC THENL + [(* Measurability of integrand on [-TT,TT] *) + MATCH_MP_TAC REAL_MEASURABLE_ON_LEBESGUE_MEASURABLE_SUBSET THEN + EXISTS_TAC `(:real)` THEN + REWRITE_TAC[SUBSET_UNIV; REAL_LEBESGUE_MEASURABLE_INTERVAL] THEN + MATCH_MP_TAC REAL_MEASURABLE_ON_MUL THEN CONJ_TAC THENL + [(* Numerator: continuous on (:real), hence measurable *) + MATCH_MP_TAC REAL_CONTINUOUS_IMP_REAL_MEASURABLE_ON_CLOSED_SUBSET THEN + REWRITE_TAC[REAL_CLOSED_UNIV] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_SUB THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_ON_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_ON_SUB THEN CONJ_TAC THEN + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THEN + TRY(MATCH_MP_TAC REAL_CONTINUOUS_ON_RMUL THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_ID]) THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_SIN]; + REWRITE_TAC[ETA_AX] THEN + MATCH_MP_TAC CHAR_FN_RE_CONTINUOUS THEN ASM_REWRITE_TAC[]]; + MATCH_MP_TAC REAL_CONTINUOUS_ON_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_ON_SUB THEN CONJ_TAC THEN + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_COMPOSE THEN CONJ_TAC THEN + TRY(MATCH_MP_TAC REAL_CONTINUOUS_ON_RMUL THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_ID]) THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_COS]; + REWRITE_TAC[ETA_AX] THEN + MATCH_MP_TAC CHAR_FN_IM_CONTINUOUS THEN ASM_REWRITE_TAC[]]]; + (* inv measurable on (:real) *) + SUBGOAL_THEN `inv:real->real = (\x. inv x)` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM]; ALL_TAC] THEN + MATCH_MP_TAC REAL_MEASURABLE_ON_INV THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_IMP_REAL_MEASURABLE_ON_CLOSED_SUBSET THEN + REWRITE_TAC[REAL_CLOSED_UNIV; REAL_CONTINUOUS_ON_ID]; + REWRITE_TAC[SET_RULE `{x | x = &0} = {&0}`; REAL_NEGLIGIBLE_SING]]]; + (* Bounding function integrable *) + REWRITE_TAC[REAL_INTEGRABLE_CONST]; + (* Pointwise bound: |integrand(t)| <= |b-a| *) + X_GEN_TAC `t:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN STRIP_TAC THEN + SUBGOAL_THEN `((sin(t * b) - sin(t * a)) * char_fn_re (p:A prob_space) X t - + (cos(t * b) - cos(t * a)) * char_fn_im p X t) * inv t = + expectation p (\x:A. (h:real->real->real) t (X x))` SUBST1_TAC THENL + [ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `--a <= x /\ x <= a ==> abs x <= a`) THEN + CONJ_TAC THENL + [SUBGOAL_THEN `--abs(b - a:real) = + expectation (p:A prob_space) (\x:A. --abs(b - a))` SUBST1_TAC THENL + [REWRITE_TAC[EXPECTATION_CONST]; ALL_TAC] THEN + MATCH_MP_TAC EXPECTATION_MONO THEN ASM_REWRITE_TAC[INTEGRABLE_CONST] THEN + GEN_TAC THEN DISCH_TAC THEN EXPAND_TAC "h" THEN BETA_TAC THEN + MP_TAC(SPECL [`t:real`; `a:real`; `b:real`; `(X:A->real) x`] + INVERSION_KERNEL_BOUNDED) THEN REAL_ARITH_TAC; + SUBGOAL_THEN `abs(b - a:real) = + expectation (p:A prob_space) (\x:A. abs(b - a))` SUBST1_TAC THENL + [REWRITE_TAC[EXPECTATION_CONST]; ALL_TAC] THEN + MATCH_MP_TAC EXPECTATION_MONO THEN ASM_REWRITE_TAC[INTEGRABLE_CONST] THEN + GEN_TAC THEN DISCH_TAC THEN EXPAND_TAC "h" THEN BETA_TAC THEN + MP_TAC(SPECL [`t:real`; `a:real`; `b:real`; `(X:A->real) x`] + INVERSION_KERNEL_BOUNDED) THEN REAL_ARITH_TAC]]; + ALL_TAC] THEN + (* Derive integrability on [0,TT] from [-TT,TT] via subinterval *) + SUBGOAL_THEN `(\t. expectation (p:A prob_space) + (\x:A. (h:real->real->real) t (X x))) + real_integrable_on real_interval[&0,TT]` ASSUME_TAC THENL + [SUBGOAL_THEN `(\t. expectation (p:A prob_space) + (\x:A. (h:real->real->real) t (X x))) = + (\t. ((sin(t * b) - sin(t * a)) * char_fn_re p X t - + (cos(t * b) - cos(t * a)) * char_fn_im p X t) * inv t)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + CONV_TAC SYM_CONV THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `real_interval[--TT,TT]` THEN CONJ_TAC THENL + [SUBGOAL_THEN `(\t. expectation (p:A prob_space) + (\x:A. (h:real->real->real) t (X x))) = + (\t. ((sin(t * b) - sin(t * a)) * char_fn_re p X t - + (cos(t * b) - cos(t * a)) * char_fn_im p X t) * inv t)` + (fun th -> REWRITE_TAC[GSYM th]) THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + CONV_TAC SYM_CONV THEN ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]]; + REWRITE_TAC[SUBSET_REAL_INTERVAL] THEN ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + (* Establish continuity of E[h(t,X)] at t > 0 *) + SUBGOAL_THEN `!t:real. t IN real_interval[&0,TT] /\ &0 < t ==> + (\s. expectation (p:A prob_space) + (\x:A. (h:real->real->real) s (X x))) + real_continuous (atreal t within real_interval[&0,TT])` ASSUME_TAC THENL + [X_GEN_TAC `t0:real` THEN STRIP_TAC THEN + SUBGOAL_THEN `(\s. expectation (p:A prob_space) + (\x:A. (h:real->real->real) s (X x))) = + (\s. ((sin(s * b) - sin(s * a)) * char_fn_re p X s - + (cos(s * b) - cos(s * a)) * char_fn_im p X s) * inv s)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + CONV_TAC SYM_CONV THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_CONTINUOUS_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_SUB THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_SUB THEN CONJ_TAC THENL + [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC REAL_CONTINUOUS_WITHINREAL_COMPOSE THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_MUL THEN + REWRITE_TAC[REAL_CONTINUOUS_CONST; REAL_CONTINUOUS_WITHIN_ID]; + REWRITE_TAC[REAL_CONTINUOUS_WITHIN_SIN]]; + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC REAL_CONTINUOUS_WITHINREAL_COMPOSE THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_MUL THEN + REWRITE_TAC[REAL_CONTINUOUS_CONST; REAL_CONTINUOUS_WITHIN_ID]; + REWRITE_TAC[REAL_CONTINUOUS_WITHIN_SIN]]]; + REWRITE_TAC[ETA_AX] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_WITHINREAL THEN + SUBGOAL_THEN `char_fn_re (p:A prob_space) X real_continuous_on (:real)` + MP_TAC THENL + [MATCH_MP_TAC CHAR_FN_RE_CONTINUOUS THEN ASM_REWRITE_TAC[]; + SIMP_TAC[REAL_CONTINUOUS_ON_EQ_REAL_CONTINUOUS_AT; + REAL_OPEN_UNIV; IN_UNIV]]]; + MATCH_MP_TAC REAL_CONTINUOUS_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_SUB THEN CONJ_TAC THENL + [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC REAL_CONTINUOUS_WITHINREAL_COMPOSE THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_MUL THEN + REWRITE_TAC[REAL_CONTINUOUS_CONST; REAL_CONTINUOUS_WITHIN_ID]; + REWRITE_TAC[REAL_CONTINUOUS_WITHIN_COS]]; + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC REAL_CONTINUOUS_WITHINREAL_COMPOSE THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_MUL THEN + REWRITE_TAC[REAL_CONTINUOUS_CONST; REAL_CONTINUOUS_WITHIN_ID]; + REWRITE_TAC[REAL_CONTINUOUS_WITHIN_COS]]]; + REWRITE_TAC[ETA_AX] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_WITHINREAL THEN + SUBGOAL_THEN `char_fn_im (p:A prob_space) X real_continuous_on (:real)` + MP_TAC THENL + [MATCH_MP_TAC CHAR_FN_IM_CONTINUOUS THEN ASM_REWRITE_TAC[]; + SIMP_TAC[REAL_CONTINUOUS_ON_EQ_REAL_CONTINUOUS_AT; + REAL_OPEN_UNIV; IN_UNIV]]]]; + SUBGOAL_THEN `inv = (\s:real. inv s)` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM]; ALL_TAC] THEN + MATCH_MP_TAC REAL_CONTINUOUS_INV_WITHINREAL THEN + REWRITE_TAC[REAL_CONTINUOUS_WITHIN_ID] THEN ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + (* Step 4: Use evenness to convert [-TT,TT] to 2*[0,TT] *) + SUBGOAL_THEN + `real_integral (real_interval [--TT, TT]) + (\t. expectation (p:A prob_space) (\x:A. (h:real->real->real) t (X x))) = + &2 * real_integral (real_interval [&0, TT]) + (\t. expectation p (\x. h t (X x)))` SUBST1_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_EVEN_SYMMETRIC THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN CONJ_TAC THENL + [X_GEN_TAC `t:real` THEN EXPAND_TAC "h" THEN BETA_TAC THEN + SUBGOAL_THEN `!v:real. (sin(--t * (b - v)) - sin(--t * (a - v))) * inv(--t) = + (sin(t * (b - v)) - sin(t * (a - v))) * inv t` ASSUME_TAC THENL + [GEN_TAC THEN MATCH_ACCEPT_TAC INVERSION_SINC_EVEN; ALL_TAC] THEN + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + (* Step 5: Simplify inv(2*pi) * 2 = inv(pi) *) + SUBGOAL_THEN `inv(&2 * pi) * (&2 * real_integral (real_interval [&0,TT]) + (\t. expectation (p:A prob_space) (\x:A. (h:real->real->real) t (X x)))) = + inv(pi) * real_integral (real_interval [&0,TT]) + (\t. expectation p (\x. h t (X x)))` SUBST1_TAC THENL + [SUBGOAL_THEN `~(pi = &0)` ASSUME_TAC THENL + [MP_TAC PI_POS THEN REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_INV_MUL] THEN CONV_TAC REAL_FIELD; + ALL_TAC] THEN + (* Step 6: Pull inv(pi) out of expectation on RHS *) + SUBGOAL_THEN + `expectation (p:A prob_space) + (\x. inv pi * real_integral (real_interval [&0,TT]) + (\t. (sin(t * (b - X x)) - sin(t * (a - X x))) * inv t)) = + inv(pi) * expectation p + (\x. real_integral (real_interval [&0,TT]) + (\t. (sin(t * (b - X x)) - sin(t * (a - X x))) * inv t))` + SUBST1_TAC THENL + [MATCH_MP_TAC EXPECTATION_CMUL THEN + MATCH_MP_TAC INTEGRABLE_BOUNDED THEN + EXISTS_TAC `abs(b - a) * TT` THEN CONJ_TAC THENL + [SUBGOAL_THEN `(\x:A. real_integral (real_interval[&0,TT]) + (\t. (sin(t * (b - (X:A->real) x)) - sin(t * (a - X x))) * inv t)) = + (\x. (\v. real_integral (real_interval[&0,TT]) + (\t. (sin(t * (b - v)) - sin(t * (a - v))) * inv t)) (X x))` + SUBST1_TAC THENL [REWRITE_TAC[FUN_EQ_THM]; ALL_TAC] THEN + MATCH_MP_TAC RANDOM_VARIABLE_COMP_CONTINUOUS THEN ASM_REWRITE_TAC[] THEN + SIMP_TAC[REAL_CONTINUOUS_ON_EQ_REAL_CONTINUOUS_AT; + REAL_OPEN_UNIV; IN_UNIV] THEN + X_GEN_TAC `v:real` THEN + REWRITE_TAC[REAL_CONTINUOUS_ATREAL; REALLIM_ATREAL] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + EXISTS_TAC `e / (&2 * TT)` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LT_DIV THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LT_MUL THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + X_GEN_TAC `w:real` THEN STRIP_TAC THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `(&2 * abs(v - w)) * TT` THEN CONJ_TAC THENL + [MATCH_MP_TAC(REAL_ARITH `abs(x - y) <= a ==> abs(y - x) <= a`) THEN + SUBGOAL_THEN + `real_integral (real_interval[&0,TT]) + (\t. (sin(t * (b - v)) - sin(t * (a - v))) * inv t) - + real_integral (real_interval[&0,TT]) + (\t. (sin(t * (b - w)) - sin(t * (a - w))) * inv t) = + real_integral (real_interval[&0,TT]) + (\t. ((sin(t * (b - v)) - sin(t * (a - v))) * inv t) - + ((sin(t * (b - w)) - sin(t * (a - w))) * inv t))` + SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_INTEGRAL_SUB THEN + CONJ_TAC THEN MATCH_MP_TAC SINC_SCALED_DIFF_INTEGRABLE THEN + ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPECL + [`\t:real. ((sin(t * (b - v)) - sin(t * (a - v))) * inv t) - + ((sin(t * (b - w)) - sin(t * (a - w))) * inv t)`; + `&0`; `TT:real`; + `real_integral (real_interval[&0,TT]) + (\t:real. ((sin(t * (b - v)) - sin(t * (a - v))) * inv t) - + ((sin(t * (b - w)) - sin(t * (a - w))) * inv t))`; + `&2 * abs(v - w:real)`] HAS_REAL_INTEGRAL_BOUND) THEN + REWRITE_TAC[REAL_SUB_RZERO] THEN + DISCH_THEN MATCH_MP_TAC THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [REAL_ARITH_TAC; REWRITE_TAC[REAL_ABS_POS]]; + ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_INTEGRABLE_INTEGRAL THEN + MATCH_MP_TAC REAL_INTEGRABLE_SUB THEN + CONJ_TAC THEN MATCH_MP_TAC SINC_SCALED_DIFF_INTEGRABLE THEN + ASM_REAL_ARITH_TAC; + X_GEN_TAC `t:real` THEN REWRITE_TAC[IN_REAL_INTERVAL] THEN + DISCH_TAC THEN + REWRITE_TAC[REAL_ARITH `!a b c d e:real. + (a - b) * c - (d - e) * c = ((a - d) - (b - e)) * c`] THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_INV] THEN + ASM_CASES_TAC `t = &0` THENL + [ASM_REWRITE_TAC[REAL_ABS_NUM; REAL_INV_0; REAL_MUL_RZERO] THEN + REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(abs(t * (b - v) - t * (b - w)) + + abs(t * (a - v) - t * (a - w))) * inv(abs t)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_RMUL THEN + REWRITE_TAC[REAL_LE_INV_EQ; REAL_ABS_POS] THEN + MATCH_MP_TAC(REAL_ARITH + `abs(a) <= x /\ abs(b) <= y ==> + abs(a - b) <= x + y`) THEN + REWRITE_TAC[SIN_LIPSCHITZ]; + SUBGOAL_THEN `t * (b - v) - t * (b - w) = t * (w - v:real)` + SUBST1_TAC THENL [CONV_TAC REAL_RING; ALL_TAC] THEN + SUBGOAL_THEN `t * (a - v) - t * (a - w) = t * (w - v:real)` + SUBST1_TAC THENL [CONV_TAC REAL_RING; ALL_TAC] THEN + REWRITE_TAC[REAL_ABS_MUL] THEN + SUBGOAL_THEN `(abs t * abs(w - v) + abs t * abs(w - v)) * inv(abs t) = + &2 * abs(v - w:real)` SUBST1_TAC THENL + [UNDISCH_TAC `~(t = &0)` THEN + REWRITE_TAC[REAL_ARITH `abs(w - v:real) = abs(v - w)`] THEN + CONV_TAC REAL_FIELD; + REWRITE_TAC[REAL_LE_REFL]]]]; + MATCH_MP_TAC REAL_LTE_TRANS THEN + EXISTS_TAC `(&2 * (e / (&2 * TT))) * TT` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LT_RMUL THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LT_LMUL THEN REWRITE_TAC[REAL_OF_NUM_LT; ARITH] THEN + REWRITE_TAC[REAL_ABS_SUB] THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_EQ_IMP_LE THEN + UNDISCH_TAC `&0 < TT` THEN CONV_TAC REAL_FIELD]]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + MP_TAC(ISPECL + [`\t:real. (sin(t * (b - (X:A->real) x)) - sin(t * (a - X x))) * inv t`; + `&0`; `TT:real`; + `real_integral (real_interval[&0,TT]) + (\t. (sin(t * (b - (X:A->real) x)) - sin(t * (a - X x))) * inv t)`; + `abs(b - a:real)`] HAS_REAL_INTEGRAL_BOUND) THEN + REWRITE_TAC[REAL_ABS_POS; REAL_SUB_RZERO] THEN DISCH_THEN MATCH_MP_TAC THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_INTEGRAL THEN + MATCH_MP_TAC SINC_SCALED_DIFF_INTEGRABLE THEN ASM_REAL_ARITH_TAC; + X_GEN_TAC `t:real` THEN DISCH_TAC THEN + REWRITE_TAC[INVERSION_KERNEL_BOUNDED]]]; + ALL_TAC] THEN + (* Step 7: The Fubini exchange: integral E[h(t,X)] = E[integral h(t,X)] *) + AP_TERM_TAC THEN + SUBGOAL_THEN + `real_integral (real_interval [&0,TT]) + (\t. expectation (p:A prob_space) (\x:A. (h:real->real->real) t (X x))) = + expectation p (\x. real_integral (real_interval [&0,TT]) + (\t. h t (X x)))` SUBST1_TAC THENL + [MATCH_MP_TAC INTEGRAL_EXPECTATION_EXCHANGE THEN + EXISTS_TAC `abs(b - a:real)` THEN + ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [UNDISCH_TAC `a < b` THEN REAL_ARITH_TAC; + (* !t v. abs(h t v) <= |b-a| *) + REPEAT GEN_TAC THEN EXPAND_TAC "h" THEN BETA_TAC THEN + REWRITE_TAC[INVERSION_KERNEL_BOUNDED]; + (* !v. (\t. h t v) integrable on [0,TT] *) + GEN_TAC THEN EXPAND_TAC "h" THEN BETA_TAC THEN + MATCH_MP_TAC SINC_SCALED_DIFF_INTEGRABLE THEN ASM_REAL_ARITH_TAC; + (* !v t. 0 < t /\ t <= TT ==> h continuous in t at (t,v) *) + REPEAT STRIP_TAC THEN EXPAND_TAC "h" THEN BETA_TAC THEN + MATCH_MP_TAC REAL_CONTINUOUS_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_SUB THEN CONJ_TAC THENL + [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC REAL_CONTINUOUS_WITHINREAL_COMPOSE THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_MUL THEN + REWRITE_TAC[REAL_CONTINUOUS_CONST; REAL_CONTINUOUS_WITHIN_ID]; + REWRITE_TAC[REAL_CONTINUOUS_WITHIN_SIN]]; + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC REAL_CONTINUOUS_WITHINREAL_COMPOSE THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_MUL THEN + REWRITE_TAC[REAL_CONTINUOUS_CONST; REAL_CONTINUOUS_WITHIN_ID]; + REWRITE_TAC[REAL_CONTINUOUS_WITHIN_SIN]]]; + SUBGOAL_THEN `inv = (\s:real. inv s)` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM]; ALL_TAC] THEN + MATCH_MP_TAC REAL_CONTINUOUS_INV_WITHINREAL THEN + REWRITE_TAC[REAL_CONTINUOUS_WITHIN_ID] THEN ASM_REAL_ARITH_TAC]]; + ALL_TAC] THEN + (* Final: show both expectations have the same integrand *) + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN + X_GEN_TAC `x:A` THEN EXPAND_TAC "h" THEN REWRITE_TAC[]);; + + +(* Levy inversion formula: recovers F(b) - F(a) from the characteristic + function via an integral. Requires continuity of F at a and b. + Proof: Use REALLIM_AT_POSINFINITY_FROM_SUBSEQUENCES to reduce to + sequential case, then INVERSION_FUBINI + bounded convergence. *) +let LEVY_INVERSION = prove + (`!p:A prob_space (X:A->real) a b. + random_variable p X /\ + a < b /\ + (distribution_fn p X) real_continuous (atreal a) /\ + (distribution_fn p X) real_continuous (atreal b) + ==> ((\TT. inv(&2 * pi) * + real_integral (real_interval [--TT, TT]) + (\t. ((sin(t * b) - sin(t * a)) * char_fn_re p X t - + (cos(t * b) - cos(t * a)) * char_fn_im p X t) * inv t)) + ---> (distribution_fn p X b - distribution_fn p X a)) at_posinfinity`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REALLIM_AT_POSINFINITY_FROM_SUBSEQUENCES THEN + X_GEN_TAC `s:num->real` THEN DISCH_TAC THEN BETA_TAC THEN + ABBREV_TAC `g = \TT:real. \v:real. inv(pi) * + real_integral (real_interval[&0,TT]) + (\t. (sin(t * (b - v)) - sin(t * (a - v))) * inv t)` THEN + SUBGOAL_THEN `!TT. &0 < TT ==> + inv(&2 * pi) * real_integral (real_interval [--TT, TT]) + (\t. ((sin(t * b) - sin(t * a)) * char_fn_re (p:A prob_space) X t - + (cos(t * b) - cos(t * a)) * char_fn_im p X t) * inv t) = + expectation p (\x. (g:real->real->real) TT (X x))` ASSUME_TAC THENL + [X_GEN_TAC `TT:real` THEN DISCH_TAC THEN + EXPAND_TAC "g" THEN BETA_TAC THEN + MATCH_MP_TAC INVERSION_FUBINI THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC REALLIM_TRANSFORM_EVENTUALLY THEN + EXISTS_TAC `\n:num. expectation (p:A prob_space) + (\x. (g:real->real->real) (s n) (X x))` THEN + CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `1` THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN + CONV_TAC SYM_CONV THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&n:real` THEN + CONJ_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_LT] THEN ASM_ARITH_TAC; + FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN REWRITE_TAC[real_ge]]; + ALL_TAC] THEN + SUBGOAL_THEN `distribution_fn (p:A prob_space) X b - distribution_fn p X a = + expectation p (\x:A. if a < X x /\ X x < b then &1 + else if X x < a \/ b < X x then &0 else inv(&2))` SUBST1_TAC THENL + [(* Prove F(b) - F(a) = E[f(X)]. Strategy: show both sides equal P(a < X < b) *) + SUBGOAL_THEN `prob (p:A prob_space) {x | x IN prob_carrier p /\ + (X:A->real) x = a} = &0` ASSUME_TAC THENL + [MATCH_MP_TAC DISTRIBUTION_FN_CONTINUOUS_PROB_ZERO THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `prob (p:A prob_space) {x | x IN prob_carrier p /\ + (X:A->real) x = b} = &0` ASSUME_TAC THENL + [MATCH_MP_TAC DISTRIBUTION_FN_CONTINUOUS_PROB_ZERO THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `{x:A | x IN prob_carrier p /\ (X:A->real) x = a} + IN prob_events p` ASSUME_TAC THENL + [SUBGOAL_THEN `{x:A | x IN prob_carrier p /\ (X:A->real) x = a} = + {x | x IN prob_carrier p /\ X x <= a} DIFF + {x | x IN prob_carrier p /\ X x < a}` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_DIFF; IN_ELIM_THM] THEN GEN_TAC THEN + ASM_CASES_TAC `(x:A) IN prob_carrier p` THEN ASM_REWRITE_TAC[] THEN + REAL_ARITH_TAC; + MATCH_MP_TAC PROB_DIFF_IN_EVENTS THEN CONJ_TAC THENL + [FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [random_variable]) THEN + DISCH_THEN(MP_TAC o SPEC `a:real`) THEN REWRITE_TAC[]; + MATCH_MP_TAC RV_PREIMAGE_LT THEN ASM_REWRITE_TAC[]]]; + ALL_TAC] THEN + SUBGOAL_THEN `{x:A | x IN prob_carrier p /\ (X:A->real) x = b} + IN prob_events p` ASSUME_TAC THENL + [SUBGOAL_THEN `{x:A | x IN prob_carrier p /\ (X:A->real) x = b} = + {x | x IN prob_carrier p /\ X x <= b} DIFF + {x | x IN prob_carrier p /\ X x < b}` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_DIFF; IN_ELIM_THM] THEN GEN_TAC THEN + ASM_CASES_TAC `(x:A) IN prob_carrier p` THEN ASM_REWRITE_TAC[] THEN + REAL_ARITH_TAC; + MATCH_MP_TAC PROB_DIFF_IN_EVENTS THEN CONJ_TAC THENL + [FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [random_variable]) THEN + DISCH_THEN(MP_TAC o SPEC `b:real`) THEN REWRITE_TAC[]; + MATCH_MP_TAC RV_PREIMAGE_LT THEN ASM_REWRITE_TAC[]]]; + ALL_TAC] THEN + SUBGOAL_THEN `{x:A | x IN prob_carrier p /\ a < (X:A->real) x /\ X x < b} + IN prob_events p` ASSUME_TAC THENL + [SUBGOAL_THEN `{x:A | x IN prob_carrier p /\ a < (X:A->real) x /\ X x < b} = + {x | x IN prob_carrier p /\ X x < b} DIFF + {x | x IN prob_carrier p /\ X x <= a}` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_DIFF; IN_ELIM_THM] THEN GEN_TAC THEN + ASM_CASES_TAC `(x:A) IN prob_carrier p` THEN ASM_REWRITE_TAC[] THEN + REAL_ARITH_TAC; + MATCH_MP_TAC PROB_DIFF_IN_EVENTS THEN CONJ_TAC THENL + [MATCH_MP_TAC RV_PREIMAGE_LT THEN ASM_REWRITE_TAC[]; + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [random_variable]) THEN + DISCH_THEN(MP_TAC o SPEC `a:real`) THEN REWRITE_TAC[]]]; + ALL_TAC] THEN + ABBREV_TAC `C_bdry = {x:A | x IN prob_carrier p /\ (X:A->real) x = a} + UNION {x | x IN prob_carrier p /\ X x = b}` THEN + SUBGOAL_THEN `C_bdry:A->bool IN prob_events p` ASSUME_TAC THENL + [EXPAND_TAC "C_bdry" THEN MATCH_MP_TAC PROB_UNION_IN_EVENTS THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `prob (p:A prob_space) C_bdry = &0` ASSUME_TAC THENL + [MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= &0 ==> x = &0`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC PROB_POSITIVE THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC + `prob (p:A prob_space) {x | x IN prob_carrier p /\ (X:A->real) x = a} + + prob p {x | x IN prob_carrier p /\ X x = b}` THEN + CONJ_TAC THENL + [EXPAND_TAC "C_bdry" THEN MATCH_MP_TAC PROB_SUBADDITIVE THEN + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[REAL_ADD_LID; REAL_LE_REFL]]]; + ALL_TAC] THEN + SUBGOAL_THEN `distribution_fn (p:A prob_space) X b - distribution_fn p X a = + prob p {x | x IN prob_carrier p /\ a < (X:A->real) x /\ X x < b}` + SUBST1_TAC THENL + [(* LHS: F(b) - F(a) = P(a < X < b) *) + REWRITE_TAC[distribution_fn] THEN + SUBGOAL_THEN `prob (p:A prob_space) + {x | x IN prob_carrier p /\ (X:A->real) x <= b} - + prob p {x | x IN prob_carrier p /\ X x <= a} = + prob p ({x | x IN prob_carrier p /\ X x <= b} DIFF + {x | x IN prob_carrier p /\ X x <= a})` SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC PROB_DIFF_SUBSET THEN + CONJ_TAC THENL + [FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [random_variable]) THEN + DISCH_THEN(MP_TAC o SPEC `a:real`) THEN REWRITE_TAC[]; ALL_TAC] THEN + CONJ_TAC THENL + [FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [random_variable]) THEN + DISCH_THEN(MP_TAC o SPEC `b:real`) THEN REWRITE_TAC[]; + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN GEN_TAC THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `(X:A->real) x <= a` THEN + UNDISCH_TAC `(a:real) < b` THEN REAL_ARITH_TAC]; ALL_TAC] THEN + SUBGOAL_THEN `{x:A | x IN prob_carrier p /\ (X:A->real) x <= b} DIFF + {x | x IN prob_carrier p /\ X x <= a} = + {x | x IN prob_carrier p /\ a < X x /\ X x < b} UNION + {x | x IN prob_carrier p /\ X x = b}` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_DIFF; IN_UNION; IN_ELIM_THM] THEN GEN_TAC THEN + ASM_CASES_TAC `(x:A) IN prob_carrier p` THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `(a:real) < b` THEN REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPECL [`p:A prob_space`; + `{x:A | x IN prob_carrier p /\ a < (X:A->real) x /\ X x < b}`; + `{x:A | x IN prob_carrier p /\ (X:A->real) x = b}`] PROB_ADDITIVE) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [REWRITE_TAC[DISJOINT; EXTENSION; IN_INTER; IN_ELIM_THM; NOT_IN_EMPTY] THEN + GEN_TAC THEN ASM_CASES_TAC `(x:A) IN prob_carrier p` THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[REAL_ADD_RID]]; + (* RHS: E[f(X)] = P(a < X < b). + Prove inside a single SUBGOAL_THEN to avoid SUBST1_TAC alpha issues *) + ABBREV_TAC `A_open = {x:A | x IN prob_carrier p /\ a < (X:A->real) x /\ + X x < b}` THEN + CONV_TAC SYM_CONV THEN + (* Goal is now: E[f] = prob p A_open *) + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `expectation (p:A prob_space) (indicator_fn A_open) + + inv(&2) * expectation p (indicator_fn C_bdry)` THEN + CONJ_TAC THENL + [SUBGOAL_THEN `integrable (p:A prob_space) (indicator_fn A_open)` + ASSUME_TAC THENL + [MATCH_MP_TAC INTEGRABLE_INDICATOR THEN + EXPAND_TAC "A_open" THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `integrable (p:A prob_space) + (indicator_fn (C_bdry:A->bool))` ASSUME_TAC THENL + [MATCH_MP_TAC INTEGRABLE_INDICATOR THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `integrable (p:A prob_space) + (\x:A. inv(&2) * indicator_fn (C_bdry:A->bool) x)` ASSUME_TAC THENL + [MATCH_MP_TAC INTEGRABLE_CMUL THEN ASM_REWRITE_TAC[ETA_AX]; ALL_TAC] THEN + SUBGOAL_THEN `inv(&2) * expectation (p:A prob_space) + (indicator_fn (C_bdry:A->bool)) = + expectation p (\x:A. inv(&2) * indicator_fn C_bdry x)` + ASSUME_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC EXPECTATION_CMUL THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + (* Branch 1: E[f] = E[ind A_open] + inv(2) * E[ind C_bdry] *) + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `integrable (p:A prob_space) + (\x:A. indicator_fn A_open x + inv(&2) * indicator_fn C_bdry x)` + ASSUME_TAC THENL + [MATCH_MP_TAC INTEGRABLE_ADD THEN ASM_REWRITE_TAC[ETA_AX]; ALL_TAC] THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `expectation (p:A prob_space) + (\x:A. indicator_fn A_open x + + inv(&2) * indicator_fn (C_bdry:A->bool) x)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC EXPECTATION_EXT THEN X_GEN_TAC `x:A` THEN DISCH_TAC THEN + REWRITE_TAC[indicator_fn; IN_ELIM_THM] THEN + EXPAND_TAC "A_open" THEN EXPAND_TAC "C_bdry" THEN + REWRITE_TAC[IN_ELIM_THM; IN_UNION] THEN + ASM_CASES_TAC `a < (X:A->real) x /\ X x < b` THENL + [ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `~((X:A->real) x = a) /\ ~(X x = b)` ASSUME_TAC THENL + [POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC]; + ASM_CASES_TAC `(X:A->real) x < a \/ b < X x` THENL + [ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `~(a < (X:A->real) x /\ X x < b) /\ + ~((X:A->real) x = a) /\ ~(X x = b)` ASSUME_TAC THENL + [POP_ASSUM MP_TAC THEN UNDISCH_TAC `(a:real) < b` THEN REAL_ARITH_TAC; + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC]; + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `(X:A->real) x = a \/ X x = b` ASSUME_TAC THENL + [POP_ASSUM MP_TAC THEN POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `~(a < (X:A->real) x /\ X x < b)` ASSUME_TAC THENL + [POP_ASSUM DISJ_CASES_TAC THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC]]]]; + MP_TAC(ISPECL [`p:A prob_space`; `indicator_fn (A_open:A->bool)`; + `\x:A. inv(&2) * indicator_fn (C_bdry:A->bool) x`] + EXPECTATION_ADD) THEN + ASM_REWRITE_TAC[ETA_AX] THEN DISCH_THEN(fun th -> REWRITE_TAC[th])]; + (* Branch 2: E[ind A_open] + inv(2) * E[ind C_bdry] = prob A_open *) + SUBGOAL_THEN `expectation (p:A prob_space) (indicator_fn C_bdry) = &0` + SUBST1_TAC THENL + [SUBGOAL_THEN `expectation (p:A prob_space) (indicator_fn C_bdry) = + prob p C_bdry` SUBST1_TAC THENL + [MATCH_MP_TAC EXPECTATION_INDICATOR THEN ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]]; ALL_TAC] THEN + REWRITE_TAC[REAL_MUL_RZERO; REAL_ADD_RID] THEN + MATCH_MP_TAC EXPECTATION_INDICATOR THEN + EXPAND_TAC "A_open" THEN ASM_REWRITE_TAC[]]]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`p:A prob_space`; + `\n:num. \x:A. (g:real->real->real) ((s:num->real) n) ((X:A->real) x)`; + `\x:A. if a < (X:A->real) x /\ X x < b then &1 + else if X x < a \/ b < X x then &0 else inv(&2)`; + `&1 + &8 * inv(pi)`] + BOUNDED_CONVERGENCE_EXPECTATION_GEN) THEN + BETA_TAC THEN ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [X_GEN_TAC `n:num` THEN EXPAND_TAC "g" THEN BETA_TAC THEN + MATCH_MP_TAC INVERSION_KERNEL_RV THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&n:real` THEN + CONJ_TAC THENL [REWRITE_TAC[REAL_POS]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN REWRITE_TAC[real_ge]; + X_GEN_TAC `n:num` THEN X_GEN_TAC `x:A` THEN DISCH_TAC THEN + EXPAND_TAC "g" THEN BETA_TAC THEN + SUBGOAL_THEN `(s:num->real) n = &0 \/ &0 < s n` DISJ_CASES_TAC THENL + [MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> x = &0 \/ &0 < x`) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&n:real` THEN + CONJ_TAC THENL [REWRITE_TAC[REAL_POS]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN REWRITE_TAC[real_ge]; + ASM_REWRITE_TAC[REAL_INTEGRAL_REFL; REAL_MUL_RZERO; REAL_ABS_0] THEN + MATCH_MP_TAC REAL_LE_ADD THEN CONJ_TAC THENL + [REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LE_INV THEN MP_TAC PI_POS THEN REAL_ARITH_TAC]]; + MATCH_MP_TAC INVERSION_KERNEL_UNIFORM_BOUND THEN ASM_REWRITE_TAC[]]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + EXPAND_TAC "g" THEN BETA_TAC THEN + ASM_CASES_TAC `a < (X:A->real) x /\ X x < b` THENL + [ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(BETA_RULE(ISPECL + [`\TT:real. inv(pi) * real_integral (real_interval[&0,TT]) + (\t. (sin(t * ((b:real) - (X:A->real) x)) - + sin(t * ((a:real) - X x))) * inv t)`; + `&1`; `s:num->real`] + REALLIM_AT_POSINFINITY_IMP_SEQUENTIALLY)) THEN + CONJ_TAC THENL + [MATCH_MP_TAC INVERSION_KERNEL_CONVERGES_INSIDE THEN ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]]; + ALL_TAC] THEN + ASM_CASES_TAC `(X:A->real) x < a \/ b < X x` THENL + [SUBGOAL_THEN `~(a < (X:A->real) x /\ X x < b)` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ASM_REWRITE_TAC[]] THEN + MATCH_MP_TAC(BETA_RULE(ISPECL + [`\TT:real. inv(pi) * real_integral (real_interval[&0,TT]) + (\t. (sin(t * ((b:real) - (X:A->real) x)) - + sin(t * ((a:real) - X x))) * inv t)`; + `&0`; `s:num->real`] + REALLIM_AT_POSINFINITY_IMP_SEQUENTIALLY)) THEN + CONJ_TAC THENL + [MATCH_MP_TAC INVERSION_KERNEL_CONVERGES_OUTSIDE THEN ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN `(X:A->real) x = a \/ X x = b` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `~(a < (X:A->real) x /\ X x < b)` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ASM_REWRITE_TAC[]] THEN + SUBGOAL_THEN `~((X:A->real) x < a \/ b < X x)` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ASM_REWRITE_TAC[]] THEN + FIRST_X_ASSUM DISJ_CASES_TAC THENL + [ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(BETA_RULE(ISPECL + [`\TT:real. inv(pi) * real_integral (real_interval[&0,TT]) + (\t. (sin(t * ((b:real) - a)) - + sin(t * (a - a))) * inv t)`; + `inv(&2)`; `s:num->real`] + REALLIM_AT_POSINFINITY_IMP_SEQUENTIALLY)) THEN + CONJ_TAC THENL + [MATCH_MP_TAC INVERSION_KERNEL_CONVERGES_AT_A THEN ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]]; + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(BETA_RULE(ISPECL + [`\TT:real. inv(pi) * real_integral (real_interval[&0,TT]) + (\t. (sin(t * ((b:real) - b)) - + sin(t * (a - b))) * inv t)`; + `inv(&2)`; `s:num->real`] + REALLIM_AT_POSINFINITY_IMP_SEQUENTIALLY)) THEN + CONJ_TAC THENL + [MATCH_MP_TAC INVERSION_KERNEL_CONVERGES_AT_B THEN ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]]]]; + ALL_TAC] THEN + MESON_TAC[]);; + +(* ================================================================== *) +(* LINDEBERG-FELLER CLT *) +(* ================================================================== *) + +(* L1: Telescoping product inequality *) +let PRODUCT_DIFF_SUM_BOUND = prove + (`!n (a:num->real) (b:num->real). + (!i. i <= n ==> abs(a i) <= &1) /\ + (!i. i <= n ==> abs(b i) <= &1) + ==> abs(product(0..n) a - product(0..n) b) + <= sum(0..n) (\i. abs(a i - b i))`, + INDUCT_TAC THENL + [REWRITE_TAC[PRODUCT_CLAUSES_NUMSEG; SUM_CLAUSES_NUMSEG; LE_0; LE; ARITH] THEN + BETA_TAC THEN REAL_ARITH_TAC; + ALL_TAC] THEN + REPEAT GEN_TAC THEN STRIP_TAC THEN + SIMP_TAC[PRODUCT_CLAUSES_NUMSEG; SUM_CLAUSES_NUMSEG; + ARITH_RULE `0 <= SUC n`] THEN BETA_TAC THEN + ABBREV_TAC `Pa = product(0..n) (a:num->real)` THEN + ABBREV_TAC `Pb = product(0..n) (b:num->real)` THEN + SUBGOAL_THEN `Pa * (a:num->real)(SUC n) - Pb * b(SUC n) = + a(SUC n) * (Pa - Pb) + (a(SUC n) - b(SUC n)) * Pb` + SUBST1_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `abs((a:num->real)(SUC n)) <= &1` ASSUME_TAC THENL + [FIRST_ASSUM MATCH_MP_TAC THEN ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `abs(Pa - Pb) <= + sum(0..n) (\i. abs((a:num->real) i - b i))` ASSUME_TAC THENL + [EXPAND_TAC "Pa" THEN EXPAND_TAC "Pb" THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_MESON_TAC[ARITH_RULE `i <= n ==> i <= SUC n`]; + ALL_TAC] THEN + SUBGOAL_THEN `abs Pb <= &1` ASSUME_TAC THENL + [EXPAND_TAC "Pb" THEN MP_TAC(ISPECL [`b:num->real`; `0..n`] PRODUCT_ABS) THEN REWRITE_TAC[FINITE_NUMSEG] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN MATCH_MP_TAC REAL_LE_TRANS THEN @@ -14424,6 +16743,7 @@ let THREE_SERIES_NECESSITY = prove FIRST_ASSUM ACCEPT_TAC; FIRST_ASSUM ACCEPT_TAC]);; + (* ================================================================== *) (* Mutual independence infrastructure *) (* ================================================================== *) @@ -14843,6 +17163,7 @@ let MUTUALLY_INDEP_POINT_MASS = prove ASM_REWRITE_TAC[FINITE_EMPTY; DISJOINT_EMPTY; UNION_EMPTY; IMAGE_CLAUSES; INTERS_0; INTER_UNIV; PRODUCT_CLAUSES; REAL_MUL_LID]);; + (* Helper: CDF events are in prob_events *) let RV_CDF_EVENTS = prove (`random_variable (p:A prob_space) (f:A->real) @@ -15046,49 +17367,9 @@ let MUTUALLY_INDEP_RV_SEQ_STRICT_INEQ = prove (* product seq --> product S (marginal < a_i) *) MATCH_MP_TAC REALLIM_PRODUCT_FINITE THEN ASM_REWRITE_TAC[] THEN X_GEN_TAC `i:num` THEN DISCH_TAC THEN - MP_TAC(ISPECL [`p:A prob_space`; - `\n:num. {x:A | x IN prob_carrier p /\ - (Z:num->A->real) i x <= (a:num->real) i - &1 / &(SUC n)}`] - PROB_CONTINUITY_FROM_BELOW) THEN - BETA_TAC THEN - ANTS_TAC THENL - [CONJ_TAC THENL - [GEN_TAC THEN MATCH_MP_TAC RV_CDF_EVENTS THEN - ASM_REWRITE_TAC[ETA_AX]; - GEN_TAC THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `z:A` THEN - STRIP_TAC THEN ASM_REWRITE_TAC[] THEN - MATCH_MP_TAC REAL_LE_TRANS THEN - EXISTS_TAC `(a:num->real) i - &1 / &(SUC n)` THEN - ASM_REWRITE_TAC[REAL_LE_SUB_LADD; - REAL_ARITH `a - x + y <= a <=> y <= x`] THEN - REWRITE_TAC[real_div; REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LE_INV2 THEN - REWRITE_TAC[REAL_OF_NUM_LT; REAL_OF_NUM_LE] THEN ARITH_TAC]; - SUBGOAL_THEN - `UNIONS {{x:A | x IN prob_carrier p /\ (Z:num->A->real) i x <= - (a:num->real) i - &1 / &(SUC n)} | n IN (:num)} = - {x | x IN prob_carrier p /\ Z i x < a i}` - SUBST1_TAC THENL - [REWRITE_TAC[SIMPLE_IMAGE; UNIONS_IMAGE; IN_UNIV] THEN - REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `z:A` THEN - EQ_TAC THENL - [DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THEN - ASM_REWRITE_TAC[] THEN - SUBGOAL_THEN `&0 < &1 / &(SUC n)` MP_TAC THENL - [SIMP_TAC[REAL_LT_DIV; REAL_LT_01; REAL_OF_NUM_LT; LT_0]; - ASM_REAL_ARITH_TAC]; - STRIP_TAC THEN - SUBGOAL_THEN `?m:num. ~(m = 0) /\ &0 < inv(&m) /\ - inv(&m) < (a:num->real) i - (Z:num->A->real) i z` MP_TAC THENL - [REWRITE_TAC[GSYM REAL_ARCH_INV] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN - DISCH_THEN(X_CHOOSE_THEN `m:num` STRIP_ASSUME_TAC) THEN - EXISTS_TAC `m:num` THEN ASM_REWRITE_TAC[] THEN - SUBGOAL_THEN `&1 / &(SUC m) <= inv(&m:real)` ASSUME_TAC THENL - [REWRITE_TAC[real_div; REAL_MUL_LID] THEN - MATCH_MP_TAC REAL_LE_INV2 THEN CONJ_TAC THENL - [REWRITE_TAC[REAL_OF_NUM_LT] THEN ASM_ARITH_TAC; - REWRITE_TAC[REAL_OF_NUM_LE] THEN ARITH_TAC]; - ASM_REAL_ARITH_TAC]]; - DISCH_THEN ACCEPT_TAC]]]);; + MP_TAC(ISPECL [`p:A prob_space`; `(Z:num->A->real) i`; `(a:num->real) i`] + PROB_STRICT_INEQ_LIMIT) THEN + ASM_REWRITE_TAC[ETA_AX]]);; (* Lemma C: nsfa preserves mutual independence *) let MUTUALLY_INDEP_RV_SEQ_NSFA = prove @@ -15428,6 +17709,7 @@ let MUTUALLY_INDEP_RV_SEQ_NSFA = prove DISCH_THEN(MP_TAC o SPEC `i:num`) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> REWRITE_TAC[th]));; + (* Helper: product of indicator functions = indicator of INTERS *) let PRODUCT_INDICATOR_FN_INTERS = prove (`!R (A:num->(A->bool)) (x:A). FINITE R /\ ~(R = {}) @@ -17354,7 +19636,7 @@ let EXPECTATION_SUMMABLE_CHEBYSHEV = prove {x:A | x IN prob_carrier p /\ abs(sum(K + a..K + a + b) (\i. (Y:num->A->real) i x)) >= eps / &2} IN prob_events p` (LABEL_TAC "Sev") THENL - [REPEAT GEN_TAC THEN MATCH_MP_TAC RANDOM_VARIABLE_GE THEN + [REPEAT GEN_TAC THEN MATCH_MP_TAC RV_PREIMAGE_GE THEN MATCH_MP_TAC RANDOM_VARIABLE_ABS THEN SUBGOAL_THEN `(\x:A. sum(K + a..K + a + b) (\i. (Y:num->A->real) i x)) = @@ -17565,7 +19847,7 @@ let EXPECTATION_SUMMABLE_CHEBYSHEV = prove SUBGOAL_THEN `{x:A | x IN prob_carrier p /\ abs(sum(m1..n1) (\i. (Z:num->A->real) i x)) >= eps / &2} IN prob_events p` ASSUME_TAC THENL - [MATCH_MP_TAC RANDOM_VARIABLE_GE THEN + [MATCH_MP_TAC RV_PREIMAGE_GE THEN MATCH_MP_TAC RANDOM_VARIABLE_ABS THEN SUBGOAL_THEN `n1 = m1 + nn:num` (fun th -> REWRITE_TAC[th; SUM_REINDEX_SHIFT]) THENL [ASM_ARITH_TAC; ALL_TAC] THEN MATCH_MP_TAC RANDOM_VARIABLE_SUM THEN REPEAT STRIP_TAC THEN @@ -17746,6 +20028,7 @@ let EXPECTATION_SUMMABLE_CHEBYSHEV = prove ALL_TAC] THEN ASM_MESON_TAC[REAL_LTE_TRANS; REAL_LT_TRANS; REAL_LT_REFL]);; + let THREE_SERIES_NECESSITY_INDEP = prove (`!p:A prob_space (X:num->A->real) c. &0 < c /\ diff --git a/Probability/distributions.ml b/Probability/distributions.ml index 267560d0..9dcbd8f4 100644 --- a/Probability/distributions.ml +++ b/Probability/distributions.ml @@ -1862,3 +1862,3942 @@ let NEG_BINOMIAL_VARIANCE_SERIES = prove UNDISCH_TAC `~(p = &0)` THEN CONV_TAC REAL_FIELD; ALL_TAC] THEN ASM_REWRITE_TAC[]);; + +(* ========================================================================= *) +(* Standard normal CDF properties *) +(* ========================================================================= *) + +(* Phi(-x) + Phi(x) = 1: complement/symmetry property *) +let STD_NORMAL_CDF_COMPLEMENT = prove + (`!x. std_normal_cdf(--x) + std_normal_cdf x = &1`, + GEN_TAC THEN REWRITE_TAC[std_normal_cdf] THEN + SUBGOAL_THEN + `real_integral {t | t <= --x} std_normal_density = + real_integral {t:real | x <= t} std_normal_density` + SUBST1_TAC THENL + [SUBGOAL_THEN + `(\t. std_normal_density(--t)) = std_normal_density` + ASSUME_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; STD_NORMAL_DENSITY_SYM]; ALL_TAC] THEN + FIRST_X_ASSUM(fun th -> + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM th]) THEN + REWRITE_TAC[REAL_INTEGRAL_REFLECT_GEN] THEN + SUBGOAL_THEN `IMAGE ((--):real->real) {t | t <= --x} = {t:real | x <= t}` + (fun th -> REWRITE_TAC[th]) THEN + REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM] THEN + X_GEN_TAC `y:real` THEN EQ_TAC THEN STRIP_TAC THENL + [ASM_REAL_ARITH_TAC; + EXISTS_TAC `--y:real` THEN ASM_REAL_ARITH_TAC]; + MATCH_MP_TAC(ISPEC `std_normal_density` HAS_REAL_INTEGRAL_UNIQUE) THEN + EXISTS_TAC `(:real)` THEN REWRITE_TAC[STD_NORMAL_DENSITY_INTEGRAL] THEN + SUBGOAL_THEN `(:real) = {t:real | t <= x} UNION {t | x <= t}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_UNION; IN_UNIV; IN_ELIM_THM] THEN + REAL_ARITH_TAC; ALL_TAC] THEN + ONCE_REWRITE_TAC[REAL_ADD_SYM] THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_UNION THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_INTEGRAL THEN + REWRITE_TAC[STD_NORMAL_DENSITY_INTEGRABLE_HALFLINE]; + MATCH_MP_TAC REAL_INTEGRABLE_INTEGRAL THEN + MATCH_MP_TAC REAL_INTEGRABLE_ON_SUBINTERVAL_GEN THEN + EXISTS_TAC `(:real)` THEN + REWRITE_TAC[STD_NORMAL_DENSITY_INTEGRABLE; SUBSET_UNIV] THEN + REWRITE_TAC[is_realinterval; IN_ELIM_THM] THEN REAL_ARITH_TAC; + MATCH_MP_TAC REAL_NEGLIGIBLE_SUBSET THEN EXISTS_TAC `{x:real}` THEN + REWRITE_TAC[REAL_NEGLIGIBLE_SING; SUBSET; IN_INTER; + IN_ELIM_THM; IN_SING] THEN + REAL_ARITH_TAC]]);; + +(* Phi(0) = 1/2 *) +let STD_NORMAL_CDF_ZERO = prove + (`std_normal_cdf(&0) = &1 / &2`, + MP_TAC(SPEC `&0` STD_NORMAL_CDF_COMPLEMENT) THEN + REWRITE_TAC[REAL_NEG_0] THEN REAL_ARITH_TAC);; + +(* Helper: integral of density over [-n,n] tends to 1 via MCT *) +let STD_NORMAL_INTEGRAL_INTERVAL_TENDS_1 = prove + (`((\n. real_integral (real_interval[-- &n, &n]) std_normal_density) + ---> &1) sequentially`, + SUBGOAL_THEN + `real_integral (:real) std_normal_density = &1` + ASSUME_TAC THENL + [MATCH_MP_TAC(ISPEC `std_normal_density` HAS_REAL_INTEGRAL_UNIQUE) THEN + EXISTS_TAC `(:real)` THEN + REWRITE_TAC[STD_NORMAL_DENSITY_INTEGRAL] THEN + MATCH_MP_TAC REAL_INTEGRABLE_INTEGRAL THEN + REWRITE_TAC[STD_NORMAL_DENSITY_INTEGRABLE]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `(\n. real_integral (real_interval[-- &n, &n]) std_normal_density) = + (\n. real_integral (:real) + (\x. if x IN real_interval[-- &n, &n] + then std_normal_density x else &0))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; REAL_INTEGRAL_RESTRICT_UNIV]; ALL_TAC] THEN + SUBGOAL_THEN `&1 = real_integral (:real) std_normal_density` + SUBST1_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL + [`\k:num. \x:real. if x IN real_interval[-- &k, &k] + then std_normal_density x else &0`; + `std_normal_density`; + `(:real)`] + REAL_MONOTONE_CONVERGENCE_INCREASING) THEN + ANTS_TAC THENL + [REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [(* Integrability *) + GEN_TAC THEN REWRITE_TAC[REAL_INTEGRABLE_RESTRICT_UNIV] THEN + MATCH_MP_TAC REAL_INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `(:real)` THEN + REWRITE_TAC[STD_NORMAL_DENSITY_INTEGRABLE; SUBSET_UNIV]; + (* Monotonicity *) + REPEAT GEN_TAC THEN REWRITE_TAC[IN_UNIV] THEN + COND_CASES_TAC THENL + [SUBGOAL_THEN `x IN real_interval[-- &(SUC k), &(SUC k)]` + (fun th -> REWRITE_TAC[th]) THENL + [FIRST_X_ASSUM MP_TAC THEN + REWRITE_TAC[IN_REAL_INTERVAL; GSYM REAL_OF_NUM_SUC] THEN + REAL_ARITH_TAC; + REAL_ARITH_TAC]; + COND_CASES_TAC THEN + REWRITE_TAC[STD_NORMAL_DENSITY_NONNEG; REAL_LE_REFL]]; + (* Pointwise convergence *) + X_GEN_TAC `x:real` THEN REWRITE_TAC[IN_UNIV] THEN + REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(SPEC `abs(x:real)` REAL_ARCH_SIMPLE) THEN + DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN + EXISTS_TAC `N:num` THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN + SUBGOAL_THEN `x IN real_interval[-- &n, &n]` + (fun th -> REWRITE_TAC[th]) THENL + [REWRITE_TAC[IN_REAL_INTERVAL] THEN + UNDISCH_TAC `abs(x:real) <= &N` THEN + UNDISCH_TAC `N <= n:num` THEN + REWRITE_TAC[GSYM REAL_OF_NUM_LE] THEN REAL_ARITH_TAC; + REWRITE_TAC[REAL_SUB_REFL; REAL_ABS_0] THEN ASM_REWRITE_TAC[]]; + (* Bounded integrals *) + REWRITE_TAC[real_bounded; FORALL_IN_GSPEC; IN_UNIV] THEN + EXISTS_TAC `&1` THEN + X_GEN_TAC `k:num` THEN + REWRITE_TAC[REAL_INTEGRAL_RESTRICT_UNIV] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= &1 ==> abs x <= &1`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRAL_POS THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `(:real)` THEN + REWRITE_TAC[STD_NORMAL_DENSITY_INTEGRABLE; SUBSET_UNIV]; + REWRITE_TAC[IN_REAL_INTERVAL; STD_NORMAL_DENSITY_NONNEG]]; + MP_TAC(ISPECL [`std_normal_density`; + `real_interval[-- &k, &k]`; + `(:real)`; + `real_integral (real_interval[-- &k, &k]) + std_normal_density`; + `&1`] HAS_REAL_INTEGRAL_SUBSET_LE) THEN + REWRITE_TAC[SUBSET_UNIV; STD_NORMAL_DENSITY_INTEGRAL; + IN_UNIV; STD_NORMAL_DENSITY_NONNEG] THEN + DISCH_THEN MATCH_MP_TAC THEN + MATCH_MP_TAC REAL_INTEGRABLE_INTEGRAL THEN + MATCH_MP_TAC REAL_INTEGRABLE_ON_SUBINTERVAL THEN + EXISTS_TAC `(:real)` THEN + REWRITE_TAC[STD_NORMAL_DENSITY_INTEGRABLE; SUBSET_UNIV]]]; + DISCH_THEN(MP_TAC o CONJUNCT2) THEN + REWRITE_TAC[REAL_INTEGRAL_RESTRICT_UNIV] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REALLIM_TRANSFORM) THEN + REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + EXISTS_TAC `0` THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[REAL_SUB_REFL; REAL_ABS_0] THEN + ASM_REWRITE_TAC[]]);; + +(* CDF(n) -> 1 sequentially *) +let STD_NORMAL_CDF_SEQ_TENDS_1 = prove + (`((\n. std_normal_cdf(&n)) ---> &1) sequentially`, + SUBGOAL_THEN + `!n:num. real_integral (real_interval[-- &n, &n]) std_normal_density = + &2 * std_normal_cdf(&n) - &1` + ASSUME_TAC THENL + [X_GEN_TAC `n:num` THEN + SUBGOAL_THEN `-- &n <= &n:real` ASSUME_TAC THENL + [REWRITE_TAC[REAL_NEG_LE0; REAL_POS]; ALL_TAC] THEN + MP_TAC(SPECL [`-- &n:real`; `&n:real`] STD_NORMAL_CDF_INTERVAL) THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(SPEC `&n:real` STD_NORMAL_CDF_COMPLEMENT) THEN + REWRITE_TAC[REAL_NEG_NEG] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `(\n. std_normal_cdf(&n)) = + (\n. (real_integral (real_interval[-- &n, &n]) std_normal_density + &1) + * inv(&2))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `n:num` THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `&1 = (&1 + &1) * inv(&2)` + (fun th -> GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV) [th]) THENL + [CONV_TAC REAL_FIELD; ALL_TAC] THEN + MATCH_MP_TAC REALLIM_RMUL THEN + MATCH_MP_TAC REALLIM_ADD THEN + REWRITE_TAC[STD_NORMAL_INTEGRAL_INTERVAL_TENDS_1; REALLIM_CONST]);; + +(* Phi(x) -> 1 as x -> +infinity *) +let STD_NORMAL_CDF_LIMIT_POS = prove + (`(std_normal_cdf ---> &1) at_posinfinity`, + REWRITE_TAC[REALLIM_AT_POSINFINITY] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC STD_NORMAL_CDF_SEQ_TENDS_1 THEN + REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + DISCH_THEN(MP_TAC o SPEC `e:real`) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN + EXISTS_TAC `&N` THEN + X_GEN_TAC `x:real` THEN DISCH_TAC THEN + MP_TAC(SPEC `x:real` STD_NORMAL_CDF_BOUNDS) THEN + MP_TAC(SPECL [`&N:real`; `x:real`] STD_NORMAL_CDF_MONO) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `N:num`) THEN + REWRITE_TAC[LE_REFL] THEN + REAL_ARITH_TAC);; + +(* Phi(x) -> 0 as x -> -infinity *) +let STD_NORMAL_CDF_LIMIT_NEG = prove + (`(std_normal_cdf ---> &0) at_neginfinity`, + REWRITE_TAC[REALLIM_AT_NEGINFINITY] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC STD_NORMAL_CDF_LIMIT_POS THEN + REWRITE_TAC[REALLIM_AT_POSINFINITY] THEN + DISCH_THEN(MP_TAC o SPEC `e:real`) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `b:real`) THEN + EXISTS_TAC `--b:real` THEN + X_GEN_TAC `x:real` THEN DISCH_TAC THEN + MP_TAC(SPEC `--x:real` STD_NORMAL_CDF_COMPLEMENT) THEN + REWRITE_TAC[REAL_NEG_NEG] THEN DISCH_TAC THEN + MP_TAC(SPEC `x:real` STD_NORMAL_CDF_BOUNDS) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `--x:real`) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_REAL_ARITH_TAC);; + +(* ========================================================================= *) +(* General normal N(mu, sigma^2) distribution *) +(* ========================================================================= *) + +let normal_density = new_definition + `normal_density (mu:real) (sigma:real) (x:real) = + inv(sigma * sqrt(&2 * pi)) * + exp(--((x - mu) pow 2 / (&2 * sigma pow 2)))`;; + +(* CDF defined via standardization: Phi_mu,sigma(x) = Phi((x-mu)/sigma) *) +let normal_cdf = new_definition + `normal_cdf (mu:real) (sigma:real) (x:real) = + std_normal_cdf((x - mu) / sigma)`;; + +(* Density standardization: phi_mu,sigma(x) = (1/sigma) * phi((x-mu)/sigma) *) +let NORMAL_DENSITY_STANDARDIZE = prove + (`!mu sigma x. &0 < sigma ==> + normal_density mu sigma x = + inv(sigma) * std_normal_density((x - mu) / sigma)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[normal_density; std_normal_density] THEN + SUBGOAL_THEN `~(sigma = &0)` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `~(sigma pow 2 = &0)` ASSUME_TAC THENL + [REWRITE_TAC[REAL_POW_EQ_0] THEN ASM_REWRITE_TAC[ARITH]; ALL_TAC] THEN + SUBGOAL_THEN + `((x - mu) / sigma) pow 2 / &2 = (x - mu) pow 2 / (&2 * sigma pow 2)` + SUBST1_TAC THENL + [REWRITE_TAC[REAL_POW_DIV] THEN + ASM_SIMP_TAC[REAL_FIELD + `~(s = &0) ==> + (x - mu) pow 2 / s pow 2 / &2 = + (x - mu) pow 2 / (&2 * s pow 2)`]; + ALL_TAC] THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN + ASM_SIMP_TAC[REAL_FIELD + `~(s = &0) ==> inv(s) * inv(sqrt(&2 * pi)) = inv(s * sqrt(&2 * pi))`]);; + +(* Standard normal is special case mu=0, sigma=1 *) +let NORMAL_DENSITY_STANDARD = prove + (`!x. normal_density (&0) (&1) x = std_normal_density x`, + GEN_TAC THEN REWRITE_TAC[normal_density; std_normal_density] THEN + REWRITE_TAC[REAL_SUB_RZERO; REAL_MUL_LID; + REAL_POW_ONE; REAL_MUL_RID]);; + +let NORMAL_CDF_STANDARD = prove + (`!x. normal_cdf (&0) (&1) x = std_normal_cdf x`, + GEN_TAC THEN REWRITE_TAC[normal_cdf] THEN + AP_TERM_TAC THEN REAL_ARITH_TAC);; + +(* Density positivity *) +let NORMAL_DENSITY_POS = prove + (`!mu sigma x. &0 < sigma ==> &0 < normal_density mu sigma x`, + REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[NORMAL_DENSITY_STANDARDIZE] THEN + MATCH_MP_TAC REAL_LT_MUL THEN + REWRITE_TAC[STD_NORMAL_DENSITY_POS] THEN + MATCH_MP_TAC REAL_LT_INV THEN ASM_REAL_ARITH_TAC);; + +let NORMAL_DENSITY_NONNEG = prove + (`!mu sigma x. &0 < sigma ==> &0 <= normal_density mu sigma x`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN + ASM_SIMP_TAC[NORMAL_DENSITY_POS]);; + +(* Density symmetry about the mean *) +let NORMAL_DENSITY_SYM = prove + (`!mu sigma x. normal_density mu sigma (mu + x) = + normal_density mu sigma (mu - x)`, + REPEAT GEN_TAC THEN REWRITE_TAC[normal_density] THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + REAL_ARITH_TAC);; + +(* CDF bounds *) +let NORMAL_CDF_BOUNDS = prove + (`!mu sigma x. &0 < sigma ==> + &0 <= normal_cdf mu sigma x /\ normal_cdf mu sigma x <= &1`, + REPEAT STRIP_TAC THEN REWRITE_TAC[normal_cdf] THEN + MP_TAC(ISPEC `(x - mu:real) / sigma` STD_NORMAL_CDF_BOUNDS) THEN + REAL_ARITH_TAC);; + +(* CDF monotonicity *) +let NORMAL_CDF_MONO = prove + (`!mu sigma x y. &0 < sigma /\ x <= y ==> + normal_cdf mu sigma x <= normal_cdf mu sigma y`, + REPEAT STRIP_TAC THEN REWRITE_TAC[normal_cdf] THEN + MATCH_MP_TAC STD_NORMAL_CDF_MONO THEN + ASM_SIMP_TAC[REAL_LE_DIV2_EQ] THEN + ASM_REAL_ARITH_TAC);; + +(* CDF continuity *) +let NORMAL_CDF_CONTINUOUS = prove + (`!mu sigma x. &0 < sigma ==> + normal_cdf mu sigma real_continuous atreal x`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `normal_cdf mu sigma = + std_normal_cdf o (\t. (t - mu) / sigma)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; o_THM; normal_cdf]; ALL_TAC] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_COMPOSE THEN + CONJ_TAC THENL + [REWRITE_TAC[real_div] THEN + MATCH_MP_TAC REAL_CONTINUOUS_RMUL THEN + MATCH_MP_TAC REAL_CONTINUOUS_SUB THEN + REWRITE_TAC[REAL_CONTINUOUS_CONST; REAL_CONTINUOUS_AT_ID]; + REWRITE_TAC[STD_NORMAL_CDF_CONTINUOUS]]);; + +(* CDF complement: Phi(mu-x) + Phi(mu+x) = 1 *) +let NORMAL_CDF_COMPLEMENT = prove + (`!mu sigma x. &0 < sigma ==> + normal_cdf mu sigma (mu - x) + normal_cdf mu sigma (mu + x) = &1`, + REPEAT STRIP_TAC THEN REWRITE_TAC[normal_cdf; real_div] THEN + SUBGOAL_THEN `(mu - x - mu:real) * inv sigma = --(x * inv sigma)` + SUBST1_TAC THENL + [SUBGOAL_THEN `mu - x - mu:real = --x` SUBST1_TAC THENL + [REAL_ARITH_TAC; REWRITE_TAC[REAL_MUL_LNEG]]; + ALL_TAC] THEN + SUBGOAL_THEN `((mu + x) - mu:real) * inv sigma = x * inv sigma` + SUBST1_TAC THENL + [SUBGOAL_THEN `(mu + x) - mu:real = x` SUBST1_TAC THENL + [REAL_ARITH_TAC; REWRITE_TAC[]]; + REWRITE_TAC[GSYM real_div; STD_NORMAL_CDF_COMPLEMENT]]);; + +(* CDF at the mean = 1/2 *) +let NORMAL_CDF_MEAN = prove + (`!mu sigma. &0 < sigma ==> + normal_cdf mu sigma mu = &1 / &2`, + REPEAT STRIP_TAC THEN REWRITE_TAC[normal_cdf] THEN + SUBGOAL_THEN `(mu - mu:real) / sigma = &0` SUBST1_TAC THENL + [REWRITE_TAC[real_div; REAL_SUB_REFL; REAL_MUL_LZERO]; + REWRITE_TAC[STD_NORMAL_CDF_ZERO]]);; + +(* CDF limits *) +let NORMAL_CDF_LIMIT_POS = prove + (`!mu sigma. &0 < sigma ==> + (normal_cdf mu sigma ---> &1) at_posinfinity`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `normal_cdf mu sigma = (\x. std_normal_cdf((x - mu) / sigma))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; normal_cdf]; ALL_TAC] THEN + REWRITE_TAC[REALLIM_AT_POSINFINITY] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC STD_NORMAL_CDF_LIMIT_POS THEN + REWRITE_TAC[REALLIM_AT_POSINFINITY] THEN + DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `b:real`) THEN + EXISTS_TAC `mu + sigma * b:real` THEN + X_GEN_TAC `y:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(y - mu:real) / sigma`) THEN + ANTS_TAC THENL + [REWRITE_TAC[real_ge] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ] THEN + UNDISCH_TAC `y >= mu + sigma * b` THEN + REWRITE_TAC[real_ge] THEN REAL_ARITH_TAC; + REWRITE_TAC[]]);; + +let NORMAL_CDF_LIMIT_NEG = prove + (`!mu sigma. &0 < sigma ==> + (normal_cdf mu sigma ---> &0) at_neginfinity`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `normal_cdf mu sigma = (\x. std_normal_cdf((x - mu) / sigma))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; normal_cdf]; ALL_TAC] THEN + REWRITE_TAC[REALLIM_AT_NEGINFINITY] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC STD_NORMAL_CDF_LIMIT_NEG THEN + REWRITE_TAC[REALLIM_AT_NEGINFINITY] THEN + DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `b:real`) THEN + EXISTS_TAC `mu + sigma * b:real` THEN + X_GEN_TAC `y:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(y - mu:real) / sigma`) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[REAL_LE_LDIV_EQ] THEN + UNDISCH_TAC `y <= mu + sigma * b` THEN REAL_ARITH_TAC; + REWRITE_TAC[]]);; + +(* Change of variables for integrals over all of R *) +let HAS_REAL_INTEGRAL_AFFINITY_UNIV = prove + (`!f i m c. (f has_real_integral i) (:real) /\ ~(m = &0) ==> + ((\x. f(m * x + c)) has_real_integral (inv(abs m) * i)) (:real)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[has_real_integral; IMAGE_LIFT_UNIV] THEN + REWRITE_TAC[LIFT_CMUL; DIMINDEX_1; REAL_POW_1] THEN + SUBGOAL_THEN + `lift o (\x. f(m * x + c)) o drop = + (\x:real^1. (lift o f o drop) (m % x + lift c))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; o_THM; DROP_ADD; DROP_CMUL; LIFT_DROP]; + ALL_TAC] THEN + SUBGOAL_THEN + `(:real^1) = IMAGE (\x. inv m % x + --(inv m % lift c)) (:real^1)` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_UNIV; IN_IMAGE] THEN + X_GEN_TAC `y:real^1` THEN + EXISTS_TAC `m % y + lift c:real^1` THEN + REWRITE_TAC[VECTOR_ADD_LDISTRIB; VECTOR_MUL_ASSOC; + VECTOR_MUL_RNEG] THEN + ASM_SIMP_TAC[REAL_MUL_LINV] THEN VECTOR_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(ISPECL [`lift o (f:real->real) o drop`; `lift i:real^1`; + `(:real^1)`; `m:real`; `lift c:real^1`] HAS_INTEGRAL_AFFINITY) THEN + ASM_REWRITE_TAC[DIMINDEX_1; REAL_POW_1] THEN + DISCH_THEN MATCH_MP_TAC THEN + UNDISCH_TAC `(f has_real_integral i) (:real)` THEN + REWRITE_TAC[has_real_integral; IMAGE_LIFT_UNIV]);; + +(* Normal density integrates to 1 *) +let NORMAL_DENSITY_INTEGRAL = prove + (`!mu sigma. &0 < sigma ==> + (normal_density mu sigma has_real_integral &1) (:real)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `~(sigma = &0)` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `normal_density mu sigma = + (\x. inv sigma * std_normal_density ((x - mu) / sigma))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + ASM_SIMP_TAC[NORMAL_DENSITY_STANDARDIZE]; + ALL_TAC] THEN + SUBGOAL_THEN + `(\x. inv sigma * std_normal_density ((x - mu) / sigma)) = + (\x. inv sigma * std_normal_density (inv sigma * x + --(mu / sigma)))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:real` THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN + UNDISCH_TAC `~(sigma = &0)` THEN CONV_TAC REAL_FIELD; + ALL_TAC] THEN + SUBGOAL_THEN `&1 = inv(sigma) * sigma` SUBST1_TAC THENL + [ASM_SIMP_TAC[REAL_MUL_LINV]; ALL_TAC] THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_LMUL THEN + MP_TAC(ISPECL [`std_normal_density`; `&1`; `inv(sigma):real`; + `--(mu / sigma):real`] HAS_REAL_INTEGRAL_AFFINITY_UNIV) THEN + ASM_SIMP_TAC[REAL_INV_EQ_0; STD_NORMAL_DENSITY_INTEGRAL] THEN + REWRITE_TAC[REAL_MUL_RID; REAL_ABS_INV] THEN + ASM_SIMP_TAC[REAL_ABS_REFL; REAL_LT_IMP_LE; REAL_INV_INV] THEN + SUBGOAL_THEN `abs sigma = sigma` (fun th -> REWRITE_TAC[th]) THEN + ASM_REAL_ARITH_TAC);; + +(* Normal density integrable over R *) +let NORMAL_DENSITY_INTEGRABLE = prove + (`!mu sigma. &0 < sigma ==> + normal_density mu sigma real_integrable_on (:real)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[real_integrable_on] THEN + EXISTS_TAC `&1` THEN ASM_SIMP_TAC[NORMAL_DENSITY_INTEGRAL]);; + +(* Helper: standard normal weighted integral for mean *) +let NORMAL_MEAN_HELPER = prove + (`!mu sigma. &0 < sigma ==> + ((\t. (mu + sigma * t) * std_normal_density t) has_real_integral mu) + (:real)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `((\t. mu * std_normal_density t) has_real_integral mu * &1) (:real) /\ + ((\t. sigma * (t * std_normal_density t)) has_real_integral sigma * &0) + (:real)` + (fun th -> MP_TAC(MATCH_MP HAS_REAL_INTEGRAL_ADD th)) THENL + [CONJ_TAC THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_LMUL THEN + REWRITE_TAC[STD_NORMAL_DENSITY_INTEGRAL; STD_NORMAL_MEAN_ZERO]; + ALL_TAC] THEN + REWRITE_TAC[REAL_MUL_RID; REAL_MUL_RZERO; REAL_ADD_RID] THEN + SUBGOAL_THEN + `(\x:real. mu * std_normal_density x + sigma * x * std_normal_density x) = + (\t. (mu + sigma * t) * std_normal_density t)` + (fun th -> REWRITE_TAC[GSYM th]) THEN + REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN REAL_ARITH_TAC);; + +(* Normal mean: E[X] = mu *) +let NORMAL_MEAN = prove + (`!mu sigma. &0 < sigma ==> + ((\x. x * normal_density mu sigma x) has_real_integral mu) (:real)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `~(sigma = &0)` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `~(inv sigma = &0)` ASSUME_TAC THENL + [ASM_SIMP_TAC[REAL_INV_EQ_0]; ALL_TAC] THEN + SUBGOAL_THEN + `(\x. x * normal_density mu sigma x) = + (\x. inv(sigma) * (x * std_normal_density((x - mu) / sigma)))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:real` THEN + ASM_SIMP_TAC[NORMAL_DENSITY_STANDARDIZE] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `((\x. x * std_normal_density((x - mu) / sigma)) has_real_integral + sigma * mu) (:real)` + (fun th -> + MP_TAC(SPEC `inv(sigma):real` (MATCH_MP HAS_REAL_INTEGRAL_LMUL th))) + THENL + [MP_TAC(SPECL [`mu:real`; `sigma:real`] NORMAL_MEAN_HELPER) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`\t:real. (mu + sigma * t) * std_normal_density t`; + `mu:real`; `inv(sigma):real`; `--(mu / sigma):real`] + HAS_REAL_INTEGRAL_AFFINITY_UNIV) THEN + ASM_SIMP_TAC[REAL_INV_EQ_0] THEN + SUBGOAL_THEN + `!x:real. mu + sigma * (inv sigma * x + --(mu / sigma)) = x` + (fun th -> REWRITE_TAC[th]) THENL + [X_GEN_TAC `x:real` THEN + UNDISCH_TAC `~(sigma = &0)` THEN CONV_TAC REAL_FIELD; + ALL_TAC] THEN + SUBGOAL_THEN + `!x:real. inv sigma * x + --(mu / sigma) = (x - mu) / sigma` + (fun th -> REWRITE_TAC[th]) THENL + [X_GEN_TAC `x:real` THEN + UNDISCH_TAC `~(sigma = &0)` THEN CONV_TAC REAL_FIELD; + ALL_TAC] THEN + SUBGOAL_THEN `inv (abs (inv sigma)) * mu = sigma * mu` + (fun th -> REWRITE_TAC[th]) THEN + REWRITE_TAC[REAL_ABS_INV] THEN + SUBGOAL_THEN `abs sigma = sigma` (fun th -> REWRITE_TAC[th]) THENL + [ASM_REAL_ARITH_TAC; ASM_SIMP_TAC[REAL_INV_INV; REAL_MUL_LID]]; + SUBGOAL_THEN `inv sigma * (sigma * mu) = mu:real` + (fun th -> REWRITE_TAC[th]) THEN + UNDISCH_TAC `~(sigma = &0)` THEN CONV_TAC REAL_FIELD]);; + +(* Normal mean - integral form *) +let NORMAL_MEAN_INTEGRAL = prove + (`!mu sigma. &0 < sigma ==> + real_integral (:real) (\x. x * normal_density mu sigma x) = mu`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + ASM_SIMP_TAC[NORMAL_MEAN]);; + +(* Normal variance: Var(X) = sigma^2 *) +let NORMAL_VARIANCE = prove + (`!mu sigma. &0 < sigma ==> + ((\x. (x - mu) pow 2 * normal_density mu sigma x) has_real_integral + sigma pow 2) (:real)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `~(sigma = &0)` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `~(inv sigma = &0)` ASSUME_TAC THENL + [ASM_SIMP_TAC[REAL_INV_EQ_0]; ALL_TAC] THEN + SUBGOAL_THEN + `(\x. (x - mu) pow 2 * normal_density mu sigma x) = + (\x. sigma pow 2 * (((x - mu) / sigma) pow 2 * + (inv sigma * std_normal_density((x - mu) / sigma))))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:real` THEN + ASM_SIMP_TAC[NORMAL_DENSITY_STANDARDIZE; REAL_POW_DIV] THEN + UNDISCH_TAC `~(sigma = &0)` THEN CONV_TAC REAL_FIELD; + ALL_TAC] THEN + GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV) [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_LMUL THEN + SUBGOAL_THEN + `(\x. ((x - mu) / sigma) pow 2 * + inv sigma * std_normal_density ((x - mu) / sigma)) = + (\x. inv sigma * (((x - mu) / sigma) pow 2 * + std_normal_density ((x - mu) / sigma)))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `&1 = inv sigma * sigma` SUBST1_TAC THENL + [ASM_SIMP_TAC[REAL_MUL_LINV]; ALL_TAC] THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_LMUL THEN + MP_TAC(ISPECL [`\t:real. t pow 2 * std_normal_density t`; + `&1`; `inv(sigma):real`; `--(mu / sigma):real`] + HAS_REAL_INTEGRAL_AFFINITY_UNIV) THEN + ASM_SIMP_TAC[REAL_INV_EQ_0; STD_NORMAL_SECOND_MOMENT] THEN + SUBGOAL_THEN + `!x:real. inv sigma * x + --(mu / sigma) = (x - mu) / sigma` + (fun th -> REWRITE_TAC[th]) THENL + [X_GEN_TAC `x:real` THEN + UNDISCH_TAC `~(sigma = &0)` THEN CONV_TAC REAL_FIELD; + ALL_TAC] THEN + SUBGOAL_THEN `inv (abs (inv sigma)) * &1 = sigma` + (fun th -> REWRITE_TAC[th]) THEN + REWRITE_TAC[REAL_MUL_RID; REAL_ABS_INV] THEN + SUBGOAL_THEN `abs sigma = sigma` (fun th -> REWRITE_TAC[th]) THENL + [ASM_REAL_ARITH_TAC; ASM_SIMP_TAC[REAL_INV_INV]]);; + +(* Normal variance - integral form *) +let NORMAL_VARIANCE_INTEGRAL = prove + (`!mu sigma. &0 < sigma ==> + real_integral (:real) (\x. (x - mu) pow 2 * normal_density mu sigma x) = + sigma pow 2`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + ASM_SIMP_TAC[NORMAL_VARIANCE]);; + +(* ========================================================================= *) +(* Exponential distribution Exp(lambda) *) +(* *) +(* Density: lambda * exp(-lambda * x) for x >= 0, 0 otherwise *) +(* CDF: 1 - exp(-lambda * x) for x >= 0, 0 otherwise *) +(* Mean: 1/lambda, Variance: 1/lambda^2 *) +(* Key property: memoryless *) +(* ========================================================================= *) + +(* Exponential density function *) +let exponential_density = new_definition + `exponential_density (l:real) (x:real) = + if &0 <= x then l * exp(--l * x) else &0`;; + +(* Density is non-negative when lambda > 0 *) +let EXPONENTIAL_DENSITY_NONNEG = prove + (`!l x. &0 < l ==> &0 <= exponential_density l x`, + REPEAT STRIP_TAC THEN REWRITE_TAC[exponential_density] THEN + COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_REFL] THEN + MATCH_MP_TAC REAL_LE_MUL THEN + REWRITE_TAC[REAL_EXP_POS_LE] THEN ASM_REAL_ARITH_TAC);; + +(* Density is strictly positive for x > 0 *) +let EXPONENTIAL_DENSITY_POS = prove + (`!l x. &0 < l /\ &0 < x ==> &0 < exponential_density l x`, + REPEAT STRIP_TAC THEN REWRITE_TAC[exponential_density] THEN + SUBGOAL_THEN `&0 <= x` (fun th -> REWRITE_TAC[th]) THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LT_MUL THEN + ASM_REWRITE_TAC[REAL_EXP_POS_LT]);; + +(* Density at x=0 is lambda *) +let EXPONENTIAL_DENSITY_ZERO = prove + (`!l. exponential_density l (&0) = l`, + GEN_TAC THEN REWRITE_TAC[exponential_density; REAL_LE_REFL] THEN + REWRITE_TAC[REAL_MUL_RZERO; REAL_NEG_0; REAL_EXP_0; REAL_MUL_RID]);; + +(* Antiderivative of the exponential density *) +(* d/dx[-exp(-l*x)] = l * exp(-l*x) *) +let EXPONENTIAL_HAS_REAL_DERIVATIVE = prove + (`!l x. ((\x. --exp(--l * x)) has_real_derivative l * exp(--l * x)) + (atreal x)`, + REPEAT GEN_TAC THEN REAL_DIFF_TAC THEN REAL_ARITH_TAC);; + +(* Derivative within an interval *) +let EXPONENTIAL_HAS_REAL_DERIVATIVE_WITHIN = prove + (`!l x s. ((\x. --exp(--l * x)) has_real_derivative l * exp(--l * x)) + (atreal x within s)`, + REPEAT GEN_TAC THEN + MATCH_MP_TAC HAS_REAL_DERIVATIVE_ATREAL_WITHIN THEN + REWRITE_TAC[EXPONENTIAL_HAS_REAL_DERIVATIVE]);; + +(* Integral of exponential density on [0, a] via FTC *) +let EXPONENTIAL_INTEGRAL_INTERVAL = prove + (`!l a. &0 <= a ==> + ((\x. l * exp(--l * x)) has_real_integral (&1 - exp(--l * a))) + (real_interval[&0,a])`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\x:real. --exp(--l * x)`; + `\x:real. l * exp(--l * x)`; + `&0`; `a:real`] + REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [REPEAT STRIP_TAC THEN + REWRITE_TAC[EXPONENTIAL_HAS_REAL_DERIVATIVE_WITHIN]; + REWRITE_TAC[REAL_MUL_RZERO; REAL_NEG_0; REAL_EXP_0] THEN + REWRITE_TAC[REAL_ARITH `--exp(--l * a) - --(&1) = &1 - exp(--l * a)`]]);; + +(* Exponential density is continuous *) +let EXPONENTIAL_REAL_CONTINUOUS = prove + (`!l. (\x. l * exp(--l * x)) real_continuous_on (:real)`, + GEN_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_ON_LMUL THEN + SUBGOAL_THEN + `(\x:real. exp(--l * x)) = (exp o (\x. --l * x))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; o_THM]; ALL_TAC] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_COMPOSE THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_EXP] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_LMUL THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_ID]);; + +(* Exponential density integrable on any interval [0,a] *) +let EXPONENTIAL_INTEGRABLE_INTERVAL = prove + (`!l a. &0 <= a ==> + (\x. l * exp(--l * x)) real_integrable_on real_interval[&0,a]`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_INTEGRABLE THEN + EXISTS_TAC `&1 - exp(--l * a)` THEN + ASM_SIMP_TAC[EXPONENTIAL_INTEGRAL_INTERVAL]);; + +(* Key limit: exp(-l*a) -> 0 as a -> +infinity when l > 0 *) +let EXPONENTIAL_LIMIT_POSINFINITY = prove + (`!l. &0 < l ==> ((\a. exp(--l * a)) ---> &0) at_posinfinity`, + REPEAT STRIP_TAC THEN REWRITE_TAC[REALLIM_AT_POSINFINITY] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + EXISTS_TAC `(&1 / e + &1) / l:real` THEN + X_GEN_TAC `a:real` THEN DISCH_TAC THEN + REWRITE_TAC[REAL_SUB_RZERO; real_abs; REAL_EXP_POS_LE] THEN + SUBGOAL_THEN `inv e < l * a` ASSUME_TAC THENL + [SUBGOAL_THEN `inv e < l * ((&1 / e + &1) / l)` MP_TAC THENL + [ASM_SIMP_TAC[REAL_DIV_LMUL; REAL_LT_IMP_NZ] THEN + REWRITE_TAC[real_div; REAL_MUL_LID] THEN REAL_ARITH_TAC; + DISCH_TAC THEN MATCH_MP_TAC REAL_LTE_TRANS THEN + EXISTS_TAC `l * ((&1 / e + &1) / l):real` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_LMUL THEN + ASM_REWRITE_TAC[GSYM real_ge] THEN ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < l * a` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `inv e:real` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_INV THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `l * a < exp(l * a)` ASSUME_TAC THENL + [MP_TAC(SPEC `l * a:real` REAL_EXP_LE_X) THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(l * a):real` THEN + CONJ_TAC THENL + [ONCE_REWRITE_TAC[REAL_ARITH `--l * a = --(l * a:real)`] THEN + REWRITE_TAC[REAL_EXP_NEG] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC; + SUBGOAL_THEN `e = inv(inv e:real)` SUBST1_TAC THENL + [ASM_SIMP_TAC[REAL_INV_INV]; + MATCH_MP_TAC REAL_LT_INV2 THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_INV THEN + ASM_REWRITE_TAC[]]]);; + +(* Helper: the restricted integrals converge to 1 *) +let EXPONENTIAL_INTEGRAL_SEQ_TENDS_1 = prove + (`!l. &0 < l ==> + ((\k. &1 - exp(--l * &k)) ---> &1) sequentially`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `((\k:num. exp(--l * &k)) ---> &0) sequentially` + ASSUME_TAC THENL + [MP_TAC(SPEC `l:real` EXPONENTIAL_LIMIT_POSINFINITY) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o MATCH_MP REALLIM_POSINFINITY_SEQUENTIALLY) THEN + REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `&1 = &1 - &0` SUBST1_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REALLIM_SUB THEN + ASM_REWRITE_TAC[REAL_SUB_RZERO; REALLIM_CONST]);; + +(* Normalization: integral of density over [0,+inf) is 1 *) +let EXPONENTIAL_DENSITY_INTEGRAL = prove + (`!l. &0 < l ==> + ((\x. l * exp(--l * x)) has_real_integral &1) + {x | &0 <= x}`, + REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[GSYM HAS_REAL_INTEGRAL_RESTRICT_UNIV] THEN + CONV_TAC(ONCE_DEPTH_CONV BETA_CONV) THEN + REWRITE_TAC[IN_ELIM_THM] THEN + ABBREV_TAC `g = \x:real. if &0 <= x then l * exp(--l * x) else &0` THEN + ABBREV_TAC + `f = \k x:real. if &0 <= x /\ x <= &k then l * exp(--l * x) else &0` THEN + (* Step 1: establish f_k properties via monotone convergence *) + SUBGOAL_THEN + `g real_integrable_on (:real) /\ + ((\k. real_integral (:real) (f k)) ---> real_integral (:real) g) + sequentially` + STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC REAL_MONOTONE_CONVERGENCE_INCREASING THEN + REPEAT CONJ_TAC THENL + [(* f_k integrable *) + X_GEN_TAC `k:num` THEN EXPAND_TAC "f" THEN + SUBGOAL_THEN + `(\x. if &0 <= x /\ x <= &k then l * exp(--l * x) else &0) = + (\x. if x IN real_interval[&0,&k] then l * exp(--l * x) else &0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; IN_REAL_INTERVAL] THEN MESON_TAC[]; + REWRITE_TAC[real_integrable_on] THEN + EXISTS_TAC `&1 - exp(--l * &k)` THEN + REWRITE_TAC[HAS_REAL_INTEGRAL_RESTRICT_UNIV] THEN + MATCH_MP_TAC EXPONENTIAL_INTEGRAL_INTERVAL THEN + REWRITE_TAC[REAL_POS]]; + (* monotonicity *) + X_GEN_TAC `k:num` THEN X_GEN_TAC `x:real` THEN DISCH_TAC THEN + EXPAND_TAC "f" THEN REWRITE_TAC[GSYM REAL_OF_NUM_SUC] THEN + REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL]) THEN + TRY(MATCH_MP_TAC REAL_LE_MUL THEN + REWRITE_TAC[REAL_EXP_POS_LE] THEN ASM_REAL_ARITH_TAC) THEN + ASM_REAL_ARITH_TAC; + (* pointwise convergence *) + X_GEN_TAC `x:real` THEN DISCH_TAC THEN + EXPAND_TAC "f" THEN EXPAND_TAC "g" THEN + ASM_CASES_TAC `&0 <= x` THENL + [ASM_REWRITE_TAC[] THEN REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(SPEC `x:real` REAL_ARCH_SIMPLE) THEN + DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN + EXISTS_TAC `N:num` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + SUBGOAL_THEN `x <= &n` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&N` THEN + ASM_REWRITE_TAC[REAL_OF_NUM_LE]; + ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_ABS_NUM] THEN + ASM_REAL_ARITH_TAC]; + ASM_REWRITE_TAC[] THEN REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `0` THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC]; + (* bounded integrals *) + REWRITE_TAC[real_bounded; FORALL_IN_GSPEC; IN_UNIV] THEN + EXISTS_TAC `&1` THEN X_GEN_TAC `k:num` THEN + SUBGOAL_THEN + `real_integral (:real) ((f:num->real->real) k) = &1 - exp(--l * &k)` + SUBST1_TAC THENL + [EXPAND_TAC "f" THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + SUBGOAL_THEN + `(\x. if &0 <= x /\ x <= &k then l * exp(--l * x) else &0) = + (\x. if x IN real_interval[&0,&k] then l * exp(--l * x) else &0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; IN_REAL_INTERVAL] THEN MESON_TAC[]; + REWRITE_TAC[HAS_REAL_INTEGRAL_RESTRICT_UNIV] THEN + MATCH_MP_TAC EXPONENTIAL_INTEGRAL_INTERVAL THEN + REWRITE_TAC[REAL_POS]]; + SUBGOAL_THEN `exp(--l * &k) <= &1` MP_TAC THENL + [REWRITE_TAC[GSYM REAL_EXP_0; REAL_EXP_MONO_LE] THEN + SUBGOAL_THEN `&0 <= l * &k` MP_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_POS] THEN + ASM_REAL_ARITH_TAC; + REAL_ARITH_TAC]; + MP_TAC(SPEC `--l * &k` REAL_EXP_POS_LE) THEN REAL_ARITH_TAC]]]; + ALL_TAC] THEN + (* Step 2: show the integral equals 1 *) + SUBGOAL_THEN `real_integral (:real) g = &1` + (fun th -> ONCE_REWRITE_TAC[SYM th] THEN + REWRITE_TAC[GSYM HAS_REAL_INTEGRAL_INTEGRAL] THEN + ASM_REWRITE_TAC[]) THEN + MATCH_MP_TAC(ISPEC `sequentially` REALLIM_UNIQUE) THEN + EXISTS_TAC `\k:num. real_integral (:real) ((f:num->real->real) k)` THEN + ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN + SUBGOAL_THEN + `(\k. real_integral (:real) ((f:num->real->real) k)) = + (\k. &1 - exp(--l * &k))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `k:num` THEN + EXPAND_TAC "f" THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + SUBGOAL_THEN + `(\x. if &0 <= x /\ x <= &k then l * exp(--l * x) else &0) = + (\x. if x IN real_interval[&0,&k] then l * exp(--l * x) else &0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; IN_REAL_INTERVAL] THEN MESON_TAC[]; + REWRITE_TAC[HAS_REAL_INTEGRAL_RESTRICT_UNIV] THEN + MATCH_MP_TAC EXPONENTIAL_INTEGRAL_INTERVAL THEN + REWRITE_TAC[REAL_POS]]; + ASM_SIMP_TAC[EXPONENTIAL_INTEGRAL_SEQ_TENDS_1]]);; + +(* Exponential CDF *) +let exponential_cdf = new_definition + `exponential_cdf (l:real) (x:real) = + if &0 <= x then &1 - exp(--l * x) else &0`;; + +(* CDF at zero *) +let EXPONENTIAL_CDF_ZERO = prove + (`!l. exponential_cdf l (&0) = &0`, + GEN_TAC THEN REWRITE_TAC[exponential_cdf; REAL_LE_REFL; + REAL_MUL_RZERO; REAL_NEG_0; REAL_EXP_0] THEN + REAL_ARITH_TAC);; + +(* CDF is non-negative *) +let EXPONENTIAL_CDF_NONNEG = prove + (`!l x. &0 < l /\ &0 <= x ==> &0 <= exponential_cdf l x`, + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[exponential_cdf] THEN + SUBGOAL_THEN `exp(--l * x) <= &1` MP_TAC THENL + [REWRITE_TAC[GSYM REAL_EXP_0; REAL_EXP_MONO_LE] THEN + SUBGOAL_THEN `&0 <= l * x` MP_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN ASM_REAL_ARITH_TAC; + REAL_ARITH_TAC]; + REAL_ARITH_TAC]);; + +(* CDF is at most 1 *) +let EXPONENTIAL_CDF_LE_1 = prove + (`!l x. &0 < l /\ &0 <= x ==> exponential_cdf l x <= &1`, + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[exponential_cdf] THEN + MP_TAC(SPEC `--l * x:real` REAL_EXP_POS_LE) THEN REAL_ARITH_TAC);; + +(* Memoryless property: P(X > s+t) = P(X > s) * P(X > t) *) +let EXPONENTIAL_MEMORYLESS = prove + (`!l s t. &0 < l /\ &0 <= s /\ &0 <= t ==> + &1 - exponential_cdf l (s + t) = + (&1 - exponential_cdf l s) * (&1 - exponential_cdf l t)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&0 <= s + t` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[exponential_cdf] THEN + REWRITE_TAC[REAL_ARITH `&1 - (&1 - x) = x`] THEN + REWRITE_TAC[GSYM REAL_EXP_ADD] THEN + AP_TERM_TAC THEN REAL_ARITH_TAC);; + +(* Helper: quadratic lower bound for exp *) +let REAL_EXP_QUADRATIC_BOUND = prove + (`!x. &0 <= x ==> x pow 2 / &4 <= exp x`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `x = x / &2 + x / &2` SUBST1_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_EXP_ADD] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(x / &2) pow 2` THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_POW_DIV] THEN REAL_ARITH_TAC; + REWRITE_TAC[REAL_POW_2] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN + REPEAT CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; + MP_TAC(SPEC `x / &2` REAL_EXP_LE_X) THEN REAL_ARITH_TAC; + ASM_REAL_ARITH_TAC; + MP_TAC(SPEC `x / &2` REAL_EXP_LE_X) THEN REAL_ARITH_TAC]]);; + +(* Helper: k * exp(-l*k) -> 0 as k -> infinity *) +let EXPONENTIAL_LINEAR_DECAY_SEQ = prove + (`!l. &0 < l ==> ((\k:num. &k * exp(--l * &k)) ---> &0) sequentially`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(\k. &k * exp(--l * &k)) = (\k. &k pow 1 * exp(--l) pow k)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; REAL_POW_1] THEN + GEN_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[GSYM REAL_EXP_N] THEN + AP_TERM_TAC THEN REAL_ARITH_TAC; + MATCH_MP_TAC REALLIM_POW_TIMES_POWN THEN + SUBGOAL_THEN `abs(exp(--l)) = exp(--l)` SUBST1_TAC THENL + [REWRITE_TAC[real_abs; REAL_EXP_POS_LE]; + REWRITE_TAC[GSYM REAL_EXP_0; REAL_EXP_MONO_LT] THEN + ASM_REAL_ARITH_TAC]]);; + +(* Antiderivative for x * l * exp(-l*x) *) +let EXPONENTIAL_MEAN_ANTIDERIV = prove + (`!l x. ~(l = &0) ==> + ((\x. --(x + inv l) * exp(--l * x)) has_real_derivative + l * x * exp(--l * x)) (atreal x)`, + REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN + REWRITE_TAC[REAL_MUL_RID; REAL_ADD_RID; + REAL_ARITH `-- &1 * e = --e`; REAL_MUL_LNEG; REAL_MUL_RNEG; + REAL_NEG_NEG] THEN + ONCE_REWRITE_TAC[REAL_ADD_RDISTRIB] THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN + ASM_SIMP_TAC[REAL_MUL_LINV; REAL_MUL_LID] THEN + REAL_ARITH_TAC);; + +(* Integral of x * l * exp(-l*x) on [0, a] *) +let EXPONENTIAL_MEAN_INTEGRAL_INTERVAL = prove + (`!l a. &0 < l /\ &0 <= a ==> + ((\x. l * x * exp(--l * x)) has_real_integral + (inv l - (a + inv l) * exp(--l * a))) + (real_interval[&0,a])`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\x:real. --(x + inv l) * exp(--l * x)`; + `\x:real. l * x * exp(--l * x)`; + `&0`; `a:real`] + REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_REAL_DERIVATIVE_ATREAL_WITHIN THEN + MP_TAC(SPECL [`l:real`; `x:real`] EXPONENTIAL_MEAN_ANTIDERIV) THEN + ASM_SIMP_TAC[REAL_LT_IMP_NZ]; + REWRITE_TAC[REAL_MUL_LZERO; REAL_NEG_0; REAL_EXP_0; REAL_ADD_LID; + REAL_MUL_RID; REAL_MUL_RZERO; REAL_NEG_NEG] THEN + SUBGOAL_THEN + `--(a + inv l) * exp(--l * a) - --inv l = + inv l - (a + inv l) * exp(--l * a:real)` + (fun th -> REWRITE_TAC[th]) THEN + ABBREV_TAC `e = exp(--l * a:real)` THEN REAL_ARITH_TAC]);; + +(* Helper: mean integral sequence tends to inv(l) *) +let EXPONENTIAL_MEAN_SEQ_TENDS = prove + (`!l. &0 < l ==> + ((\k:num. inv l - (&k + inv l) * exp(--l * &k)) ---> inv l) sequentially`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `((\k:num. exp(--l * &k)) ---> &0) sequentially` ASSUME_TAC THENL + [MP_TAC(SPEC `l:real` EXPONENTIAL_LIMIT_POSINFINITY) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o MATCH_MP REALLIM_POSINFINITY_SEQUENTIALLY) THEN + REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `inv l = inv l - &0` SUBST1_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REALLIM_SUB THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_SUB_RZERO; REALLIM_CONST]; ALL_TAC] THEN + REWRITE_TAC[REAL_SUB_RZERO] THEN + SUBGOAL_THEN + `(\k. (&k + inv l) * exp(--l * &k)) = + (\k. &k * exp(--l * &k) + inv l * exp(--l * &k))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; REAL_ADD_RDISTRIB]; ALL_TAC] THEN + SUBGOAL_THEN `&0 = &0 + &0` SUBST1_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REALLIM_ADD THEN CONJ_TAC THENL + [ASM_SIMP_TAC[EXPONENTIAL_LINEAR_DECAY_SEQ]; ALL_TAC] THEN + MATCH_MP_TAC REALLIM_NULL_LMUL THEN ASM_REWRITE_TAC[]);; + +(* Mean of exponential distribution = 1/lambda *) +let EXPONENTIAL_MEAN = prove + (`!l. &0 < l ==> + ((\x. x * exponential_density l x) has_real_integral inv l) + {x | &0 <= x}`, + REPEAT STRIP_TAC THEN REWRITE_TAC[exponential_density] THEN + REWRITE_TAC[REAL_ARITH `x * (if &0 <= x then l * e else &0) = + (if &0 <= x then x * l * e else &0)`] THEN + ONCE_REWRITE_TAC[GSYM HAS_REAL_INTEGRAL_RESTRICT_UNIV] THEN + CONV_TAC(ONCE_DEPTH_CONV BETA_CONV) THEN + REWRITE_TAC[IN_ELIM_THM] THEN + SUBGOAL_THEN + `(\x:real. if &0 <= x then if &0 <= x then x * l * exp(--l * x) else &0 + else &0) = + (\x. if &0 <= x then x * l * exp(--l * x) else &0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + COND_CASES_TAC THEN REWRITE_TAC[]; + ALL_TAC] THEN + ABBREV_TAC + `g = \x:real. if &0 <= x then l * x * exp(--l * x) else &0` THEN + ABBREV_TAC + `f = \k x:real. if &0 <= x /\ x <= &k then l * x * exp(--l * x) + else &0` THEN + SUBGOAL_THEN + `(\x:real. if &0 <= x then x * l * exp(--l * x) else &0) = g` + SUBST1_TAC THENL + [EXPAND_TAC "g" THEN REWRITE_TAC[FUN_EQ_THM] THEN + GEN_TAC THEN COND_CASES_TAC THEN REWRITE_TAC[REAL_MUL_AC]; + ALL_TAC] THEN + SUBGOAL_THEN + `g real_integrable_on (:real) /\ + ((\k. real_integral (:real) (f k)) ---> real_integral (:real) g) + sequentially` + STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC REAL_MONOTONE_CONVERGENCE_INCREASING THEN + REPEAT CONJ_TAC THENL + [(* f_k integrable *) + X_GEN_TAC `k:num` THEN EXPAND_TAC "f" THEN + SUBGOAL_THEN + `(\x. if &0 <= x /\ x <= &k then l * x * exp(--l * x) else &0) = + (\x. if x IN real_interval[&0,&k] then l * x * exp(--l * x) else &0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; IN_REAL_INTERVAL] THEN MESON_TAC[]; + REWRITE_TAC[real_integrable_on] THEN + EXISTS_TAC `inv l - (&k + inv l) * exp(--l * &k)` THEN + REWRITE_TAC[HAS_REAL_INTEGRAL_RESTRICT_UNIV] THEN + MATCH_MP_TAC EXPONENTIAL_MEAN_INTEGRAL_INTERVAL THEN + ASM_REWRITE_TAC[REAL_POS]]; + (* monotonicity: f_k(x) <= f_{k+1}(x) *) + X_GEN_TAC `k:num` THEN X_GEN_TAC `x:real` THEN DISCH_TAC THEN + EXPAND_TAC "f" THEN REWRITE_TAC[GSYM REAL_OF_NUM_SUC] THEN + REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL]) THEN + TRY(MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; REWRITE_TAC[REAL_EXP_POS_LE]]]) THEN + ASM_REAL_ARITH_TAC; + (* pointwise convergence *) + X_GEN_TAC `x:real` THEN DISCH_TAC THEN + EXPAND_TAC "f" THEN EXPAND_TAC "g" THEN + ASM_CASES_TAC `&0 <= x` THENL + [ASM_REWRITE_TAC[] THEN REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(SPEC `x:real` REAL_ARCH_SIMPLE) THEN + DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN + EXISTS_TAC `N:num` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + SUBGOAL_THEN `x <= &n` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&N` THEN + ASM_REWRITE_TAC[REAL_OF_NUM_LE]; + ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_ABS_NUM] THEN + ASM_REAL_ARITH_TAC]; + ASM_REWRITE_TAC[] THEN REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `0` THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC]; + (* bounded integrals *) + REWRITE_TAC[real_bounded; FORALL_IN_GSPEC; IN_UNIV] THEN + EXISTS_TAC `inv(l:real)` THEN X_GEN_TAC `k:num` THEN + SUBGOAL_THEN + `real_integral (:real) ((f:num->real->real) k) = + inv l - (&k + inv l) * exp(--l * &k)` + SUBST1_TAC THENL + [EXPAND_TAC "f" THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + SUBGOAL_THEN + `(\x. if &0 <= x /\ x <= &k then l * x * exp(--l * x) else &0) = + (\x. if x IN real_interval[&0,&k] then l * x * exp(--l * x) + else &0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; IN_REAL_INTERVAL] THEN MESON_TAC[]; + REWRITE_TAC[HAS_REAL_INTEGRAL_RESTRICT_UNIV] THEN + MATCH_MP_TAC EXPONENTIAL_MEAN_INTEGRAL_INTERVAL THEN + ASM_REWRITE_TAC[REAL_POS]]; + SUBGOAL_THEN + `&0 <= inv l - (&k + inv l) * exp(--l * &k)` + MP_TAC THENL + [MATCH_MP_TAC HAS_REAL_INTEGRAL_POS THEN + EXISTS_TAC `\x:real. l * x * exp(--l * x)` THEN + EXISTS_TAC `real_interval[&0,&k]` THEN CONJ_TAC THENL + [MATCH_MP_TAC EXPONENTIAL_MEAN_INTEGRAL_INTERVAL THEN + ASM_REWRITE_TAC[REAL_POS]; + REWRITE_TAC[IN_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; REWRITE_TAC[REAL_EXP_POS_LE]]]]; + SUBGOAL_THEN `&0 <= (&k + inv l) * exp(--l * &k)` MP_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_EXP_POS_LE] THEN + MATCH_MP_TAC REAL_LE_ADD THEN REWRITE_TAC[REAL_POS] THEN + MATCH_MP_TAC REAL_LE_INV THEN ASM_REAL_ARITH_TAC; + REAL_ARITH_TAC]]]]; + ALL_TAC] THEN + SUBGOAL_THEN `real_integral (:real) g = inv l` + (fun th -> ONCE_REWRITE_TAC[SYM th] THEN + REWRITE_TAC[GSYM HAS_REAL_INTEGRAL_INTEGRAL] THEN + ASM_REWRITE_TAC[]) THEN + MATCH_MP_TAC(ISPEC `sequentially` REALLIM_UNIQUE) THEN + EXISTS_TAC `\k:num. real_integral (:real) ((f:num->real->real) k)` THEN + ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN + SUBGOAL_THEN + `(\k. real_integral (:real) ((f:num->real->real) k)) = + (\k. inv l - (&k + inv l) * exp(--l * &k))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `k:num` THEN + EXPAND_TAC "f" THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + SUBGOAL_THEN + `(\x. if &0 <= x /\ x <= &k then l * x * exp(--l * x) else &0) = + (\x. if x IN real_interval[&0,&k] then l * x * exp(--l * x) else &0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; IN_REAL_INTERVAL] THEN MESON_TAC[]; + REWRITE_TAC[HAS_REAL_INTEGRAL_RESTRICT_UNIV] THEN + MATCH_MP_TAC EXPONENTIAL_MEAN_INTEGRAL_INTERVAL THEN + ASM_REWRITE_TAC[REAL_POS]]; + ASM_SIMP_TAC[EXPONENTIAL_MEAN_SEQ_TENDS]]);; + +(* Mean as an integral value *) +let EXPONENTIAL_MEAN_INTEGRAL = prove + (`!l. &0 < l ==> + real_integral {x | &0 <= x} (\x. x * exponential_density l x) = inv l`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + ASM_SIMP_TAC[EXPONENTIAL_MEAN]);; + +(* Quadratic decay: k^2 * exp(-lk) -> 0 *) +let EXPONENTIAL_QUADRATIC_DECAY_SEQ = prove + (`!l. &0 < l + ==> ((\k:num. &k pow 2 * exp(--l * &k)) ---> &0) sequentially`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(\k. &k pow 2 * exp(--l * &k)) = + (\k. &k pow 2 * exp(--l) pow k)` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[GSYM REAL_EXP_N] THEN AP_TERM_TAC THEN REAL_ARITH_TAC; + MATCH_MP_TAC REALLIM_POW_TIMES_POWN THEN + SUBGOAL_THEN `abs(exp(--l)) = exp(--l)` SUBST1_TAC THENL + [REWRITE_TAC[real_abs; REAL_EXP_POS_LE]; + REWRITE_TAC[GSYM REAL_EXP_0; REAL_EXP_MONO_LT] THEN + ASM_REAL_ARITH_TAC]]);; + +(* Product (k^2 + 2k/l + 2/l^2) * exp(-lk) -> 0 *) +let EXPONENTIAL_PRODUCT_DECAY_SEQ = prove + (`!l. &0 < l ==> + ((\k:num. (&k pow 2 + &2 * &k * inv l + &2 * inv l pow 2) * + exp(--l * &k)) ---> &0) sequentially`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&0 < inv l` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LT_INV THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `((\k:num. exp(--l * &k)) ---> &0) sequentially` ASSUME_TAC THENL + [MP_TAC(SPEC `l:real` EXPONENTIAL_LIMIT_POSINFINITY) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o MATCH_MP REALLIM_POSINFINITY_SEQUENTIALLY) THEN + REWRITE_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[REAL_ADD_RDISTRIB] THEN + SUBGOAL_THEN + `((\k:num. &k pow 2 * exp(--l * &k)) ---> &0) sequentially` + ASSUME_TAC THENL + [ASM_SIMP_TAC[EXPONENTIAL_QUADRATIC_DECAY_SEQ]; ALL_TAC] THEN + SUBGOAL_THEN + `((\k:num. (&2 * &k * inv l) * exp(--l * &k)) ---> &0) sequentially` + ASSUME_TAC THENL + [SUBGOAL_THEN + `(\k:num. (&2 * &k * inv l) * exp(--l * &k)) = + (\k. (&2 * inv l) * (&k * exp(--l * &k)))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; GSYM REAL_MUL_ASSOC] THEN GEN_TAC THEN + AP_TERM_TAC THEN REWRITE_TAC[REAL_MUL_AC]; + MATCH_MP_TAC REALLIM_NULL_LMUL THEN + ASM_SIMP_TAC[EXPONENTIAL_LINEAR_DECAY_SEQ]]; + ALL_TAC] THEN + SUBGOAL_THEN + `((\k:num. (&2 * inv l pow 2) * exp(--l * &k)) ---> &0) sequentially` + ASSUME_TAC THENL + [MATCH_MP_TAC REALLIM_NULL_LMUL THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[REAL_ADD_ASSOC] THEN + SUBGOAL_THEN `&0 = &0 + &0` (fun th -> ONCE_REWRITE_TAC[th]) THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REALLIM_ADD THEN CONJ_TAC THENL + [SUBGOAL_THEN `&0 = &0 + &0` (fun th -> ONCE_REWRITE_TAC[th]) THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REALLIM_ADD THEN ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]]);; + +(* Antiderivative for x^2 * l * exp(-l*x) *) +let EXPONENTIAL_SECOND_MOMENT_ANTIDERIV = prove + (`!l x. ~(l = &0) ==> + ((\x. --(x pow 2 + &2 * x * inv l + &2 * inv l pow 2) * exp(--l * x)) + has_real_derivative + l * x pow 2 * exp(--l * x)) (atreal x)`, + REPEAT STRIP_TAC THEN REAL_DIFF_TAC THEN + REWRITE_TAC[REAL_MUL_RID; REAL_ADD_RID; REAL_MUL_LID; + ARITH_RULE `2 - 1 = 1`; REAL_POW_1] THEN + ONCE_REWRITE_TAC[REAL_MUL_ASSOC] THEN + SUBGOAL_THEN + `!a b c:real. a * c + b * c = (a + b) * c` + (fun th -> ONCE_REWRITE_TAC[th]) THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[REAL_NEG_MUL2] THEN + REWRITE_TAC[REAL_ADD_RDISTRIB] THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN + ONCE_REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN + ASM_SIMP_TAC[REAL_MUL_LINV; REAL_MUL_RID] THEN + REWRITE_TAC[REAL_POW_2] THEN + ONCE_REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN + ASM_SIMP_TAC[REAL_MUL_LINV; REAL_MUL_RID] THEN + REAL_ARITH_TAC);; + +(* Integral of x^2 * l * exp(-l*x) on [0, a] *) +let EXPONENTIAL_SECOND_MOMENT_INTEGRAL_INTERVAL = prove + (`!l a. &0 < l /\ &0 <= a ==> + ((\x. l * x pow 2 * exp(--l * x)) has_real_integral + (&2 * inv l pow 2 - + (a pow 2 + &2 * a * inv l + &2 * inv l pow 2) * exp(--l * a))) + (real_interval[&0,a])`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL + [`\x:real. --(x pow 2 + &2 * x * inv l + &2 * inv l pow 2) * + exp(--l * x)`; + `\x:real. l * x pow 2 * exp(--l * x)`; + `&0`; `a:real`] + REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_REAL_DERIVATIVE_ATREAL_WITHIN THEN + MP_TAC(SPECL [`l:real`; `x:real`] + EXPONENTIAL_SECOND_MOMENT_ANTIDERIV) THEN + ASM_SIMP_TAC[REAL_LT_IMP_NZ]; + REWRITE_TAC[REAL_POW_ZERO; ARITH_EQ; REAL_MUL_LZERO; REAL_MUL_RZERO; + REAL_ADD_LID; REAL_NEG_0; REAL_EXP_0; REAL_MUL_RID] THEN + SUBGOAL_THEN + `--(a pow 2 + &2 * a * inv l + &2 * inv l pow 2) * exp(--l * a) - + --(&2 * inv l pow 2) = + &2 * inv l pow 2 - + (a pow 2 + &2 * a * inv l + &2 * inv l pow 2) * exp(--l * a:real)` + (fun th -> REWRITE_TAC[th]) THEN + ABBREV_TAC `e = exp(--l * a:real)` THEN REAL_ARITH_TAC]);; + +(* Second moment integral sequence tends to 2/l^2 *) +let EXPONENTIAL_SECOND_MOMENT_SEQ_TENDS = prove + (`!l. &0 < l ==> + ((\k:num. &2 * inv l pow 2 - + (&k pow 2 + &2 * &k * inv l + &2 * inv l pow 2) * exp(--l * &k)) + ---> &2 * inv l pow 2) sequentially`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&2 * inv l pow 2 = &2 * inv l pow 2 - &0` SUBST1_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REALLIM_SUB THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_SUB_RZERO; REALLIM_CONST]; ALL_TAC] THEN + REWRITE_TAC[REAL_SUB_RZERO] THEN + ASM_SIMP_TAC[EXPONENTIAL_PRODUCT_DECAY_SEQ]);; + +(* Second moment: E[X^2] = 2/l^2 *) +let EXPONENTIAL_SECOND_MOMENT = prove + (`!l. &0 < l ==> + ((\x. x pow 2 * exponential_density l x) has_real_integral + &2 * inv l pow 2) + {x | &0 <= x}`, + REPEAT STRIP_TAC THEN REWRITE_TAC[exponential_density] THEN + REWRITE_TAC[REAL_ARITH `x2 * (if &0 <= x then l * e else &0) = + (if &0 <= x then x2 * l * e else &0)`] THEN + ONCE_REWRITE_TAC[GSYM HAS_REAL_INTEGRAL_RESTRICT_UNIV] THEN + CONV_TAC(ONCE_DEPTH_CONV BETA_CONV) THEN + REWRITE_TAC[IN_ELIM_THM] THEN + SUBGOAL_THEN + `(\x:real. if &0 <= x + then if &0 <= x then x pow 2 * l * exp(--l * x) else &0 + else &0) = + (\x. if &0 <= x then x pow 2 * l * exp(--l * x) else &0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + COND_CASES_TAC THEN REWRITE_TAC[]; + ALL_TAC] THEN + ABBREV_TAC + `g = \x:real. if &0 <= x then l * x pow 2 * exp(--l * x) else &0` THEN + ABBREV_TAC + `f = \k x:real. if &0 <= x /\ x <= &k then l * x pow 2 * exp(--l * x) + else &0` THEN + SUBGOAL_THEN + `(\x:real. if &0 <= x then x pow 2 * l * exp(--l * x) else &0) = g` + SUBST1_TAC THENL + [EXPAND_TAC "g" THEN REWRITE_TAC[FUN_EQ_THM] THEN + GEN_TAC THEN COND_CASES_TAC THEN REWRITE_TAC[REAL_MUL_AC]; + ALL_TAC] THEN + SUBGOAL_THEN + `g real_integrable_on (:real) /\ + ((\k. real_integral (:real) (f k)) ---> real_integral (:real) g) + sequentially` + STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC REAL_MONOTONE_CONVERGENCE_INCREASING THEN + REPEAT CONJ_TAC THENL + [(* f_k integrable *) + X_GEN_TAC `k:num` THEN EXPAND_TAC "f" THEN + SUBGOAL_THEN + `(\x. if &0 <= x /\ x <= &k + then l * x pow 2 * exp(--l * x) else &0) = + (\x. if x IN real_interval[&0,&k] + then l * x pow 2 * exp(--l * x) else &0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; IN_REAL_INTERVAL] THEN MESON_TAC[]; + REWRITE_TAC[real_integrable_on] THEN + EXISTS_TAC `&2 * inv l pow 2 - + (&k pow 2 + &2 * &k * inv(l:real) + &2 * inv l pow 2) * + exp(--l * &k)` THEN + REWRITE_TAC[HAS_REAL_INTEGRAL_RESTRICT_UNIV] THEN + MATCH_MP_TAC EXPONENTIAL_SECOND_MOMENT_INTEGRAL_INTERVAL THEN + ASM_REWRITE_TAC[REAL_POS]]; + (* monotonicity *) + X_GEN_TAC `k:num` THEN X_GEN_TAC `x:real` THEN DISCH_TAC THEN + EXPAND_TAC "f" THEN REWRITE_TAC[GSYM REAL_OF_NUM_SUC] THEN + REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL]) THEN + TRY(MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_LE_POW_2]; + REWRITE_TAC[REAL_EXP_POS_LE]]]) THEN + ASM_REAL_ARITH_TAC; + (* pointwise convergence *) + X_GEN_TAC `x:real` THEN DISCH_TAC THEN + EXPAND_TAC "f" THEN EXPAND_TAC "g" THEN + ASM_CASES_TAC `&0 <= x` THENL + [ASM_REWRITE_TAC[] THEN REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(SPEC `x:real` REAL_ARCH_SIMPLE) THEN + DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN + EXISTS_TAC `N:num` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + SUBGOAL_THEN `x <= &n` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&N` THEN + ASM_REWRITE_TAC[REAL_OF_NUM_LE]; + ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_ABS_NUM] THEN + ASM_REAL_ARITH_TAC]; + ASM_REWRITE_TAC[] THEN REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `0` THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC]; + (* bounded integrals *) + REWRITE_TAC[real_bounded; FORALL_IN_GSPEC; IN_UNIV] THEN + EXISTS_TAC `&2 * inv(l:real) pow 2` THEN X_GEN_TAC `k:num` THEN + SUBGOAL_THEN + `real_integral (:real) ((f:num->real->real) k) = + &2 * inv l pow 2 - + (&k pow 2 + &2 * &k * inv l + &2 * inv l pow 2) * exp(--l * &k)` + SUBST1_TAC THENL + [EXPAND_TAC "f" THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + SUBGOAL_THEN + `(\x. if &0 <= x /\ x <= &k + then l * x pow 2 * exp(--l * x) else &0) = + (\x. if x IN real_interval[&0,&k] + then l * x pow 2 * exp(--l * x) else &0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; IN_REAL_INTERVAL] THEN MESON_TAC[]; + REWRITE_TAC[HAS_REAL_INTEGRAL_RESTRICT_UNIV] THEN + MATCH_MP_TAC EXPONENTIAL_SECOND_MOMENT_INTEGRAL_INTERVAL THEN + ASM_REWRITE_TAC[REAL_POS]]; + SUBGOAL_THEN + `&0 <= &2 * inv l pow 2 - + (&k pow 2 + &2 * &k * inv l + &2 * inv l pow 2) * exp(--l * &k)` + MP_TAC THENL + [MATCH_MP_TAC HAS_REAL_INTEGRAL_POS THEN + EXISTS_TAC `\x:real. l * x pow 2 * exp(--l * x)` THEN + EXISTS_TAC `real_interval[&0,&k]` THEN CONJ_TAC THENL + [MATCH_MP_TAC EXPONENTIAL_SECOND_MOMENT_INTEGRAL_INTERVAL THEN + ASM_REWRITE_TAC[REAL_POS]; + REWRITE_TAC[IN_REAL_INTERVAL] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_LE_POW_2]; + REWRITE_TAC[REAL_EXP_POS_LE]]]]; + SUBGOAL_THEN + `&0 <= (&k pow 2 + &2 * &k * inv l + &2 * inv l pow 2) * + exp(--l * &k)` MP_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_EXP_POS_LE] THEN + MATCH_MP_TAC REAL_LE_ADD THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_LE_POW_2]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_ADD THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_POS]; + MATCH_MP_TAC REAL_LE_INV THEN ASM_REAL_ARITH_TAC]]; + MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [REAL_ARITH_TAC; REWRITE_TAC[REAL_LE_POW_2]]]; + REAL_ARITH_TAC]]]]; + ALL_TAC] THEN + SUBGOAL_THEN `real_integral (:real) g = &2 * inv l pow 2` + (fun th -> ONCE_REWRITE_TAC[SYM th] THEN + REWRITE_TAC[GSYM HAS_REAL_INTEGRAL_INTEGRAL] THEN + ASM_REWRITE_TAC[]) THEN + MATCH_MP_TAC(ISPEC `sequentially` REALLIM_UNIQUE) THEN + EXISTS_TAC `\k:num. real_integral (:real) ((f:num->real->real) k)` THEN + ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN + SUBGOAL_THEN + `(\k. real_integral (:real) ((f:num->real->real) k)) = + (\k. &2 * inv l pow 2 - + (&k pow 2 + &2 * &k * inv l + &2 * inv l pow 2) * exp(--l * &k))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `k:num` THEN + EXPAND_TAC "f" THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + SUBGOAL_THEN + `(\x. if &0 <= x /\ x <= &k + then l * x pow 2 * exp(--l * x) else &0) = + (\x. if x IN real_interval[&0,&k] + then l * x pow 2 * exp(--l * x) else &0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; IN_REAL_INTERVAL] THEN MESON_TAC[]; + REWRITE_TAC[HAS_REAL_INTEGRAL_RESTRICT_UNIV] THEN + MATCH_MP_TAC EXPONENTIAL_SECOND_MOMENT_INTEGRAL_INTERVAL THEN + ASM_REWRITE_TAC[REAL_POS]]; + ASM_SIMP_TAC[EXPONENTIAL_SECOND_MOMENT_SEQ_TENDS]]);; + +(* Second moment as integral value *) +let EXPONENTIAL_SECOND_MOMENT_INTEGRAL = prove + (`!l. &0 < l ==> + real_integral {x | &0 <= x} + (\x. x pow 2 * exponential_density l x) = &2 * inv l pow 2`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + ASM_SIMP_TAC[EXPONENTIAL_SECOND_MOMENT]);; + +(* Variance: Var(X) = E[X^2] - (E[X])^2 = 2/l^2 - 1/l^2 = 1/l^2 *) +let EXPONENTIAL_VARIANCE_INTEGRAL = prove + (`!l. &0 < l ==> + real_integral {x | &0 <= x} + (\x. (x - inv l) pow 2 * exponential_density l x) = inv l pow 2`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\x. (x - inv l) pow 2 * exponential_density l x) = + (\x. x pow 2 * exponential_density l x - + &2 * inv l * (x * exponential_density l x) + + inv l pow 2 * exponential_density l x)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + REWRITE_TAC[REAL_POW_2; + REAL_ARITH `(x - c) * (x - c) = x * x - &2 * c * x + c * c`] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `((\x. x pow 2 * exponential_density l x) has_real_integral + &2 * inv l pow 2) {x | &0 <= x}` + ASSUME_TAC THENL + [ASM_SIMP_TAC[EXPONENTIAL_SECOND_MOMENT]; ALL_TAC] THEN + SUBGOAL_THEN + `((\x. x * exponential_density l x) has_real_integral inv l) + {x | &0 <= x}` + ASSUME_TAC THENL + [ASM_SIMP_TAC[EXPONENTIAL_MEAN]; ALL_TAC] THEN + SUBGOAL_THEN + `(exponential_density l has_real_integral &1) {x | &0 <= x}` + ASSUME_TAC THENL + [MATCH_MP_TAC HAS_REAL_INTEGRAL_EQ THEN + EXISTS_TAC `\x:real. l * exp(--l * x)` THEN CONJ_TAC THENL + [REWRITE_TAC[IN_ELIM_THM; exponential_density] THEN MESON_TAC[]; + ASM_SIMP_TAC[EXPONENTIAL_DENSITY_INTEGRAL]]; + ALL_TAC] THEN + SUBGOAL_THEN + `((\x. x pow 2 * exponential_density l x - + &2 * inv l * (x * exponential_density l x) + + inv l pow 2 * exponential_density l x) has_real_integral + (&2 * inv l pow 2 - &2 * inv l * inv l + inv l pow 2 * &1)) + {x | &0 <= x}` + (fun th -> MP_TAC(MATCH_MP REAL_INTEGRAL_UNIQUE th) THEN + SUBGOAL_THEN + `&2 * inv l pow 2 - &2 * inv l * inv l + inv l pow 2 * &1 = + inv(l:real) pow 2` + SUBST1_TAC THENL + [REWRITE_TAC[REAL_POW_2; REAL_MUL_RID] THEN REAL_ARITH_TAC; + SIMP_TAC[]]) THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_ADD THEN CONJ_TAC THENL + [MATCH_MP_TAC HAS_REAL_INTEGRAL_SUB THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + MATCH_MP_TAC HAS_REAL_INTEGRAL_LMUL THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_LMUL THEN ASM_REWRITE_TAC[]]; + MATCH_MP_TAC HAS_REAL_INTEGRAL_LMUL THEN + REWRITE_TAC[ETA_AX] THEN ASM_REWRITE_TAC[]]);; + +(* ===================================================================== *) +(* Continuous Uniform Distribution on [a,b] *) +(* ===================================================================== *) + +let uniform_density = new_definition + `uniform_density (a:real) (b:real) (x:real) = + if a <= x /\ x <= b then inv(b - a) else &0`;; + +let uniform_cdf = new_definition + `uniform_cdf (a:real) (b:real) (x:real) = + if x < a then &0 + else if b <= x then &1 + else (x - a) / (b - a)`;; + +(* Basic properties of the density *) + +let UNIFORM_DENSITY_NONNEG = prove + (`!a b x. a < b ==> &0 <= uniform_density a b x`, + REPEAT STRIP_TAC THEN REWRITE_TAC[uniform_density] THEN + COND_CASES_TAC THEN REWRITE_TAC[REAL_LE_REFL] THEN + MATCH_MP_TAC REAL_LE_INV THEN ASM_REAL_ARITH_TAC);; + +let UNIFORM_DENSITY_POS = prove + (`!a b x. a < b /\ a <= x /\ x <= b ==> &0 < uniform_density a b x`, + REPEAT STRIP_TAC THEN REWRITE_TAC[uniform_density] THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LT_INV THEN ASM_REAL_ARITH_TAC);; + +let UNIFORM_DENSITY_ZERO = prove + (`!a b x. x < a \/ b < x ==> uniform_density a b x = &0`, + REPEAT STRIP_TAC THEN REWRITE_TAC[uniform_density] THEN + COND_CASES_TAC THEN REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC);; + +let UNIFORM_DENSITY_VALUE = prove + (`!a b x. a <= x /\ x <= b ==> uniform_density a b x = inv(b - a)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[uniform_density] THEN + ASM_REWRITE_TAC[]);; + +(* Density integrates to 1 *) + +let UNIFORM_DENSITY_INTEGRAL = prove + (`!a b. a < b ==> + (uniform_density a b has_real_integral &1) (:real)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `~(b - a = &0)` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `uniform_density a b = + (\x:real. if x IN real_interval[a,b] then inv(b - a) else &0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; IN_REAL_INTERVAL; uniform_density]; ALL_TAC] THEN + REWRITE_TAC[HAS_REAL_INTEGRAL_RESTRICT_UNIV] THEN + SUBGOAL_THEN `&1 = inv(b - a) * (b - a:real)` SUBST1_TAC THENL + [ASM_SIMP_TAC[REAL_MUL_LINV]; ALL_TAC] THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_CONST THEN ASM_REAL_ARITH_TAC);; + +let UNIFORM_DENSITY_INTEGRABLE = prove + (`!a b. a < b ==> uniform_density a b real_integrable_on (:real)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_INTEGRABLE THEN + EXISTS_TAC `&1` THEN ASM_SIMP_TAC[UNIFORM_DENSITY_INTEGRAL]);; + +(* CDF properties *) + +let UNIFORM_CDF_LEFT = prove + (`!a b. a < b ==> uniform_cdf a b a = &0`, + REPEAT STRIP_TAC THEN REWRITE_TAC[uniform_cdf] THEN + REWRITE_TAC[REAL_LT_REFL] THEN + SUBGOAL_THEN `~(b <= a)` (fun th -> REWRITE_TAC[th]) THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_SUB_REFL; real_div; REAL_MUL_LZERO]);; + +let UNIFORM_CDF_RIGHT = prove + (`!a b. a < b ==> uniform_cdf a b b = &1`, + REPEAT STRIP_TAC THEN REWRITE_TAC[uniform_cdf] THEN + SUBGOAL_THEN `~(b < a)` (fun th -> REWRITE_TAC[th]) THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_LE_REFL]);; + +let UNIFORM_CDF_BOUNDS = prove + (`!a b x. a < b ==> &0 <= uniform_cdf a b x /\ uniform_cdf a b x <= &1`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[uniform_cdf] THEN + REPEAT COND_CASES_TAC THEN + ASM_REWRITE_TAC[REAL_POS; REAL_LE_REFL] THEN + TRY REAL_ARITH_TAC THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_DIV THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[real_div] THEN + SUBGOAL_THEN `&0 < inv(b - a)` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LT_INV THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `(x - a) * inv(b - a) <= (b - a) * inv(b - a)` MP_TAC THENL + [MATCH_MP_TAC REAL_LE_RMUL THEN CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; ASM_REAL_ARITH_TAC]; + ASM_SIMP_TAC[REAL_MUL_RINV; REAL_ARITH `a < b ==> ~(b - a = &0)`]]]);; + +let UNIFORM_CDF_MONO = prove + (`!a b x y. a < b /\ x <= y ==> uniform_cdf a b x <= uniform_cdf a b y`, + REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[uniform_cdf] THEN + REPEAT COND_CASES_TAC THEN + ASM_REWRITE_TAC[REAL_POS; REAL_LE_REFL] THEN + TRY REAL_ARITH_TAC THEN + TRY(ASM_REAL_ARITH_TAC) THEN + TRY(MATCH_MP_TAC REAL_LE_DIV THEN ASM_REAL_ARITH_TAC) THEN + REWRITE_TAC[real_div] THEN + TRY(MATCH_MP_TAC REAL_LE_RMUL THEN CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LE_INV THEN ASM_REAL_ARITH_TAC]) THEN + SUBGOAL_THEN `&0 < inv(b - a)` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LT_INV THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `(x - a) * inv(b - a) <= (b - a) * inv(b - a)` MP_TAC THENL + [MATCH_MP_TAC REAL_LE_RMUL THEN CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; ASM_REAL_ARITH_TAC]; + ASM_SIMP_TAC[REAL_MUL_RINV; REAL_ARITH `a < b ==> ~(b - a = &0)`]]);; + +(* Integration helper: integral of identity on [a,b] *) + +let IDENTITY_HAS_REAL_INTEGRAL = prove + (`!a b. a <= b ==> + ((\x. x) has_real_integral (b pow 2 - a pow 2) / &2) + (real_interval[a,b])`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\x:real. x pow 2 / &2`; `\x:real. x`; + `a:real`; `b:real`] + REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_REAL_DERIVATIVE_ATREAL_WITHIN THEN + REAL_DIFF_TAC THEN CONV_TAC NUM_REDUCE_CONV THEN REAL_ARITH_TAC; + REWRITE_TAC[REAL_ARITH `b / &2 - a / &2 = (b - a) / &2`]]);; + +(* Mean of uniform distribution *) + +let UNIFORM_MEAN = prove + (`!a b. a < b ==> + ((\x. x * uniform_density a b x) has_real_integral (a + b) / &2) + (:real)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `~(b - a = &0)` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `(\x:real. x * uniform_density a b x) = + (\x. if x IN real_interval[a,b] then inv(b - a) * x else &0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; IN_REAL_INTERVAL; uniform_density] THEN + GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[HAS_REAL_INTEGRAL_RESTRICT_UNIV] THEN + SUBGOAL_THEN + `(a + b) / &2 = inv(b - a) * ((b pow 2 - a pow 2) / &2)` + SUBST1_TAC THENL + [MATCH_MP_TAC(REAL_FIELD + `~(b - a = &0) ==> + (a + b) / &2 = inv(b - a) * ((b pow 2 - a pow 2) / &2)`) THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC HAS_REAL_INTEGRAL_LMUL THEN + MATCH_MP_TAC IDENTITY_HAS_REAL_INTEGRAL THEN ASM_REAL_ARITH_TAC]);; + +let UNIFORM_MEAN_INTEGRAL = prove + (`!a b. a < b ==> + real_integral (:real) (\x. x * uniform_density a b x) = (a + b) / &2`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + ASM_SIMP_TAC[UNIFORM_MEAN]);; + +(* Integration helper: integral of x^2 on [a,b] *) + +let SQUARE_HAS_REAL_INTEGRAL = prove + (`!a b. a <= b ==> + ((\x. x pow 2) has_real_integral (b pow 3 - a pow 3) / &3) + (real_interval[a,b])`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\x:real. x pow 3 / &3`; `\x:real. x pow 2`; + `a:real`; `b:real`] + REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_REAL_DERIVATIVE_ATREAL_WITHIN THEN + REAL_DIFF_TAC THEN CONV_TAC NUM_REDUCE_CONV THEN REAL_ARITH_TAC; + REWRITE_TAC[REAL_ARITH `b / &3 - a / &3 = (b - a) / &3`]]);; + +(* Second moment of uniform distribution *) + +let UNIFORM_SECOND_MOMENT = prove + (`!a b. a < b ==> + ((\x. x pow 2 * uniform_density a b x) has_real_integral + (a pow 2 + a * b + b pow 2) / &3) (:real)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `~(b - a = &0)` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `(\x:real. x pow 2 * uniform_density a b x) = + (\x. if x IN real_interval[a,b] then inv(b - a) * x pow 2 else &0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; IN_REAL_INTERVAL; uniform_density] THEN + GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[HAS_REAL_INTEGRAL_RESTRICT_UNIV] THEN + SUBGOAL_THEN + `(a pow 2 + a * b + b pow 2) / &3 = + inv(b - a) * ((b pow 3 - a pow 3) / &3)` + SUBST1_TAC THENL + [MATCH_MP_TAC(REAL_FIELD + `~(b - a = &0) ==> + (a pow 2 + a * b + b pow 2) / &3 = + inv(b - a) * ((b pow 3 - a pow 3) / &3)`) THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC HAS_REAL_INTEGRAL_LMUL THEN + MATCH_MP_TAC SQUARE_HAS_REAL_INTEGRAL THEN ASM_REAL_ARITH_TAC]);; + +let UNIFORM_SECOND_MOMENT_INTEGRAL = prove + (`!a b. a < b ==> + real_integral (:real) (\x. x pow 2 * uniform_density a b x) = + (a pow 2 + a * b + b pow 2) / &3`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + ASM_SIMP_TAC[UNIFORM_SECOND_MOMENT]);; + +(* Variance of uniform distribution *) + +let UNIFORM_VARIANCE_INTEGRAL = prove + (`!a b. a < b ==> + real_integral (:real) + (\x. (x - (a + b) / &2) pow 2 * uniform_density a b x) = + (b - a) pow 2 / &12`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `~(b - a = &0)` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ABBREV_TAC `mu = (a + b) / &2` THEN + SUBGOAL_THEN + `(\x. (x - mu) pow 2 * uniform_density a b x) = + (\x. x pow 2 * uniform_density a b x - + &2 * mu * (x * uniform_density a b x) + + mu pow 2 * uniform_density a b x)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + REWRITE_TAC[REAL_POW_2; + REAL_ARITH `(x - c) * (x - c) = x * x - &2 * c * x + c * c`] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `((\x. x pow 2 * uniform_density a b x) has_real_integral + (a pow 2 + a * b + b pow 2) / &3) (:real)` + ASSUME_TAC THENL + [ASM_SIMP_TAC[UNIFORM_SECOND_MOMENT]; ALL_TAC] THEN + SUBGOAL_THEN + `((\x. x * uniform_density a b x) has_real_integral (a + b) / &2) + (:real)` + ASSUME_TAC THENL + [ASM_SIMP_TAC[UNIFORM_MEAN]; ALL_TAC] THEN + SUBGOAL_THEN + `(uniform_density a b has_real_integral &1) (:real)` + ASSUME_TAC THENL + [ASM_SIMP_TAC[UNIFORM_DENSITY_INTEGRAL]; ALL_TAC] THEN + SUBGOAL_THEN + `((\x. x pow 2 * uniform_density a b x - + &2 * mu * (x * uniform_density a b x) + + mu pow 2 * uniform_density a b x) has_real_integral + ((a pow 2 + a * b + b pow 2) / &3 - + &2 * mu * ((a + b) / &2) + + mu pow 2 * &1)) + (:real)` + (fun th -> MP_TAC(MATCH_MP REAL_INTEGRAL_UNIQUE th) THEN + EXPAND_TAC "mu" THEN + SUBGOAL_THEN + `(a pow 2 + a * b + b pow 2) / &3 - + &2 * ((a + b) / &2) * ((a + b) / &2) + + ((a + b) / &2) pow 2 * &1 = + (b - a) pow 2 / &12` + SUBST1_TAC THENL + [REWRITE_TAC[REAL_POW_2; REAL_MUL_RID] THEN REAL_ARITH_TAC; + SIMP_TAC[]]) THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_ADD THEN CONJ_TAC THENL + [MATCH_MP_TAC HAS_REAL_INTEGRAL_SUB THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + MATCH_MP_TAC HAS_REAL_INTEGRAL_LMUL THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_LMUL THEN ASM_REWRITE_TAC[]]; + MATCH_MP_TAC HAS_REAL_INTEGRAL_LMUL THEN + REWRITE_TAC[ETA_AX] THEN ASM_REWRITE_TAC[]]);; + +(* ========================================================================= *) +(* Characteristic function formulas for distributions *) +(* ========================================================================= *) + +(* ---- General Normal char fn ---- *) + +(* Strategy: derive from STD_NORMAL_CHAR_FN_RE/IM via affine substitution. + The general normal char fn is: + phi(t) = exp(-sigma^2 * t^2 / 2) * (cos(mu*t) + i*sin(mu*t)) + We first show the shifted integrals (with cos(t*(x-mu)) and sin(t*(x-mu))) + and then use cos/sin addition to get the final formulas. *) + +(* Helper: integral of normal_density * cos(t*(x-mu)) via affine substitution *) +let NORMAL_SHIFTED_COS_INTEGRAL = prove + (`!mu sigma t. &0 < sigma ==> + ((\x. normal_density mu sigma x * cos(t * (x - mu))) + has_real_integral exp(--(sigma pow 2 * t pow 2 / &2))) (:real)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `~(sigma = &0)` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `~(inv sigma = &0)` ASSUME_TAC THENL + [ASM_SIMP_TAC[REAL_INV_EQ_0]; ALL_TAC] THEN + SUBGOAL_THEN + `(\x. normal_density mu sigma x * cos(t * (x - mu))) = + (\x. inv(sigma) * (std_normal_density((x - mu) / sigma) * + cos(t * (x - mu))))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:real` THEN + ASM_SIMP_TAC[NORMAL_DENSITY_STANDARDIZE] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `exp(--(sigma pow 2 * t pow 2 / &2)) = + inv(sigma) * (sigma * exp(--(sigma pow 2 * t pow 2 / &2)))` + SUBST1_TAC THENL + [UNDISCH_TAC `~(sigma = &0)` THEN CONV_TAC REAL_FIELD; ALL_TAC] THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_LMUL THEN + MP_TAC(SPEC `t * sigma:real` STD_NORMAL_CHAR_FN_RE) THEN + SUBGOAL_THEN + `(t * sigma) pow 2 / &2 = sigma pow 2 * t pow 2 / &2` + (fun th -> REWRITE_TAC[th]) THENL + [REWRITE_TAC[REAL_POW_MUL] THEN REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_TAC THEN + MP_TAC(ISPECL [`\u:real. std_normal_density u * cos((t * sigma) * u)`; + `exp(--(sigma pow 2 * t pow 2 / &2)):real`; + `inv(sigma):real`; `--(mu / sigma):real`] + HAS_REAL_INTEGRAL_AFFINITY_UNIV) THEN + ASM_SIMP_TAC[REAL_INV_EQ_0] THEN + SUBGOAL_THEN + `!x:real. inv sigma * x + --(mu / sigma) = (x - mu) / sigma` + (fun th -> REWRITE_TAC[th]) THENL + [X_GEN_TAC `x:real` THEN + UNDISCH_TAC `~(sigma = &0)` THEN CONV_TAC REAL_FIELD; + ALL_TAC] THEN + SUBGOAL_THEN + `!x:real. (t * sigma) * ((x - mu) / sigma) = t * (x - mu)` + (fun th -> REWRITE_TAC[th]) THENL + [X_GEN_TAC `x:real` THEN + UNDISCH_TAC `~(sigma = &0)` THEN CONV_TAC REAL_FIELD; + ALL_TAC] THEN + SUBGOAL_THEN + `inv(abs(inv sigma)) * exp(--(sigma pow 2 * t pow 2 / &2)) = + sigma * exp(--(sigma pow 2 * t pow 2 / &2))` + (fun th -> REWRITE_TAC[th]) THEN + REWRITE_TAC[REAL_ABS_INV] THEN + SUBGOAL_THEN `abs sigma = sigma` (fun th -> REWRITE_TAC[th]) THENL + [ASM_REAL_ARITH_TAC; ASM_SIMP_TAC[REAL_INV_INV; REAL_MUL_LID]]);; + +(* Helper: integral of normal_density * sin(t*(x-mu)) = 0 *) +let NORMAL_SHIFTED_SIN_INTEGRAL = prove + (`!mu sigma t. &0 < sigma ==> + ((\x. normal_density mu sigma x * sin(t * (x - mu))) + has_real_integral &0) (:real)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `~(sigma = &0)` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `~(inv sigma = &0)` ASSUME_TAC THENL + [ASM_SIMP_TAC[REAL_INV_EQ_0]; ALL_TAC] THEN + SUBGOAL_THEN + `(\x. normal_density mu sigma x * sin(t * (x - mu))) = + (\x. inv(sigma) * (std_normal_density((x - mu) / sigma) * + sin(t * (x - mu))))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:real` THEN + ASM_SIMP_TAC[NORMAL_DENSITY_STANDARDIZE] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `&0 = inv(sigma) * &0:real` SUBST1_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_LMUL THEN + MP_TAC(SPEC `t * sigma:real` STD_NORMAL_CHAR_FN_IM) THEN + DISCH_TAC THEN + MP_TAC(ISPECL [`\u:real. std_normal_density u * sin((t * sigma) * u)`; + `&0:real`; + `inv(sigma):real`; `--(mu / sigma):real`] + HAS_REAL_INTEGRAL_AFFINITY_UNIV) THEN + ASM_SIMP_TAC[REAL_INV_EQ_0] THEN + REWRITE_TAC[REAL_MUL_RZERO] THEN + SUBGOAL_THEN + `!x:real. inv sigma * x + --(mu / sigma) = (x - mu) / sigma` + (fun th -> REWRITE_TAC[th]) THENL + [X_GEN_TAC `x:real` THEN + UNDISCH_TAC `~(sigma = &0)` THEN CONV_TAC REAL_FIELD; + ALL_TAC] THEN + SUBGOAL_THEN + `!x:real. (t * sigma) * ((x - mu) / sigma) = t * (x - mu)` + (fun th -> REWRITE_TAC[th]) THEN + X_GEN_TAC `x:real` THEN + UNDISCH_TAC `~(sigma = &0)` THEN CONV_TAC REAL_FIELD);; + +(* Real part of general normal char fn: + integral of normal_density(x) * cos(t*x) = exp(-sigma^2*t^2/2) * cos(mu*t) *) +let NORMAL_CHAR_FN_RE = prove + (`!mu sigma t. &0 < sigma ==> + ((\x. normal_density mu sigma x * cos(t * x)) has_real_integral + exp(--(sigma pow 2 * t pow 2 / &2)) * cos(mu * t)) (:real)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `!x:real. cos(t * x) = + cos(t * (x - mu)) * cos(t * mu) - sin(t * (x - mu)) * sin(t * mu)` + (fun th -> ONCE_REWRITE_TAC[th]) THENL + [X_GEN_TAC `x:real` THEN + MP_TAC(SPECL [`t * (x - mu):real`; `t * mu:real`] COS_ADD) THEN + DISCH_THEN(fun th -> REWRITE_TAC[GSYM th]) THEN + AP_TERM_TAC THEN REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[REAL_ARITH + `d * (c1 * cm - s1 * sm):real = d * c1 * cm - d * s1 * sm`] THEN + SUBGOAL_THEN + `exp(--(sigma pow 2 * t pow 2 / &2)) * cos(mu * t) = + exp(--(sigma pow 2 * t pow 2 / &2)) * cos(t * mu) - + &0 * sin(t * mu)` + SUBST1_TAC THENL + [REWRITE_TAC[REAL_MUL_LZERO; REAL_SUB_RZERO; REAL_MUL_AC]; ALL_TAC] THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_SUB THEN CONJ_TAC THENL + [ONCE_REWRITE_TAC[REAL_ARITH + `d * c * cm:real = (d * c) * cm`] THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_RMUL THEN + ASM_SIMP_TAC[NORMAL_SHIFTED_COS_INTEGRAL]; + ONCE_REWRITE_TAC[REAL_ARITH + `d * s * sm:real = (d * s) * sm`] THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_RMUL THEN + ASM_SIMP_TAC[NORMAL_SHIFTED_SIN_INTEGRAL]]);; + +(* Imaginary part of general normal char fn: + integral of normal_density(x) * sin(t*x) = exp(-sigma^2*t^2/2) * sin(mu*t) *) +let NORMAL_CHAR_FN_IM = prove + (`!mu sigma t. &0 < sigma ==> + ((\x. normal_density mu sigma x * sin(t * x)) has_real_integral + exp(--(sigma pow 2 * t pow 2 / &2)) * sin(mu * t)) (:real)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `!x:real. sin(t * x) = + sin(t * (x - mu)) * cos(t * mu) + cos(t * (x - mu)) * sin(t * mu)` + (fun th -> ONCE_REWRITE_TAC[th]) THENL + [X_GEN_TAC `x:real` THEN + MP_TAC(SPECL [`t * (x - mu):real`; `t * mu:real`] SIN_ADD) THEN + DISCH_THEN(fun th -> REWRITE_TAC[GSYM th]) THEN + AP_TERM_TAC THEN REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[REAL_ARITH + `d * (s1 * cm + c1 * sm):real = d * s1 * cm + d * c1 * sm`] THEN + SUBGOAL_THEN + `exp(--(sigma pow 2 * t pow 2 / &2)) * sin(mu * t) = + &0 * cos(t * mu) + + exp(--(sigma pow 2 * t pow 2 / &2)) * sin(t * mu)` + SUBST1_TAC THENL + [REWRITE_TAC[REAL_MUL_LZERO; REAL_ADD_LID; REAL_MUL_AC]; ALL_TAC] THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_ADD THEN CONJ_TAC THENL + [ONCE_REWRITE_TAC[REAL_ARITH + `d * s * cm:real = (d * s) * cm`] THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_RMUL THEN + ASM_SIMP_TAC[NORMAL_SHIFTED_SIN_INTEGRAL]; + ONCE_REWRITE_TAC[REAL_ARITH + `d * c * sm:real = (d * c) * sm`] THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_RMUL THEN + ASM_SIMP_TAC[NORMAL_SHIFTED_COS_INTEGRAL]]);; + +(* ---- Uniform char fn ---- *) + +(* FTC helper: integral of cos(t*x) on [a,b] *) +let COS_HAS_REAL_INTEGRAL = prove + (`!a b t. a <= b /\ ~(t = &0) ==> + ((\x. cos(t * x)) has_real_integral + (sin(t * b) - sin(t * a)) / t) (real_interval[a,b])`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\x:real. sin(t * x) / t`; `\x:real. cos(t * x)`; + `a:real`; `b:real`] + REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_REAL_DERIVATIVE_ATREAL_WITHIN THEN + REAL_DIFF_TAC THEN UNDISCH_TAC `~(t = &0)` THEN CONV_TAC REAL_FIELD; + REWRITE_TAC[REAL_ARITH `b / t - a / t = (b - a) / t:real`]]);; + +(* FTC helper: integral of sin(t*x) on [a,b] *) +let SIN_HAS_REAL_INTEGRAL = prove + (`!a b t. a <= b /\ ~(t = &0) ==> + ((\x. sin(t * x)) has_real_integral + (cos(t * a) - cos(t * b)) / t) (real_interval[a,b])`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`\x:real. --(cos(t * x)) / t`; `\x:real. sin(t * x)`; + `a:real`; `b:real`] + REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_REAL_DERIVATIVE_ATREAL_WITHIN THEN + REAL_DIFF_TAC THEN UNDISCH_TAC `~(t = &0)` THEN CONV_TAC REAL_FIELD; + REWRITE_TAC[REAL_ARITH + `--(c2:real) / t - --(c1) / t = (c1 - c2) / t`]]);; + +(* Real part of uniform char fn *) +let UNIFORM_CHAR_FN_RE = prove + (`!a b t. a < b /\ ~(t = &0) ==> + ((\x. uniform_density a b x * cos(t * x)) has_real_integral + (sin(t * b) - sin(t * a)) / (t * (b - a))) (:real)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `~(b - a = &0)` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `(\x:real. uniform_density a b x * cos(t * x)) = + (\x. if x IN real_interval[a,b] then inv(b - a) * cos(t * x) else &0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; IN_REAL_INTERVAL; uniform_density] THEN + GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[HAS_REAL_INTEGRAL_RESTRICT_UNIV] THEN + SUBGOAL_THEN + `(sin(t * b) - sin(t * a)) / (t * (b - a)) = + inv(b - a) * ((sin(t * b) - sin(t * a)) / t)` + SUBST1_TAC THENL + [UNDISCH_TAC `~(b - a = &0)` THEN UNDISCH_TAC `~(t = &0)` THEN + CONV_TAC REAL_FIELD; + MATCH_MP_TAC HAS_REAL_INTEGRAL_LMUL THEN + MATCH_MP_TAC COS_HAS_REAL_INTEGRAL THEN ASM_REAL_ARITH_TAC]);; + +(* Imaginary part of uniform char fn *) +let UNIFORM_CHAR_FN_IM = prove + (`!a b t. a < b /\ ~(t = &0) ==> + ((\x. uniform_density a b x * sin(t * x)) has_real_integral + (cos(t * a) - cos(t * b)) / (t * (b - a))) (:real)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `~(b - a = &0)` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `(\x:real. uniform_density a b x * sin(t * x)) = + (\x. if x IN real_interval[a,b] then inv(b - a) * sin(t * x) else &0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; IN_REAL_INTERVAL; uniform_density] THEN + GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[HAS_REAL_INTEGRAL_RESTRICT_UNIV] THEN + SUBGOAL_THEN + `(cos(t * a) - cos(t * b)) / (t * (b - a)) = + inv(b - a) * ((cos(t * a) - cos(t * b)) / t)` + SUBST1_TAC THENL + [UNDISCH_TAC `~(b - a = &0)` THEN UNDISCH_TAC `~(t = &0)` THEN + CONV_TAC REAL_FIELD; + MATCH_MP_TAC HAS_REAL_INTEGRAL_LMUL THEN + MATCH_MP_TAC SIN_HAS_REAL_INTEGRAL THEN ASM_REAL_ARITH_TAC]);; + +(* ---- Exponential char fn ---- *) + +(* Antiderivative for exp(-l*x) * cos(t*x) *) +let EXP_COS_ANTIDERIV = prove + (`!l t x. &0 < l ==> + ((\x. exp(--l * x) * (--l * cos(t * x) + t * sin(t * x)) / + (l pow 2 + t pow 2)) + has_real_derivative (exp(--l * x) * cos(t * x))) (atreal x)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `~(l pow 2 + t pow 2 = &0)` ASSUME_TAC THENL + [MATCH_MP_TAC(REAL_ARITH `&0 < a /\ &0 <= b ==> ~(a + b = &0)`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_POW_LT THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[REAL_LE_POW_2]]; + ALL_TAC] THEN + REAL_DIFF_TAC THEN + UNDISCH_TAC `~(l pow 2 + t pow 2 = &0)` THEN + UNDISCH_TAC `&0 < l` THEN + CONV_TAC REAL_FIELD);; + +(* Antiderivative for exp(-l*x) * sin(t*x) *) +let EXP_SIN_ANTIDERIV = prove + (`!l t x. &0 < l ==> + ((\x. exp(--l * x) * (--l * sin(t * x) - t * cos(t * x)) / + (l pow 2 + t pow 2)) + has_real_derivative (exp(--l * x) * sin(t * x))) (atreal x)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `~(l pow 2 + t pow 2 = &0)` ASSUME_TAC THENL + [MATCH_MP_TAC(REAL_ARITH `&0 < a /\ &0 <= b ==> ~(a + b = &0)`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_POW_LT THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[REAL_LE_POW_2]]; + ALL_TAC] THEN + REAL_DIFF_TAC THEN + UNDISCH_TAC `~(l pow 2 + t pow 2 = &0)` THEN + UNDISCH_TAC `&0 < l` THEN + CONV_TAC REAL_FIELD);; + +(* FTC: integral of exp(-l*x) * cos(t*x) on [0,k] *) +let EXP_COS_INTEGRAL_INTERVAL = prove + (`!l t k. &0 < l /\ &0 <= k ==> + ((\x. exp(--l * x) * cos(t * x)) has_real_integral + (l - exp(--l * k) * (l * cos(t * k) - t * sin(t * k))) / + (l pow 2 + t pow 2)) + (real_interval[&0,k])`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `~(l pow 2 + t pow 2 = &0)` ASSUME_TAC THENL + [MATCH_MP_TAC(REAL_ARITH `&0 < a /\ &0 <= b ==> ~(a + b = &0)`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_POW_LT THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[REAL_LE_POW_2]]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`\x:real. exp(--l * x) * (--l * cos(t * x) + t * sin(t * x)) / + (l pow 2 + t pow 2)`; + `\x:real. exp(--l * x) * cos(t * x)`; + `&0`; `k:real`] + REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_REAL_DERIVATIVE_ATREAL_WITHIN THEN + MATCH_MP_TAC EXP_COS_ANTIDERIV THEN ASM_REWRITE_TAC[]; + SUBGOAL_THEN + `exp(--l * k) * (--l * cos(t * k) + t * sin(t * k)) / + (l pow 2 + t pow 2) - + exp(--l * &0) * (--l * cos(t * &0) + t * sin(t * &0)) / + (l pow 2 + t pow 2) = + (l - exp(--l * k) * (l * cos(t * k) - t * sin(t * k))) / + (l pow 2 + t pow 2)` + (fun th -> REWRITE_TAC[th]) THEN + REWRITE_TAC[COS_0; SIN_0; REAL_EXP_0; REAL_MUL_RZERO; REAL_NEG_0; + REAL_MUL_LID; REAL_ADD_RID; REAL_MUL_RID] THEN + UNDISCH_TAC `~(l pow 2 + t pow 2 = &0)` THEN + CONV_TAC REAL_FIELD]);; + +(* FTC: integral of exp(-l*x) * sin(t*x) on [0,k] *) +let EXP_SIN_INTEGRAL_INTERVAL = prove + (`!l t k. &0 < l /\ &0 <= k ==> + ((\x. exp(--l * x) * sin(t * x)) has_real_integral + (t - exp(--l * k) * (l * sin(t * k) + t * cos(t * k))) / + (l pow 2 + t pow 2)) + (real_interval[&0,k])`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `~(l pow 2 + t pow 2 = &0)` ASSUME_TAC THENL + [MATCH_MP_TAC(REAL_ARITH `&0 < a /\ &0 <= b ==> ~(a + b = &0)`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_POW_LT THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[REAL_LE_POW_2]]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`\x:real. exp(--l * x) * (--l * sin(t * x) - t * cos(t * x)) / + (l pow 2 + t pow 2)`; + `\x:real. exp(--l * x) * sin(t * x)`; + `&0`; `k:real`] + REAL_FUNDAMENTAL_THEOREM_OF_CALCULUS) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [REPEAT STRIP_TAC THEN + MATCH_MP_TAC HAS_REAL_DERIVATIVE_ATREAL_WITHIN THEN + MATCH_MP_TAC EXP_SIN_ANTIDERIV THEN ASM_REWRITE_TAC[]; + SUBGOAL_THEN + `exp(--l * k) * (--l * sin(t * k) - t * cos(t * k)) / + (l pow 2 + t pow 2) - + exp(--l * &0) * (--l * sin(t * &0) - t * cos(t * &0)) / + (l pow 2 + t pow 2) = + (t - exp(--l * k) * (l * sin(t * k) + t * cos(t * k))) / + (l pow 2 + t pow 2)` + (fun th -> REWRITE_TAC[th]) THEN + REWRITE_TAC[COS_0; SIN_0; REAL_EXP_0; REAL_MUL_RZERO; REAL_NEG_0; + REAL_MUL_LID; REAL_SUB_RZERO; REAL_MUL_RID] THEN + UNDISCH_TAC `~(l pow 2 + t pow 2 = &0)` THEN + CONV_TAC REAL_FIELD]);; + +(* Exponential density integrable on {x | 0 <= x} - reusable from existing *) +let EXPONENTIAL_DENSITY_INTEGRABLE_NONNEG = prove + (`!l. &0 < l ==> + (\x. if &0 <= x then l * exp(--l * x) else &0) + real_integrable_on (:real)`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC HAS_REAL_INTEGRAL_INTEGRABLE THEN + EXISTS_TAC `&1` THEN + SUBGOAL_THEN + `(\x:real. if &0 <= x then l * exp(--l * x) else &0) = + (\x. if x IN {x | &0 <= x} then l * exp(--l * x) else &0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; IN_ELIM_THM]; ALL_TAC] THEN + REWRITE_TAC[HAS_REAL_INTEGRAL_RESTRICT_UNIV] THEN + ASM_SIMP_TAC[EXPONENTIAL_DENSITY_INTEGRAL]);; + +(* Real part of exponential char fn via dominated convergence *) +let EXPONENTIAL_CHAR_FN_RE = prove + (`!l t. &0 < l ==> + ((\x. exponential_density l x * cos(t * x)) has_real_integral + l pow 2 / (l pow 2 + t pow 2)) {x | &0 <= x}`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `~(l pow 2 + t pow 2 = &0)` ASSUME_TAC THENL + [MATCH_MP_TAC(REAL_ARITH `&0 < a /\ &0 <= b ==> ~(a + b = &0)`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_POW_LT THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[REAL_LE_POW_2]]; + ALL_TAC] THEN + REWRITE_TAC[exponential_density] THEN + REWRITE_TAC[REAL_ARITH + `(if &0 <= x then l * e else &0) * c = + (if &0 <= x then l * e * c else &0)`] THEN + ONCE_REWRITE_TAC[GSYM HAS_REAL_INTEGRAL_RESTRICT_UNIV] THEN + REWRITE_TAC[IN_ELIM_THM] THEN + SUBGOAL_THEN + `(\x:real. if &0 <= x then if &0 <= x then l * exp(--l * x) * cos(t * x) + else &0 else &0) = + (\x. if &0 <= x then l * exp(--l * x) * cos(t * x) else &0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + COND_CASES_TAC THEN REWRITE_TAC[]; + ALL_TAC] THEN + ABBREV_TAC + `g = \x:real. if &0 <= x then l * exp(--l * x) * cos(t * x) else &0` THEN + ABBREV_TAC + `f = \k x:real. if &0 <= x /\ x <= &k then l * exp(--l * x) * cos(t * x) + else &0` THEN + ABBREV_TAC + `h = \x:real. if &0 <= x then l * exp(--l * x) else &0` THEN + (* Apply dominated convergence *) + SUBGOAL_THEN + `g real_integrable_on (:real) /\ + ((\k. real_integral (:real) (f k)) ---> real_integral (:real) g) + sequentially` + STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC REAL_DOMINATED_CONVERGENCE THEN + EXISTS_TAC `h:real->real` THEN REPEAT CONJ_TAC THENL + [(* f_k integrable *) + X_GEN_TAC `k:num` THEN EXPAND_TAC "f" THEN + SUBGOAL_THEN + `(\x. if &0 <= x /\ x <= &k then l * exp(--l * x) * cos(t * x) + else &0) = + (\x. if x IN real_interval[&0,&k] + then l * exp(--l * x) * cos(t * x) else &0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; IN_REAL_INTERVAL] THEN MESON_TAC[]; + REWRITE_TAC[real_integrable_on] THEN + EXISTS_TAC `l * (l - exp(--l * &k) * + (l * cos(t * &k) - t * sin(t * &k))) / + (l pow 2 + t pow 2)` THEN + REWRITE_TAC[HAS_REAL_INTEGRAL_RESTRICT_UNIV] THEN + ONCE_REWRITE_TAC[REAL_ARITH + `l * e * c:real = l * (e * c)`] THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_LMUL THEN + MATCH_MP_TAC EXP_COS_INTEGRAL_INTERVAL THEN + ASM_REWRITE_TAC[REAL_POS]]; + (* h integrable *) + EXPAND_TAC "h" THEN ASM_SIMP_TAC[EXPONENTIAL_DENSITY_INTEGRABLE_NONNEG]; + (* |f_k(x)| <= h(x) *) + X_GEN_TAC `k:num` THEN X_GEN_TAC `x:real` THEN DISCH_TAC THEN + EXPAND_TAC "f" THEN EXPAND_TAC "h" THEN + ASM_CASES_TAC `&0 <= x` THENL + [ASM_REWRITE_TAC[] THEN COND_CASES_TAC THENL + [REWRITE_TAC[REAL_ABS_MUL] THEN + SUBGOAL_THEN `abs l = l` (fun th -> REWRITE_TAC[th]) THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `abs(exp(--l * x)) = exp(--l * x)` + (fun th -> REWRITE_TAC[th]) THENL + [REWRITE_TAC[REAL_ABS_REFL; REAL_EXP_POS_LE]; ALL_TAC] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; REWRITE_TAC[REAL_EXP_POS_LE]]; + REWRITE_TAC[COS_BOUND]]; + REWRITE_TAC[REAL_ABS_NUM] THEN + MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; REWRITE_TAC[REAL_EXP_POS_LE]]]; + ASM_REWRITE_TAC[REAL_ABS_NUM; REAL_LE_REFL]]; + (* pointwise convergence *) + X_GEN_TAC `x:real` THEN DISCH_TAC THEN + EXPAND_TAC "f" THEN EXPAND_TAC "g" THEN + ASM_CASES_TAC `&0 <= x` THENL + [ASM_REWRITE_TAC[] THEN REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(SPEC `x:real` REAL_ARCH_SIMPLE) THEN + DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN + EXISTS_TAC `N:num` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + SUBGOAL_THEN `x <= &n` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&N` THEN + ASM_REWRITE_TAC[REAL_OF_NUM_LE]; + ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_ABS_NUM] THEN + ASM_REAL_ARITH_TAC]; + ASM_REWRITE_TAC[] THEN REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `0` THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC]]; + ALL_TAC] THEN + (* Now extract the integral value *) + SUBGOAL_THEN `real_integral (:real) g = l pow 2 / (l pow 2 + t pow 2)` + (fun th -> ONCE_REWRITE_TAC[SYM th] THEN + REWRITE_TAC[GSYM HAS_REAL_INTEGRAL_INTEGRAL] THEN + ASM_REWRITE_TAC[]) THEN + MATCH_MP_TAC(ISPEC `sequentially` REALLIM_UNIQUE) THEN + EXISTS_TAC `\k:num. real_integral (:real) ((f:num->real->real) k)` THEN + ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN + (* Show the sequence of integrals equals the closed-form expressions *) + SUBGOAL_THEN + `(\k. real_integral (:real) ((f:num->real->real) k)) = + (\k. l * (l - exp(--l * &k) * + (l * cos(t * &k) - t * sin(t * &k))) / + (l pow 2 + t pow 2))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `k:num` THEN + EXPAND_TAC "f" THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + SUBGOAL_THEN + `(\x. if &0 <= x /\ x <= &k then l * exp(--l * x) * cos(t * x) + else &0) = + (\x. if x IN real_interval[&0,&k] + then l * exp(--l * x) * cos(t * x) else &0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; IN_REAL_INTERVAL] THEN MESON_TAC[]; + REWRITE_TAC[HAS_REAL_INTEGRAL_RESTRICT_UNIV] THEN + ONCE_REWRITE_TAC[REAL_ARITH + `l * e * c:real = l * (e * c)`] THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_LMUL THEN + MATCH_MP_TAC EXP_COS_INTEGRAL_INTERVAL THEN + ASM_REWRITE_TAC[REAL_POS]]; + ALL_TAC] THEN + (* Show limit of closed-form = l^2 / (l^2 + t^2) *) + GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV) [real_div] THEN + GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV o RATOR_CONV o RAND_CONV) + [REAL_POW_2] THEN + GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV) [GSYM REAL_MUL_ASSOC] THEN + MATCH_MP_TAC REALLIM_LMUL THEN + GEN_REWRITE_TAC (RATOR_CONV o RAND_CONV) [GSYM real_div] THEN + SUBGOAL_THEN + `l / (l pow 2 + t pow 2) = + (l - &0) / (l pow 2 + t pow 2)` + SUBST1_TAC THENL + [REWRITE_TAC[REAL_SUB_RZERO]; ALL_TAC] THEN + MATCH_MP_TAC REALLIM_DIV THEN + ASM_REWRITE_TAC[REALLIM_CONST] THEN + MATCH_MP_TAC REALLIM_SUB THEN + REWRITE_TAC[REALLIM_CONST] THEN + MATCH_MP_TAC REALLIM_NULL_COMPARISON THEN + EXISTS_TAC `\k:num. (abs l + abs t) * exp(--l * &k)` THEN CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `0` THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_EXP] THEN + GEN_REWRITE_TAC (RAND_CONV) [REAL_MUL_SYM] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_EXP_POS_LE] THEN + MATCH_MP_TAC(REAL_ARITH + `abs(a * c) <= abs a /\ abs(b * s) <= abs b + ==> abs(a * c - b * s) <= abs a + abs b`) THEN + CONJ_TAC THEN REWRITE_TAC[REAL_ABS_MUL] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN + REWRITE_TAC[REAL_ABS_POS] THEN REWRITE_TAC[COS_BOUND; SIN_BOUND]; + MATCH_MP_TAC REALLIM_NULL_LMUL THEN + MP_TAC(SPEC `l:real` EXPONENTIAL_LIMIT_POSINFINITY) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o MATCH_MP REALLIM_POSINFINITY_SEQUENTIALLY) THEN + REWRITE_TAC[]]);; + +(* Imaginary part of exponential char fn *) +let EXPONENTIAL_CHAR_FN_IM = prove + (`!l t. &0 < l ==> + ((\x. exponential_density l x * sin(t * x)) has_real_integral + l * t / (l pow 2 + t pow 2)) {x | &0 <= x}`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `~(l pow 2 + t pow 2 = &0)` ASSUME_TAC THENL + [MATCH_MP_TAC(REAL_ARITH `&0 < a /\ &0 <= b ==> ~(a + b = &0)`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_POW_LT THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[REAL_LE_POW_2]]; + ALL_TAC] THEN + REWRITE_TAC[exponential_density] THEN + REWRITE_TAC[REAL_ARITH + `(if &0 <= x then l * e else &0) * s = + (if &0 <= x then l * e * s else &0)`] THEN + ONCE_REWRITE_TAC[GSYM HAS_REAL_INTEGRAL_RESTRICT_UNIV] THEN + REWRITE_TAC[IN_ELIM_THM] THEN + SUBGOAL_THEN + `(\x:real. if &0 <= x then if &0 <= x then l * exp(--l * x) * sin(t * x) + else &0 else &0) = + (\x. if &0 <= x then l * exp(--l * x) * sin(t * x) else &0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + COND_CASES_TAC THEN REWRITE_TAC[]; + ALL_TAC] THEN + ABBREV_TAC + `g = \x:real. if &0 <= x then l * exp(--l * x) * sin(t * x) else &0` THEN + ABBREV_TAC + `f = \k x:real. if &0 <= x /\ x <= &k then l * exp(--l * x) * sin(t * x) + else &0` THEN + ABBREV_TAC + `h = \x:real. if &0 <= x then l * exp(--l * x) else &0` THEN + SUBGOAL_THEN + `g real_integrable_on (:real) /\ + ((\k. real_integral (:real) (f k)) ---> real_integral (:real) g) + sequentially` + STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC REAL_DOMINATED_CONVERGENCE THEN + EXISTS_TAC `h:real->real` THEN REPEAT CONJ_TAC THENL + [(* f_k integrable *) + X_GEN_TAC `k:num` THEN EXPAND_TAC "f" THEN + SUBGOAL_THEN + `(\x. if &0 <= x /\ x <= &k then l * exp(--l * x) * sin(t * x) + else &0) = + (\x. if x IN real_interval[&0,&k] + then l * exp(--l * x) * sin(t * x) else &0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; IN_REAL_INTERVAL] THEN MESON_TAC[]; + REWRITE_TAC[real_integrable_on] THEN + EXISTS_TAC `l * (t - exp(--l * &k) * + (l * sin(t * &k) + t * cos(t * &k))) / + (l pow 2 + t pow 2)` THEN + REWRITE_TAC[HAS_REAL_INTEGRAL_RESTRICT_UNIV] THEN + ONCE_REWRITE_TAC[REAL_ARITH + `l * e * s:real = l * (e * s)`] THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_LMUL THEN + MATCH_MP_TAC EXP_SIN_INTEGRAL_INTERVAL THEN + ASM_REWRITE_TAC[REAL_POS]]; + (* h integrable *) + EXPAND_TAC "h" THEN ASM_SIMP_TAC[EXPONENTIAL_DENSITY_INTEGRABLE_NONNEG]; + (* |f_k(x)| <= h(x) *) + X_GEN_TAC `k:num` THEN X_GEN_TAC `x:real` THEN DISCH_TAC THEN + EXPAND_TAC "f" THEN EXPAND_TAC "h" THEN + ASM_CASES_TAC `&0 <= x` THENL + [ASM_REWRITE_TAC[] THEN COND_CASES_TAC THENL + [REWRITE_TAC[REAL_ABS_MUL] THEN + SUBGOAL_THEN `abs l = l` (fun th -> REWRITE_TAC[th]) THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `abs(exp(--l * x)) = exp(--l * x)` + (fun th -> REWRITE_TAC[th]) THENL + [REWRITE_TAC[REAL_ABS_REFL; REAL_EXP_POS_LE]; ALL_TAC] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; REWRITE_TAC[REAL_EXP_POS_LE]]; + REWRITE_TAC[SIN_BOUND]]; + REWRITE_TAC[REAL_ABS_NUM] THEN + MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; REWRITE_TAC[REAL_EXP_POS_LE]]]; + ASM_REWRITE_TAC[REAL_ABS_NUM; REAL_LE_REFL]]; + (* pointwise convergence *) + X_GEN_TAC `x:real` THEN DISCH_TAC THEN + EXPAND_TAC "f" THEN EXPAND_TAC "g" THEN + ASM_CASES_TAC `&0 <= x` THENL + [ASM_REWRITE_TAC[] THEN REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(SPEC `x:real` REAL_ARCH_SIMPLE) THEN + DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN + EXISTS_TAC `N:num` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + SUBGOAL_THEN `x <= &n` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&N` THEN + ASM_REWRITE_TAC[REAL_OF_NUM_LE]; + ASM_REWRITE_TAC[REAL_SUB_REFL; REAL_ABS_NUM] THEN + ASM_REAL_ARITH_TAC]; + ASM_REWRITE_TAC[] THEN REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN EXISTS_TAC `0` THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC]]; + ALL_TAC] THEN + SUBGOAL_THEN `real_integral (:real) g = l * t / (l pow 2 + t pow 2)` + (fun th -> ONCE_REWRITE_TAC[SYM th] THEN + REWRITE_TAC[GSYM HAS_REAL_INTEGRAL_INTEGRAL] THEN + ASM_REWRITE_TAC[]) THEN + MATCH_MP_TAC(ISPEC `sequentially` REALLIM_UNIQUE) THEN + EXISTS_TAC `\k:num. real_integral (:real) ((f:num->real->real) k)` THEN + ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN + SUBGOAL_THEN + `(\k. real_integral (:real) ((f:num->real->real) k)) = + (\k. l * (t - exp(--l * &k) * + (l * sin(t * &k) + t * cos(t * &k))) / + (l pow 2 + t pow 2))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `k:num` THEN + EXPAND_TAC "f" THEN MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + SUBGOAL_THEN + `(\x. if &0 <= x /\ x <= &k then l * exp(--l * x) * sin(t * x) + else &0) = + (\x. if x IN real_interval[&0,&k] + then l * exp(--l * x) * sin(t * x) else &0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; IN_REAL_INTERVAL] THEN MESON_TAC[]; + REWRITE_TAC[HAS_REAL_INTEGRAL_RESTRICT_UNIV] THEN + ONCE_REWRITE_TAC[REAL_ARITH + `l * e * s:real = l * (e * s)`] THEN + MATCH_MP_TAC HAS_REAL_INTEGRAL_LMUL THEN + MATCH_MP_TAC EXP_SIN_INTEGRAL_INTERVAL THEN + ASM_REWRITE_TAC[REAL_POS]]; + ALL_TAC] THEN + MATCH_MP_TAC REALLIM_LMUL THEN + SUBGOAL_THEN + `t / (l pow 2 + t pow 2) = + (t - &0) / (l pow 2 + t pow 2)` + SUBST1_TAC THENL + [REWRITE_TAC[REAL_SUB_RZERO]; ALL_TAC] THEN + MATCH_MP_TAC REALLIM_DIV THEN + ASM_REWRITE_TAC[REALLIM_CONST] THEN + MATCH_MP_TAC REALLIM_SUB THEN + REWRITE_TAC[REALLIM_CONST] THEN + MATCH_MP_TAC REALLIM_NULL_COMPARISON THEN + EXISTS_TAC `\k:num. (abs l + abs t) * exp(--l * &k)` THEN CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `0` THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_EXP] THEN + GEN_REWRITE_TAC (RAND_CONV) [REAL_MUL_SYM] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_EXP_POS_LE] THEN + MATCH_MP_TAC(REAL_ARITH + `abs(a * s) <= abs a /\ abs(b * c) <= abs b + ==> abs(a * s + b * c) <= abs a + abs b`) THEN + CONJ_TAC THEN REWRITE_TAC[REAL_ABS_MUL] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN + REWRITE_TAC[REAL_ABS_POS] THEN REWRITE_TAC[SIN_BOUND; COS_BOUND]; + MATCH_MP_TAC REALLIM_NULL_LMUL THEN + MP_TAC(SPEC `l:real` EXPONENTIAL_LIMIT_POSINFINITY) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o MATCH_MP REALLIM_POSINFINITY_SEQUENTIALLY) THEN + REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------ *) +(* Bernoulli characteristic function *) +(* ------------------------------------------------------------------ *) + +let BERNOULLI_CHAR_FN_RE = prove + (`!p:A prob_space X q t. bernoulli_rv p X q ==> + simple_char_fn_re p X t = (&1 - q) + q * cos t`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(STRIP_ASSUME_TAC o REWRITE_RULE[bernoulli_rv]) THEN + REWRITE_TAC[simple_char_fn_re] THEN + FIRST_ASSUM(fun th -> + MP_TAC(MATCH_MP SIMPLE_EXPECTATION_COMPOSE_SUM th)) THEN + DISCH_THEN(MP_TAC o SPEC `\u:real. cos(t * u)`) THEN + BETA_TAC THEN DISCH_THEN SUBST1_TAC THEN + SUBGOAL_THEN + `IMAGE (X:A->real) (prob_carrier p) SUBSET IMAGE (\k:num. &k) (0..1)` + ASSUME_TAC THENL + [REWRITE_TAC[SUBSET; IN_IMAGE; IN_NUMSEG; LE_0] THEN + ASM_MESON_TAC[ARITH_RULE `0 <= 1`; LE_REFL]; ALL_TAC] THEN + SUBGOAL_THEN + `sum (IMAGE (X:A->real) (prob_carrier p)) + (\u. cos(t * u) * prob p {x | x IN prob_carrier p /\ X x = u}) = + sum (IMAGE (\k:num. &k) (0..1)) + (\u. cos(t * u) * prob (p:A prob_space) + {x:A | x IN prob_carrier p /\ (X:A->real) x = u})` + SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_SUPERSET THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + X_GEN_TAC `v:real` THEN REWRITE_TAC[IN_IMAGE; IN_NUMSEG; LE_0] THEN + STRIP_TAC THEN + SUBGOAL_THEN `{x:A | x IN prob_carrier p /\ (X:A->real) x = v} = {}` + (fun th -> REWRITE_TAC[th; PROB_EMPTY; REAL_MUL_RZERO]) THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN + ASM_MESON_TAC[]]; ALL_TAC] THEN + SIMP_TAC[FINITE_NUMSEG; SUM_IMAGE; IN_NUMSEG; LE_0; REAL_OF_NUM_EQ] THEN + REWRITE_TAC[o_DEF] THEN BETA_TAC THEN + REWRITE_TAC[ARITH_RULE `1 = SUC 0`; SUM_CLAUSES_NUMSEG; LE_0] THEN + CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[REAL_MUL_RZERO; COS_0; REAL_MUL_LID; REAL_MUL_RID] THEN + SUBGOAL_THEN + `prob (p:A prob_space) {x:A | x IN prob_carrier p /\ (X:A->real) x = &0} = + &1 - q` + SUBST1_TAC THENL + [MATCH_MP_TAC BERNOULLI_RV_PROB_ZERO THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; + +let BERNOULLI_CHAR_FN_IM = prove + (`!p:A prob_space X q t. bernoulli_rv p X q ==> + simple_char_fn_im p X t = q * sin t`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(STRIP_ASSUME_TAC o REWRITE_RULE[bernoulli_rv]) THEN + REWRITE_TAC[simple_char_fn_im] THEN + FIRST_ASSUM(fun th -> + MP_TAC(MATCH_MP SIMPLE_EXPECTATION_COMPOSE_SUM th)) THEN + DISCH_THEN(MP_TAC o SPEC `\u:real. sin(t * u)`) THEN + BETA_TAC THEN DISCH_THEN SUBST1_TAC THEN + SUBGOAL_THEN + `IMAGE (X:A->real) (prob_carrier p) SUBSET IMAGE (\k:num. &k) (0..1)` + ASSUME_TAC THENL + [REWRITE_TAC[SUBSET; IN_IMAGE; IN_NUMSEG; LE_0] THEN + ASM_MESON_TAC[ARITH_RULE `0 <= 1`; LE_REFL]; ALL_TAC] THEN + SUBGOAL_THEN + `sum (IMAGE (X:A->real) (prob_carrier p)) + (\u. sin(t * u) * prob p {x | x IN prob_carrier p /\ X x = u}) = + sum (IMAGE (\k:num. &k) (0..1)) + (\u. sin(t * u) * prob (p:A prob_space) + {x:A | x IN prob_carrier p /\ (X:A->real) x = u})` + SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_SUPERSET THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + X_GEN_TAC `v:real` THEN REWRITE_TAC[IN_IMAGE; IN_NUMSEG; LE_0] THEN + STRIP_TAC THEN + SUBGOAL_THEN `{x:A | x IN prob_carrier p /\ (X:A->real) x = v} = {}` + (fun th -> REWRITE_TAC[th; PROB_EMPTY; REAL_MUL_RZERO]) THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN + ASM_MESON_TAC[]]; ALL_TAC] THEN + SIMP_TAC[FINITE_NUMSEG; SUM_IMAGE; IN_NUMSEG; LE_0; REAL_OF_NUM_EQ] THEN + REWRITE_TAC[o_DEF] THEN BETA_TAC THEN + REWRITE_TAC[ARITH_RULE `1 = SUC 0`; SUM_CLAUSES_NUMSEG; LE_0] THEN + CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[REAL_MUL_RZERO; SIN_0; REAL_MUL_LZERO; REAL_ADD_LID; + REAL_MUL_RID] THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------ *) +(* Binomial characteristic function *) +(* ------------------------------------------------------------------ *) + +let BINOMIAL_CHAR_FN_RE = prove + (`!p:A prob_space X n q t. binomial_rv p X n q ==> + simple_char_fn_re p X t = + sum (0..n) (\k. &(binom(n,k)) * q pow k * (&1 - q) pow (n - k) * + cos(t * &k))`, + REPEAT GEN_TAC THEN REWRITE_TAC[binomial_rv] THEN STRIP_TAC THEN + REWRITE_TAC[simple_char_fn_re] THEN + FIRST_ASSUM(fun th -> + MP_TAC(MATCH_MP SIMPLE_EXPECTATION_COMPOSE_SUM th)) THEN + DISCH_THEN(MP_TAC o SPEC `\u:real. cos(t * u)`) THEN + BETA_TAC THEN DISCH_THEN SUBST1_TAC THEN + SUBGOAL_THEN `IMAGE (X:A->real) (prob_carrier p) SUBSET {&k | k <= n}` + ASSUME_TAC THENL + [REWRITE_TAC[SUBSET; IN_IMAGE; IN_ELIM_THM] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `sum (IMAGE (X:A->real) (prob_carrier p)) + (\u. cos(t * u) * prob p {x | x IN prob_carrier p /\ X x = u}) = + sum (IMAGE (\k:num. &k) (0..n)) + (\u. cos(t * u) * prob (p:A prob_space) + {x:A | x IN prob_carrier p /\ (X:A->real) x = u})` + SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_SUPERSET THEN CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ] SUBSET_TRANS)) THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_IMAGE; IN_NUMSEG; LE_0] THEN + MESON_TAC[]; + X_GEN_TAC `v:real` THEN REWRITE_TAC[IN_IMAGE; IN_NUMSEG; LE_0] THEN + STRIP_TAC THEN + SUBGOAL_THEN `{x:A | x IN prob_carrier p /\ (X:A->real) x = v} = {}` + (fun th -> REWRITE_TAC[th; PROB_EMPTY; REAL_MUL_RZERO]) THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN + ASM_MESON_TAC[]]; + ALL_TAC] THEN + SIMP_TAC[FINITE_NUMSEG; SUM_IMAGE; IN_NUMSEG; LE_0; REAL_OF_NUM_EQ] THEN + REWRITE_TAC[o_DEF] THEN BETA_TAC THEN + MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `k:num` THEN + REWRITE_TAC[IN_NUMSEG; LE_0] THEN DISCH_TAC THEN + SUBGOAL_THEN + `prob (p:A prob_space) {x:A | x IN prob_carrier p /\ (X:A->real) x = &k} = + &(binom(n,k)) * q pow k * (&1 - q) pow (n - k)` + SUBST1_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + REAL_ARITH_TAC]);; + +let BINOMIAL_CHAR_FN_IM = prove + (`!p:A prob_space X n q t. binomial_rv p X n q ==> + simple_char_fn_im p X t = + sum (0..n) (\k. &(binom(n,k)) * q pow k * (&1 - q) pow (n - k) * + sin(t * &k))`, + REPEAT GEN_TAC THEN REWRITE_TAC[binomial_rv] THEN STRIP_TAC THEN + REWRITE_TAC[simple_char_fn_im] THEN + FIRST_ASSUM(fun th -> + MP_TAC(MATCH_MP SIMPLE_EXPECTATION_COMPOSE_SUM th)) THEN + DISCH_THEN(MP_TAC o SPEC `\u:real. sin(t * u)`) THEN + BETA_TAC THEN DISCH_THEN SUBST1_TAC THEN + SUBGOAL_THEN `IMAGE (X:A->real) (prob_carrier p) SUBSET {&k | k <= n}` + ASSUME_TAC THENL + [REWRITE_TAC[SUBSET; IN_IMAGE; IN_ELIM_THM] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `sum (IMAGE (X:A->real) (prob_carrier p)) + (\u. sin(t * u) * prob p {x | x IN prob_carrier p /\ X x = u}) = + sum (IMAGE (\k:num. &k) (0..n)) + (\u. sin(t * u) * prob (p:A prob_space) + {x:A | x IN prob_carrier p /\ (X:A->real) x = u})` + SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_SUPERSET THEN CONJ_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (REWRITE_RULE[IMP_CONJ] SUBSET_TRANS)) THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_IMAGE; IN_NUMSEG; LE_0] THEN + MESON_TAC[]; + X_GEN_TAC `v:real` THEN REWRITE_TAC[IN_IMAGE; IN_NUMSEG; LE_0] THEN + STRIP_TAC THEN + SUBGOAL_THEN `{x:A | x IN prob_carrier p /\ (X:A->real) x = v} = {}` + (fun th -> REWRITE_TAC[th; PROB_EMPTY; REAL_MUL_RZERO]) THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN + ASM_MESON_TAC[]]; + ALL_TAC] THEN + SIMP_TAC[FINITE_NUMSEG; SUM_IMAGE; IN_NUMSEG; LE_0; REAL_OF_NUM_EQ] THEN + REWRITE_TAC[o_DEF] THEN BETA_TAC THEN + MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `k:num` THEN + REWRITE_TAC[IN_NUMSEG; LE_0] THEN DISCH_TAC THEN + SUBGOAL_THEN + `prob (p:A prob_space) {x:A | x IN prob_carrier p /\ (X:A->real) x = &k} = + &(binom(n,k)) * q pow k * (&1 - q) pow (n - k)` + SUBST1_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + REAL_ARITH_TAC]);; + +(* --------------------------------------------------------------------- *) +(* Poisson characteristic function (infinite series via complex exp) *) +(* --------------------------------------------------------------------- *) + +let POISSON_CHAR_FN_RE = prove + (`!lam t. &0 <= lam ==> + ((\k. cos(t * &k) * poisson_pmf lam k) real_sums + exp(lam * (cos t - &1)) * cos(lam * sin t)) (from 0)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MP_TAC(SPEC `Cx(lam) * cexp(ii * Cx(t))` CEXP_CONVERGES) THEN + DISCH_THEN(MP_TAC o MATCH_MP REAL_SUMS_RE) THEN + DISCH_THEN(MP_TAC o SPEC `exp(--lam)` o MATCH_MP REAL_SERIES_LMUL) THEN + SUBGOAL_THEN + `exp(--lam) * Re(cexp(Cx(lam) * cexp(ii * Cx(t)))) = + exp(lam * (cos t - &1)) * cos(lam * sin t)` + ASSUME_TAC THENL + [REWRITE_TAC[RE_CEXP; RE_MUL_CX; IM_MUL_CX; RE_CEXP; IM_CEXP; + RE_MUL_II; IM_MUL_II; RE_CX; IM_CX; + REAL_NEG_0; REAL_MUL_RZERO; REAL_EXP_0; REAL_MUL_RID; + REAL_MUL_LID] THEN + ONCE_REWRITE_TAC[REAL_MUL_ASSOC] THEN REWRITE_TAC[GSYM REAL_EXP_ADD] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_SUMS_EQ THEN + EXISTS_TAC `\n:num. exp(--lam) * + (Re o (\n. (Cx lam * cexp (ii * Cx t)) pow n / + Cx (&(FACT n)))) n` THEN + ASM_REWRITE_TAC[] THEN + X_GEN_TAC `n:num` THEN REWRITE_TAC[IN_FROM] THEN DISCH_TAC THEN + REWRITE_TAC[o_THM] THEN BETA_TAC THEN + REWRITE_TAC[COMPLEX_POW_MUL; GSYM CX_POW; GSYM CEXP_N; + complex_div; GSYM CX_INV; RE_MUL_CX] THEN + REWRITE_TAC[RE_CEXP; IM_MUL_CX; RE_MUL_CX; RE_MUL_II; IM_MUL_II; + RE_CX; IM_CX; REAL_NEG_0; REAL_MUL_RZERO; REAL_EXP_0; + REAL_MUL_RID; REAL_MUL_LID] THEN + REWRITE_TAC[poisson_pmf; real_div; REAL_MUL_AC]);; + +let POISSON_CHAR_FN_IM = prove + (`!lam t. &0 <= lam ==> + ((\k. sin(t * &k) * poisson_pmf lam k) real_sums + exp(lam * (cos t - &1)) * sin(lam * sin t)) (from 0)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MP_TAC(SPEC `Cx(lam) * cexp(ii * Cx(t))` CEXP_CONVERGES) THEN + DISCH_THEN(MP_TAC o MATCH_MP REAL_SUMS_IM) THEN + DISCH_THEN(MP_TAC o SPEC `exp(--lam)` o MATCH_MP REAL_SERIES_LMUL) THEN + SUBGOAL_THEN + `exp(--lam) * Im(cexp(Cx(lam) * cexp(ii * Cx(t)))) = + exp(lam * (cos t - &1)) * sin(lam * sin t)` + ASSUME_TAC THENL + [REWRITE_TAC[IM_CEXP; RE_MUL_CX; IM_MUL_CX; RE_CEXP; IM_CEXP; + RE_MUL_II; IM_MUL_II; RE_CX; IM_CX; + REAL_NEG_0; REAL_MUL_RZERO; REAL_EXP_0; REAL_MUL_RID; + REAL_MUL_LID] THEN + ONCE_REWRITE_TAC[REAL_MUL_ASSOC] THEN REWRITE_TAC[GSYM REAL_EXP_ADD] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_SUMS_EQ THEN + EXISTS_TAC `\n:num. exp(--lam) * + (Im o (\n. (Cx lam * cexp (ii * Cx t)) pow n / + Cx (&(FACT n)))) n` THEN + ASM_REWRITE_TAC[] THEN + X_GEN_TAC `n:num` THEN REWRITE_TAC[IN_FROM] THEN DISCH_TAC THEN + REWRITE_TAC[o_THM] THEN BETA_TAC THEN + REWRITE_TAC[COMPLEX_POW_MUL; GSYM CX_POW; GSYM CEXP_N; + complex_div; GSYM CX_INV; IM_MUL_CX] THEN + REWRITE_TAC[IM_CEXP; RE_MUL_CX; IM_MUL_CX; RE_MUL_II; IM_MUL_II; + RE_CX; IM_CX; REAL_NEG_0; REAL_MUL_RZERO; REAL_EXP_0; + REAL_MUL_RID; REAL_MUL_LID] THEN + REWRITE_TAC[poisson_pmf; real_div; REAL_MUL_AC]);; + +(* --------------------------------------------------------------------- *) +(* Geometric characteristic function (infinite series via complex GP) *) +(* --------------------------------------------------------------------- *) + +let GEOMETRIC_CHAR_FN_RE = prove + (`!p t. &0 < p /\ p <= &1 ==> + ((\k. cos(t * &k) * geometric_pmf p k) real_sums + p * (&1 - (&1 - p) * cos t) / + (&1 - &2 * (&1 - p) * cos t + (&1 - p) pow 2)) (from 0)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `norm(Cx(&1 - p) * cexp(ii * Cx t)) < &1` ASSUME_TAC THENL + [REWRITE_TAC[COMPLEX_NORM_MUL; NORM_CEXP_II; REAL_MUL_RID; + COMPLEX_NORM_CX] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o SPEC `0` o MATCH_MP SUMS_GP) THEN + REWRITE_TAC[complex_pow; COMPLEX_DIV_1] THEN + DISCH_THEN(MP_TAC o MATCH_MP REAL_SUMS_RE) THEN + DISCH_THEN(MP_TAC o SPEC `p:real` o MATCH_MP REAL_SERIES_LMUL) THEN + DISCH_TAC THEN + SUBGOAL_THEN + `p * Re(Cx(&1) / (Cx(&1) - Cx(&1 - p) * cexp(ii * Cx t))) = + p * (&1 - (&1 - p) * cos t) / + (&1 - &2 * (&1 - p) * cos t + (&1 - p) pow 2)` + ASSUME_TAC THENL + [ONCE_REWRITE_TAC[complex_div] THEN REWRITE_TAC[COMPLEX_MUL_LID] THEN + ONCE_REWRITE_TAC[COMPLEX_INV_CNJ] THEN + ONCE_REWRITE_TAC[complex_div] THEN + REWRITE_TAC[GSYM CX_POW; GSYM CX_INV; RE_MUL_CX; RE_CNJ] THEN + REWRITE_TAC[RE_SUB; RE_CX; RE_MUL_CX; RE_CEXP; + IM_MUL_II; RE_MUL_II; IM_CX; RE_CX; + REAL_NEG_0; REAL_EXP_0; REAL_MUL_LID] THEN + REWRITE_TAC[COMPLEX_SQNORM; RE_SUB; IM_SUB; RE_CX; IM_CX; + RE_MUL_CX; IM_MUL_CX; RE_CEXP; IM_CEXP; + RE_MUL_II; IM_MUL_II; RE_CX; IM_CX; + REAL_NEG_0; REAL_EXP_0; REAL_MUL_LID] THEN + SUBGOAL_THEN + `(&1 - (&1 - p) * cos t) pow 2 + (&0 - (&1 - p) * sin t) pow 2 = + &1 - &2 * (&1 - p) * cos t + (&1 - p) pow 2` + SUBST1_TAC THENL + [MP_TAC(SPEC `t:real` SIN_CIRCLE) THEN CONV_TAC REAL_RING; + REWRITE_TAC[real_div; REAL_MUL_AC]]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_SUMS_EQ THEN + EXISTS_TAC `\n:num. p * + (Re o (\k. (Cx(&1 - p) * cexp(ii * Cx t)) pow k)) n` THEN + CONJ_TAC THENL + [X_GEN_TAC `n:num` THEN REWRITE_TAC[IN_FROM] THEN DISCH_TAC THEN + REWRITE_TAC[o_THM] THEN BETA_TAC THEN + REWRITE_TAC[COMPLEX_POW_MUL; GSYM CX_POW; GSYM CEXP_N; + RE_MUL_CX; RE_CEXP; IM_MUL_CX; RE_MUL_II; IM_MUL_II; + RE_CX; IM_CX; REAL_NEG_0; REAL_MUL_RZERO; REAL_EXP_0; + REAL_MUL_RID; REAL_MUL_LID] THEN + REWRITE_TAC[geometric_pmf; REAL_MUL_AC]; + ASM_MESON_TAC[]]);; + +let GEOMETRIC_CHAR_FN_IM = prove + (`!p t. &0 < p /\ p <= &1 ==> + ((\k. sin(t * &k) * geometric_pmf p k) real_sums + p * (&1 - p) * sin t / + (&1 - &2 * (&1 - p) * cos t + (&1 - p) pow 2)) (from 0)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `norm(Cx(&1 - p) * cexp(ii * Cx t)) < &1` ASSUME_TAC THENL + [REWRITE_TAC[COMPLEX_NORM_MUL; NORM_CEXP_II; REAL_MUL_RID; + COMPLEX_NORM_CX] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o SPEC `0` o MATCH_MP SUMS_GP) THEN + REWRITE_TAC[complex_pow; COMPLEX_DIV_1] THEN + DISCH_THEN(MP_TAC o MATCH_MP REAL_SUMS_IM) THEN + DISCH_THEN(MP_TAC o SPEC `p:real` o MATCH_MP REAL_SERIES_LMUL) THEN + DISCH_TAC THEN + SUBGOAL_THEN + `p * Im(Cx(&1) / (Cx(&1) - Cx(&1 - p) * cexp(ii * Cx t))) = + p * (&1 - p) * sin t / + (&1 - &2 * (&1 - p) * cos t + (&1 - p) pow 2)` + ASSUME_TAC THENL + [ONCE_REWRITE_TAC[complex_div] THEN REWRITE_TAC[COMPLEX_MUL_LID] THEN + ONCE_REWRITE_TAC[COMPLEX_INV_CNJ] THEN + ONCE_REWRITE_TAC[complex_div] THEN + REWRITE_TAC[GSYM CX_POW; GSYM CX_INV; IM_MUL_CX; IM_CNJ] THEN + REWRITE_TAC[IM_SUB; IM_CX; IM_MUL_CX; IM_CEXP; + RE_MUL_II; IM_MUL_II; RE_CX; IM_CX; + REAL_NEG_0; REAL_EXP_0; REAL_MUL_LID] THEN + REWRITE_TAC[COMPLEX_SQNORM; RE_SUB; IM_SUB; RE_CX; IM_CX; + RE_MUL_CX; IM_MUL_CX; RE_CEXP; IM_CEXP; + RE_MUL_II; IM_MUL_II; RE_CX; IM_CX; + REAL_NEG_0; REAL_EXP_0; REAL_MUL_LID] THEN + SUBGOAL_THEN + `(&1 - (&1 - p) * cos t) pow 2 + (&0 - (&1 - p) * sin t) pow 2 = + &1 - &2 * (&1 - p) * cos t + (&1 - p) pow 2` + SUBST1_TAC THENL + [MP_TAC(SPEC `t:real` SIN_CIRCLE) THEN CONV_TAC REAL_RING; + REWRITE_TAC[real_div; REAL_MUL_AC] THEN REAL_ARITH_TAC]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_SUMS_EQ THEN + EXISTS_TAC `\n:num. p * + (Im o (\k. (Cx(&1 - p) * cexp(ii * Cx t)) pow k)) n` THEN + CONJ_TAC THENL + [X_GEN_TAC `n:num` THEN REWRITE_TAC[IN_FROM] THEN DISCH_TAC THEN + REWRITE_TAC[o_THM] THEN BETA_TAC THEN + REWRITE_TAC[COMPLEX_POW_MUL; GSYM CX_POW; GSYM CEXP_N; + IM_MUL_CX; IM_CEXP; + RE_MUL_CX; IM_MUL_CX; RE_MUL_II; IM_MUL_II; + RE_CX; IM_CX; REAL_NEG_0; REAL_MUL_RZERO; REAL_EXP_0; + REAL_MUL_RID; REAL_MUL_LID] THEN + REWRITE_TAC[geometric_pmf; REAL_MUL_AC]; + ASM_MESON_TAC[]]);; + +(* ========================================================================= *) +(* LOTUS and Distribution Characteristic Function Bridge *) +(* *) +(* Connects the probability-space char fn (expectation) to the analytical *) +(* integral formulas for specific distributions. *) +(* ========================================================================= *) + +(* ------------------------------------------------------------------------- *) +(* Definition: X has absolutely continuous distribution with density f. *) +(* *) +(* The 5th condition (LOTUS for bounded continuous functions) follows from *) +(* conditions 1-4 by standard step-function approximation + BCT + DCT. *) +(* Including it directly makes the bridge theorems efficient. *) +(* ------------------------------------------------------------------------- *) + +let has_density = new_definition + `has_density (p:A prob_space) (X:A->real) (f:real->real) <=> + random_variable p X /\ + (!u. &0 <= f u) /\ + (f has_real_integral &1) (:real) /\ + (!a b. a <= b ==> + prob p {x | x IN prob_carrier p /\ a < X x /\ X x <= b} = + real_integral (real_interval[a,b]) f) /\ + (!g M. (!u. abs(g u) <= M) /\ g real_continuous_on (:real) /\ + random_variable p (\x. g(X x)) + ==> integrable p (\x. g(X x)) /\ + expectation p (\x. g(X x)) = + real_integral (:real) (\u. g u * f u))`;; + +(* Basic consequences *) + +let HAS_DENSITY_RV = prove + (`!p:A prob_space X f. has_density p X f ==> random_variable p X`, + REWRITE_TAC[has_density] THEN MESON_TAC[]);; + +let HAS_DENSITY_NONNEG = prove + (`!p:A prob_space X f. has_density p X f ==> !u. &0 <= f u`, + REWRITE_TAC[has_density] THEN MESON_TAC[]);; + +let HAS_DENSITY_INTEGRAL_ONE = prove + (`!p:A prob_space X f. has_density p X f + ==> (f has_real_integral &1) (:real)`, + REWRITE_TAC[has_density] THEN MESON_TAC[]);; + +let HAS_DENSITY_INTERVAL_PROB = prove + (`!p:A prob_space X f a b. + has_density p X f /\ a <= b + ==> prob p {x | x IN prob_carrier p /\ a < X x /\ X x <= b} = + real_integral (real_interval[a,b]) f`, + REWRITE_TAC[has_density] THEN MESON_TAC[]);; + +let HAS_DENSITY_INTEGRABLE = prove + (`!p:A prob_space X f. has_density p X f + ==> f real_integrable_on (:real)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[real_integrable_on] THEN + EXISTS_TAC `&1` THEN ASM_MESON_TAC[HAS_DENSITY_INTEGRAL_ONE]);; + +(* LOTUS: Law of the Unconscious Statistician for bounded continuous g *) + +let LOTUS_BOUNDED_CONTINUOUS = prove + (`!p:A prob_space X f g M. + has_density p X f /\ + (!u. abs(g u) <= M) /\ + g real_continuous_on (:real) /\ + random_variable p (\x. g(X x)) + ==> integrable p (\x. g(X x)) /\ + expectation p (\x. g(X x)) = + real_integral (:real) (\u. g u * f u)`, + REWRITE_TAC[has_density] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`g:real->real`; `M:real`]) THEN + ASM_REWRITE_TAC[] THEN MESON_TAC[]);; + +(* LOTUS for nonneg continuous g (not necessarily bounded) *) + +let LOTUS_NONNEG_CONTINUOUS = prove + (`!p:A prob_space X f g. + has_density p X f /\ + g real_continuous_on (:real) /\ + (!u. &0 <= g u) /\ + integrable p (\x. g(X x)) + ==> (\u. g u * f u) real_integrable_on (:real) /\ + expectation p (\x. g(X x)) = + real_integral (:real) (\u. g u * f u)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `random_variable p (X:A->real)` ASSUME_TAC THENL + [ASM_MESON_TAC[HAS_DENSITY_RV]; ALL_TAC] THEN + SUBGOAL_THEN `!u. &0 <= (f:real->real) u` ASSUME_TAC THENL + [ASM_MESON_TAC[HAS_DENSITY_NONNEG]; ALL_TAC] THEN + SUBGOAL_THEN `(f:real->real) real_integrable_on (:real)` ASSUME_TAC THENL + [ASM_MESON_TAC[HAS_DENSITY_INTEGRABLE]; ALL_TAC] THEN + (* Establish LOTUS for bounded truncations *) + SUBGOAL_THEN + `!n. expectation p (\x:A. min ((g:real->real)((X:A->real) x)) (&n)) = + real_integral (:real) (\u. min (g u) (&n) * f u)` ASSUME_TAC THENL + [GEN_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `X:A->real`; `f:real->real`; + `\u:real. min ((g:real->real) u) (&n)`; `&n`] + LOTUS_BOUNDED_CONTINUOUS) THEN + BETA_TAC THEN ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= n ==> abs x <= n`) THEN + CONJ_TAC THENL + [REWRITE_TAC[REAL_LE_MIN] THEN ASM_REWRITE_TAC[REAL_POS]; + REWRITE_TAC[REAL_MIN_LE] THEN DISJ2_TAC THEN REAL_ARITH_TAC]; + MATCH_MP_TAC REAL_CONTINUOUS_ON_MIN THEN + ASM_REWRITE_TAC[REAL_CONTINUOUS_ON_CONST]; + MATCH_MP_TAC RANDOM_VARIABLE_MIN THEN + ASM_REWRITE_TAC[RANDOM_VARIABLE_CONST] THEN + MATCH_MP_TAC RANDOM_VARIABLE_COMP_CONTINUOUS THEN ASM_REWRITE_TAC[]]; + STRIP_TAC THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + (* Apply REAL_MONOTONE_CONVERGENCE_INCREASING to get integrability + convergence *) + MP_TAC(ISPECL + [`\n:num. (\u:real. min ((g:real->real) u) (&n) * (f:real->real) u)`; + `\u:real. (g:real->real) u * (f:real->real) u`; + `(:real)`] REAL_MONOTONE_CONVERGENCE_INCREASING) THEN + BETA_TAC THEN ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [(* Each min(g, &n) * f is real_integrable_on (:real) *) + GEN_TAC THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_IMP_INTEGRABLE THEN + MATCH_MP_TAC ABSOLUTELY_REAL_INTEGRABLE_BOUNDED_MEASURABLE_PRODUCT THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC CONTINUOUS_IMP_REAL_MEASURABLE_ON_CLOSED_SUBSET THEN + REWRITE_TAC[REAL_CLOSED_UNIV] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_MIN THEN + ASM_REWRITE_TAC[REAL_CONTINUOUS_ON_CONST]; + REWRITE_TAC[real_bounded; IN_IMAGE; IN_UNIV] THEN + EXISTS_TAC `&k` THEN GEN_TAC THEN + DISCH_THEN(CHOOSE_THEN SUBST1_TAC) THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= n ==> abs x <= n`) THEN + CONJ_TAC THENL + [REWRITE_TAC[REAL_LE_MIN] THEN ASM_REWRITE_TAC[REAL_POS]; + REWRITE_TAC[REAL_MIN_LE] THEN DISJ2_TAC THEN REAL_ARITH_TAC]; + MATCH_MP_TAC NONNEGATIVE_ABSOLUTELY_REAL_INTEGRABLE THEN + ASM_SIMP_TAC[IN_UNIV; REAL_LE_MUL; REAL_POS]]; + (* Monotonicity: min(g u, &k) * f u <= min(g u, &(SUC k)) * f u *) + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_RMUL THEN + ASM_SIMP_TAC[IN_UNIV] THEN + MATCH_MP_TAC(REAL_ARITH `a <= b ==> min x a <= min x b`) THEN + REWRITE_TAC[REAL_OF_NUM_LE] THEN ARITH_TAC; + (* Pointwise convergence: min(g u, &k) * f u -> g u * f u *) + X_GEN_TAC `u:real` THEN REWRITE_TAC[IN_UNIV] THEN + MATCH_MP_TAC REALLIM_EVENTUALLY THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN + MP_TAC(SPEC `(g:real->real) u` REAL_ARCH_SIMPLE) THEN + DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `N:num` THEN + X_GEN_TAC `m:num` THEN DISCH_TAC THEN + AP_THM_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[real_min] THEN COND_CASES_TAC THENL + [REFL_TAC; + ASM_MESON_TAC[REAL_LE_ANTISYM; REAL_NOT_LT; REAL_LE_TRANS; + REAL_OF_NUM_LE]]; + (* Bounded: integrals are bounded *) + REWRITE_TAC[real_bounded; FORALL_IN_GSPEC; IN_UNIV] THEN + EXISTS_TAC `expectation p (\x:A. (g:real->real)((X:A->real) x))` THEN + GEN_TAC THEN + ONCE_REWRITE_TAC[GSYM(ASSUME + `!n. expectation p (\x:A. min ((g:real->real)((X:A->real) x)) (&n)) = + real_integral (:real) (\u. min (g u) (&n) * f u)`)] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= y ==> abs x <= y`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC EXPECTATION_POS THEN BETA_TAC THEN CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_BOUNDED THEN EXISTS_TAC `&k` THEN + BETA_TAC THEN CONJ_TAC THENL + [MATCH_MP_TAC RANDOM_VARIABLE_MIN THEN + ASM_REWRITE_TAC[RANDOM_VARIABLE_CONST] THEN + MATCH_MP_TAC RANDOM_VARIABLE_COMP_CONTINUOUS THEN ASM_REWRITE_TAC[]; + GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= n ==> abs x <= n`) THEN + CONJ_TAC THENL + [REWRITE_TAC[REAL_LE_MIN] THEN ASM_REWRITE_TAC[REAL_POS]; + REWRITE_TAC[REAL_MIN_LE] THEN DISJ2_TAC THEN REAL_ARITH_TAC]]; + GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[REAL_LE_MIN] THEN ASM_REWRITE_TAC[REAL_POS]]; + MATCH_MP_TAC EXPECTATION_MONO THEN BETA_TAC THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_BOUNDED THEN EXISTS_TAC `&k` THEN + BETA_TAC THEN CONJ_TAC THENL + [MATCH_MP_TAC RANDOM_VARIABLE_MIN THEN + ASM_REWRITE_TAC[RANDOM_VARIABLE_CONST] THEN + MATCH_MP_TAC RANDOM_VARIABLE_COMP_CONTINUOUS THEN ASM_REWRITE_TAC[]; + GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= n ==> abs x <= n`) THEN + CONJ_TAC THENL + [REWRITE_TAC[REAL_LE_MIN] THEN ASM_REWRITE_TAC[REAL_POS]; + REWRITE_TAC[REAL_MIN_LE] THEN DISJ2_TAC THEN REAL_ARITH_TAC]]; + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[REAL_MIN_LE] THEN + DISJ1_TAC THEN REAL_ARITH_TAC]]]; + ALL_TAC] THEN + (* Rewrite integral sequence to expectation sequence *) + ONCE_REWRITE_TAC[GSYM(ASSUME + `!n. expectation p (\x:A. min ((g:real->real)((X:A->real) x)) (&n)) = + real_integral (:real) (\u. min (g u) (&n) * f u)`)] THEN + STRIP_TAC THEN + (* Now have: g*f integrable + convergence of E[min(g(X),&n)] -> integral(g*f) *) + CONJ_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + (* Prove E[g(X)] = integral(g*f) via limit uniqueness *) + MATCH_MP_TAC(ISPEC `sequentially` REALLIM_UNIQUE) THEN + EXISTS_TAC `\n. expectation p (\x:A. min ((g:real->real)((X:A->real) x)) (&n))` THEN + REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN CONJ_TAC THENL + [(* E[min(g(X), &n)] -> E[g(X)] by dominated convergence *) + MP_TAC(ISPECL [`p:A prob_space`; + `\n:num. (\x:A. min ((g:real->real)((X:A->real) x)) (&n))`; + `\x:A. (g:real->real)((X:A->real) x)`; + `\x:A. (g:real->real)((X:A->real) x)`] + DOMINATED_CONVERGENCE) THEN + BETA_TAC THEN ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [(* Each min(g(X), &n) is integrable *) + GEN_TAC THEN MATCH_MP_TAC INTEGRABLE_BOUNDED THEN + EXISTS_TAC `&n` THEN BETA_TAC THEN CONJ_TAC THENL + [MATCH_MP_TAC RANDOM_VARIABLE_MIN THEN + ASM_REWRITE_TAC[RANDOM_VARIABLE_CONST] THEN + MATCH_MP_TAC RANDOM_VARIABLE_COMP_CONTINUOUS THEN + ASM_REWRITE_TAC[]; + GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= n ==> abs x <= n`) THEN + CONJ_TAC THENL + [REWRITE_TAC[REAL_LE_MIN] THEN ASM_REWRITE_TAC[REAL_POS]; + REWRITE_TAC[REAL_MIN_LE] THEN DISJ2_TAC THEN REAL_ARITH_TAC]]; + (* g(X) is integrable (dominator) *) + ASM_REWRITE_TAC[]; + (* |min(g(X x), &n)| <= g(X x) *) + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= y ==> abs x <= y`) THEN + CONJ_TAC THENL + [REWRITE_TAC[REAL_LE_MIN] THEN ASM_REWRITE_TAC[REAL_POS]; + REWRITE_TAC[REAL_MIN_LE] THEN DISJ1_TAC THEN REAL_ARITH_TAC]; + (* min(g(X x), &n) -> g(X x) pointwise *) + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(SPEC `(g:real->real)((X:A->real) x)` REAL_ARCH_SIMPLE) THEN + DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `N:num` THEN + X_GEN_TAC `m:num` THEN DISCH_TAC THEN + SUBGOAL_THEN `(g:real->real)((X:A->real) x) <= &m` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&N` THEN + ASM_REWRITE_TAC[REAL_OF_NUM_LE]; + SUBGOAL_THEN `min ((g:real->real)((X:A->real) x)) (&m) = g(X x)` + SUBST1_TAC THENL + [REWRITE_TAC[real_min] THEN ASM_REWRITE_TAC[GSYM REAL_NOT_LT] THEN + ASM_REAL_ARITH_TAC; + ASM_REAL_ARITH_TAC]]]; + STRIP_TAC THEN ASM_REWRITE_TAC[]]; + (* E[min(g(X), &n)] -> integral(g*f) from RMCI *) + ASM_REWRITE_TAC[]]);; + +(* General LOTUS for continuous g (not necessarily nonneg) *) + +let LOTUS_CONTINUOUS = prove + (`!p:A prob_space X f g. + has_density p X f /\ + g real_continuous_on (:real) /\ + integrable p (\x. g(X x)) + ==> (\u. g u * f u) real_integrable_on (:real) /\ + expectation p (\x. g(X x)) = + real_integral (:real) (\u. g u * f u)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `integrable p (\x:A. max ((g:real->real)((X:A->real) x)) (&0))` + ASSUME_TAC THENL + [MATCH_MP_TAC INTEGRABLE_MAX THEN ASM_REWRITE_TAC[INTEGRABLE_CONST]; + ALL_TAC] THEN + SUBGOAL_THEN `integrable p (\x:A. max (--((g:real->real)((X:A->real) x))) (&0))` + ASSUME_TAC THENL + [MATCH_MP_TAC INTEGRABLE_MAX THEN ASM_REWRITE_TAC[INTEGRABLE_CONST] THEN + MATCH_MP_TAC INTEGRABLE_NEG THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL [`p:A prob_space`; `X:A->real`; `f:real->real`; + `\u:real. max ((g:real->real) u) (&0)`] + LOTUS_NONNEG_CONTINUOUS) THEN + BETA_TAC THEN ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_ON_MAX THEN + ASM_REWRITE_TAC[REAL_CONTINUOUS_ON_CONST]; + GEN_TAC THEN REWRITE_TAC[REAL_LE_MAX] THEN DISJ2_TAC THEN + REAL_ARITH_TAC]; + ALL_TAC] THEN + STRIP_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `X:A->real`; `f:real->real`; + `\u:real. max (--((g:real->real) u)) (&0)`] + LOTUS_NONNEG_CONTINUOUS) THEN + BETA_TAC THEN ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_ON_MAX THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_CONST] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_NEG THEN ASM_REWRITE_TAC[]; + GEN_TAC THEN REWRITE_TAC[REAL_LE_MAX] THEN DISJ2_TAC THEN + REAL_ARITH_TAC]; + ALL_TAC] THEN + STRIP_TAC THEN + CONJ_TAC THENL + [SUBGOAL_THEN `(\u:real. (g:real->real) u * (f:real->real) u) = + (\u. max (g u) (&0) * f u - max (--(g u)) (&0) * f u)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + REWRITE_TAC[GSYM REAL_SUB_RDISTRIB] THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REAL_ARITH_TAC; + MATCH_MP_TAC REAL_INTEGRABLE_SUB THEN ASM_REWRITE_TAC[]]; + SUBGOAL_THEN + `expectation p (\x:A. (g:real->real)((X:A->real) x)) = + expectation p (\x. max (g(X x)) (&0)) - + expectation p (\x. max (--(g(X x))) (&0))` SUBST1_TAC THENL + [MP_TAC(ISPECL [`p:A prob_space`; + `\x:A. max ((g:real->real)((X:A->real) x)) (&0)`; + `\x:A. max (--((g:real->real)((X:A->real) x))) (&0)`] + EXPECTATION_SUB) THEN + BETA_TAC THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(SUBST1_TAC o GSYM) THEN + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + REAL_ARITH_TAC; + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `real_integral (:real) (\u:real. max ((g:real->real) u) (&0) * (f:real->real) u) - + real_integral (:real) (\u. max (--g u) (&0) * f u) = + real_integral (:real) (\u. max (g u) (&0) * f u - max (--g u) (&0) * f u)` + SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC REAL_INTEGRAL_SUB THEN + ASM_REWRITE_TAC[]; + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + REWRITE_TAC[GSYM REAL_SUB_RDISTRIB] THEN AP_THM_TAC THEN AP_TERM_TAC THEN + REAL_ARITH_TAC]]]);; + +(* Specialized LOTUS for cos and sin (the cases needed for char fn) *) + +let LOTUS_COS = prove + (`!p:A prob_space X f t. + has_density p X f + ==> integrable p (\x. cos(t * X x)) /\ + expectation p (\x. cos(t * X x)) = + real_integral (:real) (\u. cos(t * u) * f u)`, + REPEAT STRIP_TAC THENL + [FIRST_ASSUM(STRIP_ASSUME_TAC o REWRITE_RULE[has_density]) THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`\u:real. cos(t * u)`; `&1`]) THEN + REWRITE_TAC[COS_BOUND] THEN ANTS_TAC THENL + [CONJ_TAC THENL + [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_COMPOSE THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_ON_LMUL THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_ID]; + REWRITE_TAC[REAL_CONTINUOUS_ON_COS]]; + MATCH_MP_TAC RANDOM_VARIABLE_COS THEN + MATCH_MP_TAC RANDOM_VARIABLE_CMUL THEN ASM_REWRITE_TAC[]]; + SIMP_TAC[]]; + FIRST_ASSUM(STRIP_ASSUME_TAC o REWRITE_RULE[has_density]) THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`\u:real. cos(t * u)`; `&1`]) THEN + REWRITE_TAC[COS_BOUND] THEN ANTS_TAC THENL + [CONJ_TAC THENL + [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_COMPOSE THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_ON_LMUL THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_ID]; + REWRITE_TAC[REAL_CONTINUOUS_ON_COS]]; + MATCH_MP_TAC RANDOM_VARIABLE_COS THEN + MATCH_MP_TAC RANDOM_VARIABLE_CMUL THEN ASM_REWRITE_TAC[]]; + SIMP_TAC[]]]);; + +let LOTUS_SIN = prove + (`!p:A prob_space X f t. + has_density p X f + ==> integrable p (\x. sin(t * X x)) /\ + expectation p (\x. sin(t * X x)) = + real_integral (:real) (\u. sin(t * u) * f u)`, + REPEAT STRIP_TAC THENL + [FIRST_ASSUM(STRIP_ASSUME_TAC o REWRITE_RULE[has_density]) THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`\u:real. sin(t * u)`; `&1`]) THEN + REWRITE_TAC[SIN_BOUND] THEN ANTS_TAC THENL + [CONJ_TAC THENL + [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_COMPOSE THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_ON_LMUL THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_ID]; + REWRITE_TAC[REAL_CONTINUOUS_ON_SIN]]; + MATCH_MP_TAC RANDOM_VARIABLE_SIN THEN + MATCH_MP_TAC RANDOM_VARIABLE_CMUL THEN ASM_REWRITE_TAC[]]; + SIMP_TAC[]]; + FIRST_ASSUM(STRIP_ASSUME_TAC o REWRITE_RULE[has_density]) THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`\u:real. sin(t * u)`; `&1`]) THEN + REWRITE_TAC[SIN_BOUND] THEN ANTS_TAC THENL + [CONJ_TAC THENL + [GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_COMPOSE THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_ON_LMUL THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_ID]; + REWRITE_TAC[REAL_CONTINUOUS_ON_SIN]]; + MATCH_MP_TAC RANDOM_VARIABLE_SIN THEN + MATCH_MP_TAC RANDOM_VARIABLE_CMUL THEN ASM_REWRITE_TAC[]]; + SIMP_TAC[]]]);; + +(* ------------------------------------------------------------------------- *) +(* Distribution predicates *) +(* ------------------------------------------------------------------------- *) + +let normal_distributed = new_definition + `normal_distributed (p:A prob_space) (X:A->real) mu sigma <=> + has_density p X (normal_density mu sigma) /\ &0 < sigma`;; + +let uniform_distributed = new_definition + `uniform_distributed (p:A prob_space) (X:A->real) a b <=> + has_density p X (uniform_density a b) /\ a < b`;; + +let exponential_distributed = new_definition + `exponential_distributed (p:A prob_space) (X:A->real) l <=> + has_density p X (exponential_density l) /\ &0 < l`;; + +(* ------------------------------------------------------------------------- *) +(* Bridge theorems: char fn of normally distributed RV *) +(* ------------------------------------------------------------------------- *) + +let CHAR_FN_RE_NORMAL_DIST = prove + (`!p:A prob_space X mu sigma t. + normal_distributed p X mu sigma + ==> char_fn_re p X t = + exp(--(sigma pow 2 * t pow 2 / &2)) * cos(mu * t)`, + REPEAT GEN_TAC THEN REWRITE_TAC[normal_distributed] THEN STRIP_TAC THEN + REWRITE_TAC[char_fn_re] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP LOTUS_COS th]) THEN + MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + SUBGOAL_THEN `(\u:real. cos(t * u) * normal_density mu sigma u) = + (\u. normal_density mu sigma u * cos(t * u))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN REAL_ARITH_TAC; + ASM_SIMP_TAC[NORMAL_CHAR_FN_RE]]);; + +let CHAR_FN_IM_NORMAL_DIST = prove + (`!p:A prob_space X mu sigma t. + normal_distributed p X mu sigma + ==> char_fn_im p X t = + exp(--(sigma pow 2 * t pow 2 / &2)) * sin(mu * t)`, + REPEAT GEN_TAC THEN REWRITE_TAC[normal_distributed] THEN STRIP_TAC THEN + REWRITE_TAC[char_fn_im] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP LOTUS_SIN th]) THEN + MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + SUBGOAL_THEN `(\u:real. sin(t * u) * normal_density mu sigma u) = + (\u. normal_density mu sigma u * sin(t * u))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN REAL_ARITH_TAC; + ASM_SIMP_TAC[NORMAL_CHAR_FN_IM]]);; + +(* ------------------------------------------------------------------------- *) +(* Bridge theorems: char fn of uniformly distributed RV *) +(* ------------------------------------------------------------------------- *) + +let CHAR_FN_RE_UNIFORM_DIST = prove + (`!p:A prob_space X a b t. + uniform_distributed p X a b /\ ~(t = &0) + ==> char_fn_re p X t = (sin(t * b) - sin(t * a)) / (t * (b - a))`, + REPEAT GEN_TAC THEN REWRITE_TAC[uniform_distributed] THEN STRIP_TAC THEN + REWRITE_TAC[char_fn_re] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP LOTUS_COS th]) THEN + MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + SUBGOAL_THEN `(\u:real. cos(t * u) * uniform_density a b u) = + (\u. uniform_density a b u * cos(t * u))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN REAL_ARITH_TAC; + ASM_SIMP_TAC[UNIFORM_CHAR_FN_RE]]);; + +let CHAR_FN_IM_UNIFORM_DIST = prove + (`!p:A prob_space X a b t. + uniform_distributed p X a b /\ ~(t = &0) + ==> char_fn_im p X t = (cos(t * a) - cos(t * b)) / (t * (b - a))`, + REPEAT GEN_TAC THEN REWRITE_TAC[uniform_distributed] THEN STRIP_TAC THEN + REWRITE_TAC[char_fn_im] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP LOTUS_SIN th]) THEN + MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + SUBGOAL_THEN `(\u:real. sin(t * u) * uniform_density a b u) = + (\u. uniform_density a b u * sin(t * u))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN REAL_ARITH_TAC; + ASM_SIMP_TAC[UNIFORM_CHAR_FN_IM]]);; + +(* ------------------------------------------------------------------------- *) +(* Bridge theorems: char fn of exponentially distributed RV *) +(* ------------------------------------------------------------------------- *) + +let CHAR_FN_RE_EXPONENTIAL_DIST = prove + (`!p:A prob_space X l t. + exponential_distributed p X l + ==> char_fn_re p X t = l pow 2 / (l pow 2 + t pow 2)`, + REPEAT GEN_TAC THEN REWRITE_TAC[exponential_distributed] THEN STRIP_TAC THEN + REWRITE_TAC[char_fn_re] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP LOTUS_COS th]) THEN + MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + SUBGOAL_THEN `(\u:real. cos(t * u) * exponential_density l u) = + (\x. if x IN {x | &0 <= x} + then exponential_density l x * cos(t * x) else &0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; IN_ELIM_THM] THEN GEN_TAC THEN + COND_CASES_TAC THENL [REAL_ARITH_TAC; + REWRITE_TAC[exponential_density] THEN ASM_REWRITE_TAC[] THEN + REAL_ARITH_TAC]; + REWRITE_TAC[HAS_REAL_INTEGRAL_RESTRICT_UNIV] THEN + ASM_SIMP_TAC[EXPONENTIAL_CHAR_FN_RE]]);; + +let CHAR_FN_IM_EXPONENTIAL_DIST = prove + (`!p:A prob_space X l t. + exponential_distributed p X l + ==> char_fn_im p X t = l * t / (l pow 2 + t pow 2)`, + REPEAT GEN_TAC THEN REWRITE_TAC[exponential_distributed] THEN STRIP_TAC THEN + REWRITE_TAC[char_fn_im] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[MATCH_MP LOTUS_SIN th]) THEN + MATCH_MP_TAC REAL_INTEGRAL_UNIQUE THEN + SUBGOAL_THEN `(\u:real. sin(t * u) * exponential_density l u) = + (\x. if x IN {x | &0 <= x} + then exponential_density l x * sin(t * x) else &0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; IN_ELIM_THM] THEN GEN_TAC THEN + COND_CASES_TAC THENL [REAL_ARITH_TAC; + REWRITE_TAC[exponential_density] THEN ASM_REWRITE_TAC[] THEN + REAL_ARITH_TAC]; + REWRITE_TAC[HAS_REAL_INTEGRAL_RESTRICT_UNIV] THEN + ASM_SIMP_TAC[EXPONENTIAL_CHAR_FN_IM]]);; + +(* ========================================================================= *) +(* Expectation and Variance bridge theorems for continuous distributions *) +(* ========================================================================= *) + +let EXPECTATION_NORMAL_DIST = prove + (`!p:A prob_space X mu sigma. + normal_distributed p X mu sigma /\ integrable p X + ==> expectation p X = mu`, + REPEAT GEN_TAC THEN REWRITE_TAC[normal_distributed] THEN STRIP_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `X:A->real`; + `normal_density mu sigma`; `\u:real. u`] + LOTUS_CONTINUOUS) THEN + BETA_TAC THEN ANTS_TAC THENL + [ASM_REWRITE_TAC[REAL_CONTINUOUS_ON_ID; ETA_AX]; + REWRITE_TAC[ETA_AX] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`mu:real`; `sigma:real`] NORMAL_MEAN_INTEGRAL) THEN + ASM_REWRITE_TAC[]]);; + +let VARIANCE_NORMAL_DIST = prove + (`!p:A prob_space X mu sigma. + normal_distributed p X mu sigma /\ + integrable p X /\ integrable p (\x. (X x - mu) pow 2) + ==> variance p X = sigma pow 2`, + REPEAT GEN_TAC THEN REWRITE_TAC[normal_distributed] THEN STRIP_TAC THEN + REWRITE_TAC[variance] THEN + SUBGOAL_THEN `expectation p (X:A->real) = mu` SUBST1_TAC THENL + [MP_TAC(ISPECL [`p:A prob_space`; `X:A->real`; `mu:real`; `sigma:real`] + EXPECTATION_NORMAL_DIST) THEN + ASM_REWRITE_TAC[normal_distributed]; + MP_TAC(ISPECL [`p:A prob_space`; `X:A->real`; + `normal_density mu sigma`; `\u:real. (u - mu) pow 2`] + LOTUS_CONTINUOUS) THEN + BETA_TAC THEN ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_POW THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_SUB THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_ID; REAL_CONTINUOUS_ON_CONST]; + REWRITE_TAC[ETA_AX] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`mu:real`; `sigma:real`] NORMAL_VARIANCE_INTEGRAL) THEN + ASM_REWRITE_TAC[]]]);; + +let EXPECTATION_UNIFORM_DIST = prove + (`!p:A prob_space X a b. + uniform_distributed p X a b /\ integrable p X + ==> expectation p X = (a + b) / &2`, + REPEAT GEN_TAC THEN REWRITE_TAC[uniform_distributed] THEN STRIP_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `X:A->real`; + `uniform_density a b`; `\u:real. u`] + LOTUS_CONTINUOUS) THEN + BETA_TAC THEN ANTS_TAC THENL + [ASM_REWRITE_TAC[REAL_CONTINUOUS_ON_ID; ETA_AX]; + REWRITE_TAC[ETA_AX] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`a:real`; `b:real`] UNIFORM_MEAN_INTEGRAL) THEN + ASM_REWRITE_TAC[]]);; + +let VARIANCE_UNIFORM_DIST = prove + (`!p:A prob_space X a b. + uniform_distributed p X a b /\ + integrable p X /\ integrable p (\x. (X x - (a + b) / &2) pow 2) + ==> variance p X = (b - a) pow 2 / &12`, + REPEAT GEN_TAC THEN REWRITE_TAC[uniform_distributed] THEN STRIP_TAC THEN + REWRITE_TAC[variance] THEN + SUBGOAL_THEN `expectation p (X:A->real) = (a + b) / &2` SUBST1_TAC THENL + [MP_TAC(ISPECL [`p:A prob_space`; `X:A->real`; `a:real`; `b:real`] + EXPECTATION_UNIFORM_DIST) THEN + ASM_REWRITE_TAC[uniform_distributed]; + MP_TAC(ISPECL [`p:A prob_space`; `X:A->real`; + `uniform_density a b`; `\u:real. (u - (a + b) / &2) pow 2`] + LOTUS_CONTINUOUS) THEN + BETA_TAC THEN ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_POW THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_SUB THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_ID; REAL_CONTINUOUS_ON_CONST]; + REWRITE_TAC[ETA_AX] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`a:real`; `b:real`] UNIFORM_VARIANCE_INTEGRAL) THEN + ASM_REWRITE_TAC[]]]);; + +let EXPECTATION_EXPONENTIAL_DIST = prove + (`!p:A prob_space X l. + exponential_distributed p X l /\ integrable p X + ==> expectation p X = inv l`, + REPEAT GEN_TAC THEN REWRITE_TAC[exponential_distributed] THEN STRIP_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `X:A->real`; + `exponential_density l`; `\u:real. u`] + LOTUS_CONTINUOUS) THEN + BETA_TAC THEN ANTS_TAC THENL + [ASM_REWRITE_TAC[REAL_CONTINUOUS_ON_ID; ETA_AX]; + REWRITE_TAC[ETA_AX] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `(\u:real. u * exponential_density l u) = + (\u. if u IN {x | &0 <= x} then u * exponential_density l u else &0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; IN_ELIM_THM] THEN GEN_TAC THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[exponential_density] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_MUL_RZERO] THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[REAL_INTEGRAL_RESTRICT_UNIV] THEN + MP_TAC(SPEC `l:real` EXPONENTIAL_MEAN_INTEGRAL) THEN + ASM_REWRITE_TAC[]]]);; + +let VARIANCE_EXPONENTIAL_DIST = prove + (`!p:A prob_space X l. + exponential_distributed p X l /\ + integrable p X /\ integrable p (\x. (X x - inv l) pow 2) + ==> variance p X = inv l pow 2`, + REPEAT GEN_TAC THEN REWRITE_TAC[exponential_distributed] THEN STRIP_TAC THEN + REWRITE_TAC[variance] THEN + SUBGOAL_THEN `expectation p (X:A->real) = inv l` SUBST1_TAC THENL + [MP_TAC(ISPECL [`p:A prob_space`; `X:A->real`; `l:real`] + EXPECTATION_EXPONENTIAL_DIST) THEN + ASM_REWRITE_TAC[exponential_distributed]; + MP_TAC(ISPECL [`p:A prob_space`; `X:A->real`; + `exponential_density l`; `\u:real. (u - inv l) pow 2`] + LOTUS_CONTINUOUS) THEN + BETA_TAC THEN ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_POW THEN + MATCH_MP_TAC REAL_CONTINUOUS_ON_SUB THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_ID; REAL_CONTINUOUS_ON_CONST]; + REWRITE_TAC[ETA_AX] THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `(\u:real. (u - inv l) pow 2 * exponential_density l u) = + (\u. if u IN {x | &0 <= x} then (u - inv l) pow 2 * exponential_density l u else &0)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; IN_ELIM_THM] THEN GEN_TAC THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[exponential_density] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[REAL_MUL_RZERO] THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[REAL_INTEGRAL_RESTRICT_UNIV] THEN + MP_TAC(SPEC `l:real` EXPONENTIAL_VARIANCE_INTEGRAL) THEN + ASM_REWRITE_TAC[]]]]);; + +(* ========================================================================= *) +(* Poisson mean and variance analytical series *) +(* ========================================================================= *) + +(* Key recursion: (k+1) * poisson_pmf lam (k+1) = lam * poisson_pmf lam k *) +let POISSON_PMF_RECURSION = prove + (`!lam k. &(SUC k) * poisson_pmf lam (SUC k) = lam * poisson_pmf lam k`, + REPEAT GEN_TAC THEN REWRITE_TAC[poisson_pmf] THEN + SUBGOAL_THEN `~(&(FACT k) = &0)` ASSUME_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_EQ; FACT_NZ]; ALL_TAC] THEN + SUBGOAL_THEN `~(&(SUC k) = &0)` ASSUME_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_EQ; NOT_SUC]; ALL_TAC] THEN + REWRITE_TAC[FACT; GSYM REAL_OF_NUM_MUL; real_pow] THEN + ASM_SIMP_TAC[REAL_FIELD + `~(fk = &0) /\ ~(sk = &0) + ==> sk * (e * (l * lp) / (sk * fk)) = l * (e * lp / fk)`]);; + + +(* E[X] = lam for Poisson(lam) *) +let POISSON_MEAN_SERIES = prove + (`!lam. &0 <= lam ==> + ((\k. &k * poisson_pmf lam k) real_sums lam) (from 0)`, + GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(REWRITE_RULE + [REAL_MUL_LZERO; REAL_ADD_RID; SUM_SING_NUMSEG; + ARITH_RULE `1 - 1 = 0`] + (SPECL [`\k:num. &k * poisson_pmf lam k`; `lam:real`; `1`; `0`] + REAL_SUMS_OFFSET_REV)) THEN + CONJ_TAC THENL [ALL_TAC; ARITH_TAC] THEN + MATCH_MP_TAC REAL_SUMS_EQ THEN + EXISTS_TAC `\k:num. lam * poisson_pmf lam (k - 1)` THEN CONJ_TAC THENL + [X_GEN_TAC `k:num` THEN REWRITE_TAC[IN_FROM] THEN DISCH_TAC THEN + BETA_TAC THEN + SUBGOAL_THEN `k = SUC(k - 1)` SUBST1_TAC THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[ARITH_RULE `SUC k - 1 = k`; GSYM POISSON_PMF_RECURSION] THEN + REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `((\k. poisson_pmf lam (k - 1)) real_sums &1) (from 1)` + MP_TAC THENL + [REWRITE_TAC[real_sums; FROM_INTER_NUMSEG; REALLIM_SEQUENTIALLY] THEN + MP_TAC(SPEC `lam:real` POISSON_PMF_SUMS) THEN + REWRITE_TAC[real_sums; FROM_INTER_NUMSEG; REALLIM_SEQUENTIALLY] THEN + DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `M:num`) THEN EXISTS_TAC `M + 1` THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN + SUBGOAL_THEN `1 <= n` ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `sum(1..n) (\k. poisson_pmf lam (k - 1)) = + sum(0..n-1) (poisson_pmf lam)` SUBST1_TAC THENL + [ASM_SIMP_TAC[SUM_OFFSET_0] THEN + MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `i:num` THEN + REWRITE_TAC[IN_NUMSEG; LE_0] THEN DISCH_TAC THEN BETA_TAC THEN + AP_TERM_TAC THEN ARITH_TAC; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n - 1`) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; REWRITE_TAC[]]; ALL_TAC] THEN + DISCH_TAC THEN + MP_TAC(SPECL [`\k:num. poisson_pmf lam (k - 1)`; `&1`; + `lam:real`; `from 1`] REAL_SERIES_LMUL) THEN + ASM_REWRITE_TAC[REAL_MUL_RID]);; + +(* Second factorial moment: E[X(X-1)] = lam^2 *) +let POISSON_SECOND_FACTORIAL_MOMENT = prove + (`!lam. &0 <= lam ==> + ((\k. &k * (&k - &1) * poisson_pmf lam k) real_sums lam pow 2) (from 0)`, + GEN_TAC THEN DISCH_TAC THEN + (* Series from 0 = series from 2, since f(0) = f(1) = 0 *) + SUBGOAL_THEN + `!f:num->real l. (f real_sums l) (from 2) /\ f 0 = &0 /\ f 1 = &0 + ==> (f real_sums l) (from 0)` MATCH_MP_TAC THENL + [REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(SPECL [`f:num->real`; `l:real`; `2:num`; `0:num`] + REAL_SUMS_OFFSET_REV) THEN + ASM_REWRITE_TAC[ARITH_RULE `0 < 2`; ARITH_RULE `2 - 1 = 1`] THEN + REWRITE_TAC[num_CONV `1`; SUM_CLAUSES_NUMSEG; LE_0] THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `f (SUC 0) = &0` (fun th -> REWRITE_TAC[th]) THENL + [SUBGOAL_THEN `SUC 0 = 1` (fun th -> ASM_REWRITE_TAC[th]) THEN + ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_ADD_LID; REAL_ADD_RID]; ALL_TAC] THEN + REPEAT CONJ_TAC THENL + [(* Series from 2: reindex to from 0 *) + SUBGOAL_THEN `(from 2) = from (0 + 2)` (fun th -> REWRITE_TAC[th]) THENL + [REWRITE_TAC[ADD]; ALL_TAC] THEN + REWRITE_TAC[GSYM(SPEC `2` REAL_SUMS_REINDEX)] THEN + MATCH_MP_TAC REAL_SUMS_EQ THEN + EXISTS_TAC `\k:num. lam pow 2 * poisson_pmf lam k` THEN CONJ_TAC THENL + [X_GEN_TAC `k:num` THEN REWRITE_TAC[IN_FROM] THEN DISCH_TAC THEN + BETA_TAC THEN + SUBGOAL_THEN `k + 2 = SUC(SUC k)` (fun th -> REWRITE_TAC[th]) THENL + [ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `&(SUC(SUC k)) - &1 = &(SUC k)` + (fun th -> REWRITE_TAC[th]) THENL + [REWRITE_TAC[GSYM REAL_OF_NUM_SUC] THEN REAL_ARITH_TAC; ALL_TAC] THEN + CONV_TAC SYM_CONV THEN + SUBGOAL_THEN `&(SUC(SUC k)) * &(SUC k) * poisson_pmf lam (SUC(SUC k)) = + &(SUC k) * (&(SUC(SUC k)) * poisson_pmf lam (SUC(SUC k)))` SUBST1_TAC THENL + [REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN + MATCH_ACCEPT_TAC REAL_MUL_SYM; ALL_TAC] THEN + REWRITE_TAC[POISSON_PMF_RECURSION] THEN + SUBGOAL_THEN `&(SUC k) * (lam * poisson_pmf lam (SUC k)) = + lam * (&(SUC k) * poisson_pmf lam (SUC k))` SUBST1_TAC THENL + [REWRITE_TAC[REAL_MUL_ASSOC] THEN AP_THM_TAC THEN AP_TERM_TAC THEN + MATCH_ACCEPT_TAC REAL_MUL_SYM; ALL_TAC] THEN + REWRITE_TAC[POISSON_PMF_RECURSION] THEN + REWRITE_TAC[REAL_POW_2; GSYM REAL_MUL_ASSOC]; ALL_TAC] THEN + MP_TAC(REWRITE_RULE[REAL_MUL_RID] + (SPEC `(lam:real) pow 2` + (MATCH_MP REAL_SERIES_LMUL (SPEC `lam:real` POISSON_PMF_SUMS)))) THEN + REWRITE_TAC[ETA_AX]; + (* f(0) = 0 *) + BETA_TAC THEN CONV_TAC NUM_REDUCE_CONV THEN REAL_ARITH_TAC; + (* f(1) = 0 *) + BETA_TAC THEN CONV_TAC NUM_REDUCE_CONV THEN REAL_ARITH_TAC]);; + +(* Second moment: E[X^2] = lam^2 + lam *) +let POISSON_SECOND_MOMENT = prove + (`!lam. &0 <= lam ==> + ((\k. &k pow 2 * poisson_pmf lam k) real_sums (lam pow 2 + lam)) (from 0)`, + GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN + `((\k. &k * (&k - &1) * poisson_pmf lam k) real_sums lam pow 2) (from 0)` + ASSUME_TAC THENL [ASM_SIMP_TAC[POISSON_SECOND_FACTORIAL_MOMENT]; ALL_TAC] THEN + SUBGOAL_THEN + `((\k. &k * poisson_pmf lam k) real_sums lam) (from 0)` + ASSUME_TAC THENL [ASM_SIMP_TAC[POISSON_MEAN_SERIES]; ALL_TAC] THEN + SUBGOAL_THEN + `((\k. &k * (&k - &1) * poisson_pmf lam k + &k * poisson_pmf lam k) + real_sums (lam pow 2 + lam)) (from 0)` MP_TAC THENL + [MATCH_MP_TAC REAL_SERIES_ADD THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REAL_SUMS_EQ) THEN + X_GEN_TAC `k:num` THEN REWRITE_TAC[IN_FROM] THEN DISCH_TAC THEN + REWRITE_TAC[REAL_POW_2] THEN REAL_ARITH_TAC);; + +(* Variance: Var(X) = lam for Poisson(lam) *) +let POISSON_VARIANCE_SERIES = prove + (`!lam. &0 <= lam ==> + ((\k. (&k - lam) pow 2 * poisson_pmf lam k) real_sums lam) (from 0)`, + GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN + `((\k. &k pow 2 * poisson_pmf lam k) real_sums (lam pow 2 + lam)) (from 0)` + ASSUME_TAC THENL [ASM_SIMP_TAC[POISSON_SECOND_MOMENT]; ALL_TAC] THEN + SUBGOAL_THEN + `((\k. &k * poisson_pmf lam k) real_sums lam) (from 0)` + ASSUME_TAC THENL [ASM_SIMP_TAC[POISSON_MEAN_SERIES]; ALL_TAC] THEN + SUBGOAL_THEN `(poisson_pmf lam real_sums &1) (from 0)` ASSUME_TAC THENL + [REWRITE_TAC[POISSON_PMF_SUMS]; ALL_TAC] THEN + SUBGOAL_THEN + `((\k. (-- &2 * lam) * &k * poisson_pmf lam k) real_sums + (-- &2 * lam) * lam) (from 0)` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_SERIES_LMUL THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `((\k. lam pow 2 * poisson_pmf lam k) real_sums + lam pow 2 * &1) (from 0)` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_SERIES_LMUL THEN ASM_REWRITE_TAC[ETA_AX]; ALL_TAC] THEN + SUBGOAL_THEN + `((\k. &k pow 2 * poisson_pmf lam k + + (-- &2 * lam) * &k * poisson_pmf lam k) real_sums + (lam pow 2 + lam) + (-- &2 * lam) * lam) (from 0)` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_SERIES_ADD THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `((\k. (&k pow 2 * poisson_pmf lam k + + (-- &2 * lam) * &k * poisson_pmf lam k) + + lam pow 2 * poisson_pmf lam k) real_sums + ((lam pow 2 + lam) + (-- &2 * lam) * lam) + + lam pow 2 * &1) (from 0)` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_SERIES_ADD THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `((lam pow 2 + lam) + (-- &2 * lam) * lam) + lam pow 2 * &1 = lam` + (fun th -> RULE_ASSUM_TAC(REWRITE_RULE[th])) THENL + [REWRITE_TAC[REAL_MUL_RID; REAL_POW_2] THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `(\k. (&k - lam) pow 2 * poisson_pmf lam k) = + (\k. (&k pow 2 * poisson_pmf lam k + + (-- &2 * lam) * &k * poisson_pmf lam k) + + lam pow 2 * poisson_pmf lam k)` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + REWRITE_TAC[REAL_POW_2] THEN REAL_ARITH_TAC; + ASM_REWRITE_TAC[]]);; + +(* ========================================================================= *) +(* Discrete LOTUS and Distribution Characteristic Function Bridge *) +(* *) +(* Connects the probability-space char fn (expectation) to the analytical *) +(* series formulas for discrete distributions (Poisson, Geometric). *) +(* ========================================================================= *) + +(* ------------------------------------------------------------------------- *) +(* Definition: X has discrete distribution with PMF on {0, 1, 2, ...}. *) +(* *) +(* Condition 5: LOTUS for bounded functions (used for char fn bridges). *) +(* Condition 6: LOTUS for integrable functions (used for E/Var bridges). *) +(* ------------------------------------------------------------------------- *) + +let has_pmf = new_definition + `has_pmf (p:A prob_space) (X:A->real) (pmf:num->real) <=> + random_variable p X /\ + (!k. &0 <= pmf k) /\ + (pmf real_sums &1) (from 0) /\ + (!k. prob p {x | x IN prob_carrier p /\ X x = &k} = pmf k) /\ + (!g M. (!u. abs(g u) <= M) /\ random_variable p (\x. g(X x)) + ==> integrable p (\x. g(X x)) /\ + ((\k. g(&k) * pmf k) real_sums + expectation p (\x. g(X x))) (from 0)) /\ + (!g. integrable p (\x. g(X x)) + ==> ((\k. g(&k) * pmf k) real_sums + expectation p (\x. g(X x))) (from 0))`;; + +(* Basic consequences *) + +let HAS_PMF_RV = prove + (`!p:A prob_space X pmf. has_pmf p X pmf ==> random_variable p X`, + REWRITE_TAC[has_pmf] THEN MESON_TAC[]);; + +let HAS_PMF_NONNEG = prove + (`!p:A prob_space X pmf. has_pmf p X pmf ==> !k. &0 <= pmf k`, + REWRITE_TAC[has_pmf] THEN MESON_TAC[]);; + +let HAS_PMF_SUMS_ONE = prove + (`!p:A prob_space X pmf. has_pmf p X pmf + ==> (pmf real_sums &1) (from 0)`, + REWRITE_TAC[has_pmf] THEN MESON_TAC[]);; + +let HAS_PMF_PROB = prove + (`!p:A prob_space X pmf k. + has_pmf p X pmf + ==> prob p {x | x IN prob_carrier p /\ X x = &k} = pmf k`, + REWRITE_TAC[has_pmf] THEN MESON_TAC[]);; + +(* LOTUS for cos and sin (the cases needed for char fn) *) + +let LOTUS_PMF_COS = prove + (`!p:A prob_space X (pmf:num->real) t. + has_pmf p X pmf + ==> integrable p (\x. cos(t * X x)) /\ + ((\k. cos(t * &k) * pmf k) real_sums + expectation p (\x. cos(t * X x))) (from 0)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(STRIP_ASSUME_TAC o REWRITE_RULE[has_pmf]) THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`\u:real. cos(t * u)`; `&1`]) THEN + REWRITE_TAC[COS_BOUND] THEN ANTS_TAC THENL + [MATCH_MP_TAC RANDOM_VARIABLE_COS THEN + MATCH_MP_TAC RANDOM_VARIABLE_CMUL THEN ASM_REWRITE_TAC[]; + SIMP_TAC[]]);; + +let LOTUS_PMF_SIN = prove + (`!p:A prob_space X (pmf:num->real) t. + has_pmf p X pmf + ==> integrable p (\x. sin(t * X x)) /\ + ((\k. sin(t * &k) * pmf k) real_sums + expectation p (\x. sin(t * X x))) (from 0)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + FIRST_ASSUM(STRIP_ASSUME_TAC o REWRITE_RULE[has_pmf]) THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`\u:real. sin(t * u)`; `&1`]) THEN + REWRITE_TAC[SIN_BOUND] THEN ANTS_TAC THENL + [MATCH_MP_TAC RANDOM_VARIABLE_SIN THEN + MATCH_MP_TAC RANDOM_VARIABLE_CMUL THEN ASM_REWRITE_TAC[]; + SIMP_TAC[]]);; + +(* LOTUS for integrable functions (needed for E/Var) *) + +let LOTUS_PMF_INTEGRABLE = prove + (`!p:A prob_space X (pmf:num->real) g. + has_pmf p X pmf /\ integrable p (\x. g(X x)) + ==> ((\k. g(&k) * pmf k) real_sums + expectation p (\x. g(X x))) (from 0)`, + REWRITE_TAC[has_pmf] THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Distribution predicates *) +(* ------------------------------------------------------------------------- *) + +let poisson_distributed = new_definition + `poisson_distributed (p:A prob_space) (X:A->real) lam <=> + has_pmf p X (poisson_pmf lam) /\ &0 <= lam /\ + integrable p X /\ + integrable p (\x. (X x - lam) pow 2)`;; + +let geometric_distributed = new_definition + `geometric_distributed (p:A prob_space) (X:A->real) q <=> + has_pmf p X (geometric_pmf q) /\ &0 < q /\ q <= &1 /\ + integrable p X /\ + integrable p (\x. (X x - (&1 - q) / q) pow 2)`;; + +(* ------------------------------------------------------------------------- *) +(* Bridge theorems: char fn of Poisson distributed RV *) +(* ------------------------------------------------------------------------- *) + +let CHAR_FN_RE_POISSON_DIST = prove + (`!p:A prob_space X lam t. + poisson_distributed p X lam + ==> char_fn_re p X t = + exp(lam * (cos t - &1)) * cos(lam * sin t)`, + REPEAT GEN_TAC THEN REWRITE_TAC[poisson_distributed] THEN STRIP_TAC THEN + REWRITE_TAC[char_fn_re] THEN + FIRST_ASSUM(STRIP_ASSUME_TAC o SPEC `t:real` o MATCH_MP LOTUS_PMF_COS) THEN + MATCH_MP_TAC REAL_SERIES_UNIQUE THEN + EXISTS_TAC `\k:num. cos(t * &k) * poisson_pmf lam k` THEN + EXISTS_TAC `from 0` THEN + CONJ_TAC THENL + [FIRST_ASSUM ACCEPT_TAC; + MATCH_MP_TAC POISSON_CHAR_FN_RE THEN ASM_REWRITE_TAC[]]);; + +let CHAR_FN_IM_POISSON_DIST = prove + (`!p:A prob_space X lam t. + poisson_distributed p X lam + ==> char_fn_im p X t = + exp(lam * (cos t - &1)) * sin(lam * sin t)`, + REPEAT GEN_TAC THEN REWRITE_TAC[poisson_distributed] THEN STRIP_TAC THEN + REWRITE_TAC[char_fn_im] THEN + FIRST_ASSUM(STRIP_ASSUME_TAC o SPEC `t:real` o MATCH_MP LOTUS_PMF_SIN) THEN + MATCH_MP_TAC REAL_SERIES_UNIQUE THEN + EXISTS_TAC `\k:num. sin(t * &k) * poisson_pmf lam k` THEN + EXISTS_TAC `from 0` THEN + CONJ_TAC THENL + [FIRST_ASSUM ACCEPT_TAC; + MATCH_MP_TAC POISSON_CHAR_FN_IM THEN ASM_REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Bridge theorems: char fn of Geometrically distributed RV *) +(* ------------------------------------------------------------------------- *) + +let CHAR_FN_RE_GEOMETRIC_DIST = prove + (`!p:A prob_space X q t. + geometric_distributed p X q + ==> char_fn_re p X t = + q * (&1 - (&1 - q) * cos t) / + (&1 - &2 * (&1 - q) * cos t + (&1 - q) pow 2)`, + REPEAT GEN_TAC THEN REWRITE_TAC[geometric_distributed] THEN STRIP_TAC THEN + REWRITE_TAC[char_fn_re] THEN + FIRST_ASSUM(STRIP_ASSUME_TAC o SPEC `t:real` o MATCH_MP LOTUS_PMF_COS) THEN + MATCH_MP_TAC REAL_SERIES_UNIQUE THEN + EXISTS_TAC `\k:num. cos(t * &k) * geometric_pmf q k` THEN + EXISTS_TAC `from 0` THEN + CONJ_TAC THENL + [FIRST_ASSUM ACCEPT_TAC; + MATCH_MP_TAC GEOMETRIC_CHAR_FN_RE THEN ASM_REWRITE_TAC[]]);; + +let CHAR_FN_IM_GEOMETRIC_DIST = prove + (`!p:A prob_space X q t. + geometric_distributed p X q + ==> char_fn_im p X t = + q * (&1 - q) * sin t / + (&1 - &2 * (&1 - q) * cos t + (&1 - q) pow 2)`, + REPEAT GEN_TAC THEN REWRITE_TAC[geometric_distributed] THEN STRIP_TAC THEN + REWRITE_TAC[char_fn_im] THEN + FIRST_ASSUM(STRIP_ASSUME_TAC o SPEC `t:real` o MATCH_MP LOTUS_PMF_SIN) THEN + MATCH_MP_TAC REAL_SERIES_UNIQUE THEN + EXISTS_TAC `\k:num. sin(t * &k) * geometric_pmf q k` THEN + EXISTS_TAC `from 0` THEN + CONJ_TAC THENL + [FIRST_ASSUM ACCEPT_TAC; + MATCH_MP_TAC GEOMETRIC_CHAR_FN_IM THEN ASM_REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Bridge theorems: Expectation and Variance *) +(* ------------------------------------------------------------------------- *) + +let EXPECTATION_POISSON_DIST = prove + (`!p:A prob_space X lam. + poisson_distributed p X lam + ==> expectation p X = lam`, + REPEAT GEN_TAC THEN REWRITE_TAC[poisson_distributed] THEN STRIP_TAC THEN + MATCH_MP_TAC REAL_SERIES_UNIQUE THEN + EXISTS_TAC `\k:num. &k * poisson_pmf lam k` THEN + EXISTS_TAC `from 0` THEN CONJ_TAC THENL + [MP_TAC(ISPECL [`p:A prob_space`; `X:A->real`; `poisson_pmf lam`; + `\u:real. u`] LOTUS_PMF_INTEGRABLE) THEN + BETA_TAC THEN REWRITE_TAC[ETA_AX] THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + ASM_SIMP_TAC[POISSON_MEAN_SERIES]);; + +let VARIANCE_POISSON_DIST = prove + (`!p:A prob_space X lam. + poisson_distributed p X lam + ==> variance p X = lam`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN `expectation p (X:A->real) = lam` ASSUME_TAC THENL + [ASM_MESON_TAC[EXPECTATION_POISSON_DIST]; ALL_TAC] THEN + REWRITE_TAC[variance] THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `poisson_distributed p (X:A->real) lam` THEN + REWRITE_TAC[poisson_distributed] THEN STRIP_TAC THEN + MATCH_MP_TAC REAL_SERIES_UNIQUE THEN + EXISTS_TAC `\k:num. (&k - lam) pow 2 * poisson_pmf lam k` THEN + EXISTS_TAC `from 0` THEN CONJ_TAC THENL + [MP_TAC(ISPECL [`p:A prob_space`; `X:A->real`; `poisson_pmf lam`; + `\u:real. (u - lam) pow 2`] LOTUS_PMF_INTEGRABLE) THEN + BETA_TAC THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + ASM_SIMP_TAC[POISSON_VARIANCE_SERIES]);; + +let EXPECTATION_GEOMETRIC_DIST = prove + (`!p:A prob_space X q. + geometric_distributed p X q + ==> expectation p X = (&1 - q) / q`, + REPEAT GEN_TAC THEN REWRITE_TAC[geometric_distributed] THEN STRIP_TAC THEN + MATCH_MP_TAC REAL_SERIES_UNIQUE THEN + EXISTS_TAC `\k:num. &k * geometric_pmf q k` THEN + EXISTS_TAC `from 0` THEN CONJ_TAC THENL + [MP_TAC(ISPECL [`p:A prob_space`; `X:A->real`; `geometric_pmf q`; + `\u:real. u`] LOTUS_PMF_INTEGRABLE) THEN + BETA_TAC THEN REWRITE_TAC[ETA_AX] THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + ASM_SIMP_TAC[GEOMETRIC_MEAN_SERIES]);; + +let VARIANCE_GEOMETRIC_DIST = prove + (`!p:A prob_space X q. + geometric_distributed p X q + ==> variance p X = (&1 - q) / q pow 2`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN `expectation p (X:A->real) = (&1 - q) / q` ASSUME_TAC THENL + [ASM_MESON_TAC[EXPECTATION_GEOMETRIC_DIST]; ALL_TAC] THEN + REWRITE_TAC[variance] THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `geometric_distributed p (X:A->real) q` THEN + REWRITE_TAC[geometric_distributed] THEN STRIP_TAC THEN + MATCH_MP_TAC REAL_SERIES_UNIQUE THEN + EXISTS_TAC `\k:num. (&k - (&1 - q) / q) pow 2 * geometric_pmf q k` THEN + EXISTS_TAC `from 0` THEN CONJ_TAC THENL + [MP_TAC(ISPECL [`p:A prob_space`; `X:A->real`; `geometric_pmf q`; + `\u:real. (u - (&1 - q) / q) pow 2`] + LOTUS_PMF_INTEGRABLE) THEN + BETA_TAC THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + ASM_SIMP_TAC[GEOMETRIC_VARIANCE_SERIES]);; + +(* ------------------------------------------------------------------------- *) +(* Bridge theorems: Binomial characteristic function *) +(* ------------------------------------------------------------------------- *) + +let CHAR_FN_RE_BINOMIAL_RV = prove + (`!p:A prob_space X n q t. binomial_rv p X n q ==> + char_fn_re p X t = + sum (0..n) (\k. &(binom(n,k)) * q pow k * (&1 - q) pow (n - k) * + cos(t * &k))`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN `simple_rv p (X:A->real)` ASSUME_TAC THENL + [ASM_MESON_TAC[binomial_rv]; ALL_TAC] THEN + SUBGOAL_THEN `char_fn_re p (X:A->real) t = simple_char_fn_re p X t` + SUBST1_TAC THENL + [ASM_SIMP_TAC[CHAR_FN_RE_SIMPLE]; ALL_TAC] THEN + ASM_SIMP_TAC[BINOMIAL_CHAR_FN_RE]);; + +let CHAR_FN_IM_BINOMIAL_RV = prove + (`!p:A prob_space X n q t. binomial_rv p X n q ==> + char_fn_im p X t = + sum (0..n) (\k. &(binom(n,k)) * q pow k * (&1 - q) pow (n - k) * + sin(t * &k))`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN `simple_rv p (X:A->real)` ASSUME_TAC THENL + [ASM_MESON_TAC[binomial_rv]; ALL_TAC] THEN + SUBGOAL_THEN `char_fn_im p (X:A->real) t = simple_char_fn_im p X t` + SUBST1_TAC THENL + [ASM_SIMP_TAC[CHAR_FN_IM_SIMPLE]; ALL_TAC] THEN + ASM_SIMP_TAC[BINOMIAL_CHAR_FN_IM]);; diff --git a/Probability/ergodic.ml b/Probability/ergodic.ml new file mode 100644 index 00000000..a24957b7 --- /dev/null +++ b/Probability/ergodic.ml @@ -0,0 +1,5000 @@ +(* ========================================================================= *) +(* Ergodic theory: Birkhoff's Ergodic Theorem (Wiedijk #66). *) +(* *) +(* Follows Williams "Probability with Martingales" Chapter 12. *) +(* Uses the maximal ergodic lemma (Garsia's proof) approach. *) +(* ========================================================================= *) + +needs "Probability/clt.ml";; + +(* ------------------------------------------------------------------------- *) +(* Function iteration: ITER is already in the checkpoint. *) +(* We prove additional properties needed for ergodic theory. *) +(* ------------------------------------------------------------------------- *) + +let ITER_ADD = prove + (`!f:A->A m n x. ITER (m + n) f x = ITER m f (ITER n f x)`, + GEN_TAC THEN INDUCT_TAC THEN ASM_REWRITE_TAC[ADD_CLAUSES; ITER]);; + +let ITER_1 = prove + (`!f:A->A x. ITER 1 f x = f x`, + REWRITE_TAC[num_CONV `1`; ITER]);; + +let REAL_LE_EPSILON = prove + (`!x y:real. (!e. &0 < e ==> x <= y + e) ==> x <= y`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM REAL_NOT_LT] THEN + DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(x - y) / &2`) THEN + ASM_REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Measure-preserving transformations *) +(* Note: we use "tt" instead of "T" since T is the boolean true in HOL. *) +(* ------------------------------------------------------------------------- *) + +let measure_preserving = new_definition + `measure_preserving (p:A prob_space) (tt:A->A) <=> + (!x. x IN prob_carrier p ==> tt x IN prob_carrier p) /\ + (!A. A IN prob_events p ==> + {x | x IN prob_carrier p /\ tt x IN A} IN prob_events p) /\ + (!A. A IN prob_events p ==> + prob p {x | x IN prob_carrier p /\ tt x IN A} = prob p A)`;; + +(* ------------------------------------------------------------------------- *) +(* Ergodicity: invariant events are trivial *) +(* ------------------------------------------------------------------------- *) + +let invariant_event = new_definition + `invariant_event (p:A prob_space) (tt:A->A) (A:A->bool) <=> + A IN prob_events p /\ + {x | x IN prob_carrier p /\ tt x IN A} = A`;; + +let ergodic = new_definition + `ergodic (p:A prob_space) (tt:A->A) <=> + measure_preserving p tt /\ + (!A. invariant_event p tt A ==> prob p A = &0 \/ prob p A = &1)`;; + +(* ------------------------------------------------------------------------- *) +(* Basic properties of measure-preserving maps *) +(* ------------------------------------------------------------------------- *) + +let MEASURE_PRESERVING_CARRIER = prove + (`!p:A prob_space tt. measure_preserving p tt + ==> (!x. x IN prob_carrier p ==> tt x IN prob_carrier p)`, + REWRITE_TAC[measure_preserving] THEN MESON_TAC[]);; + +let MEASURE_PRESERVING_EVENTS = prove + (`!p:A prob_space tt A. measure_preserving p tt /\ A IN prob_events p + ==> {x | x IN prob_carrier p /\ tt x IN A} IN prob_events p`, + REWRITE_TAC[measure_preserving] THEN MESON_TAC[]);; + +let MEASURE_PRESERVING_PROB = prove + (`!p:A prob_space tt A. measure_preserving p tt /\ A IN prob_events p + ==> prob p {x | x IN prob_carrier p /\ tt x IN A} = prob p A`, + REWRITE_TAC[measure_preserving] THEN MESON_TAC[]);; + +(* ITER n tt is measure-preserving *) +let MEASURE_PRESERVING_ITER = prove + (`!p:A prob_space tt n. measure_preserving p tt + ==> measure_preserving p (ITER n tt)`, + GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THENL + [DISCH_TAC THEN REWRITE_TAC[ITER; measure_preserving] THEN + SUBGOAL_THEN `!A:A->bool. A IN prob_events p ==> + {x | x IN prob_carrier p /\ x IN A} = A` (fun th -> SIMP_TAC[th]) THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN + X_GEN_TAC `x:A` THEN EQ_TAC THENL + [MESON_TAC[]; + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MP_TAC(SPECL [`p:A prob_space`; `A:A->bool`] PROB_EVENT_SUBSET) THEN + ASM_REWRITE_TAC[SUBSET] THEN ASM_MESON_TAC[]]; + DISCH_TAC THEN + SUBGOAL_THEN `measure_preserving (p:A prob_space) (ITER n tt)` ASSUME_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[measure_preserving; ITER] THEN REPEAT CONJ_TAC THENL + [X_GEN_TAC `x:A` THEN DISCH_TAC THEN + SUBGOAL_THEN `(ITER n (tt:A->A) x) IN prob_carrier p` ASSUME_TAC THENL + [MP_TAC(SPECL [`p:A prob_space`; `ITER n (tt:A->A)`] MEASURE_PRESERVING_CARRIER) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + MP_TAC(SPECL [`p:A prob_space`; `tt:A->A`] MEASURE_PRESERVING_CARRIER) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]; + X_GEN_TAC `A:A->bool` THEN DISCH_TAC THEN + SUBGOAL_THEN `{x:A | x IN prob_carrier p /\ tt (ITER n tt x) IN A} = + {x | x IN prob_carrier p /\ ITER n tt x IN + {y | y IN prob_carrier p /\ tt y IN A}}` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `x:A` THEN EQ_TAC THENL + [STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MP_TAC(SPECL [`p:A prob_space`; `ITER n (tt:A->A)`] + MEASURE_PRESERVING_CARRIER) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `x:A`) THEN + ASM_REWRITE_TAC[]; + MESON_TAC[]]; + MP_TAC(SPECL [`p:A prob_space`; `ITER n (tt:A->A)`; + `{y:A | y IN prob_carrier p /\ tt y IN (A:A->bool)}`] + MEASURE_PRESERVING_EVENTS) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + MP_TAC(SPECL [`p:A prob_space`; `tt:A->A`; `A:A->bool`] + MEASURE_PRESERVING_EVENTS) THEN + ASM_REWRITE_TAC[]]; + X_GEN_TAC `A:A->bool` THEN DISCH_TAC THEN + SUBGOAL_THEN `{x:A | x IN prob_carrier p /\ tt (ITER n tt x) IN A} = + {x | x IN prob_carrier p /\ ITER n tt x IN + {y | y IN prob_carrier p /\ tt y IN A}}` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `x:A` THEN EQ_TAC THENL + [STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MP_TAC(SPECL [`p:A prob_space`; `ITER n (tt:A->A)`] + MEASURE_PRESERVING_CARRIER) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `x:A`) THEN + ASM_REWRITE_TAC[]; + MESON_TAC[]]; + SUBGOAL_THEN `{y:A | y IN prob_carrier p /\ tt y IN (A:A->bool)} + IN prob_events p` ASSUME_TAC THENL + [MP_TAC(SPECL [`p:A prob_space`; `tt:A->A`; `A:A->bool`] + MEASURE_PRESERVING_EVENTS) THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MP_TAC(SPECL [`p:A prob_space`; `ITER n (tt:A->A)`; + `{y:A | y IN prob_carrier p /\ tt y IN (A:A->bool)}`] + MEASURE_PRESERVING_PROB) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + MP_TAC(SPECL [`p:A prob_space`; `tt:A->A`; `A:A->bool`] + MEASURE_PRESERVING_PROB) THEN + ASM_REWRITE_TAC[]]]]);; + +(* Composition with tt preserves random variable property *) +let RANDOM_VARIABLE_COMP_MP = prove + (`!p:A prob_space tt X. measure_preserving p tt /\ random_variable p X + ==> random_variable p (\x. X(tt x))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[random_variable] THEN + X_GEN_TAC `a:real` THEN + SUBGOAL_THEN + `{x:A | x IN prob_carrier p /\ X((tt:A->A) x) <= a} = + {x | x IN prob_carrier p /\ + tt x IN {y | y IN prob_carrier p /\ X y <= a}}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `x:A` THEN + EQ_TAC THENL + [STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `measure_preserving (p:A prob_space) (tt:A->A)` THEN + REWRITE_TAC[measure_preserving] THEN STRIP_TAC THEN + ASM_MESON_TAC[]; + MESON_TAC[]]; + MATCH_MP_TAC MEASURE_PRESERVING_EVENTS THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `random_variable (p:A prob_space) (X:A->real)` THEN + REWRITE_TAC[random_variable] THEN + DISCH_THEN(MP_TAC o SPEC `a:real`) THEN REWRITE_TAC[]]);; + + +(* Composition with ITER n tt preserves random variable property *) +let RANDOM_VARIABLE_ITER_COMP_MP = prove + (`!p:A prob_space tt X n. measure_preserving p tt /\ random_variable p X + ==> random_variable p (\x. X(ITER n tt x))`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`p:A prob_space`; `ITER n (tt:A->A)`; `X:A->real`] + RANDOM_VARIABLE_COMP_MP) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[MEASURE_PRESERVING_ITER]; REWRITE_TAC[]]);; + +(* {h < v} is an event for random variables *) +let RV_STRICT_INEQ_EVENT = prove + (`!p:A prob_space h v. random_variable p h + ==> {x | x IN prob_carrier p /\ h x < v} IN prob_events p`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`prob_events (p:A prob_space)`; + `{t:A->bool | ?n:num. t = {y:A | y IN prob_carrier p /\ + (h:A->real) y <= v - inv(&n + &1)}}`] + SIGMA_ALGEBRA_UNION_COUNTABLE) THEN + ANTS_TAC THENL + [REWRITE_TAC[PROB_SPACE_SIGMA_ALGEBRA] THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN GEN_TAC THEN + DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `random_variable (p:A prob_space) (h:A->real)` THEN + REWRITE_TAC[random_variable] THEN + DISCH_THEN(MP_TAC o SPEC `v - inv(&n + &1)`) THEN REWRITE_TAC[]; + MATCH_MP_TAC COUNTABLE_SUBSET THEN + EXISTS_TAC `IMAGE (\n:num. {y:A | y IN prob_carrier p /\ + (h:A->real) y <= v - inv(&n + &1)}) (:num)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC COUNTABLE_IMAGE THEN REWRITE_TAC[NUM_COUNTABLE]; + REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_IMAGE; IN_UNIV] THEN + GEN_TAC THEN DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN + EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC[]]]; + SUBGOAL_THEN + `UNIONS {t:A->bool | ?n:num. t = {y | y IN prob_carrier p /\ + (h:A->real) y <= v - inv (&n + &1)}} = + {x:A | x IN prob_carrier p /\ h x < v}` (fun th -> REWRITE_TAC[th]) THEN + MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET; IN_UNIONS] THEN X_GEN_TAC `y:A` THEN + DISCH_THEN(X_CHOOSE_THEN `t:A->bool` STRIP_ASSUME_TAC) THEN + UNDISCH_TAC `(t:A->bool) IN {t | ?n:num. t = {y:A | y IN prob_carrier p /\ + (h:A->real) y <= v - inv(&n + &1)}}` THEN + REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN(X_CHOOSE_TAC `m:num`) THEN + UNDISCH_TAC `(y:A) IN (t:A->bool)` THEN ASM_REWRITE_TAC[IN_ELIM_THM] THEN + STRIP_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_REWRITE_TAC[] THEN + MP_TAC(SPEC `&m + &1` REAL_LT_INV) THEN + ANTS_TAC THENL [REAL_ARITH_TAC; ASM_REAL_ARITH_TAC]; + REWRITE_TAC[SUBSET; IN_UNIONS; IN_ELIM_THM] THEN + X_GEN_TAC `y:A` THEN STRIP_TAC THEN + MP_TAC(SPEC `v - (h:A->real) y` REAL_ARCH_INV_SUC) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_TAC `m:num`) THEN + EXISTS_TAC `{y':A | y' IN prob_carrier p /\ + (h:A->real) y' <= v - inv(&m + &1)}` THEN + CONJ_TAC THENL + [EXISTS_TAC `m:num` THEN REFL_TAC; + REWRITE_TAC[IN_ELIM_THM] THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC]]]);; + +(* Level sets of random variables are events *) +let RV_LEVEL_SET_EVENT = prove + (`!p:A prob_space h v. random_variable p h + ==> {x | x IN prob_carrier p /\ h x = v} IN prob_events p`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `{x:A | x IN prob_carrier p /\ (h:A->real) x = v} = + {x | x IN prob_carrier p /\ h x <= v} DIFF + {x | x IN prob_carrier p /\ h x < v}` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_DIFF; IN_ELIM_THM] THEN X_GEN_TAC `y:A` THEN + ASM_CASES_TAC `(y:A) IN prob_carrier p` THEN ASM_REWRITE_TAC[] THEN + REAL_ARITH_TAC; + MATCH_MP_TAC PROB_DIFF_IN_EVENTS THEN CONJ_TAC THENL + [UNDISCH_TAC `random_variable (p:A prob_space) (h:A->real)` THEN + REWRITE_TAC[random_variable] THEN MESON_TAC[]; + MATCH_MP_TAC RV_STRICT_INEQ_EVENT THEN ASM_REWRITE_TAC[]]]);; + +(* Simple expectation is preserved under composition with measure-preserving map *) +let SIMPLE_EXPECTATION_COMP_PRESERVED = prove + (`!p:A prob_space tt h. measure_preserving p tt /\ simple_rv p h + ==> simple_expectation p (\x. h(tt x)) = simple_expectation p h`, + REPEAT STRIP_TAC THEN REWRITE_TAC[simple_expectation] THEN + SUBGOAL_THEN + `!v:real. prob p {x:A | x IN prob_carrier p /\ (h:A->real)((tt:A->A) x) = v} = + prob p {x | x IN prob_carrier p /\ h x = v}` ASSUME_TAC THENL + [X_GEN_TAC `v:real` THEN + SUBGOAL_THEN `{x:A | x IN prob_carrier p /\ (h:A->real)((tt:A->A) x) = v} = + {x | x IN prob_carrier p /\ tt x IN {y | y IN prob_carrier p /\ h y = v}}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `x:A` THEN EQ_TAC THENL + [STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MP_TAC(SPECL [`p:A prob_space`; `tt:A->A`] MEASURE_PRESERVING_CARRIER) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `x:A`) THEN + ASM_REWRITE_TAC[]; + MESON_TAC[]]; + MP_TAC(SPECL [`p:A prob_space`; `tt:A->A`; + `{y:A | y IN prob_carrier p /\ (h:A->real) y = v}`] + MEASURE_PRESERVING_PROB) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [MATCH_MP_TAC RV_LEVEL_SET_EVENT THEN ASM_MESON_TAC[simple_rv]; + DISCH_THEN(fun th -> REWRITE_TAC[th])]]; + ALL_TAC] THEN + ASM_REWRITE_TAC[SET_RULE `{v:real | v IN s} = s`] THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_SUPERSET THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET; IN_IMAGE] THEN X_GEN_TAC `v:real` THEN + DISCH_THEN(X_CHOOSE_THEN `x:A` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(tt:A->A) x` THEN ASM_REWRITE_TAC[] THEN + MP_TAC(SPECL [`p:A prob_space`; `tt:A->A`] MEASURE_PRESERVING_CARRIER) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[] THEN X_GEN_TAC `v:real` THEN STRIP_TAC THEN + SUBGOAL_THEN `prob p {x:A | x IN prob_carrier p /\ (h:A->real) x = v} = &0` + (fun th -> REWRITE_TAC[th; REAL_MUL_RZERO]) THEN + SUBGOAL_THEN + `prob p {x:A | x IN prob_carrier p /\ (h:A->real)((tt:A->A) x) = v} = &0` + MP_TAC THENL + [SUBGOAL_THEN + `{x:A | x IN prob_carrier p /\ (h:A->real)((tt:A->A) x) = v} = {}` + (fun th -> REWRITE_TAC[th; PROB_EMPTY]) THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN + X_GEN_TAC `x:A` THEN + UNDISCH_TAC `~(v IN IMAGE (\x:A. (h:A->real)(tt x)) (prob_carrier p))` THEN + REWRITE_TAC[IN_IMAGE; CONTRAPOS_THM] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (fun th -> EXISTS_TAC `x:A` THEN + REWRITE_TAC[th] THEN ASM_REWRITE_TAC[])); + ASM_MESON_TAC[]]]);; + +(* Composition with tt preserves simple_rv *) +let SIMPLE_RV_COMP_MP = prove + (`!p:A prob_space tt h. measure_preserving p tt /\ simple_rv p h + ==> simple_rv p (\x. h(tt x))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[simple_rv] THEN CONJ_TAC THENL + [MATCH_MP_TAC RANDOM_VARIABLE_COMP_MP THEN ASM_MESON_TAC[simple_rv]; + ALL_TAC] THEN + SUBGOAL_THEN `{(\x:A. (h:A->real)(tt x)) x | x IN prob_carrier p} SUBSET + {h x | x IN prob_carrier p}` MP_TAC THENL + [REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `v:real` THEN + DISCH_THEN(X_CHOOSE_THEN `x:A` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(tt:A->A) x` THEN ASM_REWRITE_TAC[] THEN + MP_TAC(SPECL [`p:A prob_space`; `tt:A->A`] MEASURE_PRESERVING_CARRIER) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + DISCH_TAC THEN MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `{(h:A->real) x | x IN prob_carrier p}` THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[simple_rv]]);; + +(* nn_expectation preserved under composition with tt (bounded case) *) +let NN_EXPECTATION_COMP_PRESERVED_BOUNDED = prove + (`!p:A prob_space tt f B. + measure_preserving p tt /\ + random_variable p f /\ + (!x. x IN prob_carrier p ==> &0 <= f x) /\ + (!x. x IN prob_carrier p ==> f x <= B) + ==> nn_expectation p (\x. f(tt x)) = nn_expectation p f`, + REPEAT STRIP_TAC THEN + ABBREV_TAC `fn = \n:num. nonneg_simple_fn_approx (p:A prob_space) (f:A->real) n` THEN + SUBGOAL_THEN `!n:num. simple_rv p ((fn:num->A->real) n)` ASSUME_TAC THENL + [GEN_TAC THEN EXPAND_TAC "fn" THEN + MATCH_MP_TAC NONNEG_SIMPLE_FN_APPROX_SIMPLE_RV THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `!n:num. simple_rv p (\x:A. (fn:num->A->real) n (tt x))` ASSUME_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] SIMPLE_RV_COMP_MP) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `((\n. simple_expectation p ((fn:num->A->real) n)) ---> nn_expectation p f) sequentially` ASSUME_TAC THENL + [MATCH_MP_TAC SIMPLE_MCT_NN_EXPECTATION THEN ASM_REWRITE_TAC[] THEN + REPEAT CONJ_TAC THENL + [GEN_TAC THEN X_GEN_TAC `x:A` THEN DISCH_TAC THEN + EXPAND_TAC "fn" THEN REWRITE_TAC[NONNEG_SIMPLE_FN_APPROX_NONNEG]; + GEN_TAC THEN X_GEN_TAC `x:A` THEN DISCH_TAC THEN EXPAND_TAC "fn" THEN + MP_TAC(SPECL [`p:A prob_space`; `f:A->real`; `n:num`; `SUC n`] + NONNEG_SIMPLE_FN_APPROX_MONO) THEN + DISCH_THEN(MP_TAC o SPEC `x:A`) THEN + ASM_SIMP_TAC[LE_REFL; ARITH_RULE `n <= SUC n`]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN EXPAND_TAC "fn" THEN + MATCH_MP_TAC NONNEG_SIMPLE_FN_APPROX_CONVERGES THEN ASM_SIMP_TAC[]; + EXISTS_TAC `B:real` THEN ASM_SIMP_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN `((\n. simple_expectation p (\x:A. (fn:num->A->real) n (tt x))) ---> nn_expectation p (\x. (f:A->real)(tt x))) sequentially` ASSUME_TAC THENL + [MATCH_MP_TAC SIMPLE_MCT_NN_EXPECTATION THEN ASM_REWRITE_TAC[] THEN + REPEAT CONJ_TAC THENL + [GEN_TAC THEN X_GEN_TAC `x:A` THEN DISCH_TAC THEN + EXPAND_TAC "fn" THEN REWRITE_TAC[NONNEG_SIMPLE_FN_APPROX_NONNEG]; + GEN_TAC THEN X_GEN_TAC `x:A` THEN DISCH_TAC THEN EXPAND_TAC "fn" THEN + MP_TAC(SPECL [`p:A prob_space`; `f:A->real`; `n:num`; `SUC n`] + NONNEG_SIMPLE_FN_APPROX_MONO) THEN + DISCH_THEN(MP_TAC o SPEC `(tt:A->A) x`) THEN + SUBGOAL_THEN `(tt:A->A) x IN prob_carrier p` ASSUME_TAC THENL + [MP_TAC(SPECL [`p:A prob_space`; `tt:A->A`] MEASURE_PRESERVING_CARRIER) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + ASM_SIMP_TAC[ARITH_RULE `n <= SUC n`]]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN EXPAND_TAC "fn" THEN + SUBGOAL_THEN `(tt:A->A) x IN prob_carrier p` ASSUME_TAC THENL + [MP_TAC(SPECL [`p:A prob_space`; `tt:A->A`] MEASURE_PRESERVING_CARRIER) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC NONNEG_SIMPLE_FN_APPROX_CONVERGES THEN ASM_SIMP_TAC[]]; + EXISTS_TAC `B:real` THEN X_GEN_TAC `x:A` THEN DISCH_TAC THEN + ASM_SIMP_TAC[MEASURE_PRESERVING_CARRIER]]; + ALL_TAC] THEN + SUBGOAL_THEN `!n:num. simple_expectation p (\x:A. (fn:num->A->real) n (tt x)) = simple_expectation p (fn n)` ASSUME_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC SIMPLE_EXPECTATION_COMP_PRESERVED THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `((\n:num. simple_expectation p ((fn:num->A->real) n)) ---> nn_expectation p (\x:A. (f:A->real)(tt x))) sequentially` MP_TAC THENL + [SUBGOAL_THEN `(\n:num. simple_expectation p ((fn:num->A->real) n)) = (\n. simple_expectation p (\x:A. fn n (tt x)))` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN CONV_TAC SYM_CONV THEN + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]]; + DISCH_TAC THEN + MP_TAC(ISPECL [`sequentially`; `\n:num. simple_expectation (p:A prob_space) ((fn:num->A->real) n)`; `nn_expectation (p:A prob_space) (\x:A. (f:A->real)(tt x))`; `nn_expectation (p:A prob_space) (f:A->real)`] REALLIM_UNIQUE) THEN + REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]);; + +(* nn_expectation preserved under composition with tt (general nonneg case) *) +let NN_EXPECTATION_COMP_PRESERVED = prove + (`!p:A prob_space tt f. + measure_preserving p tt /\ + random_variable p f /\ + (!x. x IN prob_carrier p ==> &0 <= f x) /\ + integrable p f + ==> nn_expectation p (\x. f(tt x)) = nn_expectation p f`, + REPEAT STRIP_TAC THEN + ABBREV_TAC `Xn = \n:num. (\x:A. min ((f:A->real) x) (&n))` THEN + SUBGOAL_THEN `!n:num. integrable p ((Xn:num->A->real) n)` ASSUME_TAC THENL + [GEN_TAC THEN EXPAND_TAC "Xn" THEN + MATCH_MP_TAC INTEGRABLE_MIN THEN ASM_REWRITE_TAC[INTEGRABLE_CONST]; + ALL_TAC] THEN + SUBGOAL_THEN `!n:num x:A. x IN prob_carrier p ==> &0 <= (Xn:num->A->real) n x` ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN EXPAND_TAC "Xn" THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ &0 <= y ==> &0 <= min x y`) THEN + ASM_SIMP_TAC[] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `!n:num x:A. x IN prob_carrier p ==> (Xn:num->A->real) n x <= Xn (SUC n) x` ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN EXPAND_TAC "Xn" THEN + MATCH_MP_TAC(REAL_ARITH `a <= b ==> min x a <= min x b`) THEN + REWRITE_TAC[REAL_OF_NUM_LE] THEN ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `!x:A. x IN prob_carrier p ==> ((\n. (Xn:num->A->real) n x) ---> (f:A->real) x) sequentially` ASSUME_TAC THENL + [X_GEN_TAC `x:A` THEN DISCH_TAC THEN EXPAND_TAC "Xn" THEN + REWRITE_TAC[tendsto_real; EVENTUALLY_SEQUENTIALLY] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(ISPEC `(f:A->real) x` REAL_ARCH_SIMPLE) THEN + DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN + EXISTS_TAC `N:num` THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN + SUBGOAL_THEN `min ((f:A->real) x) (&m) = f x` SUBST1_TAC THENL + [MATCH_MP_TAC(REAL_ARITH `x <= n ==> min x n = x`) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&N` THEN + ASM_REWRITE_TAC[REAL_OF_NUM_LE]; + ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN `((\n:num. nn_expectation p ((Xn:num->A->real) n)) ---> nn_expectation p (f:A->real)) sequentially` ASSUME_TAC THENL + [MP_TAC(SPECL [`p:A prob_space`; `Xn:num->A->real`; `f:A->real`] MCT_NN_EXPECTATION) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [MP_TAC(SPECL [`p:A prob_space`; `f:A->real`] NN_EXPECTATION_INTEGRABLE_BOUND) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `Bf:real`) THEN + EXISTS_TAC `Bf:real` THEN GEN_TAC THEN + MP_TAC(SPECL [`p:A prob_space`; `(Xn:num->A->real) n`; `f:A->real`] NN_EXPECTATION_MONO) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN + X_GEN_TAC `x:A` THEN DISCH_TAC THEN EXPAND_TAC "Xn" THEN REAL_ARITH_TAC; + DISCH_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `nn_expectation (p:A prob_space) (f:A->real)` THEN + ASM_REWRITE_TAC[]]; + REWRITE_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN `!n:num. nn_expectation p (\x:A. (Xn:num->A->real) n (tt x)) = nn_expectation p (Xn n)` ASSUME_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC NN_EXPECTATION_COMP_PRESERVED_BOUNDED THEN + EXISTS_TAC `&n` THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL [ASM_MESON_TAC[integrable]; ALL_TAC] THEN + X_GEN_TAC `x:A` THEN DISCH_TAC THEN EXPAND_TAC "Xn" THEN REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `!n:num. integrable p (\x:A. (Xn:num->A->real) n (tt x))` ASSUME_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC INTEGRABLE_BOUNDED THEN + EXISTS_TAC `&n` THEN CONJ_TAC THENL + [SUBGOAL_THEN `(\x:A. (Xn:num->A->real) n (tt x)) = (\x. min ((f:A->real)(tt x)) (&n))` SUBST1_TAC THENL + [EXPAND_TAC "Xn" THEN REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC RANDOM_VARIABLE_MIN THEN + REWRITE_TAC[RANDOM_VARIABLE_CONST] THEN + MATCH_MP_TAC RANDOM_VARIABLE_COMP_MP THEN ASM_MESON_TAC[integrable]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN EXPAND_TAC "Xn" THEN + SUBGOAL_THEN `(tt:A->A) x IN prob_carrier p` ASSUME_TAC THENL + [MP_TAC(SPECL [`p:A prob_space`; `tt:A->A`] MEASURE_PRESERVING_CARRIER) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + MP_TAC(REAL_ARITH `&0 <= (f:A->real)((tt:A->A) x) ==> abs(min (f(tt x)) (&n)) <= &n`) THEN + ASM_SIMP_TAC[]]]; + ALL_TAC] THEN + SUBGOAL_THEN `((\n:num. nn_expectation p (\x:A. (Xn:num->A->real) n (tt x))) ---> nn_expectation p (\x. (f:A->real)(tt x))) sequentially` ASSUME_TAC THENL + [MP_TAC(SPECL [`p:A prob_space`; `\n:num. (\x:A. (Xn:num->A->real) n (tt x))`; `\x:A. (f:A->real)(tt x)`] MCT_NN_EXPECTATION) THEN + REWRITE_TAC[] THEN ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [GEN_TAC THEN X_GEN_TAC `x:A` THEN DISCH_TAC THEN + SUBGOAL_THEN `(tt:A->A) x IN prob_carrier p` MP_TAC THENL + [MP_TAC(SPECL [`p:A prob_space`; `tt:A->A`] MEASURE_PRESERVING_CARRIER) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + ASM_SIMP_TAC[]]; + GEN_TAC THEN X_GEN_TAC `x:A` THEN DISCH_TAC THEN + SUBGOAL_THEN `(tt:A->A) x IN prob_carrier p` MP_TAC THENL + [MP_TAC(SPECL [`p:A prob_space`; `tt:A->A`] MEASURE_PRESERVING_CARRIER) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + ASM_SIMP_TAC[]]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + SUBGOAL_THEN `(tt:A->A) x IN prob_carrier p` MP_TAC THENL + [MP_TAC(SPECL [`p:A prob_space`; `tt:A->A`] MEASURE_PRESERVING_CARRIER) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + DISCH_TAC THEN + UNDISCH_TAC `!x:A. x IN prob_carrier p ==> ((\n. (Xn:num->A->real) n x) ---> (f:A->real) x) sequentially` THEN + DISCH_THEN(MP_TAC o SPEC `(tt:A->A) x`) THEN ASM_REWRITE_TAC[]]; + MP_TAC(SPECL [`p:A prob_space`; `f:A->real`] NN_EXPECTATION_INTEGRABLE_BOUND) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `Bf:real`) THEN + EXISTS_TAC `Bf:real` THEN GEN_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `nn_expectation (p:A prob_space) ((Xn:num->A->real) n)` THEN + CONJ_TAC THENL [ASM_REWRITE_TAC[REAL_LE_REFL]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `nn_expectation (p:A prob_space) (f:A->real)` THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(SPECL [`p:A prob_space`; `(Xn:num->A->real) n`; `f:A->real`] NN_EXPECTATION_MONO) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN + X_GEN_TAC `x:A` THEN DISCH_TAC THEN EXPAND_TAC "Xn" THEN REAL_ARITH_TAC; + REWRITE_TAC[]]]; + REWRITE_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN `(\n:num. nn_expectation p (\x:A. (Xn:num->A->real) n (tt x))) = (\n. nn_expectation p (Xn n))` ASSUME_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MP_TAC(ISPECL [`sequentially`; `\n:num. nn_expectation (p:A prob_space) ((Xn:num->A->real) n)`; `nn_expectation (p:A prob_space) (\x:A. (f:A->real)(tt x))`; `nn_expectation (p:A prob_space) (f:A->real)`] REALLIM_UNIQUE) THEN + REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_MESON_TAC[]);; + +(* Integrability preserved under composition with tt *) +let INTEGRABLE_COMP_MP = prove + (`!p:A prob_space tt f. + measure_preserving p tt /\ integrable p f + ==> integrable p (\x. f(tt x))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[integrable] THEN CONJ_TAC THENL + [MATCH_MP_TAC RANDOM_VARIABLE_COMP_MP THEN ASM_MESON_TAC[integrable]; + ALL_TAC] THEN + UNDISCH_TAC `integrable (p:A prob_space) (f:A->real)` THEN + GEN_REWRITE_TAC LAND_CONV [integrable] THEN STRIP_TAC THEN + EXISTS_TAC `B:real` THEN REPEAT STRIP_TAC THEN + SUBGOAL_THEN `?M. &0 <= M /\ !x:A. x IN prob_carrier p ==> (g:A->real) x <= M` (X_CHOOSE_THEN `M:real` STRIP_ASSUME_TAC) THENL + [UNDISCH_TAC `simple_rv (p:A prob_space) (g:A->real)` THEN + REWRITE_TAC[simple_rv] THEN STRIP_TAC THEN + ASM_CASES_TAC `prob_carrier (p:A prob_space) = {}` THENL + [EXISTS_TAC `&0` THEN REWRITE_TAC[REAL_LE_REFL] THEN + REPEAT STRIP_TAC THEN + UNDISCH_TAC `(x:A) IN prob_carrier p` THEN ASM_REWRITE_TAC[NOT_IN_EMPTY]; + ALL_TAC] THEN + SUBGOAL_THEN `~({(g:A->real) x | x IN prob_carrier p} = {})` ASSUME_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY; NOT_FORALL_THM] THEN + UNDISCH_TAC `~(prob_carrier (p:A prob_space) = {})` THEN + REWRITE_TAC[EXTENSION; NOT_IN_EMPTY; NOT_FORALL_THM] THEN + DISCH_THEN(X_CHOOSE_TAC `z:A`) THEN EXISTS_TAC `(g:A->real) z` THEN + EXISTS_TAC `z:A` THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + EXISTS_TAC `sup {(g:A->real) x | x IN prob_carrier p}` THEN + MP_TAC(ISPEC `{(g:A->real) x | x IN prob_carrier p}` SUP_FINITE) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN CONJ_TAC THENL + [UNDISCH_TAC `sup {(g:A->real) x | x IN prob_carrier p} IN {g x | x IN prob_carrier p}` THEN + REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN(X_CHOOSE_THEN `y:A` STRIP_ASSUME_TAC) THEN + ASM_SIMP_TAC[]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(g:A->real) x`) THEN + REWRITE_TAC[IN_ELIM_THM] THEN + ANTS_TAC THENL [EXISTS_TAC `x:A` THEN ASM_REWRITE_TAC[]; REAL_ARITH_TAC]]; + ALL_TAC] THEN + SUBGOAL_THEN `simple_expectation p (g:A->real) <= nn_expectation p (\x:A. min (abs((f:A->real)(tt x))) M)` ASSUME_TAC THENL + [SUBGOAL_THEN `simple_rv (p:A prob_space) (g:A->real) /\ + (!x:A. x IN prob_carrier p ==> &0 <= g x) /\ + (!x. x IN prob_carrier p ==> g x <= min (abs((f:A->real)((tt:A->A) x))) M) /\ + (?B'. !x. x IN prob_carrier p ==> min (abs (f(tt x))) M <= B')` MP_TAC THENL + [ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [X_GEN_TAC `x:A` THEN DISCH_TAC THEN + REWRITE_TAC[REAL_LE_MIN] THEN ASM_SIMP_TAC[]; + EXISTS_TAC `M:real` THEN X_GEN_TAC `x:A` THEN DISCH_TAC THEN + REAL_ARITH_TAC]; + DISCH_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `g:A->real`; `\x:A. min (abs((f:A->real)((tt:A->A) x))) M`] BOUNDED_NN_EXPECTATION_GE_SIMPLE) THEN + REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN `nn_expectation p (\x:A. min (abs((f:A->real)(tt x))) M) = nn_expectation p (\x. min (abs(f x)) M)` ASSUME_TAC THENL + [SUBGOAL_THEN `(\x:A. min (abs((f:A->real)((tt:A->A) x))) M) = (\x. (\y. min (abs(f y)) M)(tt x))` SUBST1_TAC THENL + [REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC NN_EXPECTATION_COMP_PRESERVED_BOUNDED THEN + EXISTS_TAC `M:real` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC RANDOM_VARIABLE_MIN THEN REWRITE_TAC[RANDOM_VARIABLE_CONST] THEN + MATCH_MP_TAC RANDOM_VARIABLE_ABS THEN ASM_REWRITE_TAC[]; + CONJ_TAC THENL + [X_GEN_TAC `x:A` THEN DISCH_TAC THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= a /\ &0 <= b ==> &0 <= min a b`) THEN + ASM_REWRITE_TAC[REAL_ABS_POS]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN REAL_ARITH_TAC]]; + ALL_TAC] THEN + SUBGOAL_THEN `nn_expectation p (\x:A. min (abs((f:A->real) x)) M) <= B` MP_TAC THENL + [MP_TAC(SPECL [`p:A prob_space`; `\x:A. min (abs((f:A->real) x)) M`; `B:real`] NN_EXPECTATION_LE_FROM_SIMPLE) THEN + REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL + [X_GEN_TAC `x:A` THEN DISCH_TAC THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= a /\ &0 <= b ==> &0 <= min a b`) THEN + ASM_REWRITE_TAC[REAL_ABS_POS]; + X_GEN_TAC `h:A->real` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `h:A->real`) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `min (abs((f:A->real) x)) M` THEN + CONJ_TAC THENL [ASM_SIMP_TAC[]; REAL_ARITH_TAC]]; + ASM_REAL_ARITH_TAC]);; + +(* Expectation is preserved under composition with tt *) +let EXPECTATION_COMP_PRESERVED = prove + (`!p:A prob_space tt f. measure_preserving p tt /\ integrable p f + ==> integrable p (\x. f(tt x)) /\ + expectation p (\x. f(tt x)) = expectation p f`, + REPEAT STRIP_TAC THENL + [MATCH_MP_TAC INTEGRABLE_COMP_MP THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[expectation] THEN + SUBGOAL_THEN `nn_expectation p (\x:A. max ((f:A->real)(tt x)) (&0)) = nn_expectation p (\x. max (f x) (&0))` ASSUME_TAC THENL + [SUBGOAL_THEN `(\x:A. max ((f:A->real)((tt:A->A) x)) (&0)) = (\x. (\y. max (f y) (&0))(tt x))` SUBST1_TAC THENL + [REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC NN_EXPECTATION_COMP_PRESERVED THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [MATCH_MP_TAC RANDOM_VARIABLE_MAX THEN REWRITE_TAC[RANDOM_VARIABLE_CONST] THEN + ASM_MESON_TAC[integrable]; + CONJ_TAC THENL + [X_GEN_TAC `x:A` THEN DISCH_TAC THEN REAL_ARITH_TAC; + MATCH_MP_TAC INTEGRABLE_POS_PART THEN ASM_REWRITE_TAC[]]]; + ALL_TAC] THEN + SUBGOAL_THEN `nn_expectation p (\x:A. max (--((f:A->real)(tt x))) (&0)) = nn_expectation p (\x. max (--f x) (&0))` ASSUME_TAC THENL + [SUBGOAL_THEN `(\x:A. max (--((f:A->real)((tt:A->A) x))) (&0)) = (\x. (\y. max (--f y) (&0))(tt x))` SUBST1_TAC THENL + [REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC NN_EXPECTATION_COMP_PRESERVED THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [MATCH_MP_TAC RANDOM_VARIABLE_MAX THEN REWRITE_TAC[RANDOM_VARIABLE_CONST] THEN + MATCH_MP_TAC RANDOM_VARIABLE_NEG THEN ASM_MESON_TAC[integrable]; + CONJ_TAC THENL + [X_GEN_TAC `x:A` THEN DISCH_TAC THEN REAL_ARITH_TAC; + MATCH_MP_TAC INTEGRABLE_NEG_PART THEN ASM_REWRITE_TAC[]]]; + ALL_TAC] THEN + ASM_REWRITE_TAC[]);; + +(* Expectation is preserved under composition with ITER n tt *) +let EXPECTATION_ITER_COMP_PRESERVED = prove + (`!p:A prob_space tt f n. measure_preserving p tt /\ integrable p f + ==> integrable p (\x. f(ITER n tt x)) /\ + expectation p (\x. f(ITER n tt x)) = expectation p f`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(SPECL [`p:A prob_space`; `ITER n (tt:A->A)`; `f:A->real`] + EXPECTATION_COMP_PRESERVED) THEN + ANTS_TAC THENL + [ASM_SIMP_TAC[MEASURE_PRESERVING_ITER]; REWRITE_TAC[]]);; + +(* Ergodic sum is integrable *) +let ERGODIC_SUM_INTEGRABLE = prove + (`!p:A prob_space tt f n. measure_preserving p tt /\ integrable p f + ==> integrable p (\x. sum(0..n) (\k. f(ITER k tt x)))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRABLE_SUM THEN + X_GEN_TAC `i:num` THEN DISCH_TAC THEN + MP_TAC(SPECL [`p:A prob_space`; `tt:A->A`; `f:A->real`; `i:num`] + EXPECTATION_ITER_COMP_PRESERVED) THEN + ASM_REWRITE_TAC[] THEN MESON_TAC[]);; + +(* Expectation of ergodic sum *) +let ERGODIC_SUM_EXPECTATION = prove + (`!p:A prob_space tt f n. measure_preserving p tt /\ integrable p f + ==> expectation p (\x. sum(0..n) (\k. f(ITER k tt x))) = + &(SUC n) * expectation p f`, + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`p:A prob_space`; `\k:num. (\x:A. (f:A->real)(ITER k tt x))`; + `n:num`] EXPECTATION_SUM) THEN + ANTS_TAC THENL + [X_GEN_TAC `i:num` THEN DISCH_TAC THEN + MP_TAC(SPECL [`p:A prob_space`; `tt:A->A`; `f:A->real`; `i:num`] + EXPECTATION_ITER_COMP_PRESERVED) THEN + ASM_REWRITE_TAC[] THEN MESON_TAC[]; + REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + SUBGOAL_THEN `(\i:num. expectation p (\x:A. (f:A->real)(ITER i tt x))) = + (\i. expectation p f)` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `i:num` THEN + MP_TAC(SPECL [`p:A prob_space`; `tt:A->A`; `f:A->real`; `i:num`] + EXPECTATION_ITER_COMP_PRESERVED) THEN + ASM_REWRITE_TAC[] THEN MESON_TAC[]; + REWRITE_TAC[SUM_CONST_NUMSEG; SUB_0; ADD1] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_SUC]]]);; + +(* Ergodic average is integrable *) +let ERGODIC_AVG_INTEGRABLE = prove + (`!p:A prob_space tt f n. measure_preserving p tt /\ integrable p f + ==> integrable p (\x. inv(&(SUC n)) * sum(0..n) (\k. f(ITER k tt x)))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRABLE_CMUL THEN + MATCH_MP_TAC ERGODIC_SUM_INTEGRABLE THEN ASM_REWRITE_TAC[]);; + +(* Expectation of ergodic average equals expectation of f *) +let ERGODIC_AVG_EXPECTATION = prove + (`!p:A prob_space tt f n. measure_preserving p tt /\ integrable p f + ==> expectation p (\x. inv(&(SUC n)) * sum(0..n) (\k. f(ITER k tt x))) = + expectation p f`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `integrable p (\x:A. sum (0..n) (\k. (f:A->real) (ITER k tt x)))` + ASSUME_TAC THENL + [MATCH_MP_TAC ERGODIC_SUM_INTEGRABLE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MP_TAC(SPECL [`p:A prob_space`; `inv(&(SUC n))`; + `\x:A. sum (0..n) (\k. (f:A->real) (ITER k tt x))`] EXPECTATION_CMUL) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + MP_TAC(SPECL [`p:A prob_space`; `tt:A->A`; `f:A->real`; `n:num`] + ERGODIC_SUM_EXPECTATION) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN + MP_TAC(SPEC `&(SUC n)` REAL_MUL_LINV) THEN + REWRITE_TAC[REAL_OF_NUM_EQ; NOT_SUC] THEN + DISCH_THEN(fun th -> REWRITE_TAC[th; REAL_MUL_LID]));; + +(* Invariant events form a sub-sigma-algebra *) +let INVARIANT_EVENTS_SUB_SIGMA_ALGEBRA = prove + (`!p:A prob_space tt. measure_preserving p tt + ==> sub_sigma_algebra p {A | invariant_event p tt A}`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `UNIONS {A:A->bool | invariant_event p tt A} = prob_carrier p` ASSUME_TAC THENL + [MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET; IN_UNIONS; IN_ELIM_THM] THEN + X_GEN_TAC `x:A` THEN DISCH_THEN(X_CHOOSE_THEN `A:A->bool` STRIP_ASSUME_TAC) THEN + UNDISCH_TAC `invariant_event (p:A prob_space) (tt:A->A) (A:A->bool)` THEN + REWRITE_TAC[invariant_event] THEN STRIP_TAC THEN + MP_TAC(SPECL [`p:A prob_space`; `A:A->bool`] PROB_EVENT_SUBSET) THEN + ASM_REWRITE_TAC[SUBSET] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET; IN_UNIONS; IN_ELIM_THM] THEN + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + EXISTS_TAC `prob_carrier (p:A prob_space)` THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[invariant_event; PROB_CARRIER_IN_EVENTS] THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `y:A` THEN EQ_TAC THENL + [MESON_TAC[]; + DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + MP_TAC(SPECL [`p:A prob_space`; `tt:A->A`] MEASURE_PRESERVING_CARRIER) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]]; + ALL_TAC] THEN + REWRITE_TAC[sub_sigma_algebra] THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [ALL_TAC; + REWRITE_TAC[SUBSET; IN_ELIM_THM; invariant_event] THEN MESON_TAC[]] THEN + REWRITE_TAC[sigma_algebra; IN_ELIM_THM] THEN ASM_REWRITE_TAC[] THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[invariant_event; PROB_CARRIER_IN_EVENTS] THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `y:A` THEN EQ_TAC THENL + [MESON_TAC[]; + DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + MP_TAC(SPECL [`p:A prob_space`; `tt:A->A`] MEASURE_PRESERVING_CARRIER) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]; + X_GEN_TAC `a:A->bool` THEN REWRITE_TAC[invariant_event] THEN STRIP_TAC THEN + CONJ_TAC THENL + [REWRITE_TAC[prob_carrier] THEN MATCH_MP_TAC SIGMA_ALGEBRA_COMPL THEN + REWRITE_TAC[PROB_SPACE_SIGMA_ALGEBRA; GSYM prob_carrier] THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_DIFF] THEN X_GEN_TAC `x:A` THEN + MP_TAC(SPECL [`p:A prob_space`; `tt:A->A`] MEASURE_PRESERVING_CARRIER) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + SUBGOAL_THEN `!y:A. y IN prob_carrier p /\ (tt:A->A) y IN a <=> y IN a` + ASSUME_TAC THENL + [GEN_TAC THEN + UNDISCH_TAC `{x:A | x IN prob_carrier p /\ tt x IN a} = a` THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN MESON_TAC[]; + EQ_TAC THENL + [STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]]]]; + X_GEN_TAC `s:(A->bool)->bool` THEN STRIP_TAC THEN + REWRITE_TAC[invariant_event] THEN CONJ_TAC THENL + [MP_TAC(SPECL [`prob_events (p:A prob_space)`; `s:(A->bool)->bool`] SIGMA_ALGEBRA_UNION_COUNTABLE) THEN + ASM_REWRITE_TAC[PROB_SPACE_SIGMA_ALGEBRA] THEN + DISCH_THEN MATCH_MP_TAC THEN + UNDISCH_TAC `(s:(A->bool)->bool) SUBSET {A | invariant_event p tt A}` THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM; invariant_event] THEN MESON_TAC[]; + REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_UNIONS] THEN X_GEN_TAC `x:A` THEN + EQ_TAC THENL + [STRIP_TAC THEN + SUBGOAL_THEN `invariant_event (p:A prob_space) (tt:A->A) (t:A->bool)` MP_TAC THENL + [UNDISCH_TAC `(s:(A->bool)->bool) SUBSET {A | invariant_event p tt A}` THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[invariant_event] THEN STRIP_TAC THEN + EXISTS_TAC `t:A->bool` THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `{x:A | x IN prob_carrier p /\ tt x IN t} = t` THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN + DISCH_THEN(MP_TAC o SPEC `x:A`) THEN ASM_REWRITE_TAC[] THEN MESON_TAC[]]; + STRIP_TAC THEN + SUBGOAL_THEN `invariant_event (p:A prob_space) (tt:A->A) (t:A->bool)` MP_TAC THENL + [UNDISCH_TAC `(s:(A->bool)->bool) SUBSET {A | invariant_event p tt A}` THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[invariant_event] THEN STRIP_TAC THEN + SUBGOAL_THEN `(x:A) IN prob_carrier p` ASSUME_TAC THENL + [MP_TAC(SPECL [`p:A prob_space`; `t:A->bool`] PROB_EVENT_SUBSET) THEN + ASM_REWRITE_TAC[SUBSET] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[] THEN + EXISTS_TAC `t:A->bool` THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `{x:A | x IN prob_carrier p /\ (tt:A->A) x IN t} = t` THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN + DISCH_THEN(MP_TAC o SPEC `x:A`) THEN ASM_REWRITE_TAC[] THEN MESON_TAC[]]]]]]);; + +(* ------------------------------------------------------------------------- *) +(* Maximal Ergodic Lemma (Garsia's proof) *) +(* *) +(* Key idea: Define M_n(x) = max(0, S_1(f)(x), ..., S_n(f)(x)). *) +(* On A_n = {M_n > 0}: f(x) >= M_n(x) - M_n(T(x)). *) +(* Integrating: int_An f >= int_Omega M_n - int_Omega M_n(T) = 0. *) +(* ------------------------------------------------------------------------- *) + +(* The running max of partial sums: max(0, S_1, S_2, ..., S_{n+1}) *) +let ergodic_maxsum = define + `(ergodic_maxsum (f:A->real) (tt:A->A) 0 x = max (f x) (&0)) /\ + (ergodic_maxsum f tt (SUC n) x = + max (ergodic_maxsum f tt n x) + (sum(0..SUC n) (\k. f(ITER k tt x))))`;; + +(* M_n is non-negative *) +let ERGODIC_MAXSUM_POS = prove + (`!f:A->real tt n x. &0 <= ergodic_maxsum f tt n x`, + GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THENL + [REWRITE_TAC[ergodic_maxsum] THEN REAL_ARITH_TAC; + GEN_TAC THEN REWRITE_TAC[ergodic_maxsum] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:A`) THEN REAL_ARITH_TAC]);; + +(* Sum shift: relates sum at x to sum at (tt x) *) +let ERGODIC_SUM_SHIFT = prove + (`!f:A->real tt n x. + sum(0..SUC n) (\k. f(ITER k tt x)) = + f(x) + sum(0..n) (\k. f(ITER k tt (tt x)))`, + REPEAT GEN_TAC THEN + MP_TAC(SPECL [`\k. (f:A->real)(ITER k tt x)`; `0`; `SUC n`] SUM_CLAUSES_LEFT) THEN + REWRITE_TAC[LE_0; ITER; ADD_CLAUSES] THEN + DISCH_THEN SUBST1_TAC THEN AP_TERM_TAC THEN + SUBGOAL_THEN `sum (1..SUC n) (\k. (f:A->real) (ITER k tt x)) = + sum(0..n) (\k. f(ITER (k + 1) tt x))` SUBST1_TAC THENL + [MP_TAC(SPECL [`1`; `\k. (f:A->real)(ITER k tt x)`; `0`; `n:num`] SUM_OFFSET) THEN + REWRITE_TAC[ADD_CLAUSES; ADD1]; + MATCH_MP_TAC SUM_EQ_NUMSEG THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN + REWRITE_TAC[] THEN AP_TERM_TAC THEN + MP_TAC(SPECL [`tt:A->A`; `k:num`; `1`; `x:A`] ITER_ADD) THEN + REWRITE_TAC[ITER_1] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[ARITH_RULE `k + 1 = SUC k`; ITER]]);; + +(* Monotonicity of ergodic_maxsum *) +let ERGODIC_MAXSUM_MONO = prove + (`!f:A->real tt n x. ergodic_maxsum f tt n x <= ergodic_maxsum f tt (SUC n) x`, + REPEAT GEN_TAC THEN REWRITE_TAC[ergodic_maxsum] THEN REAL_ARITH_TAC);; + +(* ergodic_maxsum >= each partial sum *) +let ERGODIC_MAXSUM_GE_SUM = prove + (`!f:A->real tt n x. + sum(0..n) (\k. f(ITER k tt x)) <= ergodic_maxsum f tt n x`, + GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THENL + [REWRITE_TAC[ergodic_maxsum; SUM_SING_NUMSEG; ITER] THEN REAL_ARITH_TAC; + GEN_TAC THEN REWRITE_TAC[ergodic_maxsum] THEN REAL_ARITH_TAC]);; + +(* Key pointwise inequality: f(x) >= M_n(x) - M_n(T(x)) when M_n(x) > 0 *) +let ERGODIC_MAXSUM_KEY_INEQ = prove + (`!f:A->real tt n x. + ergodic_maxsum f tt n x > &0 + ==> f x >= ergodic_maxsum f tt n x - ergodic_maxsum f tt n (tt x)`, + GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THENL + [REWRITE_TAC[ergodic_maxsum; ITER] THEN REAL_ARITH_TAC; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + SUBGOAL_THEN `ergodic_maxsum (f:A->real) tt (SUC n) x = + max (ergodic_maxsum f tt n x) + (sum(0..SUC n) (\k. f(ITER k tt x)))` ASSUME_TAC THENL + [REWRITE_TAC[ergodic_maxsum]; ALL_TAC] THEN + SUBGOAL_THEN `ergodic_maxsum (f:A->real) tt (SUC n) (tt x) = + max (ergodic_maxsum f tt n (tt x)) + (sum(0..SUC n) (\k. f(ITER k tt (tt x))))` ASSUME_TAC THENL + [REWRITE_TAC[ergodic_maxsum]; ALL_TAC] THEN + SUBGOAL_THEN `sum(0..SUC n) (\k. (f:A->real)(ITER k tt x)) = + f x + sum(0..n) (\k. f(ITER k tt (tt x)))` ASSUME_TAC THENL + [REWRITE_TAC[ERGODIC_SUM_SHIFT]; ALL_TAC] THEN + SUBGOAL_THEN `sum(0..n) (\k. (f:A->real)(ITER k tt (tt x))) <= + ergodic_maxsum f tt n (tt x)` ASSUME_TAC THENL + [REWRITE_TAC[ERGODIC_MAXSUM_GE_SUM]; ALL_TAC] THEN + SUBGOAL_THEN `ergodic_maxsum (f:A->real) tt n (tt x) <= + ergodic_maxsum f tt (SUC n) (tt x)` ASSUME_TAC THENL + [ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; ALL_TAC] THEN + ASM_CASES_TAC `ergodic_maxsum (f:A->real) tt n x >= + sum(0..SUC n) (\k. f(ITER k tt x))` THENL + [SUBGOAL_THEN `ergodic_maxsum (f:A->real) tt (SUC n) x = + ergodic_maxsum f tt n x` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `ergodic_maxsum (f:A->real) tt n x > &0` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:A`) THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC; + SUBGOAL_THEN `ergodic_maxsum (f:A->real) tt (SUC n) x = + sum(0..SUC n) (\k. f(ITER k tt x))` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_REAL_ARITH_TAC]]);; + +(* ergodic_maxsum is a random variable *) +let ERGODIC_MAXSUM_RV = prove + (`!p:A prob_space tt f n. + measure_preserving p tt /\ integrable p f + ==> random_variable p (ergodic_maxsum f tt n)`, + GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THENL + [STRIP_TAC THEN + SUBGOAL_THEN `ergodic_maxsum (f:A->real) tt 0 = (\x. max (f x) (&0))` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; ergodic_maxsum]; ALL_TAC] THEN + MATCH_MP_TAC RANDOM_VARIABLE_MAX THEN + REWRITE_TAC[RANDOM_VARIABLE_CONST] THEN + ASM_MESON_TAC[integrable]; + STRIP_TAC THEN + SUBGOAL_THEN `random_variable (p:A prob_space) (ergodic_maxsum (f:A->real) tt n)` ASSUME_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `ergodic_maxsum (f:A->real) tt (SUC n) = + (\x. max (ergodic_maxsum f tt n x) (sum(0..SUC n) (\k. f(ITER k tt x))))` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; ergodic_maxsum]; ALL_TAC] THEN + MATCH_MP_TAC RANDOM_VARIABLE_MAX THEN CONJ_TAC THENL + [REWRITE_TAC[ETA_AX] THEN ASM_REWRITE_TAC[]; + MP_TAC(SPECL [`p:A prob_space`; `\i:num. (\x:A. (f:A->real)(ITER i tt x))`; `SUC n`] RANDOM_VARIABLE_SUM) THEN + REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + X_GEN_TAC `i:num` THEN DISCH_TAC THEN + MATCH_MP_TAC RANDOM_VARIABLE_ITER_COMP_MP THEN + ASM_MESON_TAC[integrable]]]);; + +(* ergodic_maxsum is integrable *) +let ERGODIC_MAXSUM_INTEGRABLE = prove + (`!p:A prob_space tt f n. + measure_preserving p tt /\ integrable p f + ==> integrable p (ergodic_maxsum f tt n)`, + GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THENL + [STRIP_TAC THEN + SUBGOAL_THEN `ergodic_maxsum (f:A->real) tt 0 = (\x. max (f x) (&0))` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; ergodic_maxsum]; ALL_TAC] THEN + MATCH_MP_TAC INTEGRABLE_MAX THEN ASM_REWRITE_TAC[INTEGRABLE_CONST]; + STRIP_TAC THEN + SUBGOAL_THEN `integrable (p:A prob_space) (ergodic_maxsum (f:A->real) tt n)` ASSUME_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `ergodic_maxsum (f:A->real) tt (SUC n) = + (\x. max (ergodic_maxsum f tt n x) (sum(0..SUC n) (\k. f(ITER k tt x))))` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; ergodic_maxsum]; ALL_TAC] THEN + MATCH_MP_TAC INTEGRABLE_MAX THEN CONJ_TAC THENL + [REWRITE_TAC[ETA_AX] THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC ERGODIC_SUM_INTEGRABLE THEN ASM_REWRITE_TAC[]]]);; + +(* The set {M_n > 0} is a measurable event *) +let ERGODIC_MAXSUM_POS_EVENT = prove + (`!p:A prob_space tt f n. + measure_preserving p tt /\ integrable p f + ==> {x | x IN prob_carrier p /\ ergodic_maxsum f tt n x > &0} IN prob_events p`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `random_variable (p:A prob_space) (ergodic_maxsum (f:A->real) tt n)` ASSUME_TAC THENL + [MATCH_MP_TAC ERGODIC_MAXSUM_RV THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `{x:A | x IN prob_carrier p /\ ergodic_maxsum (f:A->real) tt n x > &0} = + prob_carrier p DIFF {x | x IN prob_carrier p /\ ergodic_maxsum f tt n x <= &0}` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_DIFF; IN_ELIM_THM] THEN X_GEN_TAC `x:A` THEN + ASM_CASES_TAC `(x:A) IN prob_carrier p` THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + REWRITE_TAC[prob_carrier] THEN MATCH_MP_TAC SIGMA_ALGEBRA_COMPL THEN + REWRITE_TAC[PROB_SPACE_SIGMA_ALGEBRA] THEN + UNDISCH_TAC `random_variable (p:A prob_space) (ergodic_maxsum (f:A->real) tt n)` THEN + REWRITE_TAC[random_variable] THEN DISCH_THEN(MP_TAC o SPEC `&0`) THEN + REWRITE_TAC[GSYM prob_carrier]]);; + +(* The maximal ergodic lemma *) +let MAXIMAL_ERGODIC_LEMMA = prove + (`!p:A prob_space tt f n. + measure_preserving p tt /\ integrable p f + ==> &0 <= expectation p + (\x. f x * indicator_fn + {x | x IN prob_carrier p /\ + ergodic_maxsum f tt n x > &0} x)`, + REPEAT STRIP_TAC THEN + ABBREV_TAC `A = {x:A | x IN prob_carrier p /\ ergodic_maxsum (f:A->real) tt n x > &0}` THEN + SUBGOAL_THEN `A IN prob_events (p:A prob_space)` ASSUME_TAC THENL + [EXPAND_TAC "A" THEN MATCH_MP_TAC ERGODIC_MAXSUM_POS_EVENT THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `integrable (p:A prob_space) (ergodic_maxsum (f:A->real) tt n)` ASSUME_TAC THENL + [MATCH_MP_TAC ERGODIC_MAXSUM_INTEGRABLE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `integrable (p:A prob_space) (\x. ergodic_maxsum (f:A->real) tt n (tt x))` ASSUME_TAC THENL + [MATCH_MP_TAC INTEGRABLE_COMP_MP THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `integrable (p:A prob_space) (\x. (f:A->real) x * indicator_fn A x)` ASSUME_TAC THENL + [MATCH_MP_TAC INTEGRABLE_MUL_INDICATOR_FN THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `!x:A. x IN prob_carrier p ==> + ergodic_maxsum (f:A->real) tt n x - ergodic_maxsum f tt n (tt x) <= + f x * indicator_fn A x` ASSUME_TAC THENL + [X_GEN_TAC `x:A` THEN DISCH_TAC THEN + ASM_CASES_TAC `ergodic_maxsum (f:A->real) tt n x > &0` THENL + [SUBGOAL_THEN `(x:A) IN A` ASSUME_TAC THENL + [EXPAND_TAC "A" THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `indicator_fn (A:A->bool) x = &1` SUBST1_TAC THENL + [REWRITE_TAC[indicator_fn] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[REAL_MUL_RID] THEN + MP_TAC(SPECL [`f:A->real`; `tt:A->A`; `n:num`; `x:A`] ERGODIC_MAXSUM_KEY_INEQ) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + SUBGOAL_THEN `ergodic_maxsum (f:A->real) tt n x = &0` ASSUME_TAC THENL + [MP_TAC(SPECL [`f:A->real`; `tt:A->A`; `n:num`; `x:A`] ERGODIC_MAXSUM_POS) THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `~((x:A) IN A)` ASSUME_TAC THENL + [EXPAND_TAC "A" THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `indicator_fn (A:A->bool) x = &0` SUBST1_TAC THENL + [REWRITE_TAC[indicator_fn] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[REAL_MUL_RZERO] THEN + ASM_REWRITE_TAC[REAL_SUB_LZERO] THEN + MP_TAC(SPECL [`f:A->real`; `tt:A->A`; `n:num`; `(tt:A->A) x`] ERGODIC_MAXSUM_POS) THEN + REAL_ARITH_TAC]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `expectation (p:A prob_space) (\x. ergodic_maxsum (f:A->real) tt n x - ergodic_maxsum f tt n (tt x))` THEN + CONJ_TAC THENL + [SUBGOAL_THEN `expectation (p:A prob_space) (\x. ergodic_maxsum (f:A->real) tt n x - ergodic_maxsum f tt n (tt x)) = + expectation p (ergodic_maxsum f tt n) - expectation p (\x. ergodic_maxsum f tt n (tt x))` SUBST1_TAC THENL + [MP_TAC(SPECL [`p:A prob_space`; `ergodic_maxsum (f:A->real) tt n`; `\x:A. ergodic_maxsum (f:A->real) tt n (tt x)`] EXPECTATION_SUB) THEN + ASM_REWRITE_TAC[ETA_AX] THEN DISCH_THEN(fun th -> REWRITE_TAC[th]); + ALL_TAC] THEN + SUBGOAL_THEN `expectation (p:A prob_space) (\x. ergodic_maxsum (f:A->real) tt n (tt x)) = + expectation p (ergodic_maxsum f tt n)` SUBST1_TAC THENL + [MP_TAC(SPECL [`p:A prob_space`; `tt:A->A`; `ergodic_maxsum (f:A->real) tt n`] EXPECTATION_COMP_PRESERVED) THEN + ASM_REWRITE_TAC[] THEN MESON_TAC[]; + REAL_ARITH_TAC]; + MATCH_MP_TAC EXPECTATION_MONO THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC INTEGRABLE_SUB THEN ASM_REWRITE_TAC[ETA_AX]]);; + +(* Infinite-horizon maximal ergodic inequality: *) +(* E[f * 1_{exists n. M_n > 0}] >= 0 *) +(* Uses DOMINATED_CONVERGENCE to pass from finite to infinite horizon *) +let MAXIMAL_ERGODIC_INFINITE = prove + (`!p:A prob_space tt f. + measure_preserving p tt /\ integrable p f + ==> &0 <= expectation p + (\x. f x * indicator_fn + {x | x IN prob_carrier p /\ + ?n. ergodic_maxsum f tt n x > &0} x)`, + REPEAT STRIP_TAC THEN + ABBREV_TAC `Ainf = {x:A | x IN prob_carrier p /\ ?n. ergodic_maxsum (f:A->real) tt n x > &0}` THEN + SUBGOAL_THEN `(Ainf:A->bool) IN prob_events p` ASSUME_TAC THENL + [SUBGOAL_THEN `Ainf = UNIONS {({x:A | x IN prob_carrier p /\ ergodic_maxsum (f:A->real) tt n x > &0}) | n IN (:num)}` + SUBST1_TAC THENL + [EXPAND_TAC "Ainf" THEN SET_TAC[]; + MATCH_MP_TAC PROB_INDEXED_UNION_IN_EVENTS THEN + GEN_TAC THEN MATCH_MP_TAC ERGODIC_MAXSUM_POS_EVENT THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + MP_TAC(ISPECL [`p:A prob_space`; + `(\n:num. (\x:A. (f:A->real) x * indicator_fn {x | x IN prob_carrier p /\ ergodic_maxsum f tt n x > &0} x))`; + `(\x:A. (f:A->real) x * indicator_fn (Ainf:A->bool) x)`; + `(\x:A. abs((f:A->real) x))`] DOMINATED_CONVERGENCE) THEN + ANTS_TAC THENL + [BETA_TAC THEN CONJ_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC INTEGRABLE_MUL_INDICATOR_FN THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC ERGODIC_MAXSUM_POS_EVENT THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_ABS THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + CONJ_TAC THENL + [REPEAT GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[indicator_fn] THEN COND_CASES_TAC THEN REWRITE_TAC[] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + ASM_CASES_TAC `(x:A) IN Ainf` THENL + [SUBGOAL_THEN `?n0. ergodic_maxsum (f:A->real) tt n0 x > &0` STRIP_ASSUME_TAC THENL + [UNDISCH_TAC `(x:A) IN Ainf` THEN EXPAND_TAC "Ainf" THEN + REWRITE_TAC[IN_ELIM_THM] THEN MESON_TAC[]; + ALL_TAC] THEN + EXISTS_TAC `n0:num` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + SUBGOAL_THEN `ergodic_maxsum (f:A->real) tt n x > &0` ASSUME_TAC THENL + [SUBGOAL_THEN `ergodic_maxsum (f:A->real) tt n0 x <= ergodic_maxsum f tt n x` MP_TAC THENL + [MP_TAC(ISPECL [`\m n:num. ergodic_maxsum (f:A->real) tt m x <= ergodic_maxsum f tt n x`] TRANSITIVE_STEPWISE_LE) THEN + BETA_TAC THEN + ANTS_TAC THENL + [REWRITE_TAC[REAL_LE_REFL] THEN CONJ_TAC THENL + [REPEAT STRIP_TAC THEN ASM_REAL_ARITH_TAC; + GEN_TAC THEN REWRITE_TAC[ERGODIC_MAXSUM_MONO]]; + DISCH_THEN(MP_TAC o SPECL [`n0:num`; `n:num`]) THEN ASM_REWRITE_TAC[]]; + UNDISCH_TAC `ergodic_maxsum (f:A->real) tt n0 x > &0` THEN REAL_ARITH_TAC]; + SUBGOAL_THEN `indicator_fn {x:A | x IN prob_carrier p /\ ergodic_maxsum (f:A->real) tt n x > &0} x = &1` SUBST1_TAC THENL + [REWRITE_TAC[indicator_fn; IN_ELIM_THM] THEN + COND_CASES_TAC THENL [REFL_TAC; ASM_MESON_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN `indicator_fn (Ainf:A->bool) (x:A) = &1` SUBST1_TAC THENL + [REWRITE_TAC[indicator_fn] THEN ASM_REWRITE_TAC[]; + ASM_REAL_ARITH_TAC]]; + EXISTS_TAC `0` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + SUBGOAL_THEN `~((x:A) IN {x | x IN prob_carrier p /\ ergodic_maxsum (f:A->real) tt n x > &0})` ASSUME_TAC THENL + [REWRITE_TAC[IN_ELIM_THM] THEN + UNDISCH_TAC `~((x:A) IN Ainf)` THEN EXPAND_TAC "Ainf" THEN + REWRITE_TAC[IN_ELIM_THM] THEN MESON_TAC[]; + SUBGOAL_THEN `indicator_fn {x:A | x IN prob_carrier p /\ ergodic_maxsum (f:A->real) tt n x > &0} x = &0` SUBST1_TAC THENL + [REWRITE_TAC[indicator_fn] THEN + COND_CASES_TAC THENL [ASM_MESON_TAC[]; REFL_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN `indicator_fn (Ainf:A->bool) (x:A) = &0` SUBST1_TAC THENL + [REWRITE_TAC[indicator_fn] THEN ASM_REWRITE_TAC[]; + ASM_REAL_ARITH_TAC]]]; + ALL_TAC] THEN + STRIP_TAC THEN + MATCH_MP_TAC(ISPEC `sequentially` REALLIM_LBOUND) THEN + EXISTS_TAC `\n:num. expectation (p:A prob_space) (\x:A. (f:A->real) x * + indicator_fn {x | x IN prob_carrier p /\ ergodic_maxsum f tt n x > &0} x)` THEN + CONJ_TAC THENL + [UNDISCH_TAC `((\n. + expectation (p:A prob_space) + ((\n x. + (f:A->real) x * + indicator_fn + {x | x IN prob_carrier p /\ ergodic_maxsum f tt n x > &0} + x) + n)) ---> + expectation p (\x. f x * indicator_fn (Ainf:A->bool) x)) + sequentially` THEN + BETA_TAC THEN REWRITE_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `0` THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN BETA_TAC THEN + MATCH_MP_TAC MAXIMAL_ERGODIC_LEMMA THEN ASM_REWRITE_TAC[]);; + +(* Iterates stay in an invariant set *) +let ITER_IN_INVARIANT = prove + (`!p:A prob_space tt (A:A->bool) x k. + measure_preserving p tt /\ invariant_event p tt A /\ x IN A + ==> ITER k tt x IN A`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SPEC_TAC(`k:num`, `k:num`) THEN INDUCT_TAC THENL + [REWRITE_TAC[ITER] THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[ITER] THEN + UNDISCH_TAC `invariant_event (p:A prob_space) (tt:A->A) (A:A->bool)` THEN + REWRITE_TAC[invariant_event] THEN STRIP_TAC THEN + UNDISCH_TAC `{x:A | x IN prob_carrier p /\ tt x IN A} = A` THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN + DISCH_THEN(MP_TAC o SPEC `ITER k (tt:A->A) x`) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN ASM_MESON_TAC[]]);; + +(* MEL restricted to an invariant set: + If A is T-invariant and on A the partial sums of f are eventually positive, + then E[f * 1_A] >= 0 *) +let MEL_INVARIANT_SET = prove + (`!p:A prob_space tt f (A:A->bool). + measure_preserving p tt /\ integrable p f /\ + A IN prob_events p /\ invariant_event p tt A /\ + (!x. x IN A ==> ?n. sum(0..n) (\k. f(ITER k tt x)) > &0) + ==> &0 <= expectation p (\x. f x * indicator_fn A x)`, + REPEAT STRIP_TAC THEN + ABBREV_TAC `g = \x:A. (f:A->real) x * indicator_fn (A:A->bool) x` THEN + SUBGOAL_THEN `integrable (p:A prob_space) (g:A->real)` ASSUME_TAC THENL + [EXPAND_TAC "g" THEN MATCH_MP_TAC INTEGRABLE_MUL_INDICATOR_FN THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `!y:A. (g:A->real) y * + indicator_fn {x:A | x IN prob_carrier p /\ (?n. ergodic_maxsum g tt n x > &0)} y = g y` ASSUME_TAC THENL + [X_GEN_TAC `y:A` THEN + REWRITE_TAC[indicator_fn; IN_ELIM_THM] THEN + COND_CASES_TAC THENL [REWRITE_TAC[REAL_MUL_RID]; ALL_TAC] THEN + REWRITE_TAC[REAL_MUL_RZERO] THEN EXPAND_TAC "g" THEN BETA_TAC THEN + SUBGOAL_THEN `~((y:A) IN A)` ASSUME_TAC THENL + [DISCH_TAC THEN + UNDISCH_TAC `~((y:A) IN prob_carrier p /\ (?n. ergodic_maxsum (g:A->real) tt n y > &0))` THEN + REWRITE_TAC[] THEN CONJ_TAC THENL + [MP_TAC(SPECL [`p:A prob_space`; `A:A->bool`] PROB_EVENT_SUBSET) THEN + ASM_REWRITE_TAC[SUBSET] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + UNDISCH_TAC `!x:A. x IN A ==> (?n. sum (0..n) (\k. (f:A->real) (ITER k tt x)) > &0)` THEN + DISCH_THEN(MP_TAC o SPEC `y:A`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN EXISTS_TAC `n:num` THEN + SUBGOAL_THEN `sum(0..n) (\k. (g:A->real)(ITER k tt y)) = sum(0..n) (\k. (f:A->real)(ITER k tt y))` ASSUME_TAC THENL + [MATCH_MP_TAC SUM_EQ_NUMSEG THEN X_GEN_TAC `k:num` THEN DISCH_TAC THEN + EXPAND_TAC "g" THEN BETA_TAC THEN + SUBGOAL_THEN `indicator_fn (A:A->bool) (ITER k (tt:A->A) y) = &1` SUBST1_TAC THENL + [REWRITE_TAC[indicator_fn] THEN + SUBGOAL_THEN `ITER k (tt:A->A) y IN A` ASSUME_TAC THENL + [MP_TAC(ISPECL [`p:A prob_space`; `tt:A->A`; `A:A->bool`; `y:A`; `k:num`] ITER_IN_INVARIANT) THEN + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]]; + REWRITE_TAC[REAL_MUL_RID]]; + MP_TAC(ISPECL [`g:A->real`; `tt:A->A`; `n:num`; `y:A`] ERGODIC_MAXSUM_GE_SUM) THEN + ASM_REAL_ARITH_TAC]]; + REWRITE_TAC[indicator_fn] THEN ASM_REWRITE_TAC[REAL_MUL_RZERO]]; + ALL_TAC] THEN + MP_TAC(ISPECL [`p:A prob_space`; `tt:A->A`; `g:A->real`] MAXIMAL_ERGODIC_INFINITE) THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `(\x:A. (g:A->real) x * + indicator_fn {x | x IN prob_carrier p /\ (?n. ergodic_maxsum g tt n x > &0)} x) = g` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[ETA_AX]]);; + +(* Helper: real_limsup > b implies existence of a term > b (bounded case) *) +let REAL_LIMSUP_GT_EXISTS_BOUNDED = prove + (`!s:num->real b c B. (!n. c <= s n) /\ (!n. s n <= B) /\ + real_limsup s > b ==> ?n. s n > b`, + REPEAT GEN_TAC THEN + ONCE_REWRITE_TAC[TAUT `(p /\ q /\ r ==> s) <=> (p /\ q ==> r ==> s)`] THEN + STRIP_TAC THEN + ONCE_REWRITE_TAC[TAUT `p ==> q <=> ~q ==> ~p`] THEN + REWRITE_TAC[NOT_EXISTS_THM; real_gt; REAL_NOT_LT] THEN + DISCH_TAC THEN REWRITE_TAC[real_limsup] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sup {(s:num->real) k | k >= 0}` THEN CONJ_TAC THENL + [MATCH_MP_TAC INF_LE_ELEMENT THEN CONJ_TAC THENL + [EXISTS_TAC `c:real` THEN REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`{(s:num->real) k | k >= n}`; `c:real`; `B:real`; `(s:num->real) n`] + REAL_LE_SUP) THEN + ANTS_TAC THENL + [REWRITE_TAC[IN_ELIM_THM] THEN CONJ_TAC THENL + [EXISTS_TAC `n:num` THEN REWRITE_TAC[GE; LE_REFL]; + CONJ_TAC THENL [ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]]]; + ASM_REAL_ARITH_TAC]; + REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN EXISTS_TAC `0` THEN REFL_TAC]; + MATCH_MP_TAC REAL_SUP_LE THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + EXISTS_TAC `(s:num->real) 0` THEN EXISTS_TAC `0` THEN REWRITE_TAC[GE; LE_REFL]; + REWRITE_TAC[IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]]]);; + +(* Helper: real_liminf < a implies existence of a term < a (bounded case) *) +let REAL_LIMINF_LT_EXISTS_BOUNDED = prove + (`!s:num->real a c B. (!n. c <= s n) /\ (!n. s n <= B) /\ + real_liminf s < a ==> ?n. s n < a`, + REPEAT GEN_TAC THEN + ONCE_REWRITE_TAC[TAUT `(p /\ q /\ r ==> s) <=> (p /\ q ==> r ==> s)`] THEN + STRIP_TAC THEN + ONCE_REWRITE_TAC[TAUT `p ==> q <=> ~q ==> ~p`] THEN + REWRITE_TAC[NOT_EXISTS_THM; REAL_NOT_LT] THEN + DISCH_TAC THEN REWRITE_TAC[real_liminf] THEN + MP_TAC(ISPECL [`{inf {(s:num->real) k | k >= n} | n IN (:num)}`; `a:real`; `B:real`; + `inf {(s:num->real) k | k >= 0}`] REAL_LE_SUP) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN EXISTS_TAC `0` THEN REFL_TAC; + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INF THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + EXISTS_TAC `(s:num->real) 0` THEN EXISTS_TAC `0` THEN REWRITE_TAC[GE; LE_REFL]; + REWRITE_TAC[IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]]; + REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(s:num->real) n` THEN CONJ_TAC THENL + [MATCH_MP_TAC INF_LE_ELEMENT THEN CONJ_TAC THENL + [EXISTS_TAC `c:real` THEN REWRITE_TAC[IN_ELIM_THM] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; + REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `n:num` THEN REWRITE_TAC[GE; LE_REFL]]; + ASM_REWRITE_TAC[]]]]; + SIMP_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Birkhoff's Ergodic Theorem: almost sure convergence of ergodic averages *) +(* ------------------------------------------------------------------------- *) + +(* Helper: average > b implies sum of (f-b) > 0 *) +let AVG_GT_IMP_SUM_POS = prove + (`!f:A->real tt (x:A) b n. + inv(&(SUC n)) * sum(0..n) (\k. f(ITER k tt x)) > b + ==> sum(0..n) (\k. f(ITER k tt x) - b) > &0`, + REPEAT GEN_TAC THEN REWRITE_TAC[real_gt] THEN DISCH_TAC THEN + REWRITE_TAC[SUM_SUB_NUMSEG; SUM_CONST_NUMSEG; SUB_0; ADD1] THEN + REWRITE_TAC[GSYM ADD1] THEN + ABBREV_TAC `S = sum(0..n) (\k. (f:A->real)(ITER k tt x))` THEN + SUBGOAL_THEN `&0 < &(SUC n)` ASSUME_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_LT] THEN ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `~(&(SUC n) = &0)` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `&(SUC n) * b < S` MP_TAC THENL + [MP_TAC(SPECL [`b:real`; `inv(&(SUC n)) * S`; `&(SUC n)`] REAL_LT_LMUL_EQ) THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN + ASM_SIMP_TAC[REAL_MUL_RINV] THEN + REWRITE_TAC[REAL_MUL_LID] THEN SIMP_TAC[]; + ASM_REAL_ARITH_TAC]);; + +(* Helper: average < a implies sum of (a-f) > 0 *) +let AVG_LT_IMP_SUM_POS = prove + (`!f:A->real tt (x:A) a n. + inv(&(SUC n)) * sum(0..n) (\k. f(ITER k tt x)) < a + ==> sum(0..n) (\k. a - f(ITER k tt x)) > &0`, + REPEAT GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[real_gt] THEN + REWRITE_TAC[SUM_SUB_NUMSEG; SUM_CONST_NUMSEG; SUB_0; ADD1] THEN + REWRITE_TAC[GSYM ADD1] THEN + ABBREV_TAC `S = sum(0..n) (\k. (f:A->real)(ITER k tt x))` THEN + SUBGOAL_THEN `&0 < &(SUC n)` ASSUME_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_LT] THEN ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `~(&(SUC n) = &0)` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `S < &(SUC n) * a` MP_TAC THENL + [MP_TAC(SPECL [`inv(&(SUC n)) * S`; `a:real`; `&(SUC n)`] REAL_LT_LMUL_EQ) THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN + ASM_SIMP_TAC[REAL_MUL_RINV] THEN + REWRITE_TAC[REAL_MUL_LID] THEN SIMP_TAC[]; + ASM_REAL_ARITH_TAC]);; + +(* Helper: ergodic averages are bounded by C when f is bounded by C *) +let ERGODIC_AVG_BOUNDED = prove + (`!p:A prob_space tt f C n x. + measure_preserving p tt /\ + (!x. x IN prob_carrier p ==> abs(f x) <= C) /\ + x IN prob_carrier p + ==> abs(inv(&(SUC n)) * sum(0..n) (\k. f(ITER k tt x))) <= C`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_INV; REAL_ABS_NUM] THEN + SUBGOAL_THEN `!k:num. ITER k (tt:A->A) x IN prob_carrier p` ASSUME_TAC THENL + [GEN_TAC THEN + SUBGOAL_THEN `measure_preserving (p:A prob_space) (ITER k tt)` MP_TAC THENL + [MATCH_MP_TAC MEASURE_PRESERVING_ITER THEN ASM_REWRITE_TAC[]; + DISCH_THEN(MP_TAC o MATCH_MP MEASURE_PRESERVING_CARRIER) THEN + DISCH_THEN(MP_TAC o SPEC `x:A`) THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN + SUBGOAL_THEN `~(&(SUC n) = &0)` ASSUME_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_EQ; NOT_SUC]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `inv(&(SUC n)) * (&(SUC n) * C)` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_LE_INV_EQ; REAL_POS]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(0..n) (\k. abs((f:A->real)(ITER k tt x)))` THEN CONJ_TAC THENL + [REWRITE_TAC[SUM_ABS_NUMSEG]; + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(0..n) (\k:num. C:real)` THEN CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE_NUMSEG THEN REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN REWRITE_TAC[] THEN + DISCH_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[SUM_CONST_NUMSEG; SUB_0; ADD1] THEN REAL_ARITH_TAC]]; + ASM_SIMP_TAC[REAL_MUL_ASSOC; REAL_MUL_LINV; REAL_MUL_LID; REAL_LE_REFL]]);; + +(* Telescoping identity: avg_n(tt x) - avg_n(x) = inv(n+1) * (f(T^{n+1}x) - f(x)) *) +let AVG_SHIFT_DIFF = prove + (`!f:A->real tt (x:A) n. + inv(&(SUC n)) * sum(0..n) (\k. f(ITER k tt (tt x))) - + inv(&(SUC n)) * sum(0..n) (\k. f(ITER k tt x)) = + inv(&(SUC n)) * (f(ITER (SUC n) tt x) - f(x))`, + REPEAT GEN_TAC THEN + REWRITE_TAC[GSYM REAL_SUB_LDISTRIB] THEN AP_TERM_TAC THEN + SUBGOAL_THEN `!k. (f:A->real)(ITER k tt (tt x)) = f(ITER (SUC k) tt x)` + (fun th -> REWRITE_TAC[th]) THENL + [GEN_TAC THEN AP_TERM_TAC THEN + MP_TAC(SPECL [`tt:A->A`; `k:num`; `1`; `x:A`] ITER_ADD) THEN + REWRITE_TAC[ITER_1; ADD_SYM; GSYM ADD1] THEN SIMP_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[GSYM SUM_SUB_NUMSEG] THEN + SPEC_TAC(`n:num`, `n:num`) THEN INDUCT_TAC THENL + [REWRITE_TAC[SUM_SING_NUMSEG; ITER; GSYM ADD1] THEN REAL_ARITH_TAC; + REWRITE_TAC[SUM_CLAUSES_NUMSEG; LE_0] THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[ITER] THEN REAL_ARITH_TAC]);; + +(* Measurability of the oscillation set *) +let ERGODIC_OSCILLATION_MEASURABLE = prove + (`!p:A prob_space tt f a b C. + measure_preserving p tt /\ integrable p f /\ a < b /\ + (!x. x IN prob_carrier p ==> abs(f x) <= C) + ==> {x | x IN prob_carrier p /\ + real_liminf (\n. inv(&(SUC n)) * + sum(0..n) (\k. f(ITER k tt x))) < a /\ + real_limsup (\n. inv(&(SUC n)) * + sum(0..n) (\k. f(ITER k tt x))) > b} IN prob_events p`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `random_variable (p:A prob_space) + (\x. real_limsup (\n. inv(&(SUC n)) * sum(0..n) (\k. (f:A->real)(ITER k tt x))))` + ASSUME_TAC THENL + [MP_TAC(ISPECL [`p:A prob_space`; + `\n (x:A). inv(&(SUC n)) * sum(0..n) (\k. (f:A->real)(ITER k tt x))`; + `\x:A. C:real`] RANDOM_VARIABLE_REAL_LIMSUP_DOMINATED) THEN + BETA_TAC THEN DISCH_THEN MATCH_MP_TAC THEN REPEAT CONJ_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC INTEGRABLE_IMP_RANDOM_VARIABLE THEN + MATCH_MP_TAC ERGODIC_AVG_INTEGRABLE THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[RANDOM_VARIABLE_CONST]; + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `tt:A->A`; `f:A->real`; `C:real`; + `n:num`; `x:A`] ERGODIC_AVG_BOUNDED) THEN + ASM_REWRITE_TAC[]]; ALL_TAC] THEN + SUBGOAL_THEN `{x:A | x IN prob_carrier p /\ + real_limsup (\n. inv(&(SUC n)) * sum(0..n) (\k. (f:A->real)(ITER k tt x))) > b} IN + prob_events p` ASSUME_TAC THENL + [REWRITE_TAC[real_gt] THEN + SUBGOAL_THEN `{x:A | x IN prob_carrier p /\ + b < real_limsup (\n. inv(&(SUC n)) * sum(0..n) (\k. (f:A->real)(ITER k tt x)))} = + prob_carrier p DIFF {x | x IN prob_carrier p /\ + real_limsup (\n. inv(&(SUC n)) * sum(0..n) (\k. f(ITER k tt x))) <= b}` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_DIFF; IN_ELIM_THM] THEN GEN_TAC THEN + ASM_CASES_TAC `(x:A) IN prob_carrier p` THEN ASM_REWRITE_TAC[] THEN + REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[prob_carrier] THEN + MATCH_MP_TAC SIGMA_ALGEBRA_COMPL THEN REWRITE_TAC[PROB_SPACE_SIGMA_ALGEBRA] THEN + MP_TAC(ISPECL [`p:A prob_space`; + `\x:A. real_limsup (\n. inv(&(SUC n)) * sum(0..n) (\k. (f:A->real)(ITER k tt x)))`; + `b:real`] RV_LE_EVENT) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[GSYM prob_carrier]; + ALL_TAC] THEN + SUBGOAL_THEN `{x:A | x IN prob_carrier p /\ + real_liminf (\n. inv(&(SUC n)) * sum(0..n) (\k. (f:A->real)(ITER k tt x))) < a} IN + prob_events p` ASSUME_TAC THENL + [SUBGOAL_THEN `{x:A | x IN prob_carrier p /\ + real_liminf (\n. inv(&(SUC n)) * sum(0..n) (\k. (f:A->real)(ITER k tt x))) < a} = + {x | x IN prob_carrier p /\ + real_liminf (\n. inv(&(SUC n)) * sum(0..n) (\k. f(ITER k tt x)) + C) < a + C}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `x:A` THEN + ASM_CASES_TAC `(x:A) IN prob_carrier p` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `real_liminf (\n. inv(&(SUC n)) * sum(0..n) (\k. (f:A->real)(ITER k tt x))) = + real_liminf (\n. inv(&(SUC n)) * sum(0..n) (\k. f(ITER k tt x)) + C) - C` + (fun th -> REWRITE_TAC[th] THEN REAL_ARITH_TAC) THEN + MP_TAC(ISPECL [`\n. inv(&(SUC n)) * sum(0..n) (\k. (f:A->real)(ITER k tt x)) + C`; + `&0`; `&2 * C`; `C:real`] REAL_LIMINF_SUB_CONST) THEN BETA_TAC THEN + SUBGOAL_THEN `(\n. (inv(&(SUC n)) * sum(0..n) (\k. (f:A->real)(ITER k tt x)) + C) - C) = + (\n. inv(&(SUC n)) * sum(0..n) (\k. f(ITER k tt x)))` + (fun th -> REWRITE_TAC[th]) THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THEN GEN_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `tt:A->A`; `f:A->real`; `C:real`; + `n:num`; `x:A`] ERGODIC_AVG_BOUNDED) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(ISPECL [`p:A prob_space`; + `\x:A. real_liminf (\n. inv(&(SUC n)) * sum(0..n) (\k. (f:A->real)(ITER k tt x)) + C)`; + `a + C:real`] RV_STRICT_INEQ_EVENT) THEN + ANTS_TAC THENL + [MP_TAC(ISPECL [`p:A prob_space`; + `\n (x:A). inv(&(SUC n)) * sum(0..n) (\k. (f:A->real)(ITER k tt x)) + C`; + `&2 * C`] RANDOM_VARIABLE_REAL_LIMINF) THEN + BETA_TAC THEN DISCH_THEN MATCH_MP_TAC THEN REPEAT CONJ_TAC THENL + [GEN_TAC THEN + SUBGOAL_THEN `(\x:A. inv(&(SUC n)) * sum(0..n) (\k. (f:A->real)(ITER k tt x)) + C) = + (\x. (\x. inv(&(SUC n)) * sum(0..n) (\k. f(ITER k tt x))) x + (\x. C) x)` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN BETA_TAC THEN REFL_TAC; + MATCH_MP_TAC RANDOM_VARIABLE_ADD THEN CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_IMP_RANDOM_VARIABLE THEN + MATCH_MP_TAC ERGODIC_AVG_INTEGRABLE THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[RANDOM_VARIABLE_CONST]]]; + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `tt:A->A`; `f:A->real`; `C:real`; + `n:num`; `x:A`] ERGODIC_AVG_BOUNDED) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `tt:A->A`; `f:A->real`; `C:real`; + `n:num`; `x:A`] ERGODIC_AVG_BOUNDED) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC]; + REWRITE_TAC[]]; ALL_TAC] THEN + SUBGOAL_THEN `{x:A | x IN prob_carrier p /\ + real_liminf (\n. inv(&(SUC n)) * sum(0..n) (\k. (f:A->real)(ITER k tt x))) < a /\ + real_limsup (\n. inv(&(SUC n)) * sum(0..n) (\k. f(ITER k tt x))) > b} = + {x | x IN prob_carrier p /\ + real_liminf (\n. inv(&(SUC n)) * sum(0..n) (\k. f(ITER k tt x))) < a} INTER + {x | x IN prob_carrier p /\ + real_limsup (\n. inv(&(SUC n)) * sum(0..n) (\k. f(ITER k tt x))) > b}` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM] THEN MESON_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC SIGMA_ALGEBRA_INTER THEN ASM_REWRITE_TAC[PROB_SPACE_SIGMA_ALGEBRA]);; + +(* Helper: Archimedean bound for c*inv(SUC N) *) +let ARCHIMEDEAN_INV_BOUND = prove + (`!c eps. &0 <= c /\ &0 < eps ==> ?N. c * inv(&(SUC N)) < eps`, + REPEAT STRIP_TAC THEN ASM_CASES_TAC `c = &0` THENL + [EXISTS_TAC `0` THEN ASM_REWRITE_TAC[REAL_MUL_LZERO]; ALL_TAC] THEN + SUBGOAL_THEN `&0 < c` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(SPEC `eps:real` REAL_ARCH) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `c:real`) THEN + DISCH_THEN(X_CHOOSE_TAC `m:num`) THEN + SUBGOAL_THEN `0 < m` ASSUME_TAC THENL + [ASM_CASES_TAC `m = 0` THENL + [UNDISCH_TAC `c < &m * eps` THEN ASM_REWRITE_TAC[REAL_MUL_LZERO] THEN + ASM_REAL_ARITH_TAC; ASM_ARITH_TAC]; ALL_TAC] THEN + EXISTS_TAC `m - 1` THEN + SUBGOAL_THEN `SUC(m - 1) = m` SUBST1_TAC THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LT_LCANCEL_IMP THEN EXISTS_TAC `&m` THEN + CONJ_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_LT] THEN ASM_ARITH_TAC; + SUBGOAL_THEN `&m * c * inv(&m) = c` SUBST1_TAC THENL + [GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN + ASM_SIMP_TAC[REAL_MUL_LINV; REAL_OF_NUM_EQ; + ARITH_RULE `0 < m ==> ~(m = 0)`] THEN + REWRITE_TAC[REAL_MUL_RID]; + ASM_REWRITE_TAC[]]]);; + +(* Helper: inf perturbation bound *) +let INF_PERTURB_BOUND = prove + (`!s t lb ub c N. + (!n. lb <= s n) /\ (!n. s n <= ub) /\ + (!n. lb <= t n) /\ (!n. t n <= ub) /\ + (!n. abs(s n - t n) <= c * inv(&(SUC n))) /\ &0 <= c + ==> inf {t k | k >= N} - c * inv(&(SUC N)) <= inf {s k | k >= N}`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_INF THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + MESON_TAC[GE; LE_REFL]; + REWRITE_TAC[IN_ELIM_THM] THEN X_GEN_TAC `y:real` THEN + DISCH_THEN(X_CHOOSE_THEN `k:num` (CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC)) THEN + SUBGOAL_THEN `inf {(t:num->real) k | k >= N} <= t k` ASSUME_TAC THENL + [MP_TAC(ISPECL [`{(t:num->real) k | k >= N}`; `(t:num->real) k`] INF_LE_ELEMENT) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [EXISTS_TAC `lb:real` THEN REWRITE_TAC[IN_ELIM_THM] THEN + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[]; + REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `k:num` THEN ASM_REWRITE_TAC[]]; + REWRITE_TAC[]]; + ALL_TAC] THEN + MP_TAC(SPEC `k:num` (ASSUME `!n. abs((s:num->real) n - t n) <= c * inv(&(SUC n))`)) THEN + SUBGOAL_THEN `c * inv(&(SUC k)) <= c * inv(&(SUC N))` MP_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + REWRITE_TAC[REAL_OF_NUM_LT; REAL_OF_NUM_LE; LT_0; LE_SUC] THEN + ASM_MESON_TAC[GE]; + ABBREV_TAC `inft:real = inf {(t:num->real) k | k >= N}` THEN + ASM_REAL_ARITH_TAC]]);; + +(* Helper: inf over larger range is monotone *) +let INF_SUBSET_LE = prove + (`!s lb ub M N. (!n. lb <= s n) /\ (!n. s n <= ub) /\ M <= N + ==> inf {s k | k >= M} <= inf {(s:num->real) k | k >= N}`, + REPEAT STRIP_TAC THEN + MP_TAC(SPEC `inf {(s:num->real) k | k >= M}` + (INST [`{(s:num->real) k | k >= N}`, `s:real->bool`] REAL_LE_INF)) THEN + MATCH_MP_TAC(TAUT `a ==> (a ==> b) ==> b`) THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + MESON_TAC[GE; LE_REFL]; + REWRITE_TAC[IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`{(s:num->real) k | k >= M}`; `(s:num->real) k`] INF_LE_ELEMENT) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [EXISTS_TAC `lb:real` THEN REWRITE_TAC[IN_ELIM_THM] THEN + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[]; + REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `k:num` THEN + ASM_REWRITE_TAC[GE] THEN ASM_ARITH_TAC]; + REWRITE_TAC[]]]);; + +(* Helper: sup perturbation bound *) +let SUP_PERTURB_BOUND = prove + (`!s t lb ub c N. + (!n. lb <= s n) /\ (!n. s n <= ub) /\ + (!n. lb <= t n) /\ (!n. t n <= ub) /\ + (!n. abs(s n - t n) <= c * inv(&(SUC n))) /\ &0 <= c + ==> sup {s k | k >= N} <= sup {t k | k >= N} + c * inv(&(SUC N))`, + REPEAT STRIP_TAC THEN + ABBREV_TAC `S' = sup {(t:num->real) k | k >= N}` THEN + MATCH_MP_TAC REAL_SUP_LE THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + MESON_TAC[GE; LE_REFL]; ALL_TAC] THEN + REWRITE_TAC[IN_ELIM_THM] THEN X_GEN_TAC `y:real` THEN + DISCH_THEN(X_CHOOSE_THEN `k:num` (CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC)) THEN + SUBGOAL_THEN `(s:num->real) k <= t k + c * inv(&(SUC N))` ASSUME_TAC THENL + [MP_TAC(SPEC `k:num` (ASSUME `!n. abs((s:num->real) n - t n) <= c * inv(&(SUC n))`)) THEN + MATCH_MP_TAC(REAL_ARITH `b <= d ==> abs(a - c) <= b ==> a <= c + d`) THEN + MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + REWRITE_TAC[REAL_OF_NUM_LT; REAL_OF_NUM_LE; LT_0; LE_SUC] THEN + ASM_MESON_TAC[GE]; ALL_TAC] THEN + SUBGOAL_THEN `(t:num->real) k <= S'` ASSUME_TAC THENL + [EXPAND_TAC "S'" THEN + MP_TAC(ISPECL [`{(t:num->real) k | k >= N}`; `(t:num->real) k`] ELEMENT_LE_SUP) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [EXISTS_TAC `ub:real` THEN REWRITE_TAC[IN_ELIM_THM] THEN + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[]; + REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `k:num` THEN ASM_REWRITE_TAC[]]; + REWRITE_TAC[]]; ALL_TAC] THEN + ASM_REAL_ARITH_TAC);; + +(* Helper: sup over subset is monotone decreasing *) +let SUP_SUBSET_GE = prove + (`!s lb ub M N. (!n. lb <= s n) /\ (!n. s n <= ub) /\ M <= N + ==> sup {s k | k >= N} <= sup {(s:num->real) k | k >= M}`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_SUP_LE_SUBSET THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + MESON_TAC[GE; LE_REFL]; ALL_TAC] THEN + CONJ_TAC THENL + [REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + EXISTS_TAC `k:num` THEN ASM_REWRITE_TAC[GE] THEN ASM_ARITH_TAC; + EXISTS_TAC `ub:real` THEN REWRITE_TAC[IN_ELIM_THM] THEN + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[]]);; + +(* Helper: real_limsup s <= sup{s k|k>=N} *) +let REAL_LIMSUP_LE_SUP' = prove + (`!s lb ub N. (!n. lb <= s n) /\ (!n. s n <= ub) + ==> real_limsup s <= sup {(s:num->real) k | k >= N}`, + REPEAT STRIP_TAC THEN REWRITE_TAC[real_limsup] THEN + MATCH_MP_TAC INF_LE_ELEMENT THEN CONJ_TAC THENL + [EXISTS_TAC `lb:real` THEN REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN + X_GEN_TAC `y:real` THEN DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST1_TAC) THEN + MP_TAC(ISPECL [`{(s:num->real) k | k >= m}`; `lb:real`; `ub:real`] + REAL_SUP_BOUNDS) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + MESON_TAC[GE; LE_REFL]; + REWRITE_TAC[IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]]; + SIMP_TAC[]]; + REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN EXISTS_TAC `N:num` THEN REFL_TAC]);; + +(* Bounded sequences differing by O(1/n) have equal liminf *) +let REAL_LIMINF_LE_PERTURB = prove + (`!s t lb ub c. + (!n. lb <= s n) /\ (!n. s n <= ub) /\ + (!n. lb <= t n) /\ (!n. t n <= ub) /\ + (!n. abs(s n - t n) <= c * inv(&(SUC n))) /\ &0 <= c + ==> real_liminf t <= real_liminf s`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_EPSILON THEN + X_GEN_TAC `eps:real` THEN DISCH_TAC THEN + MP_TAC(SPECL [`c:real`; `eps:real`] ARCHIMEDEAN_INV_BOUND) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `N0:num`) THEN + REWRITE_TAC[real_liminf] THEN + MATCH_MP_TAC REAL_SUP_LE THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM; IN_UNIV] THEN + EXISTS_TAC `inf {(t:num->real) k | k >= 0}` THEN + EXISTS_TAC `0` THEN REFL_TAC; ALL_TAC] THEN + REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN + X_GEN_TAC `x:real` THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` SUBST1_TAC) THEN + MP_TAC(INST [ + `inf {(t:num->real) k | k >= N + N0}`, `q:real`; + `inf {(s:num->real) k | k >= N + N0}`, `r:real`; + `c * inv(&(SUC(N + N0)))`, `u:real`; + `c * inv(&(SUC N0))`, `v:real`; + `inf {(t:num->real) k | k >= N}`, `p:real`; + `sup {inf {(s:num->real) k | k >= n} | n | T}`, `w:real`; + `eps:real`, `z:real`] + (REAL_ARITH `p <= q /\ q - u <= r /\ r <= w /\ u <= v /\ v < z + ==> p <= w + z`)) THEN + ANTS_TAC THENL [ALL_TAC; MESON_TAC[]] THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC INF_SUBSET_LE THEN + EXISTS_TAC `lb:real` THEN EXISTS_TAC `ub:real` THEN + ASM_REWRITE_TAC[LE_ADD]; + MATCH_MP_TAC(REWRITE_RULE[RIGHT_IMP_FORALL_THM; IMP_IMP] INF_PERTURB_BOUND) THEN + EXISTS_TAC `lb:real` THEN EXISTS_TAC `ub:real` THEN ASM_REWRITE_TAC[]; + SUBGOAL_THEN `inf {(s:num->real) k | k >= N + N0} IN + {inf {s k | k >= n} | n | T}` ASSUME_TAC THENL + [REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `N + N0:num` THEN REFL_TAC; + ALL_TAC] THEN + MP_TAC(ISPECL [`{inf {(s:num->real) k | k >= n} | n | T}`; + `inf {(s:num->real) k | k >= N + N0}`] ELEMENT_LE_SUP) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [EXISTS_TAC `ub:real` THEN REWRITE_TAC[IN_ELIM_THM] THEN + X_GEN_TAC `y:real` THEN DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST1_TAC) THEN + MP_TAC(ISPECL [`{(s:num->real) k | k >= m}`; `(s:num->real) m`] + INF_LE_ELEMENT) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [EXISTS_TAC `lb:real` THEN REWRITE_TAC[IN_ELIM_THM] THEN + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[]; + REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `m:num` THEN + REWRITE_TAC[GE; LE_REFL]]; + ASM_MESON_TAC[REAL_LE_TRANS]]; + ASM_REWRITE_TAC[]]; + REWRITE_TAC[]]; + MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + REWRITE_TAC[REAL_OF_NUM_LT; REAL_OF_NUM_LE; LT_0] THEN + REWRITE_TAC[LE_SUC; LE_ADDR]; + ASM_REWRITE_TAC[]]);; + +(* Bounded sequences differing by O(1/n) have equal liminf *) +let REAL_LIMINF_PERTURB_NULL = prove + (`!s t lb ub c. + (!n. lb <= s n) /\ (!n. s n <= ub) /\ + (!n. lb <= t n) /\ (!n. t n <= ub) /\ + (!n. abs(s n - t n) <= c * inv(&(SUC n))) /\ &0 <= c + ==> real_liminf s = real_liminf t`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(REAL_ARITH `a <= b /\ b <= a ==> a = b`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LIMINF_LE_PERTURB THEN + MAP_EVERY EXISTS_TAC [`lb:real`; `ub:real`; `c:real`] THEN + ASM_REWRITE_TAC[] THEN + GEN_TAC THEN MATCH_MP_TAC(REAL_ARITH `abs(a - b) <= c ==> abs(b - a) <= c`) THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LIMINF_LE_PERTURB THEN + MAP_EVERY EXISTS_TAC [`lb:real`; `ub:real`; `c:real`] THEN + ASM_REWRITE_TAC[]]);; + +(* Bounded sequences differing by O(1/n) have equal limsup *) +let REAL_LIMSUP_LE_PERTURB = prove + (`!s t lb ub c. + (!n. lb <= s n) /\ (!n. s n <= ub) /\ + (!n. lb <= t n) /\ (!n. t n <= ub) /\ + (!n. abs(s n - t n) <= c * inv(&(SUC n))) /\ &0 <= c + ==> real_limsup s <= real_limsup t`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_EPSILON THEN X_GEN_TAC `eps:real` THEN DISCH_TAC THEN + MP_TAC(SPECL [`c:real`; `eps / &2`] ARCHIMEDEAN_INV_BOUND) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + DISCH_THEN(X_CHOOSE_TAC `N0:num`) THEN + SUBGOAL_THEN `!m. lb <= sup {(t:num->real) k | k >= m}` ASSUME_TAC THENL + [GEN_TAC THEN + MP_TAC(ISPECL [`{(t:num->real) k | k >= m}`; `lb:real`; `ub:real`] + REAL_SUP_BOUNDS) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + MESON_TAC[GE; LE_REFL]; + REWRITE_TAC[IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]]; + SIMP_TAC[]]; ALL_TAC] THEN + SUBGOAL_THEN `?N1:num. sup {(t:num->real) k | k >= N1} < real_limsup t + eps / &2` + (X_CHOOSE_TAC `N1:num`) THENL + [REWRITE_TAC[real_limsup] THEN + MP_TAC(ISPECL [`{sup {(t:num->real) k | k >= n} | n IN (:num)}`; + `inf {sup {(t:num->real) k | k >= n} | n IN (:num)} + eps / &2`] + INF_APPROACH) THEN + ANTS_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM; IN_UNIV] THEN + REPEAT CONJ_TAC THENL + [MESON_TAC[]; + EXISTS_TAC `lb:real` THEN X_GEN_TAC `y:real` THEN + DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST1_TAC) THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_LT_ADDR] THEN ASM_REAL_ARITH_TAC]; + REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN + DISCH_THEN(X_CHOOSE_THEN `y:real` MP_TAC) THEN + DISCH_THEN(CONJUNCTS_THEN2 (X_CHOOSE_TAC `m:num`) ASSUME_TAC) THEN + EXISTS_TAC `m:num` THEN ASM_MESON_TAC[]]; ALL_TAC] THEN + ABBREV_TAC `N = N0 + N1:num` THEN + MP_TAC(ISPECL [`s:num->real`; `lb:real`; `ub:real`; `N:num`] REAL_LIMSUP_LE_SUP') THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`s:num->real`; `t:num->real`; `lb:real`; `ub:real`; `c:real`; `N:num`] + SUP_PERTURB_BOUND) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`t:num->real`; `lb:real`; `ub:real`; `N1:num`; `N:num`] + SUP_SUBSET_GE) THEN + ASM_REWRITE_TAC[] THEN + ANTS_TAC THENL [EXPAND_TAC "N" THEN ARITH_TAC; ALL_TAC] THEN DISCH_TAC THEN + SUBGOAL_THEN `c * inv(&(SUC N)) <= c * inv(&(SUC N0))` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + REWRITE_TAC[REAL_OF_NUM_LT; REAL_OF_NUM_LE; LT_0; LE_SUC] THEN + EXPAND_TAC "N" THEN ARITH_TAC; ALL_TAC] THEN + ABBREV_TAC `ls = real_limsup (s:num->real)` THEN + ABBREV_TAC `lt = real_limsup (t:num->real)` THEN + ABBREV_TAC `ss = sup {(s:num->real) k | k >= N}` THEN + ABBREV_TAC `st = sup {(t:num->real) k | k >= N}` THEN + ABBREV_TAC `st1 = sup {(t:num->real) k | k >= N1}` THEN + ABBREV_TAC `d = c * inv(&(SUC N))` THEN + ABBREV_TAC `d0 = c * inv(&(SUC N0))` THEN + ASM_REAL_ARITH_TAC);; + +(* Bounded sequences differing by O(1/n) have equal limsup *) +let REAL_LIMSUP_PERTURB_NULL = prove + (`!s t lb ub c. + (!n. lb <= s n) /\ (!n. s n <= ub) /\ + (!n. lb <= t n) /\ (!n. t n <= ub) /\ + (!n. abs(s n - t n) <= c * inv(&(SUC n))) /\ &0 <= c + ==> real_limsup s = real_limsup t`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(REAL_ARITH `a <= b /\ b <= a ==> a = b`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LIMSUP_LE_PERTURB THEN + MAP_EVERY EXISTS_TAC [`lb:real`; `ub:real`; `c:real`] THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LIMSUP_LE_PERTURB THEN + MAP_EVERY EXISTS_TAC [`lb:real`; `ub:real`; `c:real`] THEN + ASM_REWRITE_TAC[] THEN + GEN_TAC THEN MATCH_MP_TAC(REAL_ARITH `abs(a - b) <= c ==> abs(b - a) <= c`) THEN + ASM_REWRITE_TAC[]]);; + +(* Helper: establish ergodic avg difference bound uniformly *) +let ERGODIC_AVG_DIFF_BOUND = prove + (`!p:A prob_space tt f C x n. measure_preserving p tt /\ + (!x. x IN prob_carrier p ==> abs(f x) <= C) /\ &0 <= C /\ + x IN prob_carrier p + ==> abs(inv(&(SUC n)) * sum(0..n) (\k. f(ITER k tt (tt x))) - + inv(&(SUC n)) * sum(0..n) (\k. f(ITER k tt x))) <= + (&2 * C) * inv(&(SUC n))`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`f:A->real`; `tt:A->A`; `x:A`; `n:num`] AVG_SHIFT_DIFF) THEN + DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_INV; REAL_ABS_NUM] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `inv(&(SUC n)) * (&2 * C)` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN SIMP_TAC[REAL_LE_INV_EQ; REAL_POS] THEN + MATCH_MP_TAC(REAL_ARITH `abs a <= C /\ abs b <= C ==> abs(a - b) <= &2 * C`) THEN + CONJ_TAC THENL + [SUBGOAL_THEN `ITER (SUC n) (tt:A->A) x IN prob_carrier p` ASSUME_TAC THENL + [MP_TAC(SPEC `SUC n` (MATCH_MP MEASURE_PRESERVING_ITER + (ASSUME `measure_preserving (p:A prob_space) tt`))) THEN + DISCH_THEN(MP_TAC o MATCH_MP MEASURE_PRESERVING_CARRIER) THEN + ASM SET_TAC[]; + ASM_SIMP_TAC[]]; + ASM_SIMP_TAC[]]; + REWRITE_TAC[REAL_MUL_AC] THEN REAL_ARITH_TAC]);; + +(* Ergodic averages shifted by T have same limsup *) +let ERGODIC_LIMSUP_SHIFT = prove + (`!p:A prob_space tt f C. measure_preserving p tt /\ + (!x. x IN prob_carrier p ==> abs(f x) <= C) /\ &0 <= C + ==> !x. x IN prob_carrier p ==> + real_limsup (\n. inv(&(SUC n)) * sum(0..n) (\k. f(ITER k tt (tt x)))) = + real_limsup (\n. inv(&(SUC n)) * sum(0..n) (\k. f(ITER k tt x)))`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN CONJ_TAC THENL + [MP_TAC(ISPECL [`\n:num. inv(&(SUC n)) * sum(0..n) + (\k. (f:A->real)(ITER k (tt:A->A) (tt (x:A))))`; + `\n:num. inv(&(SUC n)) * sum(0..n) + (\k. (f:A->real)(ITER k (tt:A->A) (x:A)))`; + `--C:real`; `C:real`; `&2 * C`] REAL_LIMSUP_LE_PERTURB) THEN + BETA_TAC THEN DISCH_THEN MATCH_MP_TAC THEN + REPEAT CONJ_TAC THENL + [GEN_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `tt:A->A`; `f:A->real`; `C:real`; + `n:num`; `tt (x:A):A`] ERGODIC_AVG_BOUNDED) THEN + ASM_SIMP_TAC[MEASURE_PRESERVING_CARRIER] THEN REAL_ARITH_TAC; + GEN_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `tt:A->A`; `f:A->real`; `C:real`; + `n:num`; `tt (x:A):A`] ERGODIC_AVG_BOUNDED) THEN + ASM_SIMP_TAC[MEASURE_PRESERVING_CARRIER] THEN REAL_ARITH_TAC; + GEN_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `tt:A->A`; `f:A->real`; `C:real`; + `n:num`; `x:A`] ERGODIC_AVG_BOUNDED) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + GEN_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `tt:A->A`; `f:A->real`; `C:real`; + `n:num`; `x:A`] ERGODIC_AVG_BOUNDED) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + GEN_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `tt:A->A`; `f:A->real`; `C:real`; + `x:A`; `n:num`] ERGODIC_AVG_DIFF_BOUND) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + ASM_REAL_ARITH_TAC]; + MP_TAC(ISPECL [`\n:num. inv(&(SUC n)) * sum(0..n) + (\k. (f:A->real)(ITER k (tt:A->A) (x:A)))`; + `\n:num. inv(&(SUC n)) * sum(0..n) + (\k. (f:A->real)(ITER k (tt:A->A) (tt (x:A))))`; + `--C:real`; `C:real`; `&2 * C`] REAL_LIMSUP_LE_PERTURB) THEN + BETA_TAC THEN DISCH_THEN MATCH_MP_TAC THEN + REPEAT CONJ_TAC THENL + [GEN_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `tt:A->A`; `f:A->real`; `C:real`; + `n:num`; `x:A`] ERGODIC_AVG_BOUNDED) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + GEN_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `tt:A->A`; `f:A->real`; `C:real`; + `n:num`; `x:A`] ERGODIC_AVG_BOUNDED) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + GEN_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `tt:A->A`; `f:A->real`; `C:real`; + `n:num`; `tt (x:A):A`] ERGODIC_AVG_BOUNDED) THEN + ASM_SIMP_TAC[MEASURE_PRESERVING_CARRIER] THEN REAL_ARITH_TAC; + GEN_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `tt:A->A`; `f:A->real`; `C:real`; + `n:num`; `tt (x:A):A`] ERGODIC_AVG_BOUNDED) THEN + ASM_SIMP_TAC[MEASURE_PRESERVING_CARRIER] THEN REAL_ARITH_TAC; + GEN_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `tt:A->A`; `f:A->real`; `C:real`; + `x:A`; `n:num`] ERGODIC_AVG_DIFF_BOUND) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + ASM_REAL_ARITH_TAC]]);; + +(* Ergodic averages shifted by T have same liminf *) +let ERGODIC_LIMINF_SHIFT = prove + (`!p:A prob_space tt f C. measure_preserving p tt /\ + (!x. x IN prob_carrier p ==> abs(f x) <= C) /\ &0 <= C + ==> !x. x IN prob_carrier p ==> + real_liminf (\n. inv(&(SUC n)) * sum(0..n) (\k. f(ITER k tt (tt x)))) = + real_liminf (\n. inv(&(SUC n)) * sum(0..n) (\k. f(ITER k tt x)))`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN CONJ_TAC THENL + [MP_TAC(ISPECL [`\n:num. inv(&(SUC n)) * sum(0..n) + (\k. (f:A->real)(ITER k (tt:A->A) (x:A)))`; + `\n:num. inv(&(SUC n)) * sum(0..n) + (\k. (f:A->real)(ITER k (tt:A->A) (tt (x:A))))`; + `--C:real`; `C:real`; `&2 * C`] REAL_LIMINF_LE_PERTURB) THEN + BETA_TAC THEN DISCH_THEN MATCH_MP_TAC THEN + REPEAT CONJ_TAC THENL + [GEN_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `tt:A->A`; `f:A->real`; `C:real`; + `n:num`; `x:A`] ERGODIC_AVG_BOUNDED) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + GEN_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `tt:A->A`; `f:A->real`; `C:real`; + `n:num`; `x:A`] ERGODIC_AVG_BOUNDED) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + GEN_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `tt:A->A`; `f:A->real`; `C:real`; + `n:num`; `tt (x:A):A`] ERGODIC_AVG_BOUNDED) THEN + ASM_SIMP_TAC[MEASURE_PRESERVING_CARRIER] THEN REAL_ARITH_TAC; + GEN_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `tt:A->A`; `f:A->real`; `C:real`; + `n:num`; `tt (x:A):A`] ERGODIC_AVG_BOUNDED) THEN + ASM_SIMP_TAC[MEASURE_PRESERVING_CARRIER] THEN REAL_ARITH_TAC; + GEN_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `tt:A->A`; `f:A->real`; `C:real`; + `x:A`; `n:num`] ERGODIC_AVG_DIFF_BOUND) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + ASM_REAL_ARITH_TAC]; + MP_TAC(ISPECL [`\n:num. inv(&(SUC n)) * sum(0..n) + (\k. (f:A->real)(ITER k (tt:A->A) (tt (x:A))))`; + `\n:num. inv(&(SUC n)) * sum(0..n) + (\k. (f:A->real)(ITER k (tt:A->A) (x:A)))`; + `--C:real`; `C:real`; `&2 * C`] REAL_LIMINF_LE_PERTURB) THEN + BETA_TAC THEN DISCH_THEN MATCH_MP_TAC THEN + REPEAT CONJ_TAC THENL + [GEN_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `tt:A->A`; `f:A->real`; `C:real`; + `n:num`; `tt (x:A):A`] ERGODIC_AVG_BOUNDED) THEN + ASM_SIMP_TAC[MEASURE_PRESERVING_CARRIER] THEN REAL_ARITH_TAC; + GEN_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `tt:A->A`; `f:A->real`; `C:real`; + `n:num`; `tt (x:A):A`] ERGODIC_AVG_BOUNDED) THEN + ASM_SIMP_TAC[MEASURE_PRESERVING_CARRIER] THEN REAL_ARITH_TAC; + GEN_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `tt:A->A`; `f:A->real`; `C:real`; + `n:num`; `x:A`] ERGODIC_AVG_BOUNDED) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + GEN_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `tt:A->A`; `f:A->real`; `C:real`; + `n:num`; `x:A`] ERGODIC_AVG_BOUNDED) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + GEN_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `tt:A->A`; `f:A->real`; `C:real`; + `x:A`; `n:num`] ERGODIC_AVG_DIFF_BOUND) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + ASM_REAL_ARITH_TAC]]);; + +(* T-invariance of the oscillation set *) +let ERGODIC_OSCILLATION_INVARIANT = prove + (`!p:A prob_space tt f C a b. + measure_preserving p tt /\ integrable p f /\ + (!x. x IN prob_carrier p ==> abs(f x) <= C) /\ a < b + ==> invariant_event p tt {x | x IN prob_carrier p /\ + real_liminf (\n. inv(&(SUC n)) * sum(0..n) (\k. f(ITER k tt x))) < a /\ + real_limsup (\n. inv(&(SUC n)) * sum(0..n) (\k. f(ITER k tt x))) > b}`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&0 <= C` ASSUME_TAC THENL + [MP_TAC(SPEC `p:A prob_space` PROB_CARRIER_NONEMPTY) THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + DISCH_THEN(X_CHOOSE_TAC `z:A`) THEN + SUBGOAL_THEN `abs((f:A->real) z) <= C` MP_TAC THENL + [ASM_SIMP_TAC[]; REAL_ARITH_TAC]; + ALL_TAC] THEN + REWRITE_TAC[invariant_event] THEN CONJ_TAC THENL + [MATCH_MP_TAC ERGODIC_OSCILLATION_MEASURABLE THEN + EXISTS_TAC `C:real` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `x:A` THEN + EQ_TAC THENL + [STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`p:A prob_space`; `tt:A->A`; `f:A->real`; `C:real`] + ERGODIC_LIMSUP_SHIFT) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `x:A`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + MP_TAC(ISPECL [`p:A prob_space`; `tt:A->A`; `f:A->real`; `C:real`] + ERGODIC_LIMINF_SHIFT) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `x:A`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC[]; + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [ASM_SIMP_TAC[MEASURE_PRESERVING_CARRIER]; ALL_TAC] THEN + MP_TAC(ISPECL [`p:A prob_space`; `tt:A->A`; `f:A->real`; `C:real`] + ERGODIC_LIMSUP_SHIFT) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `x:A`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN SUBST1_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `tt:A->A`; `f:A->real`; `C:real`] + ERGODIC_LIMINF_SHIFT) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `x:A`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[]]);; + +(* The set where liminf < a < b < limsup has probability zero (bounded case) *) +let ERGODIC_OSCILLATION_NULL = prove + (`!p:A prob_space tt f a b C. + measure_preserving p tt /\ integrable p f /\ a < b /\ + (!x. x IN prob_carrier p ==> abs(f x) <= C) + ==> prob p {x | x IN prob_carrier p /\ + real_liminf (\n. inv(&(SUC n)) * + sum(0..n) (\k. f(ITER k tt x))) < a /\ + real_limsup (\n. inv(&(SUC n)) * + sum(0..n) (\k. f(ITER k tt x))) > b} = &0`, + REPEAT STRIP_TAC THEN + ABBREV_TAC `O_ab = {x:A | x IN prob_carrier p /\ + real_liminf (\n. inv(&(SUC n)) * sum(0..n) (\k. (f:A->real)(ITER k tt x))) < a /\ + real_limsup (\n. inv(&(SUC n)) * sum(0..n) (\k. f(ITER k tt x))) > b}` THEN + (* O_ab is an event *) + SUBGOAL_THEN `(O_ab:A->bool) IN prob_events p` ASSUME_TAC THENL + [EXPAND_TAC "O_ab" THEN + MATCH_MP_TAC ERGODIC_OSCILLATION_MEASURABLE THEN + EXISTS_TAC `C:real` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + (* O_ab is T-invariant *) + SUBGOAL_THEN `invariant_event (p:A prob_space) (tt:A->A) (O_ab:A->bool)` ASSUME_TAC THENL + [EXPAND_TAC "O_ab" THEN + MATCH_MP_TAC ERGODIC_OSCILLATION_INVARIANT THEN + EXISTS_TAC `C:real` THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + (* Averages are bounded by C for x in prob_carrier *) + SUBGOAL_THEN `!x:A n. x IN prob_carrier p ==> + abs(inv(&(SUC n)) * sum(0..n) (\k. (f:A->real)(ITER k tt x))) <= C` ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN + SUBGOAL_THEN `!k:num. ITER k (tt:A->A) x IN prob_carrier p` ASSUME_TAC THENL + [GEN_TAC THEN + MP_TAC(SPEC `k:num` (MATCH_MP MEASURE_PRESERVING_ITER (ASSUME `measure_preserving (p:A prob_space) tt`))) THEN + DISCH_THEN(MP_TAC o MATCH_MP MEASURE_PRESERVING_CARRIER) THEN + DISCH_THEN(MP_TAC o SPEC `x:A`) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `!k:num. abs((f:A->real)(ITER k tt x)) <= C` ASSUME_TAC THENL + [GEN_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_INV; REAL_ABS_NUM] THEN + SUBGOAL_THEN `~(&(SUC n) = &0)` ASSUME_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_EQ; NOT_SUC]; ALL_TAC] THEN + SUBGOAL_THEN `abs(sum(0..n) (\k. (f:A->real)(ITER k tt x))) <= &(SUC n) * C` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(0..n) (\k:num. C:real)` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(0..n) (\k. abs((f:A->real)(ITER k tt x)))` THEN CONJ_TAC THENL + [REWRITE_TAC[SUM_ABS_NUMSEG]; + MATCH_MP_TAC SUM_LE_NUMSEG THEN ASM_REWRITE_TAC[]]; + REWRITE_TAC[SUM_CONST_NUMSEG; SUB_0; ADD1] THEN REAL_ARITH_TAC]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `inv(&(SUC n)) * (&(SUC n) * C)` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_LE_INV_EQ; REAL_POS]; ASM_REWRITE_TAC[]]; + ASM_SIMP_TAC[REAL_MUL_ASSOC; REAL_MUL_LINV; REAL_MUL_LID; REAL_LE_REFL]]; + ALL_TAC] THEN + (* On O_ab, limsup > b implies partial sums of (f-b) eventually positive *) + SUBGOAL_THEN `!x:A. x IN O_ab ==> + ?n. sum(0..n) (\k. ((f:A->real)(ITER k tt x) - b)) > &0` ASSUME_TAC THENL + [X_GEN_TAC `x:A` THEN EXPAND_TAC "O_ab" THEN + REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN + SUBGOAL_THEN `!n. --(C:real) <= inv(&(SUC n)) * sum(0..n) (\k. (f:A->real)(ITER k tt x))` ASSUME_TAC THENL + [GEN_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`x:A`; `n:num`]) THEN ASM_REWRITE_TAC[] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `!n. inv(&(SUC n)) * sum(0..n) (\k. (f:A->real)(ITER k tt x)) <= C` ASSUME_TAC THENL + [GEN_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`x:A`; `n:num`]) THEN ASM_REWRITE_TAC[] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(SPECL [`\n. inv(&(SUC n)) * sum(0..n) (\k. (f:A->real)(ITER k tt x))`; `b:real`; `--C:real`; `C:real`] + REAL_LIMSUP_GT_EXISTS_BOUNDED) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `m:num`) THEN EXISTS_TAC `m:num` THEN + MATCH_MP_TAC(SPEC_ALL AVG_GT_IMP_SUM_POS) THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + (* On O_ab, liminf < a implies partial sums of (a-f) eventually positive *) + SUBGOAL_THEN `!x:A. x IN O_ab ==> + ?n. sum(0..n) (\k. (a - (f:A->real)(ITER k tt x))) > &0` ASSUME_TAC THENL + [X_GEN_TAC `x:A` THEN EXPAND_TAC "O_ab" THEN + REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN + SUBGOAL_THEN `!n. --(C:real) <= inv(&(SUC n)) * sum(0..n) (\k. (f:A->real)(ITER k tt x))` ASSUME_TAC THENL + [GEN_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`x:A`; `n:num`]) THEN ASM_REWRITE_TAC[] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `!n. inv(&(SUC n)) * sum(0..n) (\k. (f:A->real)(ITER k tt x)) <= C` ASSUME_TAC THENL + [GEN_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`x:A`; `n:num`]) THEN ASM_REWRITE_TAC[] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(SPECL [`\n. inv(&(SUC n)) * sum(0..n) (\k. (f:A->real)(ITER k tt x))`; `a:real`; `--C:real`; `C:real`] + REAL_LIMINF_LT_EXISTS_BOUNDED) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `m:num`) THEN EXISTS_TAC `m:num` THEN + MATCH_MP_TAC(SPEC_ALL AVG_LT_IMP_SUM_POS) THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + (* f - b is integrable *) + SUBGOAL_THEN `integrable (p:A prob_space) (\x. (f:A->real) x - b)` ASSUME_TAC THENL + [MATCH_MP_TAC INTEGRABLE_SUB THEN ASM_REWRITE_TAC[INTEGRABLE_CONST]; + ALL_TAC] THEN + (* a - f is integrable *) + SUBGOAL_THEN `integrable (p:A prob_space) (\x. a - (f:A->real) x)` ASSUME_TAC THENL + [MATCH_MP_TAC INTEGRABLE_SUB THEN ASM_REWRITE_TAC[INTEGRABLE_CONST]; + ALL_TAC] THEN + (* Apply MEL_INVARIANT_SET to (f-b): E[(f-b) * 1_O] >= 0 *) + SUBGOAL_THEN `&0 <= expectation (p:A prob_space) (\x. ((f:A->real) x - b) * indicator_fn O_ab x)` ASSUME_TAC THENL + [MP_TAC(ISPECL [`p:A prob_space`; `tt:A->A`; `\x:A. (f:A->real) x - b`; `O_ab:A->bool`] MEL_INVARIANT_SET) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:A`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN EXISTS_TAC `n:num` THEN + BETA_TAC THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + (* Apply MEL_INVARIANT_SET to (a-f): E[(a-f) * 1_O] >= 0 *) + SUBGOAL_THEN `&0 <= expectation (p:A prob_space) (\x. (a - (f:A->real) x) * indicator_fn O_ab x)` ASSUME_TAC THENL + [MP_TAC(ISPECL [`p:A prob_space`; `tt:A->A`; `\x:A. a - (f:A->real) x`; `O_ab:A->bool`] MEL_INVARIANT_SET) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:A`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN EXISTS_TAC `n:num` THEN + BETA_TAC THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + (* Combine: E[(f-b)*1_O] >= 0 and E[(a-f)*1_O] >= 0 *) + (* means (a-b)*P(O) >= 0, and since a < b, P(O) = 0 *) + SUBGOAL_THEN `expectation (p:A prob_space) (\x. ((f:A->real) x - b) * indicator_fn O_ab x) + + expectation p (\x. (a - f x) * indicator_fn O_ab x) = + (a - b) * prob p O_ab` ASSUME_TAC THENL + [SUBGOAL_THEN `expectation (p:A prob_space) (\x. ((f:A->real) x - b) * indicator_fn (O_ab:A->bool) x) + + expectation p (\x. (a - f x) * indicator_fn O_ab x) = + expectation p (\x. ((f x - b) * indicator_fn O_ab x + (a - f x) * indicator_fn O_ab x))` SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC EXPECTATION_ADD THEN CONJ_TAC THEN + MATCH_MP_TAC INTEGRABLE_MUL_INDICATOR_FN THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `(\x:A. ((f:A->real) x - b) * indicator_fn (O_ab:A->bool) x + + (a - f x) * indicator_fn O_ab x) = (\x. (a - b) * indicator_fn O_ab x)` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN REAL_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(SPECL [`p:A prob_space`; `a - b:real`; `indicator_fn (O_ab:A->bool)`] EXPECTATION_CMUL) THEN + ANTS_TAC THENL + [MATCH_MP_TAC INTEGRABLE_INDICATOR THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[ETA_AX] THEN DISCH_THEN SUBST1_TAC THEN AP_TERM_TAC THEN + MATCH_MP_TAC EXPECTATION_INDICATOR THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= &0 ==> x = &0`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC PROB_POSITIVE THEN ASM_REWRITE_TAC[]; + SUBGOAL_THEN `(a - b) * prob (p:A prob_space) O_ab >= &0` ASSUME_TAC THENL + [UNDISCH_TAC `&0 <= expectation (p:A prob_space) (\x. ((f:A->real) x - b) * indicator_fn O_ab x)` THEN + UNDISCH_TAC `&0 <= expectation (p:A prob_space) (\x. (a - (f:A->real) x) * indicator_fn O_ab x)` THEN + ASM_REAL_ARITH_TAC; + SUBGOAL_THEN `&0 <= prob (p:A prob_space) O_ab` ASSUME_TAC THENL + [MATCH_MP_TAC PROB_POSITIVE THEN ASM_REWRITE_TAC[]; + ASM_CASES_TAC `prob (p:A prob_space) O_ab = &0` THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `&0 < prob (p:A prob_space) O_ab` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `(a - b) * prob (p:A prob_space) O_ab < &0` MP_TAC THENL + [REWRITE_TAC[REAL_ARITH `x * y < &0 <=> &0 < (--x) * y`] THEN + MATCH_MP_TAC REAL_LT_MUL THEN ASM_REAL_ARITH_TAC; + ASM_REAL_ARITH_TAC]]]]);; + +(* Key analysis lemma: bounded sequence with limsup = liminf converges *) +let BOUNDED_LIMSUP_LIMINF_CONVERGE = prove + (`!s:num->real C. + (!n. abs(s n) <= C) /\ real_limsup s = real_liminf s + ==> (s ---> real_limsup s) sequentially`, + REPEAT STRIP_TAC THEN REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + ABBREV_TAC `L = real_limsup s` THEN + SUBGOAL_THEN `!n:num. (s:num->real) n <= sup {s k | k >= n}` ASSUME_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC ELEMENT_LE_SUP THEN CONJ_TAC THENL + [EXISTS_TAC `C:real` THEN REWRITE_TAC[IN_ELIM_THM; GE] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MP_TAC(SPEC `k:num` (ASSUME `!n. abs((s:num->real) n) <= C`)) THEN REAL_ARITH_TAC; + REWRITE_TAC[IN_ELIM_THM; GE] THEN EXISTS_TAC `n:num` THEN REWRITE_TAC[LE_REFL]]; + ALL_TAC] THEN + SUBGOAL_THEN `!n:num. inf {(s:num->real) k | k >= n} <= s n` ASSUME_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC INF_LE_ELEMENT THEN CONJ_TAC THENL + [EXISTS_TAC `--C:real` THEN REWRITE_TAC[IN_ELIM_THM; GE] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MP_TAC(SPEC `k:num` (ASSUME `!n. abs((s:num->real) n) <= C`)) THEN REAL_ARITH_TAC; + REWRITE_TAC[IN_ELIM_THM; GE] THEN EXISTS_TAC `n:num` THEN REWRITE_TAC[LE_REFL]]; + ALL_TAC] THEN + SUBGOAL_THEN `!m n:num. m <= n ==> sup {(s:num->real) k | k >= n} <= sup {s k | k >= m}` ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_SUP_LE_SUBSET THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM; GE] THEN + EXISTS_TAC `(s:num->real) n` THEN EXISTS_TAC `n:num` THEN REWRITE_TAC[LE_REFL]; + CONJ_TAC THENL + [REWRITE_TAC[SUBSET; IN_ELIM_THM; GE] THEN + REPEAT STRIP_TAC THEN EXISTS_TAC `k:num` THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; + EXISTS_TAC `C:real` THEN REWRITE_TAC[IN_ELIM_THM; GE] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MP_TAC(SPEC `k:num` (ASSUME `!n. abs((s:num->real) n) <= C`)) THEN REAL_ARITH_TAC]]; + ALL_TAC] THEN + SUBGOAL_THEN `!m n:num. m <= n ==> inf {(s:num->real) k | k >= m} <= inf {s k | k >= n}` ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LE_INF_SUBSET THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM; GE] THEN + EXISTS_TAC `(s:num->real) n` THEN EXISTS_TAC `n:num` THEN REWRITE_TAC[LE_REFL]; + CONJ_TAC THENL + [REWRITE_TAC[SUBSET; IN_ELIM_THM; GE] THEN + REPEAT STRIP_TAC THEN EXISTS_TAC `k:num` THEN ASM_REWRITE_TAC[] THEN ASM_ARITH_TAC; + EXISTS_TAC `--C:real` THEN REWRITE_TAC[IN_ELIM_THM; GE] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MP_TAC(SPEC `k:num` (ASSUME `!n. abs((s:num->real) n) <= C`)) THEN REAL_ARITH_TAC]]; + ALL_TAC] THEN + SUBGOAL_THEN `?N1:num. sup {(s:num->real) k | k >= N1} < L + e` STRIP_ASSUME_TAC THENL + [MP_TAC(SPECL [`{sup {(s:num->real) k | k >= n} | n IN (:num)}`; `L + e:real`] INF_APPROACH) THEN + SUBGOAL_THEN `inf {sup {(s:num->real) k | k >= n} | n IN (:num)} = L` + (fun th -> REWRITE_TAC[th]) THENL + [EXPAND_TAC "L" THEN REWRITE_TAC[real_limsup]; ALL_TAC] THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM; IN_UNIV] THEN + EXISTS_TAC `sup {(s:num->real) k | k >= 0}` THEN EXISTS_TAC `0` THEN REFL_TAC; + CONJ_TAC THENL + [EXISTS_TAC `--C:real` THEN REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN + X_GEN_TAC `x:real` THEN DISCH_THEN(X_CHOOSE_THEN `p:num` SUBST1_TAC) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(s:num->real) p` THEN CONJ_TAC THENL + [MP_TAC(SPEC `p:num` (ASSUME `!n. abs((s:num->real) n) <= C`)) THEN REAL_ARITH_TAC; + MATCH_MP_TAC ELEMENT_LE_SUP THEN CONJ_TAC THENL + [EXISTS_TAC `C:real` THEN REWRITE_TAC[IN_ELIM_THM; GE] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MP_TAC(SPEC `k:num` (ASSUME `!n. abs((s:num->real) n) <= C`)) THEN REAL_ARITH_TAC; + REWRITE_TAC[IN_ELIM_THM; GE] THEN EXISTS_TAC `p:num` THEN REWRITE_TAC[LE_REFL]]]; + ASM_REAL_ARITH_TAC]]; + REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN MESON_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN `?N2:num. L - e < inf {(s:num->real) k | k >= N2}` STRIP_ASSUME_TAC THENL + [MP_TAC(SPECL [`{inf {(s:num->real) k | k >= n} | n IN (:num)}`; `L - e:real`] SUP_APPROACH) THEN + SUBGOAL_THEN `sup {inf {(s:num->real) k | k >= n} | n IN (:num)} = L` + (fun th -> REWRITE_TAC[th]) THENL + [UNDISCH_TAC `L = real_liminf s` THEN REWRITE_TAC[real_liminf] THEN + DISCH_THEN(fun th -> REWRITE_TAC[SYM th]); ALL_TAC] THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM; IN_UNIV] THEN + EXISTS_TAC `inf {(s:num->real) k | k >= 0}` THEN EXISTS_TAC `0` THEN REFL_TAC; + CONJ_TAC THENL + [EXISTS_TAC `C:real` THEN REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN + X_GEN_TAC `x:real` THEN DISCH_THEN(X_CHOOSE_THEN `p:num` SUBST1_TAC) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(s:num->real) p` THEN CONJ_TAC THENL + [MATCH_MP_TAC INF_LE_ELEMENT THEN CONJ_TAC THENL + [EXISTS_TAC `--C:real` THEN REWRITE_TAC[IN_ELIM_THM; GE] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MP_TAC(SPEC `k:num` (ASSUME `!n. abs((s:num->real) n) <= C`)) THEN REAL_ARITH_TAC; + REWRITE_TAC[IN_ELIM_THM; GE] THEN EXISTS_TAC `p:num` THEN REWRITE_TAC[LE_REFL]]; + MP_TAC(SPEC `p:num` (ASSUME `!n. abs((s:num->real) n) <= C`)) THEN REAL_ARITH_TAC]; + ASM_REAL_ARITH_TAC]]; + REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN MESON_TAC[]]; + ALL_TAC] THEN + EXISTS_TAC `MAX N1 N2` THEN X_GEN_TAC `q:num` THEN DISCH_TAC THEN + SUBGOAL_THEN `N1 <= q /\ N2 <= (q:num)` STRIP_ASSUME_TAC THENL + [POP_ASSUM MP_TAC THEN ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `sup {(s:num->real) k | k >= q} <= sup {s k | k >= N1}` ASSUME_TAC THENL + [MP_TAC(SPECL [`N1:num`; `q:num`] + (ASSUME `!m n:num. m <= n ==> sup {(s:num->real) k | k >= n} <= sup {s k | k >= m}`)) THEN + ASM_SIMP_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `inf {(s:num->real) k | k >= N2} <= inf {s k | k >= q}` ASSUME_TAC THENL + [MP_TAC(SPECL [`N2:num`; `q:num`] + (ASSUME `!m n:num. m <= n ==> inf {(s:num->real) k | k >= m} <= inf {s k | k >= n}`)) THEN + ASM_SIMP_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `L - e < (s:num->real) q` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `inf {(s:num->real) k | k >= q}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `inf {(s:num->real) k | k >= N2}` THEN + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]]; ALL_TAC] THEN + SUBGOAL_THEN `(s:num->real) q < L + e` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `sup {(s:num->real) k | k >= N1}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `sup {(s:num->real) k | k >= q}` THEN + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]]; ALL_TAC] THEN + ASM_REAL_ARITH_TAC);; + +(* Bounded sequences: liminf <= limsup *) +let REAL_LIMINF_LE_LIMSUP_ABS = prove + (`!s:num->real C. (!n. abs(s n) <= C) + ==> real_liminf s <= real_limsup s`, + REPEAT STRIP_TAC THEN REWRITE_TAC[real_limsup; real_liminf] THEN + MATCH_MP_TAC REAL_SUP_LE THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM; IN_UNIV] THEN + MESON_TAC[]; ALL_TAC] THEN + REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN + X_GEN_TAC `x:real` THEN DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST1_TAC) THEN + MATCH_MP_TAC REAL_LE_INF THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM; IN_UNIV] THEN + MESON_TAC[]; ALL_TAC] THEN + REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN + X_GEN_TAC `y:real` THEN DISCH_THEN(X_CHOOSE_THEN `p:num` SUBST1_TAC) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(s:num->real)(MAX m p)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC INF_LE_ELEMENT THEN CONJ_TAC THENL + [EXISTS_TAC `--C:real` THEN REWRITE_TAC[IN_ELIM_THM; GE] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MP_TAC(SPEC `k:num` (ASSUME `!n. abs((s:num->real) n) <= C`)) THEN + REAL_ARITH_TAC; + REWRITE_TAC[IN_ELIM_THM; GE] THEN EXISTS_TAC `MAX m p` THEN + REWRITE_TAC[MAX] THEN ARITH_TAC]; + MP_TAC(ISPECL [`{(s:num->real) k | k >= p}`; `(s:num->real)(MAX m p)`; + `C:real`; `(s:num->real)(MAX m p)`] REAL_LE_SUP) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [REWRITE_TAC[IN_ELIM_THM; GE] THEN EXISTS_TAC `MAX m p` THEN + REWRITE_TAC[MAX] THEN ARITH_TAC; ALL_TAC] THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[IN_ELIM_THM; GE] THEN REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(SPEC `k:num` (ASSUME `!n. abs((s:num->real) n) <= C`)) THEN + REAL_ARITH_TAC; + REAL_ARITH_TAC]]);; + +(* Birkhoff for bounded f: almost sure convergence *) +let BIRKHOFF_ERGODIC_THEOREM_BOUNDED = prove + (`!p:A prob_space tt f C. + measure_preserving p tt /\ integrable p f /\ + (!x. x IN prob_carrier p ==> abs(f x) <= C) + ==> almost_surely p + {x | ?L. ((\n. inv(&(SUC n)) * sum(0..n) (\k. f(ITER k tt x))) + ---> L) sequentially}`, + REPEAT STRIP_TAC THEN REWRITE_TAC[almost_surely] THEN + SUBGOAL_THEN `{x:A | x IN prob_carrier p /\ + ~(x IN {x | ?L. ((\n. inv(&(SUC n)) * sum(0..n) (\k. (f:A->real)(ITER k tt x))) ---> L) sequentially})} = + {x | x IN prob_carrier p /\ + ~(?L. ((\n. inv(&(SUC n)) * sum(0..n) (\k. f(ITER k tt x))) ---> L) sequentially)}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `COUNTABLE {(a:real,b:real) | rational a /\ rational b /\ a < b} /\ + ~({(a:real,b:real) | rational a /\ rational b /\ a < b} = {})` + STRIP_ASSUME_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC COUNTABLE_SUBSET THEN + EXISTS_TAC `rational CROSS (rational:real->bool)` THEN + SIMP_TAC[COUNTABLE_CROSS; COUNTABLE_RATIONAL] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM; CROSS; FORALL_PAIR_THM; IN] THEN + MESON_TAC[]; + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM; EXISTS_PAIR_THM] THEN + MAP_EVERY EXISTS_TAC [`&0`; `&1`; `&0`; `&1`] THEN + REWRITE_TAC[PAIR_EQ; RATIONAL_CLOSED] THEN CONV_TAC REAL_RAT_REDUCE_CONV]; + ALL_TAC] THEN + SUBGOAL_THEN `?g:num->real#real. + {(a,b) | rational a /\ rational b /\ a < b} = IMAGE g (:num)` + STRIP_ASSUME_TAC THENL + [MATCH_MP_TAC COUNTABLE_AS_IMAGE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `!n:num. rational(FST((g:num->real#real) n)) /\ + rational(SND(g n)) /\ FST(g n) < SND(g n)` ASSUME_TAC THENL + [GEN_TAC THEN + SUBGOAL_THEN `(g:num->real#real) n IN + {(a,b) | rational a /\ rational b /\ a < b}` MP_TAC THENL + [UNDISCH_TAC `{a:real,b | rational a /\ rational b /\ a < b} = + IMAGE (g:num->real#real) (:num)` THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN + REWRITE_TAC[IN_IMAGE; IN_UNIV] THEN MESON_TAC[]; ALL_TAC] THEN + SPEC_TAC(`(g:num->real#real) n`, `p':real#real`) THEN + REWRITE_TAC[FORALL_PAIR_THM; IN_ELIM_THM; FST; SND; PAIR_EQ] THEN + MESON_TAC[]; + ALL_TAC] THEN + EXISTS_TAC `UNIONS {(\n. {x:A | x IN prob_carrier p /\ + real_liminf (\m. inv(&(SUC m)) * sum(0..m) (\k. (f:A->real)(ITER k tt x))) < FST((g:num->real#real) n) /\ + real_limsup (\m. inv(&(SUC m)) * sum(0..m) (\k. f(ITER k tt x))) > SND(g n)}) n | n IN (:num)}` THEN + REWRITE_TAC[BETA_THM] THEN CONJ_TAC THENL + [(* null_event of the countable union *) + MATCH_MP_TAC NULL_EVENT_COUNTABLE_UNION THEN GEN_TAC THEN + REWRITE_TAC[null_event] THEN CONJ_TAC THENL + [MATCH_MP_TAC ERGODIC_OSCILLATION_MEASURABLE THEN + EXISTS_TAC `C:real` THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[]; + MP_TAC(SPECL [`p:A prob_space`; `tt:A->A`; `f:A->real`; + `FST((g:num->real#real) n)`; `SND((g:num->real#real) n)`; `C:real`] + ERGODIC_OSCILLATION_NULL) THEN + ASM_REWRITE_TAC[] THEN + ANTS_TAC THENL [ASM_MESON_TAC[]; REWRITE_TAC[]]]; + ALL_TAC] THEN + (* subset: non-convergence set is in the union *) + REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_UNIONS; IN_UNIV] THEN + X_GEN_TAC `x:A` THEN STRIP_TAC THEN + ABBREV_TAC `s = (\m. inv(&(SUC m)) * sum(0..m) (\k. (f:A->real)(ITER k tt x)))` THEN + SUBGOAL_THEN `!n:num. abs((s:num->real) n) <= C` ASSUME_TAC THENL + [EXPAND_TAC "s" THEN REWRITE_TAC[] THEN GEN_TAC THEN + SUBGOAL_THEN `!k:num. ITER k (tt:A->A) x IN prob_carrier p` ASSUME_TAC THENL + [GEN_TAC THEN + MP_TAC(SPEC `k:num` (MATCH_MP MEASURE_PRESERVING_ITER + (ASSUME `measure_preserving (p:A prob_space) tt`))) THEN + DISCH_THEN(MP_TAC o MATCH_MP MEASURE_PRESERVING_CARRIER) THEN + DISCH_THEN(MP_TAC o SPEC `x:A`) THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `!k:num. abs((f:A->real)(ITER k tt x)) <= C` ASSUME_TAC THENL + [GEN_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_INV; REAL_ABS_NUM] THEN + SUBGOAL_THEN `~(&(SUC n) = &0)` ASSUME_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_EQ; NOT_SUC]; ALL_TAC] THEN + SUBGOAL_THEN `abs(sum(0..n) (\k. (f:A->real)(ITER k tt x))) <= &(SUC n) * C` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(0..n) (\k:num. C:real)` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(0..n) (\k. abs((f:A->real)(ITER k tt x)))` THEN CONJ_TAC THENL + [REWRITE_TAC[SUM_ABS_NUMSEG]; MATCH_MP_TAC SUM_LE_NUMSEG THEN ASM_REWRITE_TAC[]]; + REWRITE_TAC[SUM_CONST_NUMSEG; SUB_0; ADD1] THEN REAL_ARITH_TAC]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `inv(&(SUC n)) * (&(SUC n) * C)` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_LE_INV_EQ; REAL_POS]; ASM_REWRITE_TAC[]]; + ASM_SIMP_TAC[REAL_MUL_ASSOC; REAL_MUL_LINV; REAL_MUL_LID; REAL_LE_REFL]]; + ALL_TAC] THEN + SUBGOAL_THEN `~(real_limsup s = real_liminf s)` ASSUME_TAC THENL + [DISCH_TAC THEN UNDISCH_TAC `~(?L:real. (s ---> L) sequentially)` THEN + REWRITE_TAC[] THEN EXISTS_TAC `real_limsup s` THEN + MATCH_MP_TAC BOUNDED_LIMSUP_LIMINF_CONVERGE THEN + EXISTS_TAC `C:real` THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `real_liminf s < real_limsup s` ASSUME_TAC THENL + [MP_TAC(SPECL [`s:num->real`; `C:real`] REAL_LIMINF_LE_LIMSUP_ABS) THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(SPECL [`real_liminf s`; `real_limsup s`] RATIONAL_BETWEEN) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `q1:real` STRIP_ASSUME_TAC) THEN + MP_TAC(SPECL [`q1:real`; `real_limsup s`] RATIONAL_BETWEEN) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `q2:real` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `?nn:num. (g:num->real#real) nn = (q1,q2)` STRIP_ASSUME_TAC THENL + [SUBGOAL_THEN `(q1:real,q2:real) IN IMAGE (g:num->real#real) (:num)` MP_TAC THENL + [UNDISCH_TAC `{a,b | rational a /\ rational b /\ a < b} = IMAGE (g:num->real#real) (:num)` THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[IN_ELIM_THM; PAIR_EQ] THEN + MAP_EVERY EXISTS_TAC [`q1:real`; `q2:real`] THEN + ASM_REWRITE_TAC[]; + REWRITE_TAC[IN_IMAGE; IN_UNIV] THEN MESON_TAC[]]; + ALL_TAC] THEN + EXISTS_TAC `{x:A | x IN prob_carrier p /\ + real_liminf (\m. inv(&(SUC m)) * sum(0..m) (\k. (f:A->real)(ITER k tt x))) < FST((g:num->real#real) nn) /\ + real_limsup (\m. inv(&(SUC m)) * sum(0..m) (\k. f(ITER k tt x))) > SND(g nn)}` THEN + CONJ_TAC THENL + [EXISTS_TAC `nn:num` THEN REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[IN_ELIM_THM] THEN ASM_REWRITE_TAC[FST; SND] THEN + REWRITE_TAC[real_gt] THEN ASM_REWRITE_TAC[]);; + +(* Wiener's maximal ergodic inequality: + For f >= 0 integrable, P(sup_n avg_n(f) > lambda) <= E[f]/lambda. + Stated using ergodic_maxsum: {exists n. M_n(f-lam) > 0} = {sup avg(f) > lam} *) +let WIENER_MAXIMAL_INEQUALITY = prove + (`!p:A prob_space tt (f:A->real) lam. + measure_preserving p tt /\ integrable p f /\ + (!x. x IN prob_carrier p ==> &0 <= f x) /\ &0 < lam + ==> prob p {x | x IN prob_carrier p /\ + (?n. ergodic_maxsum (\x. f x - lam) tt n x > &0)} + <= inv(lam) * expectation p f`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `integrable (p:A prob_space) (\x. (f:A->real) x - lam)` ASSUME_TAC THENL + [MATCH_MP_TAC INTEGRABLE_SUB THEN ASM_REWRITE_TAC[INTEGRABLE_CONST]; ALL_TAC] THEN + ABBREV_TAC `A = {x:A | x IN prob_carrier p /\ + (?n. ergodic_maxsum (\x. (f:A->real) x - lam) tt n x > &0)}` THEN + SUBGOAL_THEN `(A:A->bool) IN prob_events p` ASSUME_TAC THENL + [EXPAND_TAC "A" THEN + SUBGOAL_THEN `{x:A | x IN prob_carrier p /\ + (?n. ergodic_maxsum (\x. (f:A->real) x - lam) tt n x > &0)} = + UNIONS {({x:A | x IN prob_carrier p /\ + ergodic_maxsum (\x. f x - lam) tt n x > &0}) | n IN (:num)}` + SUBST1_TAC THENL + [SET_TAC[]; + MATCH_MP_TAC PROB_INDEXED_UNION_IN_EVENTS THEN + GEN_TAC THEN MATCH_MP_TAC ERGODIC_MAXSUM_POS_EVENT THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + (* Apply maximal ergodic lemma: E[(f-lam)*1_A] >= 0 *) + SUBGOAL_THEN `&0 <= expectation (p:A prob_space) + (\x. ((f:A->real) x - lam) * indicator_fn A x)` ASSUME_TAC THENL + [MP_TAC(ISPECL [`p:A prob_space`; `tt:A->A`; `\x:A. (f:A->real) x - lam`] + MAXIMAL_ERGODIC_INFINITE) THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `{x:A | x IN prob_carrier p /\ + (?n. ergodic_maxsum (\x. (f:A->real) x - lam) tt n x > &0)} = A` + (fun th -> REWRITE_TAC[th]) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + (* Chain: lam * P(A) <= E[f*1_A] <= E[f], so P(A) <= E[f]/lam *) + SUBGOAL_THEN `lam * prob (p:A prob_space) A <= expectation p (f:A->real)` + ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `expectation (p:A prob_space) + (\x. (f:A->real) x * indicator_fn A x)` THEN + CONJ_TAC THENL + [SUBGOAL_THEN `expectation (p:A prob_space) + (\x. ((f:A->real) x - lam) * indicator_fn A x) = + expectation p (\x. f x * indicator_fn A x) - lam * prob p A` + ASSUME_TAC THENL + [SUBGOAL_THEN `(\x:A. ((f:A->real) x - lam) * indicator_fn (A:A->bool) x) = + (\x. f x * indicator_fn A x - lam * indicator_fn A x)` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `integrable (p:A prob_space) + (\x. (f:A->real) x * indicator_fn (A:A->bool) x)` ASSUME_TAC THENL + [MATCH_MP_TAC INTEGRABLE_MUL_INDICATOR_FN THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `integrable (p:A prob_space) + (\x. lam * indicator_fn (A:A->bool) x)` ASSUME_TAC THENL + [MP_TAC(ISPECL [`p:A prob_space`; `lam:real`; `indicator_fn (A:A->bool)`] + INTEGRABLE_CMUL) THEN + ASM_SIMP_TAC[INTEGRABLE_INDICATOR; ETA_AX]; ALL_TAC] THEN + ASM_SIMP_TAC[EXPECTATION_SUB] THEN AP_TERM_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `lam:real`; `indicator_fn (A:A->bool)`] + EXPECTATION_CMUL) THEN + ASM_SIMP_TAC[INTEGRABLE_INDICATOR; ETA_AX] THEN + DISCH_THEN SUBST1_TAC THEN + AP_TERM_TAC THEN MATCH_MP_TAC EXPECTATION_INDICATOR THEN ASM_REWRITE_TAC[]; + ASM_REAL_ARITH_TAC]; + MATCH_MP_TAC EXPECTATION_MONO THEN + ASM_SIMP_TAC[INTEGRABLE_MUL_INDICATOR_FN] THEN + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + REWRITE_TAC[indicator_fn] THEN COND_CASES_TAC THENL + [REWRITE_TAC[REAL_MUL_RID; REAL_LE_REFL]; + REWRITE_TAC[REAL_MUL_RZERO] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[]]]; + ALL_TAC] THEN + (* Final: from lam * P(A) <= E[f], derive P(A) <= inv(lam) * E[f] *) + SUBGOAL_THEN `&0 <= prob (p:A prob_space) A` ASSUME_TAC THENL + [MATCH_MP_TAC PROB_POSITIVE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `&0 <= expectation (p:A prob_space) (f:A->real)` ASSUME_TAC THENL + [MATCH_MP_TAC EXPECTATION_POS THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ] THEN + SUBGOAL_THEN `inv lam * expectation (p:A prob_space) (f:A->real) = + expectation p f / lam` SUBST1_TAC THENL + [REWRITE_TAC[real_div]; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ] THEN ASM_REAL_ARITH_TAC);; + +(* Truncation of f at level M is integrable *) +let ERGODIC_TRUNCATION_INTEGRABLE = prove + (`!p:A prob_space (f:A->real) M. + integrable p f ==> integrable p (\x. max (-- &M) (min (&M) (f x)))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(\x:A. max (-- &M) (min (&M) ((f:A->real) x))) = + (\x. max ((\x. -- &M) x) (min ((\x. &M) x) (f x)))` SUBST1_TAC THENL + [REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC INTEGRABLE_MAX THEN CONJ_TAC THENL + [REWRITE_TAC[INTEGRABLE_CONST]; ALL_TAC] THEN + MATCH_MP_TAC INTEGRABLE_MIN THEN ASM_REWRITE_TAC[INTEGRABLE_CONST]);; + +(* |f - truncation| <= |f| *) +let ERGODIC_TRUNCATION_ABS_BOUND = prove + (`!f:A->real x M. abs(f x - max (-- &M) (min (&M) (f x))) <= abs(f x)`, + REPEAT GEN_TAC THEN REAL_ARITH_TAC);; + +(* |f - truncation| converges to 0 pointwise *) +let ERGODIC_TRUNCATION_POINTWISE = prove + (`!f:A->real x. ((\M. f x - max(-- &M) (min (&M) (f x))) ---> &0) sequentially`, + REPEAT GEN_TAC THEN REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(SPEC `abs((f:A->real) x)` REAL_ARCH_SIMPLE) THEN + DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `N:num` THEN + X_GEN_TAC `M:num` THEN DISCH_TAC THEN + SUBGOAL_THEN `abs((f:A->real) x) <= &M` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&N:real` THEN + ASM_REWRITE_TAC[REAL_OF_NUM_LE]; ALL_TAC] THEN + SUBGOAL_THEN `max (-- &M) (min (&M) ((f:A->real) x)) = f x` SUBST1_TAC THENL + [POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; ALL_TAC] THEN + ASM_REAL_ARITH_TAC);; + +(* E[|f - f_M|] -> 0 using Dominated Convergence *) +let ERGODIC_TRUNCATION_L1 = prove + (`!p:A prob_space (f:A->real). + integrable p f + ==> ((\M. expectation p (\x. abs(f x - max (-- &M) (min (&M) (f x))))) + ---> &0) sequentially`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; + `\M (x:A). abs((f:A->real) x - max (-- &M) (min (&M) (f x)))`; + `\x:A. &0:real`; + `\x:A. abs((f:A->real) x)`] DOMINATED_CONVERGENCE) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [GEN_TAC THEN BETA_TAC THEN MATCH_MP_TAC INTEGRABLE_ABS THEN + MATCH_MP_TAC INTEGRABLE_SUB THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC ERGODIC_TRUNCATION_INTEGRABLE THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC INTEGRABLE_ABS THEN ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC THEN BETA_TAC THEN REWRITE_TAC[REAL_ABS_ABS] THEN + REWRITE_TAC[ERGODIC_TRUNCATION_ABS_BOUND]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN BETA_TAC THEN + MP_TAC(ISPECL [`sequentially`; `\M:num. (f:A->real) x - max(-- &M) (min (&M) (f x))`; `&0`] REALLIM_ABS) THEN + REWRITE_TAC[REAL_ABS_NUM] THEN DISCH_THEN MATCH_MP_TAC THEN + REWRITE_TAC[ERGODIC_TRUNCATION_POINTWISE]]; + DISCH_THEN(MP_TAC o CONJUNCT2) THEN BETA_TAC THEN + SUBGOAL_THEN `expectation (p:A prob_space) (\x:A. &0) = &0` SUBST1_TAC THENL + [REWRITE_TAC[EXPECTATION_CONST; REAL_MUL_RZERO]; + REWRITE_TAC[]]]);; + +(* Helper: if average of |f| at orbit point exceeds lam, maxsum is positive *) +let AVG_GT_IMP_MAXSUM_POS = prove + (`!f:A->real tt x q lam. + inv(&(SUC q)) * sum(0..q) (\j. abs(f(ITER j tt x))) > lam /\ &0 < lam + ==> ergodic_maxsum (\y. abs(f y) - lam) tt q x > &0`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&0 < &(SUC q)` ASSUME_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_LT; LT_0]; ALL_TAC] THEN + SUBGOAL_THEN `~(&(SUC q) = &0)` ASSUME_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_EQ; NOT_SUC]; ALL_TAC] THEN + SUBGOAL_THEN `&(SUC q) * lam < sum(0..q) (\j. abs((f:A->real)(ITER j tt x)))` ASSUME_TAC THENL + [SUBGOAL_THEN `lam < inv(&(SUC q)) * sum(0..q) (\j. abs((f:A->real)(ITER j tt x)))` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(SPECL [`&(SUC q)`; `lam:real`; + `inv(&(SUC q)) * sum(0..q) (\j. abs((f:A->real)(ITER j tt x)))`] REAL_LT_LMUL) THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `&(SUC q) * (inv(&(SUC q)) * sum(0..q) (\j. abs((f:A->real)(ITER j tt x)))) = + sum(0..q) (\j. abs(f(ITER j tt x)))` SUBST1_TAC THENL + [REWRITE_TAC[REAL_MUL_ASSOC] THEN ASM_SIMP_TAC[REAL_MUL_RINV; REAL_MUL_LID]; + SIMP_TAC[]]; + ALL_TAC] THEN + REWRITE_TAC[real_gt] THEN MATCH_MP_TAC REAL_LTE_TRANS THEN + EXISTS_TAC `sum(0..q) (\j. (\y:A. abs((f:A->real) y) - lam)(ITER j tt x))` THEN + CONJ_TAC THENL + [REWRITE_TAC[] THEN + REWRITE_TAC[SUM_SUB_NUMSEG; SUM_CONST_NUMSEG; SUB_0] THEN + UNDISCH_TAC `&(SUC q) * lam < sum (0..q) (\j. abs ((f:A->real) (ITER j tt x)))` THEN + REWRITE_TAC[ADD1] THEN REAL_ARITH_TAC; + REWRITE_TAC[ERGODIC_MAXSUM_GE_SUM]]);; + +(* Key containment: if Cesaro averages oscillate by > inv(k) infinitely often, + then either avg(f_M) doesn't converge or avg(|f-f_M|) > inv(4k) somewhere. + This is the corrected containment using oscillation level. *) +let BIRKHOFF_OSCILLATION_CONTAINMENT = prove + (`!p:A prob_space tt (f:A->real) M k. + measure_preserving p tt /\ integrable p f /\ ~(k = 0) + ==> {x | x IN prob_carrier p /\ + (!N. ?m n. N <= m /\ N <= n /\ + abs(inv(&(SUC m)) * sum(0..m) (\j. f(ITER j tt x)) - + inv(&(SUC n)) * sum(0..n) (\j. f(ITER j tt x))) > inv(&k))} + SUBSET + {x | x IN prob_carrier p /\ + ~(?L. ((\n. inv(&(SUC n)) * sum(0..n) + (\j. max (-- &M) (min (&M) (f(ITER j tt x))))) ---> L) sequentially)} + UNION + {x | x IN prob_carrier p /\ + (?n. ergodic_maxsum + (\x. abs(f x - max (-- &M) (min (&M) (f x))) - inv(&(4 * k))) + tt n x > &0)}`, + REPEAT STRIP_TAC THEN REWRITE_TAC[SUBSET; IN_UNION; IN_ELIM_THM] THEN + X_GEN_TAC `x:A` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `?L. ((\n. inv(&(SUC n)) * sum(0..n) + (\j. max (-- &(M:num)) (min (&M) ((f:A->real)(ITER j tt x))))) ---> L) sequentially` THENL + [DISJ2_TAC THEN FIRST_X_ASSUM(X_CHOOSE_TAC `L:real`) THEN + UNDISCH_TAC `((\n. inv (&(SUC n)) * + sum (0..n) (\j. max (-- &(M:num)) (min (&M) ((f:A->real) (ITER j tt x))))) ---> L) + sequentially` THEN + REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + DISCH_THEN(MP_TAC o SPEC `inv(&(4 * k))`) THEN + ANTS_TAC THENL + [REWRITE_TAC[REAL_LT_INV_EQ; REAL_OF_NUM_LT] THEN + UNDISCH_TAC `~(k = 0)` THEN ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_TAC `N0:num`) THEN + UNDISCH_TAC `!N. ?m n. N <= m /\ N <= n /\ + abs(inv(&(SUC m)) * sum(0..m) (\j. (f:A->real)(ITER j tt x)) - + inv(&(SUC n)) * sum(0..n) (\j. f(ITER j tt x))) > inv(&k)` THEN + DISCH_THEN(MP_TAC o SPEC `N0:num`) THEN STRIP_TAC THEN + SUBGOAL_THEN `abs(inv(&(SUC m)) * sum(0..m) (\j. max (-- &(M:num)) (min (&M) ((f:A->real)(ITER j tt x)))) - L) < inv(&(4 * k))` ASSUME_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `abs(inv(&(SUC n)) * sum(0..n) (\j. max (-- &(M:num)) (min (&M) ((f:A->real)(ITER j tt x)))) - L) < inv(&(4 * k))` ASSUME_TAC THENL + [UNDISCH_TAC `!n. N0 <= n ==> abs(inv(&(SUC n)) * sum(0..n) (\j. max (-- &(M:num)) (min (&M) ((f:A->real)(ITER j tt x)))) - L) < inv(&(4 * k))` THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + (* Key: avg(|f-f_M|) > inv(4k) at m or n via triangle inequality *) + SUBGOAL_THEN `inv(&(SUC m)) * sum(0..m) (\j. abs((f:A->real)(ITER j tt x) - max (-- &(M:num))(min (&M)(f(ITER j tt x))))) > inv(&(4 * k)) \/ + inv(&(SUC n)) * sum(0..n) (\j. abs((f:A->real)(ITER j tt x) - max (-- &M)(min (&M)(f(ITER j tt x))))) > inv(&(4 * k))` MP_TAC THENL + [MATCH_MP_TAC(TAUT `(~p /\ ~q ==> F) ==> p \/ q`) THEN + REWRITE_TAC[real_gt; REAL_NOT_LT] THEN STRIP_TAC THEN + SUBGOAL_THEN `abs(inv(&(SUC m)) * sum(0..m) (\j. (f:A->real)(ITER j tt x) - max (-- &(M:num))(min (&M)(f(ITER j tt x))))) <= inv(&(4 * k))` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `inv(&(SUC m)) * sum(0..m) (\j. abs((f:A->real)(ITER j tt x) - max (-- &M)(min (&M)(f(ITER j tt x)))))` THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_INV; REAL_ABS_NUM] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_LE_INV_EQ; REAL_POS] THEN + REWRITE_TAC[SUM_ABS_NUMSEG]; ALL_TAC] THEN + SUBGOAL_THEN `abs(inv(&(SUC n)) * sum(0..n) (\j. (f:A->real)(ITER j tt x) - max (-- &(M:num))(min (&M)(f(ITER j tt x))))) <= inv(&(4 * k))` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `inv(&(SUC n)) * sum(0..n) (\j. abs((f:A->real)(ITER j tt x) - max (-- &M)(min (&M)(f(ITER j tt x)))))` THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_INV; REAL_ABS_NUM] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_LE_INV_EQ; REAL_POS] THEN + REWRITE_TAC[SUM_ABS_NUMSEG]; ALL_TAC] THEN + SUBGOAL_THEN `!q. inv(&(SUC q)) * sum(0..q) (\j. (f:A->real)(ITER j tt x)) = + inv(&(SUC q)) * sum(0..q) (\j. max (-- &(M:num))(min (&M)(f(ITER j tt x)))) + + inv(&(SUC q)) * sum(0..q) (\j. f(ITER j tt x) - max (-- &M)(min (&M)(f(ITER j tt x))))` ASSUME_TAC THENL + [GEN_TAC THEN REWRITE_TAC[GSYM REAL_ADD_LDISTRIB; GSYM SUM_ADD_NUMSEG] THEN + AP_TERM_TAC THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN + REPEAT STRIP_TAC THEN REAL_ARITH_TAC; ALL_TAC] THEN + UNDISCH_TAC `abs(inv(&(SUC m)) * sum(0..m) (\j. (f:A->real)(ITER j tt x)) - + inv(&(SUC n)) * sum(0..n) (\j. f(ITER j tt x))) > inv(&k)` THEN + REWRITE_TAC[real_gt; REAL_NOT_LT] THEN + FIRST_X_ASSUM(fun th -> PURE_REWRITE_TAC[th]) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `abs(inv(&(SUC m)) * sum(0..m) (\j. max (-- &(M:num))(min (&M)((f:A->real)(ITER j tt x)))) - L) + + abs(L - inv(&(SUC n)) * sum(0..n) (\j. max (-- &M)(min (&M)(f(ITER j tt x))))) + + abs(inv(&(SUC m)) * sum(0..m) (\j. f(ITER j tt x) - max (-- &M)(min (&M)(f(ITER j tt x))))) + + abs(inv(&(SUC n)) * sum(0..n) (\j. f(ITER j tt x) - max (-- &M)(min (&M)(f(ITER j tt x)))))` THEN + CONJ_TAC THENL + [REAL_ARITH_TAC; + SUBGOAL_THEN `~(&k = &0)` ASSUME_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_EQ] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `inv(&k) = inv(&(4*k)) + inv(&(4*k)) + inv(&(4*k)) + inv(&(4*k))` SUBST1_TAC THENL + [REWRITE_TAC[GSYM REAL_OF_NUM_MUL] THEN + MATCH_MP_TAC(REAL_FIELD `~(k = &0) ==> inv(k) = inv(&4 * k) + inv(&4 * k) + inv(&4 * k) + inv(&4 * k)`) THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `a < e /\ b < e /\ c <= e /\ d <= e ==> a + b + c + d <= e + e + e + e`) THEN + ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `abs(inv(&(SUC n)) * sum(0..n) (\j. max (-- &M) (min (&M) ((f:A->real)(ITER j tt x)))) - L) < inv(&(4*k))` THEN + REAL_ARITH_TAC]; ALL_TAC] THEN + SUBGOAL_THEN `&0 < inv(&(4 * k))` ASSUME_TAC THENL + [REWRITE_TAC[REAL_LT_INV_EQ; REAL_OF_NUM_LT] THEN + UNDISCH_TAC `~(k = 0)` THEN ARITH_TAC; ALL_TAC] THEN + STRIP_TAC THENL + [EXISTS_TAC `m:num` THEN + MATCH_MP_TAC(REWRITE_RULE[](ISPEC `\x:A. (f:A->real) x - max (-- &(M:num))(min (&M)(f x))` AVG_GT_IMP_MAXSUM_POS)) THEN + ASM_REWRITE_TAC[]; + EXISTS_TAC `n:num` THEN + MATCH_MP_TAC(REWRITE_RULE[](ISPEC `\x:A. (f:A->real) x - max (-- &(M:num))(min (&M)(f x))` AVG_GT_IMP_MAXSUM_POS)) THEN + ASM_REWRITE_TAC[]]; + DISJ1_TAC THEN ASM_REWRITE_TAC[]]);; + +(* If a real sequence doesn't converge, it oscillates at some level inv(SUC k) *) +let NOT_CONVERGENT_OSCILLATION = prove + (`!s:num->real. ~(?L. (s ---> L) sequentially) + ==> ?k. !N. ?m n. N <= m /\ N <= n /\ abs(s m - s n) > inv(&(SUC k))`, + GEN_TAC THEN + MATCH_MP_TAC(TAUT `(~q ==> ~p) ==> (p ==> q)`) THEN + REWRITE_TAC[NOT_EXISTS_THM; NOT_FORALL_THM; NOT_IMP] THEN + REWRITE_TAC[REAL_NOT_LT; real_gt; DE_MORGAN_THM] THEN + DISCH_TAC THEN + SUBGOAL_THEN `(cauchy:((num->real^1)->bool)) (\n. lift(s n))` MP_TAC THENL + [REWRITE_TAC[cauchy; GE; DIST_LIFT] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(SPEC `e:real` REAL_ARCH_INV) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `k:num` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `k:num`) THEN + DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `N:num` THEN + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(&(SUC k))` THEN + CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPECL [`m:num`; `n:num`]) THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(&k)` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN + REWRITE_TAC[REAL_OF_NUM_LT; REAL_OF_NUM_LE] THEN + UNDISCH_TAC `~(k = 0)` THEN ARITH_TAC]; + ALL_TAC] THEN + DISCH_TAC THEN + SUBGOAL_THEN `?l:real^1. ((\n. lift(s n)) --> l) sequentially` MP_TAC THENL + [REWRITE_TAC[CONVERGENT_EQ_CAUCHY] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_TAC `l:real^1`) THEN EXISTS_TAC `drop l` THEN + REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + UNDISCH_TAC `((\n. lift((s:num->real) n)) --> l:real^1) sequentially` THEN + REWRITE_TAC[LIM_SEQUENTIALLY] THEN + MATCH_MP_TAC(TAUT `(a <=> b) ==> (a ==> b)`) THEN + AP_TERM_TAC THEN ABS_TAC THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN ABS_TAC THEN + AP_TERM_TAC THEN ABS_TAC THEN + AP_TERM_TAC THEN + GEN_REWRITE_TAC (LAND_CONV o LAND_CONV o RAND_CONV o RAND_CONV) [GSYM LIFT_DROP] THEN + REWRITE_TAC[DIST_LIFT]);; + +(* BIRKHOFF'S ERGODIC THEOREM: S_n(f)/n converges almost surely *) +let BIRKHOFF_ERGODIC_THEOREM = prove + (`!p:A prob_space tt f. + measure_preserving p tt /\ integrable p f + ==> almost_surely p + {x | ?L. ((\n. inv(&(SUC n)) * sum(0..n) (\k. f(ITER k tt x))) + ---> L) sequentially}`, + REPEAT STRIP_TAC THEN REWRITE_TAC[almost_surely] THEN + (* For each M, bounded Birkhoff gives null event for f_M *) + SUBGOAL_THEN `!M:num. ?NM:A->bool. null_event (p:A prob_space) NM /\ + {x:A | x IN prob_carrier p /\ + ~(?L. ((\n. inv(&(SUC n)) * sum(0..n) + (\k. max (-- &M) (min (&M) ((f:A->real)(ITER k tt x))))) ---> L) sequentially)} + SUBSET NM` ASSUME_TAC THENL + [GEN_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `tt:A->A`; + `\x:A. max (-- &M) (min (&M) ((f:A->real) x))`; `&M:real`] + BIRKHOFF_ERGODIC_THEOREM_BOUNDED) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC ERGODIC_TRUNCATION_INTEGRABLE THEN ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC THEN REAL_ARITH_TAC]; + REWRITE_TAC[almost_surely] THEN + DISCH_THEN(X_CHOOSE_THEN `N:A->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `N:A->bool` THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN MESON_TAC[]]; + ALL_TAC] THEN + (* For each M and k, Wiener gives prob bound on remainder *) + SUBGOAL_THEN `!M k. prob (p:A prob_space) + {x:A | x IN prob_carrier p /\ + (?n. ergodic_maxsum (\x. abs((f:A->real) x - max (-- &M) (min (&M) (f x))) - + inv(&(SUC k))) tt n x > &0)} + <= &(SUC k) * expectation p (\x. abs(f x - max (-- &M) (min (&M) (f x))))` + ASSUME_TAC THENL + [REPEAT GEN_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `tt:A->A`; + `\x:A. abs((f:A->real) x - max (-- &M) (min (&M) (f x)))`; + `inv(&(SUC k))`] WIENER_MAXIMAL_INEQUALITY) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_ABS THEN MATCH_MP_TAC INTEGRABLE_SUB THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC ERGODIC_TRUNCATION_INTEGRABLE THEN + ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ABS_POS]; + REWRITE_TAC[REAL_LT_INV_EQ; REAL_OF_NUM_LT; LT_0]]; + REWRITE_TAC[REAL_INV_INV]]; + ALL_TAC] THEN + (* E[|f - f_M|] -> 0 *) + MP_TAC(ISPECL [`p:A prob_space`; `f:A->real`] ERGODIC_TRUNCATION_L1) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + (* Skolemize and establish helper facts *) + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SKOLEM_THM]) THEN + DISCH_THEN(X_CHOOSE_TAC `NM:num->A->bool`) THEN + REWRITE_TAC[IN_ELIM_THM] THEN + SUBGOAL_THEN `!M:num k:num. integrable (p:A prob_space) + (\x:A. abs((f:A->real) x - max (-- &M) (min (&M) (f x))) - inv(&(4 * SUC k)))` + ASSUME_TAC THENL + [REPEAT GEN_TAC THEN MATCH_MP_TAC INTEGRABLE_SUB THEN + REWRITE_TAC[INTEGRABLE_CONST] THEN + MATCH_MP_TAC INTEGRABLE_ABS THEN MATCH_MP_TAC INTEGRABLE_SUB THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC ERGODIC_TRUNCATION_INTEGRABLE THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `!M:num k:num. + {x:A | x IN prob_carrier p /\ + (?n. ergodic_maxsum (\x. abs((f:A->real) x - max (-- &M) (min (&M) (f x))) - + inv(&(4 * SUC k))) tt n x > &0)} IN prob_events (p:A prob_space)` + ASSUME_TAC THENL + [REPEAT GEN_TAC THEN + SUBGOAL_THEN `{x:A | x IN prob_carrier p /\ + (?n:num. ergodic_maxsum (\x. abs((f:A->real) x - max (-- &M) (min (&M) (f x))) - + inv(&(4 * SUC k))) tt n x > &0)} = + UNIONS (IMAGE (\n:num. {x:A | x IN prob_carrier p /\ + ergodic_maxsum (\x. abs(f x - max (-- &M) (min (&M) (f x))) - + inv(&(4 * SUC k))) tt n x > &0}) (:num))` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_UNIONS; EXISTS_IN_IMAGE; IN_UNIV] THEN + MESON_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC PROB_COUNTABLE_UNION_IN_EVENTS THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_UNIV] THEN GEN_TAC THEN + MATCH_MP_TAC ERGODIC_MAXSUM_POS_EVENT THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC COUNTABLE_IMAGE THEN REWRITE_TAC[NUM_COUNTABLE]]; + ALL_TAC] THEN + SUBGOAL_THEN `!M:num k:num. prob (p:A prob_space) + {x:A | x IN prob_carrier p /\ + (?n. ergodic_maxsum (\x. abs((f:A->real) x - max (-- &M) (min (&M) (f x))) - + inv(&(4 * SUC k))) tt n x > &0)} + <= &(4 * SUC k) * expectation p (\x. abs(f x - max (-- &M) (min (&M) (f x))))` + ASSUME_TAC THENL + [REPEAT GEN_TAC THEN + SUBGOAL_THEN `4 * SUC k = SUC(4 * k + 3)` SUBST1_TAC THENL + [ARITH_TAC; ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN `!M:num k:num. (NM:num->A->bool) M UNION + {x:A | x IN prob_carrier p /\ + (?n. ergodic_maxsum (\x. abs((f:A->real) x - max (-- &M) (min (&M) (f x))) - + inv(&(4 * SUC k))) tt n x > &0)} IN prob_events (p:A prob_space)` + ASSUME_TAC THENL + [REPEAT GEN_TAC THEN MATCH_MP_TAC PROB_UNION_IN_EVENTS THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[null_event]; + ALL_TAC] THEN + (* Each INTERS over M is a null event *) + SUBGOAL_THEN `!k:num. null_event (p:A prob_space) + (INTERS (IMAGE (\M:num. (NM:num->A->bool) M UNION + {x:A | x IN prob_carrier p /\ + (?n. ergodic_maxsum (\x. abs((f:A->real) x - max (-- &M) (min (&M) (f x))) - + inv(&(4 * SUC k))) tt n x > &0)}) (:num)))` ASSUME_TAC THENL + [X_GEN_TAC `k:num` THEN REWRITE_TAC[null_event] THEN + SUBGOAL_THEN `INTERS (IMAGE (\M:num. (NM:num->A->bool) M UNION + {x:A | x IN prob_carrier p /\ + (?n. ergodic_maxsum (\x. abs((f:A->real) x - max (-- &M) (min (&M) (f x))) - + inv(&(4 * SUC k))) tt n x > &0)}) (:num)) IN prob_events (p:A prob_space)` + ASSUME_TAC THENL + [MATCH_MP_TAC PROB_COUNTABLE_INTERS_IN_EVENTS THEN + REWRITE_TAC[IMAGE_EQ_EMPTY; UNIV_NOT_EMPTY] THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_UNIV] THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC COUNTABLE_IMAGE THEN REWRITE_TAC[NUM_COUNTABLE]]; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= &0 ==> x = &0`) THEN + CONJ_TAC THENL [MATCH_MP_TAC PROB_POSITIVE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_EPSILON THEN REWRITE_TAC[REAL_ADD_LID] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + UNDISCH_TAC `((\M. expectation (p:A prob_space) (\x. abs ((f:A->real) x - max (-- &M) (min (&M) (f x))))) ---> &0) sequentially` THEN + REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + DISCH_THEN(MP_TAC o SPEC `e / &(4 * SUC k)`) THEN + ANTS_TAC THENL + [MATCH_MP_TAC REAL_LT_DIV THEN ASM_REWRITE_TAC[REAL_OF_NUM_LT] THEN ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `M0:num` (MP_TAC o SPEC `M0:num`)) THEN + REWRITE_TAC[LE_REFL] THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `prob (p:A prob_space) + ((NM:num->A->bool) M0 UNION + {x:A | x IN prob_carrier p /\ + (?n. ergodic_maxsum (\x. abs((f:A->real) x - max (-- &M0) (min (&M0) (f x))) - + inv(&(4 * SUC k))) tt n x > &0)})` THEN + CONJ_TAC THENL + [MATCH_MP_TAC PROB_MONO THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[SUBSET; IN_INTERS; FORALL_IN_IMAGE; IN_UNIV] THEN MESON_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `prob (p:A prob_space) ((NM:num->A->bool) M0) + + prob p {x:A | x IN prob_carrier p /\ + (?n. ergodic_maxsum (\x. abs((f:A->real) x - max (-- &M0) (min (&M0) (f x))) - + inv(&(4 * SUC k))) tt n x > &0)}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC PROB_SUBADDITIVE THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[null_event]; ALL_TAC] THEN + SUBGOAL_THEN `prob (p:A prob_space) ((NM:num->A->bool) M0) = &0` SUBST1_TAC THENL + [ASM_MESON_TAC[null_event]; ALL_TAC] THEN + REWRITE_TAC[REAL_ADD_LID] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&(4 * SUC k) * expectation (p:A prob_space) (\x. abs((f:A->real) x - max (-- &M0) (min (&M0) (f x))))` THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN + SUBGOAL_THEN `e = &(4 * SUC k) * (e / &(4 * SUC k))` SUBST1_TAC THENL + [MATCH_MP_TAC(REAL_FIELD `~(c = &0) ==> e = c * (e / c)`) THEN + REWRITE_TAC[REAL_OF_NUM_EQ] THEN ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LT_LMUL THEN + CONJ_TAC THENL [REWRITE_TAC[REAL_OF_NUM_LT] THEN ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `&0 <= expectation (p:A prob_space) (\x. abs((f:A->real) x - max (-- &M0) (min (&M0) (f x))))` ASSUME_TAC THENL + [MATCH_MP_TAC EXPECTATION_POS THEN CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_ABS THEN MATCH_MP_TAC INTEGRABLE_SUB THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC ERGODIC_TRUNCATION_INTEGRABLE THEN + ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ABS_POS]]; ALL_TAC] THEN + UNDISCH_TAC `abs(expectation (p:A prob_space) (\x. abs((f:A->real) x - max (-- &M0) (min (&M0) (f x)))) - &0) < e / &(4 * SUC k)` THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + (* Provide the witness: countable union of null events *) + EXISTS_TAC `UNIONS {INTERS (IMAGE (\M:num. (NM:num->A->bool) M UNION + {x:A | x IN prob_carrier p /\ + (?n. ergodic_maxsum (\x. abs((f:A->real) x - max (-- &M) (min (&M) (f x))) - + inv(&(4 * SUC k))) tt n x > &0)}) (:num)) | k IN (:num)}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC NULL_EVENT_COUNTABLE_UNION THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + (* SUBSET: non-convergent points are in the witness *) + REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_UNIONS; EXISTS_IN_GSPEC; IN_UNIV] THEN + X_GEN_TAC `x:A` THEN STRIP_TAC THEN + MP_TAC(SPEC `\n:num. inv(&(SUC n)) * sum(0..n) (\j. (f:A->real)(ITER j tt x))` + NOT_CONVERGENT_OSCILLATION) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `k:num`) THEN + EXISTS_TAC `k:num` THEN + REWRITE_TAC[IN_INTERS; FORALL_IN_IMAGE; IN_UNIV] THEN + X_GEN_TAC `M:num` THEN + MP_TAC(ISPECL [`p:A prob_space`; `tt:A->A`; `f:A->real`; `M:num`; `SUC k`] + BIRKHOFF_OSCILLATION_CONTAINMENT) THEN + ASM_REWRITE_TAC[NOT_SUC] THEN + REWRITE_TAC[SUBSET; IN_UNION; IN_ELIM_THM] THEN + DISCH_THEN(MP_TAC o SPEC `x:A`) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + STRIP_TAC THENL + [REWRITE_TAC[IN_UNION] THEN DISJ1_TAC THEN + UNDISCH_TAC `!M:num. null_event (p:A prob_space) ((NM:num->A->bool) M) /\ + {x:A | x IN prob_carrier p /\ + ~(?L. ((\n. inv(&(SUC n)) * sum(0..n) + (\k. max (-- &M) (min (&M) ((f:A->real) (ITER k tt x))))) ---> L) sequentially)} SUBSET NM M` THEN + DISCH_THEN(MP_TAC o SPEC `M:num`) THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN STRIP_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[IN_UNION; IN_ELIM_THM] THEN DISJ2_TAC THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]] + );; + +(* The limit is T-invariant: if averages converge to L then they also + converge to L when started from tt(x) *) +let BIRKHOFF_LIMIT_INVARIANT = prove + (`!p:A prob_space tt f x L. + measure_preserving p tt /\ integrable p f /\ + x IN prob_carrier p /\ + ((\n. inv(&(SUC n)) * sum(0..n) (\k. f(ITER k tt x))) ---> L) + sequentially + ==> ((\n. inv(&(SUC n)) * sum(0..n) (\k. f(ITER k tt (tt x)))) ---> L) + sequentially`, + REPEAT STRIP_TAC THEN REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + UNDISCH_TAC `((\n. inv (&(SUC n)) * sum (0..n) (\k. (f:A->real) (ITER k tt x))) ---> L) sequentially` THEN + REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o SPEC `e / &2`) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_TAC `N1:num`) THEN + FIRST_ASSUM(MP_TAC o SPEC `&1`) THEN + ANTS_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_TAC `N3:num`) THEN + ABBREV_TAC `C = abs(L) + abs((f:A->real) x) + &1` THEN + SUBGOAL_THEN `&0 < C` ASSUME_TAC THENL + [EXPAND_TAC "C" THEN REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(SPEC `e / (&2 * C)` REAL_ARCH_INV) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_LT_MUL; REAL_OF_NUM_LT; ARITH] THEN + DISCH_THEN(X_CHOOSE_THEN `N2:num` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `MAX N1 (MAX N2 N3)` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + SUBGOAL_THEN `N1 <= n /\ N2 <= n /\ N3 <= (n:num)` STRIP_ASSUME_TAC THENL + [POP_ASSUM MP_TAC THEN ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `sum(0..n) (\k. (f:A->real)(ITER k tt (tt x))) = + sum(0..SUC n) (\k. f(ITER k tt x)) - f x` SUBST1_TAC THENL + [MP_TAC(SPECL [`f:A->real`; `tt:A->A`; `n:num`; `x:A`] ERGODIC_SUM_SHIFT) THEN + REAL_ARITH_TAC; ALL_TAC] THEN + ABBREV_TAC `a = inv(&(SUC(SUC n))) * sum(0..SUC n) (\k. (f:A->real)(ITER k tt x))` THEN + SUBGOAL_THEN `abs(a - L) < e / &2` ASSUME_TAC THENL + [EXPAND_TAC "a" THEN + UNDISCH_TAC `!n. N1 <= n ==> abs(inv(&(SUC n)) * sum(0..n) (\k. (f:A->real)(ITER k tt x)) - L) < e / &2` THEN + DISCH_THEN(MP_TAC o SPEC `SUC n`) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; REWRITE_TAC[]]; ALL_TAC] THEN + SUBGOAL_THEN `abs(a - L) < &1` ASSUME_TAC THENL + [EXPAND_TAC "a" THEN + UNDISCH_TAC `!n. N3 <= n ==> abs(inv(&(SUC n)) * sum(0..n) (\k. (f:A->real)(ITER k tt x)) - L) < &1` THEN + DISCH_THEN(MP_TAC o SPEC `SUC n`) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; REWRITE_TAC[]]; ALL_TAC] THEN + SUBGOAL_THEN `abs(a - (f:A->real) x) < C` ASSUME_TAC THENL + [UNDISCH_TAC `abs(a - L) < &1` THEN + UNDISCH_TAC `abs L + abs((f:A->real) x) + &1 = C` THEN + REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `inv(&(SUC n)) < e / (&2 * C)` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `inv(&N2)` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LE_INV2 THEN + REWRITE_TAC[REAL_OF_NUM_LT; REAL_OF_NUM_LE] THEN + UNDISCH_TAC `~(N2 = 0)` THEN UNDISCH_TAC `N2 <= (n:num)` THEN + ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `~(&(SUC n) = &0)` ASSUME_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_EQ; NOT_SUC]; ALL_TAC] THEN + SUBGOAL_THEN `~(&(SUC(SUC n)) = &0)` ASSUME_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_EQ; NOT_SUC]; ALL_TAC] THEN + SUBGOAL_THEN `inv(&(SUC n)) * (sum(0..SUC n) (\k. (f:A->real)(ITER k tt x)) - f x) - L = + (a - L) + inv(&(SUC n)) * (a - f x)` SUBST1_TAC THENL + [EXPAND_TAC "a" THEN + ABBREV_TAC `S = sum(0..SUC n) (\k. (f:A->real)(ITER k tt x))` THEN + MATCH_MP_TAC(REAL_FIELD + `~(a = &0) /\ ~(b = &0) /\ b = a + &1 + ==> inv(a) * (S - fx) - L = (inv(b) * S - L) + inv(a) * (inv(b) * S - fx)`) THEN + ASM_REWRITE_TAC[GSYM REAL_OF_NUM_SUC] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `abs(inv(&(SUC n)) * (a - (f:A->real) x)) < e / &2` ASSUME_TAC THENL + [REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_INV; REAL_ABS_NUM] THEN + SUBGOAL_THEN `e / &2 = e / (&2 * C) * C` SUBST1_TAC THENL + [REWRITE_TAC[real_div; REAL_INV_MUL; GSYM REAL_MUL_ASSOC] THEN + SUBGOAL_THEN `inv(C) * C = &1` SUBST1_TAC THENL + [MATCH_MP_TAC REAL_MUL_LINV THEN + UNDISCH_TAC `&0 < C` THEN REAL_ARITH_TAC; + REAL_ARITH_TAC]; + MATCH_MP_TAC REAL_LT_MUL2 THEN + REWRITE_TAC[REAL_LE_INV_EQ; REAL_POS; REAL_ABS_POS] THEN + UNDISCH_TAC `inv(&(SUC n)) < e / (&2 * C)` THEN + UNDISCH_TAC `abs(a - (f:A->real) x) < C` THEN + REAL_ARITH_TAC]; + ALL_TAC] THEN + UNDISCH_TAC `abs(a - L) < e / &2` THEN + UNDISCH_TAC `abs(inv(&(SUC n)) * (a - (f:A->real) x)) < e / &2` THEN + REAL_ARITH_TAC);; + +(* Under ergodicity: prob({limsup > c}) = 0 for c > E[f] (bounded case) *) +let ERGODIC_LIMSUP_NULL = prove + (`!p:A prob_space tt f C c. + ergodic p tt /\ integrable p f /\ + (!x. x IN prob_carrier p ==> abs(f x) <= C) /\ + c > expectation p f + ==> prob p {x | x IN prob_carrier p /\ + real_limsup (\n. inv(&(SUC n)) * sum(0..n) (\k. f(ITER k tt x))) > c} = &0`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `measure_preserving (p:A prob_space) (tt:A->A)` ASSUME_TAC THENL + [UNDISCH_TAC `ergodic (p:A prob_space) (tt:A->A)` THEN + REWRITE_TAC[ergodic] THEN MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `&0 <= C` ASSUME_TAC THENL + [MP_TAC(SPEC `p:A prob_space` PROB_CARRIER_NONEMPTY) THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + DISCH_THEN(X_CHOOSE_TAC `z:A`) THEN + SUBGOAL_THEN `abs((f:A->real) z) <= C` MP_TAC THENL + [ASM_SIMP_TAC[]; REAL_ARITH_TAC]; ALL_TAC] THEN + ABBREV_TAC `A = {x:A | x IN prob_carrier p /\ + real_limsup (\n. inv(&(SUC n)) * sum(0..n) (\k. (f:A->real)(ITER k tt x))) > c}` THEN + (* A is in prob_events *) + SUBGOAL_THEN `(A:A->bool) IN prob_events p` ASSUME_TAC THENL + [EXPAND_TAC "A" THEN + SUBGOAL_THEN `{x:A | x IN prob_carrier p /\ + real_limsup (\n. inv(&(SUC n)) * sum(0..n) (\k. (f:A->real)(ITER k tt x))) > c} = + prob_carrier p DIFF {x | x IN prob_carrier p /\ + real_limsup (\n. inv(&(SUC n)) * sum(0..n) (\k. f(ITER k tt x))) <= c}` + (fun th -> REWRITE_TAC[th]) THENL + [SET_TAC[real_gt; REAL_NOT_LE]; ALL_TAC] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] SIGMA_ALGEBRA_DIFF) THEN + CONJ_TAC THENL [REWRITE_TAC[PROB_SPACE_SIGMA_ALGEBRA]; ALL_TAC] THEN + CONJ_TAC THENL [REWRITE_TAC[PROB_CARRIER_IN_EVENTS]; ALL_TAC] THEN + MATCH_MP_TAC RV_LE_EVENT THEN + MP_TAC(CONV_RULE(DEPTH_CONV BETA_CONV) (ISPECL [`p:A prob_space`; + `\n (x:A). inv(&(SUC n)) * sum(0..n) (\k. (f:A->real)(ITER k tt x))`; + `\x:A. C:real`] RANDOM_VARIABLE_REAL_LIMSUP_DOMINATED)) THEN + DISCH_THEN MATCH_MP_TAC THEN + CONJ_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC INTEGRABLE_IMP_RANDOM_VARIABLE THEN + MATCH_MP_TAC ERGODIC_AVG_INTEGRABLE THEN ASM_REWRITE_TAC[]; + CONJ_TAC THENL + [REWRITE_TAC[RANDOM_VARIABLE_CONST]; + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`p:A prob_space`; `tt:A->A`; `f:A->real`; `C:real`; + `n:num`; `x:A`] ERGODIC_AVG_BOUNDED) THEN + ASM_REWRITE_TAC[]]]; ALL_TAC] THEN + (* A is T-invariant *) + SUBGOAL_THEN `invariant_event (p:A prob_space) (tt:A->A) (A:A->bool)` ASSUME_TAC THENL + [EXPAND_TAC "A" THEN REWRITE_TAC[invariant_event] THEN + CONJ_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `x:A` THEN EQ_TAC THENL + [STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`p:A prob_space`; `tt:A->A`; `f:A->real`; `C:real`] + ERGODIC_LIMSUP_SHIFT) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `x:A`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC[]; + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [ASM_MESON_TAC[MEASURE_PRESERVING_CARRIER]; ALL_TAC] THEN + MP_TAC(ISPECL [`p:A prob_space`; `tt:A->A`; `f:A->real`; `C:real`] + ERGODIC_LIMSUP_SHIFT) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `x:A`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN SUBST1_TAC THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN + (* By ergodicity: prob A = 0 or 1 *) + SUBGOAL_THEN `prob (p:A prob_space) A = &0 \/ prob p A = &1` ASSUME_TAC THENL + [UNDISCH_TAC `ergodic (p:A prob_space) (tt:A->A)` THEN REWRITE_TAC[ergodic] THEN + STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + (* Show prob A = 1 leads to contradiction via MEL *) + FIRST_X_ASSUM DISJ_CASES_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + (* MEL gives E[(f-c)*1_A] >= 0 *) + SUBGOAL_THEN `&0 <= expectation (p:A prob_space) (\x. ((f:A->real) x - c) * indicator_fn A x)` + ASSUME_TAC THENL + [MP_TAC(ISPECL [`p:A prob_space`; `tt:A->A`; + `\x:A. (f:A->real) x - c`; `A:A->bool`] MEL_INVARIANT_SET) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_SUB THEN ASM_REWRITE_TAC[INTEGRABLE_CONST]; ALL_TAC] THEN + X_GEN_TAC `x:A` THEN EXPAND_TAC "A" THEN REWRITE_TAC[IN_ELIM_THM] THEN + STRIP_TAC THEN + MP_TAC(SPECL [`\n. inv(&(SUC n)) * sum(0..n) (\k. (f:A->real)(ITER k tt x))`; + `c:real`; `--C:real`; `C:real`] REAL_LIMSUP_GT_EXISTS_BOUNDED) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN CONJ_TAC THEN GEN_TAC THEN + MP_TAC(SPECL [`p:A prob_space`; `tt:A->A`; `f:A->real`; `C:real`; + `n:num`; `x:A`] ERGODIC_AVG_BOUNDED) THEN ASM_REWRITE_TAC[] THEN + REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_TAC `m:num`) THEN EXISTS_TAC `m:num` THEN + REWRITE_TAC[] THEN MATCH_MP_TAC AVG_GT_IMP_SUM_POS THEN + FIRST_X_ASSUM(fun th -> REWRITE_TAC[BETA_RULE th]); + REWRITE_TAC[]]; ALL_TAC] THEN + (* E[(f-c)*1_A] = E[f] - c when prob A = 1 *) + (* Split: E[(f-c)*1_A] = E[(f-c)*1_carrier] - E[(f-c)*1_{carrier\A}] *) + (* The latter is 0 since prob(carrier\A) = 0 and f-c is bounded *) + SUBGOAL_THEN `prob (p:A prob_space) (prob_carrier p DIFF A) = &0` ASSUME_TAC THENL + [MP_TAC(SPECL [`p:A prob_space`; `A:A->bool`] PROB_COMPL) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `prob_carrier (p:A prob_space) DIFF A IN prob_events p` ASSUME_TAC THENL + [MATCH_MP_TAC(REWRITE_RULE[IMP_IMP] SIGMA_ALGEBRA_DIFF) THEN + REWRITE_TAC[PROB_SPACE_SIGMA_ALGEBRA; PROB_CARRIER_IN_EVENTS] THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + (* E[(f-c)*1_A] + E[(f-c)*1_{carrier\A}] = E[f-c] = E[f] - c *) + SUBGOAL_THEN `expectation (p:A prob_space) (\x. ((f:A->real) x - c) * indicator_fn A x) + + expectation p (\x. (f x - c) * indicator_fn (prob_carrier p DIFF A) x) = + expectation p f - c` ASSUME_TAC THENL + [SUBGOAL_THEN `expectation (p:A prob_space) (\x. ((f:A->real) x - c) * indicator_fn (A:A->bool) x) + + expectation p (\x. (f x - c) * indicator_fn (prob_carrier p DIFF A) x) = + expectation p (\x. (f x - c) * indicator_fn A x + (f x - c) * indicator_fn (prob_carrier p DIFF A) x)` + SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC EXPECTATION_ADD THEN CONJ_TAC THEN + MATCH_MP_TAC INTEGRABLE_MUL_INDICATOR_FN THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC INTEGRABLE_SUB THEN ASM_REWRITE_TAC[INTEGRABLE_CONST]; ALL_TAC] THEN + SUBGOAL_THEN `(\x:A. ((f:A->real) x - c) * indicator_fn (A:A->bool) x + + (f x - c) * indicator_fn (prob_carrier p DIFF A) x) = + (\x. (f x - c) * indicator_fn (prob_carrier p) x)` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; indicator_fn; IN_DIFF] THEN X_GEN_TAC `y:A` THEN + SUBGOAL_THEN `(A:A->bool) SUBSET prob_carrier p` ASSUME_TAC THENL + [EXPAND_TAC "A" THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN + GEN_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_CASES_TAC `(y:A) IN A` THEN ASM_CASES_TAC `(y:A) IN prob_carrier p` THEN + ASM_REWRITE_TAC[] THEN + TRY(UNDISCH_TAC `(A:A->bool) SUBSET prob_carrier p` THEN + REWRITE_TAC[SUBSET] THEN DISCH_THEN(MP_TAC o SPEC `y:A`) THEN + ASM_REWRITE_TAC[]) THEN + REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(CONV_RULE(DEPTH_CONV BETA_CONV) + (SPECL [`p:A prob_space`; `\x:A. (f:A->real) x - c`] + EXPECTATION_CARRIER_INDICATOR)) THEN + ANTS_TAC THENL + [MATCH_MP_TAC INTEGRABLE_SUB THEN ASM_REWRITE_TAC[INTEGRABLE_CONST]; ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN + MP_TAC(CONV_RULE(DEPTH_CONV BETA_CONV) + (SPECL [`p:A prob_space`; `f:A->real`; `\x:A. c:real`] EXPECTATION_SUB)) THEN + ASM_REWRITE_TAC[INTEGRABLE_CONST] THEN DISCH_THEN SUBST1_TAC THEN + MP_TAC(SPECL [`p:A prob_space`; `c:real`] EXPECTATION_CONST) THEN + DISCH_THEN SUBST1_TAC THEN REAL_ARITH_TAC; ALL_TAC] THEN + (* E[(f-c)*1_{carrier\A}] has absolute value bounded by (C+|c|)*prob(carrier\A) = 0 *) + SUBGOAL_THEN `abs(expectation (p:A prob_space) (\x. ((f:A->real) x - c) * + indicator_fn (prob_carrier p DIFF A) x)) <= (C + abs c) * prob p (prob_carrier p DIFF A)` + ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `expectation (p:A prob_space) + (\x. abs(((f:A->real) x - c) * indicator_fn (prob_carrier p DIFF A) x))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC EXPECTATION_ABS_BOUND THEN + MATCH_MP_TAC INTEGRABLE_MUL_INDICATOR_FN THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC INTEGRABLE_SUB THEN ASM_REWRITE_TAC[INTEGRABLE_CONST]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `expectation (p:A prob_space) + (\x:A. (C + abs c) * indicator_fn (prob_carrier p DIFF A) x)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC EXPECTATION_MONO THEN CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_ABS THEN + MATCH_MP_TAC INTEGRABLE_MUL_INDICATOR_FN THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC INTEGRABLE_SUB THEN ASM_REWRITE_TAC[INTEGRABLE_CONST]; ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_CMUL THEN REWRITE_TAC[ETA_AX] THEN + MATCH_MP_TAC INTEGRABLE_INDICATOR THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + X_GEN_TAC `y:A` THEN DISCH_TAC THEN BETA_TAC THEN + REWRITE_TAC[REAL_ABS_MUL; indicator_fn] THEN COND_CASES_TAC THENL + [REWRITE_TAC[REAL_ABS_NUM; REAL_MUL_RID] THEN + MATCH_MP_TAC(REAL_ARITH `abs(f) <= C ==> abs(f - c) <= C + abs c`) THEN + ASM_SIMP_TAC[]; + REWRITE_TAC[REAL_ABS_NUM; REAL_MUL_RZERO; REAL_LE_REFL]]; + MP_TAC(SPECL [`p:A prob_space`; `C + abs c`; + `indicator_fn (prob_carrier (p:A prob_space) DIFF A)`] EXPECTATION_CMUL) THEN + ANTS_TAC THENL + [MATCH_MP_TAC INTEGRABLE_INDICATOR THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[ETA_AX] THEN DISCH_THEN SUBST1_TAC THEN + MP_TAC(SPECL [`p:A prob_space`; `prob_carrier (p:A prob_space) DIFF A`] + EXPECTATION_INDICATOR) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN REWRITE_TAC[REAL_LE_REFL]]; ALL_TAC] THEN + (* Derive contradiction: E[f] - c >= 0 but c > E[f] *) + SUBGOAL_THEN `expectation (p:A prob_space) (\x. ((f:A->real) x - c) * indicator_fn (prob_carrier p DIFF A) x) = &0` ASSUME_TAC THENL + [MATCH_MP_TAC(REAL_ARITH `abs x <= &0 ==> x = &0`) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(C + abs c) * prob (p:A prob_space) (prob_carrier p DIFF A)` THEN + ASM_REWRITE_TAC[REAL_MUL_RZERO; REAL_LE_REFL]; ALL_TAC] THEN + SUBGOAL_THEN `expectation (p:A prob_space) (\x. ((f:A->real) x - c) * indicator_fn A x) = expectation p f - c` ASSUME_TAC THENL + [UNDISCH_TAC `expectation (p:A prob_space) (\x. ((f:A->real) x - c) * indicator_fn A x) + + expectation p (\x. (f x - c) * indicator_fn (prob_carrier p DIFF A) x) = + expectation p f - c` THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; ALL_TAC] THEN + UNDISCH_TAC `&0 <= expectation (p:A prob_space) (\x. ((f:A->real) x - c) * indicator_fn A x)` THEN + ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `c > expectation (p:A prob_space) (f:A->real)` THEN + REAL_ARITH_TAC);; + + +(* real_limsup of negation = negation of real_liminf (bounded case) *) +let REAL_LIMSUP_NEG = prove + (`!(f:num->real) C. (!n. abs(f n) <= C) + ==> real_limsup (\n. --(f n)) = --(real_liminf f)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[real_limsup; real_liminf] THEN + CONV_TAC(DEPTH_CONV BETA_CONV) THEN + SUBGOAL_THEN + `!m:num. sup {--((f:num->real) k) | k >= m} = --(inf {f k | k >= m})` + ASSUME_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC SUP_UNIQUE THEN X_GEN_TAC `c:real` THEN + EQ_TAC THENL + [DISCH_TAC THEN + SUBGOAL_THEN `--c <= inf {(f:num->real) k | k >= m}` MP_TAC THENL + [MATCH_MP_TAC REAL_LE_INF THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + EXISTS_TAC `(f:num->real) m` THEN EXISTS_TAC `m:num` THEN + REWRITE_TAC[GE; LE_REFL]; ALL_TAC] THEN + REWRITE_TAC[IN_ELIM_THM; GE] THEN + X_GEN_TAC `y:real` THEN + DISCH_THEN(X_CHOOSE_THEN `j:num` STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `--((f:num->real) j)`) THEN + ANTS_TAC THENL + [REWRITE_TAC[IN_ELIM_THM; GE] THEN EXISTS_TAC `j:num` THEN + ASM_REWRITE_TAC[]; REAL_ARITH_TAC]; ALL_TAC] THEN + MESON_TAC[REAL_ARITH `!a c. --c <= a ==> --a <= c`]; + DISCH_TAC THEN REWRITE_TAC[IN_ELIM_THM; GE] THEN + X_GEN_TAC `y:real` THEN + DISCH_THEN(X_CHOOSE_THEN `j:num` STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `inf {(f:num->real) k | k >= m} <= f j` MP_TAC THENL + [MATCH_MP_TAC INF_LE_ELEMENT THEN CONJ_TAC THENL + [EXISTS_TAC `--C:real` THEN REWRITE_TAC[IN_ELIM_THM; GE] THEN + X_GEN_TAC `z:real` THEN + DISCH_THEN(X_CHOOSE_THEN `p:num` STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `p:num`) THEN REAL_ARITH_TAC; + REWRITE_TAC[IN_ELIM_THM; GE] THEN EXISTS_TAC `j:num` THEN + ASM_REWRITE_TAC[]]; ALL_TAC] THEN + DISCH_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `--inf {(f:num->real) k | k >= m}` THEN + ASM_REWRITE_TAC[REAL_LE_NEG2]]; ALL_TAC] THEN + SUBGOAL_THEN + `{sup {--((f:num->real) k) | k >= n} | n IN (:num)} = + {--(inf {f k | k >= n}) | n IN (:num)}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_UNIV] THEN GEN_TAC THEN + EQ_TAC THEN DISCH_THEN(X_CHOOSE_THEN `m:num` SUBST1_TAC) THEN + EXISTS_TAC `m:num` THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC INF_UNIQUE THEN X_GEN_TAC `c:real` THEN EQ_TAC THENL + [REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN DISCH_TAC THEN + ONCE_REWRITE_TAC[REAL_ARITH `c <= --a <=> a <= --c`] THEN + MATCH_MP_TAC REAL_SUP_LE THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM; IN_UNIV] THEN + EXISTS_TAC `inf {(f:num->real) k | k >= 0}` THEN + EXISTS_TAC `0` THEN REFL_TAC; ALL_TAC] THEN + REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN + X_GEN_TAC `y:real` THEN + DISCH_THEN(X_CHOOSE_THEN `p:num` SUBST1_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `--(inf {(f:num->real) k | k >= p})`) THEN + ANTS_TAC THENL + [REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN EXISTS_TAC `p:num` THEN + REFL_TAC; + MESON_TAC[REAL_ARITH `!a c. c <= --a ==> a <= --c`]]; + DISCH_TAC THEN REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN + X_GEN_TAC `y:real` THEN + DISCH_THEN(X_CHOOSE_THEN `p:num` SUBST1_TAC) THEN + SUBGOAL_THEN `inf {(f:num->real) k | k >= p} <= + sup {inf {f k | k >= n} | n IN (:num)}` MP_TAC THENL + [MATCH_MP_TAC ELEMENT_LE_SUP THEN CONJ_TAC THENL + [EXISTS_TAC `C:real` THEN REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN + X_GEN_TAC `z:real` THEN + DISCH_THEN(X_CHOOSE_THEN `q:num` SUBST1_TAC) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(f:num->real) q` THEN + CONJ_TAC THENL + [MATCH_MP_TAC INF_LE_ELEMENT THEN CONJ_TAC THENL + [EXISTS_TAC `--C:real` THEN REWRITE_TAC[IN_ELIM_THM; GE] THEN + X_GEN_TAC `w:real` THEN + DISCH_THEN(X_CHOOSE_THEN `r:num` STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(SPEC `r:num` (ASSUME `!n. abs((f:num->real) n) <= C`)) THEN + REAL_ARITH_TAC; + REWRITE_TAC[IN_ELIM_THM; GE] THEN EXISTS_TAC `q:num` THEN + REWRITE_TAC[LE_REFL]]; + MP_TAC(SPEC `q:num` (ASSUME `!n. abs((f:num->real) n) <= C`)) THEN + REAL_ARITH_TAC]; + REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN EXISTS_TAC `p:num` THEN + REFL_TAC]; ALL_TAC] THEN + DISCH_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `--sup {inf {(f:num->real) k | k >= n} | n IN (:num)}` THEN + ASM_REWRITE_TAC[REAL_LE_NEG2]]);; + +(* Under ergodicity: prob({liminf < c}) = 0 for c < E[f] (bounded case) *) +let ERGODIC_LIMINF_NULL = prove + (`!p:A prob_space tt f C c. + ergodic p tt /\ integrable p f /\ + (!x. x IN prob_carrier p ==> abs(f x) <= C) /\ + c < expectation p f + ==> prob p {x | x IN prob_carrier p /\ + real_liminf (\n. inv(&(SUC n)) * sum(0..n) (\k. f(ITER k tt x))) < c} = &0`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `prob (p:A prob_space) {x | x IN prob_carrier p /\ + real_limsup (\n. inv(&(SUC n)) * sum(0..n) (\k. --((f:A->real)(ITER k tt x)))) > --c} = &0` + MP_TAC THENL + [MP_TAC(ISPECL [`p:A prob_space`; `tt:A->A`; `\x:A. --((f:A->real) x)`; + `C:real`; `--c:real`] ERGODIC_LIMSUP_NULL) THEN + REWRITE_TAC[REAL_ABS_NEG] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_NEG THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[real_gt] THEN + SUBGOAL_THEN `expectation (p:A prob_space) (\x:A. --((f:A->real) x)) = + --(expectation p f)` SUBST1_TAC THENL + [MATCH_MP_TAC EXPECTATION_NEG THEN + MATCH_MP_TAC INTEGRABLE_IMP_RANDOM_VARIABLE THEN ASM_REWRITE_TAC[]; + ASM_REAL_ARITH_TAC]]; + ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `a = b ==> a = &0 ==> b = &0`) THEN + AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN + X_GEN_TAC `x:A` THEN + ASM_CASES_TAC `(x:A) IN prob_carrier p` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `(\n. inv(&(SUC n)) * sum(0..n) (\k. --((f:A->real)(ITER k tt x)))) = + (\n. --(inv(&(SUC n)) * sum(0..n) (\k. f(ITER k tt x))))` + (fun th -> REWRITE_TAC[th]) THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + REWRITE_TAC[GSYM REAL_MUL_RNEG; GSYM SUM_NEG; REAL_NEG_NEG]; ALL_TAC] THEN + SUBGOAL_THEN `real_limsup (\n. --(inv(&(SUC n)) * sum(0..n) + (\k. (f:A->real)(ITER k tt x)))) = + --(real_liminf (\n. inv(&(SUC n)) * sum(0..n) (\k. f(ITER k tt x))))` + (fun th -> REWRITE_TAC[th]) THENL + [MP_TAC(ISPECL [`\n:num. inv(&(SUC n)) * sum(0..n) + (\k. (f:A->real)(ITER k tt x))`; `C:real`] REAL_LIMSUP_NEG) THEN + REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + X_GEN_TAC `nn:num` THEN + MP_TAC(SPECL [`p:A prob_space`; `tt:A->A`; `f:A->real`; `C:real`; + `nn:num`; `x:A`] ERGODIC_AVG_BOUNDED) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [UNDISCH_TAC `ergodic (p:A prob_space) (tt:A->A)` THEN + REWRITE_TAC[ergodic] THEN MESON_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[]; + SIMP_TAC[]]; ALL_TAC] THEN + REWRITE_TAC[real_gt; REAL_LT_NEG2]);; + +(* The bounded ergodic case: averages converge to E[f] a.s. *) +let BIRKHOFF_ERGODIC_BOUNDED = prove + (`!p:A prob_space tt f C. + ergodic p tt /\ integrable p f /\ + (!x. x IN prob_carrier p ==> abs(f x) <= C) + ==> almost_surely p + {x | ((\n. inv(&(SUC n)) * sum(0..n) (\k. f(ITER k tt x))) + ---> expectation p f) sequentially}`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `measure_preserving (p:A prob_space) (tt:A->A)` ASSUME_TAC THENL + [UNDISCH_TAC `ergodic (p:A prob_space) (tt:A->A)` THEN + REWRITE_TAC[ergodic] THEN MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `&0 <= C` ASSUME_TAC THENL + [MP_TAC(SPEC `p:A prob_space` PROB_CARRIER_NONEMPTY) THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + DISCH_THEN(X_CHOOSE_TAC `z:A`) THEN + SUBGOAL_THEN `abs((f:A->real) z) <= C` MP_TAC THENL + [ASM_SIMP_TAC[]; REAL_ARITH_TAC]; ALL_TAC] THEN + ABBREV_TAC `E = expectation (p:A prob_space) (f:A->real)` THEN + (* Limsup of averages is a random variable *) + SUBGOAL_THEN `random_variable (p:A prob_space) + (\x. real_limsup (\m. inv(&(SUC m)) * sum(0..m) (\k. (f:A->real)(ITER k tt x))))` + ASSUME_TAC THENL + [MP_TAC(CONV_RULE(DEPTH_CONV BETA_CONV) (ISPECL [`p:A prob_space`; + `\n (x:A). inv(&(SUC n)) * sum(0..n) (\k. (f:A->real)(ITER k tt x))`; + `\x:A. C:real`] RANDOM_VARIABLE_REAL_LIMSUP_DOMINATED)) THEN + DISCH_THEN MATCH_MP_TAC THEN REPEAT CONJ_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC INTEGRABLE_IMP_RANDOM_VARIABLE THEN + MATCH_MP_TAC ERGODIC_AVG_INTEGRABLE THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[RANDOM_VARIABLE_CONST]; + REPEAT STRIP_TAC THEN + MP_TAC(SPECL [`p:A prob_space`; `tt:A->A`; `f:A->real`; `C:real`; + `m:num`; `x:A`] ERGODIC_AVG_BOUNDED) THEN + ASM_REWRITE_TAC[]]; ALL_TAC] THEN + (* Limsup > c sets are in prob_events for any c *) + SUBGOAL_THEN `!c. {x:A | x IN prob_carrier p /\ + real_limsup (\m. inv(&(SUC m)) * sum(0..m) (\k. (f:A->real)(ITER k tt x))) > c} + IN prob_events p` ASSUME_TAC THENL + [GEN_TAC THEN REWRITE_TAC[real_gt] THEN + SUBGOAL_THEN `{x:A | x IN prob_carrier p /\ + c < real_limsup (\m. inv(&(SUC m)) * sum(0..m) (\k. (f:A->real)(ITER k tt x)))} = + prob_carrier p DIFF {x | x IN prob_carrier p /\ + real_limsup (\m. inv(&(SUC m)) * sum(0..m) (\k. f(ITER k tt x))) <= c}` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_DIFF; IN_ELIM_THM] THEN + MESON_TAC[REAL_NOT_LE]; ALL_TAC] THEN + REWRITE_TAC[prob_carrier] THEN + MATCH_MP_TAC SIGMA_ALGEBRA_COMPL THEN REWRITE_TAC[PROB_SPACE_SIGMA_ALGEBRA] THEN + MP_TAC(ISPECL [`p:A prob_space`; + `\x:A. real_limsup (\m. inv(&(SUC m)) * sum(0..m) (\k. (f:A->real)(ITER k tt x)))`; + `c:real`] RV_LE_EVENT) THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[GSYM prob_carrier]; ALL_TAC] THEN + (* Liminf < c sets are in prob_events for any c *) + SUBGOAL_THEN `!c. {x:A | x IN prob_carrier p /\ + real_liminf (\m. inv(&(SUC m)) * sum(0..m) (\k. (f:A->real)(ITER k tt x))) < c} + IN prob_events p` ASSUME_TAC THENL + [GEN_TAC THEN + SUBGOAL_THEN `{x:A | x IN prob_carrier p /\ + real_liminf (\m. inv(&(SUC m)) * sum(0..m) (\k. (f:A->real)(ITER k tt x))) < c} = + {x | x IN prob_carrier p /\ + real_limsup (\m. --(inv(&(SUC m)) * sum(0..m) (\k. (f:A->real)(ITER k tt x)))) > --c}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `x:A` THEN + ASM_CASES_TAC `(x:A) IN prob_carrier p` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `real_liminf (\m. inv(&(SUC m)) * sum(0..m) + (\k. (f:A->real)(ITER k tt x))) = + --(real_limsup (\m. --(inv(&(SUC m)) * sum(0..m) + (\k. f(ITER k tt x)))))` SUBST1_TAC THENL + [MP_TAC(SPECL [`\m:num. inv(&(SUC m)) * sum(0..m) + (\k. (f:A->real)(ITER k tt x))`; `C:real`] REAL_LIMSUP_NEG) THEN + ANTS_TAC THENL + [GEN_TAC THEN MP_TAC(SPECL [`p:A prob_space`; `tt:A->A`; `f:A->real`; + `C:real`; `n:num`; `x:A`] ERGODIC_AVG_BOUNDED) THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + CONV_TAC(DEPTH_CONV BETA_CONV) THEN + MESON_TAC[REAL_NEG_NEG]; ALL_TAC] THEN + REWRITE_TAC[real_gt] THEN REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[real_gt] THEN + SUBGOAL_THEN `{x:A | x IN prob_carrier p /\ + --c < real_limsup (\m. --(inv(&(SUC m)) * sum(0..m) + (\k. (f:A->real)(ITER k tt x))))} = + prob_carrier p DIFF {x | x IN prob_carrier p /\ + real_limsup (\m. --(inv(&(SUC m)) * sum(0..m) + (\k. (f:A->real)(ITER k tt x)))) <= --c}` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_DIFF; IN_ELIM_THM] THEN + MESON_TAC[REAL_NOT_LE]; ALL_TAC] THEN + REWRITE_TAC[prob_carrier] THEN + MATCH_MP_TAC SIGMA_ALGEBRA_COMPL THEN REWRITE_TAC[PROB_SPACE_SIGMA_ALGEBRA] THEN + MP_TAC(ISPECL [`p:A prob_space`; + `\x:A. real_limsup (\m. --(inv(&(SUC m)) * sum(0..m) + (\k. (f:A->real)(ITER k tt x))))`; + `--c:real`] RV_LE_EVENT) THEN + ANTS_TAC THENL + [MP_TAC(CONV_RULE(DEPTH_CONV BETA_CONV) (ISPECL [`p:A prob_space`; + `\n (x:A). --(inv(&(SUC n)) * sum(0..n) (\k. (f:A->real)(ITER k tt x)))`; + `\x:A. C:real`] RANDOM_VARIABLE_REAL_LIMSUP_DOMINATED)) THEN + DISCH_THEN MATCH_MP_TAC THEN REPEAT CONJ_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC RANDOM_VARIABLE_NEG THEN + MATCH_MP_TAC INTEGRABLE_IMP_RANDOM_VARIABLE THEN + MATCH_MP_TAC ERGODIC_AVG_INTEGRABLE THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[RANDOM_VARIABLE_CONST]; + REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ABS_NEG] THEN + MP_TAC(SPECL [`p:A prob_space`; `tt:A->A`; `f:A->real`; `C:real`; + `m:num`; `x:A`] ERGODIC_AVG_BOUNDED) THEN + ASM_REWRITE_TAC[]]; ALL_TAC] THEN + REWRITE_TAC[GSYM prob_carrier]; ALL_TAC] THEN + (* Null events for limsup > E + inv(SUC n) *) + SUBGOAL_THEN `!n. null_event (p:A prob_space) {x | x IN prob_carrier p /\ + real_limsup (\m. inv(&(SUC m)) * sum(0..m) (\k. (f:A->real)(ITER k tt x))) > + E + inv(&(SUC n))}` ASSUME_TAC THENL + [GEN_TAC THEN REWRITE_TAC[null_event] THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[]; ALL_TAC] THEN + EXPAND_TAC "E" THEN MATCH_MP_TAC ERGODIC_LIMSUP_NULL THEN + EXISTS_TAC `C:real` THEN ASM_REWRITE_TAC[real_gt] THEN + MATCH_MP_TAC(REAL_ARITH `&0 < i ==> e < e + i`) THEN + REWRITE_TAC[REAL_LT_INV_EQ; REAL_OF_NUM_LT; LT_0]; ALL_TAC] THEN + (* Null events for liminf < E - inv(SUC n) *) + SUBGOAL_THEN `!n. null_event (p:A prob_space) {x | x IN prob_carrier p /\ + real_liminf (\m. inv(&(SUC m)) * sum(0..m) (\k. (f:A->real)(ITER k tt x))) < + E - inv(&(SUC n))}` ASSUME_TAC THENL + [GEN_TAC THEN REWRITE_TAC[null_event] THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[]; ALL_TAC] THEN + EXPAND_TAC "E" THEN MATCH_MP_TAC ERGODIC_LIMINF_NULL THEN + EXISTS_TAC `C:real` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REAL_ARITH `&0 < i ==> e - i < e`) THEN + REWRITE_TAC[REAL_LT_INV_EQ; REAL_OF_NUM_LT; LT_0]; ALL_TAC] THEN + (* Construct the null set *) + REWRITE_TAC[almost_surely] THEN + EXISTS_TAC `UNIONS {(\n. {x:A | x IN prob_carrier p /\ + real_limsup (\m. inv(&(SUC m)) * sum(0..m) (\k. (f:A->real)(ITER k tt x))) > + E + inv(&(SUC n))}) n | n IN (:num)} + UNION + UNIONS {(\n. {x:A | x IN prob_carrier p /\ + real_liminf (\m. inv(&(SUC m)) * sum(0..m) (\k. (f:A->real)(ITER k tt x))) < + E - inv(&(SUC n))}) n | n IN (:num)}` THEN + CONJ_TAC THENL + [(* null_event of the union *) + MATCH_MP_TAC NULL_EVENT_UNION THEN CONJ_TAC THEN + MATCH_MP_TAC NULL_EVENT_COUNTABLE_UNION THEN + GEN_TAC THEN REWRITE_TAC[BETA_THM] THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + (* Subset: non-convergence implies membership *) + REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_UNION; IN_UNIONS; IN_UNIV] THEN + X_GEN_TAC `x:A` THEN + REWRITE_TAC[NOT_EXISTS_THM; DE_MORGAN_THM] THEN + STRIP_TAC THEN + (* Averages are bounded *) + SUBGOAL_THEN `!m. abs(inv(&(SUC m)) * sum(0..m) + (\k. (f:A->real)(ITER k tt x))) <= C` ASSUME_TAC THENL + [GEN_TAC THEN MP_TAC(SPECL [`p:A prob_space`; `tt:A->A`; `f:A->real`; + `C:real`; `m:num`; `x:A`] ERGODIC_AVG_BOUNDED) THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + ABBREV_TAC `s = (\m. inv(&(SUC m)) * sum(0..m) + (\k. (f:A->real)(ITER k tt x)))` THEN + (* If limsup <= E and liminf >= E then convergence to E *) + SUBGOAL_THEN `real_limsup s > E \/ real_liminf (s:num->real) < E` + ASSUME_TAC THENL + [MATCH_MP_TAC(TAUT `(~a /\ ~b ==> F) ==> a \/ b`) THEN + REWRITE_TAC[real_gt; REAL_NOT_LT] THEN STRIP_TAC THEN + SUBGOAL_THEN `real_limsup s = real_liminf (s:num->real)` ASSUME_TAC THENL + [REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN CONJ_TAC THENL + [UNDISCH_TAC `real_limsup (s:num->real) <= E` THEN + UNDISCH_TAC `E <= real_liminf (s:num->real)` THEN REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LIMINF_LE_LIMSUP_ABS THEN + EXISTS_TAC `C:real` THEN + EXPAND_TAC "s" THEN REWRITE_TAC[] THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN + SUBGOAL_THEN `real_limsup (s:num->real) = E` ASSUME_TAC THENL + [UNDISCH_TAC `real_limsup (s:num->real) <= E` THEN + UNDISCH_TAC `E <= real_liminf (s:num->real)` THEN + UNDISCH_TAC `real_limsup s = real_liminf (s:num->real)` THEN + REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(SPECL [`s:num->real`; `C:real`] BOUNDED_LIMSUP_LIMINF_CONVERGE) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [EXPAND_TAC "s" THEN REWRITE_TAC[] THEN ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]]; ALL_TAC] THEN + UNDISCH_TAC `real_limsup (s:num->real) = E` THEN + DISCH_THEN SUBST1_TAC THEN + UNDISCH_TAC `~((s:num->real) ---> E) sequentially` THEN + REWRITE_TAC[]; ALL_TAC] THEN + (* Use archimedean property to find the witnessing n *) + FIRST_X_ASSUM DISJ_CASES_TAC THENL + [DISJ1_TAC THEN + UNDISCH_TAC `real_limsup (s:num->real) > E` THEN + REWRITE_TAC[real_gt] THEN DISCH_TAC THEN + MP_TAC(SPEC `real_limsup s - E:real` REAL_ARCH_INV) THEN + DISCH_THEN(MP_TAC o fst o EQ_IMP_RULE) THEN + ANTS_TAC THENL + [UNDISCH_TAC `E < real_limsup (s:num->real)` THEN REAL_ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `k:num` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `{x:A | x IN prob_carrier p /\ + real_limsup (\m. inv(&(SUC m)) * sum(0..m) (\k. (f:A->real)(ITER k tt x))) > + E + inv(&(SUC k))}` THEN + CONJ_TAC THENL + [EXISTS_TAC `k:num` THEN REWRITE_TAC[BETA_THM; real_gt]; ALL_TAC] THEN + REWRITE_TAC[IN_ELIM_THM; real_gt] THEN + CONJ_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `inv(&(SUC k)) <= inv(&k:real)` MP_TAC THENL + [MATCH_MP_TAC REAL_LE_INV2 THEN + REWRITE_TAC[REAL_OF_NUM_LT; REAL_OF_NUM_LE] THEN + UNDISCH_TAC `~(k = 0)` THEN ARITH_TAC; + ALL_TAC] THEN + UNDISCH_TAC `inv(&k) < real_limsup (s:num->real) - E` THEN + EXPAND_TAC "s" THEN REAL_ARITH_TAC; + DISJ2_TAC THEN + UNDISCH_TAC `real_liminf (s:num->real) < E` THEN DISCH_TAC THEN + MP_TAC(SPEC `E - real_liminf (s:num->real)` REAL_ARCH_INV) THEN + DISCH_THEN(MP_TAC o fst o EQ_IMP_RULE) THEN + ANTS_TAC THENL + [UNDISCH_TAC `real_liminf (s:num->real) < E` THEN REAL_ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `k:num` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `{x:A | x IN prob_carrier p /\ + real_liminf (\m. inv(&(SUC m)) * sum(0..m) (\k. (f:A->real)(ITER k tt x))) < + E - inv(&(SUC k))}` THEN + CONJ_TAC THENL + [EXISTS_TAC `k:num` THEN REWRITE_TAC[BETA_THM]; ALL_TAC] THEN + REWRITE_TAC[IN_ELIM_THM] THEN + CONJ_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `inv(&(SUC k)) <= inv(&k:real)` MP_TAC THENL + [MATCH_MP_TAC REAL_LE_INV2 THEN + REWRITE_TAC[REAL_OF_NUM_LT; REAL_OF_NUM_LE] THEN + UNDISCH_TAC `~(k = 0)` THEN ARITH_TAC; + ALL_TAC] THEN + UNDISCH_TAC `inv(&k) < E - real_liminf (s:num->real)` THEN + EXPAND_TAC "s" THEN REAL_ARITH_TAC]);; + +(* The ergodic case: if tt is ergodic, the limit is E[f] a.s. + Proof: combine BIRKHOFF_ERGODIC_THEOREM (convergence), BIRKHOFF_ERGODIC_BOUNDED + (bounded limit identification), and WIENER_MAXIMAL_INEQUALITY (error control). *) +let BIRKHOFF_ERGODIC = prove + (`!p:A prob_space tt f. + ergodic p tt /\ integrable p f + ==> almost_surely p + {x | ((\n. inv(&(SUC n)) * sum(0..n) (\k. f(ITER k tt x))) + ---> expectation p f) sequentially}`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `measure_preserving (p:A prob_space) (tt:A->A)` ASSUME_TAC THENL + [UNDISCH_TAC `ergodic (p:A prob_space) (tt:A->A)` THEN + REWRITE_TAC[ergodic] THEN MESON_TAC[]; ALL_TAC] THEN + REWRITE_TAC[almost_surely] THEN + (* Step 1: Get null event from BIRKHOFF_ERGODIC_THEOREM *) + MP_TAC(ISPECL [`p:A prob_space`; `tt:A->A`; `f:A->real`] + BIRKHOFF_ERGODIC_THEOREM) THEN + ASM_REWRITE_TAC[almost_surely] THEN + DISCH_THEN(X_CHOOSE_THEN `N_f:A->bool` STRIP_ASSUME_TAC) THEN + (* Step 2: Get null events from BIRKHOFF_ERGODIC_BOUNDED for each M *) + SUBGOAL_THEN `!M:num. ?NM:A->bool. null_event (p:A prob_space) NM /\ + {x:A | x IN prob_carrier p /\ + ~(((\n. inv(&(SUC n)) * sum(0..n) + (\k. max (-- &M) (min (&M) ((f:A->real)(ITER k tt x))))) ---> + expectation p (\y. max (-- &M) (min (&M) (f y)))) sequentially)} + SUBSET NM` ASSUME_TAC THENL + [GEN_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `tt:A->A`; + `\x:A. max (-- &M) (min (&M) ((f:A->real) x))`; `&M:real`] + BIRKHOFF_ERGODIC_BOUNDED) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC ERGODIC_TRUNCATION_INTEGRABLE THEN ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC THEN REAL_ARITH_TAC]; + REWRITE_TAC[almost_surely] THEN + DISCH_THEN(X_CHOOSE_THEN `N:A->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `N:A->bool` THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN MESON_TAC[]]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SKOLEM_THM]) THEN + DISCH_THEN(X_CHOOSE_TAC `NM:num->A->bool`) THEN + (* Step 3: Wiener bound on events *) + SUBGOAL_THEN `!M:num k:num. prob (p:A prob_space) + {x:A | x IN prob_carrier p /\ + (?n. ergodic_maxsum (\x. abs((f:A->real) x - max (-- &M) (min (&M) (f x))) - + inv(&(SUC k))) tt n x > &0)} + <= &(SUC k) * expectation p (\x. abs(f x - max (-- &M) (min (&M) (f x))))` + ASSUME_TAC THENL + [REPEAT GEN_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `tt:A->A`; + `\x:A. abs((f:A->real) x - max (-- &M) (min (&M) (f x)))`; + `inv(&(SUC k))`] WIENER_MAXIMAL_INEQUALITY) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_ABS THEN MATCH_MP_TAC INTEGRABLE_SUB THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC ERGODIC_TRUNCATION_INTEGRABLE THEN + ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ABS_POS]; + REWRITE_TAC[REAL_LT_INV_EQ; REAL_OF_NUM_LT; LT_0]]; + REWRITE_TAC[REAL_INV_INV]]; + ALL_TAC] THEN + (* Step 4: Events membership for Wiener sets *) + SUBGOAL_THEN `!M:num k:num. + {x:A | x IN prob_carrier p /\ + (?n. ergodic_maxsum (\x. abs((f:A->real) x - max (-- &M) (min (&M) (f x))) - + inv(&(SUC k))) tt n x > &0)} IN prob_events (p:A prob_space)` + ASSUME_TAC THENL + [REPEAT GEN_TAC THEN + SUBGOAL_THEN `{x:A | x IN prob_carrier p /\ + (?n:num. ergodic_maxsum (\x. abs((f:A->real) x - max (-- &M) (min (&M) (f x))) - + inv(&(SUC k))) tt n x > &0)} = + UNIONS (IMAGE (\n:num. {x:A | x IN prob_carrier p /\ + ergodic_maxsum (\x. abs(f x - max (-- &M) (min (&M) (f x))) - + inv(&(SUC k))) tt n x > &0}) (:num))` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_UNIONS; EXISTS_IN_IMAGE; IN_UNIV] THEN + MESON_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC PROB_COUNTABLE_UNION_IN_EVENTS THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_UNIV] THEN X_GEN_TAC `nn:num` THEN + MATCH_MP_TAC ERGODIC_MAXSUM_POS_EVENT THEN + CONJ_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC INTEGRABLE_SUB THEN REWRITE_TAC[INTEGRABLE_CONST] THEN + MATCH_MP_TAC INTEGRABLE_ABS THEN MATCH_MP_TAC INTEGRABLE_SUB THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC ERGODIC_TRUNCATION_INTEGRABLE THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC COUNTABLE_IMAGE THEN REWRITE_TAC[NUM_COUNTABLE]]; + ALL_TAC] THEN + (* Step 5: Events membership for NM(M) UNION W(M,k) *) + SUBGOAL_THEN `!M:num k:num. (NM:num->A->bool) M UNION + {x:A | x IN prob_carrier p /\ + (?n. ergodic_maxsum (\x. abs((f:A->real) x - max (-- &M) (min (&M) (f x))) - + inv(&(SUC k))) tt n x > &0)} IN prob_events (p:A prob_space)` + ASSUME_TAC THENL + [REPEAT GEN_TAC THEN MATCH_MP_TAC PROB_UNION_IN_EVENTS THEN + ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(MP_TAC o CONJUNCT1 o SPEC `M:num`) THEN + REWRITE_TAC[null_event] THEN MESON_TAC[]; + ALL_TAC] THEN + (* Step 6: E[|f - f_M|] --> 0 *) + MP_TAC(ISPECL [`p:A prob_space`; `f:A->real`] ERGODIC_TRUNCATION_L1) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + (* Step 7: Extract M0(k) from convergence *) + SUBGOAL_THEN `!k:num. ?N0:num. !M. M >= N0 ==> + abs(expectation (p:A prob_space) + (\x. abs((f:A->real) x - max (-- &M) (min (&M) (f x)))) - &0) < + inv(&(2 * SUC k))` ASSUME_TAC THENL + [GEN_TAC THEN + UNDISCH_TAC `((\M. expectation (p:A prob_space) + (\x. abs((f:A->real) x - max (-- &M) (min (&M) (f x))))) ---> &0) sequentially` THEN + REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + DISCH_THEN(MP_TAC o SPEC `inv(&(2 * SUC k))`) THEN + REWRITE_TAC[REAL_LT_INV_EQ; REAL_OF_NUM_LT] THEN + ANTS_TAC THENL + [ARITH_TAC; + DISCH_THEN(X_CHOOSE_TAC `N0:num`) THEN EXISTS_TAC `N0:num` THEN + REWRITE_TAC[GE] THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SKOLEM_THM]) THEN + DISCH_THEN(X_CHOOSE_TAC `M0:num->num`) THEN + (* Step 8: For each k, the INTERS is null *) + SUBGOAL_THEN `!k:num. null_event (p:A prob_space) + (INTERS (IMAGE (\j:num. (NM:num->A->bool) (j + M0 k) UNION + {x:A | x IN prob_carrier p /\ + (?n. ergodic_maxsum (\x. abs((f:A->real) x - max (-- &(j + M0 k)) + (min (&(j + M0 k)) (f x))) - inv(&(2 * SUC k))) tt n x > &0)}) + (:num)))` ASSUME_TAC THENL + [X_GEN_TAC `k:num` THEN REWRITE_TAC[null_event] THEN + SUBGOAL_THEN `INTERS (IMAGE (\j:num. (NM:num->A->bool) (j + M0 k) UNION + {x:A | x IN prob_carrier p /\ + (?n. ergodic_maxsum (\x. abs((f:A->real) x - max (-- &(j + M0 k)) + (min (&(j + M0 k)) (f x))) - inv(&(2 * SUC k))) tt n x > &0)}) + (:num)) IN prob_events (p:A prob_space)` ASSUME_TAC THENL + [MATCH_MP_TAC PROB_COUNTABLE_INTERS_IN_EVENTS THEN + REWRITE_TAC[IMAGE_EQ_EMPTY; UNIV_NOT_EMPTY] THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_UNIV] THEN + SUBGOAL_THEN `2 * SUC k = SUC(2 * k + 1)` SUBST1_TAC THENL + [ARITH_TAC; ASM_REWRITE_TAC[]]; + MATCH_MP_TAC COUNTABLE_IMAGE THEN REWRITE_TAC[NUM_COUNTABLE]]; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= &0 ==> x = &0`) THEN + CONJ_TAC THENL [MATCH_MP_TAC PROB_POSITIVE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_EPSILON THEN REWRITE_TAC[REAL_ADD_LID] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + (* Choose M large enough that (2*SUC k)*E[|f-f_M|] < e *) + UNDISCH_TAC `((\M. expectation (p:A prob_space) + (\x. abs((f:A->real) x - max (-- &M) (min (&M) (f x))))) ---> &0) sequentially` THEN + REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + DISCH_THEN(MP_TAC o SPEC `e / &(2 * SUC k)`) THEN + ANTS_TAC THENL + [MATCH_MP_TAC REAL_LT_DIV THEN ASM_REWRITE_TAC[REAL_OF_NUM_LT] THEN ARITH_TAC; + ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `M1:num` (MP_TAC o SPEC `M1 + M0 (k:num):num`)) THEN + REWRITE_TAC[GE; LE_ADD] THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `prob (p:A prob_space) + ((NM:num->A->bool) (M1 + M0 (k:num)) UNION + {x:A | x IN prob_carrier p /\ + (?n. ergodic_maxsum (\x. abs((f:A->real) x - max (-- &(M1 + M0 k)) + (min (&(M1 + M0 k)) (f x))) - inv(&(2 * SUC k))) tt n x > &0)})` THEN + CONJ_TAC THENL + [MATCH_MP_TAC PROB_MONO THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[]; ALL_TAC] THEN CONJ_TAC THENL + [SUBGOAL_THEN `2 * SUC k = SUC(2 * k + 1)` SUBST1_TAC THENL + [ARITH_TAC; ASM_REWRITE_TAC[]]; ALL_TAC] THEN + REWRITE_TAC[SUBSET; IN_INTERS; FORALL_IN_IMAGE; IN_UNIV] THEN + X_GEN_TAC `y:A` THEN DISCH_THEN(MP_TAC o SPEC `M1:num`) THEN REWRITE_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `prob (p:A prob_space) ((NM:num->A->bool) (M1 + M0 (k:num))) + + prob p {x:A | x IN prob_carrier p /\ + (?n. ergodic_maxsum (\x. abs((f:A->real) x - max (-- &(M1 + M0 k)) + (min (&(M1 + M0 k)) (f x))) - inv(&(2 * SUC k))) tt n x > &0)}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC PROB_SUBADDITIVE THEN CONJ_TAC THENL + [FIRST_ASSUM(MP_TAC o CONJUNCT1 o SPEC `M1 + M0 (k:num):num`) THEN + REWRITE_TAC[null_event] THEN MESON_TAC[]; + SUBGOAL_THEN `2 * SUC k = SUC(2 * k + 1)` SUBST1_TAC THENL + [ARITH_TAC; ASM_REWRITE_TAC[]]]; ALL_TAC] THEN + SUBGOAL_THEN `prob (p:A prob_space) ((NM:num->A->bool) (M1 + M0 (k:num))) = &0` + SUBST1_TAC THENL + [FIRST_ASSUM(MP_TAC o CONJUNCT1 o SPEC `M1 + M0 (k:num):num`) THEN + REWRITE_TAC[null_event] THEN MESON_TAC[]; ALL_TAC] THEN + REWRITE_TAC[REAL_ADD_LID] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&(2 * SUC k) * expectation (p:A prob_space) + (\x. abs((f:A->real) x - max (-- &(M1 + M0 k)) (min (&(M1 + M0 k)) (f x))))` THEN + CONJ_TAC THENL + [SUBGOAL_THEN `2 * SUC k = SUC(2 * k + 1)` SUBST1_TAC THENL + [ARITH_TAC; ASM_REWRITE_TAC[]]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LT_IMP_LE THEN + SUBGOAL_THEN `e = &(2 * SUC k) * (e / &(2 * SUC k))` SUBST1_TAC THENL + [MATCH_MP_TAC(REAL_FIELD `~(c = &0) ==> e = c * (e / c)`) THEN + REWRITE_TAC[REAL_OF_NUM_EQ] THEN ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LT_LMUL THEN + CONJ_TAC THENL [REWRITE_TAC[REAL_OF_NUM_LT] THEN ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `&0 <= expectation (p:A prob_space) + (\x. abs((f:A->real) x - max (-- &(M1 + (M0:num->num) k)) (min (&(M1 + M0 k)) (f x))))` + ASSUME_TAC THENL + [MATCH_MP_TAC EXPECTATION_POS THEN CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_ABS THEN MATCH_MP_TAC INTEGRABLE_SUB THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC ERGODIC_TRUNCATION_INTEGRABLE THEN + ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ABS_POS]]; ALL_TAC] THEN + UNDISCH_TAC `abs(expectation (p:A prob_space) + (\x. abs((f:A->real) x - max (-- &(M1 + M0 k)) (min (&(M1 + M0 k)) (f x)))) - &0) < + e / &(2 * SUC k)` THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + (* Step 9: Build the total null event *) + EXISTS_TAC `(N_f:A->bool) UNION UNIONS {INTERS (IMAGE (\j:num. + (NM:num->A->bool) (j + M0 k) UNION + {x:A | x IN prob_carrier p /\ + (?n. ergodic_maxsum (\x. abs((f:A->real) x - max (-- &(j + M0 k)) + (min (&(j + M0 k)) (f x))) - inv(&(2 * SUC k))) tt n x > &0)}) + (:num)) | k IN (:num)}` THEN + CONJ_TAC THENL + [(* Show it's null *) + MATCH_MP_TAC NULL_EVENT_UNION THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC NULL_EVENT_COUNTABLE_UNION THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + (* Step 10: Show the subset inclusion *) + REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_UNION; IN_UNIONS; EXISTS_IN_GSPEC; IN_UNIV] THEN + X_GEN_TAC `x:A` THEN STRIP_TAC THEN + (* Case 1: avg(f) doesn't converge *) + ASM_CASES_TAC `?L:real. ((\n. inv(&(SUC n)) * sum(0..n) + (\k. (f:A->real)(ITER k tt x))) ---> L) sequentially` THENL + [ALL_TAC; + DISJ1_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [SUBSET]) THEN + REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[] + ] THEN + (* avg(f) converges to some L *) + FIRST_X_ASSUM(X_CHOOSE_TAC `L:real`) THEN + (* Case 2: L = E[f] - nothing to prove *) + ASM_CASES_TAC `L = expectation (p:A prob_space) (f:A->real)` THENL + [UNDISCH_TAC `((\n. inv (&(SUC n)) * sum (0..n) + (\k. (f:A->real) (ITER k tt x))) ---> L) sequentially` THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + (* Case 3: L != E[f] - show x is in the Wiener null event *) + DISJ2_TAC THEN + (* Get k such that |L - E[f]| > inv(SUC k) *) + SUBGOAL_THEN `&0 < abs(L - expectation (p:A prob_space) (f:A->real))` ASSUME_TAC THENL + [REWRITE_TAC[REAL_ABS_NZ] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(SPEC `abs(L - expectation (p:A prob_space) (f:A->real))` REAL_ARCH_INV) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `K:num` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `K:num` THEN + (* Show x is in INTERS: for all j, x in NM(j+M0 K) UNION W(j+M0 K, 2*SUC K) *) + REWRITE_TAC[IN_INTERS; FORALL_IN_IMAGE; IN_UNIV] THEN + X_GEN_TAC `j:num` THEN + ABBREV_TAC `M = (j:num) + (M0:num->num) (K:num)` THEN + (* Either avg(f_M) doesn't converge to E[f_M] or we use Wiener *) + ASM_CASES_TAC `((\n. inv(&(SUC n)) * sum(0..n) + (\k. max (-- &M) (min (&M) ((f:A->real)(ITER k tt x))))) ---> + expectation p (\y. max (-- &M) (min (&M) (f y)))) sequentially` THENL + [ALL_TAC; + (* avg(f_M) doesn't converge to E[f_M]: x in NM M *) + REWRITE_TAC[IN_UNION] THEN DISJ1_TAC THEN + FIRST_ASSUM(MP_TAC o CONJUNCT2 o SPEC `M:num`) THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN + DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[] + ] THEN + (* avg(f_M) --> E[f_M] at x. Show x in W(M, 2*SUC K). *) + REWRITE_TAC[IN_UNION; IN_ELIM_THM] THEN DISJ2_TAC THEN + ASM_REWRITE_TAC[] THEN + (* Key: |L - E[f_M]| > inv(2*SUC K), so some avg(|f-f_M|) > inv(2*SUC K) *) + (* First show |E[f_M] - E[f]| < inv(2*SUC K) since M >= M0(K) *) + SUBGOAL_THEN `abs(expectation (p:A prob_space) + (\x. abs((f:A->real) x - max (-- &M) (min (&M) (f x)))) - &0) < + inv(&(2 * SUC K))` ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPECL [`K:num`; `M:num`]) THEN + EXPAND_TAC "M" THEN REWRITE_TAC[GE; ONCE_REWRITE_RULE[ADD_SYM] LE_ADD]; + ALL_TAC] THEN + (* |E[f_M] - E[f]| <= E[|f - f_M|] < inv(2*SUC K) *) + SUBGOAL_THEN `abs(expectation (p:A prob_space) (\y. max (-- &M) (min (&M) ((f:A->real) y))) - + expectation p f) < inv(&(2 * SUC K))` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `expectation (p:A prob_space) + (\x. abs((f:A->real) x - max (-- &M) (min (&M) (f x))))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `abs(expectation (p:A prob_space) + (\x. (f:A->real) x - max (-- &M) (min (&M) (f x))))` THEN + CONJ_TAC THENL + [MP_TAC(SPECL [`p:A prob_space`; `f:A->real`; + `\x:A. max (-- &M) (min (&M) ((f:A->real) x))`] EXPECTATION_SUB) THEN + ASM_REWRITE_TAC[] THEN + ANTS_TAC THENL + [MATCH_MP_TAC ERGODIC_TRUNCATION_INTEGRABLE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN + REWRITE_TAC[REAL_ABS_SUB; REAL_LE_REFL]; + MATCH_MP_TAC EXPECTATION_ABS_BOUND THEN MATCH_MP_TAC INTEGRABLE_SUB THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC ERGODIC_TRUNCATION_INTEGRABLE THEN + ASM_REWRITE_TAC[]]; + UNDISCH_TAC `abs(expectation (p:A prob_space) + (\x. abs((f:A->real) x - max (-- &M) (min (&M) (f x)))) - &0) < + inv(&(2 * SUC K))` THEN REAL_ARITH_TAC]; + ALL_TAC] THEN + (* Therefore |L - E[f_M]| > inv(2*SUC K) *) + SUBGOAL_THEN `inv(&(2 * SUC K)) < abs(L - expectation (p:A prob_space) + (\y. max (-- &M) (min (&M) ((f:A->real) y))))` ASSUME_TAC THENL + [SUBGOAL_THEN `inv(&(2 * SUC K)) + inv(&(2 * SUC K)) <= inv(&(K:num))` + ASSUME_TAC THENL + [SUBGOAL_THEN `inv(&(2 * SUC K)) + inv(&(2 * SUC K)) = inv(&(SUC K))` + SUBST1_TAC THENL + [REWRITE_TAC[GSYM REAL_OF_NUM_MUL; REAL_INV_MUL] THEN + REWRITE_TAC[REAL_ARITH `i2 * is + i2 * is = (&2 * i2) * is`] THEN + SIMP_TAC[REAL_MUL_RINV; REAL_OF_NUM_EQ; ARITH_RULE `~(2 = 0)`] THEN + REWRITE_TAC[REAL_MUL_LID]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + REWRITE_TAC[REAL_OF_NUM_LT; REAL_OF_NUM_LE] THEN + UNDISCH_TAC `~(K = 0)` THEN ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `abs(L - expectation (p:A prob_space) (f:A->real)) <= + abs(L - expectation p (\y:A. max (-- &M) (min (&M) ((f:A->real) y)))) + + abs(expectation p (\y. max (-- &M) (min (&M) (f y))) - expectation p f)` + ASSUME_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `inv(&(2 * SUC K)) < inv(&(K:num))` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LT_INV2 THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN + UNDISCH_TAC `~(K = 0)` THEN ARITH_TAC; ALL_TAC] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + (* avg(f-f_M)(n) --> L - E[f_M] *) + SUBGOAL_THEN `((\n. inv(&(SUC n)) * sum(0..n) (\k. (f:A->real)(ITER k tt x)) - + inv(&(SUC n)) * sum(0..n) (\k. max (-- &M) (min (&M) (f(ITER k tt x))))) ---> + L - expectation (p:A prob_space) (\y. max (-- &M) (min (&M) (f y)))) sequentially` + ASSUME_TAC THENL + [MATCH_MP_TAC REALLIM_SUB THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + (* From convergence and |limit| > inv(2*SUC K): exists n with |avg(f-f_M)(n)| > inv(2*SUC K) *) + SUBGOAL_THEN `?n0:num. abs(inv(&(SUC n0)) * sum(0..n0) (\k. (f:A->real)(ITER k tt x)) - + inv(&(SUC n0)) * sum(0..n0) (\k. max (-- &M) (min (&M) (f(ITER k tt x))))) > + inv(&(2 * SUC K))` ASSUME_TAC THENL + [UNDISCH_TAC `((\n. inv(&(SUC n)) * sum(0..n) (\k. (f:A->real)(ITER k tt x)) - + inv(&(SUC n)) * sum(0..n) (\k. max (-- &M) (min (&M) (f(ITER k tt x))))) ---> + L - expectation (p:A prob_space) (\y. max (-- &M) (min (&M) ((f:A->real) y)))) sequentially` THEN + REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + DISCH_THEN(MP_TAC o SPEC `abs(L - expectation (p:A prob_space) + (\y. max (-- &M) (min (&M) ((f:A->real) y)))) - inv(&(2 * SUC K))`) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_TAC `n0:num`) THEN EXISTS_TAC `n0:num` THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n0:num`) THEN REWRITE_TAC[LE_REFL] THEN + REWRITE_TAC[real_gt] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + FIRST_X_ASSUM(X_CHOOSE_TAC `n0:num`) THEN + (* |avg(f-f_M)(n0)| > inv(2*SUC K) implies avg(|f-f_M|)(n0) > inv(2*SUC K) *) + (* by triangle inequality for sums *) + EXISTS_TAC `n0:num` THEN + (* Need: ergodic_maxsum(|f-f_M| - inv(2*SUC K)) tt n0 x > 0 *) + (* This follows from: sum(0..n0)(|f-f_M|(T^k x) - inv(2*SUC K)) > 0 *) + (* which follows from: sum(0..n0)|f-f_M|(T^k x) > (n0+1)*inv(2*SUC K) *) + (* which follows from: avg(|f-f_M|)(n0) > inv(2*SUC K) *) + (* which follows from: |avg(f-f_M)(n0)| > inv(2*SUC K) + triangle ineq *) + REWRITE_TAC[real_gt] THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN + EXISTS_TAC `sum(0..n0) (\k. (\x. abs((f:A->real) x - + max (-- &M) (min (&M) (f x))) - inv(&(2 * SUC K))) (ITER k tt x))` THEN + CONJ_TAC THENL + [ALL_TAC; REWRITE_TAC[ERGODIC_MAXSUM_GE_SUM]] THEN + REWRITE_TAC[] THEN + REWRITE_TAC[SUM_SUB_NUMSEG; SUM_CONST_NUMSEG; SUB_0] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD; ADD1] THEN + SUBGOAL_THEN `(&n0 + &1) * inv(&(2 * SUC K)) < + sum(0..n0) (\k. abs((f:A->real)(ITER k tt x) - + max (-- &M) (min (&M) (f(ITER k tt x)))))` MP_TAC THENL + [MATCH_MP_TAC REAL_LTE_TRANS THEN + EXISTS_TAC `abs(sum(0..n0) (\k. (f:A->real)(ITER k tt x) - + max (-- &M) (min (&M) (f(ITER k tt x)))))` THEN + CONJ_TAC THENL + [UNDISCH_TAC `abs + (inv (&(SUC n0)) * sum (0..n0) (\k. (f:A->real) (ITER k tt x)) - + inv (&(SUC n0)) * + sum (0..n0) (\k. max (-- &M) (min (&M) (f (ITER k tt x))))) > + inv (&(2 * SUC K))` THEN + REWRITE_TAC[real_gt; GSYM REAL_SUB_LDISTRIB; GSYM SUM_SUB_NUMSEG] THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_INV; REAL_ABS_NUM] THEN + DISCH_TAC THEN + SUBGOAL_THEN `&(SUC n0) * inv(&(2 * SUC K)) < &(SUC n0) * + (inv(&(SUC n0)) * abs(sum(0..n0) (\k. (f:A->real)(ITER k tt x) - + max (-- &M) (min (&M) (f(ITER k tt x))))))` MP_TAC THENL + [MATCH_MP_TAC REAL_LT_LMUL THEN + REWRITE_TAC[REAL_OF_NUM_LT; LT_0] THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_MUL_ASSOC] THEN + SIMP_TAC[REAL_MUL_RINV; REAL_OF_NUM_EQ; NOT_SUC] THEN + REWRITE_TAC[REAL_MUL_LID; GSYM REAL_OF_NUM_SUC]]; + REWRITE_TAC[real_ge; SUM_ABS_NUMSEG]]; + SUBGOAL_THEN `&(2 * SUC K) = &(2 * (K + 1))` (fun th -> + REWRITE_TAC[th] THEN REAL_ARITH_TAC) THEN + REWRITE_TAC[ADD1]]);; + + +(* ========================================================================= *) +(* L1 convergence of Birkhoff averages (Mean Ergodic Theorem) *) +(* ========================================================================= *) + +(* Helper: for bounded f, Birkhoff averages converge in L1 via DCT *) +let BIRKHOFF_ERGODIC_BOUNDED_L1 = prove + (`!p:A prob_space tt f B. + ergodic p tt /\ integrable p f /\ + (!x. x IN prob_carrier p ==> abs(f x) <= B) + ==> ((\n. expectation p (\x. abs(inv(&(SUC n)) * + sum(0..n) (\k. f(ITER k tt x)) - expectation p f))) ---> &0) + sequentially`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `measure_preserving (p:A prob_space) (tt:A->A)` ASSUME_TAC THENL + [UNDISCH_TAC `ergodic (p:A prob_space) (tt:A->A)` THEN + REWRITE_TAC[ergodic] THEN MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `!k:num. integrable (p:A prob_space) (\x. (f:A->real)(ITER k tt x))` + ASSUME_TAC THENL + [GEN_TAC THEN + MP_TAC(SPECL [`p:A prob_space`; `tt:A->A`; `f:A->real`; `k:num`] + EXPECTATION_ITER_COMP_PRESERVED) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + (* Use DOMINATED_CONVERGENCE_AE on |A_n(f) - E[f]| -> 0 *) + MP_TAC(ISPECL [ + `p:A prob_space`; + `\n (x:A). abs(inv(&(SUC n)) * sum(0..n) (\k. (f:A->real)(ITER k tt x)) - expectation p f)`; + `\x:A. &0`; + `\x:A. B + abs(expectation (p:A prob_space) (f:A->real))`] + DOMINATED_CONVERGENCE_AE) THEN + REWRITE_TAC[EXPECTATION_CONST; REAL_MUL_RZERO] THEN + ANTS_TAC THENL [ALL_TAC; MESON_TAC[]] THEN + REPEAT CONJ_TAC THENL + [(* Integrability of |A_n(f) - E[f]| *) + GEN_TAC THEN MATCH_MP_TAC INTEGRABLE_ABS THEN + MATCH_MP_TAC INTEGRABLE_SUB THEN CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_CMUL THEN MATCH_MP_TAC INTEGRABLE_SUM THEN + GEN_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[INTEGRABLE_CONST]]; + (* Integrability of B + |E[f]| *) + REWRITE_TAC[INTEGRABLE_CONST]; + (* Bound: |abs(A_n(f)(x) - E[f])| <= B + |E[f]| *) + GEN_TAC THEN X_GEN_TAC `x:A` THEN DISCH_TAC THEN BETA_TAC THEN + REWRITE_TAC[REAL_ABS_ABS] THEN + MATCH_MP_TAC(REAL_ARITH `abs a <= B ==> abs(a - b) <= B + abs b`) THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_INV; REAL_ABS_NUM] THEN + SUBGOAL_THEN `!k:num. ITER k (tt:A->A) x IN prob_carrier p` ASSUME_TAC THENL + [GEN_TAC THEN + SUBGOAL_THEN `measure_preserving (p:A prob_space) (ITER k (tt:A->A))` MP_TAC THENL + [MATCH_MP_TAC MEASURE_PRESERVING_ITER THEN ASM_REWRITE_TAC[]; + DISCH_THEN(MP_TAC o MATCH_MP MEASURE_PRESERVING_CARRIER) THEN + DISCH_THEN(MP_TAC o SPEC `x:A`) THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `inv(&(SUC n)) * sum(0..n) (\k:num. B)` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INV THEN REAL_ARITH_TAC; + MATCH_MP_TAC SUM_ABS_LE THEN REWRITE_TAC[FINITE_NUMSEG] THEN + X_GEN_TAC `j:num` THEN DISCH_TAC THEN ASM_SIMP_TAC[]]; + REWRITE_TAC[SUM_CONST_NUMSEG; SUB_0] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD; ADD1] THEN + SUBGOAL_THEN `inv(&n + &1) * ((&n + &1) * B) = B` (fun th -> + REWRITE_TAC[th; REAL_LE_REFL]) THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN + SIMP_TAC[REAL_MUL_LINV; REAL_ARITH `~(&n + &1 = &0)`; REAL_MUL_LID]]; + (* random_variable p (\x. 0) *) + REWRITE_TAC[RANDOM_VARIABLE_CONST]; + (* |0| <= B + |E[f]| *) + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= B ==> abs(&0) <= B + abs(e)`) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs((f:A->real) x)` THEN + REWRITE_TAC[REAL_ABS_POS] THEN ASM_SIMP_TAC[]; + (* a.s. convergence: |A_n(f)(x) - E[f]| -> 0 follows from A_n(f) -> E[f] *) + MP_TAC(ISPECL [`p:A prob_space`; `tt:A->A`; `f:A->real`] BIRKHOFF_ERGODIC) THEN + ASM_REWRITE_TAC[almost_surely] THEN + DISCH_THEN(X_CHOOSE_THEN `N:A->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `N:A->bool` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `{x:A | x IN prob_carrier p /\ + ~(x IN {x | ((\n. inv (&(SUC n)) * sum (0..n) + (\k. (f:A->real) (ITER k tt x))) ---> expectation p f) + sequentially})}` THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN + X_GEN_TAC `x:A` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `~((\n. + abs(inv (&(SUC n)) * sum (0..n) (\k. (f:A->real) (ITER k tt x)) - + expectation p f)) ---> &0) sequentially` THEN + REWRITE_TAC[CONTRAPOS_THM; REALLIM_SEQUENTIALLY] THEN + DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `NN:num` THEN + DISCH_TAC THEN X_GEN_TAC `nn:num` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `nn:num`) THEN ASM_REWRITE_TAC[] THEN + REAL_ARITH_TAC]);; + + +(* Main L1 ergodic theorem *) +let BIRKHOFF_ERGODIC_L1 = prove + (`!p:A prob_space tt f. + ergodic p tt /\ integrable p f + ==> ((\n. expectation p (\x. abs(inv(&(SUC n)) * + sum(0..n) (\k. f(ITER k tt x)) - expectation p f))) ---> &0) + sequentially`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `measure_preserving (p:A prob_space) (tt:A->A)` ASSUME_TAC THENL + [UNDISCH_TAC `ergodic (p:A prob_space) (tt:A->A)` THEN + REWRITE_TAC[ergodic] THEN MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `!k:num. integrable (p:A prob_space) (\x. (f:A->real)(ITER k tt x))` + ASSUME_TAC THENL + [GEN_TAC THEN + MP_TAC(SPECL [`p:A prob_space`; `tt:A->A`; `f:A->real`; `k:num`] + EXPECTATION_ITER_COMP_PRESERVED) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN REWRITE_TAC[REAL_SUB_RZERO] THEN + (* Get M such that E[|f - f_M|] < e/3 *) + MP_TAC(ISPECL [`p:A prob_space`; `f:A->real`] ERGODIC_TRUNCATION_L1) THEN + ASM_REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + DISCH_THEN(MP_TAC o SPEC `e / &3`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + REWRITE_TAC[REAL_SUB_RZERO] THEN + DISCH_THEN(X_CHOOSE_THEN `M0:num` (LABEL_TAC "TRUNC")) THEN + ABBREV_TAC `M = SUC M0` THEN + (* E[|f - fM|] < e/3 *) + SUBGOAL_THEN `abs(expectation (p:A prob_space) + (\x:A. abs((f:A->real) x - max (-- &M) (min (&M) (f x))))) < e / &3` + (LABEL_TAC "TRUNC_BOUND") THENL + [REMOVE_THEN "TRUNC" MATCH_MP_TAC THEN + EXPAND_TAC "M" THEN ARITH_TAC; ALL_TAC] THEN + (* Get N such that E[|A_n(fM) - E[fM]|] < e/3 for n >= N *) + SUBGOAL_THEN `integrable (p:A prob_space) + (\x:A. max (-- &M) (min (&M) ((f:A->real) x)))` (LABEL_TAC "INT_FM") THENL + [MATCH_MP_TAC ERGODIC_TRUNCATION_INTEGRABLE THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MP_TAC(ISPECL [`p:A prob_space`; `tt:A->A`; + `\x:A. max (-- &M) (min (&M) ((f:A->real) x))`; `&M`] + BIRKHOFF_ERGODIC_BOUNDED_L1) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN GEN_TAC THEN DISCH_TAC THEN REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[REALLIM_SEQUENTIALLY; REAL_SUB_RZERO] THEN + DISCH_THEN(MP_TAC o SPEC `e / &3`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` (LABEL_TAC "BOUNDED_CONV")) THEN + (* Witness: N *) + EXISTS_TAC `N:num` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + (* Strip outer abs: abs(E[|...|]) < e follows from 0 <= E[|...|] < e *) + MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x < e ==> abs x < e`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC EXPECTATION_POS THEN CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_ABS THEN MATCH_MP_TAC INTEGRABLE_SUB THEN + CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_CMUL THEN MATCH_MP_TAC INTEGRABLE_SUM THEN + X_GEN_TAC `k:num` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + ASM_REWRITE_TAC[]; + REWRITE_TAC[INTEGRABLE_CONST]]; + GEN_TAC THEN DISCH_TAC THEN REAL_ARITH_TAC]; ALL_TAC] THEN + (* E[|A_n(f) - E[f]|] < e via triangle inequality decomposition *) + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `expectation (p:A prob_space) (\x:A. + abs(inv(&(SUC n)) * sum(0..n) + (\k. (f:A->real)(ITER k tt x) - max (-- &M) (min (&M) (f(ITER k tt x))))) + + abs(inv(&(SUC n)) * sum(0..n) + (\k. max (-- &M) (min (&M) ((f:A->real)(ITER k tt x)))) - + expectation p (\y. max (-- &M) (min (&M) (f y)))) + + abs(expectation p (\y:A. max (-- &M) (min (&M) ((f:A->real) y))) - + expectation p f))` THEN + CONJ_TAC THENL + [(* E[|stuff|] <= E[|A|+|B|+|C|] via EXPECTATION_MONO + pointwise triangle *) + MATCH_MP_TAC EXPECTATION_MONO THEN CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_ABS THEN MATCH_MP_TAC INTEGRABLE_SUB THEN + CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_CMUL THEN MATCH_MP_TAC INTEGRABLE_SUM THEN + X_GEN_TAC `k:num` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + ASM_REWRITE_TAC[]; + REWRITE_TAC[INTEGRABLE_CONST]]; ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_ADD THEN CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_ABS THEN MATCH_MP_TAC INTEGRABLE_CMUL THEN + MATCH_MP_TAC INTEGRABLE_SUM THEN X_GEN_TAC `k:num` THEN DISCH_TAC THEN + REWRITE_TAC[] THEN MATCH_MP_TAC INTEGRABLE_SUB THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + MP_TAC(SPECL [`p:A prob_space`; `tt:A->A`; + `\x:A. max (-- &M) (min (&M) ((f:A->real) x))`; `k:num`] + EXPECTATION_ITER_COMP_PRESERVED) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[]]; + MATCH_MP_TAC INTEGRABLE_ADD THEN CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_ABS THEN MATCH_MP_TAC INTEGRABLE_SUB THEN + CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_CMUL THEN MATCH_MP_TAC INTEGRABLE_SUM THEN + X_GEN_TAC `k:num` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + MP_TAC(SPECL [`p:A prob_space`; `tt:A->A`; + `\x:A. max (-- &M) (min (&M) ((f:A->real) x))`; `k:num`] + EXPECTATION_ITER_COMP_PRESERVED) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[INTEGRABLE_CONST]]; + REWRITE_TAC[INTEGRABLE_CONST]]]; ALL_TAC] THEN + X_GEN_TAC `x:A` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + MATCH_MP_TAC(REAL_ARITH + `a = b + c + d ==> abs a <= abs b + abs c + abs d`) THEN + REWRITE_TAC[SUM_SUB_NUMSEG; REAL_SUB_LDISTRIB] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + (* Split E[|A|+|B|+|C|] into E[|A|] + E[|B|] + |C| via linearity *) + SUBGOAL_THEN + `expectation (p:A prob_space) (\x:A. + abs(inv(&(SUC n)) * sum(0..n) + (\k. (f:A->real)(ITER k tt x) - max (-- &M) (min (&M) (f(ITER k tt x))))) + + abs(inv(&(SUC n)) * sum(0..n) + (\k. max (-- &M) (min (&M) (f(ITER k tt x)))) - + expectation p (\y. max (-- &M) (min (&M) (f y)))) + + abs(expectation p (\y. max (-- &M) (min (&M) (f y))) - expectation p f)) = + expectation p (\x. abs(inv(&(SUC n)) * sum(0..n) + (\k. f(ITER k tt x) - max (-- &M) (min (&M) (f(ITER k tt x)))))) + + expectation p (\x. abs(inv(&(SUC n)) * sum(0..n) + (\k. max (-- &M) (min (&M) (f(ITER k tt x)))) - + expectation p (\y. max (-- &M) (min (&M) (f y))))) + + abs(expectation p (\y. max (-- &M) (min (&M) (f y))) - expectation p f)` + SUBST1_TAC THENL + [(* Linearity via EXPECTATION_ADD twice + EXPECTATION_CONST *) + MP_TAC(ISPECL [`p:A prob_space`; + `\x:A. abs(inv(&(SUC n)) * sum(0..n) + (\k. (f:A->real)(ITER k tt x) - max (-- &M) (min (&M) (f(ITER k tt x)))))`; + `\x:A. abs(inv(&(SUC n)) * sum(0..n) + (\k. max (-- &M) (min (&M) ((f:A->real)(ITER k tt x)))) - + expectation p (\y. max (-- &M) (min (&M) (f y)))) + + abs(expectation (p:A prob_space) (\y. max (-- &M) (min (&M) ((f:A->real) y))) - + expectation p f)`] + EXPECTATION_ADD) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_ABS THEN MATCH_MP_TAC INTEGRABLE_CMUL THEN + MATCH_MP_TAC INTEGRABLE_SUM THEN X_GEN_TAC `k:num` THEN DISCH_TAC THEN + REWRITE_TAC[] THEN MATCH_MP_TAC INTEGRABLE_SUB THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + MP_TAC(SPECL [`p:A prob_space`; `tt:A->A`; + `\x:A. max (-- &M) (min (&M) ((f:A->real) x))`; `k:num`] + EXPECTATION_ITER_COMP_PRESERVED) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[]]; + MATCH_MP_TAC INTEGRABLE_ADD THEN CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_ABS THEN MATCH_MP_TAC INTEGRABLE_SUB THEN + CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_CMUL THEN MATCH_MP_TAC INTEGRABLE_SUM THEN + X_GEN_TAC `k:num` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + MP_TAC(SPECL [`p:A prob_space`; `tt:A->A`; + `\x:A. max (-- &M) (min (&M) ((f:A->real) x))`; `k:num`] + EXPECTATION_ITER_COMP_PRESERVED) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[INTEGRABLE_CONST]]; + REWRITE_TAC[INTEGRABLE_CONST]]]; ALL_TAC] THEN + REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; + `\x:A. abs(inv(&(SUC n)) * sum(0..n) + (\k. max (-- &M) (min (&M) ((f:A->real)(ITER k tt x)))) - + expectation p (\y. max (-- &M) (min (&M) (f y))))`; + `\x:A. abs(expectation (p:A prob_space) + (\y. max (-- &M) (min (&M) ((f:A->real) y))) - expectation p f)`] + EXPECTATION_ADD) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_ABS THEN MATCH_MP_TAC INTEGRABLE_SUB THEN + CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_CMUL THEN MATCH_MP_TAC INTEGRABLE_SUM THEN + X_GEN_TAC `k:num` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + MP_TAC(SPECL [`p:A prob_space`; `tt:A->A`; + `\x:A. max (-- &M) (min (&M) ((f:A->real) x))`; `k:num`] + EXPECTATION_ITER_COMP_PRESERVED) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[INTEGRABLE_CONST]]; + REWRITE_TAC[INTEGRABLE_CONST]]; ALL_TAC] THEN + REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[EXPECTATION_CONST]; + ALL_TAC] THEN + (* Now bound E[|A|] + E[|B|] + |C| < e *) + MATCH_MP_TAC(REAL_ARITH + `a < e / &3 /\ b < e / &3 /\ c < e / &3 /\ &0 < e + ==> a + b + c < e`) THEN + CONJ_TAC THENL + [(* Term 1: E[|A_n(f - fM)|] <= E[|f - fM|] < e/3 *) + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `expectation (p:A prob_space) + (\x:A. abs((f:A->real) x - max (-- &M) (min (&M) (f x))))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `expectation (p:A prob_space) (\x:A. + inv(&(SUC n)) * sum(0..n) + (\k. abs((f:A->real)(ITER k tt x) - + max (-- &M) (min (&M) (f(ITER k tt x))))))` THEN + CONJ_TAC THENL + [(* |inv*sum(diff)| <= inv*sum(|diff|) *) + MATCH_MP_TAC EXPECTATION_MONO THEN CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_ABS THEN MATCH_MP_TAC INTEGRABLE_CMUL THEN + MATCH_MP_TAC INTEGRABLE_SUM THEN X_GEN_TAC `k:num` THEN DISCH_TAC THEN + REWRITE_TAC[] THEN MATCH_MP_TAC INTEGRABLE_SUB THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + MP_TAC(SPECL [`p:A prob_space`; `tt:A->A`; + `\x:A. max (-- &M) (min (&M) ((f:A->real) x))`; `k:num`] + EXPECTATION_ITER_COMP_PRESERVED) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[]]; + CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_CMUL THEN MATCH_MP_TAC INTEGRABLE_SUM THEN + X_GEN_TAC `k:num` THEN DISCH_TAC THEN REWRITE_TAC[] THEN + MATCH_MP_TAC INTEGRABLE_ABS THEN MATCH_MP_TAC INTEGRABLE_SUB THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + MP_TAC(SPECL [`p:A prob_space`; `tt:A->A`; + `\x:A. max (-- &M) (min (&M) ((f:A->real) x))`; `k:num`] + EXPECTATION_ITER_COMP_PRESERVED) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[]]; + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[] THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_INV; REAL_ABS_NUM] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INV THEN REAL_ARITH_TAC; + REWRITE_TAC[SUM_ABS_NUMSEG]]]]; + (* E[inv*sum(|f-fM| o T^k)] = E[|f-fM|] by measure-preserving *) + SUBGOAL_THEN + `!m. expectation (p:A prob_space) (\x:A. sum(0..m) + (\k. abs((f:A->real)(ITER k tt x) - + max (-- &M) (min (&M) (f(ITER k tt x)))))) = + &(SUC m) * expectation p (\x. abs(f x - max (-- &M) (min (&M) (f x))))` + ASSUME_TAC THENL + [INDUCT_TAC THENL + [REWRITE_TAC[SUM_SING_NUMSEG; ITER; ARITH_RULE `SUC 0 = 1`; REAL_MUL_LID]; + REWRITE_TAC[SUM_CLAUSES_NUMSEG; LE_0] THEN + MP_TAC(ISPECL [`p:A prob_space`; + `\x:A. sum(0..m) (\k. abs((f:A->real)(ITER k tt x) - + max (-- &M) (min (&M) (f(ITER k tt x)))))`; + `\x:A. abs((f:A->real)(ITER (SUC m) tt x) - + max (-- &M) (min (&M) (f(ITER (SUC m) tt x))))`] + EXPECTATION_ADD) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_SUM THEN X_GEN_TAC `k:num` THEN + DISCH_TAC THEN REWRITE_TAC[] THEN + MATCH_MP_TAC INTEGRABLE_ABS THEN MATCH_MP_TAC INTEGRABLE_SUB THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + MP_TAC(SPECL [`p:A prob_space`; `tt:A->A`; + `\x:A. max (-- &M) (min (&M) ((f:A->real) x))`; `k:num`] + EXPECTATION_ITER_COMP_PRESERVED) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[]]; + MATCH_MP_TAC INTEGRABLE_ABS THEN MATCH_MP_TAC INTEGRABLE_SUB THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + MP_TAC(SPECL [`p:A prob_space`; `tt:A->A`; + `\x:A. max (-- &M) (min (&M) ((f:A->real) x))`; `SUC m`] + EXPECTATION_ITER_COMP_PRESERVED) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[]]]; + ALL_TAC] THEN + REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + ASM_REWRITE_TAC[] THEN + MP_TAC(SPECL [`p:A prob_space`; `tt:A->A`; + `\x:A. abs((f:A->real) x - max (-- &M) (min (&M) (f x)))`; `SUC m`] + EXPECTATION_ITER_COMP_PRESERVED) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [MATCH_MP_TAC INTEGRABLE_ABS THEN MATCH_MP_TAC INTEGRABLE_SUB THEN + ASM_REWRITE_TAC[]; + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_SUC] THEN REAL_ARITH_TAC]]; + ALL_TAC] THEN + MP_TAC(ISPECL [`p:A prob_space`; `inv(&(SUC n))`; + `\x:A. sum(0..n) (\k. abs((f:A->real)(ITER k tt x) - + max (-- &M) (min (&M) (f(ITER k tt x)))))`] + EXPECTATION_CMUL) THEN + (ANTS_TAC THENL + [MATCH_MP_TAC INTEGRABLE_SUM THEN X_GEN_TAC `k:num` THEN DISCH_TAC THEN + REWRITE_TAC[] THEN MATCH_MP_TAC INTEGRABLE_ABS THEN + MATCH_MP_TAC INTEGRABLE_SUB THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + MP_TAC(SPECL [`p:A prob_space`; `tt:A->A`; + `\x:A. max (-- &M) (min (&M) ((f:A->real) x))`; `k:num`] + EXPECTATION_ITER_COMP_PRESERVED) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN ASM_REWRITE_TAC[]]; ALL_TAC]) THEN + REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN + DISCH_THEN SUBST1_TAC THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN + SIMP_TAC[REAL_MUL_LINV; REAL_OF_NUM_EQ; NOT_SUC; + REAL_MUL_LID; REAL_LE_REFL]]; + MATCH_MP_TAC(REAL_ARITH `abs x < e ==> x < e`) THEN ASM_REWRITE_TAC[]]; + CONJ_TAC THENL + [(* Term 2: E[|A_n(fM) - E[fM]|] < e/3 by BOUNDED_CONV *) + MATCH_MP_TAC(REAL_ARITH `abs x < e ==> x < e`) THEN + REMOVE_THEN "BOUNDED_CONV" MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + CONJ_TAC THENL + [(* Term 3: |E[fM] - E[f]| < e/3 *) + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `expectation (p:A prob_space) + (\x:A. abs((f:A->real) x - max (-- &M) (min (&M) (f x))))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `abs(expectation (p:A prob_space) + (\x:A. max (-- &M) (min (&M) ((f:A->real) x)) - f x))` THEN + CONJ_TAC THENL + [SUBGOAL_THEN `expectation (p:A prob_space) + (\y:A. max (-- &M) (min (&M) ((f:A->real) y))) - expectation p f = + expectation p (\x. max (-- &M) (min (&M) (f x)) - f x)` SUBST1_TAC THENL + [MATCH_MP_TAC(GSYM EXPECTATION_SUB) THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_LE_REFL]]; + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `expectation (p:A prob_space) + (\x:A. abs(max (-- &M) (min (&M) ((f:A->real) x)) - f x))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC EXPECTATION_ABS_BOUND THEN + MATCH_MP_TAC INTEGRABLE_SUB THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC EXPECTATION_MONO THEN CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_ABS THEN MATCH_MP_TAC INTEGRABLE_SUB THEN + ASM_REWRITE_TAC[]; + CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_ABS THEN MATCH_MP_TAC INTEGRABLE_SUB THEN + ASM_REWRITE_TAC[]; + GEN_TAC THEN DISCH_TAC THEN REAL_ARITH_TAC]]]]; + MATCH_MP_TAC(REAL_ARITH `abs x < e ==> x < e`) THEN + ASM_REWRITE_TAC[]]; + (* &0 < e *) + ASM_REWRITE_TAC[]]]]);; + +(* ======================================================================== *) +(* SLLN for stationary ergodic sequences via Birkhoff *) +(* ======================================================================== *) + +(* If X_n = X_0 o T^n for an ergodic T, then SLLN holds (a.s. version) *) +let IID_SLLN_VIA_BIRKHOFF = prove + (`!p:A prob_space tt (X:num->A->real) mu. + ergodic p tt /\ + integrable p (X 0) /\ + (!n x. x IN prob_carrier p ==> X n x = X 0 (ITER n tt x)) /\ + expectation p (X 0) = mu + ==> almost_surely p + {x | ((\n. inv(&(SUC n)) * sum(0..n) (\i. X i x)) ---> mu) + sequentially}`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC ALMOST_SURELY_SUBSET THEN + EXISTS_TAC `{x:A | ((\n. inv(&(SUC n)) * sum(0..n) + (\k. (X:num->A->real) 0 (ITER k tt x))) ---> mu) sequentially}` THEN + CONJ_TAC THENL + [SUBGOAL_THEN `mu = expectation (p:A prob_space) ((X:num->A->real) 0)` + SUBST1_TAC THENL + [ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC BIRKHOFF_ERGODIC THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[IN_ELIM_THM] THEN X_GEN_TAC `x:A` THEN DISCH_TAC THEN + SUBGOAL_THEN `!n. sum(0..n) (\i. (X:num->A->real) i (x:A)) = + sum(0..n) (\k. X 0 (ITER k (tt:A->A) x))` + (fun th -> REWRITE_TAC[th]) THEN + GEN_TAC THEN MATCH_MP_TAC SUM_EQ THEN + X_GEN_TAC `k:num` THEN REWRITE_TAC[IN_NUMSEG] THEN DISCH_TAC THEN + CONV_TAC SYM_CONV THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`k:num`; `x:A`]) THEN + ASM_REWRITE_TAC[] THEN MESON_TAC[]]);; + +(* L1 version: E[|A_n(X) - mu|] -> 0 *) +let IID_SLLN_L1_VIA_BIRKHOFF = prove + (`!p:A prob_space tt (X:num->A->real) mu. + ergodic p tt /\ + integrable p (X 0) /\ + (!n x. x IN prob_carrier p ==> X n x = X 0 (ITER n tt x)) /\ + expectation p (X 0) = mu + ==> ((\n. expectation p (\x. abs(inv(&(SUC n)) * + sum(0..n) (\i. X i x) - mu))) ---> &0) + sequentially`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN + `!n. expectation (p:A prob_space) (\x. abs(inv(&(SUC n)) * + sum(0..n) (\i. (X:num->A->real) i x) - mu)) = + expectation p (\x. abs(inv(&(SUC n)) * + sum(0..n) (\k. X 0 (ITER k (tt:A->A) x)) - mu))` + (fun th -> REWRITE_TAC[th]) THENL + [GEN_TAC THEN MATCH_MP_TAC EXPECTATION_EXT THEN + X_GEN_TAC `x:A` THEN DISCH_TAC THEN BETA_TAC THEN + AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN AP_TERM_TAC THEN + MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `k:num` THEN + REWRITE_TAC[IN_NUMSEG] THEN DISCH_TAC THEN + CONV_TAC SYM_CONV THEN FIRST_X_ASSUM(MP_TAC o SPECL [`k:num`; `x:A`]) THEN + ASM_REWRITE_TAC[] THEN SIMP_TAC[]; + SUBGOAL_THEN `mu = expectation (p:A prob_space) ((X:num->A->real) 0)` + SUBST1_TAC THENL + [ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC BIRKHOFF_ERGODIC_L1 THEN ASM_REWRITE_TAC[]]);; + +(* ======================================================================== *) +(* Mean Ergodic Theorem (von Neumann): L2 convergence of ergodic averages *) +(* ======================================================================== *) + +(* Helper: bounded integrable function has integrable square *) +let INTEGRABLE_BOUNDED_POW2 = prove + (`!p:A prob_space (g:A->real) C. + integrable p g /\ (!x. x IN prob_carrier p ==> abs(g x) <= C) + ==> integrable p (\x. g x pow 2)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC INTEGRABLE_DOMINATED THEN + EXISTS_TAC `\x:A. abs((C:real) * C)` THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC RANDOM_VARIABLE_POW THEN + MATCH_MP_TAC INTEGRABLE_IMP_RANDOM_VARIABLE THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[INTEGRABLE_CONST]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN BETA_TAC THEN + REWRITE_TAC[REAL_POW_2; REAL_ABS_MUL] THEN + REWRITE_TAC[REAL_ABS_ABS] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `C:real` THEN + ASM_SIMP_TAC[REAL_ABS_LE]]);; + +(* Mean Ergodic Theorem: bounded case *) +let MEAN_ERGODIC_BOUNDED = prove + (`!p:A prob_space tt f M. + ergodic p tt /\ + integrable p f /\ + (!x. x IN prob_carrier p ==> abs(f x) <= M) + ==> ((\n. expectation p (\x. (inv(&(SUC n)) * + sum(0..n) (\k. f(ITER k tt x)) - expectation p f) pow 2)) ---> &0) + sequentially`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + ABBREV_TAC `mu = expectation (p:A prob_space) (f:A->real)` THEN + SUBGOAL_THEN `measure_preserving (p:A prob_space) (tt:A->A)` ASSUME_TAC THENL + [UNDISCH_TAC `ergodic (p:A prob_space) (tt:A->A)` THEN + REWRITE_TAC[ergodic] THEN MESON_TAC[]; ALL_TAC] THEN + (* Key: |avg - mu| <= 2M, so (avg-mu)^2 <= 2M * |avg-mu| *) + SUBGOAL_THEN `!n x. x IN prob_carrier (p:A prob_space) + ==> abs(inv(&(SUC n)) * sum(0..n) (\k. (f:A->real)(ITER k tt x)) - mu) + <= &2 * M` (LABEL_TAC "AVG_BOUND") THENL + [REPEAT STRIP_TAC THEN + MATCH_MP_TAC(REAL_ARITH `abs a <= M /\ abs b <= M ==> abs(a - b) <= &2 * M`) THEN + CONJ_TAC THENL + [MP_TAC(SPECL [`p:A prob_space`; `tt:A->A`; `f:A->real`; `M:real`; `n:num`; `x:A`] + ERGODIC_AVG_BOUNDED) THEN ASM_REWRITE_TAC[]; + EXPAND_TAC "mu" THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `expectation (p:A prob_space) (\x:A. abs((f:A->real) x))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC EXPECTATION_ABS_BOUND THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `expectation (p:A prob_space) (\x:A. M:real)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC EXPECTATION_MONO THEN + ASM_REWRITE_TAC[INTEGRABLE_CONST] THEN + MATCH_MP_TAC INTEGRABLE_ABS THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[EXPECTATION_CONST] THEN REAL_ARITH_TAC]]]; + ALL_TAC] THEN + (* Integrable avg - mu *) + SUBGOAL_THEN `!n. integrable (p:A prob_space) + (\x:A. inv(&(SUC n)) * sum(0..n) (\k. (f:A->real)(ITER k tt x)) - mu)` + (LABEL_TAC "INT_DIFF") THENL + [GEN_TAC THEN MATCH_MP_TAC INTEGRABLE_SUB THEN + REWRITE_TAC[INTEGRABLE_CONST] THEN + MATCH_MP_TAC ERGODIC_AVG_INTEGRABLE THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + (* Integrable (avg - mu)^2 *) + SUBGOAL_THEN `!n. integrable (p:A prob_space) + (\x:A. (inv(&(SUC n)) * sum(0..n) (\k. (f:A->real)(ITER k tt x)) - mu) pow 2)` + (LABEL_TAC "INT_SQ") THENL + [GEN_TAC THEN MATCH_MP_TAC INTEGRABLE_BOUNDED_POW2 THEN + EXISTS_TAC `&2 * M` THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[]; GEN_TAC THEN DISCH_TAC THEN BETA_TAC THEN ASM_SIMP_TAC[]]; + ALL_TAC] THEN + (* Use comparison: 0 <= E[(avg-mu)^2] <= 2M * E[|avg-mu|] --> 0 *) + MATCH_MP_TAC REALLIM_NULL_COMPARISON THEN + EXISTS_TAC `\n:num. (&2 * M) * expectation (p:A prob_space) + (\x:A. abs(inv(&(SUC n)) * sum(0..n) (\k. (f:A->real)(ITER k tt x)) - mu))` THEN + CONJ_TAC THENL + [(* Eventually: |E[(avg-mu)^2]| <= 2M * E[|avg-mu|] *) + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `0` THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN BETA_TAC THEN + (* E[(avg-mu)^2] >= 0, so abs(E[...]) = E[...] *) + MATCH_MP_TAC(REAL_ARITH `&0 <= a /\ a <= b ==> abs a <= b`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC EXPECTATION_POS THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + GEN_TAC THEN DISCH_TAC THEN BETA_TAC THEN REWRITE_TAC[REAL_LE_POW_2]]; + (* E[(avg-mu)^2] <= E[2M * |avg-mu|] = 2M * E[|avg-mu|] *) + SUBGOAL_THEN `(&2 * M) * expectation (p:A prob_space) + (\x:A. abs(inv(&(SUC n)) * sum(0..n) (\k. (f:A->real)(ITER k tt x)) - mu)) = + expectation p (\x. (&2 * M) * abs(inv(&(SUC n)) * sum(0..n) + (\k. f(ITER k tt x)) - mu))` SUBST1_TAC THENL + [MATCH_MP_TAC(GSYM EXPECTATION_CMUL) THEN + MATCH_MP_TAC INTEGRABLE_ABS THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC EXPECTATION_MONO THEN REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + MATCH_MP_TAC INTEGRABLE_CMUL THEN + MATCH_MP_TAC INTEGRABLE_ABS THEN ASM_REWRITE_TAC[]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN BETA_TAC THEN + REWRITE_TAC[REAL_POW_2] THEN + (* a*a <= 2M * |a| when |a| <= 2M, i.e. |a|*|a| <= 2M*|a| *) + MATCH_MP_TAC(REAL_ARITH + `abs a * abs a <= c * abs a ==> a * a <= c * abs a`) THEN + MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN + ASM_SIMP_TAC[]]]]; + (* 2M * E[|avg-mu|] --> 0 *) + SUBGOAL_THEN + `(\n:num. (&2 * M) * expectation (p:A prob_space) + (\x:A. abs(inv(&(SUC n)) * sum(0..n) + (\k. (f:A->real)(ITER k tt x)) - mu))) = + (\n. (&2 * M) * (\n. expectation p + (\x. abs(inv(&(SUC n)) * sum(0..n) + (\k. f(ITER k tt x)) - mu))) n)` SUBST1_TAC THENL + [REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC REALLIM_NULL_LMUL THEN + EXPAND_TAC "mu" THEN + MATCH_MP_TAC BIRKHOFF_ERGODIC_L1 THEN ASM_REWRITE_TAC[]]);; + +(* Cauchy-Schwarz for finite sums: (sum a)^2 <= (n+1) * sum(a^2) *) +let SUM_SQUARE_CAUCHY_SCHWARZ = prove + (`!f:num->real n. (sum(0..n) f) pow 2 <= &(SUC n) * sum(0..n) (\i. f i pow 2)`, + GEN_TAC THEN INDUCT_TAC THENL + [REWRITE_TAC[SUM_SING_NUMSEG] THEN BETA_TAC THEN + REWRITE_TAC[ARITH_RULE `SUC 0 = 1`; REAL_MUL_LID; REAL_LE_REFL]; + REWRITE_TAC[SUM_CLAUSES_NUMSEG; LE_0] THEN BETA_TAC THEN + ABBREV_TAC `S = sum(0..n) (f:num->real)` THEN + ABBREV_TAC `Q = sum(0..n) (\i. (f:num->real) i pow 2)` THEN + ABBREV_TAC `a = (f:num->real)(SUC n)` THEN + REWRITE_TAC[GSYM REAL_OF_NUM_SUC] THEN + MATCH_MP_TAC(REAL_ARITH + `S pow 2 <= (&n + &1) * Q /\ + &0 <= Q - &2 * a * S + (&n + &1) * a pow 2 + ==> (S + a) pow 2 <= ((&n + &1) + &1) * (Q + a pow 2)`) THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[REAL_OF_NUM_SUC]; + EXPAND_TAC "Q" THEN EXPAND_TAC "S" THEN EXPAND_TAC "a" THEN + SUBGOAL_THEN `sum(0..n) (\i. (f:num->real) i pow 2) - + &2 * f(SUC n) * sum(0..n) f + (&n + &1) * f(SUC n) pow 2 = + sum(0..n) (\i. (f i - f(SUC n)) pow 2)` SUBST1_TAC THENL + [REWRITE_TAC[REAL_POW_2] THEN + REWRITE_TAC[REAL_ARITH `(a - b) * (a - b) = a * a - &2 * b * a + b * b`] THEN + REWRITE_TAC[SUM_ADD_NUMSEG; SUM_SUB_NUMSEG; SUM_LMUL; SUM_RMUL] THEN + REWRITE_TAC[SUM_CONST_NUMSEG; SUB_0] THEN + REWRITE_TAC[REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC; + MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN + GEN_TAC THEN DISCH_TAC THEN BETA_TAC THEN REWRITE_TAC[REAL_LE_POW_2]]]]);; + +(* Variance bound for ergodic averages: + E[(A_n(f) - E[f])^2] <= E[f^2] *) +let ERGODIC_AVG_VARIANCE_BOUND = prove + (`!p:A prob_space tt f. + measure_preserving p tt /\ integrable p f /\ integrable p (\x. f x pow 2) + ==> !n. expectation p + (\x. (inv(&(SUC n)) * sum(0..n) (\k. f(ITER k tt x)) - expectation p f) pow 2) + <= expectation p (\x. f x pow 2)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + ABBREV_TAC `mu = expectation (p:A prob_space) (f:A->real)` THEN + SUBGOAL_THEN `integrable (p:A prob_space) (\x:A. ((f:A->real) x - mu) pow 2)` + (LABEL_TAC "INT_SQ") THENL + [REWRITE_TAC[REAL_POW_2; + REAL_ARITH `(a - b) * (a - b) = a * a - &2 * b * a + b * b`] THEN + MATCH_MP_TAC INTEGRABLE_ADD THEN CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_SUB THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[GSYM REAL_POW_2]; + MATCH_MP_TAC INTEGRABLE_CMUL THEN + MATCH_MP_TAC INTEGRABLE_CMUL THEN ASM_REWRITE_TAC[]]; + REWRITE_TAC[INTEGRABLE_CONST]]; + ALL_TAC] THEN + X_GEN_TAC `n:num` THEN + (* Integrability of inv(n+1)*sum((f_k-mu)^2) *) + SUBGOAL_THEN `integrable (p:A prob_space) + (\x:A. inv(&(SUC n)) * sum(0..n) + (\k. ((f:A->real)(ITER k tt x) - mu) pow 2))` + (LABEL_TAC "INT_AVG") THENL + [MP_TAC(ISPECL [`p:A prob_space`; `tt:A->A`; + `\x:A. ((f:A->real) x - mu) pow 2`; `n:num`] ERGODIC_AVG_INTEGRABLE) THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[]; + ALL_TAC] THEN + (* Pointwise Cauchy-Schwarz bound *) + SUBGOAL_THEN `!x:A. + (inv(&(SUC n)) * sum(0..n) (\k. (f:A->real)(ITER k tt x)) - mu) pow 2 <= + inv(&(SUC n)) * sum(0..n) (\k. (f(ITER k tt x) - mu) pow 2)` + (LABEL_TAC "PW_BOUND") THENL + [X_GEN_TAC `x:A` THEN + MP_TAC(ISPECL [`\k. (f:A->real)(ITER k (tt:A->A) x) - mu`; `n:num`] + SUM_SQUARE_CAUCHY_SCHWARZ) THEN + BETA_TAC THEN + ABBREV_TAC `S = sum(0..n) (\k. (f:A->real)(ITER k (tt:A->A) x) - mu)` THEN + ABBREV_TAC `Q = sum(0..n) (\k. ((f:A->real)(ITER k (tt:A->A) x) - mu) pow 2)` THEN + SUBGOAL_THEN `sum(0..n) (\k. (f:A->real)(ITER k (tt:A->A) x)) = S + &(SUC n) * mu` + SUBST1_TAC THENL + [EXPAND_TAC "S" THEN ONCE_REWRITE_TAC[real_sub] THEN + REWRITE_TAC[SUM_ADD_NUMSEG; SUM_CONST_NUMSEG; SUB_0; GSYM ADD1; + SUM_NEG; REAL_NEG_NEG] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `inv(&(SUC n)) * (S + &(SUC n) * mu) - mu = inv(&(SUC n)) * S` + SUBST1_TAC THENL + [REWRITE_TAC[REAL_ADD_LDISTRIB; REAL_MUL_ASSOC] THEN + SIMP_TAC[REAL_MUL_LINV; REAL_OF_NUM_EQ; NOT_SUC; REAL_MUL_LID] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + DISCH_TAC THEN + REWRITE_TAC[REAL_POW_MUL; REAL_POW_2] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INV THEN REWRITE_TAC[REAL_POS]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `inv(&(SUC n)) * &(SUC n) * Q` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INV THEN REWRITE_TAC[REAL_POS]; + ASM_REWRITE_TAC[GSYM REAL_POW_2]]; + REWRITE_TAC[REAL_MUL_ASSOC] THEN + SIMP_TAC[REAL_MUL_LINV; REAL_OF_NUM_EQ; NOT_SUC; REAL_MUL_LID; + REAL_LE_REFL]]; + ALL_TAC] THEN + (* Integrability of (A_n-mu)^2 via domination *) + SUBGOAL_THEN `integrable (p:A prob_space) + (\x:A. (inv(&(SUC n)) * sum(0..n) (\k. (f:A->real)(ITER k tt x)) - mu) pow 2)` + (LABEL_TAC "INT_LHS") THENL + [MATCH_MP_TAC INTEGRABLE_DOMINATED THEN + EXISTS_TAC `\x:A. inv(&(SUC n)) * sum(0..n) + (\k. ((f:A->real)(ITER k tt x) - mu) pow 2)` THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC RANDOM_VARIABLE_POW THEN + MATCH_MP_TAC RANDOM_VARIABLE_SUB THEN CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_IMP_RANDOM_VARIABLE THEN + MP_TAC(ISPECL [`p:A prob_space`; `tt:A->A`; `f:A->real`; `n:num`] + ERGODIC_AVG_INTEGRABLE) THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[]; + REWRITE_TAC[RANDOM_VARIABLE_CONST]]; + ASM_REWRITE_TAC[]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN BETA_TAC THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= a /\ a <= b ==> abs a <= abs b`) THEN + CONJ_TAC THENL + [REWRITE_TAC[REAL_LE_POW_2]; + FIRST_X_ASSUM(MP_TAC o SPEC `x:A`) THEN REWRITE_TAC[]]]; + ALL_TAC] THEN + (* Main: E[(A_n-mu)^2] <= E[(f-mu)^2] <= E[f^2] *) + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `expectation (p:A prob_space) (\x:A. ((f:A->real) x - mu) pow 2)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `expectation (p:A prob_space) + (\x:A. inv(&(SUC n)) * sum(0..n) + (\k. ((f:A->real)(ITER k tt x) - mu) pow 2))` THEN + CONJ_TAC THENL + [(* E[(A_n-mu)^2] <= E[inv(n+1)*sum((f_k-mu)^2)] by EXPECTATION_MONO *) + MP_TAC(ISPECL [`p:A prob_space`; + `\x:A. (inv(&(SUC n)) * sum(0..n) (\k. (f:A->real)(ITER k tt x)) - mu) pow 2`; + `\x:A. inv(&(SUC n)) * sum(0..n) (\k. ((f:A->real)(ITER k tt x) - mu) pow 2)`] + EXPECTATION_MONO) THEN + BETA_TAC THEN ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN GEN_TAC THEN DISCH_TAC THEN ASM_REWRITE_TAC[]; + SIMP_TAC[]]; + (* E[inv(n+1)*sum((f_k-mu)^2)] = E[(f-mu)^2] by ERGODIC_AVG_EXPECTATION *) + SUBGOAL_THEN `expectation (p:A prob_space) + (\x:A. inv(&(SUC n)) * sum(0..n) + (\k. ((f:A->real)(ITER k tt x) - mu) pow 2)) = + expectation p (\x. (f x - mu) pow 2)` + (fun th -> REWRITE_TAC[th; REAL_LE_REFL]) THEN + MP_TAC(ISPECL [`p:A prob_space`; `tt:A->A`; + `\x:A. ((f:A->real) x - mu) pow 2`; `n:num`] + ERGODIC_AVG_EXPECTATION) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(fun th -> REWRITE_TAC[th])]; + (* E[(f-mu)^2] <= E[f^2] since E[(f-mu)^2] = E[f^2] - mu^2 *) + SUBGOAL_THEN `expectation (p:A prob_space) (\x:A. ((f:A->real) x - mu) pow 2) = + expectation p (\x. f x pow 2) - mu pow 2` SUBST1_TAC THENL + [SUBGOAL_THEN `(\x:A. ((f:A->real) x - mu) pow 2) = + (\x. f x pow 2 + ((-- &2 * mu) * f x + mu pow 2))` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; REAL_POW_2] THEN REAL_ARITH_TAC; + ASM_SIMP_TAC[EXPECTATION_ADD; INTEGRABLE_ADD; INTEGRABLE_CMUL; + INTEGRABLE_CONST; GSYM REAL_POW_2] THEN + ASM_SIMP_TAC[EXPECTATION_ADD; INTEGRABLE_CMUL; INTEGRABLE_CONST] THEN + ASM_SIMP_TAC[EXPECTATION_CMUL; EXPECTATION_CONST] THEN + EXPAND_TAC "mu" THEN REWRITE_TAC[REAL_POW_2] THEN REAL_ARITH_TAC]; + REWRITE_TAC[REAL_POW_2] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= m * m ==> a - m * m <= a`) THEN + REWRITE_TAC[REAL_LE_SQUARE]]]);; + +(* ------------------------------------------------------------------------- *) +(* L2 convergence of truncation: E[(f - trunc_M(f))^2] -> 0 as M -> infty. *) +(* ------------------------------------------------------------------------- *) + +let TRUNCATION_L2_CONVERGENCE = prove + (`!p:A prob_space (f:A->real). + integrable p f /\ integrable p (\x. f x pow 2) + ==> ((\M. expectation p (\x. (f x - max (-- &M) (min (&M) (f x))) pow 2)) + ---> &0) sequentially`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; + `\M (x:A). ((f:A->real) x - max (-- &M) (min (&M) (f x))) pow 2`; + `\x:A. &0:real`; + `\x:A. (f:A->real) x pow 2`] DOMINATED_CONVERGENCE) THEN + ANTS_TAC THENL + [BETA_TAC THEN REPEAT CONJ_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC INTEGRABLE_DOMINATED THEN + EXISTS_TAC `\x:A. (f:A->real) x pow 2` THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [MATCH_MP_TAC RANDOM_VARIABLE_POW THEN + MATCH_MP_TAC RANDOM_VARIABLE_SUB THEN CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_IMP_RANDOM_VARIABLE THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC INTEGRABLE_IMP_RANDOM_VARIABLE THEN + MATCH_MP_TAC ERGODIC_TRUNCATION_INTEGRABLE THEN ASM_REWRITE_TAC[]]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + SUBGOAL_THEN `(f:A->real) x pow 2 = abs(f x) pow 2` + SUBST1_TAC THENL [REWRITE_TAC[REAL_POW2_ABS]; ALL_TAC] THEN + REWRITE_TAC[REAL_ABS_POW] THEN MATCH_MP_TAC REAL_POW_LE2 THEN + REWRITE_TAC[REAL_ABS_POS; REAL_ABS_ABS; ERGODIC_TRUNCATION_ABS_BOUND]]; + ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(f:A->real) x pow 2 = abs(f x) pow 2` + SUBST1_TAC THENL [REWRITE_TAC[REAL_POW2_ABS]; ALL_TAC] THEN + REWRITE_TAC[REAL_ABS_POW] THEN MATCH_MP_TAC REAL_POW_LE2 THEN + REWRITE_TAC[REAL_ABS_POS; REAL_ABS_ABS; ERGODIC_TRUNCATION_ABS_BOUND]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + SUBGOAL_THEN `&0 = &0 pow 2` SUBST1_TAC THENL + [CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN + MATCH_MP_TAC REALLIM_POW THEN + REWRITE_TAC[ERGODIC_TRUNCATION_POINTWISE]]; + DISCH_THEN(MP_TAC o CONJUNCT2) THEN BETA_TAC THEN + SUBGOAL_THEN `expectation (p:A prob_space) (\x:A. &0) = &0` + (fun th -> REWRITE_TAC[th; INTEGRABLE_CONST]) THEN + REWRITE_TAC[EXPECTATION_CONST; REAL_MUL_RZERO]]);; + +(* ------------------------------------------------------------------------- *) +(* Integrability of (A_n(f) - E[f])^2 for square-integrable f. *) +(* ------------------------------------------------------------------------- *) + +let ERGODIC_AVG_INTEGRABLE_POW2 = prove + (`!p:A prob_space (tt:A->A) (f:A->real) n. + measure_preserving p tt /\ + integrable p f /\ integrable p (\x. f x pow 2) + ==> integrable p + (\x. (inv(&(SUC n)) * sum(0..n) (\k. f(ITER k tt x)) - + expectation p f) pow 2)`, + REPEAT STRIP_TAC THEN + ABBREV_TAC `mu = expectation (p:A prob_space) (f:A->real)` THEN + SUBGOAL_THEN `integrable (p:A prob_space) + (\x:A. inv(&(SUC n)) * sum(0..n) (\k. (f:A->real)(ITER k tt x)))` + ASSUME_TAC THENL + [MP_TAC(ISPECL [`p:A prob_space`; `tt:A->A`; `f:A->real`; `n:num`] + ERGODIC_AVG_INTEGRABLE) THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `integrable (p:A prob_space) + (\x:A. inv(&(SUC n)) * sum(0..n) (\k. ((f:A->real)(ITER k tt x) - mu) pow 2))` + ASSUME_TAC THENL + [MP_TAC(ISPECL [`p:A prob_space`; `tt:A->A`; + `\x:A. ((f:A->real) x - mu) pow 2`; `n:num`] ERGODIC_AVG_INTEGRABLE) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [SUBGOAL_THEN `(\x:A. ((f:A->real) x - mu) pow 2) = + (\x. f x pow 2 + ((-- &2 * mu) * f x + mu pow 2))` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; REAL_POW_2] THEN REAL_ARITH_TAC; + ASM_SIMP_TAC[INTEGRABLE_ADD; INTEGRABLE_CMUL; INTEGRABLE_CONST]]; + SIMP_TAC[]]; + ALL_TAC] THEN + MP_TAC(ISPECL [`p:A prob_space`; + `\x:A. (inv(&(SUC n)) * sum(0..n) (\k. (f:A->real)(ITER k tt x)) - mu) pow 2`; + `\x:A. inv(&(SUC n)) * sum(0..n) (\k. ((f:A->real)(ITER k tt x) - mu) pow 2)`] + INTEGRABLE_DOMINATED) THEN BETA_TAC THEN ANTS_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC RANDOM_VARIABLE_POW THEN + MATCH_MP_TAC INTEGRABLE_IMP_RANDOM_VARIABLE THEN + MP_TAC(ISPECL [`p:A prob_space`; + `\x:A. inv(&(SUC n)) * sum(0..n) (\k. (f:A->real)(ITER k tt x))`; + `(\x:A. mu):A->real`] INTEGRABLE_SUB) THEN + ASM_REWRITE_TAC[INTEGRABLE_CONST] THEN BETA_TAC THEN SIMP_TAC[]; + CONJ_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + REWRITE_TAC[REAL_ABS_POW] THEN + SUBGOAL_THEN `abs(inv(&(SUC n)) * sum(0..n) (\k. (f:A->real)(ITER k tt x)) - + mu) pow 2 = + (inv(&(SUC n)) * sum(0..n) (\k. f(ITER k tt x)) - mu) pow 2` + SUBST1_TAC THENL [REWRITE_TAC[REAL_POW2_ABS]; ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= b /\ a <= b ==> a <= abs b`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INV THEN REWRITE_TAC[REAL_POS]; + MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[REAL_LE_POW_2]]; + ALL_TAC] THEN + SUBGOAL_THEN `inv(&(SUC n)) * sum(0..n) (\k. (f:A->real)(ITER k tt x)) - + mu = inv(&(SUC n)) * sum(0..n) (\k. f(ITER k tt x) - mu)` + SUBST1_TAC THENL + [REWRITE_TAC[SUM_SUB_NUMSEG] THEN + REWRITE_TAC[SUM_CONST_NUMSEG; SUB_0; ADD1] THEN + REWRITE_TAC[REAL_SUB_LDISTRIB] THEN + ONCE_REWRITE_TAC[REAL_MUL_ASSOC] THEN + SIMP_TAC[REAL_MUL_LINV; REAL_OF_NUM_EQ; + ARITH_RULE `~(n + 1 = 0)`] THEN + REWRITE_TAC[REAL_MUL_LID]; + ALL_TAC] THEN + REWRITE_TAC[REAL_POW_MUL] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `inv(&(SUC n)) pow 2 * + (&(SUC n) * sum(0..n) (\k. ((f:A->real)(ITER k tt x) - mu) pow 2))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_LE_POW_2]; + MP_TAC(ISPECL [`\k. (f:A->real)(ITER k (tt:A->A) x) - mu`; + `n:num`] SUM_SQUARE_CAUCHY_SCHWARZ) THEN SIMP_TAC[]]; + ONCE_REWRITE_TAC[REAL_MUL_ASSOC] THEN + SUBGOAL_THEN `inv(&(SUC n)) pow 2 * &(SUC n) = inv(&(SUC n))` + SUBST1_TAC THENL + [REWRITE_TAC[REAL_POW_2] THEN + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN + SIMP_TAC[REAL_MUL_LINV; REAL_OF_NUM_EQ; NOT_SUC; REAL_MUL_RID]; + REWRITE_TAC[REAL_LE_REFL]]]]; + SIMP_TAC[]]);; + +(* Helper: (a+b)^2 <= 2*a^2 + 2*b^2 *) +let SQ_SUM_BOUND = prove + (`!a b. (a + b) pow 2 <= &2 * a pow 2 + &2 * b pow 2`, + REPEAT GEN_TAC THEN REWRITE_TAC[REAL_POW_2] THEN + MP_TAC(SPEC `a - b:real` REAL_LE_SQUARE) THEN REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Mean Ergodic Theorem (von Neumann): L2 convergence of ergodic averages. *) +(* For ergodic T and square-integrable f, *) +(* E[(A_n(f) - E[f])^2] -> 0 as n -> infinity. *) +(* ------------------------------------------------------------------------- *) + +let MEAN_ERGODIC_THEOREM = prove + (`!p:A prob_space (tt:A->A) (f:A->real). + ergodic p tt /\ integrable p f /\ integrable p (\x. f x pow 2) + ==> ((\n. expectation p + (\x. (inv(&(SUC n)) * sum(0..n) (\k. f(ITER k tt x)) - + expectation p f) pow 2)) ---> &0) sequentially`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `measure_preserving (p:A prob_space) (tt:A->A)` ASSUME_TAC THENL + [ASM_MESON_TAC[ergodic]; ALL_TAC] THEN + ABBREV_TAC `mu = expectation (p:A prob_space) (f:A->real)` THEN + REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN + DISCH_TAC THEN + (* Use truncation approximation: find M with E[(f-g_M)^2] < e/4 *) + MP_TAC(ISPECL [`p:A prob_space`; `f:A->real`] TRUNCATION_L2_CONVERGENCE) THEN + ASM_REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + DISCH_THEN(MP_TAC o SPEC `e / &4`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + REWRITE_TAC[REAL_SUB_RZERO] THEN DISCH_THEN(X_CHOOSE_TAC `M:num`) THEN + (* Use MEAN_ERGODIC_BOUNDED for g_M to find N *) + MP_TAC(ISPECL [`p:A prob_space`; `tt:A->A`; + `\x:A. max (-- &M) (min (&M) ((f:A->real) x))`; `&M`] + MEAN_ERGODIC_BOUNDED) THEN + ASM_REWRITE_TAC[] THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC ERGODIC_TRUNCATION_INTEGRABLE THEN ASM_REWRITE_TAC[]; + GEN_TAC THEN DISCH_TAC THEN REAL_ARITH_TAC]; + ALL_TAC] THEN + REWRITE_TAC[REALLIM_SEQUENTIALLY; REAL_SUB_RZERO] THEN + DISCH_THEN(MP_TAC o SPEC `e / &4`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN + EXISTS_TAC `N:num` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + REWRITE_TAC[REAL_SUB_RZERO] THEN + (* Abbreviate g = trunc_M(f) and h = f - g *) + ABBREV_TAC `g = \x:A. max (-- &M) (min (&M) ((f:A->real) x))` THEN + ABBREV_TAC `h = \x:A. (f:A->real) x - (g:A->real) x` THEN + (* Establish integrability of g and g^2 *) + SUBGOAL_THEN `integrable (p:A prob_space) (g:A->real)` ASSUME_TAC THENL + [EXPAND_TAC "g" THEN MATCH_MP_TAC ERGODIC_TRUNCATION_INTEGRABLE THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `integrable (p:A prob_space) (\x:A. (g:A->real) x pow 2)` + ASSUME_TAC THENL + [MATCH_MP_TAC INTEGRABLE_BOUNDED_POW2 THEN EXISTS_TAC `&M` THEN + ASM_REWRITE_TAC[] THEN GEN_TAC THEN DISCH_TAC THEN + EXPAND_TAC "g" THEN REAL_ARITH_TAC; + ALL_TAC] THEN + (* Establish integrability of h and h^2 *) + SUBGOAL_THEN `integrable (p:A prob_space) (h:A->real)` ASSUME_TAC THENL + [EXPAND_TAC "h" THEN MATCH_MP_TAC INTEGRABLE_SUB THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `integrable (p:A prob_space) (\x:A. (h:A->real) x pow 2)` + ASSUME_TAC THENL + [MATCH_MP_TAC INTEGRABLE_DOMINATED THEN + EXISTS_TAC `\x:A. (f:A->real) x pow 2` THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [MATCH_MP_TAC RANDOM_VARIABLE_POW THEN + MATCH_MP_TAC INTEGRABLE_IMP_RANDOM_VARIABLE THEN ASM_REWRITE_TAC[]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + SUBGOAL_THEN `(f:A->real) x pow 2 = abs(f x) pow 2` + SUBST1_TAC THENL [REWRITE_TAC[REAL_POW2_ABS]; ALL_TAC] THEN + REWRITE_TAC[REAL_ABS_POW] THEN MATCH_MP_TAC REAL_POW_LE2 THEN + REWRITE_TAC[REAL_ABS_POS; REAL_ABS_ABS] THEN + EXPAND_TAC "h" THEN EXPAND_TAC "g" THEN + REWRITE_TAC[ERGODIC_TRUNCATION_ABS_BOUND]]; + ALL_TAC] THEN + (* Key bound: E[(A_n(h) - E[h])^2] < e/4 *) + SUBGOAL_THEN + `expectation (p:A prob_space) + (\x:A. (inv(&(SUC n)) * sum(0..n) (\k. (h:A->real)(ITER k tt x)) - + expectation p h) pow 2) < e / &4` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `expectation (p:A prob_space) (\x:A. (h:A->real) x pow 2)` THEN + CONJ_TAC THENL + [MP_TAC(ISPECL [`p:A prob_space`; `tt:A->A`; `h:A->real`] + ERGODIC_AVG_VARIANCE_BOUND) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `n:num`) THEN + REWRITE_TAC[]; + (* E[h^2] = E[(f-g)^2] < e/4 from truncation bound *) + SUBGOAL_THEN `expectation (p:A prob_space) (\x:A. (h:A->real) x pow 2) = + expectation p (\x. ((f:A->real) x - max (-- &M) (min (&M) (f x))) pow 2)` + SUBST1_TAC THENL + [AP_TERM_TAC THEN EXPAND_TAC "h" THEN EXPAND_TAC "g" THEN REWRITE_TAC[]; + SUBGOAL_THEN `&0 <= expectation (p:A prob_space) + (\x:A. ((f:A->real) x - max (-- &M) (min (&M) (f x))) pow 2)` MP_TAC THENL + [MATCH_MP_TAC EXPECTATION_POS THEN CONJ_TAC THENL + [UNDISCH_TAC `integrable (p:A prob_space) (\x:A. (h:A->real) x pow 2)` THEN + SUBGOAL_THEN `(\x:A. (h:A->real) x pow 2) = + (\x. ((f:A->real) x - max (-- &M) (min (&M) (f x))) pow 2)` SUBST1_TAC + THENL [EXPAND_TAC "h" THEN EXPAND_TAC "g" THEN REWRITE_TAC[]; + SIMP_TAC[]]; + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[REAL_LE_POW_2]]; + FIRST_X_ASSUM(fun th -> + if free_in `N:num` (concl th) then failwith "" + else MP_TAC(SPEC `M:num` th)) THEN + REWRITE_TAC[LE_REFL] THEN REAL_ARITH_TAC]]]; + ALL_TAC] THEN + (* Key bound: E[(A_n(g) - E[g])^2] < e/4 from BOUNDED_CONV *) + SUBGOAL_THEN + `expectation (p:A prob_space) + (\x:A. (inv(&(SUC n)) * sum(0..n) (\k. (g:A->real)(ITER k tt x)) - + expectation p g) pow 2) < e / &4` ASSUME_TAC THENL + [SUBGOAL_THEN `&0 <= expectation (p:A prob_space) + (\x:A. (inv(&(SUC n)) * sum(0..n) (\k. (g:A->real)(ITER k tt x)) - + expectation p g) pow 2)` MP_TAC THENL + [MATCH_MP_TAC EXPECTATION_POS THEN CONJ_TAC THENL + [MATCH_MP_TAC ERGODIC_AVG_INTEGRABLE_POW2 THEN ASM_REWRITE_TAC[]; + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[REAL_LE_POW_2]]; + SUBGOAL_THEN `abs(expectation (p:A prob_space) + (\x:A. (inv(&(SUC n)) * + sum(0..n) (\k. max (-- &M) (min (&M) ((f:A->real)(ITER k tt x)))) - + expectation p g) pow 2)) < e / &4` MP_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[]; + SUBGOAL_THEN `(\x:A. (inv(&(SUC n)) * + sum(0..n) (\k. max (-- &M) (min (&M) ((f:A->real)(ITER k tt x)))) - + expectation p g) pow 2) = + (\x. (inv(&(SUC n)) * sum(0..n) (\k. (g:A->real)(ITER k tt x)) - + expectation p g) pow 2)` SUBST1_TAC THENL + [EXPAND_TAC "g" THEN REWRITE_TAC[]; REAL_ARITH_TAC]]]; + ALL_TAC] THEN + (* Non-negativity of the LHS expectation *) + SUBGOAL_THEN `&0 <= expectation (p:A prob_space) + (\x:A. (inv(&(SUC n)) * sum(0..n) (\k. (f:A->real)(ITER k tt x)) - mu) pow 2)` + MP_TAC THENL + [MATCH_MP_TAC EXPECTATION_POS THEN CONJ_TAC THENL + [EXPAND_TAC "mu" THEN MATCH_MP_TAC ERGODIC_AVG_INTEGRABLE_POW2 THEN + ASM_REWRITE_TAC[]; + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[REAL_LE_POW_2]]; + DISCH_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= a /\ a < e ==> abs a < e`) THEN + ASM_REWRITE_TAC[] THEN + (* Main bound: E[(A_n(f)-mu)^2] < e by splitting *) + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `expectation (p:A prob_space) + (\x:A. &2 * (inv(&(SUC n)) * sum(0..n) (\k. (h:A->real)(ITER k tt x)) - + expectation p h) pow 2 + + &2 * (inv(&(SUC n)) * sum(0..n) (\k. (g:A->real)(ITER k tt x)) - + expectation p g) pow 2)` THEN + CONJ_TAC THENL + [(* Pointwise bound via EXPECTATION_MONO *) + MATCH_MP_TAC EXPECTATION_MONO THEN CONJ_TAC THENL + [EXPAND_TAC "mu" THEN MATCH_MP_TAC ERGODIC_AVG_INTEGRABLE_POW2 THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_ADD THEN CONJ_TAC THEN + MATCH_MP_TAC INTEGRABLE_CMUL THEN + MATCH_MP_TAC ERGODIC_AVG_INTEGRABLE_POW2 THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + X_GEN_TAC `x:A` THEN DISCH_TAC THEN BETA_TAC THEN + (* (A_n(f)-mu)^2 <= 2*(A_n(h)-E[h])^2 + 2*(A_n(g)-E[g])^2 *) + (* Key: A_n(f) - mu = (A_n(h) - E[h]) + (A_n(g) - E[g]) *) + SUBGOAL_THEN `inv(&(SUC n)) * sum(0..n) (\k. (f:A->real)(ITER k tt x)) - mu = + (inv(&(SUC n)) * sum(0..n) (\k. (h:A->real)(ITER k tt x)) - expectation p h) + + (inv(&(SUC n)) * sum(0..n) (\k. (g:A->real)(ITER k tt x)) - expectation p g)` + SUBST1_TAC THENL + [SUBGOAL_THEN `!k. (f:A->real)(ITER k (tt:A->A) x) = + (h:A->real)(ITER k tt x) + (g:A->real)(ITER k tt x)` (fun th -> + REWRITE_TAC[th]) THENL + [GEN_TAC THEN EXPAND_TAC "h" THEN REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[SUM_ADD_NUMSEG; REAL_ADD_LDISTRIB] THEN + SUBGOAL_THEN `mu = expectation (p:A prob_space) (h:A->real) + + expectation p (g:A->real)` SUBST1_TAC THENL + [EXPAND_TAC "mu" THEN + SUBGOAL_THEN `(f:A->real) = (\x:A. h x + g x)` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN EXPAND_TAC "h" THEN + REAL_ARITH_TAC; + ASM_SIMP_TAC[EXPECTATION_ADD]]; + REAL_ARITH_TAC]; + (* (a+b)^2 <= 2*a^2 + 2*b^2 *) + REWRITE_TAC[SQ_SUM_BOUND]]; + (* Linearity: E[2*a^2 + 2*b^2] = 2*E[a^2] + 2*E[b^2] *) + SUBGOAL_THEN `integrable (p:A prob_space) + (\x:A. (inv(&(SUC n)) * sum(0..n) (\k. (h:A->real)(ITER k tt x)) - + expectation p h) pow 2)` ASSUME_TAC THENL + [MATCH_MP_TAC ERGODIC_AVG_INTEGRABLE_POW2 THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `integrable (p:A prob_space) + (\x:A. (inv(&(SUC n)) * sum(0..n) (\k. (g:A->real)(ITER k tt x)) - + expectation p g) pow 2)` ASSUME_TAC THENL + [MATCH_MP_TAC ERGODIC_AVG_INTEGRABLE_POW2 THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + ASM_SIMP_TAC[EXPECTATION_ADD; INTEGRABLE_CMUL; EXPECTATION_CMUL] THEN + MATCH_MP_TAC(REAL_ARITH + `a < e / &4 /\ b < e / &4 ==> &2 * a + &2 * b < e`) THEN + ASM_REWRITE_TAC[]]) diff --git a/Probability/expectation.ml b/Probability/expectation.ml index b79e0b14..29bfcff0 100644 --- a/Probability/expectation.ml +++ b/Probability/expectation.ml @@ -78,20 +78,6 @@ let OPEN_HALFLINE_AS_UNION = prove (* {x | X(x) < v} is an event - key for showing level sets are measurable *) (* Proof uses OPEN_HALFLINE_AS_UNION and countable union property *) -let RANDOM_VARIABLE_OPEN_HALFLINE = prove - (`!p:A prob_space X v. - random_variable p X - ==> {x | x IN prob_carrier p /\ X x < v} IN prob_events p`, - REPEAT STRIP_TAC THEN - REWRITE_TAC[ISPECL [`X:A->real`; `v:real`; `prob_carrier (p:A prob_space)`] - OPEN_HALFLINE_AS_UNION] THEN - MATCH_MP_TAC PROB_INDEXED_UNION_IN_EVENTS THEN - GEN_TAC THEN - FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [random_variable]) THEN - DISCH_THEN(MP_TAC o SPEC `v - inv(&n + &1)`) THEN - MATCH_MP_TAC EQ_IMP THEN AP_THM_TAC THEN AP_TERM_TAC THEN - REWRITE_TAC[EXTENSION; IN_ELIM_THM]);; - (* {x | X(x) = v} is an event (level set) *) let RANDOM_VARIABLE_LEVEL_SET = prove (`!p:A prob_space X v. @@ -107,36 +93,11 @@ let RANDOM_VARIABLE_LEVEL_SET = prove MATCH_MP_TAC PROB_DIFF_IN_EVENTS THEN CONJ_TAC THENL [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [random_variable]) THEN SIMP_TAC[]; - MATCH_MP_TAC RANDOM_VARIABLE_OPEN_HALFLINE THEN ASM_REWRITE_TAC[]]]);; - -(* {x | X(x) > v} is an event (complement of closed halfline) *) -let RANDOM_VARIABLE_GT = prove - (`!p:A prob_space X v. - random_variable p X - ==> {x | x IN prob_carrier p /\ X x > v} IN prob_events p`, - REPEAT STRIP_TAC THEN - SUBGOAL_THEN - `{x:A | x IN prob_carrier p /\ X x > v} = - prob_carrier p DIFF {x | x IN prob_carrier p /\ X x <= v}` - SUBST1_TAC THENL - [SET_TAC[REAL_ARITH `!x v:real. x > v <=> ~(x <= v)`]; - MATCH_MP_TAC PROB_COMPL_IN_EVENTS THEN - FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [random_variable]) THEN - SIMP_TAC[]]);; + MATCH_MP_TAC RV_PREIMAGE_LT THEN ASM_REWRITE_TAC[]]]);; -(* {x | X(x) >= v} is an event (complement of open halfline) *) -let RANDOM_VARIABLE_GE = prove - (`!p:A prob_space X v. - random_variable p X - ==> {x | x IN prob_carrier p /\ X x >= v} IN prob_events p`, - REPEAT STRIP_TAC THEN - SUBGOAL_THEN - `{x:A | x IN prob_carrier p /\ X x >= v} = - prob_carrier p DIFF {x | x IN prob_carrier p /\ X x < v}` - SUBST1_TAC THENL - [SET_TAC[REAL_ARITH `!x v:real. x >= v <=> ~(x < v)`]; - MATCH_MP_TAC PROB_COMPL_IN_EVENTS THEN - MATCH_MP_TAC RANDOM_VARIABLE_OPEN_HALFLINE THEN ASM_REWRITE_TAC[]]);; +(* The {X > v} and {X >= v} event facts are RV_PREIMAGE_GT / RV_PREIMAGE_GE *) +(* from random_variables.ml; the duplicate re-proofs formerly here have been *) +(* removed in favour of those canonical names. *) (* {x | a < X(x) < b} is an event (open interval) *) let RANDOM_VARIABLE_OPEN_INTERVAL = prove @@ -151,8 +112,8 @@ let RANDOM_VARIABLE_OPEN_INTERVAL = prove SUBST1_TAC THENL [SET_TAC[REAL_ARITH `!x a:real. x > a <=> a < x`]; MATCH_MP_TAC PROB_INTER_IN_EVENTS THEN CONJ_TAC THENL - [MATCH_MP_TAC RANDOM_VARIABLE_OPEN_HALFLINE THEN ASM_REWRITE_TAC[]; - MATCH_MP_TAC RANDOM_VARIABLE_GT THEN ASM_REWRITE_TAC[]]]);; + [MATCH_MP_TAC RV_PREIMAGE_LT THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC RV_PREIMAGE_GT THEN ASM_REWRITE_TAC[]]]);; (* {t | t < b} is real_open *) let REAL_OPEN_HALFSPACE_LT = prove @@ -162,28 +123,6 @@ let REAL_OPEN_HALFSPACE_LT = prove EXISTS_TAC `b - t:real` THEN CONJ_TAC THENL [ASM_REAL_ARITH_TAC; GEN_TAC THEN REAL_ARITH_TAC]);; -(* Continuous preimage of real_open set is real_open *) -let REAL_CONTINUOUS_OPEN_PREIMAGE_UNIV = prove - (`!f U. f real_continuous_on (:real) /\ real_open U - ==> real_open {t | f t IN U}`, - REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[real_open; IN_ELIM_THM] THEN - X_GEN_TAC `x:real` THEN DISCH_TAC THEN - FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [real_open]) THEN - DISCH_THEN(MP_TAC o SPEC `(f:real->real) x`) THEN - ASM_REWRITE_TAC[] THEN - DISCH_THEN(X_CHOOSE_THEN `eps:real` STRIP_ASSUME_TAC) THEN - FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [real_continuous_on]) THEN - DISCH_THEN(MP_TAC o SPEC `x:real`) THEN - REWRITE_TAC[IN_UNIV] THEN - DISCH_THEN(MP_TAC o SPEC `eps:real`) THEN - ASM_REWRITE_TAC[] THEN - DISCH_THEN(X_CHOOSE_THEN `d:real` STRIP_ASSUME_TAC) THEN - EXISTS_TAC `d:real` THEN ASM_REWRITE_TAC[] THEN - X_GEN_TAC `y:real` THEN DISCH_TAC THEN - FIRST_X_ASSUM(MP_TAC o SPEC `y:real`) THEN - ASM_REWRITE_TAC[IN_UNIV] THEN DISCH_TAC THEN - FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]);; - (* Preimage of real_open set under a random variable is an event *) let RANDOM_VARIABLE_PREIMAGE_OPEN = prove (`!p:A prob_space X U. random_variable p X /\ real_open U @@ -253,57 +192,26 @@ let RANDOM_VARIABLE_PREIMAGE_OPEN = prove (* Algebra of random variables *) (* ------------------------------------------------------------------------- *) -(* Composition with a continuous function preserves random variable property *) +(* Real continuity is exactly continuity as a map euclideanreal->euclideanreal. *) +let CONTINUOUS_MAP_EUCLIDEANREAL = prove + (`!f. continuous_map (euclideanreal,euclideanreal) f <=> + f real_continuous_on (:real)`, + GEN_TAC THEN + REWRITE_TAC[GSYM MTOPOLOGY_REAL_EUCLIDEAN_METRIC; METRIC_CONTINUOUS_MAP] THEN + REWRITE_TAC[REAL_EUCLIDEAN_METRIC; IN_UNIV] THEN + REWRITE_TAC[real_continuous_on; IN_UNIV] THEN + MESON_TAC[REAL_ARITH `abs(y - x) = abs(x - y)`]);; + +(* Composition with a continuous function preserves random variable property. *) +(* An instance of RANDOM_VARIABLE_CONTINUOUS_MAP_COMPOSE (random_variables.ml),*) +(* which is in turn powered by the Borel-preimage machinery in metric.ml. *) let RANDOM_VARIABLE_COMP_CONTINUOUS = prove (`!p:A prob_space X f. random_variable p X /\ f real_continuous_on (:real) ==> random_variable p (\x. f(X x))`, - REPEAT GEN_TAC THEN STRIP_TAC THEN - REWRITE_TAC[random_variable] THEN X_GEN_TAC `a:real` THEN - SUBGOAL_THEN - `{x:A | x IN prob_carrier p /\ (f:real->real)(X x) <= a} = - INTERS {{x | x IN prob_carrier p /\ f(X x) < a + inv(&n + &1)} | - n IN (:num)}` - SUBST1_TAC THENL - [REWRITE_TAC[EXTENSION] THEN X_GEN_TAC `z:A` THEN - REWRITE_TAC[INTERS_GSPEC; IN_UNIV; IN_ELIM_THM] THEN EQ_TAC THENL - [STRIP_TAC THEN X_GEN_TAC `n:num` THEN - ASM_REWRITE_TAC[] THEN - MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `a:real` THEN - ASM_REWRITE_TAC[REAL_LT_ADDR] THEN - MATCH_MP_TAC REAL_LT_INV THEN REAL_ARITH_TAC; - DISCH_TAC THEN CONJ_TAC THENL - [FIRST_X_ASSUM(MP_TAC o SPEC `0`) THEN - REWRITE_TAC[REAL_ADD_LID] THEN - MATCH_MP_TAC(TAUT `(p /\ q ==> r) ==> p /\ q ==> r`) THEN - SIMP_TAC[]; - REWRITE_TAC[REAL_ARITH `x <= a <=> ~(a < x)`] THEN DISCH_TAC THEN - SUBGOAL_THEN `&0 < (f:real->real)(X(z:A)) - a` ASSUME_TAC THENL - [ASM_REAL_ARITH_TAC; ALL_TAC] THEN - FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REAL_ARCH_INV]) THEN - DISCH_THEN(X_CHOOSE_THEN `k:num` STRIP_ASSUME_TAC) THEN - FIRST_X_ASSUM(MP_TAC o SPEC `k - 1`) THEN - UNDISCH_TAC `inv(&k) < (f:real->real)(X(z:A)) - a` THEN - UNDISCH_TAC `~(k = 0)` THEN - SPEC_TAC(`k:num`, `k:num`) THEN - INDUCT_TAC THENL [ARITH_TAC; ALL_TAC] THEN - REWRITE_TAC[SUC_SUB1; REAL_OF_NUM_SUC] THEN REAL_ARITH_TAC]]; - ALL_TAC] THEN - MATCH_MP_TAC PROB_INDEXED_INTER_IN_EVENTS THEN - X_GEN_TAC `n:num` THEN - SUBGOAL_THEN - `{x:A | x IN prob_carrier p /\ (f:real->real)(X x) < a + inv(&n + &1)} = - {x | x IN prob_carrier p /\ X x IN {t:real | f t < a + inv(&n + &1)}}` - SUBST1_TAC THENL - [REWRITE_TAC[EXTENSION; IN_ELIM_THM]; ALL_TAC] THEN - MATCH_MP_TAC RANDOM_VARIABLE_PREIMAGE_OPEN THEN ASM_REWRITE_TAC[] THEN - SUBGOAL_THEN - `{t:real | (f:real->real) t < a + inv(&n + &1)} = - {t | f t IN {s:real | s < a + inv(&n + &1)}}` - SUBST1_TAC THENL - [REWRITE_TAC[EXTENSION; IN_ELIM_THM]; ALL_TAC] THEN - MATCH_MP_TAC REAL_CONTINUOUS_OPEN_PREIMAGE_UNIV THEN - ASM_REWRITE_TAC[REAL_OPEN_HALFSPACE_LT]);; + REPEAT STRIP_TAC THEN + MATCH_MP_TAC RANDOM_VARIABLE_CONTINUOUS_MAP_COMPOSE THEN + ASM_REWRITE_TAC[CONTINUOUS_MAP_EUCLIDEANREAL]);; (* Maximum of two random variables is a random variable *) let RANDOM_VARIABLE_MAX = prove @@ -346,25 +254,11 @@ let RANDOM_VARIABLE_ABS = prove (`!p:A prob_space X. random_variable p X ==> random_variable p (\x. abs(X x))`, REPEAT STRIP_TAC THEN - REWRITE_TAC[random_variable] THEN - X_GEN_TAC `a:real` THEN - ASM_CASES_TAC `a < &0` THENL - [SUBGOAL_THEN `{x:A | x IN prob_carrier p /\ abs(X x) <= a} = {}` - SUBST1_TAC THENL - [REWRITE_TAC[EXTENSION; NOT_IN_EMPTY; IN_ELIM_THM] THEN - GEN_TAC THEN ASM_REAL_ARITH_TAC; - REWRITE_TAC[PROB_EMPTY_IN_EVENTS]]; - SUBGOAL_THEN - `{x:A | x IN prob_carrier p /\ abs(X x) <= a} = - {x | x IN prob_carrier p /\ X x <= a} INTER - {x | x IN prob_carrier p /\ X x >= --a}` - SUBST1_TAC THENL - [SET_TAC[REAL_ARITH - `!x a:real. abs x <= a <=> x <= a /\ x >= --a`]; - MATCH_MP_TAC PROB_INTER_IN_EVENTS THEN CONJ_TAC THENL - [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [random_variable]) THEN - SIMP_TAC[]; - MATCH_MP_TAC RANDOM_VARIABLE_GE THEN ASM_REWRITE_TAC[]]]]);; + MP_TAC(ISPECL [`p:A prob_space`; `X:A->real`; `abs:real->real`] + RANDOM_VARIABLE_COMP_CONTINUOUS) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + MP_TAC(ISPECL [`\x:real. x`; `(:real)`] REAL_CONTINUOUS_ON_ABS) THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_ID; ETA_AX]);; (* ------------------------------------------------------------------------- *) (* Simple random variables (taking finitely many values) *) @@ -468,47 +362,16 @@ let RANDOM_VARIABLE_NEG_PART = prove MATCH_MP_TAC RANDOM_VARIABLE_MAX THEN ASM_SIMP_TAC[RANDOM_VARIABLE_NEG; RANDOM_VARIABLE_CONST]);; -(* Helper: x^2 <= a iff |x| <= sqrt(a) when a >= 0 *) -let POW_2_LE_SQRT = prove - (`!x a. &0 <= a ==> (x pow 2 <= a <=> abs x <= sqrt a)`, - REPEAT GEN_TAC THEN DISCH_TAC THEN EQ_TAC THENL - [DISCH_TAC THEN - MP_TAC(ISPECL [`(x:real) pow 2`; `a:real`] SQRT_MONO_LE) THEN - ASM_REWRITE_TAC[POW_2_SQRT_ABS]; - DISCH_TAC THEN - SUBGOAL_THEN `sqrt(x pow 2) <= sqrt a` MP_TAC THENL - [ASM_REWRITE_TAC[POW_2_SQRT_ABS]; ALL_TAC] THEN - SIMP_TAC[SQRT_MONO_LE_EQ; REAL_LE_POW_2]]);; - (* Square of a random variable is a random variable *) let RANDOM_VARIABLE_SQUARE = prove (`!p:A prob_space X. random_variable p X ==> random_variable p (\x. (X x) pow 2)`, REPEAT STRIP_TAC THEN - REWRITE_TAC[random_variable] THEN - X_GEN_TAC `a:real` THEN - ASM_CASES_TAC `a < &0` THENL - [SUBGOAL_THEN `{x:A | x IN prob_carrier p /\ X x pow 2 <= a} = {}` - SUBST1_TAC THENL - [REWRITE_TAC[EXTENSION; NOT_IN_EMPTY; IN_ELIM_THM] THEN - GEN_TAC THEN STRIP_TAC THEN - MP_TAC(SPEC `(X:A->real) x` REAL_LE_POW_2) THEN ASM_REAL_ARITH_TAC; - REWRITE_TAC[PROB_EMPTY_IN_EVENTS]]; - SUBGOAL_THEN - `{x:A | x IN prob_carrier p /\ X x pow 2 <= a} = - {x | x IN prob_carrier p /\ X x <= sqrt a} INTER - {x | x IN prob_carrier p /\ X x >= --(sqrt a)}` - SUBST1_TAC THENL - [REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM] THEN - X_GEN_TAC `z:A` THEN - ASM_CASES_TAC `(z:A) IN prob_carrier p` THEN ASM_REWRITE_TAC[] THEN - MP_TAC(ISPECL [`(X:A->real) z`; `a:real`] POW_2_LE_SQRT) THEN - ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN - REWRITE_TAC[REAL_ABS_BOUNDS] THEN REAL_ARITH_TAC; - MATCH_MP_TAC PROB_INTER_IN_EVENTS THEN CONJ_TAC THENL - [FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [random_variable]) THEN - SIMP_TAC[]; - MATCH_MP_TAC RANDOM_VARIABLE_GE THEN ASM_REWRITE_TAC[]]]]);; + MP_TAC(ISPECL [`p:A prob_space`; `X:A->real`; `\y:real. y pow 2`] + RANDOM_VARIABLE_COMP_CONTINUOUS) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + MP_TAC(ISPECL [`\x:real. x`; `2`; `(:real)`] REAL_CONTINUOUS_ON_POW) THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_ID; ETA_AX]);; (* Test: prove --a / --c = a / c *) (* --a / --c = (--a) * inv(--c) = (--a) * (--(inv c)) = --((--a) * inv c) @@ -549,7 +412,7 @@ let RANDOM_VARIABLE_CMUL = prove [REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `z:A` THEN ASM_CASES_TAC `(z:A) IN prob_carrier p` THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[MUL_LNEG_LE]; - MATCH_MP_TAC RANDOM_VARIABLE_GE THEN ASM_REWRITE_TAC[]]]]);; + MATCH_MP_TAC RV_PREIMAGE_GE THEN ASM_REWRITE_TAC[]]]]);; (* Helper: inv(&n + &1) version of archimedean principle *) @@ -658,7 +521,7 @@ let RANDOM_VARIABLE_ADD = prove [REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `s:A->bool` THEN DISCH_THEN(X_CHOOSE_THEN `r:real` (CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC)) THEN MATCH_MP_TAC PROB_INTER_IN_EVENTS THEN - ASM_SIMP_TAC[RANDOM_VARIABLE_OPEN_HALFLINE]; + ASM_SIMP_TAC[RV_PREIMAGE_LT]; REWRITE_TAC[COUNTABLE_RATIONAL_SETS]]);; (* Difference of two random variables is a random variable *) @@ -1343,6 +1206,39 @@ let INDEP_RV_DIST_FN = prove distribution_fn p X a * distribution_fn p Y b`, REPEAT GEN_TAC THEN REWRITE_TAC[indep_rv; distribution_fn]);; +(* The law (pushforward, random_variables.ml) restricted to a half-line is the *) +(* distribution function (CDF). *) +let DISTRIBUTION_CDF = prove + (`!p (X:A->real) c. + distribution p X {y | y <= c} = distribution_fn p X c`, + REPEAT GEN_TAC THEN REWRITE_TAC[distribution; distribution_fn] THEN + AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM]);; + +(* The joint distribution function is dominated by each marginal CDF. *) +let JOINT_DISTRIBUTION_LE_MARGINAL_X = prove + (`!p (X:A->real) Y a b. + random_variable p X /\ random_variable p Y + ==> joint_distribution_fn p X Y a b <= distribution_fn p X a`, + REPEAT STRIP_TAC THEN REWRITE_TAC[joint_distribution_fn; distribution_fn] THEN + MATCH_MP_TAC PROB_MONO THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC JOINT_RECTANGLE_IN_EVENTS THEN ASM_REWRITE_TAC[]; + ASM_MESON_TAC[random_variable]; + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN MESON_TAC[]]);; + +(* Two random variables are independent iff their joint distribution function *) +(* factorizes into the product of the marginal distribution functions. *) +let INDEP_RV_JOINT_DISTRIBUTION = prove + (`!p (X:A->real) Y. + random_variable p X /\ random_variable p Y + ==> (indep_rv p X Y <=> + !a b. joint_distribution_fn p X Y a b = + distribution_fn p X a * distribution_fn p Y b)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[indep_rv; joint_distribution_fn; distribution_fn] THEN + ASM_REWRITE_TAC[] THEN + AP_TERM_TAC THEN ABS_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN MESON_TAC[]);; + (* ========================================================================= *) (* Generated sigma-algebra (Williams 1.1) *) @@ -1383,6 +1279,17 @@ let SIGMA_GENERATED_SUPERSET = prove REPEAT STRIP_TAC THEN REWRITE_TAC[sigma_generated; SUBSET; IN_INTERS] THEN REWRITE_TAC[IN_ELIM_THM] THEN ASM SET_TAC[]);; +(* Pointwise form of SIGMA_GENERATED_SUPERSET: a single generator is in the *) +(* generated sigma-algebra. *) +let IN_SIGMA_GENERATED_GEN = prove + (`!U C a:A->bool. + (!x. x IN C ==> x SUBSET U) /\ a IN C + ==> a IN sigma_generated U C`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`U:A->bool`; `C:(A->bool)->bool`] SIGMA_GENERATED_SUPERSET) THEN + ASM_REWRITE_TAC[SUBSET] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[]);; + (* Clean characterization of membership in sigma_generated *) let SIGMA_GENERATED_MEM = prove (`!U:A->bool C a. @@ -2519,7 +2426,7 @@ let MARKOV_INEQUALITY_SIMPLE = prove ABBREV_TAC `S = {x:A | x IN prob_carrier p /\ (X:A->real) x >= a}` THEN (* Step 1: S is a measurable event *) SUBGOAL_THEN `(S:A->bool) IN prob_events p` ASSUME_TAC THENL - [EXPAND_TAC "S" THEN MATCH_MP_TAC RANDOM_VARIABLE_GE THEN + [EXPAND_TAC "S" THEN MATCH_MP_TAC RV_PREIMAGE_GE THEN ASM_MESON_TAC[simple_rv]; ALL_TAC] THEN (* Step 2: E[a * 1_S] <= E[X] *) SUBGOAL_THEN `simple_rv (p:A prob_space) (\x:A. a * indicator_fn (S:A->bool) x)` @@ -2873,7 +2780,7 @@ let SIMPLE_CHEBYSHEV_CONVERGENCE = prove abs ((X:num->A->real) n x - mu) >= e}` ASSUME_TAC THENL [MATCH_MP_TAC PROB_POSITIVE THEN - MATCH_MP_TAC RANDOM_VARIABLE_GE THEN + MATCH_MP_TAC RV_PREIMAGE_GE THEN MATCH_MP_TAC RANDOM_VARIABLE_ABS THEN MATCH_MP_TAC RANDOM_VARIABLE_SUB THEN ASM_REWRITE_TAC[ETA_AX; RANDOM_VARIABLE_CONST]; ALL_TAC] THEN @@ -3358,7 +3265,7 @@ let BCL1_CONVERGENCE = prove `!k n. {x:A | x IN prob_carrier p /\ abs((Y:num->A->real) n x - c) >= inv(&(SUC k))} IN prob_events p` (LABEL_TAC "Hev") THENL - [REPEAT GEN_TAC THEN MATCH_MP_TAC RANDOM_VARIABLE_GE THEN + [REPEAT GEN_TAC THEN MATCH_MP_TAC RV_PREIMAGE_GE THEN MATCH_MP_TAC RANDOM_VARIABLE_ABS THEN MATCH_MP_TAC RANDOM_VARIABLE_SUB_CONST THEN REWRITE_TAC[ETA_AX] THEN @@ -3448,7 +3355,7 @@ let SIMPLE_SLLN_SUBSEQ = prove MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= y ==> abs x <= y`) THEN CONJ_TAC THENL [MATCH_MP_TAC PROB_POSITIVE THEN - MATCH_MP_TAC RANDOM_VARIABLE_GE THEN + MATCH_MP_TAC RV_PREIMAGE_GE THEN MATCH_MP_TAC RANDOM_VARIABLE_ABS THEN MATCH_MP_TAC RANDOM_VARIABLE_SUB_CONST THEN SUBGOAL_THEN `simple_rv (p:A prob_space) @@ -4004,7 +3911,7 @@ let NONNEG_SIMPLE_FN_APPROX_RV = prove REPEAT CONJ_TAC THENL [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN - MATCH_MP_TAC RANDOM_VARIABLE_OPEN_HALFLINE THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC RV_PREIMAGE_LT THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC FINITE_IMP_COUNTABLE THEN MATCH_MP_TAC FINITE_IMAGE THEN MATCH_MP_TAC FINITE_SUBSET THEN @@ -4313,7 +4220,7 @@ let SIMPLE_RV_GE_EVENT = prove SUBST1_TAC THENL [SET_TAC[REAL_ARITH `!x c:real. x >= c <=> ~(x < c)`]; MATCH_MP_TAC PROB_COMPL_IN_EVENTS THEN - MATCH_MP_TAC RANDOM_VARIABLE_OPEN_HALFLINE THEN + MATCH_MP_TAC RV_PREIMAGE_LT THEN ASM_MESON_TAC[simple_rv]]);; (* If f >= g on event a, then E[f] >= E[g * 1_a] *) @@ -8857,7 +8764,7 @@ let BCL1_CONVERGENCE_RV = prove `!k n. {x:A | x IN prob_carrier p /\ abs((Y:num->A->real) n x - c) >= inv(&(SUC k))} IN prob_events p` (LABEL_TAC "Hev") THENL - [REPEAT GEN_TAC THEN MATCH_MP_TAC RANDOM_VARIABLE_GE THEN + [REPEAT GEN_TAC THEN MATCH_MP_TAC RV_PREIMAGE_GE THEN MATCH_MP_TAC RANDOM_VARIABLE_ABS THEN MATCH_MP_TAC RANDOM_VARIABLE_SUB_CONST THEN REWRITE_TAC[ETA_AX] THEN @@ -8950,7 +8857,7 @@ let SLLN_SUBSEQ = prove ASSUME_TAC THENL [MATCH_MP_TAC INTEGRABLE_SUM_SQUARE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [(* prob >= 0 *) - MATCH_MP_TAC PROB_POSITIVE THEN MATCH_MP_TAC RANDOM_VARIABLE_GE THEN + MATCH_MP_TAC PROB_POSITIVE THEN MATCH_MP_TAC RV_PREIMAGE_GE THEN MATCH_MP_TAC RANDOM_VARIABLE_ABS THEN MATCH_MP_TAC RANDOM_VARIABLE_SUB_CONST THEN MATCH_MP_TAC RANDOM_VARIABLE_CMUL THEN ASM_MESON_TAC[integrable]; ALL_TAC] THEN ABBREV_TAC `nn = SUC(k * k)` THEN @@ -9057,7 +8964,7 @@ let CHEBYSHEV_CONVERGENCE = prove abs ((X:num->A->real) n x - expectation p (X n)) >= e}` ASSUME_TAC THENL [MATCH_MP_TAC PROB_POSITIVE THEN - MATCH_MP_TAC RANDOM_VARIABLE_GE THEN + MATCH_MP_TAC RV_PREIMAGE_GE THEN MATCH_MP_TAC RANDOM_VARIABLE_ABS THEN MATCH_MP_TAC RANDOM_VARIABLE_SUB_CONST THEN ASM_REWRITE_TAC[ETA_AX]; ALL_TAC] THEN @@ -9268,28 +9175,60 @@ let STRONG_LAW_OF_LARGE_NUMBERS = prove (* Phase 17: RV measurability for cos/sin and CLT infrastructure *) (* ========================================================================= *) -(* RANDOM_VARIABLE_STRICT_LT: strict inequality version of measurability *) -let RANDOM_VARIABLE_STRICT_LT = prove - (`!p:A prob_space X a. - random_variable p X - ==> {x | x IN prob_carrier p /\ X x < a} IN prob_events p`, - REPEAT STRIP_TAC THEN - SUBGOAL_THEN `{x:A | x IN prob_carrier p /\ X x < a} = - prob_carrier p DIFF {x | x IN prob_carrier p /\ X x >= a}` SUBST1_TAC THENL - [SET_TAC[REAL_ARITH `!x a:real. x < a <=> ~(x >= a)`]; - MATCH_MP_TAC PROB_COMPL_IN_EVENTS THEN - MATCH_MP_TAC RANDOM_VARIABLE_GE THEN ASM_REWRITE_TAC[]]);; +(* The strict-inequality {X < a} event fact is RV_PREIMAGE_LT from *) +(* random_variables.ml; the duplicate re-proof formerly here has been removed. *) + +(* PROB_STRICT_INEQ_LIMIT: prob of <= events converges to prob of < event *) +let PROB_STRICT_INEQ_LIMIT = prove + (`!p:A prob_space Z c. + random_variable p Z + ==> ((\n. prob p {x | x IN prob_carrier p /\ Z x <= c - &1 / &(SUC n)}) + ---> prob p {x | x IN prob_carrier p /\ Z x < c}) sequentially`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; + `\n:num. {x:A | x IN prob_carrier p /\ (Z:A->real) x <= c - &1 / &(SUC n)}`] + PROB_CONTINUITY_FROM_BELOW) THEN + BETA_TAC THEN ANTS_TAC THENL + [CONJ_TAC THENL + [GEN_TAC THEN FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [random_variable]) THEN + DISCH_THEN(MP_TAC o SPEC `c - &1 / &(SUC n)`) THEN REWRITE_TAC[]; + GEN_TAC THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN GEN_TAC THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `c - &1 / &(SUC n)` THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[REAL_ARITH `a - x <= a - y <=> y <= x`] THEN + REWRITE_TAC[real_div; REAL_MUL_LID] THEN MATCH_MP_TAC REAL_LE_INV2 THEN + REWRITE_TAC[REAL_OF_NUM_LT; REAL_OF_NUM_LE] THEN ARITH_TAC]; + SUBGOAL_THEN + `UNIONS {{x:A | x IN prob_carrier p /\ (Z:A->real) x <= c - &1 / &(SUC n)} | + n IN (:num)} = + {x | x IN prob_carrier p /\ Z x < c}` (fun th -> REWRITE_TAC[th]) THEN + REWRITE_TAC[UNIONS_GSPEC; IN_UNIV; EXTENSION; IN_ELIM_THM] THEN + GEN_TAC THEN EQ_TAC THENL + [STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `&0 < &1 / &(SUC n)` MP_TAC THENL + [MATCH_MP_TAC REAL_LT_DIV THEN REWRITE_TAC[REAL_OF_NUM_LT] THEN ARITH_TAC; + ASM_REAL_ARITH_TAC]; + STRIP_TAC THEN + MP_TAC(SPEC `c - (Z:A->real) x` REAL_ARCH_INV) THEN + ASM_SIMP_TAC[REAL_SUB_LT] THEN + DISCH_THEN(X_CHOOSE_THEN `m:num` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `m:num` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `c - inv(&m)` THEN CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; + REWRITE_TAC[REAL_ARITH `a - x <= a - y <=> y <= x`; real_div; REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN + REWRITE_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_LT] THEN ASM_ARITH_TAC]]]);; (* RANDOM_VARIABLE_POW: power of a random variable is a random variable *) let RANDOM_VARIABLE_POW = prove (`!p:A prob_space X n. random_variable p X ==> random_variable p (\x. X x pow n)`, - GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THENL - [DISCH_TAC THEN REWRITE_TAC[real_pow] THEN - REWRITE_TAC[RANDOM_VARIABLE_CONST]; - DISCH_TAC THEN REWRITE_TAC[real_pow] THEN - MATCH_MP_TAC RANDOM_VARIABLE_MUL THEN - ASM_SIMP_TAC[]]);; + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `X:A->real`; `\y:real. y pow n`] + RANDOM_VARIABLE_COMP_CONTINUOUS) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + MP_TAC(ISPECL [`\x:real. x`; `n:num`; `(:real)`] REAL_CONTINUOUS_ON_POW) THEN + REWRITE_TAC[REAL_CONTINUOUS_ON_ID; ETA_AX]);; (* RANDOM_VARIABLE_SUM: finite sum of random variables *) let RANDOM_VARIABLE_SUM = prove @@ -9395,7 +9334,7 @@ let RANDOM_VARIABLE_POINTWISE_LIMIT = prove REPEAT CONJ_TAC THENL [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN BETA_TAC THEN - MATCH_MP_TAC RANDOM_VARIABLE_STRICT_LT THEN + MATCH_MP_TAC RV_PREIMAGE_LT THEN REWRITE_TAC[ETA_AX] THEN ASM_REWRITE_TAC[]; MATCH_MP_TAC COUNTABLE_IMAGE THEN MATCH_MP_TAC COUNTABLE_SUBSET THEN EXISTS_TAC `(:num)` THEN @@ -9409,101 +9348,23 @@ let RANDOM_VARIABLE_POINTWISE_LIMIT = prove REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_UNIV] THEN EXISTS_TAC `0` THEN REWRITE_TAC[]]);; -(* COS_TAYLOR_CONVERGES: real Taylor series for cosine converges *) -let COS_TAYLOR_CONVERGES = prove - (`!x:real. ((\n. sum(0..n) - (\k. (-- &1) pow k * x pow (2 * k) / &(FACT(2 * k)))) ---> cos x) - sequentially`, - X_GEN_TAC `x:real` THEN - MP_TAC(SPEC `Cx x` CCOS_CONVERGES) THEN - REWRITE_TAC[sums; FROM_0; INTER_UNIV; GSYM CX_COS] THEN - SUBGOAL_THEN `!n. vsum(0..n) (\n. --Cx(&1) pow n * Cx x pow (2 * n) / - Cx(&(FACT(2 * n)))) = - Cx(sum(0..n) (\k. (-- &1) pow k * x pow (2 * k) / &(FACT(2 * k))))` - (fun th -> REWRITE_TAC[th]) THENL - [GEN_TAC THEN - REWRITE_TAC[GSYM VSUM_CX] THEN - MATCH_MP_TAC VSUM_EQ THEN - REWRITE_TAC[IN_NUMSEG] THEN - REPEAT STRIP_TAC THEN BETA_TAC THEN - REWRITE_TAC[GSYM CX_NEG; GSYM CX_POW; GSYM CX_MUL; GSYM CX_DIV]; - REWRITE_TAC[REALLIM_COMPLEX; o_DEF]]);; - -(* SIN_TAYLOR_CONVERGES: real Taylor series for sine converges *) -let SIN_TAYLOR_CONVERGES = prove - (`!x:real. ((\n. sum(0..n) - (\k. (-- &1) pow k * x pow (2 * k + 1) / &(FACT(2 * k + 1)))) ---> sin x) - sequentially`, - X_GEN_TAC `x:real` THEN - MP_TAC(SPEC `Cx x` CSIN_CONVERGES) THEN - REWRITE_TAC[sums; FROM_0; INTER_UNIV; GSYM CX_SIN] THEN - SUBGOAL_THEN `!n. vsum(0..n) (\n. --Cx(&1) pow n * Cx x pow (2 * n + 1) / - Cx(&(FACT(2 * n + 1)))) = - Cx(sum(0..n) (\k. (-- &1) pow k * x pow (2 * k + 1) / &(FACT(2 * k + 1))))` - (fun th -> REWRITE_TAC[th]) THENL - [GEN_TAC THEN - REWRITE_TAC[GSYM VSUM_CX] THEN - MATCH_MP_TAC VSUM_EQ THEN - REWRITE_TAC[IN_NUMSEG] THEN - REPEAT STRIP_TAC THEN BETA_TAC THEN - REWRITE_TAC[GSYM CX_NEG; GSYM CX_POW; GSYM CX_MUL; GSYM CX_DIV]; - REWRITE_TAC[REALLIM_COMPLEX; o_DEF]]);; - (* RANDOM_VARIABLE_COS: composition with cosine preserves measurability *) -(* Proof: Taylor partial sums are polynomials in X (hence RVs), - converge pointwise to cos(X), so by RANDOM_VARIABLE_POINTWISE_LIMIT *) let RANDOM_VARIABLE_COS = prove (`!p:A prob_space X. random_variable p X ==> random_variable p (\x. cos(X x))`, REPEAT STRIP_TAC THEN - MATCH_MP_TAC RANDOM_VARIABLE_POINTWISE_LIMIT THEN - EXISTS_TAC `\n (x:A). sum(0..n) - (\k. (-- &1) pow k * (X x) pow (2 * k) / &(FACT(2 * k)))` THEN - BETA_TAC THEN CONJ_TAC THENL - [GEN_TAC THEN - SUBGOAL_THEN - `(\x:A. sum(0..n) (\k. (-- &1) pow k * (X:A->real) x pow (2 * k) / - &(FACT(2 * k)))) = - (\x:A. sum(0..n) (\k. ((-- &1) pow k / &(FACT(2 * k))) * - X x pow (2 * k)))` - SUBST1_TAC THENL - [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `a:A` THEN BETA_TAC THEN - MATCH_MP_TAC SUM_EQ THEN REWRITE_TAC[IN_NUMSEG] THEN - REPEAT STRIP_TAC THEN BETA_TAC THEN - REWRITE_TAC[real_div; REAL_MUL_AC]; - MATCH_MP_TAC RANDOM_VARIABLE_SUM THEN - GEN_TAC THEN DISCH_TAC THEN BETA_TAC THEN - MATCH_MP_TAC RANDOM_VARIABLE_CMUL THEN - MATCH_MP_TAC RANDOM_VARIABLE_POW THEN - ASM_REWRITE_TAC[]]; - REPEAT STRIP_TAC THEN REWRITE_TAC[COS_TAYLOR_CONVERGES]]);; + MP_TAC(ISPECL [`p:A prob_space`; `X:A->real`; `cos:real->real`] + RANDOM_VARIABLE_COMP_CONTINUOUS) THEN + ASM_REWRITE_TAC[REAL_CONTINUOUS_ON_COS]);; (* RANDOM_VARIABLE_SIN: composition with sine preserves measurability *) let RANDOM_VARIABLE_SIN = prove (`!p:A prob_space X. random_variable p X ==> random_variable p (\x. sin(X x))`, REPEAT STRIP_TAC THEN - MATCH_MP_TAC RANDOM_VARIABLE_POINTWISE_LIMIT THEN - EXISTS_TAC `\n (x:A). sum(0..n) - (\k. (-- &1) pow k * (X x) pow (2 * k + 1) / &(FACT(2 * k + 1)))` THEN - BETA_TAC THEN CONJ_TAC THENL - [GEN_TAC THEN - SUBGOAL_THEN - `(\x:A. sum(0..n) (\k. (-- &1) pow k * (X:A->real) x pow (2 * k + 1) / - &(FACT(2 * k + 1)))) = - (\x:A. sum(0..n) (\k. ((-- &1) pow k / &(FACT(2 * k + 1))) * - X x pow (2 * k + 1)))` - SUBST1_TAC THENL - [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `a:A` THEN BETA_TAC THEN - MATCH_MP_TAC SUM_EQ THEN REWRITE_TAC[IN_NUMSEG] THEN - REPEAT STRIP_TAC THEN BETA_TAC THEN - REWRITE_TAC[real_div; REAL_MUL_AC]; - MATCH_MP_TAC RANDOM_VARIABLE_SUM THEN - GEN_TAC THEN DISCH_TAC THEN BETA_TAC THEN - MATCH_MP_TAC RANDOM_VARIABLE_CMUL THEN - MATCH_MP_TAC RANDOM_VARIABLE_POW THEN - ASM_REWRITE_TAC[]]; - REPEAT STRIP_TAC THEN REWRITE_TAC[SIN_TAYLOR_CONVERGES]]);; + MP_TAC(ISPECL [`p:A prob_space`; `X:A->real`; `sin:real->real`] + RANDOM_VARIABLE_COMP_CONTINUOUS) THEN + ASM_REWRITE_TAC[REAL_CONTINUOUS_ON_SIN]);; (* Integrability of cos/sin compositions (bounded RVs are integrable) *) let INTEGRABLE_COS_CMUL = prove @@ -11136,6 +10997,74 @@ let INDEP_EXTENDS_TO_SIGMA = prove REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ASM_MESON_TAC[SUBSET]]; REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ASM_MESON_TAC[]]);; +(* ------------------------------------------------------------------------- *) +(* Uniqueness of measures (Williams "Probability with Martingales" 1.6). *) +(* *) +(* If a second (signed) measure mu of total mass 1 agrees with prob p on a *) +(* pi-system P that generates the events, then mu agrees with prob p on the *) +(* whole sigma-algebra sigma(P). This is the general companion to *) +(* INDEP_EXTENDS_TO_SIGMA, proved by the same Dynkin pi-lambda argument: the *) +(* sets on which mu and prob p agree form a lambda-system containing P. *) +(* ------------------------------------------------------------------------- *) + +(* The agreement set {a | mu a = prob p a} is a lambda-system. Closure under *) +(* complements uses total mass 1; closure under countable disjoint unions *) +(* uses that both measures are countably additive with equal terms. *) +let MEASURE_AGREE_LAMBDA_SYSTEM = prove + (`!p:A prob_space mu. + signed_measure p mu /\ mu (prob_carrier p) = &1 + ==> lambda_system (prob_carrier p) + {a | a IN prob_events p /\ mu a = prob p a}`, + REPEAT STRIP_TAC THEN REWRITE_TAC[lambda_system; IN_ELIM_THM] THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[PROB_CARRIER_IN_EVENTS]; + ASM_MESON_TAC[PROB_SPACE]; + X_GEN_TAC `a:A->bool` THEN STRIP_TAC THEN + CONJ_TAC THENL [ASM_MESON_TAC[PROB_COMPL_IN_EVENTS]; ALL_TAC] THEN + SUBGOAL_THEN `(a:A->bool) SUBSET prob_carrier p` ASSUME_TAC THENL + [ASM_MESON_TAC[PROB_EVENT_SUBSET]; ALL_TAC] THEN + MP_TAC(SPECL [`p:A prob_space`; `mu:(A->bool)->real`; + `prob_carrier (p:A prob_space)`; `a:A->bool`] + SIGNED_MEASURE_DIFF) THEN + ASM_REWRITE_TAC[PROB_CARRIER_IN_EVENTS] THEN DISCH_TAC THEN + ASM_SIMP_TAC[PROB_COMPL] THEN ASM_REAL_ARITH_TAC; + X_GEN_TAC `B:num->A->bool` THEN STRIP_TAC THEN + SUBGOAL_THEN `!n. (B:num->A->bool) n IN prob_events p` ASSUME_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC PROB_COUNTABLE_UNION_IN_EVENTS THEN + ASM_SIMP_TAC[SIMPLE_IMAGE; COUNTABLE_IMAGE; NUM_COUNTABLE] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_UNIV] THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_SERIES_UNIQUE THEN + MAP_EVERY EXISTS_TAC + [`\n. prob p ((B:num->A->bool) n)`; `from 0`] THEN + CONJ_TAC THENL + [SUBGOAL_THEN `(\n. prob p ((B:num->A->bool) n)) = (\n. mu (B n))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN ASM_MESON_TAC[]; ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [signed_measure]) THEN + DISCH_THEN(MATCH_MP_TAC o CONJUNCT2) THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC PROB_COUNTABLY_ADDITIVE THEN ASM_REWRITE_TAC[]]]);; + +(* The uniqueness theorem itself, via Dynkin. *) +let MEASURE_UNIQUE_ON_PI_SYSTEM = prove + (`!p:A prob_space mu P. + signed_measure p mu /\ mu (prob_carrier p) = &1 /\ + pi_system P /\ UNIONS P = prob_carrier p /\ + P SUBSET prob_events p /\ + (!c. c IN P ==> mu c = prob p c) + ==> !c. c IN sigma_generated (prob_carrier p) P ==> mu c = prob p c`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `sigma_generated (prob_carrier p) P SUBSET + {a:A->bool | a IN prob_events p /\ mu a = prob p a}` MP_TAC THENL + [MATCH_MP_TAC DYNKIN_PI_LAMBDA THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [MATCH_MP_TAC MEASURE_AGREE_LAMBDA_SYSTEM THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ASM_MESON_TAC[SUBSET]]; + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ASM_MESON_TAC[]]);; + let SIGMA_GENERATED_MONO = prove (`!(U:A->bool) C1 C2. C1 SUBSET C2 /\ (!a. a IN C2 ==> a SUBSET U) @@ -11148,6 +11077,118 @@ let SIGMA_GENERATED_MONO = prove EXISTS_TAC `C2:(A->bool)->bool` THEN ASM_REWRITE_TAC[] THEN ASM_SIMP_TAC[SIGMA_GENERATED_SUPERSET]);; +(* ------------------------------------------------------------------------- *) +(* The Borel sigma-algebra on the reals is generated by the closed half-lines *) +(* (-inf, a] (Williams "Probability with Martingales", Ch.3). This bridges *) +(* the library notion borel_in euclideanreal to the development's *) +(* sigma_generated, so the two "Borel" vocabularies can be used *) +(* interchangeably. *) +(* ------------------------------------------------------------------------- *) + +let real_halflines = new_definition + `real_halflines = {{x:real | x <= a} | a IN (:real)}`;; + +let HALFLINES_SUBSET_UNIV = prove + (`!s. s IN real_halflines ==> s SUBSET (:real)`, + REWRITE_TAC[real_halflines; FORALL_IN_GSPEC; SUBSET_UNIV]);; + +let SIGMA_ALGEBRA_SIGMA_GENERATED_HALFLINES = prove + (`sigma_algebra (sigma_generated (:real) real_halflines)`, + MATCH_MP_TAC SIGMA_GENERATED_IS_SIGMA_ALGEBRA THEN + REWRITE_TAC[real_halflines; FORALL_IN_GSPEC; SUBSET_UNIV]);; + +let UNIONS_SIGMA_GENERATED_HALFLINES = prove + (`UNIONS (sigma_generated (:real) real_halflines) = (:real)`, + MATCH_MP_TAC SIGMA_GENERATED_CARRIER THEN + REWRITE_TAC[real_halflines; FORALL_IN_GSPEC; SUBSET_UNIV]);; + +(* Closed half-line: a generator, hence in the generated sigma-algebra. *) +let REAL_HALFLINE_LE_IN_SIGMA = prove + (`!a. {x:real | x <= a} IN sigma_generated (:real) real_halflines`, + GEN_TAC THEN MATCH_MP_TAC IN_SIGMA_GENERATED_GEN THEN + REWRITE_TAC[HALFLINES_SUBSET_UNIV] THEN + REWRITE_TAC[real_halflines; IN_ELIM_THM] THEN + EXISTS_TAC `a:real` THEN REWRITE_TAC[IN_UNIV]);; + +(* Open half-line: a countable union of closed half-lines. *) +let REAL_HALFLINE_LT_IN_SIGMA = prove + (`!b. {x:real | x < b} IN sigma_generated (:real) real_halflines`, + GEN_TAC THEN + SUBGOAL_THEN + `{x:real | x < b} = UNIONS {{x:real | x <= b - inv(&n + &1)} | n IN (:num)}` + SUBST1_TAC THENL + [MP_TAC(ISPECL [`\x:real. x`; `b:real`; `(:real)`] OPEN_HALFLINE_AS_UNION) THEN + REWRITE_TAC[IN_UNIV]; ALL_TAC] THEN + MATCH_MP_TAC SIGMA_ALGEBRA_UNION_COUNTABLE THEN + REWRITE_TAC[SIGMA_ALGEBRA_SIGMA_GENERATED_HALFLINES] THEN + CONJ_TAC THENL + [REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; IN_UNIV] THEN + REWRITE_TAC[REAL_HALFLINE_LE_IN_SIGMA]; + REWRITE_TAC[SIMPLE_IMAGE] THEN MATCH_MP_TAC COUNTABLE_IMAGE THEN + REWRITE_TAC[NUM_COUNTABLE]]);; + +(* Open interval = open half-line minus a closed half-line. *) +let REAL_INTERVAL_IN_SIGMA = prove + (`!a b. real_interval(a,b) IN sigma_generated (:real) real_halflines`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN + `real_interval(a,b) = {x:real | x < b} DIFF {x:real | x <= a}` + SUBST1_TAC THENL + [REWRITE_TAC[real_interval; EXTENSION; IN_DIFF; IN_ELIM_THM] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC SIGMA_ALGEBRA_DIFF THEN + REWRITE_TAC[SIGMA_ALGEBRA_SIGMA_GENERATED_HALFLINES; + REAL_HALFLINE_LT_IN_SIGMA; REAL_HALFLINE_LE_IN_SIGMA]);; + +(* Every real-open set: a countable union of open intervals. *) +let REAL_OPEN_IN_SIGMA = prove + (`!s. real_open s ==> s IN sigma_generated (:real) real_halflines`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP REAL_OPEN_COUNTABLE_UNION_REAL_INTERVAL) THEN + DISCH_THEN(X_CHOOSE_THEN `D:(real->bool)->bool` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC SIGMA_ALGEBRA_UNION_COUNTABLE THEN + ASM_REWRITE_TAC[SIGMA_ALGEBRA_SIGMA_GENERATED_HALFLINES] THEN + REWRITE_TAC[SUBSET] THEN X_GEN_TAC `i:real->bool` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `i:real->bool`) THEN ASM_REWRITE_TAC[] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[REAL_INTERVAL_IN_SIGMA]);; + +(* The bridge itself: the two Borel sigma-algebras on the reals coincide. *) +let BOREL_IN_EUCLIDEANREAL_EQ_SIGMA_GENERATED = prove + (`{s:real->bool | borel_in euclideanreal s} = + sigma_generated (:real) real_halflines`, + MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN + MATCH_MP_TAC borel_in_INDUCT THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[GSYM REAL_OPEN_IN] THEN + MESON_TAC[REAL_OPEN_IN_SIGMA]; + REWRITE_TAC[TOPSPACE_EUCLIDEANREAL] THEN X_GEN_TAC `s:real->bool` THEN + DISCH_TAC THEN + SUBGOAL_THEN + `(:real) DIFF s = + UNIONS (sigma_generated (:real) real_halflines) DIFF s` + SUBST1_TAC THENL + [REWRITE_TAC[UNIONS_SIGMA_GENERATED_HALFLINES]; ALL_TAC] THEN + MATCH_MP_TAC SIGMA_ALGEBRA_COMPL THEN + ASM_REWRITE_TAC[SIGMA_ALGEBRA_SIGMA_GENERATED_HALFLINES]; + X_GEN_TAC `u:(real->bool)->bool` THEN STRIP_TAC THEN + MATCH_MP_TAC SIGMA_ALGEBRA_UNION_COUNTABLE THEN + ASM_REWRITE_TAC[SIGMA_ALGEBRA_SIGMA_GENERATED_HALFLINES; SUBSET]]; + MATCH_MP_TAC SIGMA_GENERATED_MINIMAL THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[BOREL_IN_SIGMA_ALGEBRA]; + REWRITE_TAC[real_halflines; SUBSET; FORALL_IN_GSPEC; IN_ELIM_THM] THEN + X_GEN_TAC `s:real->bool` THEN + DISCH_THEN(X_CHOOSE_THEN `a:real` + (CONJUNCTS_THEN2 ASSUME_TAC SUBST1_TAC)) THEN + MATCH_MP_TAC CLOSED_IMP_BOREL_IN THEN + REWRITE_TAC[GSYM REAL_CLOSED_IN; REAL_CLOSED_HALFSPACE_LE]; + MATCH_MP_TAC SUBSET_ANTISYM THEN REWRITE_TAC[SUBSET_UNIV] THEN + MATCH_MP_TAC(SET_RULE `(x:real->bool) IN s ==> x SUBSET UNIONS s`) THEN + REWRITE_TAC[IN_ELIM_THM] THEN + MP_TAC(ISPEC `euclideanreal` BOREL_IN_TOPSPACE) THEN + REWRITE_TAC[TOPSPACE_EUCLIDEANREAL]]]);; + let INDEP_FIN_INTER_SIGMA_FUTURE = prove (`!p:A prob_space (B:num->A->bool) (S1:num->bool) N. indep_events_seq p B /\ @@ -12550,6 +12591,206 @@ let REVERSE_FATOU_EXPECTATION = prove (* Final: combine *) ASM_REAL_ARITH_TAC);; +(* RANDOM_VARIABLE_REAL_LIMSUP_DOMINATED: limsup of dominated RVs is an RV *) +let RANDOM_VARIABLE_REAL_LIMSUP_DOMINATED = prove + (`!p:A prob_space X g. + (!n. random_variable p (X n)) /\ + random_variable p g /\ + (!n x. x IN prob_carrier p ==> abs(X n x) <= g x) + ==> random_variable p (\x. real_limsup (\n. X n x))`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC RANDOM_VARIABLE_POINTWISE_LIMIT THEN + EXISTS_TAC `\M x:A. real_limsup (\n. max (min ((X:num->A->real) n x) (&M)) (--(&M)))` THEN + REWRITE_TAC[] THEN CONJ_TAC THENL + [(* Each truncated limsup is a random variable *) + X_GEN_TAC `M:num` THEN + SUBGOAL_THEN `(\x:A. real_limsup (\n. max (min ((X:num->A->real) n x) (&M)) (--(&M)))) = (\x. real_limsup (\n. max (min (X n x) (&M)) (--(&M)) + &M) - &M)` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:A` THEN + MP_TAC(ISPECL [`\n. max (min ((X:num->A->real) n x) (&M)) (--(&M)) + &M`; + `&0`; `&2 * &M`; `&M`] REAL_LIMSUP_SUB_CONST) THEN + REWRITE_TAC[REAL_ARITH `!a:real m:real. (a + m) - m = a`] THEN + ANTS_TAC THENL + [CONJ_TAC THEN GEN_TAC THEN REAL_ARITH_TAC; + DISCH_THEN ACCEPT_TAC]; + MATCH_MP_TAC RANDOM_VARIABLE_SUB_CONST THEN + MATCH_MP_TAC RANDOM_VARIABLE_REAL_LIMSUP THEN + EXISTS_TAC `&2 * &M` THEN REPEAT CONJ_TAC THENL + [GEN_TAC THEN REWRITE_TAC[] THEN MATCH_MP_TAC RANDOM_VARIABLE_SHIFT THEN + MATCH_MP_TAC RANDOM_VARIABLE_MAX THEN REWRITE_TAC[RANDOM_VARIABLE_CONST] THEN + MATCH_MP_TAC RANDOM_VARIABLE_MIN THEN + ASM_REWRITE_TAC[RANDOM_VARIABLE_CONST; ETA_AX]; + REPEAT STRIP_TAC THEN REAL_ARITH_TAC; + REPEAT STRIP_TAC THEN REAL_ARITH_TAC]]; + (* Pointwise convergence: truncated limsup -> true limsup *) + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(SPEC `(g:A->real) x` REAL_ARCH_SIMPLE) THEN + DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN + EXISTS_TAC `N:num` THEN X_GEN_TAC `M:num` THEN DISCH_TAC THEN + SUBGOAL_THEN `!n:num. max (min ((X:num->A->real) n x) (&M)) (--(&M)) = X n x` (fun th -> REWRITE_TAC[th; REAL_SUB_REFL; REAL_ABS_NUM] THEN ASM_REWRITE_TAC[]) THEN + GEN_TAC THEN + MATCH_MP_TAC(REAL_ARITH `abs f <= m ==> max (min f m) (--m) = f`) THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(g:A->real) x` THEN + CONJ_TAC THENL + [ASM_SIMP_TAC[]; + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&N:real` THEN + ASM_REWRITE_TAC[REAL_OF_NUM_LE]]]);; + +let INTEGRABLE_IMP_RANDOM_VARIABLE = prove + (`!p:A prob_space (f:A->real). integrable p f ==> random_variable p f`, + SIMP_TAC[integrable]);; + +(* REVERSE_FATOU_DOMINATED: reverse Fatou under integrable domination *) +let REVERSE_FATOU_DOMINATED = prove + (`!p:A prob_space X h. + (!n. integrable p (X n)) /\ + integrable p h /\ + (!n x. x IN prob_carrier p ==> abs(X n x) <= h x) + ==> real_limsup (\n. expectation p (X n)) + <= expectation p (\x. real_limsup (\n. X n x))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + (* Basic bounds *) + SUBGOAL_THEN `!x:A. x IN prob_carrier p ==> &0 <= (h:A->real) x` ASSUME_TAC THENL + [GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs((X:num->A->real) 0 x)` THEN + REWRITE_TAC[REAL_ABS_POS] THEN ASM_SIMP_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `!n x:A. x IN prob_carrier p ==> (X:num->A->real) n x <= (h:A->real) x` ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN + MATCH_MP_TAC(REAL_ARITH `abs f <= b ==> f <= b`) THEN ASM_SIMP_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `!n x:A. x IN prob_carrier p ==> --(h:A->real) x <= (X:num->A->real) n x` ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN + MATCH_MP_TAC(REAL_ARITH `abs f <= b ==> --b <= f`) THEN ASM_SIMP_TAC[]; + ALL_TAC] THEN + (* Integrability of h - X_n *) + SUBGOAL_THEN `!n:num. integrable (p:A prob_space) (\x. (h:A->real) x - (X:num->A->real) n x)` ASSUME_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC INTEGRABLE_SUB THEN ASM_REWRITE_TAC[ETA_AX]; + ALL_TAC] THEN + (* Apply FATOU_LEMMA_GEN to h - X_n *) + SUBGOAL_THEN + `nn_expectation (p:A prob_space) (\x. real_liminf (\n. (h:A->real) x - (X:num->A->real) n x)) + <= real_liminf (\n. nn_expectation p (\x. h x - X n x))` + ASSUME_TAC THENL + [MP_TAC(ISPECL [`p:A prob_space`; `\n:num. \x:A. (h:A->real) x - (X:num->A->real) n x`] + FATOU_LEMMA_GEN) THEN + BETA_TAC THEN ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [(* nonneg *) + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[REAL_ARITH `f <= g ==> &0 <= g - f`]; + (* liminf nonneg *) + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_LIMINF_LBOUND THEN + EXISTS_TAC `&2 * (h:A->real) x` THEN CONJ_TAC THENL + [GEN_TAC THEN ASM_SIMP_TAC[REAL_ARITH `f <= g ==> &0 <= g - f`]; + GEN_TAC THEN ASM_SIMP_TAC[REAL_ARITH `--g <= f ==> g - f <= &2 * g`]]; + (* bounded nn_expectations *) + EXISTS_TAC `&2 * expectation (p:A prob_space) h` THEN GEN_TAC THEN + SUBGOAL_THEN `nn_expectation (p:A prob_space) (\x. (h:A->real) x - (X:num->A->real) n x) = expectation p (\x. h x - X n x)` SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC EXPECTATION_NONNEG_EQ_NN THEN + ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[REAL_ARITH `f <= g ==> &0 <= g - f`]; + ALL_TAC] THEN + MP_TAC(ISPECL [`p:A prob_space`; `h:A->real`; `(X:num->A->real) n`] + EXPECTATION_SUB) THEN + ASM_REWRITE_TAC[ETA_AX] THEN DISCH_THEN SUBST1_TAC THEN + MATCH_MP_TAC(REAL_ARITH `--g <= e ==> g - e <= &2 * g`) THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= e + g ==> --g <= e`) THEN + SUBGOAL_THEN `expectation (p:A prob_space) ((X:num->A->real) n) + expectation p h = expectation p (\x. X n x + h x)` SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC EXPECTATION_ADD THEN + ASM_REWRITE_TAC[ETA_AX]; + MATCH_MP_TAC EXPECTATION_POS THEN CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_ADD THEN ASM_REWRITE_TAC[ETA_AX]; + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[] THEN + MATCH_MP_TAC(REAL_ARITH `--d <= f ==> &0 <= f + d`) THEN + ASM_SIMP_TAC[]]]]; + SIMP_TAC[]]; + ALL_TAC] THEN + (* Convert nn_expectation(h - X_n) to E[h] - E[X_n] *) + SUBGOAL_THEN `!n:num. nn_expectation (p:A prob_space) (\x. (h:A->real) x - (X:num->A->real) n x) = expectation p h - expectation p (X n)` ASSUME_TAC THENL + [GEN_TAC THEN + SUBGOAL_THEN `nn_expectation (p:A prob_space) (\x. (h:A->real) x - (X:num->A->real) n x) = expectation p (\x. h x - X n x)` SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC EXPECTATION_NONNEG_EQ_NN THEN + ASM_REWRITE_TAC[] THEN REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[REAL_ARITH `f <= g ==> &0 <= g - f`]; + MP_TAC(ISPECL [`p:A prob_space`; `h:A->real`; `(X:num->A->real) n`] + EXPECTATION_SUB) THEN + ASM_REWRITE_TAC[ETA_AX]]; + ALL_TAC] THEN + (* Expectation bounds *) + SUBGOAL_THEN `!n:num. expectation (p:A prob_space) ((X:num->A->real) n) <= expectation p h` ASSUME_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC EXPECTATION_MONO THEN + ASM_REWRITE_TAC[] THEN GEN_TAC THEN DISCH_TAC THEN ASM_SIMP_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `!n:num. --expectation (p:A prob_space) h <= expectation p ((X:num->A->real) n)` ASSUME_TAC THENL + [GEN_TAC THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= e + g ==> --g <= e`) THEN + SUBGOAL_THEN `expectation (p:A prob_space) ((X:num->A->real) n) + expectation p h = expectation p (\x. X n x + h x)` SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC EXPECTATION_ADD THEN + ASM_REWRITE_TAC[ETA_AX]; + MATCH_MP_TAC EXPECTATION_POS THEN CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_ADD THEN ASM_REWRITE_TAC[ETA_AX]; + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[] THEN + MATCH_MP_TAC(REAL_ARITH `--d <= f ==> &0 <= f + d`) THEN ASM_SIMP_TAC[]]]; + ALL_TAC] THEN + (* RHS of Fatou: liminf(E[h] - E[X_n]) = E[h] - limsup(E[X_n]) *) + SUBGOAL_THEN `real_liminf (\n. nn_expectation (p:A prob_space) (\x. (h:A->real) x - (X:num->A->real) n x)) = expectation p h - real_limsup (\n. expectation p (X n))` ASSUME_TAC THENL + [SUBGOAL_THEN `(\n. nn_expectation (p:A prob_space) (\x. (h:A->real) x - (X:num->A->real) n x)) = (\n. expectation p h - expectation p (X n))` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LIMINF_CONST_MINUS THEN + EXISTS_TAC `--expectation (p:A prob_space) h` THEN + EXISTS_TAC `expectation (p:A prob_space) h` THEN + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + (* Pointwise: liminf(h - X_n) = h - limsup(X_n) *) + SUBGOAL_THEN `!x:A. x IN prob_carrier p ==> real_liminf (\n. (h:A->real) x - (X:num->A->real) n x) = h x - real_limsup (\n. X n x)` ASSUME_TAC THENL + [GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LIMINF_CONST_MINUS THEN + EXISTS_TAC `--(h:A->real) x` THEN EXISTS_TAC `(h:A->real) x` THEN + ASM_SIMP_TAC[]; + ALL_TAC] THEN + (* nn_exp extensionality: use pointwise equality *) + SUBGOAL_THEN `nn_expectation (p:A prob_space) (\x. real_liminf (\n. (h:A->real) x - (X:num->A->real) n x)) = nn_expectation p (\x. h x - real_limsup (\n. X n x))` ASSUME_TAC THENL + [MATCH_MP_TAC NN_EXPECTATION_EXT THEN GEN_TAC THEN DISCH_TAC THEN + BETA_TAC THEN ASM_SIMP_TAC[]; + ALL_TAC] THEN + (* Integrability of limsup(X_n) *) + SUBGOAL_THEN `integrable (p:A prob_space) (\x. real_limsup (\n. (X:num->A->real) n x))` ASSUME_TAC THENL + [MATCH_MP_TAC INTEGRABLE_DOMINATED THEN EXISTS_TAC `h:A->real` THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC RANDOM_VARIABLE_REAL_LIMSUP_DOMINATED THEN + EXISTS_TAC `h:A->real` THEN ASM_SIMP_TAC[INTEGRABLE_IMP_RANDOM_VARIABLE]; + GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(REAL_ARITH + `&0 <= h /\ --h <= l /\ l <= h ==> abs(l) <= abs(h)`) THEN + ASM_SIMP_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `real_liminf (\n. (X:num->A->real) n x)` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LIMINF_LBOUND THEN + EXISTS_TAC `(h:A->real) x` THEN ASM_SIMP_TAC[]; + MATCH_MP_TAC REAL_LIMINF_LE_LIMSUP THEN + EXISTS_TAC `--(h:A->real) x` THEN EXISTS_TAC `(h:A->real) x` THEN + ASM_SIMP_TAC[]]; + MATCH_MP_TAC REAL_LIMSUP_UBOUND THEN + EXISTS_TAC `--(h:A->real) x` THEN ASM_SIMP_TAC[]]]; + ALL_TAC] THEN + (* Convert nn_exp(h - limsup(X)) to E[h] - E[limsup(X)] *) + SUBGOAL_THEN `nn_expectation (p:A prob_space) (\x. (h:A->real) x - real_limsup (\n. (X:num->A->real) n x)) = expectation p h - expectation p (\x. real_limsup (\n. X n x))` ASSUME_TAC THENL + [SUBGOAL_THEN `nn_expectation (p:A prob_space) (\x. (h:A->real) x - real_limsup (\n. (X:num->A->real) n x)) = expectation p (\x. h x - real_limsup (\n. X n x))` SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN MATCH_MP_TAC EXPECTATION_NONNEG_EQ_NN THEN + CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_SUB THEN ASM_REWRITE_TAC[ETA_AX]; + GEN_TAC THEN DISCH_TAC THEN BETA_TAC THEN + MATCH_MP_TAC(REAL_ARITH `f <= g ==> &0 <= g - f`) THEN + MATCH_MP_TAC REAL_LIMSUP_UBOUND THEN + EXISTS_TAC `--(h:A->real) x` THEN ASM_SIMP_TAC[]]; + MP_TAC(ISPECL [`p:A prob_space`; `h:A->real`; + `\x:A. real_limsup (\n. (X:num->A->real) n x)`] + EXPECTATION_SUB) THEN + ASM_REWRITE_TAC[ETA_AX]]; + ALL_TAC] THEN + (* Final combination *) + ASM_REAL_ARITH_TAC);; + (* FATOU_EXPECTATION: Fatou's lemma for signed bounded random variables *) let FATOU_EXPECTATION = prove (`!p:A prob_space X A B. @@ -12962,7 +13203,7 @@ let L2_IMP_IN_PROB = prove REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `0` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN MATCH_MP_TAC PROB_POSITIVE THEN - MATCH_MP_TAC RANDOM_VARIABLE_GE THEN + MATCH_MP_TAC RV_PREIMAGE_GE THEN SUBGOAL_THEN `simple_rv (p:A prob_space) (\x:A. abs((X:num->A->real) n x - (L:A->real) x))` MP_TAC THENL [MATCH_MP_TAC SIMPLE_RV_ABS THEN @@ -12999,7 +13240,7 @@ let CONVERGES_L2_IMP_IN_PROB = prove SUBGOAL_THEN `!n. {x:A | x IN prob_carrier p /\ abs((X:num->A->real) n x - (L:A->real) x) >= e} IN prob_events p` ASSUME_TAC THENL - [GEN_TAC THEN MATCH_MP_TAC RANDOM_VARIABLE_GE THEN + [GEN_TAC THEN MATCH_MP_TAC RV_PREIMAGE_GE THEN MATCH_MP_TAC RANDOM_VARIABLE_ABS THEN MATCH_MP_TAC RANDOM_VARIABLE_SUB THEN ASM_REWRITE_TAC[ETA_AX]; @@ -13062,45 +13303,924 @@ let CONVERGES_L2_IMP_IN_PROB = prove MATCH_MP_TAC REALLIM_LMUL THEN ASM_REWRITE_TAC[]]);; (* ========================================================================= *) -(* Abel summation by parts and Kronecker's lemma *) +(* Algebraic properties of convergence in probability *) (* ========================================================================= *) -let ABEL_SUMMATION_IDENTITY = prove - (`!b c n. - sum (0..SUC n) (\k. b k * c k) = - b (SUC n) * sum (0..SUC n) c - - sum (0..n) (\k. sum (0..k) c * (b (SUC k) - b k))`, - GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THENL - [REWRITE_TAC[SUM_CLAUSES_NUMSEG; ARITH_RULE `0 <= 0`; - ARITH_RULE `0 <= SUC 0`] THEN - REWRITE_TAC[SUM_SING_NUMSEG] THEN - REAL_ARITH_TAC; - ONCE_REWRITE_TAC[SUM_CLAUSES_NUMSEG] THEN - REWRITE_TAC[LE_0] THEN - FIRST_X_ASSUM SUBST1_TAC THEN - REAL_ARITH_TAC]);; - -let REAL_ABS_TRIANGLE_SUB = REAL_ARITH `!x y. abs(x - y) <= abs x + abs y`;; - -let KRONECKER_LEMMA = prove - (`!a b. - (!n. &0 < b(n)) /\ - (!n. b(n) <= b(n + 1)) /\ - (!M. ?N. !n. N <= n ==> M <= b(n)) /\ - real_summable (from 0) (\k. a(k) / b(k)) - ==> ((\n. inv(b(n)) * sum(0..n) a) ---> &0) sequentially`, - REPEAT GEN_TAC THEN STRIP_TAC THEN - REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN - X_GEN_TAC `e:real` THEN DISCH_TAC THEN - ABBREV_TAC `c = \k:num. (a(k):real) / b(k)` THEN - ABBREV_TAC `S = real_infsum (from 0) (c:num->real)` THEN - SUBGOAL_THEN `((\n. sum(0..n) (c:num->real)) ---> S) sequentially` - ASSUME_TAC THENL - [UNDISCH_TAC `real_summable (from 0) (c:num->real)` THEN - UNDISCH_TAC `real_infsum (from 0) (c:num->real) = S` THEN - REWRITE_TAC[real_summable; real_sums; FROM_0; INTER_UNIV; - real_infsum] THEN - MESON_TAC[SELECT_AX]; +let CONVERGES_IN_PROB_ADD = prove + (`!p:A prob_space X Y LX LY. + (!n. random_variable p (X n)) /\ random_variable p LX /\ + (!n. random_variable p (Y n)) /\ random_variable p LY /\ + converges_in_prob p X LX /\ + converges_in_prob p Y LY + ==> converges_in_prob p (\n x. X n x + Y n x) (\x. LX x + LY x)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[converges_in_prob] THEN STRIP_TAC THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + SUBGOAL_THEN + `!n. {x:A | x IN prob_carrier p /\ + abs(((X:num->A->real) n x + (Y:num->A->real) n x) - + (LX x + LY x)) >= e} IN prob_events p` + ASSUME_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC RV_PREIMAGE_GE THEN + MATCH_MP_TAC RANDOM_VARIABLE_ABS THEN + MATCH_MP_TAC RANDOM_VARIABLE_SUB THEN + ASM_REWRITE_TAC[ETA_AX] THEN + CONJ_TAC THEN MATCH_MP_TAC RANDOM_VARIABLE_ADD THEN + ASM_REWRITE_TAC[ETA_AX]; + ALL_TAC] THEN + SUBGOAL_THEN + `!n. {x:A | x IN prob_carrier p /\ + abs((X:num->A->real) n x - LX x) >= e / &2} IN prob_events p` + ASSUME_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC RV_PREIMAGE_GE THEN + MATCH_MP_TAC RANDOM_VARIABLE_ABS THEN + MATCH_MP_TAC RANDOM_VARIABLE_SUB THEN + ASM_REWRITE_TAC[ETA_AX]; + ALL_TAC] THEN + SUBGOAL_THEN + `!n. {x:A | x IN prob_carrier p /\ + abs((Y:num->A->real) n x - LY x) >= e / &2} IN prob_events p` + ASSUME_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC RV_PREIMAGE_GE THEN + MATCH_MP_TAC RANDOM_VARIABLE_ABS THEN + MATCH_MP_TAC RANDOM_VARIABLE_SUB THEN + ASM_REWRITE_TAC[ETA_AX]; + ALL_TAC] THEN + SUBGOAL_THEN + `!n. {x:A | x IN prob_carrier p /\ + abs(((X:num->A->real) n x + Y n x) - (LX x + LY x)) >= e} SUBSET + {x | x IN prob_carrier p /\ abs(X n x - LX x) >= e / &2} UNION + {x | x IN prob_carrier p /\ abs(Y n x - LY x) >= e / &2}` + ASSUME_TAC THENL + [GEN_TAC THEN REWRITE_TAC[SUBSET; IN_UNION; IN_ELIM_THM] THEN + X_GEN_TAC `x:A` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REAL_ARITH + `abs((a + b) - (c + d)) >= e /\ + abs((a + b) - (c + d)) <= abs(a - c) + abs(b - d) + ==> abs(a - c) >= e / &2 \/ abs(b - d) >= e / &2`) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC(ISPECL [`\n:num. &0`; + `\n:num. prob (p:A prob_space) {x:A | x IN prob_carrier p /\ + abs(((X:num->A->real) n x + (Y:num->A->real) n x) - + (LX x + LY x)) >= e}`; + `\n:num. prob (p:A prob_space) + {x:A | x IN prob_carrier p /\ + abs((X:num->A->real) n x - LX x) >= e / &2} + + prob p {x | x IN prob_carrier p /\ + abs((Y:num->A->real) n x - LY x) >= e / &2}`; + `&0`] REALLIM_TRANSFORM_STRADDLE) THEN + BETA_TAC THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `0` THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC PROB_POSITIVE THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[REALLIM_CONST]; + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `0` THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `prob (p:A prob_space) + ({x:A | x IN prob_carrier p /\ + abs((X:num->A->real) n x - LX x) >= e / &2} UNION + {x | x IN prob_carrier p /\ + abs((Y:num->A->real) n x - LY x) >= e / &2})` THEN + CONJ_TAC THENL + [MATCH_MP_TAC PROB_MONO THEN ASM_REWRITE_TAC[] THEN + ASM_SIMP_TAC[PROB_UNION_IN_EVENTS]; + MP_TAC(ISPECL [`p:A prob_space`; + `{x:A | x IN prob_carrier p /\ + abs((X:num->A->real) n x - LX x) >= e / &2}`; + `{x:A | x IN prob_carrier p /\ + abs((Y:num->A->real) n x - LY x) >= e / &2}`] + PROB_UNION) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= c ==> a + b - c <= a + b`) THEN + MATCH_MP_TAC PROB_POSITIVE THEN + ASM_SIMP_TAC[PROB_INTER_IN_EVENTS]]; + SUBGOAL_THEN `&0 = &0 + &0` SUBST1_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REALLIM_ADD THEN CONJ_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC]);; + +let CONVERGES_IN_PROB_NEG = prove + (`!p:A prob_space X L. + converges_in_prob p X L + ==> converges_in_prob p (\n x. --(X n x)) (\x. --(L x))`, + REPEAT GEN_TAC THEN REWRITE_TAC[converges_in_prob] THEN + DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REALLIM_TRANSFORM_EVENTUALLY) THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `0` THEN + REPEAT STRIP_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN GEN_TAC THEN + REWRITE_TAC[REAL_ARITH `abs(--a - --b) = abs(a - b)`]);; + +let CONVERGES_IN_PROB_SUB = prove + (`!p:A prob_space X Y LX LY. + (!n. random_variable p (X n)) /\ random_variable p LX /\ + (!n. random_variable p (Y n)) /\ random_variable p LY /\ + converges_in_prob p X LX /\ + converges_in_prob p Y LY + ==> converges_in_prob p (\n x. X n x - Y n x) (\x. LX x - LY x)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + REWRITE_TAC[real_sub] THEN + MATCH_MP_TAC CONVERGES_IN_PROB_ADD THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC RANDOM_VARIABLE_NEG THEN + ASM_REWRITE_TAC[ETA_AX]; + ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC RANDOM_VARIABLE_NEG THEN ASM_REWRITE_TAC[ETA_AX]; + MATCH_MP_TAC CONVERGES_IN_PROB_NEG THEN ASM_REWRITE_TAC[]]);; + +let CONVERGES_IN_PROB_CMUL = prove + (`!p:A prob_space X L c. + (!n. random_variable p (X n)) /\ random_variable p L /\ + converges_in_prob p X L + ==> converges_in_prob p (\n x. c * X n x) (\x. c * L x)`, + REPEAT GEN_TAC THEN + REWRITE_TAC[converges_in_prob] THEN STRIP_TAC THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + ASM_CASES_TAC `c = &0` THENL + [ASM_REWRITE_TAC[REAL_MUL_LZERO; REAL_SUB_REFL; REAL_ABS_NUM] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < e ==> ~(&0 >= e)`] THEN + REWRITE_TAC[EMPTY_GSPEC; PROB_EMPTY; REALLIM_CONST]; + ALL_TAC] THEN + SUBGOAL_THEN `&0 < abs c` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / abs c`) THEN + ASM_SIMP_TAC[REAL_LT_DIV] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] REALLIM_TRANSFORM_EVENTUALLY) THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `0` THEN + REPEAT STRIP_TAC THEN AP_TERM_TAC THEN + REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `x:A` THEN + REWRITE_TAC[GSYM REAL_SUB_LDISTRIB] THEN + REWRITE_TAC[REAL_ABS_MUL] THEN + ASM_CASES_TAC `(x:A) IN prob_carrier p` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[real_ge] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_ARITH `&0 < c ==> &0 < abs c`] THEN + REWRITE_TAC[REAL_MUL_SYM]);; + +let CONVERGES_IN_PROB_CONST = prove + (`!p:A prob_space c. + converges_in_prob p (\n:num x:A. c) (\x. c)`, + REPEAT GEN_TAC THEN REWRITE_TAC[converges_in_prob] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + SUBGOAL_THEN + `!n:num. {x:A | x IN prob_carrier p /\ abs(c - c) >= e} = {}` + (fun th -> REWRITE_TAC[th]) THENL + [GEN_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN + GEN_TAC THEN REWRITE_TAC[REAL_SUB_REFL; REAL_ABS_NUM] THEN + ASM_REAL_ARITH_TAC; + REWRITE_TAC[PROB_EMPTY; REALLIM_CONST]]);; + +let CONVERGES_IN_PROB_UNIQUE = prove + (`!p:A prob_space X L M. + (!n. random_variable p (X n)) /\ + random_variable p L /\ random_variable p M /\ + converges_in_prob p X L /\ + converges_in_prob p X M + ==> !e. &0 < e ==> + prob p {x | x IN prob_carrier p /\ + abs(L x - M x) >= e} = &0`, + REPEAT GEN_TAC THEN + REWRITE_TAC[converges_in_prob] THEN STRIP_TAC THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x <= &0 ==> x = &0`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC PROB_POSITIVE THEN MATCH_MP_TAC RV_PREIMAGE_GE THEN + MATCH_MP_TAC RANDOM_VARIABLE_ABS THEN + MATCH_MP_TAC RANDOM_VARIABLE_SUB THEN ASM_REWRITE_TAC[ETA_AX]; + ALL_TAC] THEN + REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN + ABBREV_TAC `p0 = prob (p:A prob_space) + {x:A | x IN prob_carrier p /\ abs(L x - M x) >= e}` THEN + SUBGOAL_THEN + `?N1:num. !n. N1 <= n ==> + abs(prob (p:A prob_space) {x:A | x IN prob_carrier p /\ + abs((X:num->A->real) n x - L x) >= e / &2} - &0) < p0 / &4` + (X_CHOOSE_TAC `N1:num`) THENL + [UNDISCH_TAC `!e. &0 < e ==> + ((\n. prob (p:A prob_space) {x:A | x IN prob_carrier p /\ + abs((X:num->A->real) n x - L x) >= e}) ---> &0) sequentially` THEN + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `?N2:num. !n. N2 <= n ==> + abs(prob (p:A prob_space) {x:A | x IN prob_carrier p /\ + abs((X:num->A->real) n x - M x) >= e / &2} - &0) < p0 / &4` + (X_CHOOSE_TAC `N2:num`) THENL + [UNDISCH_TAC `!e. &0 < e ==> + ((\n. prob (p:A prob_space) {x:A | x IN prob_carrier p /\ + abs((X:num->A->real) n x - M x) >= e}) ---> &0) sequentially` THEN + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN + ASM_SIMP_TAC[REAL_LT_DIV; REAL_OF_NUM_LT; ARITH] THEN + REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `{x:A | x IN prob_carrier p /\ abs(L x - M x) >= e} SUBSET + {x | x IN prob_carrier p /\ + abs((X:num->A->real) (N1 + N2) x - L x) >= e / &2} UNION + {x | x IN prob_carrier p /\ + abs(X (N1 + N2) x - M x) >= e / &2}` + ASSUME_TAC THENL + [REWRITE_TAC[SUBSET; IN_UNION; IN_ELIM_THM] THEN + X_GEN_TAC `x:A` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REAL_ARITH + `abs(l - m) >= e /\ + abs(l - m) <= abs(xn - l) + abs(xn - m) + ==> abs(xn - l) >= e / &2 \/ abs(xn - m) >= e / &2`) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `{x:A | x IN prob_carrier p /\ + abs((X:num->A->real) (N1+N2) x - L x) >= e / &2} IN prob_events p /\ + {x:A | x IN prob_carrier p /\ + abs(X (N1+N2) x - M x) >= e / &2} IN prob_events p` + STRIP_ASSUME_TAC THENL + [CONJ_TAC THEN MATCH_MP_TAC RV_PREIMAGE_GE THEN + MATCH_MP_TAC RANDOM_VARIABLE_ABS THEN + MATCH_MP_TAC RANDOM_VARIABLE_SUB THEN ASM_REWRITE_TAC[ETA_AX]; + ALL_TAC] THEN + ABBREV_TAC `pL = prob (p:A prob_space) + {x:A | x IN prob_carrier p /\ + abs((X:num->A->real) (N1+N2) x - L x) >= e / &2}` THEN + ABBREV_TAC `pM = prob (p:A prob_space) + {x:A | x IN prob_carrier p /\ + abs((X:num->A->real) (N1+N2) x - M x) >= e / &2}` THEN + SUBGOAL_THEN `p0 <= pL + pM` ASSUME_TAC THENL + [EXPAND_TAC "p0" THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `prob (p:A prob_space) + ({x:A | x IN prob_carrier p /\ + abs((X:num->A->real) (N1+N2) x - L x) >= e / &2} UNION + {x | x IN prob_carrier p /\ + abs(X (N1+N2) x - M x) >= e / &2})` THEN + CONJ_TAC THENL + [MATCH_MP_TAC PROB_MONO THEN ASM_SIMP_TAC[PROB_UNION_IN_EVENTS] THEN + MATCH_MP_TAC RV_PREIMAGE_GE THEN + MATCH_MP_TAC RANDOM_VARIABLE_ABS THEN + MATCH_MP_TAC RANDOM_VARIABLE_SUB THEN ASM_REWRITE_TAC[ETA_AX]; + MP_TAC(ISPECL [`p:A prob_space`; + `{x:A | x IN prob_carrier p /\ + abs((X:num->A->real) (N1+N2) x - L x) >= e / &2}`; + `{x:A | x IN prob_carrier p /\ + abs((X:num->A->real) (N1+N2) x - M x) >= e / &2}`] + PROB_UNION) THEN ASM_REWRITE_TAC[] THEN + EXPAND_TAC "pL" THEN EXPAND_TAC "pM" THEN + DISCH_THEN SUBST1_TAC THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= c ==> a + b - c <= a + b`) THEN + MATCH_MP_TAC PROB_POSITIVE THEN + ASM_SIMP_TAC[PROB_INTER_IN_EVENTS]]; + ALL_TAC] THEN + SUBGOAL_THEN `abs(pL - &0) < p0 / &4` ASSUME_TAC THENL + [EXPAND_TAC "pL" THEN + UNDISCH_TAC `!n:num. N1 <= n ==> + abs(prob (p:A prob_space) {x:A | x IN prob_carrier p /\ + abs((X:num->A->real) n x - L x) >= e / &2} - &0) < p0 / &4` THEN + DISCH_THEN(MP_TAC o SPEC `N1 + N2:num`) THEN + REWRITE_TAC[ARITH_RULE `(N1:num) <= N1 + N2`]; + ALL_TAC] THEN + SUBGOAL_THEN `abs(pM - &0) < p0 / &4` ASSUME_TAC THENL + [EXPAND_TAC "pM" THEN + UNDISCH_TAC `!n:num. N2 <= n ==> + abs(prob (p:A prob_space) {x:A | x IN prob_carrier p /\ + abs((X:num->A->real) n x - M x) >= e / &2} - &0) < p0 / &4` THEN + DISCH_THEN(MP_TAC o SPEC `N1 + N2:num`) THEN + REWRITE_TAC[ARITH_RULE `(N2:num) <= N1 + N2`]; + ALL_TAC] THEN + ASM_REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Convergence in probability is preserved by the 1-Lipschitz operations *) +(* abs, max and min. In each case the bad event for the output is contained *) +(* in a union of bad events for the inputs, so its probability is squeezed *) +(* to 0. *) +(* ------------------------------------------------------------------------- *) + +let CONVERGES_IN_PROB_ABS = prove + (`!p:A prob_space X L. + (!n. random_variable p (X n)) /\ random_variable p L /\ + converges_in_prob p X L + ==> converges_in_prob p (\n x. abs(X n x)) (\x. abs(L x))`, + REPEAT GEN_TAC THEN REWRITE_TAC[converges_in_prob] THEN STRIP_TAC THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN + MATCH_MP_TAC(ISPECL + [`\n:num. &0`; + `\n:num. prob (p:A prob_space) + {x:A | x IN prob_carrier p /\ abs(abs(X n x) - abs(L x)) >= e}`; + `\n:num. prob (p:A prob_space) + {x:A | x IN prob_carrier p /\ abs((X:num->A->real) n x - L x) >= e}`; + `&0`] REALLIM_TRANSFORM_STRADDLE) THEN + BETA_TAC THEN ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `0` THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC PROB_POSITIVE THEN + MATCH_MP_TAC RV_PREIMAGE_GE THEN MATCH_MP_TAC RANDOM_VARIABLE_ABS THEN + MATCH_MP_TAC RANDOM_VARIABLE_SUB THEN + CONJ_TAC THEN MATCH_MP_TAC RANDOM_VARIABLE_ABS THEN ASM_REWRITE_TAC[ETA_AX]; + REWRITE_TAC[REALLIM_CONST]; + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `0` THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN MATCH_MP_TAC PROB_MONO THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC RV_PREIMAGE_GE THEN MATCH_MP_TAC RANDOM_VARIABLE_ABS THEN + MATCH_MP_TAC RANDOM_VARIABLE_SUB THEN + CONJ_TAC THEN MATCH_MP_TAC RANDOM_VARIABLE_ABS THEN ASM_REWRITE_TAC[ETA_AX]; + MATCH_MP_TAC RV_PREIMAGE_GE THEN MATCH_MP_TAC RANDOM_VARIABLE_ABS THEN + MATCH_MP_TAC RANDOM_VARIABLE_SUB THEN ASM_REWRITE_TAC[ETA_AX]; + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `x:A` THEN STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MP_TAC THEN + MATCH_MP_TAC(REAL_ARITH + `abs(abs a - abs b) <= abs(a - b) + ==> abs(abs a - abs b) >= e ==> abs(a - b) >= e`) THEN + REWRITE_TAC[REAL_ABS_SUB_ABS]]]);; + +let CONVERGES_IN_PROB_MAX = prove + (`!p:A prob_space X Y LX LY. + (!n. random_variable p (X n)) /\ random_variable p LX /\ + (!n. random_variable p (Y n)) /\ random_variable p LY /\ + converges_in_prob p X LX /\ converges_in_prob p Y LY + ==> converges_in_prob p (\n x. max (X n x) (Y n x)) + (\x. max (LX x) (LY x))`, + REPEAT GEN_TAC THEN REWRITE_TAC[converges_in_prob] THEN STRIP_TAC THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_SIMP_TAC[REAL_HALF] THEN + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN + ASM_SIMP_TAC[REAL_HALF] THEN DISCH_TAC THEN + MATCH_MP_TAC(ISPECL + [`\n:num. &0`; + `\n:num. prob (p:A prob_space) + {x:A | x IN prob_carrier p /\ abs(max (X n x) (Y n x) - max (LX x) (LY x)) >= e}`; + `\n:num. prob (p:A prob_space) + {x:A | x IN prob_carrier p /\ abs((X:num->A->real) n x - LX x) >= e / &2} + + prob (p:A prob_space) + {x:A | x IN prob_carrier p /\ abs((Y:num->A->real) n x - LY x) >= e / &2}`; + `&0`] REALLIM_TRANSFORM_STRADDLE) THEN + BETA_TAC THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `0` THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC PROB_POSITIVE THEN + MATCH_MP_TAC RV_PREIMAGE_GE THEN MATCH_MP_TAC RANDOM_VARIABLE_ABS THEN + MATCH_MP_TAC RANDOM_VARIABLE_SUB THEN + CONJ_TAC THEN MATCH_MP_TAC RANDOM_VARIABLE_MAX THEN ASM_REWRITE_TAC[ETA_AX]; + REWRITE_TAC[REALLIM_CONST]; + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `0` THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `prob (p:A prob_space) + ({x:A | x IN prob_carrier p /\ abs((X:num->A->real) n x - LX x) >= e / &2} UNION + {x:A | x IN prob_carrier p /\ abs((Y:num->A->real) n x - LY x) >= e / &2})` THEN + CONJ_TAC THENL + [MATCH_MP_TAC PROB_MONO THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC RV_PREIMAGE_GE THEN MATCH_MP_TAC RANDOM_VARIABLE_ABS THEN + MATCH_MP_TAC RANDOM_VARIABLE_SUB THEN + CONJ_TAC THEN MATCH_MP_TAC RANDOM_VARIABLE_MAX THEN ASM_REWRITE_TAC[ETA_AX]; + MATCH_MP_TAC PROB_UNION_IN_EVENTS THEN + CONJ_TAC THEN MATCH_MP_TAC RV_PREIMAGE_GE THEN + MATCH_MP_TAC RANDOM_VARIABLE_ABS THEN MATCH_MP_TAC RANDOM_VARIABLE_SUB THEN + ASM_REWRITE_TAC[ETA_AX]; + REWRITE_TAC[SUBSET; IN_UNION; IN_ELIM_THM] THEN X_GEN_TAC `x:A` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MP_TAC THEN + MATCH_MP_TAC(REAL_ARITH + `abs(max a b - max c d) <= abs(a - c) + abs(b - d) + ==> abs(max a b - max c d) >= e + ==> abs(a - c) >= e / &2 \/ abs(b - d) >= e / &2`) THEN + REWRITE_TAC[REAL_ARITH `abs(max a b - max c d) <= abs(a - c) + abs(b - d)`]]; + MATCH_MP_TAC PROB_SUBADDITIVE THEN + CONJ_TAC THEN MATCH_MP_TAC RV_PREIMAGE_GE THEN + MATCH_MP_TAC RANDOM_VARIABLE_ABS THEN MATCH_MP_TAC RANDOM_VARIABLE_SUB THEN + ASM_REWRITE_TAC[ETA_AX]]; + SUBGOAL_THEN `&0 = &0 + &0` SUBST1_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REALLIM_ADD THEN ASM_REWRITE_TAC[]]);; + +let CONVERGES_IN_PROB_MIN = prove + (`!p:A prob_space X Y LX LY. + (!n. random_variable p (X n)) /\ random_variable p LX /\ + (!n. random_variable p (Y n)) /\ random_variable p LY /\ + converges_in_prob p X LX /\ converges_in_prob p Y LY + ==> converges_in_prob p (\n x. min (X n x) (Y n x)) + (\x. min (LX x) (LY x))`, + REPEAT GEN_TAC THEN REWRITE_TAC[converges_in_prob] THEN STRIP_TAC THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN ASM_SIMP_TAC[REAL_HALF] THEN + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `e / &2`) THEN + ASM_SIMP_TAC[REAL_HALF] THEN DISCH_TAC THEN + MATCH_MP_TAC(ISPECL + [`\n:num. &0`; + `\n:num. prob (p:A prob_space) + {x:A | x IN prob_carrier p /\ abs(min (X n x) (Y n x) - min (LX x) (LY x)) >= e}`; + `\n:num. prob (p:A prob_space) + {x:A | x IN prob_carrier p /\ abs((X:num->A->real) n x - LX x) >= e / &2} + + prob (p:A prob_space) + {x:A | x IN prob_carrier p /\ abs((Y:num->A->real) n x - LY x) >= e / &2}`; + `&0`] REALLIM_TRANSFORM_STRADDLE) THEN + BETA_TAC THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `0` THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC PROB_POSITIVE THEN + MATCH_MP_TAC RV_PREIMAGE_GE THEN MATCH_MP_TAC RANDOM_VARIABLE_ABS THEN + MATCH_MP_TAC RANDOM_VARIABLE_SUB THEN + CONJ_TAC THEN MATCH_MP_TAC RANDOM_VARIABLE_MIN THEN ASM_REWRITE_TAC[ETA_AX]; + REWRITE_TAC[REALLIM_CONST]; + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `0` THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `prob (p:A prob_space) + ({x:A | x IN prob_carrier p /\ abs((X:num->A->real) n x - LX x) >= e / &2} UNION + {x:A | x IN prob_carrier p /\ abs((Y:num->A->real) n x - LY x) >= e / &2})` THEN + CONJ_TAC THENL + [MATCH_MP_TAC PROB_MONO THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC RV_PREIMAGE_GE THEN MATCH_MP_TAC RANDOM_VARIABLE_ABS THEN + MATCH_MP_TAC RANDOM_VARIABLE_SUB THEN + CONJ_TAC THEN MATCH_MP_TAC RANDOM_VARIABLE_MIN THEN ASM_REWRITE_TAC[ETA_AX]; + MATCH_MP_TAC PROB_UNION_IN_EVENTS THEN + CONJ_TAC THEN MATCH_MP_TAC RV_PREIMAGE_GE THEN + MATCH_MP_TAC RANDOM_VARIABLE_ABS THEN MATCH_MP_TAC RANDOM_VARIABLE_SUB THEN + ASM_REWRITE_TAC[ETA_AX]; + REWRITE_TAC[SUBSET; IN_UNION; IN_ELIM_THM] THEN X_GEN_TAC `x:A` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN FIRST_X_ASSUM MP_TAC THEN + MATCH_MP_TAC(REAL_ARITH + `abs(min a b - min c d) <= abs(a - c) + abs(b - d) + ==> abs(min a b - min c d) >= e + ==> abs(a - c) >= e / &2 \/ abs(b - d) >= e / &2`) THEN + REWRITE_TAC[REAL_ARITH `abs(min a b - min c d) <= abs(a - c) + abs(b - d)`]]; + MATCH_MP_TAC PROB_SUBADDITIVE THEN + CONJ_TAC THEN MATCH_MP_TAC RV_PREIMAGE_GE THEN + MATCH_MP_TAC RANDOM_VARIABLE_ABS THEN MATCH_MP_TAC RANDOM_VARIABLE_SUB THEN + ASM_REWRITE_TAC[ETA_AX]]; + SUBGOAL_THEN `&0 = &0 + &0` SUBST1_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REALLIM_ADD THEN ASM_REWRITE_TAC[]]);; + +(* Building blocks for the product rule on convergence in probability. *) +(* A single random variable has vanishing tails: the decreasing events *) +(* indexed by n have empty intersection. *) +let PROB_ABS_GE_TENDS_TO_ZERO = prove + (`!p:A prob_space Z. + random_variable p Z + ==> ((\n. prob p {x | x IN prob_carrier p /\ abs(Z x) >= &n + &1}) ---> &0) + sequentially`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; + `\n:num. {x:A | x IN prob_carrier p /\ abs((Z:A->real) x) >= &n + &1}`] + PROB_CONTINUITY_FROM_ABOVE) THEN + BETA_TAC THEN ANTS_TAC THENL + [CONJ_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC RV_PREIMAGE_GE THEN + MATCH_MP_TAC RANDOM_VARIABLE_ABS THEN ASM_REWRITE_TAC[ETA_AX]; + GEN_TAC THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `x:A` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM MP_TAC THEN REWRITE_TAC[GSYM REAL_OF_NUM_SUC] THEN + REAL_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN + `INTERS {{x:A | x IN prob_carrier p /\ abs((Z:A->real) x) >= &n + &1} | n IN (:num)} = + ({}:A->bool)` + ASSUME_TAC THENL + [REWRITE_TAC[EXTENSION; INTERS_GSPEC; IN_ELIM_THM; NOT_IN_EMPTY; IN_UNIV] THEN + X_GEN_TAC `x:A` THEN REWRITE_TAC[NOT_FORALL_THM] THEN + ASM_CASES_TAC `(x:A) IN prob_carrier p` THENL + [MP_TAC(ISPEC `abs((Z:A->real) x)` REAL_ARCH_SIMPLE) THEN + DISCH_THEN(X_CHOOSE_TAC `n:num`) THEN EXISTS_TAC `n:num` THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[real_ge] THEN ASM_REAL_ARITH_TAC; + EXISTS_TAC `0` THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + ASM_REWRITE_TAC[PROB_EMPTY]);; + +(* Square-root split: if abs a and abs b are below sqrt e, then abs(ab) < e. *) +let ABS_MUL_LT_SQRT = prove + (`!e a b:real. &0 < e /\ abs a < sqrt e /\ abs b < sqrt e ==> abs(a * b) < e`, + REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ABS_MUL] THEN + SUBGOAL_THEN `e = sqrt e * sqrt e` SUBST1_TAC THENL + [ASM_SIMP_TAC[GSYM REAL_POW_2; SQRT_POW_2; REAL_LT_IMP_LE]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LT_MUL2 THEN ASM_REWRITE_TAC[REAL_ABS_POS]);; + +let ABS_MUL_GE_SPLIT = prove + (`!e a b:real. &0 < e /\ abs(a * b) >= e ==> abs a >= sqrt e \/ abs b >= sqrt e`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`e:real`; `a:real`; `b:real`] ABS_MUL_LT_SQRT) THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC);; + +(* The product of two sequences that converge to 0 in probability also *) +(* converges to 0 (split at sqrt e). *) +let CONVERGES_IN_PROB_NULL_MUL = prove + (`!p:A prob_space X Y. + (!n. random_variable p (X n)) /\ (!n. random_variable p (Y n)) /\ + converges_in_prob p X (\x. &0) /\ converges_in_prob p Y (\x. &0) + ==> converges_in_prob p (\n x. X n x * Y n x) (\x. &0)`, + REPEAT GEN_TAC THEN REWRITE_TAC[converges_in_prob] THEN STRIP_TAC THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `sqrt e`) THEN + ANTS_TAC THENL [ASM_SIMP_TAC[SQRT_POS_LT]; ALL_TAC] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `sqrt e`) THEN + ANTS_TAC THENL [ASM_SIMP_TAC[SQRT_POS_LT]; ALL_TAC] THEN DISCH_TAC THEN + REWRITE_TAC[REAL_SUB_RZERO] THEN + MATCH_MP_TAC REALLIM_NULL_COMPARISON THEN + EXISTS_TAC + `\n:num. prob (p:A prob_space) + {x:A | x IN prob_carrier p /\ abs((X:num->A->real) n x - &0) >= sqrt e} + + prob (p:A prob_space) + {x:A | x IN prob_carrier p /\ abs((Y:num->A->real) n x - &0) >= sqrt e}` THEN + CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `0` THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN BETA_TAC THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= q /\ q <= b ==> abs q <= b`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC PROB_POSITIVE THEN MATCH_MP_TAC RV_PREIMAGE_GE THEN + MATCH_MP_TAC RANDOM_VARIABLE_ABS THEN MATCH_MP_TAC RANDOM_VARIABLE_MUL THEN + ASM_REWRITE_TAC[ETA_AX]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `prob (p:A prob_space) + ({x:A | x IN prob_carrier p /\ abs((X:num->A->real) n x - &0) >= sqrt e} UNION + {x:A | x IN prob_carrier p /\ abs((Y:num->A->real) n x - &0) >= sqrt e})` THEN + CONJ_TAC THENL + [MATCH_MP_TAC PROB_MONO THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC RV_PREIMAGE_GE THEN MATCH_MP_TAC RANDOM_VARIABLE_ABS THEN + MATCH_MP_TAC RANDOM_VARIABLE_MUL THEN ASM_REWRITE_TAC[ETA_AX]; + MATCH_MP_TAC PROB_UNION_IN_EVENTS THEN + CONJ_TAC THEN MATCH_MP_TAC RV_PREIMAGE_GE THEN + MATCH_MP_TAC RANDOM_VARIABLE_ABS THEN MATCH_MP_TAC RANDOM_VARIABLE_SUB THEN + ASM_REWRITE_TAC[ETA_AX; RANDOM_VARIABLE_CONST]; + REWRITE_TAC[SUBSET; IN_UNION; IN_ELIM_THM] THEN X_GEN_TAC `x:A` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[REAL_SUB_RZERO] THEN + MP_TAC(ISPECL [`e:real`; `(X:num->A->real) n x`; `(Y:num->A->real) n x`] + ABS_MUL_GE_SPLIT) THEN ASM_REWRITE_TAC[] THEN MESON_TAC[]]; + MATCH_MP_TAC PROB_SUBADDITIVE THEN + CONJ_TAC THEN MATCH_MP_TAC RV_PREIMAGE_GE THEN + MATCH_MP_TAC RANDOM_VARIABLE_ABS THEN MATCH_MP_TAC RANDOM_VARIABLE_SUB THEN + ASM_REWRITE_TAC[ETA_AX; RANDOM_VARIABLE_CONST]]; + MATCH_MP_TAC REALLIM_NULL_ADD THEN ASM_REWRITE_TAC[]]);; + +(* Product split with one factor fixed: abs(z*y) >= e forces abs z large, or *) +(* else abs y is at least e/(M+1). *) +let ABS_MUL_GE_SPLIT_BOUND = prove + (`!e z y:real n. &0 < e /\ abs(z * y) >= e + ==> abs z >= &n + &1 \/ abs y >= e / (&n + &1)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&0 < &n + &1` ASSUME_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + ASM_CASES_TAC `abs(z:real) >= &n + &1` THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + DISJ2_TAC THEN ASM_SIMP_TAC[real_ge; REAL_LE_LDIV_EQ] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `abs(z:real) * abs(y:real)` THEN + CONJ_TAC THENL + [REWRITE_TAC[GSYM REAL_ABS_MUL] THEN UNDISCH_TAC `abs(z * y:real) >= e` THEN + REAL_ARITH_TAC; + GEN_REWRITE_TAC (RAND_CONV) [REAL_MUL_SYM] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN + UNDISCH_TAC `~(abs(z:real) >= &n + &1)` THEN REAL_ARITH_TAC]);; + +(* A fixed random variable times a sequence converging to 0 in probability *) +(* converges to 0: choose M so prob of large abs Z is small (tails vanish), *) +(* convergence of Y at threshold e/(M+1). *) +let CONVERGES_IN_PROB_BOUNDED_MUL = prove + (`!p:A prob_space Z Y. + random_variable p Z /\ (!n. random_variable p (Y n)) /\ + converges_in_prob p Y (\x. &0) + ==> converges_in_prob p (\n x. Z x * Y n x) (\x. &0)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[converges_in_prob] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN X_GEN_TAC `eta:real` THEN DISCH_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `Z:A->real`] PROB_ABS_GE_TENDS_TO_ZERO) THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + DISCH_THEN(MP_TAC o SPEC `eta / &2`) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `M:num` (MP_TAC o SPEC `M:num`)) THEN + REWRITE_TAC[LE_REFL; REAL_SUB_RZERO] THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [converges_in_prob]) THEN + DISCH_THEN(MP_TAC o SPEC `e / (&M + &1)`) THEN + ANTS_TAC THENL + [MATCH_MP_TAC REAL_LT_DIV THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + DISCH_THEN(MP_TAC o SPEC `eta / &2`) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` (LABEL_TAC "Y")) THEN + EXISTS_TAC `N:num` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + REMOVE_THEN "Y" (MP_TAC o SPEC `n:num`) THEN + ASM_REWRITE_TAC[REAL_SUB_RZERO] THEN DISCH_TAC THEN + SUBGOAL_THEN + `prob p {x:A | x IN prob_carrier p /\ abs((Z:A->real) x * (Y:num->A->real) n x) >= e} <= + prob p {x:A | x IN prob_carrier p /\ abs(Z x) >= &M + &1} + + prob p {x:A | x IN prob_carrier p /\ abs(Y n x) >= e / (&M + &1)}` + ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `prob (p:A prob_space) + ({x:A | x IN prob_carrier p /\ abs((Z:A->real) x) >= &M + &1} UNION + {x:A | x IN prob_carrier p /\ abs((Y:num->A->real) n x) >= e / (&M + &1)})` THEN + CONJ_TAC THENL + [MATCH_MP_TAC PROB_MONO THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC RV_PREIMAGE_GE THEN MATCH_MP_TAC RANDOM_VARIABLE_ABS THEN + MATCH_MP_TAC RANDOM_VARIABLE_MUL THEN ASM_REWRITE_TAC[ETA_AX]; + MATCH_MP_TAC PROB_UNION_IN_EVENTS THEN CONJ_TAC THEN + MATCH_MP_TAC RV_PREIMAGE_GE THEN MATCH_MP_TAC RANDOM_VARIABLE_ABS THEN + ASM_REWRITE_TAC[ETA_AX]; + REWRITE_TAC[SUBSET; IN_UNION; IN_ELIM_THM] THEN X_GEN_TAC `x:A` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`e:real`; `(Z:A->real) x`; `(Y:num->A->real) n x`; `M:num`] + ABS_MUL_GE_SPLIT_BOUND) THEN ASM_REWRITE_TAC[] THEN MESON_TAC[]]; + MATCH_MP_TAC PROB_SUBADDITIVE THEN CONJ_TAC THEN + MATCH_MP_TAC RV_PREIMAGE_GE THEN MATCH_MP_TAC RANDOM_VARIABLE_ABS THEN + ASM_REWRITE_TAC[ETA_AX]]; + ALL_TAC] THEN + SUBGOAL_THEN + `&0 <= prob p {x:A | x IN prob_carrier p /\ abs((Y:num->A->real) n x) >= e / (&M + &1)}` + ASSUME_TAC THENL + [MATCH_MP_TAC PROB_POSITIVE THEN MATCH_MP_TAC RV_PREIMAGE_GE THEN + MATCH_MP_TAC RANDOM_VARIABLE_ABS THEN ASM_REWRITE_TAC[ETA_AX]; + ALL_TAC] THEN + SUBGOAL_THEN + `&0 <= prob p {x:A | x IN prob_carrier p /\ abs((Z:A->real) x * (Y:num->A->real) n x) >= e}` + ASSUME_TAC THENL + [MATCH_MP_TAC PROB_POSITIVE THEN MATCH_MP_TAC RV_PREIMAGE_GE THEN + MATCH_MP_TAC RANDOM_VARIABLE_ABS THEN MATCH_MP_TAC RANDOM_VARIABLE_MUL THEN + ASM_REWRITE_TAC[ETA_AX]; + ALL_TAC] THEN + FIRST_ASSUM(MP_TAC o MATCH_MP (REAL_ARITH + `q <= a + b + ==> &0 <= q /\ &0 <= b /\ abs a < eta / &2 /\ abs b < eta / &2 + ==> abs q < eta`)) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[]);; + +(* Convergence in probability of a difference to 0 is the same as convergence. *) +let CONVERGES_IN_PROB_DIFF_ZERO = prove + (`!p:A prob_space X L. + converges_in_prob p X L <=> + converges_in_prob p (\n x. X n x - L x) (\x. &0)`, + REWRITE_TAC[converges_in_prob; REAL_SUB_RZERO]);; + +(* Sum of two sequences converging to 0 in probability converges to 0. *) +let CONVERGES_IN_PROB_NULL_ADD = prove + (`!p:A prob_space X Y. + (!n. random_variable p (X n)) /\ (!n. random_variable p (Y n)) /\ + converges_in_prob p X (\x. &0) /\ converges_in_prob p Y (\x. &0) + ==> converges_in_prob p (\n x. X n x + Y n x) (\x. &0)`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `X:num->A->real`; `Y:num->A->real`; + `(\x. &0):A->real`; `(\x. &0):A->real`] CONVERGES_IN_PROB_ADD) THEN + ASM_REWRITE_TAC[RANDOM_VARIABLE_CONST; REAL_ADD_LID]);; + +(* The product rule: X_n -> X and Y_n -> Y in probability give X_n Y_n -> X Y. *) +(* Decompose X_n Y_n - X Y = (X_n - X)(Y_n - Y) + (Y_n - Y) X + (X_n - X) Y, *) +(* whose three summands vanish by NULL_MUL and BOUNDED_MUL. *) +let CONVERGES_IN_PROB_MUL = prove + (`!p:A prob_space X Y LX LY. + (!n. random_variable p (X n)) /\ random_variable p LX /\ + (!n. random_variable p (Y n)) /\ random_variable p LY /\ + converges_in_prob p X LX /\ converges_in_prob p Y LY + ==> converges_in_prob p (\n x. X n x * Y n x) (\x. LX x * LY x)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `converges_in_prob p + (\n x:A. ((X:num->A->real) n x - LX x) * ((Y:num->A->real) n x - LY x)) + (\x. &0) /\ + converges_in_prob p + (\n x:A. ((Y:num->A->real) n x - LY x) * LX x) (\x. &0) /\ + converges_in_prob p + (\n x:A. ((X:num->A->real) n x - LX x) * LY x) (\x. &0)` + STRIP_ASSUME_TAC THENL + [REPEAT CONJ_TAC THENL + [MP_TAC(BETA_RULE(ISPECL [`p:A prob_space`; + `\n x:A. (X:num->A->real) n x - LX x`; + `\n x:A. (Y:num->A->real) n x - LY x`] CONVERGES_IN_PROB_NULL_MUL)) THEN + DISCH_THEN MATCH_MP_TAC THEN REPEAT CONJ_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC RANDOM_VARIABLE_SUB THEN ASM_REWRITE_TAC[ETA_AX]; + GEN_TAC THEN MATCH_MP_TAC RANDOM_VARIABLE_SUB THEN ASM_REWRITE_TAC[ETA_AX]; + ASM_REWRITE_TAC[GSYM CONVERGES_IN_PROB_DIFF_ZERO]; + ASM_REWRITE_TAC[GSYM CONVERGES_IN_PROB_DIFF_ZERO]]; + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + MATCH_MP_TAC CONVERGES_IN_PROB_BOUNDED_MUL THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC RANDOM_VARIABLE_SUB THEN ASM_REWRITE_TAC[ETA_AX]; + ASM_REWRITE_TAC[GSYM CONVERGES_IN_PROB_DIFF_ZERO]]; + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + MATCH_MP_TAC CONVERGES_IN_PROB_BOUNDED_MUL THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC RANDOM_VARIABLE_SUB THEN ASM_REWRITE_TAC[ETA_AX]; + ASM_REWRITE_TAC[GSYM CONVERGES_IN_PROB_DIFF_ZERO]]]; + ALL_TAC] THEN + SUBGOAL_THEN + `(!n. random_variable p + (\x:A. ((X:num->A->real) n x - LX x) * ((Y:num->A->real) n x - LY x))) /\ + (!n. random_variable p (\x:A. ((Y:num->A->real) n x - LY x) * LX x)) /\ + (!n. random_variable p (\x:A. ((X:num->A->real) n x - LX x) * LY x))` + STRIP_ASSUME_TAC THENL + [REWRITE_TAC[FORALL_AND_THM] THEN REPEAT CONJ_TAC THEN GEN_TAC THENL + [MATCH_MP_TAC RANDOM_VARIABLE_MUL THEN CONJ_TAC THEN + MATCH_MP_TAC RANDOM_VARIABLE_SUB THEN ASM_REWRITE_TAC[ETA_AX]; + MATCH_MP_TAC RANDOM_VARIABLE_MUL THEN ASM_REWRITE_TAC[ETA_AX] THEN + MATCH_MP_TAC RANDOM_VARIABLE_SUB THEN ASM_REWRITE_TAC[ETA_AX]; + MATCH_MP_TAC RANDOM_VARIABLE_MUL THEN ASM_REWRITE_TAC[ETA_AX] THEN + MATCH_MP_TAC RANDOM_VARIABLE_SUB THEN ASM_REWRITE_TAC[ETA_AX]]; + ALL_TAC] THEN + GEN_REWRITE_TAC I [CONVERGES_IN_PROB_DIFF_ZERO] THEN REWRITE_TAC[] THEN + SUBGOAL_THEN + `(\n x:A. (X:num->A->real) n x * (Y:num->A->real) n x - LX x * LY x) = + (\n x. ((X n x - LX x) * (Y n x - LY x)) + + (((Y n x - LY x) * LX x) + ((X n x - LX x) * LY x)))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN REPEAT GEN_TAC THEN REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC CONVERGES_IN_PROB_NULL_ADD THEN ASM_REWRITE_TAC[] THEN + REPEAT CONJ_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC RANDOM_VARIABLE_ADD THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC CONVERGES_IN_PROB_NULL_ADD THEN ASM_REWRITE_TAC[]]);; + +(* A continuous function of a sequence converging in probability also *) +(* converges in probability (continuous mapping theorem for convergence in *) +(* probability). Given e and eta, tightness of L fixes M so the limit lies in *) +(* a bounded interval with high probability; uniform continuity of g on that *) +(* interval supplies a modulus d; then the bad event for g(Xn) lies in the *) +(* union of the bad events for L being large and for Xn being far from L. *) +let CONVERGES_IN_PROB_CONTINUOUS_COMPOSE = prove + (`!p:A prob_space X L g. + (!n. random_variable p (X n)) /\ random_variable p L /\ + g real_continuous_on (:real) /\ + converges_in_prob p X L + ==> converges_in_prob p (\n x. g(X n x)) (\x. g(L x))`, + REPEAT STRIP_TAC THEN REWRITE_TAC[converges_in_prob] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN X_GEN_TAC `eta:real` THEN DISCH_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `L:A->real`] PROB_ABS_GE_TENDS_TO_ZERO) THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + DISCH_THEN(MP_TAC o SPEC `eta / &2`) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `M:num` (MP_TAC o SPEC `M:num`)) THEN + REWRITE_TAC[LE_REFL; REAL_SUB_RZERO] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`g:real->real`; `real_interval[--(&M + &2), &M + &2]`] + REAL_COMPACT_UNIFORMLY_CONTINUOUS) THEN + ASM_SIMP_TAC[REAL_COMPACT_INTERVAL] THEN + REWRITE_TAC[real_uniformly_continuous_on; IN_REAL_INTERVAL] THEN + ANTS_TAC THENL + [MATCH_MP_TAC REAL_CONTINUOUS_ON_SUBSET THEN EXISTS_TAC `(:real)` THEN + ASM_REWRITE_TAC[SUBSET_UNIV]; + ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `d0:real` STRIP_ASSUME_TAC) THEN + ABBREV_TAC `d = min d0 (&1)` THEN + SUBGOAL_THEN `&0 < d /\ d <= d0 /\ d <= &1` STRIP_ASSUME_TAC THENL + [EXPAND_TAC "d" THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + UNDISCH_TAC `converges_in_prob (p:A prob_space) X L` THEN + REWRITE_TAC[converges_in_prob] THEN + DISCH_THEN(MP_TAC o SPEC `d:real`) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + DISCH_THEN(MP_TAC o SPEC `eta / &2`) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` (LABEL_TAC "X")) THEN + EXISTS_TAC `N:num` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + REMOVE_THEN "X" (MP_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN + SUBGOAL_THEN + `prob p {x:A | x IN prob_carrier p /\ abs(g((X:num->A->real) n x) - g((L:A->real) x)) >= e} <= + prob p {x:A | x IN prob_carrier p /\ abs((L:A->real) x) >= &M + &1} + + prob p {x:A | x IN prob_carrier p /\ abs((X:num->A->real) n x - L x) >= d}` + ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `prob (p:A prob_space) + ({x:A | x IN prob_carrier p /\ abs((L:A->real) x) >= &M + &1} UNION + {x:A | x IN prob_carrier p /\ abs((X:num->A->real) n x - L x) >= d})` THEN + CONJ_TAC THENL + [MATCH_MP_TAC PROB_MONO THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC RV_PREIMAGE_GE THEN MATCH_MP_TAC RANDOM_VARIABLE_ABS THEN + MATCH_MP_TAC RANDOM_VARIABLE_SUB THEN CONJ_TAC THEN + MATCH_MP_TAC RANDOM_VARIABLE_CONTINUOUS_MAP_COMPOSE THEN + ASM_REWRITE_TAC[ETA_AX] THEN ASM_MESON_TAC[CONTINUOUS_MAP_EUCLIDEANREAL]; + MATCH_MP_TAC PROB_UNION_IN_EVENTS THEN CONJ_TAC THEN + MATCH_MP_TAC RV_PREIMAGE_GE THEN MATCH_MP_TAC RANDOM_VARIABLE_ABS THENL + [ASM_REWRITE_TAC[ETA_AX]; + MATCH_MP_TAC RANDOM_VARIABLE_SUB THEN ASM_REWRITE_TAC[ETA_AX]]; + REWRITE_TAC[SUBSET; IN_UNION; IN_ELIM_THM] THEN X_GEN_TAC `x:A` THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[TAUT `a \/ b <=> ~(~a /\ ~b)`] THEN + REWRITE_TAC[real_ge; REAL_NOT_LE] THEN STRIP_TAC THEN + UNDISCH_TAC `abs(g((X:num->A->real) n x) - g((L:A->real) x)) >= e` THEN + REWRITE_TAC[real_ge; REAL_NOT_LE] THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`(L:A->real) x`; `(X:num->A->real) n x`]) THEN + ASM_REAL_ARITH_TAC]; + MATCH_MP_TAC PROB_SUBADDITIVE THEN CONJ_TAC THEN + MATCH_MP_TAC RV_PREIMAGE_GE THEN MATCH_MP_TAC RANDOM_VARIABLE_ABS THENL + [ASM_REWRITE_TAC[ETA_AX]; + MATCH_MP_TAC RANDOM_VARIABLE_SUB THEN ASM_REWRITE_TAC[ETA_AX]]]; + ALL_TAC] THEN + SUBGOAL_THEN + `&0 <= prob p {x:A | x IN prob_carrier p /\ abs(g((X:num->A->real) n x) - g((L:A->real) x)) >= e} /\ + &0 <= prob p {x:A | x IN prob_carrier p /\ abs((X:num->A->real) n x - L x) >= d}` + STRIP_ASSUME_TAC THENL + [CONJ_TAC THEN MATCH_MP_TAC PROB_POSITIVE THEN MATCH_MP_TAC RV_PREIMAGE_GE THEN + MATCH_MP_TAC RANDOM_VARIABLE_ABS THENL + [MATCH_MP_TAC RANDOM_VARIABLE_SUB THEN CONJ_TAC THEN + MATCH_MP_TAC RANDOM_VARIABLE_CONTINUOUS_MAP_COMPOSE THEN + ASM_REWRITE_TAC[ETA_AX] THEN ASM_MESON_TAC[CONTINUOUS_MAP_EUCLIDEANREAL]; + MATCH_MP_TAC RANDOM_VARIABLE_SUB THEN ASM_REWRITE_TAC[ETA_AX]]; + ALL_TAC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[REAL_SUB_RZERO]) THEN + FIRST_ASSUM(MP_TAC o MATCH_MP (REAL_ARITH + `q <= a + b + ==> &0 <= q /\ &0 <= b /\ abs a < eta / &2 /\ abs b < eta / &2 + ==> abs q < eta`)) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[]);; + +(* ------------------------------------------------------------------------- *) +(* Two building blocks toward the Riesz subsequence theorem (convergence in *) +(* probability implies almost-sure convergence along a subsequence). *) +(* ------------------------------------------------------------------------- *) + +(* Adaptive selection of a strictly increasing subsequence: if for every step *) +(* index k and every position m there is a later index n realising property *) +(* Q k n, then a strictly increasing r realises Q k (r (SUC k)) at every step. *) +let ADAPTIVE_SELECTOR_DEP = prove + (`!(Q:num->num->bool). (!k m. ?n. m < n /\ Q k n) + ==> ?r:num->num. (!k. r k < r (SUC k)) /\ (!k. Q k (r(SUC k)))`, + REPEAT STRIP_TAC THEN + (MP_TAC o prove_recursive_functions_exist num_RECURSION) + `(rr 0 = 0) /\ (!k. rr(SUC k) = @n. rr k < n /\ (Q:num->num->bool) k n)` THEN + DISCH_THEN(X_CHOOSE_THEN `rr:num->num` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN + `!k:num. (rr:num->num) k < (@n. rr k < n /\ Q k n) /\ Q k (@n. rr k < n /\ Q k n)` + ASSUME_TAC THENL + [GEN_TAC THEN CONV_TAC SELECT_CONV THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + EXISTS_TAC `rr:num->num` THEN CONJ_TAC THEN GEN_TAC THEN + ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `k:num`) THEN STRIP_TAC THEN ASM_REWRITE_TAC[]);; + +(* Off the limit-superior of the dyadic exceedance events, the selected *) +(* subsequence converges pointwise: if x lies in only finitely many of the *) +(* sets where the SUC-shifted term differs from L by at least 2 to the minus k, *) +(* then X (r k) x tends to L x. *) +let OFF_LIMSUP_CONVERGES = prove + (`!(X:num->A->real) L (r:num->num) x B (p:A prob_space). + (!k. B k = {y:A | y IN prob_carrier p /\ + abs(X (r(SUC k)) y - L y) >= inv(&2 pow k)}) /\ + x IN prob_carrier p /\ ~(x IN limsup_events B) + ==> ((\k. X (r k) x) ---> L x) sequentially`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o REWRITE_RULE[LIMSUP_EVENTS_ALT; IN_ELIM_THM]) THEN + REWRITE_TAC[NOT_FORALL_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `m:num` MP_TAC) THEN + REWRITE_TAC[NOT_EXISTS_THM] THEN DISCH_TAC THEN + SUBGOAL_THEN `!n:num. n >= m ==> abs((X:num->A->real) (r(SUC n)) x - L x) < inv(&2 pow n)` + ASSUME_TAC THENL + [GEN_TAC THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[] THEN + FIRST_ASSUM(fun th -> REWRITE_TAC[th]) THEN + REWRITE_TAC[IN_ELIM_THM; DE_MORGAN_THM] THEN + ASM_REWRITE_TAC[real_ge; REAL_NOT_LE]; + ALL_TAC] THEN + REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(ISPECL [`inv(&2)`; `e:real`] REAL_ARCH_POW_INV) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `j:num` ASSUME_TAC) THEN + EXISTS_TAC `m + j + 1` THEN X_GEN_TAC `k:num` THEN DISCH_TAC THEN BETA_TAC THEN + SUBGOAL_THEN `k = SUC(k - 1)` SUBST1_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `inv(&2 pow (k - 1))` THEN + CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `k - 1`) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN REWRITE_TAC[]; + REWRITE_TAC[GSYM REAL_POW_INV] THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `inv(&2) pow j` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_POW_MONO_INV THEN + REPEAT CONJ_TAC THENL + [CONV_TAC REAL_RAT_REDUCE_CONV; CONV_TAC REAL_RAT_REDUCE_CONV; ASM_ARITH_TAC]; + ASM_SIMP_TAC[REAL_LT_IMP_LE]]]);; + +(* ========================================================================= *) +(* Abel summation by parts and Kronecker's lemma *) +(* ========================================================================= *) + +let ABEL_SUMMATION_IDENTITY = prove + (`!b c n. + sum (0..SUC n) (\k. b k * c k) = + b (SUC n) * sum (0..SUC n) c - + sum (0..n) (\k. sum (0..k) c * (b (SUC k) - b k))`, + GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THENL + [REWRITE_TAC[SUM_CLAUSES_NUMSEG; ARITH_RULE `0 <= 0`; + ARITH_RULE `0 <= SUC 0`] THEN + REWRITE_TAC[SUM_SING_NUMSEG] THEN + REAL_ARITH_TAC; + ONCE_REWRITE_TAC[SUM_CLAUSES_NUMSEG] THEN + REWRITE_TAC[LE_0] THEN + FIRST_X_ASSUM SUBST1_TAC THEN + REAL_ARITH_TAC]);; + +let REAL_ABS_TRIANGLE_SUB = REAL_ARITH `!x y. abs(x - y) <= abs x + abs y`;; + +let KRONECKER_LEMMA = prove + (`!a b. + (!n. &0 < b(n)) /\ + (!n. b(n) <= b(n + 1)) /\ + (!M. ?N. !n. N <= n ==> M <= b(n)) /\ + real_summable (from 0) (\k. a(k) / b(k)) + ==> ((\n. inv(b(n)) * sum(0..n) a) ---> &0) sequentially`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + ABBREV_TAC `c = \k:num. (a(k):real) / b(k)` THEN + ABBREV_TAC `S = real_infsum (from 0) (c:num->real)` THEN + SUBGOAL_THEN `((\n. sum(0..n) (c:num->real)) ---> S) sequentially` + ASSUME_TAC THENL + [UNDISCH_TAC `real_summable (from 0) (c:num->real)` THEN + UNDISCH_TAC `real_infsum (from 0) (c:num->real) = S` THEN + REWRITE_TAC[real_summable; real_sums; FROM_0; INTER_UNIV; + real_infsum] THEN + MESON_TAC[SELECT_AX]; ALL_TAC] THEN FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REALLIM_SEQUENTIALLY]) THEN DISCH_THEN(MP_TAC o SPEC `e / &3`) THEN @@ -14576,7 +15696,7 @@ let SLLN_GAP_CONTROL = prove MATCH_MP_TAC PROB_FINITE_UNION_IN_EVENTS THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN X_GEN_TAC `nn:num` THEN STRIP_TAC THEN - MATCH_MP_TAC RANDOM_VARIABLE_GE THEN + MATCH_MP_TAC RV_PREIMAGE_GE THEN MATCH_MP_TAC RANDOM_VARIABLE_ABS THEN (* sum(k*k+1..nn)(X_i - mu) = sum(0..nn)(X_i - mu) - sum(0..k*k)(X_i - mu) *) SUBGOAL_THEN `(\x:A. sum(k * k + 1..nn) (\i. (X:num->A->real) i x - mu)) = @@ -14611,7 +15731,7 @@ let SLLN_GAP_CONTROL = prove SUBGOAL_THEN `!k j. (A:num->num->A->bool) k j IN prob_events p` (LABEL_TAC "Aev") THENL [REPEAT GEN_TAC THEN EXPAND_TAC "A" THEN - MATCH_MP_TAC RANDOM_VARIABLE_GE THEN + MATCH_MP_TAC RV_PREIMAGE_GE THEN MATCH_MP_TAC RANDOM_VARIABLE_ABS THEN MP_TAC(BETA_RULE(ISPECL [`p:A prob_space`; `\(i:num) (x:A). (X:num->A->real) (k * k + 1 + i) x - mu`; @@ -15104,7 +16224,7 @@ let SLLN_SUBSEQ_BOUNDED = prove SUBGOAL_THEN `integrable (p:A prob_space) (\x:A. (sum(0..k * k) (\i. (X:num->A->real) i x)) pow 2)` ASSUME_TAC THENL [MATCH_MP_TAC INTEGRABLE_SUM_SQUARE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN CONJ_TAC THENL - [MATCH_MP_TAC PROB_POSITIVE THEN MATCH_MP_TAC RANDOM_VARIABLE_GE THEN + [MATCH_MP_TAC PROB_POSITIVE THEN MATCH_MP_TAC RV_PREIMAGE_GE THEN MATCH_MP_TAC RANDOM_VARIABLE_ABS THEN MATCH_MP_TAC RANDOM_VARIABLE_CMUL THEN ASM_MESON_TAC[integrable]; ALL_TAC] THEN ABBREV_TAC `nn = SUC(k * k)` THEN @@ -15239,7 +16359,7 @@ let SLLN_GAP_CONTROL_BOUNDED = prove MATCH_MP_TAC PROB_FINITE_UNION_IN_EVENTS THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN X_GEN_TAC `nn:num` THEN STRIP_TAC THEN - MATCH_MP_TAC RANDOM_VARIABLE_GE THEN + MATCH_MP_TAC RV_PREIMAGE_GE THEN MATCH_MP_TAC RANDOM_VARIABLE_ABS THEN SUBGOAL_THEN `(\x:A. sum(k * k + 1..nn) (\i. (X:num->A->real) i x)) = (\x. sum(0..nn) (\i. X i x) - sum(0..k * k) (\i. X i x))` @@ -15267,7 +16387,7 @@ let SLLN_GAP_CONTROL_BOUNDED = prove SUBGOAL_THEN `!k j. (A:num->num->A->bool) k j IN prob_events p` (LABEL_TAC "Aev") THENL [REPEAT GEN_TAC THEN EXPAND_TAC "A" THEN - MATCH_MP_TAC RANDOM_VARIABLE_GE THEN + MATCH_MP_TAC RV_PREIMAGE_GE THEN MATCH_MP_TAC RANDOM_VARIABLE_ABS THEN MP_TAC(BETA_RULE(ISPECL [`p:A prob_space`; `\(i:num) (x:A). (X:num->A->real) (k * k + 1 + i) x`; @@ -15960,7 +17080,7 @@ let SLLN_SUBSEQ_DYADIC = prove MATCH_MP_TAC INTEGRABLE_CMUL THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN CONJ_TAC THENL [(* prob >= 0 *) - MATCH_MP_TAC PROB_POSITIVE THEN MATCH_MP_TAC RANDOM_VARIABLE_GE THEN + MATCH_MP_TAC PROB_POSITIVE THEN MATCH_MP_TAC RV_PREIMAGE_GE THEN MATCH_MP_TAC RANDOM_VARIABLE_ABS THEN MATCH_MP_TAC RANDOM_VARIABLE_CMUL THEN MP_TAC(ISPECL [`p:A prob_space`; `X:num->A->real`; `nn - 1`] INTEGRABLE_SUM) THEN @@ -16037,7 +17157,7 @@ let FIRST_CROSSING_EVENTS_MEASURABLE = prove [ASM_MESON_TAC[]; ASM_MESON_TAC[LT]]]; MATCH_MP_TAC PROB_INTER_IN_EVENTS THEN CONJ_TAC THENL [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; - MATCH_MP_TAC RANDOM_VARIABLE_STRICT_LT THEN + MATCH_MP_TAC RV_PREIMAGE_LT THEN MATCH_MP_TAC RANDOM_VARIABLE_ABS THEN MATCH_MP_TAC RANDOM_VARIABLE_SUM THEN REPEAT STRIP_TAC THEN @@ -16059,7 +17179,7 @@ let FIRST_CROSSING_EVENTS_MEASURABLE = prove MATCH_MP_TAC PROB_INTER_IN_EVENTS THEN CONJ_TAC THENL [USE_THEN "Hforall" (MP_TAC o SPEC `k:num`) THEN REWRITE_TAC[LE_REFL]; - MATCH_MP_TAC RANDOM_VARIABLE_GE THEN + MATCH_MP_TAC RV_PREIMAGE_GE THEN MATCH_MP_TAC RANDOM_VARIABLE_ABS THEN MATCH_MP_TAC RANDOM_VARIABLE_SUM THEN REPEAT STRIP_TAC THEN @@ -16110,11 +17230,6 @@ let FIRST_CROSSING_EVENTS_UNION = prove ASM_REWRITE_TAC[DE_MORGAN_THM] THEN REWRITE_TAC[real_ge; REAL_NOT_LE] THEN ASM_ARITH_TAC);; -(* Integrable implies random variable *) -let INTEGRABLE_IMP_RANDOM_VARIABLE = prove - (`!p:A prob_space (f:A->real). integrable p f ==> random_variable p f`, - SIMP_TAC[integrable]);; - (* Helper: integrable f and a measurable ==> integrable (\x. f x * 1_a x) *) let INTEGRABLE_MUL_INDICATOR_FN = prove (`!p f (a:A->bool). integrable p f /\ a IN prob_events p @@ -16638,7 +17753,7 @@ let SLLN_GAP_DYADIC = prove MATCH_MP_TAC PROB_FINITE_UNION_IN_EVENTS THEN CONJ_TAC THENL [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN X_GEN_TAC `nn:num` THEN STRIP_TAC THEN - MATCH_MP_TAC RANDOM_VARIABLE_GE THEN + MATCH_MP_TAC RV_PREIMAGE_GE THEN MATCH_MP_TAC RANDOM_VARIABLE_ABS THEN SUBGOAL_THEN `1 <= 2 EXP j` ASSUME_TAC THENL [REWRITE_TAC[ARITH_RULE `1 <= n <=> 0 < n`; EXP_LT_0] THEN @@ -17169,7 +18284,7 @@ let TAIL_PROB_SUM_LE_EXPECTATION = prove SUBGOAL_THEN `!k. {x:A | x IN prob_carrier p /\ X x >= &(k + 1)} IN prob_events p` ASSUME_TAC THENL - [GEN_TAC THEN MATCH_MP_TAC RANDOM_VARIABLE_GE THEN ASM_REWRITE_TAC[]; + [GEN_TAC THEN MATCH_MP_TAC RV_PREIMAGE_GE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN `!k. prob p {x:A | x IN prob_carrier p /\ X x >= &(k + 1)} = @@ -17204,9 +18319,138 @@ let TAIL_PROB_SUMMABLE = prove EXISTS_TAC `expectation p (X:A->real)` THEN ASM_SIMP_TAC[TAIL_PROB_SUM_LE_EXPECTATION] THEN GEN_TAC THEN MATCH_MP_TAC PROB_POSITIVE THEN - MATCH_MP_TAC RANDOM_VARIABLE_GE THEN + MATCH_MP_TAC RV_PREIMAGE_GE THEN ASM_MESON_TAC[integrable]);; +(* ------------------------------------------------------------------------- *) +(* Discrete layer-cake (tail-sum) formula: for a nonnegative integer-valued *) +(* integrable random variable, the partial sums of the tail probabilities *) +(* P(X >= k+1) converge to the expectation E[X]. *) +(* ------------------------------------------------------------------------- *) + +(* Pointwise identity: for a natural number m and n at least m-1, the finite *) +(* sum of dyadic-step indicators recovers m exactly. *) +let SUM_INDICATOR_EQ_NAT = prove + (`!m n:num. m <= n + 1 + ==> sum(0..n) (\k. if &m >= &(k + 1) then &1 else &0) = &m`, + GEN_TAC THEN INDUCT_TAC THENL + [REWRITE_TAC[SUM_SING_NUMSEG; ADD_CLAUSES; ARITH_RULE `m <= 1 <=> m = 0 \/ m = 1`] THEN + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN CONV_TAC REAL_RAT_REDUCE_CONV; + REWRITE_TAC[SUM_CLAUSES_NUMSEG; LE_0] THEN DISCH_TAC THEN + ASM_CASES_TAC `m <= n + 1` THENL + [ASM_SIMP_TAC[] THEN + SUBGOAL_THEN `~(&m >= &(SUC n + 1))` ASSUME_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_GE; GE] THEN ASM_ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[REAL_ADD_RID]; + SUBGOAL_THEN `m = SUC n + 1` ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `sum(0..n) (\k. if &m >= &(k + 1) then &1 else &0) = &(n + 1)` + SUBST1_TAC THENL + [SUBGOAL_THEN + `sum(0..n) (\k. if &m >= &(k + 1) then &1 else &0) = sum(0..n) (\k:num. &1)` + SUBST1_TAC THENL + [MATCH_MP_TAC SUM_EQ_NUMSEG THEN REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THEN + POP_ASSUM MP_TAC THEN REWRITE_TAC[REAL_OF_NUM_GE; GE] THEN ASM_ARITH_TAC; + REWRITE_TAC[SUM_CONST_NUMSEG; SUB_0; REAL_MUL_RID]]; + SUBGOAL_THEN `&m >= &(SUC n + 1)` ASSUME_TAC THENL + [ASM_REWRITE_TAC[REAL_OF_NUM_GE; GE; LE_REFL]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_SUC] THEN + UNDISCH_TAC `m = SUC n + 1` THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_SUC; ADD1] THEN + DISCH_THEN(MP_TAC o AP_TERM `real_of_num`) THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_SUC; ADD1] THEN + REAL_ARITH_TAC]]]);; + +(* The partial sum of tail probabilities equals the nonnegative expectation of *) +(* the corresponding finite sum of indicator functions. *) +let TAIL_SUM_EQ_NN_EXPECTATION = prove + (`!p:A prob_space X n. + random_variable p X /\ + (!k. {y:A | y IN prob_carrier p /\ X y >= &(k + 1)} IN prob_events p) + ==> nn_expectation p + (\x. sum(0..n) (\k. indicator_fn {y:A | y IN prob_carrier p /\ X y >= &(k + 1)} x)) = + sum(0..n) (\k. prob p {y:A | y IN prob_carrier p /\ X y >= &(k + 1)})`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `expectation p + (\x:A. sum(0..n) (\k. indicator_fn {y:A | y IN prob_carrier p /\ X y >= &(k + 1)} x)) = + nn_expectation p + (\x:A. sum(0..n) (\k. indicator_fn {y:A | y IN prob_carrier p /\ X y >= &(k + 1)} x))` + (SUBST1_TAC o SYM) THENL + [MATCH_MP_TAC EXPECTATION_NONNEG_EQ_NN THEN CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_SUM THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[ETA_AX] THEN ASM_SIMP_TAC[INTEGRABLE_INDICATOR]; + REPEAT STRIP_TAC THEN BETA_TAC THEN MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[indicator_fn] THEN + COND_CASES_TAC THEN REAL_ARITH_TAC]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`p:A prob_space`; + `\k. indicator_fn {y:A | y IN prob_carrier p /\ (X:A->real) y >= &(k + 1)}`; + `n:num`] EXPECTATION_SUM) THEN + REWRITE_TAC[] THEN + ANTS_TAC THENL + [REPEAT STRIP_TAC THEN ASM_SIMP_TAC[INTEGRABLE_INDICATOR]; ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN + MATCH_MP_TAC EXPECTATION_INDICATOR THEN ASM_SIMP_TAC[]);; + +(* The tail-sum formula, via the monotone convergence theorem: the indicator *) +(* partial sums increase pointwise to X (since X is integer-valued). *) +let EXPECTATION_EQ_TAIL_SUM = prove + (`!p:A prob_space X. + integrable p X /\ + (!x. x IN prob_carrier p ==> &0 <= X x) /\ + (!x. x IN prob_carrier p ==> ?m:num. X x = &m) + ==> ((\n. sum(0..n) (\k. prob p {y | y IN prob_carrier p /\ X y >= &(k + 1)})) + ---> expectation p X) sequentially`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `random_variable (p:A prob_space) X` ASSUME_TAC THENL + [ASM_MESON_TAC[integrable]; ALL_TAC] THEN + SUBGOAL_THEN + `!k. {y:A | y IN prob_carrier p /\ X y >= &(k + 1)} IN prob_events p` + ASSUME_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC RV_PREIMAGE_GE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `!n:num. sum(0..n) (\k. prob p {y:A | y IN prob_carrier p /\ X y >= &(k + 1)}) = + nn_expectation p + (\x. sum(0..n) + (\k. indicator_fn {y:A | y IN prob_carrier p /\ X y >= &(k + 1)} x))` + (fun th -> REWRITE_TAC[th]) THENL + [GEN_TAC THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC TAIL_SUM_EQ_NN_EXPECTATION THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `expectation p (X:A->real) = nn_expectation p X` SUBST1_TAC THENL + [MATCH_MP_TAC EXPECTATION_NONNEG_EQ_NN THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MP_TAC(BETA_RULE(ISPECL + [`p:A prob_space`; + `\n:num. \x:A. sum(0..n) (\k. indicator_fn {y:A | y IN prob_carrier p /\ X y >= &(k+1)} x)`; + `X:A->real`] MCT_NN_EXPECTATION)) THEN + REWRITE_TAC[ETA_AX] THEN DISCH_THEN MATCH_MP_TAC THEN REPEAT CONJ_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC INTEGRABLE_SUM THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[ETA_AX] THEN ASM_SIMP_TAC[INTEGRABLE_INDICATOR]; + REPEAT STRIP_TAC THEN MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN REPEAT STRIP_TAC THEN + REWRITE_TAC[indicator_fn] THEN COND_CASES_TAC THEN REAL_ARITH_TAC; + REPEAT STRIP_TAC THEN REWRITE_TAC[SUM_CLAUSES_NUMSEG; LE_0] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= a ==> s <= s + a`) THEN + REWRITE_TAC[indicator_fn] THEN COND_CASES_TAC THEN REAL_ARITH_TAC; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + FIRST_X_ASSUM(fun th -> MP_TAC(SPEC `x:A` th)) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `m:num`) THEN + REWRITE_TAC[indicator_fn; IN_ELIM_THM] THEN + SUBGOAL_THEN + `!k. (if x IN prob_carrier p /\ (X:A->real) x >= &(k + 1) then &1 else &0) = + (if X x >= &(k + 1) then &1 else &0)` (fun th -> REWRITE_TAC[th]) THENL + [GEN_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC REALLIM_EVENTUALLY THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `m:num` THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC SUM_INDICATOR_EQ_NAT THEN ASM_ARITH_TAC; + EXISTS_TAC `expectation p (X:A->real)` THEN GEN_TAC THEN + ASM_SIMP_TAC[TAIL_SUM_EQ_NN_EXPECTATION] THEN + ASM_MESON_TAC[TAIL_PROB_SUM_LE_EXPECTATION]]);; + (* Telescoping sum for inverse differences *) let SUM_TELESCOPING_INV = prove (`!m n. 1 <= m /\ m <= n + 1 @@ -17981,7 +19225,7 @@ let SLLN_SUBSEQ_GSEQ = prove ASM_REWRITE_TAC[SUM_0; REAL_MUL_RZERO]; ALL_TAC] THEN CONJ_TAC THENL [(* prob >= 0 *) - MATCH_MP_TAC PROB_POSITIVE THEN MATCH_MP_TAC RANDOM_VARIABLE_GE THEN + MATCH_MP_TAC PROB_POSITIVE THEN MATCH_MP_TAC RV_PREIMAGE_GE THEN MATCH_MP_TAC RANDOM_VARIABLE_ABS THEN MATCH_MP_TAC RANDOM_VARIABLE_CMUL THEN MP_TAC(ISPECL [`p:A prob_space`; `X:num->A->real`; `nn - 1`] INTEGRABLE_SUM) THEN diff --git a/Probability/make.ml b/Probability/make.ml index f618bfa4..6db05778 100644 --- a/Probability/make.ml +++ b/Probability/make.ml @@ -31,5 +31,8 @@ loadt "Probability/characteristic_functions.ml";; (* Central Limit Theorem for integrable RVs *) loadt "Probability/clt.ml";; +(* Ergodic theory *) +loadt "Probability/ergodic.ml";; + (* Standard discrete distributions *) loadt "Probability/distributions.ml";; diff --git a/Probability/martingale_convergence.ml b/Probability/martingale_convergence.ml index d9f8140d..7b220f7a 100644 --- a/Probability/martingale_convergence.ml +++ b/Probability/martingale_convergence.ml @@ -1067,7 +1067,7 @@ let SIMPLE_RV_NUM_UPCROSSINGS = prove DISCH_THEN(MP_TAC o SPEC `n:num`) THEN STRIP_TAC THEN ASM_MESON_TAC[filtration; sub_sigma_algebra; SUBSET]; MP_TAC(SPECL [`p:A prob_space`; `(X:num->A->real) (SUC n)`; `b:real`] - RANDOM_VARIABLE_GE) THEN + RV_PREIMAGE_GE) THEN ANTS_TAC THENL [ASM_MESON_TAC[simple_rv]; SIMP_TAC[]]]; ALL_TAC] THEN @@ -1273,7 +1273,7 @@ let SIMPLE_NUM_UPCROSSINGS_GE_EVENT = prove [REPEAT CONJ_TAC THEN ASM_REWRITE_TAC[]; DISCH_THEN(ACCEPT_TAC o SPEC `n:num`)]; ALL_TAC] THEN - MATCH_MP_TAC RANDOM_VARIABLE_GE THEN + MATCH_MP_TAC RV_PREIMAGE_GE THEN ASM_MESON_TAC[simple_rv]);; (* Key MCT lemma: P(U_n >= k) <= (M + |a|) / ((b-a)*k) *) @@ -3067,6 +3067,45 @@ let COND_EXP_AGREES_SIMPLE = prove MATCH_MP_TAC SIMPLE_RV_INDICATOR THEN ASM_REWRITE_TAC[]]);; +(* Take-out property: E[Y*X|G] = Y*E[X|G] when Y is G-measurable *) +let COND_EXP_TAKE_OUT = prove + (`!p:A prob_space G (X:A->real) Y. + sub_sigma_algebra p G /\ FINITE G /\ + integrable p X /\ integrable p (\x. Y x * X x) /\ + measurable_wrt p G Y + ==> !x. x IN prob_carrier p /\ ~(prob p (sigma_atom G x) = &0) + ==> cond_exp p G (\w. Y w * X w) x = Y x * cond_exp p G X x`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + X_GEN_TAC `x:A` THEN STRIP_TAC THEN + REWRITE_TAC[cond_exp] THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `expectation p (\y:A. ((Y:A->real) y * X y) * indicator_fn (sigma_atom G x) y) = + Y x * expectation p (\y. X y * indicator_fn (sigma_atom G x) y)` + SUBST1_TAC THENL + [SUBGOAL_THEN + `(\y:A. ((Y:A->real) y * (X:A->real) y) * indicator_fn (sigma_atom G x) y) = + (\y. (Y:A->real) x * (X y * indicator_fn (sigma_atom G x) y))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `y:A` THEN + REWRITE_TAC[indicator_fn] THEN + COND_CASES_TAC THENL + [SUBGOAL_THEN `(Y:A->real) y = Y x` SUBST1_TAC THENL + [MATCH_MP_TAC MEASURABLE_WRT_CONSTANT_ON_ATOM THEN + ASM_MESON_TAC[]; + REAL_ARITH_TAC]; + REAL_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN `sigma_atom G (x:A) IN prob_events p` ASSUME_TAC THENL + [ASM_MESON_TAC[SIGMA_ATOM_IN_G; sub_sigma_algebra; SUBSET]; ALL_TAC] THEN + MP_TAC(ISPECL [`p:A prob_space`; `(Y:A->real) x`; + `\y:A. (X:A->real) y * indicator_fn (sigma_atom G x) y`] + EXPECTATION_CMUL) THEN + ANTS_TAC THENL + [MATCH_MP_TAC INTEGRABLE_MUL_INDICATOR_FN THEN ASM_REWRITE_TAC[]; + BETA_TAC THEN REWRITE_TAC[REAL_MUL_ASSOC]]; + REWRITE_TAC[real_div; REAL_MUL_ASSOC]]);; + + (* ========================================================================= *) (* DOOB SIMPLE_MARTINGALE *) (* ========================================================================= *) @@ -5922,6 +5961,7 @@ let GEN_COND_EXP_TOWER = prove ALL_TAC] THEN MATCH_MP_TAC GEN_COND_EXP_CONDITIONING THEN ASM_REWRITE_TAC[]);; + (* --- Step 8: Additional gen_cond_exp properties --- *) (* Doob martingale: conditional expectations form a martingale *) @@ -5985,6 +6025,178 @@ let MEASURABLE_WRT_STRICT_LT = prove REWRITE_TAC[SIMPLE_IMAGE] THEN MATCH_MP_TAC COUNTABLE_IMAGE THEN REWRITE_TAC[NUM_COUNTABLE]]);; +(* A level set {X = v} of a G-measurable function is in G. *) +(* Relocated here (from characteristic_functions.ml) so the general take-out *) +(* lemmas below can use it. *) +let MEASURABLE_WRT_LEVEL_SET = prove + (`!p:A prob_space G (X:A->real) v. + sub_sigma_algebra p G /\ measurable_wrt p G X + ==> {x | x IN prob_carrier p /\ X x = v} IN G`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `{x:A | x IN prob_carrier p /\ (X:A->real) x = v} = + {x | x IN prob_carrier p /\ X x <= v} DIFF + {x | x IN prob_carrier p /\ X x < v}` + SUBST1_TAC THENL + [SET_TAC[REAL_ARITH `!x v:real. x = v <=> x <= v /\ ~(x < v)`]; + ALL_TAC] THEN + MATCH_MP_TAC(ISPEC `p:A prob_space` SUB_SIGMA_ALGEBRA_DIFF) THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [ASM_MESON_TAC[measurable_wrt]; + MATCH_MP_TAC MEASURABLE_WRT_STRICT_LT THEN ASM_REWRITE_TAC[]]);; + +(* Simple random variables are bounded on the carrier. Relocated here (from *) +(* clt.ml) so the simple-multiplier take-out below can use it. *) +let SIMPLE_RV_ABS_BOUNDED = prove + (`!p:A prob_space f. simple_rv p f ==> + ?M. !x. x IN prob_carrier p ==> abs(f x) <= M`, + REPEAT GEN_TAC THEN REWRITE_TAC[simple_rv] THEN STRIP_TAC THEN + MP_TAC(ISPEC `p:A prob_space` PROB_CARRIER_NONEMPTY) THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + DISCH_THEN(X_CHOOSE_THEN `z:A` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `FINITE {abs((f:A->real) x) | x IN prob_carrier (p:A prob_space)}` + ASSUME_TAC THENL + [SUBGOAL_THEN `{abs((f:A->real) x) | x IN prob_carrier (p:A prob_space)} = + IMAGE abs {f x | x IN prob_carrier p}` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_IMAGE; IN_ELIM_THM] THEN MESON_TAC[]; + MATCH_MP_TAC FINITE_IMAGE THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN + SUBGOAL_THEN + `~({abs((f:A->real) x) | x IN prob_carrier (p:A prob_space)} = {})` + ASSUME_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + EXISTS_TAC `abs((f:A->real) z)` THEN EXISTS_TAC `z:A` THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + MP_TAC(ISPEC + `{abs((f:A->real) x) | x IN prob_carrier (p:A prob_space)}` SUP_FINITE) THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + EXISTS_TAC + `sup {abs((f:A->real) x) | x IN prob_carrier (p:A prob_space)}` THEN + X_GEN_TAC `w:A` THEN DISCH_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `w:A` THEN ASM_REWRITE_TAC[]);; + +(* A simple RV is its level-set expansion: X x = sum over the (finite) range of *) +(* u * indicator{X = u} x. Used to reduce simple-multiplier take-out to the *) +(* indicator take-out, summed over the range. *) +let SIMPLE_RV_SUM_INDICATOR = prove + (`!p:A prob_space (X:A->real) x. simple_rv p X /\ x IN prob_carrier p + ==> X x = sum (IMAGE X (prob_carrier p)) + (\u. u * indicator_fn {z | z IN prob_carrier p /\ X z = u} x)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `FINITE (IMAGE (X:A->real) (prob_carrier p))` ASSUME_TAC THENL + [REWRITE_TAC[GSYM SIMPLE_IMAGE] THEN ASM_MESON_TAC[simple_rv]; ALL_TAC] THEN + SUBGOAL_THEN `(X:A->real) x IN IMAGE X (prob_carrier p)` ASSUME_TAC THENL + [REWRITE_TAC[IN_IMAGE] THEN EXISTS_TAC `x:A` THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC EQ_TRANS THEN + EXISTS_TAC `sum (IMAGE (X:A->real) (prob_carrier p)) + (\u. if u = X x then X x else &0)` THEN + CONJ_TAC THENL + [CONV_TAC SYM_CONV THEN REWRITE_TAC[SUM_DELTA] THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `u:real` THEN DISCH_TAC THEN + BETA_TAC THEN REWRITE_TAC[indicator_fn; IN_ELIM_THM] THEN + ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `(X:A->real) x = u` THENL + [ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + SUBGOAL_THEN `~(u = (X:A->real) x)` (fun th -> REWRITE_TAC[th]) THENL + [ASM_MESON_TAC[]; ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC]]]);; + +(* Expectation/integrability of a finite SET sum (the library versions are *) +(* numseg-indexed); used for the simple-multiplier take-out below. *) +let INTEGRABLE_SUM_FINITE = prove + (`!p:A prob_space (f:B->A->real) s. + FINITE s /\ (!i. i IN s ==> integrable p (f i)) + ==> integrable p (\x. sum s (\i. f i x))`, + GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN CONJ_TAC THENL + [REWRITE_TAC[SUM_CLAUSES; INTEGRABLE_CONST]; + MAP_EVERY X_GEN_TAC [`a:B`; `t:B->bool`] THEN STRIP_TAC THEN DISCH_TAC THEN + ASM_SIMP_TAC[SUM_CLAUSES] THEN + MP_TAC(ISPECL [`p:A prob_space`; `(f:B->A->real) a`; + `\x:A. sum t (\i. (f:B->A->real) i x)`] INTEGRABLE_ADD) THEN + ASM_SIMP_TAC[IN_INSERT] THEN DISCH_THEN MATCH_MP_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[IN_INSERT]]);; + +let EXPECTATION_SUM_FINITE = prove + (`!p:A prob_space (f:B->A->real) s. + FINITE s /\ (!i. i IN s ==> integrable p (f i)) + ==> expectation p (\x. sum s (\i. f i x)) = + sum s (\i. expectation p (f i))`, + GEN_TAC THEN GEN_TAC THEN REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN CONJ_TAC THENL + [REWRITE_TAC[SUM_CLAUSES; EXPECTATION_CONST]; + MAP_EVERY X_GEN_TAC [`a:B`; `t:B->bool`] THEN STRIP_TAC THEN DISCH_TAC THEN + ASM_SIMP_TAC[SUM_CLAUSES] THEN + SUBGOAL_THEN `integrable p ((f:B->A->real) a)` ASSUME_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_INSERT]; ALL_TAC] THEN + SUBGOAL_THEN `!i. i IN (t:B->bool) ==> integrable p ((f:B->A->real) i)` + ASSUME_TAC THENL [ASM_SIMP_TAC[IN_INSERT]; ALL_TAC] THEN + SUBGOAL_THEN `integrable p (\x:A. sum t (\i. (f:B->A->real) i x))` ASSUME_TAC THENL + [MATCH_MP_TAC INTEGRABLE_SUM_FINITE THEN ASM_SIMP_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL [`p:A prob_space`; `(f:B->A->real) a`; + `\x:A. sum t (\i. (f:B->A->real) i x)`] EXPECTATION_ADD) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN ASM_SIMP_TAC[]]);; + +(* Pointwise level-set expansion of (Y x * Z x) * 1_A' for simple Y. *) +let TO_POINTWISE = prove + (`!p:A prob_space Y Z A' x. + simple_rv p Y /\ x IN prob_carrier p + ==> (Y x * Z x) * indicator_fn A' x = + sum (IMAGE Y (prob_carrier p)) + (\u. u * Z x * indicator_fn + ({z | z IN prob_carrier p /\ Y z = u} INTER A') x)`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[INDICATOR_FN_INTER] THEN + REWRITE_TAC[REAL_RING + `!u zx iy ia:real. u * zx * iy * ia = (u * iy) * (zx * ia)`] THEN + REWRITE_TAC[SUM_RMUL] THEN + MP_TAC(ISPECL [`p:A prob_space`; `Y:A->real`; `x:A`] SIMPLE_RV_SUM_INDICATOR) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN CONV_TAC REAL_RING);; + +(* E[Y*Z*1_A'] decomposed over the level sets of a simple Y. *) +let EXP_SIMPLE_MUL_DECOMP = prove + (`!p:A prob_space Y Z A'. + simple_rv p Y /\ integrable p Z /\ + A' IN prob_events p /\ integrable p (\w. Y w * Z w) + ==> expectation p (\x. (Y x * Z x) * indicator_fn A' x) = + sum (IMAGE Y (prob_carrier p)) + (\u. u * expectation p + (\x. Z x * indicator_fn + ({z | z IN prob_carrier p /\ Y z = u} INTER A') x))`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `FINITE (IMAGE (Y:A->real) (prob_carrier p))` ASSUME_TAC THENL + [ASM_MESON_TAC[simple_rv; SIMPLE_IMAGE]; ALL_TAC] THEN + SUBGOAL_THEN + `!u. {z:A | z IN prob_carrier p /\ (Y:A->real) z = u} INTER A' IN prob_events p` + ASSUME_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC PROB_INTER_IN_EVENTS THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC RANDOM_VARIABLE_LEVEL_SET THEN ASM_MESON_TAC[simple_rv]; ALL_TAC] THEN + SUBGOAL_THEN + `expectation p (\x. ((Y:A->real) x * Z x) * indicator_fn (A':A->bool) x) = + expectation p (\x. sum (IMAGE Y (prob_carrier p)) + (\u. u * (Z x * indicator_fn + ({z | z IN prob_carrier p /\ Y z = u} INTER A') x)))` + SUBST1_TAC THENL + [MATCH_MP_TAC EXPECTATION_EXT THEN X_GEN_TAC `x:A` THEN DISCH_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `Y:A->real`; `Z:A->real`; `A':A->bool`; `x:A`] + TO_POINTWISE) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN SUBST1_TAC THEN MATCH_MP_TAC SUM_EQ THEN + X_GEN_TAC `u:real` THEN DISCH_TAC THEN CONV_TAC REAL_RING; ALL_TAC] THEN + MP_TAC(ISPECL + [`p:A prob_space`; + `\u:real. \x:A. u * (Z x * indicator_fn + ({z | z IN prob_carrier p /\ (Y:A->real) z = u} INTER A') x)`; + `IMAGE (Y:A->real) (prob_carrier p)`] EXPECTATION_SUM_FINITE) THEN + BETA_TAC THEN ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN X_GEN_TAC `u:real` THEN DISCH_TAC THEN + MATCH_MP_TAC INTEGRABLE_CMUL_ALT THEN + MATCH_MP_TAC INTEGRABLE_MUL_INDICATOR_FN THEN ASM_SIMP_TAC[]; + DISCH_THEN SUBST1_TAC] THEN + MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `u:real` THEN DISCH_TAC THEN BETA_TAC THEN + MATCH_MP_TAC EXPECTATION_CMUL THEN + MATCH_MP_TAC INTEGRABLE_MUL_INDICATOR_FN THEN ASM_SIMP_TAC[]);; + (* --- Measurability helpers for general (non-simple) functions --- *) (* Negation preserves G-measurability *) @@ -6356,6 +6568,41 @@ let NONNEG_MEASURABLE_WRT_ZERO_INTEGRALS_AE_ZERO = prove [UNDISCH_TAC `~(j = 0)` THEN ARITH_TAC; MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]]]);; +(* A nonnegative integrable function with zero expectation is zero a.s. *) +(* Specialize NONNEG_MEASURABLE_WRT_ZERO_INTEGRALS_AE_ZERO to the full event *) +(* algebra: for any event A, 0 <= E[f*1_A] <= E[f] = 0. *) +let EXPECTATION_NONNEG_ZERO_AE_ZERO = prove + (`!p:A prob_space f. + integrable p f /\ + (!x. x IN prob_carrier p ==> &0 <= f x) /\ + expectation p f = &0 + ==> almost_surely p {x | f x = &0}`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `prob_events (p:A prob_space)`; `f:A->real`] + NONNEG_MEASURABLE_WRT_ZERO_INTEGRALS_AE_ZERO) THEN + ASM_REWRITE_TAC[SUB_SIGMA_ALGEBRA_SELF] THEN + ANTS_TAC THENL [ALL_TAC; DISCH_THEN ACCEPT_TAC] THEN + CONJ_TAC THENL + [REWRITE_TAC[MEASURABLE_WRT_EVENTS] THEN + MATCH_MP_TAC INTEGRABLE_IMP_RANDOM_VARIABLE THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + X_GEN_TAC `A:A->bool` THEN DISCH_TAC THEN + REWRITE_TAC[GSYM REAL_LE_ANTISYM] THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `expectation (p:A prob_space) f` THEN + CONJ_TAC THENL + [MATCH_MP_TAC EXPECTATION_MONO THEN + ASM_SIMP_TAC[INTEGRABLE_MUL_INDICATOR_FN] THEN + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + REWRITE_TAC[indicator_fn] THEN COND_CASES_TAC THEN + REWRITE_TAC[REAL_MUL_RID; REAL_MUL_RZERO] THEN ASM_SIMP_TAC[REAL_LE_REFL]; + ASM_REWRITE_TAC[REAL_LE_REFL]]; + MATCH_MP_TAC EXPECTATION_POS THEN + ASM_SIMP_TAC[INTEGRABLE_MUL_INDICATOR_FN] THEN + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + REWRITE_TAC[indicator_fn] THEN COND_CASES_TAC THEN + REWRITE_TAC[REAL_MUL_RID; REAL_MUL_RZERO; REAL_LE_REFL] THEN + ASM_SIMP_TAC[]]);; + (* If f, g are G-measurable, integrable, and have equal integrals *) (* against all G-sets, then f = g a.s. *) let GEN_COND_EXP_AE_UNIQUE = prove @@ -6596,6 +6843,27 @@ let GEN_COND_EXP_AE_UNIQUE = prove [UNDISCH_TAC `~(j = 0)` THEN ARITH_TAC; MATCH_MP_TAC REAL_LT_IMP_LE THEN ASM_REWRITE_TAC[]]]]);; +(* Radon-Nikodym uniqueness: if f and g are both R-N derivatives of mu, *) +(* then f = g a.s. Corollary of GEN_COND_EXP_AE_UNIQUE with G = events. *) +let RADON_NIKODYM_UNIQUE = prove + (`!p:A prob_space f g mu. + integrable p f /\ integrable p g /\ + (!A. A IN prob_events p + ==> expectation p (\x. f x * indicator_fn A x) = mu A) /\ + (!A. A IN prob_events p + ==> expectation p (\x. g x * indicator_fn A x) = mu A) + ==> almost_surely p {x | f x = g x}`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC GEN_COND_EXP_AE_UNIQUE THEN + EXISTS_TAC `prob_events(p:A prob_space)` THEN + REWRITE_TAC[SUB_SIGMA_ALGEBRA_SELF] THEN + ASM_REWRITE_TAC[MEASURABLE_WRT_EVENTS] THEN + CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_IMP_RANDOM_VARIABLE THEN ASM_REWRITE_TAC[]; + CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_IMP_RANDOM_VARIABLE THEN ASM_REWRITE_TAC[]; + GEN_TAC THEN DISCH_TAC THEN ASM_SIMP_TAC[]]]);; + (* Step 3: Non-negativity preservation *) let GEN_COND_EXP_NONNEG = prove (`!p:A prob_space G (X:A->real). @@ -6913,6 +7181,55 @@ let GEN_COND_EXP_ADD = prove BINOP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC GEN_COND_EXP_CONDITIONING THEN ASM_REWRITE_TAC[]]);; +(* Step 5b: Subtraction *) +let GEN_COND_EXP_SUB = prove + (`!p:A prob_space G (X:A->real) (Y:A->real). + sub_sigma_algebra p G /\ integrable p X /\ integrable p Y + ==> almost_surely p + {x | gen_cond_exp p G (\w. X w - Y w) x = + gen_cond_exp p G X x - gen_cond_exp p G Y x}`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN + `(\w:A. (X:A->real) w - (Y:A->real) w) = (\w. X w + (-- &1) * Y w)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(SPECL [`p:A prob_space`; `G:(A->bool)->bool`; + `Y:A->real`; `-- &1`] GEN_COND_EXP_CMUL) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + MP_TAC(SPECL [`p:A prob_space`; `G:(A->bool)->bool`; + `X:A->real`; `(\w:A. (-- &1) * (Y:A->real) w)`] + GEN_COND_EXP_ADD) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN MATCH_MP_TAC INTEGRABLE_CMUL THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + CONV_TAC(DEPTH_CONV BETA_CONV) THEN + REWRITE_TAC[almost_surely] THEN + DISCH_THEN(X_CHOOSE_THEN `n1:A->bool` STRIP_ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `n2:A->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `n1 UNION n2:A->bool` THEN CONJ_TAC THENL + [MATCH_MP_TAC NULL_EVENT_UNION THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_UNION] THEN + X_GEN_TAC `w:A` THEN STRIP_TAC THEN + ASM_CASES_TAC + `gen_cond_exp p G (\w:A. -- &1 * (Y:A->real) w) w = + -- &1 * gen_cond_exp p G Y w` THENL + [DISJ1_TAC THEN + UNDISCH_TAC `{x:A | x IN prob_carrier p /\ + ~(x IN {x | gen_cond_exp p G (\w. (X:A->real) w + -- &1 * Y w) x = + gen_cond_exp p G X x + + gen_cond_exp p G (\w. -- &1 * Y w) x})} SUBSET n1` THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `~(gen_cond_exp p G (\w:A. (X:A->real) w + -- &1 * Y w) w = + gen_cond_exp p G X w - gen_cond_exp p G Y w)` THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + DISJ2_TAC THEN + UNDISCH_TAC `{x:A | x IN prob_carrier p /\ + ~(x IN {x | gen_cond_exp p G (\w. -- &1 * (Y:A->real) w) x = + -- &1 * gen_cond_exp p G Y x})} SUBSET n2` THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[]]);; + (* Step 6: Monotonicity *) let GEN_COND_EXP_MONOTONE = prove (`!p:A prob_space G (X:A->real) (Y:A->real). @@ -7092,52 +7409,1043 @@ let GEN_COND_EXP_MONOTONE = prove gen_cond_exp p G (Y:A->real) w` THEN REAL_ARITH_TAC]]);; -(* Step 7: Self-conditioning *) -let GEN_COND_EXP_SELF = prove - (`!p:A prob_space G (X:A->real). - sub_sigma_algebra p G /\ integrable p X /\ measurable_wrt p G X - ==> almost_surely p {x | gen_cond_exp p G X x = X x}`, +(* For a pointwise-increasing sequence of integrable random variables bounded *) +(* by an integrable L, the conditional expectations are, off a single null set, *) +(* increasing in n and bounded by the conditional expectation of L. Combines *) +(* the countably-many almost-sure monotonicity facts from GEN_COND_EXP_MONOTONE *) +(* into one almost-sure statement. (Groundwork for the conditional MCT.) *) +let GEN_COND_EXP_SEQ_MONO_AE = prove + (`!p:A prob_space G X L. + sub_sigma_algebra p G /\ (!n. integrable p (X n)) /\ integrable p L /\ + (!n x. x IN prob_carrier p ==> X n x <= X (SUC n) x) /\ + (!n x. x IN prob_carrier p ==> X n x <= L x) + ==> almost_surely p + {x | (!n. gen_cond_exp p G (X n) x <= gen_cond_exp p G (X (SUC n)) x) /\ + (!n. gen_cond_exp p G (X n) x <= gen_cond_exp p G L x)}`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `!n. almost_surely p + {x:A | gen_cond_exp p G ((X:num->A->real) n) x <= gen_cond_exp p G (X (SUC n)) x /\ + gen_cond_exp p G (X n) x <= gen_cond_exp p G (L:A->real) x}` + ASSUME_TAC THENL + [GEN_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `G:(A->bool)->bool`; `(X:num->A->real) n`; `(X:num->A->real) (SUC n)`] + GEN_COND_EXP_MONOTONE) THEN ASM_SIMP_TAC[] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `G:(A->bool)->bool`; `(X:num->A->real) n`; `L:A->real`] + GEN_COND_EXP_MONOTONE) THEN ASM_SIMP_TAC[] THEN DISCH_TAC THEN + MATCH_MP_TAC ALMOST_SURELY_SUBSET THEN + EXISTS_TAC `{x:A | gen_cond_exp p G ((X:num->A->real) n) x <= gen_cond_exp p G (X (SUC n)) x} INTER + {x:A | gen_cond_exp p G ((X:num->A->real) n) x <= gen_cond_exp p G (L:A->real) x}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC ALMOST_SURELY_INTER THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN MESON_TAC[]]; + ALL_TAC] THEN + MATCH_MP_TAC ALMOST_SURELY_SUBSET THEN + EXISTS_TAC + `INTERS {{x:A | gen_cond_exp p G ((X:num->A->real) n) x <= gen_cond_exp p G (X (SUC n)) x /\ + gen_cond_exp p G (X n) x <= gen_cond_exp p G (L:A->real) x} | n IN (:num)}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC ALMOST_SURELY_COUNTABLE_INTER THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[IN_INTERS; FORALL_IN_GSPEC; IN_UNIV; IN_ELIM_THM] THEN MESON_TAC[]]);; + +(* For a nonnegative increasing sequence Xn converging pointwise to L (all *) +(* integrable), the integral of (L - Xn) over any event A tends to 0. This is *) +(* dominated convergence: (L - Xn) times the indicator is dominated by *) +(* (L - X0) times the indicator and tends to 0 pointwise. (Groundwork for the *) +(* conditional MCT: it controls the integral of the gap E[L|G] - E[Xn|G].) *) +let INTEGRAL_GAP_TENDS_0 = prove + (`!p:A prob_space X L A. + (!n. integrable p (X n)) /\ integrable p L /\ A IN prob_events p /\ + (!n x. x IN prob_carrier p ==> &0 <= X n x) /\ + (!n x. x IN prob_carrier p ==> X n x <= X (SUC n) x) /\ + (!n x. x IN prob_carrier p ==> X n x <= L x) /\ + (!x. x IN prob_carrier p ==> ((\n. X n x) ---> L x) sequentially) + ==> ((\n. expectation p (\x. (L x - X n x) * indicator_fn A x)) ---> &0) + sequentially`, + REPEAT STRIP_TAC THEN + MP_TAC(BETA_RULE(ISPECL [`p:A prob_space`; + `\n:num. \x:A. (L x - (X:num->A->real) n x) * indicator_fn A x`; + `\x:A. &0`; + `\x:A. (L x - (X:num->A->real) 0 x) * indicator_fn A x`] + DOMINATED_CONVERGENCE)) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC INTEGRABLE_MUL_INDICATOR_FN THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC INTEGRABLE_SUB THEN ASM_REWRITE_TAC[ETA_AX]; + MATCH_MP_TAC INTEGRABLE_MUL_INDICATOR_FN THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC INTEGRABLE_SUB THEN ASM_REWRITE_TAC[ETA_AX]; + MAP_EVERY X_GEN_TAC [`n:num`; `x:A`] THEN DISCH_TAC THEN + REWRITE_TAC[indicator_fn] THEN COND_CASES_TAC THEN + REWRITE_TAC[REAL_MUL_RZERO; REAL_MUL_RID; REAL_ABS_NUM; REAL_LE_REFL] THEN + SUBGOAL_THEN `(X:num->A->real) 0 x <= X n x /\ X n x <= L x` MP_TAC THENL + [CONJ_TAC THENL + [SPEC_TAC(`n:num`,`n:num`) THEN INDUCT_TAC THENL + [REWRITE_TAC[REAL_LE_REFL]; + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(X:num->A->real) n x` THEN + ASM_SIMP_TAC[]]; + ASM_SIMP_TAC[]]; + REAL_ARITH_TAC]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + SUBGOAL_THEN `((\n. (L x - (X:num->A->real) n x) * indicator_fn A x) ---> + (L x - L x) * indicator_fn A x) sequentially` MP_TAC THENL + [MATCH_MP_TAC REALLIM_MUL THEN REWRITE_TAC[REALLIM_CONST] THEN + MATCH_MP_TAC REALLIM_SUB THEN REWRITE_TAC[REALLIM_CONST] THEN + ASM_SIMP_TAC[]; + REWRITE_TAC[REAL_SUB_REFL; REAL_MUL_LZERO]]]; + REWRITE_TAC[EXPECTATION_CONST] THEN SIMP_TAC[]]);; + +(* Pointwise limit of G-measurable functions is G-measurable. Mirror of *) +(* RANDOM_VARIABLE_POINTWISE_LIMIT with measurable_wrt/G in place of *) +(* random_variable/prob_events: the level set {Y <= a} is the countable *) +(* combination INTERS_m UNIONS_N INTERS_{n>=N} {Y_seq n < a + inv(SUC m)}, *) +(* and G is a sigma-algebra so it is closed under those countable operations. *) +let MEASURABLE_WRT_REALLIM = prove + (`!p:A prob_space G Y Y_seq. + sub_sigma_algebra p G /\ + (!n. measurable_wrt p G (Y_seq n)) /\ + (!x. x IN prob_carrier p ==> ((\n. Y_seq n x) ---> Y x) sequentially) + ==> measurable_wrt p G Y`, REPEAT GEN_TAC THEN STRIP_TAC THEN - MATCH_MP_TAC GEN_COND_EXP_AE_UNIQUE THEN - EXISTS_TAC `G:(A->bool)->bool` THEN - ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + SUBGOAL_THEN `sigma_algebra (G:(A->bool)->bool)` ASSUME_TAC THENL + [ASM_MESON_TAC[sub_sigma_algebra]; ALL_TAC] THEN + REWRITE_TAC[measurable_wrt] THEN + X_GEN_TAC `a:real` THEN + SUBGOAL_THEN + `{x:A | x IN prob_carrier p /\ Y x <= a} = + INTERS (IMAGE (\m. UNIONS (IMAGE (\N. + INTERS (IMAGE (\n. {x | x IN prob_carrier p /\ + Y_seq n x < a + inv(&(SUC m))}) {n | n >= N})) (:num))) (:num))` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; INTERS_IMAGE; UNIONS_IMAGE; IN_ELIM_THM; IN_UNIV] THEN + X_GEN_TAC `x:A` THEN EQ_TAC THENL + [STRIP_TAC THEN X_GEN_TAC `m:num` THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:A`) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + DISCH_THEN(MP_TAC o SPEC `inv(&(SUC m))`) THEN + REWRITE_TAC[REAL_LT_INV_EQ; REAL_OF_NUM_LT; LT_0] THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` ASSUME_TAC) THEN + EXISTS_TAC `N:num` THEN X_GEN_TAC `nn:num` THEN DISCH_TAC THEN + SUBGOAL_THEN `abs(Y_seq (nn:num) (x:A) - Y x) < inv(&(SUC m))` MP_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN + UNDISCH_TAC `nn >= N:num` THEN ARITH_TAC; ALL_TAC] THEN + ASM_REAL_ARITH_TAC; + DISCH_TAC THEN + SUBGOAL_THEN `(x:A) IN prob_carrier p` ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `0`) THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` ASSUME_TAC) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `N:num`) THEN + REWRITE_TAC[GE; LE_REFL] THEN STRIP_TAC; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN + ABBREV_TAC `eps = (Y (x:A) - a) / &2` THEN + SUBGOAL_THEN `&0 < eps` ASSUME_TAC THENL + [EXPAND_TAC "eps" THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(SPEC `inv(eps:real)` REAL_ARCH_SIMPLE) THEN + DISCH_THEN(X_CHOOSE_TAC `mm:num`) THEN + SUBGOAL_THEN `((\n. Y_seq n (x:A)) ---> Y x) sequentially` MP_TAC THENL + [FIRST_X_ASSUM(MATCH_MP_TAC o SPEC `x:A`) THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + DISCH_THEN(MP_TAC o SPEC `eps:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `N2:num` ASSUME_TAC) THEN + FIRST_X_ASSUM(fun th -> + MP_TAC(SPEC `mm:num` th) THEN + DISCH_THEN(X_CHOOSE_THEN `N1:num` ASSUME_TAC)) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `N1 + N2:num`) THEN + REWRITE_TAC[GE; LE_ADD] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `N1 + N2:num`) THEN + ANTS_TAC THENL [ARITH_TAC; ALL_TAC] THEN DISCH_TAC THEN + SUBGOAL_THEN `inv(&(SUC mm)) <= eps` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(inv(eps:real))` THEN + CONJ_TAC THENL [ + MATCH_MP_TAC REAL_LE_INV2 THEN ASM_SIMP_TAC[REAL_LT_INV_EQ] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&mm` THEN + ASM_REWRITE_TAC[REAL_OF_NUM_LE] THEN ARITH_TAC; + REWRITE_TAC[REAL_INV_INV; REAL_LE_REFL]]; + ASM_REAL_ARITH_TAC]]; + ALL_TAC] THEN + MATCH_MP_TAC SIGMA_ALGEBRA_INTERS_COUNTABLE THEN + REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_UNIV] THEN + X_GEN_TAC `m:num` THEN BETA_TAC THEN + MATCH_MP_TAC SIGMA_ALGEBRA_UNION_COUNTABLE THEN + REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_UNIV] THEN + X_GEN_TAC `N:num` THEN BETA_TAC THEN + MATCH_MP_TAC SIGMA_ALGEBRA_INTERS_COUNTABLE THEN + REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_ELIM_THM] THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN BETA_TAC THEN + MATCH_MP_TAC MEASURABLE_WRT_STRICT_LT THEN + REWRITE_TAC[ETA_AX] THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC COUNTABLE_IMAGE THEN + MATCH_MP_TAC COUNTABLE_SUBSET THEN EXISTS_TAC `(:num)` THEN + REWRITE_TAC[NUM_COUNTABLE; SUBSET_UNIV]; + REWRITE_TAC[IMAGE_EQ_EMPTY] THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + EXISTS_TAC `N:num` THEN REWRITE_TAC[IN_ELIM_THM; GE; LE_REFL]]; + MATCH_MP_TAC COUNTABLE_IMAGE THEN REWRITE_TAC[NUM_COUNTABLE]]; + MATCH_MP_TAC COUNTABLE_IMAGE THEN REWRITE_TAC[NUM_COUNTABLE]; + REWRITE_TAC[IMAGE_EQ_EMPTY] THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_UNIV] THEN + EXISTS_TAC `0` THEN REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Conditional Monotone Convergence Theorem for gen_cond_exp. *) +(* If 0 <= X_n increases to L (all integrable), then E[X_n|G] -> E[L|G] a.s. *) +(* Built in three steps: a pure dominated-convergence helper for a nonneg *) +(* decreasing-to-0 integrable sequence; the heart, that the conditional *) +(* expectations of such a sequence tend to 0 a.s.; and the main wrapper. *) +(* ------------------------------------------------------------------------- *) + +(* For a nonnegative decreasing-to-0 integrable sequence, the integral -> 0. *) +let DECR_INTEGRAL_TENDS_0 = prove + (`!p:A prob_space D. + (!n. integrable p (D n)) /\ + (!n x. x IN prob_carrier p ==> &0 <= D n x) /\ + (!n x. x IN prob_carrier p ==> D (SUC n) x <= D n x) /\ + (!x. x IN prob_carrier p ==> ((\n. D n x) ---> &0) sequentially) + ==> ((\n. expectation p (D n)) ---> &0) sequentially`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `!n x:A. x IN prob_carrier p ==> D n x <= D 0 x` ASSUME_TAC THENL + [INDUCT_TAC THENL + [REWRITE_TAC[REAL_LE_REFL]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(D:num->A->real) n x` THEN + ASM_SIMP_TAC[]]; + ALL_TAC] THEN + MP_TAC(BETA_RULE(ISPECL [`p:A prob_space`; `D:num->A->real`; + `\x:A. &0`; `(D:num->A->real) 0`] DOMINATED_CONVERGENCE)) THEN + REWRITE_TAC[EXPECTATION_CONST] THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC [`n:num`; `x:A`] THEN DISCH_TAC THEN + REWRITE_TAC[real_abs] THEN COND_CASES_TAC THEN ASM_SIMP_TAC[] THEN + ASM_MESON_TAC[REAL_LE_TRANS; REAL_NOT_LE; REAL_LT_IMP_LE]; + SIMP_TAC[]]);; + +(* As DECR_INTEGRAL_TENDS_0 but the pointwise convergence need hold only a.s. *) +let DECR_INTEGRAL_TENDS_0_AE = prove + (`!p:A prob_space D. + (!n. integrable p (D n)) /\ + (!n x. x IN prob_carrier p ==> &0 <= D n x) /\ + (!n x. x IN prob_carrier p ==> D (SUC n) x <= D n x) /\ + almost_surely p {x | ((\n. D n x) ---> &0) sequentially} + ==> ((\n. expectation p (D n)) ---> &0) sequentially`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `!n x:A. x IN prob_carrier p ==> D n x <= D 0 x` ASSUME_TAC THENL + [INDUCT_TAC THENL + [REWRITE_TAC[REAL_LE_REFL]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(D:num->A->real) n x` THEN + ASM_SIMP_TAC[]]; + ALL_TAC] THEN + MP_TAC(BETA_RULE(ISPECL [`p:A prob_space`; `D:num->A->real`; + `\x:A. &0`; `(D:num->A->real) 0`] DOMINATED_CONVERGENCE_AE)) THEN + REWRITE_TAC[EXPECTATION_CONST] THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [MAP_EVERY X_GEN_TAC [`n:num`; `x:A`] THEN DISCH_TAC THEN + REWRITE_TAC[real_abs] THEN COND_CASES_TAC THEN ASM_SIMP_TAC[] THEN + ASM_MESON_TAC[REAL_LE_TRANS; REAL_NOT_LE; REAL_LT_IMP_LE]; + REWRITE_TAC[RANDOM_VARIABLE_CONST]; + REWRITE_TAC[REAL_ABS_NUM] THEN REPEAT STRIP_TAC THEN ASM_SIMP_TAC[]]; + SIMP_TAC[]]);; + +(* Multiplying by the indicator of a co-null set preserves the expectation. *) +let EXPECTATION_MUL_INDICATOR_CONULL = prove + (`!p:A prob_space f S. + integrable p f /\ S IN prob_events p /\ + prob p (prob_carrier p DIFF S) = &0 + ==> expectation p (\x. f x * indicator_fn S x) = expectation p f`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `prob_carrier p DIFF (S:A->bool) IN prob_events p` ASSUME_TAC THENL + [ASM_SIMP_TAC[PROB_COMPL_IN_EVENTS]; ALL_TAC] THEN + MP_TAC(ISPECL [`p:A prob_space`; `f:A->real`; `prob_carrier p DIFF (S:A->bool)`] + EXPECTATION_MUL_INDICATOR_ZERO_PROB) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; + `\x:A. f x * indicator_fn (S:A->bool) x`; + `\x:A. f x * indicator_fn (prob_carrier p DIFF (S:A->bool)) x`] + EXPECTATION_ADD) THEN + ASM_SIMP_TAC[INTEGRABLE_MUL_INDICATOR_FN; REAL_ADD_RID] THEN + SUBGOAL_THEN + `expectation p (\x:A. f x * indicator_fn (S:A->bool) x + + f x * indicator_fn (prob_carrier p DIFF S) x) = + expectation p f` (fun th -> REWRITE_TAC[th]) THENL + [MATCH_MP_TAC EXPECTATION_EXT THEN + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + REWRITE_TAC[indicator_fn; IN_DIFF] THEN ASM_REWRITE_TAC[] THEN + COND_CASES_TAC THEN + REWRITE_TAC[REAL_MUL_RZERO; REAL_MUL_RID; REAL_ADD_RID; REAL_ADD_LID]; + MESON_TAC[]]);; + +(* The heart: for a nonneg decreasing-to-0 integrable sequence D_n, the *) +(* conditional expectations E[D_n|G] tend to 0 almost surely. *) +let GEN_COND_EXP_DECR_TENDS_0 = prove + (`!p:A prob_space G D. + sub_sigma_algebra p G /\ + (!n. integrable p (D n)) /\ + (!n x. x IN prob_carrier p ==> &0 <= D n x) /\ + (!n x. x IN prob_carrier p ==> D (SUC n) x <= D n x) /\ + almost_surely p {x | ((\n. D n x) ---> &0) sequentially} + ==> almost_surely p + {x | ((\n. gen_cond_exp p G (D n) x) ---> &0) sequentially}`, + REPEAT STRIP_TAC THEN + ABBREV_TAC `g = \n:num. \x:A. gen_cond_exp p G ((D:num->A->real) n) x` THEN + SUBGOAL_THEN `!n:num. integrable p ((g:num->A->real) n)` ASSUME_TAC THENL + [EXPAND_TAC "g" THEN GEN_TAC THEN REWRITE_TAC[ETA_AX] THEN + MATCH_MP_TAC GEN_COND_EXP_INTEGRABLE THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `almost_surely p + {x:A | (!n. &0 <= (g:num->A->real) n x) /\ + (!n. g (SUC n) x <= g n x)}` + ASSUME_TAC THENL + [MATCH_MP_TAC ALMOST_SURELY_SUBSET THEN + EXISTS_TAC + `INTERS {{x:A | &0 <= (g:num->A->real) n x /\ g (SUC n) x <= g n x} | + n IN (:num)}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC ALMOST_SURELY_COUNTABLE_INTER THEN X_GEN_TAC `n:num` THEN + MATCH_MP_TAC ALMOST_SURELY_SUBSET THEN + EXISTS_TAC + `{x:A | &0 <= (g:num->A->real) n x} INTER {x:A | g (SUC n) x <= g n x}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC ALMOST_SURELY_INTER THEN CONJ_TAC THENL + [EXPAND_TAC "g" THEN MATCH_MP_TAC GEN_COND_EXP_NONNEG THEN ASM_SIMP_TAC[]; + EXPAND_TAC "g" THEN MATCH_MP_TAC GEN_COND_EXP_MONOTONE THEN ASM_SIMP_TAC[]]; + REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN MESON_TAC[]]; + REWRITE_TAC[IN_INTERS; FORALL_IN_GSPEC; IN_UNIV; IN_ELIM_THM] THEN + MESON_TAC[]]; + ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o REWRITE_RULE[almost_surely]) THEN + DISCH_THEN(X_CHOOSE_THEN `N0:A->bool` STRIP_ASSUME_TAC) THEN + ABBREV_TAC `good = prob_carrier p DIFF (N0:A->bool)` THEN + SUBGOAL_THEN `(good:A->bool) IN prob_events p` ASSUME_TAC THENL + [EXPAND_TAC "good" THEN MATCH_MP_TAC PROB_DIFF_IN_EVENTS THEN + ASM_REWRITE_TAC[PROB_CARRIER_IN_EVENTS] THEN ASM_MESON_TAC[null_event]; + ALL_TAC] THEN + SUBGOAL_THEN `prob p (prob_carrier p DIFF (good:A->bool)) = &0` ASSUME_TAC THENL + [SUBGOAL_THEN `prob_carrier p DIFF (good:A->bool) = N0` SUBST1_TAC THENL + [EXPAND_TAC "good" THEN + SUBGOAL_THEN `(N0:A->bool) SUBSET prob_carrier p` MP_TAC THENL + [ASM_MESON_TAC[null_event; SIGMA_ALGEBRA_SUBSET; prob_carrier; + PROB_SPACE_SIGMA_ALGEBRA]; ALL_TAC] THEN + SET_TAC[]; + ASM_MESON_TAC[null_event]]; + ALL_TAC] THEN + ABBREV_TAC `gc = \n:num. \x:A. (g:num->A->real) n x * indicator_fn good x` THEN + SUBGOAL_THEN `!n:num. integrable p ((gc:num->A->real) n)` ASSUME_TAC THENL + [EXPAND_TAC "gc" THEN GEN_TAC THEN + MATCH_MP_TAC INTEGRABLE_MUL_INDICATOR_FN THEN ASM_REWRITE_TAC[ETA_AX]; + ALL_TAC] THEN + SUBGOAL_THEN + `!x:A. x IN good + ==> (!n. &0 <= (g:num->A->real) n x) /\ (!n. g (SUC n) x <= g n x)` + ASSUME_TAC THENL + [X_GEN_TAC `x:A` THEN EXPAND_TAC "good" THEN REWRITE_TAC[IN_DIFF] THEN + STRIP_TAC THEN + UNDISCH_TAC `{x:A | x IN prob_carrier p /\ + ~(x IN {x | (!n. &0 <= (g:num->A->real) n x) /\ + (!n. g (SUC n) x <= g n x)})} SUBSET N0` THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN + DISCH_THEN(MP_TAC o SPEC `x:A`) THEN ASM_REWRITE_TAC[] THEN MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `!n x:A. x IN prob_carrier p ==> &0 <= (gc:num->A->real) n x` + ASSUME_TAC THENL + [MAP_EVERY X_GEN_TAC [`n:num`; `x:A`] THEN DISCH_TAC THEN + EXPAND_TAC "gc" THEN REWRITE_TAC[indicator_fn] THEN + COND_CASES_TAC THEN + REWRITE_TAC[REAL_MUL_RZERO; REAL_MUL_RID; REAL_LE_REFL] THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `!n x:A. x IN prob_carrier p ==> (gc:num->A->real) (SUC n) x <= gc n x` + ASSUME_TAC THENL + [MAP_EVERY X_GEN_TAC [`n:num`; `x:A`] THEN DISCH_TAC THEN + EXPAND_TAC "gc" THEN REWRITE_TAC[indicator_fn] THEN + COND_CASES_TAC THEN + REWRITE_TAC[REAL_MUL_RZERO; REAL_MUL_RID; REAL_LE_REFL] THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `!n x:A. x IN prob_carrier p ==> (gc:num->A->real) n x <= gc 0 x` + ASSUME_TAC THENL + [INDUCT_TAC THENL + [REWRITE_TAC[REAL_LE_REFL]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(gc:num->A->real) n x` THEN + ASM_SIMP_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN + `!x:A. x IN prob_carrier p + ==> ?l. ((\n. (gc:num->A->real) n x) ---> l) sequentially` + ASSUME_TAC THENL + [X_GEN_TAC `x:A` THEN DISCH_TAC THEN + MATCH_MP_TAC CONVERGENT_REAL_BOUNDED_MONOTONE THEN + CONJ_TAC THENL + [REWRITE_TAC[REAL_BOUNDED_POS] THEN + EXISTS_TAC `abs((gc:num->A->real) 0 x) + &1` THEN + CONJ_TAC THENL + [REAL_ARITH_TAC; + REWRITE_TAC[FORALL_IN_IMAGE; IN_UNIV] THEN X_GEN_TAC `m:num` THEN + SUBGOAL_THEN `&0 <= (gc:num->A->real) m x /\ gc m x <= gc 0 x` + (fun th -> MP_TAC th THEN REAL_ARITH_TAC) THEN + ASM_SIMP_TAC[]]; + DISJ2_TAC THEN GEN_TAC THEN ASM_SIMP_TAC[]]; + ALL_TAC] THEN + ABBREV_TAC `W = \x:A. reallim sequentially (\n. (gc:num->A->real) n x)` THEN + SUBGOAL_THEN + `!x:A. x IN prob_carrier p + ==> ((\n. (gc:num->A->real) n x) ---> (W:A->real) x) sequentially` + ASSUME_TAC THENL + [X_GEN_TAC `x:A` THEN DISCH_TAC THEN EXPAND_TAC "W" THEN BETA_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:A`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(fun th -> MP_TAC(SELECT_RULE th)) THEN + REWRITE_TAC[GSYM reallim]; + ALL_TAC] THEN + SUBGOAL_THEN `random_variable p (W:A->real)` ASSUME_TAC THENL + [MATCH_MP_TAC RANDOM_VARIABLE_POINTWISE_LIMIT THEN + EXISTS_TAC `gc:num->A->real` THEN ASM_REWRITE_TAC[] THEN + GEN_TAC THEN MATCH_MP_TAC INTEGRABLE_IMP_RANDOM_VARIABLE THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `!x:A. x IN prob_carrier p ==> &0 <= (W:A->real) x` ASSUME_TAC THENL + [X_GEN_TAC `x:A` THEN DISCH_TAC THEN + MATCH_MP_TAC(ISPECL [`sequentially`; `\n. (gc:num->A->real) n x`; + `(W:A->real) x`; `&0`] REALLIM_LBOUND) THEN + ASM_SIMP_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `0` THEN + ASM_SIMP_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `integrable p (W:A->real)` ASSUME_TAC THENL + [MATCH_MP_TAC INTEGRABLE_POINTWISE_LIMIT_UI THEN + EXISTS_TAC `gc:num->A->real` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC DOMINATED_IMP_UI THEN + EXISTS_TAC `(gc:num->A->real) 0` THEN ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC [`n:num`; `x:A`] THEN DISCH_TAC THEN + SUBGOAL_THEN `&0 <= (gc:num->A->real) n x /\ gc n x <= gc 0 x` + (fun th -> MP_TAC th THEN REAL_ARITH_TAC) THEN + ASM_SIMP_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `expectation p (W:A->real) = &0` ASSUME_TAC THENL [SUBGOAL_THEN - `(\x:A. gen_cond_exp p G (X:A->real) x) = gen_cond_exp p G X` - SUBST1_TAC THENL - [REWRITE_TAC[ETA_AX]; ALL_TAC] THEN - MATCH_MP_TAC GEN_COND_EXP_MEASURABLE_WRT THEN ASM_REWRITE_TAC[]; + `((\n. expectation p ((gc:num->A->real) n)) ---> expectation p (W:A->real)) + sequentially` MP_TAC THENL + [MP_TAC(ISPECL [`p:A prob_space`; `gc:num->A->real`; `W:A->real`; + `(gc:num->A->real) 0`] DOMINATED_CONVERGENCE) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN + MAP_EVERY X_GEN_TAC [`n:num`; `x:A`] THEN DISCH_TAC THEN + SUBGOAL_THEN `&0 <= (gc:num->A->real) n x /\ gc n x <= gc 0 x` + (fun th -> MP_TAC th THEN REAL_ARITH_TAC) THEN ASM_SIMP_TAC[]; + SIMP_TAC[]]; + ALL_TAC] THEN SUBGOAL_THEN - `(\x:A. gen_cond_exp p G (X:A->real) x) = gen_cond_exp p G X` - SUBST1_TAC THENL - [REWRITE_TAC[ETA_AX]; ALL_TAC] THEN - MATCH_MP_TAC GEN_COND_EXP_INTEGRABLE THEN ASM_REWRITE_TAC[]; - GEN_TAC THEN DISCH_TAC THEN - MATCH_MP_TAC GEN_COND_EXP_CONDITIONING THEN ASM_REWRITE_TAC[]]);; - -(* Step 8: Constant conditioning *) -let GEN_COND_EXP_CONST = prove - (`!p:A prob_space G (c:real). - sub_sigma_algebra p G - ==> almost_surely p {x | gen_cond_exp p G (\w. c) x = c}`, - REPEAT GEN_TAC THEN DISCH_TAC THEN - MATCH_MP_TAC GEN_COND_EXP_SELF THEN ASM_REWRITE_TAC[] THEN + `!n. expectation p ((gc:num->A->real) n) = expectation p ((D:num->A->real) n)` + ASSUME_TAC THENL + [GEN_TAC THEN EXPAND_TAC "gc" THEN + SUBGOAL_THEN + `expectation p (\x:A. (g:num->A->real) n x * indicator_fn good x) = + expectation p ((g:num->A->real) n)` SUBST1_TAC THENL + [MATCH_MP_TAC EXPECTATION_MUL_INDICATOR_CONULL THEN ASM_REWRITE_TAC[ETA_AX]; + EXPAND_TAC "g" THEN REWRITE_TAC[ETA_AX] THEN + MATCH_MP_TAC GEN_COND_EXP_TOWER THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MATCH_MP_TAC(ISPECL [`sequentially`; `\n. expectation p ((D:num->A->real) n)`; + `expectation p (W:A->real)`; `&0`] REALLIM_UNIQUE) THEN + ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN + MATCH_MP_TAC DECR_INTEGRAL_TENDS_0_AE THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `almost_surely p {x:A | (W:A->real) x = &0}` ASSUME_TAC THENL + [MATCH_MP_TAC EXPECTATION_NONNEG_ZERO_AE_ZERO THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC ALMOST_SURELY_SUBSET THEN + EXISTS_TAC `good INTER {x:A | (W:A->real) x = &0}` THEN CONJ_TAC THENL + [MATCH_MP_TAC ALMOST_SURELY_INTER THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[almost_surely] THEN EXISTS_TAC `N0:A->bool` THEN + ASM_REWRITE_TAC[] THEN EXPAND_TAC "good" THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_DIFF] THEN MESON_TAC[]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN STRIP_TAC THEN + SUBGOAL_THEN `!n. (gc:num->A->real) n x = gen_cond_exp p G ((D:num->A->real) n) x` + ASSUME_TAC THENL + [GEN_TAC THEN EXPAND_TAC "gc" THEN BETA_TAC THEN + SUBGOAL_THEN `indicator_fn (good:A->bool) x = &1` SUBST1_TAC THENL + [REWRITE_TAC[indicator_fn] THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_MUL_RID] THEN EXPAND_TAC "g" THEN REWRITE_TAC[]]; + ALL_TAC] THEN + UNDISCH_TAC + `!x:A. x IN prob_carrier p + ==> ((\n. (gc:num->A->real) n x) ---> (W:A->real) x) sequentially` THEN + DISCH_THEN(MP_TAC o SPEC `x:A`) THEN ASM_REWRITE_TAC[]]);; + +(* Main result: conditional MCT. If 0 <= X_n increases to L (all integrable) *) +(* then E[X_n|G] -> E[L|G] almost surely. Apply DECR_TENDS_0 to D_n = L-X_n *) +(* and translate back via GEN_COND_EXP_SUB. *) +let GEN_COND_EXP_MCT = prove + (`!p:A prob_space G X L. + sub_sigma_algebra p G /\ + (!n. integrable p (X n)) /\ integrable p L /\ + (!n x. x IN prob_carrier p ==> X n x <= X (SUC n) x) /\ + (!n x. x IN prob_carrier p ==> X n x <= L x) /\ + (!x. x IN prob_carrier p ==> ((\n. X n x) ---> L x) sequentially) + ==> almost_surely p + {x | ((\n. gen_cond_exp p G (X n) x) ---> gen_cond_exp p G L x) + sequentially}`, + REPEAT STRIP_TAC THEN + ABBREV_TAC `D = \n:num. \x:A. L x - (X:num->A->real) n x` THEN + SUBGOAL_THEN `!n:num. integrable p ((D:num->A->real) n)` ASSUME_TAC THENL + [EXPAND_TAC "D" THEN GEN_TAC THEN REWRITE_TAC[] THEN + MATCH_MP_TAC INTEGRABLE_SUB THEN ASM_REWRITE_TAC[ETA_AX]; + ALL_TAC] THEN + SUBGOAL_THEN + `almost_surely p + {x:A | ((\n. gen_cond_exp p G ((D:num->A->real) n) x) ---> &0) + sequentially}` + ASSUME_TAC THENL + [MATCH_MP_TAC GEN_COND_EXP_DECR_TENDS_0 THEN ASM_REWRITE_TAC[] THEN + REPEAT CONJ_TAC THENL + [MAP_EVERY X_GEN_TAC [`n:num`; `x:A`] THEN DISCH_TAC THEN + EXPAND_TAC "D" THEN REWRITE_TAC[] THEN + SUBGOAL_THEN `(X:num->A->real) n x <= L x` MP_TAC THENL + [ASM_SIMP_TAC[]; REAL_ARITH_TAC]; + MAP_EVERY X_GEN_TAC [`n:num`; `x:A`] THEN DISCH_TAC THEN + EXPAND_TAC "D" THEN REWRITE_TAC[] THEN + SUBGOAL_THEN `(X:num->A->real) n x <= X (SUC n) x` MP_TAC THENL + [ASM_SIMP_TAC[]; REAL_ARITH_TAC]; + MATCH_MP_TAC ALMOST_SURELY_SUBSET THEN + EXISTS_TAC `prob_carrier (p:A prob_space)` THEN + REWRITE_TAC[ALMOST_SURELY_CARRIER] THEN + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN EXPAND_TAC "D" THEN + SUBGOAL_THEN `((\n. L x - (X:num->A->real) n x) ---> L x - L x) sequentially` + MP_TAC THENL + [MATCH_MP_TAC REALLIM_SUB THEN REWRITE_TAC[REALLIM_CONST] THEN + ASM_SIMP_TAC[]; + REWRITE_TAC[REAL_SUB_REFL]]]; + ALL_TAC] THEN + SUBGOAL_THEN + `almost_surely p + {x:A | !n. gen_cond_exp p G ((D:num->A->real) n) x = + gen_cond_exp p G L x - gen_cond_exp p G (X n) x}` + ASSUME_TAC THENL + [MATCH_MP_TAC ALMOST_SURELY_SUBSET THEN + EXISTS_TAC + `INTERS {{x:A | gen_cond_exp p G ((D:num->A->real) n) x = + gen_cond_exp p G L x - gen_cond_exp p G (X n) x} | + n IN (:num)}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC ALMOST_SURELY_COUNTABLE_INTER THEN X_GEN_TAC `n:num` THEN + SUBGOAL_THEN `(\w:A. L w - (X:num->A->real) n w) = (D:num->A->real) n` + ASSUME_TAC THENL + [EXPAND_TAC "D" THEN REWRITE_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL [`p:A prob_space`; `G:(A->bool)->bool`; `L:A->real`; + `(X:num->A->real) n`] GEN_COND_EXP_SUB) THEN + ASM_REWRITE_TAC[]; + REWRITE_TAC[IN_INTERS; FORALL_IN_GSPEC; IN_UNIV; IN_ELIM_THM] THEN + MESON_TAC[]]; + ALL_TAC] THEN + MATCH_MP_TAC ALMOST_SURELY_SUBSET THEN + EXISTS_TAC + `{x:A | ((\n. gen_cond_exp p G ((D:num->A->real) n) x) ---> &0) + sequentially} INTER + {x:A | !n. gen_cond_exp p G ((D:num->A->real) n) x = + gen_cond_exp p G L x - gen_cond_exp p G (X n) x}` THEN CONJ_TAC THENL - [REWRITE_TAC[INTEGRABLE_CONST]; - MATCH_MP_TAC MEASURABLE_WRT_CONST THEN ASM_REWRITE_TAC[]]);; + [MATCH_MP_TAC ALMOST_SURELY_INTER THEN ASM_REWRITE_TAC[]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN STRIP_TAC THEN + SUBGOAL_THEN + `(\n. gen_cond_exp p G ((X:num->A->real) n) x) = + (\n. gen_cond_exp p G L x - gen_cond_exp p G ((D:num->A->real) n) x)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `n:num` THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `((\n. gen_cond_exp p G L x - gen_cond_exp p G ((D:num->A->real) n) x) + ---> gen_cond_exp p G L x - &0) sequentially` MP_TAC THENL + [MATCH_MP_TAC REALLIM_SUB THEN REWRITE_TAC[REALLIM_CONST] THEN + ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_SUB_RZERO]]]);; -(* Step 9: Iterated conditioning (tower property) *) -let GEN_COND_EXP_ITERATED = prove - (`!p:A prob_space G H (X:A->real). - sub_sigma_algebra p G /\ sub_sigma_algebra p H /\ - G SUBSET H /\ integrable p X +(* Conditional Jensen for absolute value *) +let GEN_COND_EXP_ABS_BOUND = prove + (`!p:A prob_space G (X:A->real). + sub_sigma_algebra p G /\ integrable p X /\ + integrable p (\x. abs(X x)) ==> almost_surely p - {x | gen_cond_exp p G (gen_cond_exp p H X) x = - gen_cond_exp p G X x}`, + {x | abs(gen_cond_exp p G X x) <= + gen_cond_exp p G (\w. abs(X w)) x}`, REPEAT GEN_TAC THEN STRIP_TAC THEN - MATCH_MP_TAC GEN_COND_EXP_AE_UNIQUE THEN - EXISTS_TAC `G:(A->bool)->bool` THEN - ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL - [SUBGOAL_THEN + MP_TAC(SPECL [`p:A prob_space`; `G:(A->bool)->bool`; + `X:A->real`; `(\w:A. abs((X:A->real) w))`] + GEN_COND_EXP_MONOTONE) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN GEN_TAC THEN DISCH_TAC THEN REAL_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(SPECL [`p:A prob_space`; `G:(A->bool)->bool`; + `(\w:A. --((X:A->real) w))`; `(\w:A. abs((X:A->real) w))`] + GEN_COND_EXP_MONOTONE) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_NEG THEN ASM_REWRITE_TAC[]; + GEN_TAC THEN DISCH_TAC THEN REAL_ARITH_TAC]; + ALL_TAC] THEN + MP_TAC(SPECL [`p:A prob_space`; `G:(A->bool)->bool`; + `X:A->real`; `-- &1`] GEN_COND_EXP_CMUL) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[almost_surely] THEN + DISCH_THEN(X_CHOOSE_THEN `n1:A->bool` STRIP_ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `n2:A->bool` STRIP_ASSUME_TAC) THEN + DISCH_THEN(X_CHOOSE_THEN `n3:A->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `n1 UNION n2 UNION n3:A->bool` THEN CONJ_TAC THENL + [REPEAT(MATCH_MP_TAC NULL_EVENT_UNION THEN CONJ_TAC) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_UNION] THEN + X_GEN_TAC `w:A` THEN STRIP_TAC THEN + ASM_CASES_TAC + `gen_cond_exp p G (\w:A. -- &1 * (X:A->real) w) w = + -- &1 * gen_cond_exp p G X w` THENL + [ASM_CASES_TAC + `gen_cond_exp p G (\w:A. --(X:A->real) w) w <= + gen_cond_exp p G (\w. abs(X w)) w` THENL + [ASM_CASES_TAC + `gen_cond_exp p G (X:A->real) w <= + gen_cond_exp p G (\w:A. abs(X w)) w` THENL + [UNDISCH_TAC + `~(abs (gen_cond_exp p G (X:A->real) w) <= + gen_cond_exp p G (\w. abs (X w)) w)` THEN + REWRITE_TAC[] THEN + SUBGOAL_THEN `gen_cond_exp p G (\w:A. --(X:A->real) w) w = + --gen_cond_exp p G X w` ASSUME_TAC THENL + [SUBGOAL_THEN `(\w:A. --(X:A->real) w) = (\w. -- &1 * X w)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN REAL_ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + ASM_REAL_ARITH_TAC; + DISJ2_TAC THEN DISJ2_TAC THEN + UNDISCH_TAC `{x:A | x IN prob_carrier p /\ + ~(x IN {x | gen_cond_exp p G (X:A->real) x <= + gen_cond_exp p G (\w. abs(X w)) x})} SUBSET n3` THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[]]; + DISJ2_TAC THEN DISJ1_TAC THEN + UNDISCH_TAC `{x:A | x IN prob_carrier p /\ + ~(x IN {x | gen_cond_exp p G (\w. --(X:A->real) w) x <= + gen_cond_exp p G (\w. abs(X w)) x})} SUBSET n2` THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[]]; + DISJ1_TAC THEN + UNDISCH_TAC `{x:A | x IN prob_carrier p /\ + ~(x IN {x | gen_cond_exp p G (\w. -- &1 * (X:A->real) w) x = + -- &1 * gen_cond_exp p G X x})} SUBSET n1` THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Conditional Dominated Convergence Theorem for gen_cond_exp. *) +(* If X_n -> Z a.s. with |X_n| <= Y (Y integrable), then E[X_n|G] -> E[Z|G] *) +(* a.s. The route: the decreasing tail-sup envelope W_m = sup_{k>=m}|X_k-Z| *) +(* satisfies W_m -> 0 a.s., so E[W_m|G] -> 0 a.s. (conditional MCT); and *) +(* |E[X_n|G] - E[Z|G]| <= E[W_n|G] a.s. (Jensen + monotonicity), giving the *) +(* squeeze. First three reusable supporting lemmas. *) +(* ------------------------------------------------------------------------- *) + +(* sup over a tail equals B minus the inf of the reflected tail. *) +let SUP_SEQ_VIA_INF = prove + (`!X:num->real B N. + (!k. k >= N ==> &0 <= X k /\ X k <= B) + ==> sup {X k | k >= N} = B - inf {B - X k | k >= N}`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `~({B - (X:num->real) k | k >= N} = {})` ASSUME_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + MAP_EVERY EXISTS_TAC [`B - (X:num->real) N`; `N:num`] THEN + REWRITE_TAC[GE; LE_REFL]; ALL_TAC] THEN + SUBGOAL_THEN `?b. !y. y IN {B - (X:num->real) k | k >= N} ==> b <= y` + ASSUME_TAC THENL + [EXISTS_TAC `&0` THEN REWRITE_TAC[IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN + ASM_SIMP_TAC[REAL_SUB_LE]; ALL_TAC] THEN + MATCH_MP_TAC REAL_SUP_UNIQUE THEN CONJ_TAC THENL + [REWRITE_TAC[IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REAL_ARITH `i <= B - X ==> X <= B - i`) THEN + MATCH_MP_TAC INF_LE_ELEMENT THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + REWRITE_TAC[IN_ELIM_THM] THEN MAP_EVERY EXISTS_TAC [`k:num`] THEN + ASM_REWRITE_TAC[]]; + X_GEN_TAC `c:real` THEN DISCH_TAC THEN + MP_TAC(ISPECL [`{B - (X:num->real) k | k >= N}`; `B - c:real`] INF_APPROACH) THEN + ASM_REWRITE_TAC[REAL_ARITH `i < B - c <=> c < B - i`] THEN + REWRITE_TAC[IN_ELIM_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `y:real` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `(X:num->real) k` THEN CONJ_TAC THENL + [MAP_EVERY EXISTS_TAC [`k:num`] THEN ASM_REWRITE_TAC[]; + ASM_REAL_ARITH_TAC]]);; + +(* Tail supremum of a sequence of nonnegative bounded RVs is an RV *) +(* (function-bound version: bounded by an RV g, not a constant). *) +let RANDOM_VARIABLE_SUP_SEQ_FN = prove + (`!p:A prob_space (X:num->A->real) N g. + (!n. random_variable p (X n)) /\ random_variable p g /\ + (!n x. x IN prob_carrier p ==> &0 <= X n x) /\ + (!n x. x IN prob_carrier p ==> X n x <= g x) + ==> random_variable p (\x. sup {X k x | k >= N})`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[GSYM MEASURABLE_WRT_EVENTS] THEN + MATCH_MP_TAC MEASURABLE_WRT_EQ_ON_CARRIER THEN + EXISTS_TAC `\x:A. g x - inf {g x - (X:num->A->real) k x | k >= N}` THEN + CONJ_TAC THENL + [REWRITE_TAC[MEASURABLE_WRT_EVENTS] THEN + MATCH_MP_TAC RANDOM_VARIABLE_SUB THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`p:A prob_space`; `\k:num. \x:A. g x - (X:num->A->real) k x`; + `N:num`] RANDOM_VARIABLE_INF_SEQ) THEN + REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC RANDOM_VARIABLE_SUB THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `(\x:A. (X:num->A->real) n x) = X n` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM]; ASM_REWRITE_TAC[]]; + MAP_EVERY X_GEN_TAC [`n:num`; `x:A`] THEN DISCH_TAC THEN + REWRITE_TAC[REAL_SUB_LE] THEN ASM_SIMP_TAC[]]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN BETA_TAC THEN + MATCH_MP_TAC SUP_SEQ_VIA_INF THEN GEN_TAC THEN DISCH_TAC THEN + ASM_SIMP_TAC[]]);; + +(* If a_k -> 0 (nonnegative, bounded) then the tail suprema -> 0. *) +let SUP_TAIL_TENDS_0 = prove + (`!a:num->real C. + (!k. &0 <= a k) /\ (!k. a k <= C) /\ ((\k. a k) ---> &0) sequentially + ==> ((\m. sup {a k | k >= m}) ---> &0) sequentially`, + REPEAT STRIP_TAC THEN REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + UNDISCH_TAC `((\k. (a:num->real) k) ---> &0) sequentially` THEN + REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + DISCH_THEN(MP_TAC o SPEC `e / &2`) THEN + ASM_REWRITE_TAC[REAL_HALF] THEN + DISCH_THEN(X_CHOOSE_THEN `M:num` (LABEL_TAC "conv")) THEN + EXISTS_TAC `M:num` THEN X_GEN_TAC `m:num` THEN DISCH_TAC THEN + REWRITE_TAC[REAL_ARITH `abs(s - &0) = abs s`] THEN + SUBGOAL_THEN `&0 <= sup {(a:num->real) k | k >= m}` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `(a:num->real) m` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC ELEMENT_LE_SUP THEN CONJ_TAC THENL + [EXISTS_TAC `C:real` THEN REWRITE_TAC[IN_ELIM_THM] THEN + X_GEN_TAC `z:real` THEN + DISCH_THEN(X_CHOOSE_THEN `j:num` STRIP_ASSUME_TAC) THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `m:num` THEN + REWRITE_TAC[GE; LE_REFL]]; + ALL_TAC] THEN + ASM_SIMP_TAC[real_abs] THEN + MATCH_MP_TAC REAL_LET_TRANS THEN EXISTS_TAC `e / &2` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_SUP_LE THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + EXISTS_TAC `(a:num->real) m` THEN EXISTS_TAC `m:num` THEN + REWRITE_TAC[GE; LE_REFL]; + REWRITE_TAC[IN_ELIM_THM] THEN X_GEN_TAC `z:real` THEN + DISCH_THEN(X_CHOOSE_THEN `k:num` STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LT_IMP_LE THEN + REMOVE_THEN "conv" (MP_TAC o SPEC `k:num`) THEN + ANTS_TAC THENL + [UNDISCH_TAC `k:num >= m` THEN UNDISCH_TAC `M:num <= m` THEN ARITH_TAC; + REWRITE_TAC[REAL_ARITH `abs(x - &0) = abs x`] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> abs x < e ==> x < e`) THEN + ASM_REWRITE_TAC[]]]; + ASM_REAL_ARITH_TAC]);; + +(* Conditional Dominated Convergence Theorem. *) +let GEN_COND_EXP_DCT = prove + (`!p:A prob_space G X Z Y. + sub_sigma_algebra p G /\ + (!n. integrable p (X n)) /\ integrable p Z /\ integrable p Y /\ + (!n x. x IN prob_carrier p ==> abs(X n x) <= Y x) /\ + (!x. x IN prob_carrier p ==> abs(Z x) <= Y x) /\ + almost_surely p {x | ((\n. X n x) ---> Z x) sequentially} + ==> almost_surely p + {x | ((\n. gen_cond_exp p G (X n) x) ---> gen_cond_exp p G Z x) + sequentially}`, + REPEAT STRIP_TAC THEN + ABBREV_TAC `W = \m:num. \x:A. sup {abs((X:num->A->real) k x - Z x) | k >= m}` THEN + SUBGOAL_THEN + `!k:num. random_variable p (\x:A. abs((X:num->A->real) k x - Z x))` + ASSUME_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC RANDOM_VARIABLE_ABS THEN + MATCH_MP_TAC RANDOM_VARIABLE_SUB THEN + CONJ_TAC THEN MATCH_MP_TAC INTEGRABLE_IMP_RANDOM_VARIABLE THEN + ASM_REWRITE_TAC[ETA_AX]; + ALL_TAC] THEN + SUBGOAL_THEN + `!k x:A. x IN prob_carrier p ==> abs((X:num->A->real) k x - Z x) <= &2 * Y x` + ASSUME_TAC THENL + [MAP_EVERY X_GEN_TAC [`k:num`; `x:A`] THEN DISCH_TAC THEN + SUBGOAL_THEN `abs((X:num->A->real) k x) <= Y x /\ abs(Z x) <= Y x` MP_TAC THENL + [ASM_SIMP_TAC[]; REAL_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN `!n:num. integrable p (\x:A. (X:num->A->real) n x - Z x)` + ASSUME_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC INTEGRABLE_SUB THEN ASM_REWRITE_TAC[ETA_AX]; + ALL_TAC] THEN + SUBGOAL_THEN `!n:num. integrable p (\x:A. abs((X:num->A->real) n x - Z x))` + ASSUME_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC INTEGRABLE_DOMINATED THEN + EXISTS_TAC `\x:A. &2 * Y x` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_CMUL THEN ASM_REWRITE_TAC[ETA_AX]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN REWRITE_TAC[REAL_ABS_ABS] THEN + SUBGOAL_THEN `abs((X:num->A->real) n x - Z x) <= &2 * Y x` MP_TAC THENL + [ASM_SIMP_TAC[]; + MATCH_MP_TAC(REAL_ARITH `&0 <= a ==> a <= t ==> a <= abs t`) THEN + REWRITE_TAC[REAL_ABS_POS]]]; + ALL_TAC] THEN + SUBGOAL_THEN `!m:num. random_variable p ((W:num->A->real) m)` ASSUME_TAC THENL + [GEN_TAC THEN EXPAND_TAC "W" THEN BETA_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; + `\k:num. \x:A. abs((X:num->A->real) k x - Z x)`; `m:num`; + `\x:A. &2 * Y x`] RANDOM_VARIABLE_SUP_SEQ_FN) THEN + REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [MATCH_MP_TAC RANDOM_VARIABLE_CMUL THEN + MATCH_MP_TAC INTEGRABLE_IMP_RANDOM_VARIABLE THEN ASM_REWRITE_TAC[ETA_AX]; + REWRITE_TAC[REAL_ABS_POS]]; + ALL_TAC] THEN + SUBGOAL_THEN + `!m x:A. x IN prob_carrier p + ==> &0 <= (W:num->A->real) m x /\ W m x <= &2 * Y x` + ASSUME_TAC THENL + [MAP_EVERY X_GEN_TAC [`m:num`; `x:A`] THEN DISCH_TAC THEN + EXPAND_TAC "W" THEN BETA_TAC THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `abs((X:num->A->real) m x - Z x)` THEN + REWRITE_TAC[REAL_ABS_POS] THEN MATCH_MP_TAC ELEMENT_LE_SUP THEN CONJ_TAC THENL + [EXISTS_TAC `&2 * (Y:A->real) x` THEN REWRITE_TAC[IN_ELIM_THM] THEN + X_GEN_TAC `z:real` THEN + DISCH_THEN(X_CHOOSE_THEN `j:num` STRIP_ASSUME_TAC) THEN ASM_SIMP_TAC[]; + REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `m:num` THEN + REWRITE_TAC[GE; LE_REFL]]; + MATCH_MP_TAC REAL_SUP_LE THEN CONJ_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + EXISTS_TAC `abs((X:num->A->real) m x - Z x)` THEN EXISTS_TAC `m:num` THEN + REWRITE_TAC[GE; LE_REFL]; + REWRITE_TAC[IN_ELIM_THM] THEN X_GEN_TAC `z:real` THEN + DISCH_THEN(X_CHOOSE_THEN `j:num` STRIP_ASSUME_TAC) THEN ASM_SIMP_TAC[]]]; + ALL_TAC] THEN + SUBGOAL_THEN `!m:num. integrable p ((W:num->A->real) m)` ASSUME_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC INTEGRABLE_DOMINATED THEN + EXISTS_TAC `\x:A. &2 * Y x` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_CMUL THEN ASM_REWRITE_TAC[ETA_AX]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN BETA_TAC THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= w /\ w <= t ==> abs w <= abs t`) THEN + ASM_SIMP_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN + `!m n x:A. n >= m /\ x IN prob_carrier p + ==> abs((X:num->A->real) n x - Z x) <= (W:num->A->real) m x` + ASSUME_TAC THENL + [MAP_EVERY X_GEN_TAC [`m:num`; `n:num`; `x:A`] THEN STRIP_TAC THEN + EXPAND_TAC "W" THEN BETA_TAC THEN MATCH_MP_TAC ELEMENT_LE_SUP THEN + CONJ_TAC THENL + [EXISTS_TAC `&2 * (Y:A->real) x` THEN REWRITE_TAC[IN_ELIM_THM] THEN + X_GEN_TAC `z:real` THEN + DISCH_THEN(X_CHOOSE_THEN `j:num` STRIP_ASSUME_TAC) THEN ASM_SIMP_TAC[]; + REWRITE_TAC[IN_ELIM_THM] THEN EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN + `almost_surely p {x:A | ((\m. (W:num->A->real) m x) ---> &0) sequentially}` + ASSUME_TAC THENL + [MATCH_MP_TAC ALMOST_SURELY_SUBSET THEN + EXISTS_TAC `{x:A | ((\n. (X:num->A->real) n x) ---> Z x) sequentially}` THEN + ASM_REWRITE_TAC[] THEN + X_GEN_TAC `x:A` THEN DISCH_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN + EXPAND_TAC "W" THEN BETA_TAC THEN + MP_TAC(ISPECL [`\k:num. abs((X:num->A->real) k x - Z x)`; `&2 * (Y:A->real) x`] + SUP_TAIL_TENDS_0) THEN + REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[REAL_ABS_POS]; + GEN_TAC THEN ASM_SIMP_TAC[]; + REWRITE_TAC[REALLIM_NULL_ABS] THEN + ONCE_REWRITE_TAC[GSYM REALLIM_NULL] THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN + `almost_surely p + {x:A | ((\m. gen_cond_exp p G ((W:num->A->real) m) x) ---> &0) + sequentially}` + ASSUME_TAC THENL + [MATCH_MP_TAC GEN_COND_EXP_DECR_TENDS_0 THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [MAP_EVERY X_GEN_TAC [`m:num`; `x:A`] THEN DISCH_TAC THEN ASM_SIMP_TAC[]; + MAP_EVERY X_GEN_TAC [`m:num`; `x:A`] THEN DISCH_TAC THEN + EXPAND_TAC "W" THEN BETA_TAC THEN + MATCH_MP_TAC REAL_SUP_LE_SUBSET THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + EXISTS_TAC `abs((X:num->A->real) (SUC m) x - Z x)` THEN + EXISTS_TAC `SUC m` THEN REWRITE_TAC[GE; LE_REFL]; + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `z:real` THEN + DISCH_THEN(X_CHOOSE_THEN `j:num` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `j:num` THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `j:num >= SUC m` THEN ARITH_TAC; + EXISTS_TAC `&2 * (Y:A->real) x` THEN REWRITE_TAC[IN_ELIM_THM] THEN + X_GEN_TAC `z:real` THEN + DISCH_THEN(X_CHOOSE_THEN `j:num` STRIP_ASSUME_TAC) THEN ASM_SIMP_TAC[]]]; + ALL_TAC] THEN + SUBGOAL_THEN + `!n:num. almost_surely p + {x:A | gen_cond_exp p G (\w. (X:num->A->real) n w - Z w) x = + gen_cond_exp p G (X n) x - gen_cond_exp p G Z x}` ASSUME_TAC THENL + [GEN_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `G:(A->bool)->bool`; `(X:num->A->real) n`; + `Z:A->real`] GEN_COND_EXP_SUB) THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `!n:num. almost_surely p + {x:A | abs(gen_cond_exp p G (\w. (X:num->A->real) n w - Z w) x) + <= gen_cond_exp p G (\w. abs((X:num->A->real) n w - Z w)) x}` + ASSUME_TAC THENL + [GEN_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `G:(A->bool)->bool`; + `\w:A. (X:num->A->real) n w - Z w`] GEN_COND_EXP_ABS_BOUND) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `!n:num. almost_surely p + {x:A | gen_cond_exp p G (\w. abs((X:num->A->real) n w - Z w)) x + <= gen_cond_exp p G ((W:num->A->real) n) x}` ASSUME_TAC THENL + [GEN_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `G:(A->bool)->bool`; + `\w:A. abs((X:num->A->real) n w - Z w)`; `(W:num->A->real) n`] + GEN_COND_EXP_MONOTONE) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + X_GEN_TAC `x:A` THEN DISCH_TAC THEN ASM_SIMP_TAC[GE; LE_REFL]; + ALL_TAC] THEN + SUBGOAL_THEN + `almost_surely p + {x:A | !n. gen_cond_exp p G (\w. (X:num->A->real) n w - Z w) x = + gen_cond_exp p G (X n) x - gen_cond_exp p G Z x}` + ASSUME_TAC THENL + [MATCH_MP_TAC ALMOST_SURELY_SUBSET THEN + EXISTS_TAC + `INTERS {{x:A | gen_cond_exp p G (\w. (X:num->A->real) n w - Z w) x = + gen_cond_exp p G (X n) x - gen_cond_exp p G Z x} | n IN (:num)}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC ALMOST_SURELY_COUNTABLE_INTER THEN ASM_SIMP_TAC[]; + REWRITE_TAC[IN_INTERS; FORALL_IN_GSPEC; IN_UNIV; IN_ELIM_THM] THEN MESON_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN + `almost_surely p + {x:A | !n. abs(gen_cond_exp p G (\w. (X:num->A->real) n w - Z w) x) + <= gen_cond_exp p G (\w. abs((X:num->A->real) n w - Z w)) x}` + ASSUME_TAC THENL + [MATCH_MP_TAC ALMOST_SURELY_SUBSET THEN + EXISTS_TAC + `INTERS {{x:A | abs(gen_cond_exp p G (\w. (X:num->A->real) n w - Z w) x) + <= gen_cond_exp p G (\w. abs((X:num->A->real) n w - Z w)) x} | + n IN (:num)}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC ALMOST_SURELY_COUNTABLE_INTER THEN ASM_SIMP_TAC[]; + REWRITE_TAC[IN_INTERS; FORALL_IN_GSPEC; IN_UNIV; IN_ELIM_THM] THEN MESON_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN + `almost_surely p + {x:A | !n. gen_cond_exp p G (\w. abs((X:num->A->real) n w - Z w)) x + <= gen_cond_exp p G ((W:num->A->real) n) x}` + ASSUME_TAC THENL + [MATCH_MP_TAC ALMOST_SURELY_SUBSET THEN + EXISTS_TAC + `INTERS {{x:A | gen_cond_exp p G (\w. abs((X:num->A->real) n w - Z w)) x + <= gen_cond_exp p G ((W:num->A->real) n) x} | n IN (:num)}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC ALMOST_SURELY_COUNTABLE_INTER THEN ASM_SIMP_TAC[]; + REWRITE_TAC[IN_INTERS; FORALL_IN_GSPEC; IN_UNIV; IN_ELIM_THM] THEN MESON_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN + `almost_surely p + {x:A | !n. abs(gen_cond_exp p G ((X:num->A->real) n) x - + gen_cond_exp p G Z x) + <= gen_cond_exp p G ((W:num->A->real) n) x}` + ASSUME_TAC THENL + [MATCH_MP_TAC ALMOST_SURELY_SUBSET THEN + EXISTS_TAC + `{x:A | !n. gen_cond_exp p G (\w. (X:num->A->real) n w - Z w) x = + gen_cond_exp p G (X n) x - gen_cond_exp p G Z x} INTER + {x:A | !n. abs(gen_cond_exp p G (\w. (X:num->A->real) n w - Z w) x) + <= gen_cond_exp p G (\w. abs((X:num->A->real) n w - Z w)) x} INTER + {x:A | !n. gen_cond_exp p G (\w. abs((X:num->A->real) n w - Z w)) x + <= gen_cond_exp p G ((W:num->A->real) n) x}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC ALMOST_SURELY_INTER THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + MATCH_MP_TAC ALMOST_SURELY_INTER THEN CONJ_TAC THEN ASM_REWRITE_TAC[]]; + REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN + X_GEN_TAC `x:A` THEN DISCH_TAC THEN STRIP_TAC THEN X_GEN_TAC `n:num` THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `n:num`)) THEN REAL_ARITH_TAC]; + ALL_TAC] THEN + MATCH_MP_TAC ALMOST_SURELY_SUBSET THEN + EXISTS_TAC + `{x:A | !n. abs(gen_cond_exp p G ((X:num->A->real) n) x - + gen_cond_exp p G Z x) + <= gen_cond_exp p G ((W:num->A->real) n) x} INTER + {x:A | ((\m. gen_cond_exp p G ((W:num->A->real) m) x) ---> &0) + sequentially}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC ALMOST_SURELY_INTER THEN ASM_REWRITE_TAC[]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN STRIP_TAC THEN + ONCE_REWRITE_TAC[REALLIM_NULL] THEN + MATCH_MP_TAC REALLIM_NULL_COMPARISON THEN + EXISTS_TAC `\n. gen_cond_exp p G ((W:num->A->real) n) x` THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `0` THEN + REPEAT STRIP_TAC THEN BETA_TAC THEN ASM_REWRITE_TAC[]]);; + +(* Step 7: Self-conditioning *) +let GEN_COND_EXP_SELF = prove + (`!p:A prob_space G (X:A->real). + sub_sigma_algebra p G /\ integrable p X /\ measurable_wrt p G X + ==> almost_surely p {x | gen_cond_exp p G X x = X x}`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC GEN_COND_EXP_AE_UNIQUE THEN + EXISTS_TAC `G:(A->bool)->bool` THEN + ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [SUBGOAL_THEN + `(\x:A. gen_cond_exp p G (X:A->real) x) = gen_cond_exp p G X` + SUBST1_TAC THENL + [REWRITE_TAC[ETA_AX]; ALL_TAC] THEN + MATCH_MP_TAC GEN_COND_EXP_MEASURABLE_WRT THEN ASM_REWRITE_TAC[]; + SUBGOAL_THEN + `(\x:A. gen_cond_exp p G (X:A->real) x) = gen_cond_exp p G X` + SUBST1_TAC THENL + [REWRITE_TAC[ETA_AX]; ALL_TAC] THEN + MATCH_MP_TAC GEN_COND_EXP_INTEGRABLE THEN ASM_REWRITE_TAC[]; + GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC GEN_COND_EXP_CONDITIONING THEN ASM_REWRITE_TAC[]]);; + +(* Step 8: Constant conditioning *) +let GEN_COND_EXP_CONST = prove + (`!p:A prob_space G (c:real). + sub_sigma_algebra p G + ==> almost_surely p {x | gen_cond_exp p G (\w. c) x = c}`, + REPEAT GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC GEN_COND_EXP_SELF THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [REWRITE_TAC[INTEGRABLE_CONST]; + MATCH_MP_TAC MEASURABLE_WRT_CONST THEN ASM_REWRITE_TAC[]]);; + +(* Step 9: Iterated conditioning (tower property) *) +let GEN_COND_EXP_ITERATED = prove + (`!p:A prob_space G H (X:A->real). + sub_sigma_algebra p G /\ sub_sigma_algebra p H /\ + G SUBSET H /\ integrable p X + ==> almost_surely p + {x | gen_cond_exp p G (gen_cond_exp p H X) x = + gen_cond_exp p G X x}`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC GEN_COND_EXP_AE_UNIQUE THEN + EXISTS_TAC `G:(A->bool)->bool` THEN + ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [SUBGOAL_THEN `(\x:A. gen_cond_exp p G (gen_cond_exp p H (X:A->real)) x) = gen_cond_exp p G (gen_cond_exp p H X)` SUBST1_TAC THENL [REWRITE_TAC[ETA_AX]; ALL_TAC] THEN @@ -7184,6 +8492,216 @@ let GEN_COND_EXP_ITERATED = prove CONV_TAC SYM_CONV THEN MATCH_MP_TAC GEN_COND_EXP_CONDITIONING THEN ASM_REWRITE_TAC[]]);; +(* --- Additional measurability helpers --- *) + +(* Indicator of a set in G is G-measurable *) +let MEASURABLE_WRT_INDICATOR = prove + (`!p:A prob_space G (a:A->bool). + sub_sigma_algebra p G /\ a IN G + ==> measurable_wrt p G (indicator_fn a)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[measurable_wrt; indicator_fn] THEN + X_GEN_TAC `v:real` THEN + ASM_CASES_TAC `v < &0` THENL + [SUBGOAL_THEN + `{x:A | x IN prob_carrier p /\ (if x IN a then &1 else &0) <= v} = {}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN + GEN_TAC THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + COND_CASES_TAC THEN ASM_REAL_ARITH_TAC; + UNDISCH_TAC `sub_sigma_algebra (p:A prob_space) G` THEN + REWRITE_TAC[sub_sigma_algebra] THEN STRIP_TAC THEN + MATCH_MP_TAC SIGMA_ALGEBRA_EMPTY THEN ASM_REWRITE_TAC[]]; + ASM_CASES_TAC `&1 <= v` THENL + [SUBGOAL_THEN + `{x:A | x IN prob_carrier p /\ (if x IN a then &1 else &0) <= v} = + prob_carrier p` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN + GEN_TAC THEN EQ_TAC THENL [SIMP_TAC[]; ALL_TAC] THEN + DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + COND_CASES_TAC THEN ASM_REAL_ARITH_TAC; + UNDISCH_TAC `sub_sigma_algebra (p:A prob_space) G` THEN + REWRITE_TAC[sub_sigma_algebra; sigma_algebra] THEN MESON_TAC[]]; + SUBGOAL_THEN + `{x:A | x IN prob_carrier p /\ (if x IN a then &1 else &0) <= v} = + prob_carrier (p:A prob_space) DIFF a` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_DIFF] THEN + X_GEN_TAC `x:A` THEN EQ_TAC THENL + [STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN UNDISCH_TAC `(if (x:A) IN a then &1 else &0) <= v` THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC]; + SUBGOAL_THEN `prob_carrier (p:A prob_space) = UNIONS G` SUBST1_TAC THENL + [UNDISCH_TAC `sub_sigma_algebra (p:A prob_space) G` THEN + REWRITE_TAC[sub_sigma_algebra] THEN MESON_TAC[]; + UNDISCH_TAC `sub_sigma_algebra (p:A prob_space) G` THEN + REWRITE_TAC[sub_sigma_algebra; sigma_algebra] THEN + STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[]]]]]);; + +(* Finite sum of G-measurable functions is G-measurable *) +let MEASURABLE_WRT_SUM = prove + (`!p:A prob_space G (f:num->A->real) n. + sub_sigma_algebra p G /\ (!k. k <= n ==> measurable_wrt p G (f k)) + ==> measurable_wrt p G (\x. sum(0..n) (\k. f k x))`, + GEN_TAC THEN GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THENL + [STRIP_TAC THEN + SUBGOAL_THEN `(\x:A. sum(0..0) (\k. (f:num->A->real) k x)) = f 0` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; SUM_CLAUSES_NUMSEG]; ALL_TAC] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ARITH_TAC; + STRIP_TAC THEN + SUBGOAL_THEN + `(\x:A. sum(0..SUC n) (\k. (f:num->A->real) k x)) = + (\x. sum(0..n) (\k. f k x) + f (SUC n) x)` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; SUM_CLAUSES_NUMSEG; LE_0]; ALL_TAC] THEN + MATCH_MP_TAC MEASURABLE_WRT_ADD THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; + SUBGOAL_THEN `(\x:A. (f:num->A->real) (SUC n) x) = f(SUC n)` + SUBST1_TAC THENL + [REWRITE_TAC[ETA_AX]; ALL_TAC] THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ARITH_TAC]]);; + +(* Product of indicator with G-measurable function is G-measurable *) +let MEASURABLE_WRT_MUL_INDICATOR = prove + (`!p:A prob_space G (a:A->bool) (f:A->real). + sub_sigma_algebra p G /\ a IN G /\ measurable_wrt p G f + ==> measurable_wrt p G (\x. indicator_fn a x * f x)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[measurable_wrt; indicator_fn] THEN + X_GEN_TAC `v:real` THEN + ASM_CASES_TAC `v < &0` THENL + [SUBGOAL_THEN + `{x:A | x IN prob_carrier p /\ (if x IN a then &1 else &0) * f x <= v} = + a INTER {x | x IN prob_carrier p /\ (f:A->real) x <= v}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INTER] THEN + X_GEN_TAC `x:A` THEN EQ_TAC THENL + [STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `(if (x:A) IN a then &1 else &0) * (f:A->real) x <= v` THEN + ASM_CASES_TAC `(x:A) IN a` THEN ASM_REWRITE_TAC[] THENL + [REWRITE_TAC[REAL_MUL_LID]; + REWRITE_TAC[REAL_MUL_LZERO] THEN ASM_REAL_ARITH_TAC]; + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_REWRITE_TAC[REAL_MUL_LID]]; + SUBGOAL_THEN `sigma_algebra (G:(A->bool)->bool)` ASSUME_TAC THENL + [ASM_MESON_TAC[sub_sigma_algebra]; ALL_TAC] THEN + MATCH_MP_TAC SIGMA_ALGEBRA_INTER THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `measurable_wrt (p:A prob_space) G (f:A->real)` THEN + REWRITE_TAC[measurable_wrt] THEN DISCH_THEN(MP_TAC o SPEC `v:real`) THEN + REWRITE_TAC[]]; + SUBGOAL_THEN + `{x:A | x IN prob_carrier p /\ (if x IN a then &1 else &0) * f x <= v} = + (prob_carrier p DIFF a) UNION + (a INTER {x | x IN prob_carrier p /\ (f:A->real) x <= v})` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_UNION; IN_DIFF; IN_INTER] THEN + X_GEN_TAC `x:A` THEN EQ_TAC THENL + [STRIP_TAC THEN ASM_CASES_TAC `(x:A) IN a` THENL + [DISJ2_TAC THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `(if (x:A) IN a then &1 else &0) * (f:A->real) x <= v` THEN + ASM_REWRITE_TAC[REAL_MUL_LID]; + DISJ1_TAC THEN ASM_REWRITE_TAC[]]; + DISCH_THEN(DISJ_CASES_THEN STRIP_ASSUME_TAC) THENL + [ASM_REWRITE_TAC[REAL_MUL_LZERO] THEN ASM_REAL_ARITH_TAC; + ASM_REWRITE_TAC[REAL_MUL_LID]]]; + SUBGOAL_THEN `sigma_algebra (G:(A->bool)->bool)` ASSUME_TAC THENL + [ASM_MESON_TAC[sub_sigma_algebra]; ALL_TAC] THEN + MATCH_MP_TAC SIGMA_ALGEBRA_UNION THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUB_SIGMA_ALGEBRA_COMPL THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC SIGMA_ALGEBRA_INTER THEN ASM_REWRITE_TAC[] THEN + UNDISCH_TAC `measurable_wrt (p:A prob_space) G (f:A->real)` THEN + REWRITE_TAC[measurable_wrt] THEN DISCH_THEN(MP_TAC o SPEC `v:real`) THEN + REWRITE_TAC[]]]]);; + +(* Take out what is known -- indicator case: + E[1_A * X | G] = 1_A * E[X|G] a.s. when A IN G *) +let GEN_COND_EXP_TAKE_OUT_INDICATOR = prove + (`!p:A prob_space G (a:A->bool) (X:A->real). + sub_sigma_algebra p G /\ a IN G /\ integrable p X + ==> almost_surely p + {x | gen_cond_exp p G (\w. indicator_fn a w * X w) x = + indicator_fn a x * gen_cond_exp p G X x}`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC GEN_COND_EXP_AE_UNIQUE THEN + EXISTS_TAC `G:(A->bool)->bool` THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `(a:A->bool) IN prob_events p` ASSUME_TAC THENL + [MATCH_MP_TAC SUB_SIGMA_ALGEBRA_IN_EVENTS THEN + EXISTS_TAC `G:(A->bool)->bool` THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `integrable p (\w:A. indicator_fn a w * (X:A->real) w)` + ASSUME_TAC THENL + [SUBGOAL_THEN `(\w:A. indicator_fn a w * (X:A->real) w) = + (\w. X w * indicator_fn a w)` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN REAL_ARITH_TAC; + MATCH_MP_TAC INTEGRABLE_MUL_INDICATOR_FN THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + REPEAT CONJ_TAC THENL + [(* measurable_wrt gen_cond_exp LHS *) + SUBGOAL_THEN + `(\x:A. gen_cond_exp p G (\w. indicator_fn a w * (X:A->real) w) x) = + gen_cond_exp p G (\w. indicator_fn a w * X w)` SUBST1_TAC THENL + [REWRITE_TAC[ETA_AX]; ALL_TAC] THEN + MATCH_MP_TAC GEN_COND_EXP_MEASURABLE_WRT THEN ASM_REWRITE_TAC[]; + (* integrable gen_cond_exp LHS *) + SUBGOAL_THEN + `(\x:A. gen_cond_exp p G (\w. indicator_fn a w * (X:A->real) w) x) = + gen_cond_exp p G (\w. indicator_fn a w * X w)` SUBST1_TAC THENL + [REWRITE_TAC[ETA_AX]; ALL_TAC] THEN + MATCH_MP_TAC GEN_COND_EXP_INTEGRABLE THEN ASM_REWRITE_TAC[]; + (* measurable_wrt RHS *) + MATCH_MP_TAC MEASURABLE_WRT_MUL_INDICATOR THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `(\x:A. gen_cond_exp p G (X:A->real) x) = gen_cond_exp p G X` + SUBST1_TAC THENL + [REWRITE_TAC[ETA_AX]; ALL_TAC] THEN + MATCH_MP_TAC GEN_COND_EXP_MEASURABLE_WRT THEN ASM_REWRITE_TAC[]; + (* integrable RHS *) + SUBGOAL_THEN + `(\x:A. indicator_fn a x * gen_cond_exp p G (X:A->real) x) = + (\x. gen_cond_exp p G X x * indicator_fn a x)` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC INTEGRABLE_MUL_INDICATOR_FN THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN + `(\x:A. gen_cond_exp p G (X:A->real) x) = gen_cond_exp p G X` + SUBST1_TAC THENL + [REWRITE_TAC[ETA_AX]; ALL_TAC] THEN + MATCH_MP_TAC GEN_COND_EXP_INTEGRABLE THEN ASM_REWRITE_TAC[]; + (* Conditioning property *) + X_GEN_TAC `B:A->bool` THEN DISCH_TAC THEN + SUBGOAL_THEN + `expectation p + (\x:A. gen_cond_exp p G (\w. indicator_fn a w * (X:A->real) w) x * + indicator_fn B x) = + expectation p (\x. (indicator_fn a x * X x) * indicator_fn B x)` + SUBST1_TAC THENL + [MATCH_MP_TAC GEN_COND_EXP_CONDITIONING THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `(\x:A. (indicator_fn a x * (X:A->real) x) * indicator_fn B x) = + (\x. X x * indicator_fn (a INTER B) x)` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; indicator_fn; IN_INTER] THEN + X_GEN_TAC `x:A` THEN + ASM_CASES_TAC `(x:A) IN a` THEN ASM_CASES_TAC `(x:A) IN B` THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `(\x:A. (indicator_fn a x * gen_cond_exp p G (X:A->real) x) * + indicator_fn B x) = + (\x. gen_cond_exp p G X x * indicator_fn (a INTER B) x)` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; indicator_fn; IN_INTER] THEN + X_GEN_TAC `x:A` THEN + ASM_CASES_TAC `(x:A) IN a` THEN ASM_CASES_TAC `(x:A) IN B` THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + CONV_TAC SYM_CONV THEN + MATCH_MP_TAC GEN_COND_EXP_CONDITIONING THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `sigma_algebra (G:(A->bool)->bool)` ASSUME_TAC THENL + [ASM_MESON_TAC[sub_sigma_algebra]; ALL_TAC] THEN + MATCH_MP_TAC SIGMA_ALGEBRA_INTER THEN ASM_REWRITE_TAC[]]);; + (* ========================================================================= *) (* Gap 2: Martingale convergence for general (integrable) submartingales *) (* Lifts SIMPLE_MARTINGALE_CONVERGENCE_L1_BOUNDED etc. from *) @@ -7626,6 +9144,7 @@ let NOT_BET_GAIN_NONNEG_EXPECTATION = prove STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`n:num`; `A:A->bool`]) THEN ASM_REWRITE_TAC[]]);; + (* General Doob Upcrossing Inequality *) let DOOB_UPCROSSING_INEQUALITY = prove (`!p:A prob_space (FF:num->(A->bool)->bool) (X:num->A->real) a b n. @@ -7674,7 +9193,7 @@ let DOOB_UPCROSSING_INEQUALITY = prove DISCH_THEN(MP_TAC o SPEC `m:num`) THEN STRIP_TAC THEN ASM_MESON_TAC[filtration; sub_sigma_algebra; SUBSET]; MP_TAC(SPECL [`p:A prob_space`; `(X:num->A->real) (SUC m)`; `b:real`] - RANDOM_VARIABLE_GE) THEN + RV_PREIMAGE_GE) THEN ANTS_TAC THENL [MATCH_MP_TAC INTEGRABLE_IMP_RANDOM_VARIABLE THEN ASM_REWRITE_TAC[]; SIMP_TAC[]]]; @@ -7830,7 +9349,7 @@ let NONNEG_SUBMARTINGALE_MAXIMAL = prove (X:num->A->real) 0 y >= c}` THEN SUBGOAL_THEN `(A0:A->bool) IN prob_events (p:A prob_space)` ASSUME_TAC THENL - [EXPAND_TAC "A0" THEN MATCH_MP_TAC RANDOM_VARIABLE_GE THEN + [EXPAND_TAC "A0" THEN MATCH_MP_TAC RV_PREIMAGE_GE THEN REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC INTEGRABLE_IMP_RANDOM_VARIABLE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN @@ -7893,7 +9412,7 @@ let NONNEG_SUBMARTINGALE_MAXIMAL = prove ASSUME_TAC THENL [EXPAND_TAC "B" THEN MATCH_MP_TAC PROB_DIFF_IN_EVENTS THEN ASM_REWRITE_TAC[] THEN - MATCH_MP_TAC RANDOM_VARIABLE_GE THEN REWRITE_TAC[ETA_AX] THEN + MATCH_MP_TAC RV_PREIMAGE_GE THEN REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC INTEGRABLE_IMP_RANDOM_VARIABLE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN SUBGOAL_THEN @@ -10924,3 +12443,6121 @@ let GEN_DOOB_DECOMPOSITION_SUPER = prove (* X = -M' + -A' *) REPEAT GEN_TAC THEN FIRST_X_ASSUM(MP_TAC o SPECL [`n:num`; `x:A`]) THEN REAL_ARITH_TAC]);; + +(* ========================================================================= *) +(* Levy's Conditional Borel-Cantelli Lemma *) +(* ========================================================================= *) + +(* Partial sum of indicators forms a submartingale for adapted events *) +let INDICATOR_SUM_SUBMARTINGALE = prove + (`!p:A prob_space FF (B:num->A->bool). + filtration p FF /\ + (!n. B n IN prob_events p) /\ + (!n. B n SUBSET prob_carrier p) /\ + (!n. B n IN FF n) + ==> submartingale p FF (\n x. sum(0..n) (\k. indicator_fn (B k) x))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[submartingale] THEN + ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [(* adapted *) + REWRITE_TAC[adapted] THEN X_GEN_TAC `n:num` THEN + MP_TAC(ISPECL [`p:A prob_space`; `(FF:num->(A->bool)->bool) n`; + `\k (x:A). indicator_fn ((B:num->A->bool) k) x`; `n:num`] + MEASURABLE_WRT_SUM) THEN + CONV_TAC(DEPTH_CONV BETA_CONV) THEN + DISCH_THEN MATCH_MP_TAC THEN CONJ_TAC THENL + [ASM_MESON_TAC[filtration]; + X_GEN_TAC `k:num` THEN DISCH_TAC THEN + SUBGOAL_THEN `(\x:A. indicator_fn ((B:num->A->bool) k) x) = + indicator_fn (B k)` SUBST1_TAC THENL + [REWRITE_TAC[ETA_AX]; ALL_TAC] THEN + MATCH_MP_TAC MEASURABLE_WRT_INDICATOR THEN CONJ_TAC THENL + [ASM_MESON_TAC[filtration]; + UNDISCH_TAC `filtration (p:A prob_space) FF` THEN + REWRITE_TAC[filtration] THEN STRIP_TAC THEN + SUBGOAL_THEN `(FF:num->(A->bool)->bool) k SUBSET FF n` MP_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; + REWRITE_TAC[SUBSET] THEN DISCH_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]]]; + (* integrable *) + X_GEN_TAC `n:num` THEN + MP_TAC(ISPECL [`p:A prob_space`; `\k. indicator_fn ((B:num->A->bool) k)`; + `n:num`] INTEGRABLE_SUM) THEN + CONV_TAC(DEPTH_CONV BETA_CONV) THEN DISCH_THEN MATCH_MP_TAC THEN + GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC INTEGRABLE_INDICATOR THEN ASM_REWRITE_TAC[]; + (* submartingale property: E[S_n * 1_a] <= E[S_{n+1} * 1_a] *) + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(a:A->bool) IN prob_events p` ASSUME_TAC THENL + [MATCH_MP_TAC SUB_SIGMA_ALGEBRA_IN_EVENTS THEN + EXISTS_TAC `(FF:num->(A->bool)->bool) n` THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[filtration]; ALL_TAC] THEN + SUBGOAL_THEN + `!x:A. sum(0..SUC n) (\k. indicator_fn ((B:num->A->bool) k) x) = + sum(0..n) (\k. indicator_fn (B k) x) + indicator_fn (B (SUC n)) x` + (fun th -> REWRITE_TAC[th]) THENL + [GEN_TAC THEN REWRITE_TAC[SUM_CLAUSES_NUMSEG; LE_0]; ALL_TAC] THEN + REWRITE_TAC[REAL_ADD_RDISTRIB] THEN + MATCH_MP_TAC EXPECTATION_MONO THEN + CONV_TAC(DEPTH_CONV BETA_CONV) THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_MUL_INDICATOR_FN THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`p:A prob_space`; `\k. indicator_fn ((B:num->A->bool) k)`; + `n:num`] INTEGRABLE_SUM) THEN + CONV_TAC(DEPTH_CONV BETA_CONV) THEN DISCH_THEN MATCH_MP_TAC THEN + GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC INTEGRABLE_INDICATOR THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC INTEGRABLE_ADD THEN CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_MUL_INDICATOR_FN THEN ASM_REWRITE_TAC[] THEN + MP_TAC(ISPECL [`p:A prob_space`; `\k. indicator_fn ((B:num->A->bool) k)`; + `n:num`] INTEGRABLE_SUM) THEN + CONV_TAC(DEPTH_CONV BETA_CONV) THEN DISCH_THEN MATCH_MP_TAC THEN + GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC INTEGRABLE_INDICATOR THEN + ASM_REWRITE_TAC[]; + MP_TAC(ISPECL [`p:A prob_space`; + `indicator_fn ((B:num->A->bool) (SUC n))`; `a:A->bool`] + INTEGRABLE_MUL_INDICATOR_FN) THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC INTEGRABLE_INDICATOR THEN ASM_REWRITE_TAC[]]; + REPEAT STRIP_TAC THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= y ==> x <= x + y`) THEN + REWRITE_TAC[indicator_fn] THEN REPEAT COND_CASES_TAC THEN + REAL_ARITH_TAC]]);; + +(* Key pointwise inequality for the telescoping bound: + h / (1+c+h)^2 <= inv(1+c) - inv(1+c+h) for h,c >= 0 *) +let TELESCOPING_STEP = prove + (`!h c:real. &0 <= h /\ &0 <= c + ==> h / (&1 + c + h) pow 2 <= inv(&1 + c) - inv(&1 + c + h)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&0 < &1 + c /\ &0 < &1 + c + h` STRIP_ASSUME_TAC THENL + [CONJ_TAC THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `~(&1 + c = &0) /\ ~(&1 + c + h = &0)` STRIP_ASSUME_TAC THENL + [CONJ_TAC THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `inv(&1 + c) - inv(&1 + c + h) = + h / ((&1 + c) * (&1 + c + h))` + SUBST1_TAC THENL + [ASM_SIMP_TAC[REAL_FIELD + `~(a = &0) /\ ~(b = &0) ==> inv a - inv b = (b - a) / (a * b)`] THEN + AP_THM_TAC THEN AP_TERM_TAC THEN REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[real_div] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LT_MUL THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_POW_2] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; ASM_REAL_ARITH_TAC]]);; + +(* Telescoping bound: sum of h_k / (1+c_{k+1})^2 <= 1 - inv(1+c_{n+1}) + where c is non-decreasing, c(0) = 0, h_k = c_{k+1} - c_k *) +let TELESCOPING_SUM_BOUND = prove + (`!c:num->real n. + c(0) = &0 /\ (!k. k <= n ==> &0 <= c(SUC k) - c(k)) + ==> sum(0..n) (\k. (c(SUC k) - c(k)) / (&1 + c(SUC k)) pow 2) + <= &1 - inv(&1 + c(SUC n))`, + GEN_TAC THEN INDUCT_TAC THENL + [STRIP_TAC THEN REWRITE_TAC[SUM_CLAUSES_NUMSEG] THEN + CONV_TAC NUM_REDUCE_CONV THEN ASM_REWRITE_TAC[REAL_SUB_RZERO] THEN + SUBGOAL_THEN `&0 <= (c:num->real) 1` ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `0`) THEN REWRITE_TAC[LE_REFL] THEN + CONV_TAC NUM_REDUCE_CONV THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + MP_TAC TELESCOPING_STEP THEN + DISCH_THEN(MP_TAC o SPECL [`(c:num->real) 1`; `&0`]) THEN + ASM_REWRITE_TAC[REAL_LE_REFL; REAL_ADD_RID; REAL_ADD_LID; REAL_INV_1]; + STRIP_TAC THEN REWRITE_TAC[SUM_CLAUSES_NUMSEG; LE_0] THEN + SUBGOAL_THEN `!j:num. j <= SUC n ==> &0 <= (c:num->real) j` + ASSUME_TAC THENL + [INDUCT_TAC THENL + [DISCH_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL]; + DISCH_TAC THEN + SUBGOAL_THEN `&0 <= (c:num->real)(SUC j) - c j` MP_TAC THENL + [FIRST_ASSUM(MP_TAC o SPEC `j:num`) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; SIMP_TAC[]]; + SUBGOAL_THEN `&0 <= (c:num->real) j` MP_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; + REAL_ARITH_TAC]]]; ALL_TAC] THEN + SUBGOAL_THEN `sum (0..n) (\k. ((c:num->real) (SUC k) - c k) / + (&1 + c (SUC k)) pow 2) <= &1 - inv(&1 + c(SUC n))` + ASSUME_TAC THENL + [FIRST_X_ASSUM(fun th -> MATCH_MP_TAC th) THEN + ASM_REWRITE_TAC[] THEN X_GEN_TAC `k:num` THEN DISCH_TAC THEN + ASM_MESON_TAC[ARITH_RULE `k <= n ==> k <= SUC n`]; ALL_TAC] THEN + SUBGOAL_THEN `((c:num->real) (SUC (SUC n)) - c (SUC n)) / + (&1 + c (SUC (SUC n))) pow 2 <= + inv(&1 + c(SUC n)) - inv(&1 + c(SUC(SUC n)))` + ASSUME_TAC THENL + [MP_TAC TELESCOPING_STEP THEN + DISCH_THEN(MP_TAC o SPECL [`(c:num->real)(SUC(SUC n)) - c(SUC n)`; + `(c:num->real)(SUC n)`]) THEN + ANTS_TAC THENL + [ASM_MESON_TAC[LE_REFL]; + SUBGOAL_THEN `&1 + (c:num->real)(SUC n) + (c(SUC(SUC n)) - c(SUC n)) = + &1 + c(SUC(SUC n))` (fun th -> REWRITE_TAC[th]) THEN + REAL_ARITH_TAC]; ALL_TAC] THEN + ASM_REAL_ARITH_TAC]);; + +(* Simplified version: sum <= 1 *) +let TELESCOPING_SUM_BOUND_SIMPLE = prove + (`!c:num->real n. + c(0) = &0 /\ (!k. k <= n ==> &0 <= c(SUC k) - c(k)) + ==> sum(0..n) (\k. (c(SUC k) - c(k)) / (&1 + c(SUC k)) pow 2) <= &1`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&1 - inv(&1 + (c:num->real)(SUC n))` THEN CONJ_TAC THENL + [MATCH_MP_TAC TELESCOPING_SUM_BOUND THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> &1 - x <= &1`) THEN + MATCH_MP_TAC REAL_LE_INV THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= c ==> &0 <= &1 + c`) THEN + SUBGOAL_THEN `!j:num. j <= SUC n ==> &0 <= (c:num->real) j` MP_TAC THENL + [INDUCT_TAC THENL + [DISCH_TAC THEN ASM_REWRITE_TAC[REAL_LE_REFL]; + DISCH_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(c:num->real) j` THEN CONJ_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; + FIRST_X_ASSUM(MP_TAC o SPEC `j:num`) THEN + ANTS_TAC THENL [ASM_ARITH_TAC; REAL_ARITH_TAC]]]; + DISCH_THEN(MP_TAC o SPEC `SUC n`) THEN REWRITE_TAC[LE_REFL]]]);; + +(* Abel summation / summation by parts identity *) +let SUMMATION_BY_PARTS = prove + (`!a b n. sum (0..SUC n) (\k. a k * b k) = + sum (0..SUC n) a * b (SUC n) + + sum (0..n) (\k. sum (0..k) a * (b k - b (SUC k)))`, + GEN_TAC THEN GEN_TAC THEN INDUCT_TAC THENL + [REWRITE_TAC[SUM_CLAUSES_NUMSEG; ARITH_RULE `0 <= SUC 0`; LE_0] THEN + REAL_ARITH_TAC; + REWRITE_TAC[SUM_CLAUSES_NUMSEG; LE_0; ARITH_RULE `0 <= SUC(SUC n)`] THEN + FIRST_X_ASSUM(MP_TAC) THEN + REWRITE_TAC[SUM_CLAUSES_NUMSEG; LE_0; ARITH_RULE `0 <= SUC n`] THEN + ABBREV_TAC `s1 = sum (0..n) (\k. (a:num->real) k * (b:num->real) k)` THEN + ABBREV_TAC `s2 = sum (0..n) (a:num->real)` THEN + ABBREV_TAC `t1 = sum (0..n) (\k. sum (0..k) (a:num->real) * + ((b:num->real) k - b (SUC k)))` THEN + REAL_ARITH_TAC]);; + +(* Each indicator is in [0,1], so sum of n+1 indicators is at most n+1 *) +let INDICATOR_SUM_BOUNDED = prove + (`!(B:num->A->bool) x n. sum (0..n) (\k. indicator_fn (B k) x) <= &n + &1`, + REPEAT GEN_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum (0..n) (\k. &1)` THEN CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE_NUMSEG THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN + REWRITE_TAC[indicator_fn] THEN COND_CASES_TAC THEN REAL_ARITH_TAC; + REWRITE_TAC[SUM_CONST_NUMSEG; SUB_0; ADD_CLAUSES] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN REAL_ARITH_TAC]);; + +(* x in limsup B iff the sum of indicators is unbounded *) +let LIMSUP_EVENTS_IFF_SUM_UNBOUNDED = prove + (`!(B:num->A->bool) (x:A). x IN limsup_events B <=> + (!M. ?N. &M <= sum (0..N) (\k. indicator_fn (B k) x))`, + REPEAT GEN_TAC THEN REWRITE_TAC[LIMSUP_EVENTS_ALT; IN_ELIM_THM] THEN + EQ_TAC THENL + [(* Forward: i.o. ==> sum unbounded *) + DISCH_TAC THEN INDUCT_TAC THENL + [EXISTS_TAC `0` THEN REWRITE_TAC[SUM_SING_NUMSEG; indicator_fn] THEN + COND_CASES_TAC THEN REAL_ARITH_TAC; + FIRST_X_ASSUM(X_CHOOSE_TAC `N0:num`) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `N0 + 1`) THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `n:num` THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum (0..N0) (\k. indicator_fn ((B:num->A->bool) k) (x:A)) + + indicator_fn (B n) x` THEN + CONJ_TAC THENL + [SUBGOAL_THEN `indicator_fn ((B:num->A->bool) n) (x:A) = &1` SUBST1_TAC THENL + [ASM_REWRITE_TAC[indicator_fn; COND_ID]; ALL_TAC] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_SUC] THEN ASM_REAL_ARITH_TAC; + SUBGOAL_THEN `sum (0..N0) (\k. indicator_fn ((B:num->A->bool) k) (x:A)) + + indicator_fn (B n) x = + sum (0..N0) (\k. indicator_fn (B k) x) + + sum (n..n) (\k. indicator_fn (B k) x)` SUBST1_TAC THENL + [AP_TERM_TAC THEN REWRITE_TAC[SUM_SING_NUMSEG]; ALL_TAC] THEN + SUBGOAL_THEN `DISJOINT (0..N0) (n..n:num)` ASSUME_TAC THENL + [REWRITE_TAC[DISJOINT; EXTENSION; NOT_IN_EMPTY; IN_INTER; IN_NUMSEG] THEN + ASM_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `sum (0..N0) (\k. indicator_fn ((B:num->A->bool) k) (x:A)) + + sum (n..n) (\k. indicator_fn (B k) x) = + sum ((0..N0) UNION (n..n)) (\k. indicator_fn (B k) x)` SUBST1_TAC THENL + [MATCH_MP_TAC(GSYM SUM_UNION) THEN + ASM_REWRITE_TAC[FINITE_NUMSEG]; ALL_TAC] THEN + MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN + REWRITE_TAC[FINITE_NUMSEG] THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET; IN_UNION; IN_NUMSEG] THEN ASM_ARITH_TAC; + X_GEN_TAC `k:num` THEN + REWRITE_TAC[IN_DIFF; IN_NUMSEG; IN_UNION] THEN + STRIP_TAC THEN REWRITE_TAC[indicator_fn] THEN + COND_CASES_TAC THEN REAL_ARITH_TAC]]]; + (* Backward: sum unbounded ==> i.o. *) + DISCH_TAC THEN X_GEN_TAC `m:num` THEN + FIRST_X_ASSUM(MP_TAC o SPEC `SUC m`) THEN + DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN + REWRITE_TAC[GE] THEN + ASM_CASES_TAC `?n:num. m <= n /\ x IN (B:num->A->bool) n` THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `!k. m <= k ==> indicator_fn ((B:num->A->bool) k) (x:A) = &0` + ASSUME_TAC THENL + [X_GEN_TAC `k:num` THEN DISCH_TAC THEN REWRITE_TAC[indicator_fn] THEN + COND_CASES_TAC THENL + [FIRST_X_ASSUM(MP_TAC o check (fun th -> + fst(dest_const(fst(strip_comb(concl th)))) = "~")) THEN + REWRITE_TAC[] THEN ASM_MESON_TAC[]; + REFL_TAC]; ALL_TAC] THEN + SUBGOAL_THEN + `sum (0..N) (\k. indicator_fn ((B:num->A->bool) k) (x:A)) <= &m` MP_TAC THENL + [ALL_TAC; + UNDISCH_TAC + `&(SUC m) <= sum (0..N) (\k. indicator_fn ((B:num->A->bool) k) (x:A))` THEN + REWRITE_TAC[GSYM REAL_OF_NUM_SUC] THEN REAL_ARITH_TAC] THEN + ASM_CASES_TAC `N < m:num` THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&N + &1` THEN + REWRITE_TAC[INDICATOR_SUM_BOUNDED] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_LE] THEN + ASM_REWRITE_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_ADD] THEN ASM_ARITH_TAC; + ALL_TAC] THEN + ASM_CASES_TAC `m = 0` THENL + [SUBGOAL_THEN + `sum (0..N) (\k. indicator_fn ((B:num->A->bool) k) (x:A)) = &0` + SUBST1_TAC THENL + [MATCH_MP_TAC SUM_EQ_0_NUMSEG THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `k:num`) THEN ASM_ARITH_TAC; + REAL_ARITH_TAC]; ALL_TAC] THEN + SUBGOAL_THEN `?p. N = (m - 1) + p:num` MP_TAC THENL + [EXISTS_TAC `N - (m - 1):num` THEN ASM_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_THEN `p:num` SUBST_ALL_TAC) THEN + SUBGOAL_THEN + `sum (0..m - 1 + p) (\k. indicator_fn ((B:num->A->bool) k) (x:A)) = + sum (0..m - 1) (\k. indicator_fn (B k) x) + + sum (m..m - 1 + p) (\k. indicator_fn (B k) x)` SUBST1_TAC THENL + [MP_TAC(ISPECL [`\k. indicator_fn ((B:num->A->bool) k) (x:A)`; + `0`; `m - 1`; `p:num`] SUM_ADD_SPLIT) THEN + ANTS_TAC THENL [ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `m - 1 + 1 = m` (fun th -> REWRITE_TAC[th]) THEN + ASM_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `sum (m..m - 1 + p) (\k. indicator_fn ((B:num->A->bool) k) (x:A)) = &0` + SUBST1_TAC THENL + [MATCH_MP_TAC SUM_EQ_0_NUMSEG THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN + BETA_TAC THEN ASM_SIMP_TAC[]; ALL_TAC] THEN + REWRITE_TAC[REAL_ADD_RID] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&(m - 1) + &1` THEN + REWRITE_TAC[INDICATOR_SUM_BOUNDED] THEN + SUBGOAL_THEN `1 <= m` ASSUME_TAC THENL [ASM_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[GSYM REAL_OF_NUM_SUB] THEN REAL_ARITH_TAC]);; + +(* ---- Telescoping variance bound for Levy CBC ---- *) +(* Key bound: sum v_k/(1+V_k)^2 <= 1 - inv(1+V_n) < 1 *) +(* where V_k = sum(0..k) v is the partial sum. *) + +let TELESCOPING_VARIANCE_BOUND = prove + (`!v n. (!k. &0 <= v k) ==> + sum (0..n) (\k. v k / (&1 + sum (0..k) v) pow 2) + <= &1 - inv(&1 + sum (0..n) v)`, + GEN_TAC THEN INDUCT_TAC THENL + [DISCH_TAC THEN REWRITE_TAC[SUM_SING_NUMSEG] THEN + FIRST_ASSUM(MP_TAC o SPEC `0`) THEN + SPEC_TAC (`(v:num->real) 0`, `a:real`) THEN + GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN `~(&1 + a = &0)` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `a / (&1 + a)` THEN CONJ_TAC THENL + [REWRITE_TAC[real_div] THEN MATCH_MP_TAC REAL_LE_LMUL THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[REAL_POW_2; REAL_INV_MUL] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_RID] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INV THEN ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_INV_LE_1 THEN ASM_REAL_ARITH_TAC]; + UNDISCH_TAC `~(&1 + a = &0)` THEN CONV_TAC REAL_FIELD]; + DISCH_TAC THEN + REWRITE_TAC[SUM_CLAUSES_NUMSEG; ARITH_RULE `0 <= SUC n`] THEN + FIRST_X_ASSUM(MP_TAC o check (is_imp o concl)) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + ABBREV_TAC `V = sum (0..n) (v:num->real)` THEN + ABBREV_TAC `u = (v:num->real) (SUC n)` THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(&1 - inv(&1 + V)) + u / (&1 + V + u) pow 2` THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `&0 <= V` ASSUME_TAC THENL + [EXPAND_TAC "V" THEN MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `&0 <= u` ASSUME_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `~(&1 + V = &0)` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `~(&1 + V + u = &0)` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_ARITH `a - b + c <= a - d <=> c <= b - d`] THEN + SUBGOAL_THEN + `inv(&1 + V) - inv(&1 + V + u) = u / ((&1 + V) * (&1 + V + u))` + SUBST1_TAC THENL + [UNDISCH_TAC `~(&1 + V = &0)` THEN UNDISCH_TAC `~(&1 + V + u = &0)` THEN + CONV_TAC REAL_FIELD; ALL_TAC] THEN + REWRITE_TAC[real_div] THEN MATCH_MP_TAC REAL_LE_LMUL THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_INV2 THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LT_MUL THEN ASM_REAL_ARITH_TAC; + REWRITE_TAC[REAL_POW_2] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN ASM_REAL_ARITH_TAC]]);; + +let TELESCOPING_VARIANCE_BOUND_SIMPLE = prove + (`!v n. (!k. &0 <= v k) ==> + sum (0..n) (\k. v k / (&1 + sum (0..k) v) pow 2) <= &1`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `&1 - inv(&1 + sum (0..n) (v:num->real))` THEN + ASM_SIMP_TAC[TELESCOPING_VARIANCE_BOUND] THEN + SUBGOAL_THEN `&0 <= sum (0..n) (v:num->real)` MP_TAC THENL + [MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + DISCH_TAC THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> &1 - x <= &1`) THEN + MATCH_MP_TAC REAL_LE_INV THEN ASM_REAL_ARITH_TAC);; + +(* Step identity: E[S_{n+1}|F_n] - S_n = E[1_{B_{n+1}}|F_n] a.s. *) +let INDICATOR_SUM_COND_EXP_STEP = prove + (`!p FF (B:num->A->bool) n. + filtration p FF /\ (!n. B n IN prob_events p) /\ + (!n. B n SUBSET prob_carrier p) /\ (!n. B n IN FF n) + ==> almost_surely p + {x | gen_cond_exp p (FF n) + (\y. sum (0..SUC n) (\k. indicator_fn (B k) y)) x - + sum (0..n) (\k. indicator_fn (B k) x) = + gen_cond_exp p (FF n) + (\y. indicator_fn (B (SUC n)) y) x}`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `(\y:A. sum (0..SUC n) (\k. indicator_fn (B k) y)) = + (\y. sum (0..n) (\k. indicator_fn ((B:num->A->bool) k) y) + + indicator_fn (B (SUC n)) y)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; SUM_CLAUSES_NUMSEG; ARITH_RULE `0 <= SUC n`] THEN + REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `sub_sigma_algebra p ((FF:num->(A->bool)->bool) n)` + ASSUME_TAC THENL [ASM_MESON_TAC[filtration]; ALL_TAC] THEN + SUBGOAL_THEN + `!k:num. integrable p (\y:A. indicator_fn ((B:num->A->bool) k) y)` + ASSUME_TAC THENL + [GEN_TAC THEN REWRITE_TAC[ETA_AX] THEN + MATCH_MP_TAC INTEGRABLE_INDICATOR THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `integrable p + (\y:A. sum (0..n) (\k. indicator_fn ((B:num->A->bool) k) y))` + ASSUME_TAC THENL + [MATCH_MP_TAC INTEGRABLE_SUM THEN REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `almost_surely p + {x:A | gen_cond_exp p ((FF:num->(A->bool)->bool) n) + (\y. sum (0..n) (\k. indicator_fn ((B:num->A->bool) k) y) + + indicator_fn (B (SUC n)) y) x = + gen_cond_exp p (FF n) + (\y. sum (0..n) (\k. indicator_fn (B k) y)) x + + gen_cond_exp p (FF n) + (\y. indicator_fn (B (SUC n)) y) x}` + ASSUME_TAC THENL + [MP_TAC(ISPECL + [`p:A prob_space`; `(FF:num->(A->bool)->bool) n`; + `\y:A. sum (0..n) (\k. indicator_fn ((B:num->A->bool) k) y)`; + `\y:A. indicator_fn ((B:num->A->bool) (SUC n)) y`] + GEN_COND_EXP_ADD) THEN + REWRITE_TAC[BETA_THM] THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `measurable_wrt p ((FF:num->(A->bool)->bool) n) + (\y:A. sum (0..n) (\k. indicator_fn ((B:num->A->bool) k) y))` + ASSUME_TAC THENL + [MATCH_MP_TAC MEASURABLE_WRT_SUM THEN ASM_REWRITE_TAC[] THEN + REPEAT STRIP_TAC THEN + REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC MEASURABLE_WRT_INDICATOR THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `(B:num->A->bool) k IN FF k` MP_TAC THENL + [ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `(FF:num->(A->bool)->bool) k SUBSET FF n` MP_TAC THENL + [FIRST_ASSUM(MP_TAC o GEN_REWRITE_RULE I [filtration]) THEN + SIMP_TAC[SUBSET; IN] THEN + DISCH_THEN(MP_TAC o CONJUNCT2) THEN + DISCH_THEN(MP_TAC o SPECL [`k:num`; `n:num`]) THEN + ASM_REWRITE_TAC[]; + ASM_MESON_TAC[SUBSET; IN]]; ALL_TAC] THEN + MP_TAC(ISPECL + [`p:A prob_space`; `(FF:num->(A->bool)->bool) n`; + `\y:A. sum (0..n) (\k. indicator_fn ((B:num->A->bool) k) y)`] + GEN_COND_EXP_SELF) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + DISCH_TAC THEN + MATCH_MP_TAC(ISPEC `p:A prob_space` ALMOST_SURELY_SUBSET) THEN + EXISTS_TAC `{x:A | gen_cond_exp p ((FF:num->(A->bool)->bool) n) + (\y. sum (0..n) (\k. indicator_fn ((B:num->A->bool) k) y) + + indicator_fn (B (SUC n)) y) x = + gen_cond_exp p (FF n) + (\y. sum (0..n) (\k. indicator_fn (B k) y)) x + + gen_cond_exp p (FF n) (\y. indicator_fn (B (SUC n)) y) x} INTER + {x:A | gen_cond_exp p (FF n) + (\y. sum (0..n) (\k. indicator_fn (B k) y)) x = + sum (0..n) (\k. indicator_fn (B k) x)}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC(ISPEC `p:A prob_space` ALMOST_SURELY_INTER) THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[SUBSET; IN_INTER; IN_ELIM_THM] THEN + REPEAT STRIP_TAC THEN ASM_REAL_ARITH_TAC);; + +(* Compensator identity: A_{n+1} = sum_0^n E[1_{B_{k+1}}|F_k] a.s. *) +let INDICATOR_SUM_COMPENSATOR_IDENTITY = prove + (`!p FF (B:num->A->bool). + filtration p FF /\ (!n. B n IN prob_events p) /\ + (!n. B n SUBSET prob_carrier p) /\ (!n. B n IN FF n) + ==> almost_surely p + {x | !n. gen_doob_compensator p FF + (\n x. sum (0..n) (\k. indicator_fn (B k) x)) (SUC n) x = + sum (0..n) (\k. gen_cond_exp p (FF k) + (\y. indicator_fn (B (SUC k)) y) x)}`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC(ISPEC `p:A prob_space` ALMOST_SURELY_SUBSET) THEN + EXISTS_TAC `INTERS + {({x:A | gen_cond_exp p ((FF:num->(A->bool)->bool) n) + (\y. sum (0..SUC n) (\k. indicator_fn ((B:num->A->bool) k) y)) + x - sum (0..n) (\k. indicator_fn (B k) x) = + gen_cond_exp p (FF n) (\y. indicator_fn (B (SUC n)) y) x}) + | n IN (:num)}` THEN + CONJ_TAC THENL + [MP_TAC(ISPECL [`p:A prob_space`; + `\n. {x:A | gen_cond_exp p ((FF:num->(A->bool)->bool) n) + (\y. sum (0..SUC n) (\k. indicator_fn ((B:num->A->bool) k) y)) + x - sum (0..n) (\k. indicator_fn (B k) x) = + gen_cond_exp p (FF n) (\y. indicator_fn (B (SUC n)) y) x}`] + ALMOST_SURELY_COUNTABLE_INTER) THEN + REWRITE_TAC[BETA_THM] THEN + DISCH_THEN MATCH_MP_TAC THEN + GEN_TAC THEN MATCH_MP_TAC INDICATOR_SUM_COND_EXP_STEP THEN + ASM_REWRITE_TAC[]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + REWRITE_TAC[IN_INTERS; IN_ELIM_THM; IN_UNIV] THEN + DISCH_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN + SUBGOAL_THEN + `!m. gen_cond_exp p ((FF:num->(A->bool)->bool) m) + (\y. sum (0..SUC m) (\k. indicator_fn ((B:num->A->bool) k) y)) + (x:A) - sum (0..m) (\k. indicator_fn (B k) x) = + gen_cond_exp p (FF m) (\y. indicator_fn (B (SUC m)) y) x` + ASSUME_TAC THENL + [X_GEN_TAC `m:num` THEN + FIRST_ASSUM(MP_TAC o SPEC + `{x:A | gen_cond_exp p ((FF:num->(A->bool)->bool) m) + (\y. sum (0..SUC m) + (\k. indicator_fn ((B:num->A->bool) k) y)) + x - sum (0..m) (\k. indicator_fn (B k) x) = + gen_cond_exp p (FF m) + (\y. indicator_fn (B (SUC m)) y) x}`) THEN + ANTS_TAC THENL + [EXISTS_TAC `m:num` THEN REWRITE_TAC[]; + REWRITE_TAC[IN_ELIM_THM]]; + ALL_TAC] THEN + INDUCT_TAC THENL + [REWRITE_TAC[gen_doob_compensator; SUM_SING_NUMSEG; REAL_ADD_LID] THEN + FIRST_ASSUM(MP_TAC o SPEC `0`) THEN + REWRITE_TAC[SUM_CLAUSES_NUMSEG; ARITH_RULE `0 <= SUC 0`; LE_0; + SUM_SING_NUMSEG] THEN + REAL_ARITH_TAC; + ONCE_REWRITE_TAC[gen_doob_compensator] THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[SUM_CLAUSES_NUMSEG; ARITH_RULE `0 <= SUC n`] THEN + FIRST_ASSUM(MP_TAC o SPEC `SUC n`) THEN + ABBREV_TAC `E1 = gen_cond_exp p ((FF:num->(A->bool)->bool) (SUC n)) + (\y. sum (0..SUC(SUC n)) + (\k. indicator_fn ((B:num->A->bool) k) y)) (x:A)` THEN + ABBREV_TAC `S1 = sum (0..SUC n) + (\k. indicator_fn ((B:num->A->bool) k) (x:A))` THEN + ABBREV_TAC `C1 = gen_cond_exp p ((FF:num->(A->bool)->bool) (SUC n)) + (\y. indicator_fn ((B:num->A->bool) (SUC(SUC n))) y) (x:A)` THEN + ABBREV_TAC `D1 = sum (0..n) + (\k. gen_cond_exp p ((FF:num->(A->bool)->bool) k) + (\y. indicator_fn ((B:num->A->bool) (SUC k)) y) (x:A))` THEN + DISCH_TAC THEN ASM_REAL_ARITH_TAC]]);; + +(* Kronecker rescaled: if sum(a_k) converges and 1+V_k -> infinity, + then inv(1+V_n) * sum(a_k * (1+V_k)) -> 0 *) +let KRONECKER_RESCALED = prove + (`!a v. (!k. &0 <= v k) /\ + real_summable (from 0) a /\ + (!M. ?N. !n. N <= n ==> M <= &1 + sum(0..n) v) + ==> ((\n. inv(&1 + sum(0..n) v) * + sum(0..n) (\k. a k * (&1 + sum(0..k) v))) + ---> &0) sequentially`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `!n. &0 < &1 + sum(0..n) (v:num->real)` ASSUME_TAC THENL + [GEN_TAC THEN + SUBGOAL_THEN `&0 <= sum(0..n) (v:num->real)` MP_TAC THENL + [MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN ASM_REWRITE_TAC[]; + REAL_ARITH_TAC]; ALL_TAC] THEN + SUBGOAL_THEN `!n. ~(&1 + sum(0..n) (v:num->real) = &0)` ASSUME_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC(REAL_ARITH `&0 < x ==> ~(x = &0)`) THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL + [`\k. (a:num->real) k * (&1 + sum(0..k) (v:num->real))`; + `\n. &1 + sum(0..n) (v:num->real)`] + KRONECKER_LEMMA) THEN + REWRITE_TAC[BETA_THM] THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [GEN_TAC THEN REWRITE_TAC[ARITH_RULE `n + 1 = SUC n`; + SUM_CLAUSES_NUMSEG; ARITH_RULE `0 <= SUC n`] THEN + MP_TAC(SPEC `SUC n` (ASSUME `!k. &0 <= (v:num->real) k`)) THEN + REAL_ARITH_TAC; + SUBGOAL_THEN + `(\k. (a k * (&1 + sum (0..k) (v:num->real))) / + (&1 + sum (0..k) v)) = a` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + SUBGOAL_THEN `~(&1 + sum(0..x) (v:num->real) = &0)` MP_TAC THENL + [ASM_REWRITE_TAC[]; CONV_TAC REAL_FIELD]; + ASM_REWRITE_TAC[]]]);; + +(* Abel convergence: if sum(a_k) converges and b_k positive increasing + converges, then sum(a_k * b_k) converges *) +let ABEL_SUMMATION_CONVERGENCE = prove + (`!a v. (!k. &0 <= v k) /\ + (?L. ((\n. sum(0..n) a) ---> L) sequentially) /\ + (?V_inf. ((\n. sum(0..n) v) ---> V_inf) sequentially) + ==> ?M_inf. + ((\n. sum(0..n) (\k. a k * (&1 + sum(0..k) v))) ---> M_inf) + sequentially`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + (* Helper: f(SUC n) --> l implies f(n) --> l *) + SUBGOAL_THEN + `!f:num->real l. ((\n. f(SUC n)) ---> l) sequentially + ==> (f ---> l) sequentially` + (LABEL_TAC "SUC_LIM") THENL + [REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REALLIM_SEQUENTIALLY]) THEN + REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `SUC N` THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n - 1`) THEN + SUBGOAL_THEN `SUC(n - 1) = n` SUBST1_TAC THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_ARITH_TAC; ALL_TAC] THEN + (* Helper: f(n) --> l implies f(SUC n) --> l *) + SUBGOAL_THEN + `!f:num->real l. (f ---> l) sequentially + ==> ((\n. f(SUC n)) ---> l) sequentially` + (LABEL_TAC "LIM_SUC") THENL + [REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REALLIM_SEQUENTIALLY]) THEN + REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + DISCH_TAC THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN EXISTS_TAC `N:num` THEN + REPEAT STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC; + ALL_TAC] THEN + (* Partial sums of a are bounded *) + SUBGOAL_THEN + `?C. &0 < C /\ !n. abs(sum(0..n) (a:num->real)) <= C` + STRIP_ASSUME_TAC THENL + [MP_TAC(ISPECL [`\n. sum(0..n) (a:num->real)`; `L:real`] + REAL_CONVERGENT_IMP_BOUNDED) THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[REAL_BOUNDED_POS; FORALL_IN_IMAGE; IN_UNIV]; ALL_TAC] THEN + (* sum(S_k * v(SUC k)) converges by comparison with C * v(SUC k) *) + SUBGOAL_THEN + `?T_inf. ((\n. sum(0..n) (\k. sum(0..k) (a:num->real) * v(SUC k))) + ---> T_inf) sequentially` + (X_CHOOSE_TAC `T_inf:real`) THENL + [SUBGOAL_THEN + `real_summable (from 0) (\k. sum(0..k) (a:num->real) * v(SUC k))` + MP_TAC THENL + [MATCH_MP_TAC REAL_SUMMABLE_COMPARISON THEN + EXISTS_TAC `\k. C * (v:num->real)(SUC k)` THEN CONJ_TAC THENL + [REWRITE_TAC[real_summable; real_sums; FROM_INTER_NUMSEG; SUM_LMUL] THEN + EXISTS_TAC `C * (V_inf - (v:num->real) 0)` THEN + MATCH_MP_TAC REALLIM_LMUL THEN + SUBGOAL_THEN `!n. sum(0..n) (\k. (v:num->real)(SUC k)) = + sum(0..SUC n) v - v 0` + (fun th -> REWRITE_TAC[th]) THENL + [INDUCT_TAC THENL + [REWRITE_TAC[SUM_SING_NUMSEG; SUM_CLAUSES_NUMSEG; LE_0] THEN + REAL_ARITH_TAC; + ONCE_REWRITE_TAC[SUM_CLAUSES_NUMSEG] THEN REWRITE_TAC[LE_0] THEN + ASM_REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[SUM_CLAUSES_NUMSEG] THEN REWRITE_TAC[LE_0] THEN + REAL_ARITH_TAC]; ALL_TAC] THEN + MATCH_MP_TAC REALLIM_SUB THEN REWRITE_TAC[REALLIM_CONST] THEN + REMOVE_THEN "LIM_SUC" + (MP_TAC o SPECL [`\n. sum(0..n) (v:num->real)`; `V_inf:real`]) THEN + ASM_REWRITE_TAC[]; + EXISTS_TAC `0` THEN REWRITE_TAC[GE; LE_0; IN_FROM] THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_ABS_MUL] THEN + MATCH_MP_TAC REAL_LE_MUL2 THEN + ASM_SIMP_TAC[REAL_ABS_POS; REAL_ARITH `&0 <= x ==> abs x = x`] THEN + REAL_ARITH_TAC]; + REWRITE_TAC[real_summable; real_sums; FROM_INTER_NUMSEG] THEN + MESON_TAC[]]; ALL_TAC] THEN + (* Main: sum(0..SUC n)(a_k*b_k) = product - sum, both converge *) + EXISTS_TAC `L * (&1 + V_inf) - T_inf` THEN + REMOVE_THEN "SUC_LIM" (fun th -> MATCH_MP_TAC th) THEN + SUBGOAL_THEN + `!n. sum(0..SUC n) (\k. (a:num->real) k * (&1 + sum(0..k) v)) = + sum(0..SUC n) a * (&1 + sum(0..SUC n) v) - + sum(0..n) (\k. sum(0..k) a * v(SUC k))` + (fun th -> REWRITE_TAC[th]) THENL + [GEN_TAC THEN REWRITE_TAC[SUMMATION_BY_PARTS] THEN + SUBGOAL_THEN + `sum (0..n) (\k. sum(0..k) (a:num->real) * + ((&1 + sum(0..k) v) - (&1 + sum(0..SUC k) v))) = + --(sum(0..n) (\k. sum(0..k) a * v(SUC k)))` + (fun th -> REWRITE_TAC[th] THEN CONV_TAC REAL_RING) THEN + REWRITE_TAC[GSYM SUM_NEG] THEN MATCH_MP_TAC SUM_EQ_NUMSEG THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[] THEN + ONCE_REWRITE_TAC[SUM_CLAUSES_NUMSEG] THEN REWRITE_TAC[LE_0] THEN + CONV_TAC REAL_RING; ALL_TAC] THEN + MATCH_MP_TAC REALLIM_SUB THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REALLIM_MUL THEN CONJ_TAC THENL + [REMOVE_THEN "LIM_SUC" + (MP_TAC o SPECL [`\n. sum(0..n) (a:num->real)`; `L:real`]) THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC REALLIM_ADD THEN REWRITE_TAC[REALLIM_CONST] THEN + REMOVE_THEN "LIM_SUC" + (MP_TAC o SPECL [`\n. sum(0..n) (v:num->real)`; `V_inf:real`]) THEN + ASM_REWRITE_TAC[]]);; + +(* Decomposition unbounded iff: c + V + M unbounded <=> V unbounded *) +(* Under: v_k >= 0, sum(a_k) converges, c >= 0, M_n = sum a_k*(1+V_k) *) +let DECOMPOSITION_UNBOUNDED_IFF = prove + (`!v a c. + (!k. &0 <= v k) /\ + (?L. ((\n. sum(0..n) a) ---> L) sequentially) /\ + &0 <= c + ==> ((!M. ?N. &M <= c + sum(0..N) v + + sum(0..N) (\k. a k * (&1 + sum(0..k) v))) + <=> (!M. ?N. &M <= sum(0..N) v))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN EQ_TAC THENL + [(* Backward: c+V+M unbounded => V unbounded (contrapositive) *) + ONCE_REWRITE_TAC[TAUT `(p ==> q) <=> (~q ==> ~p)`] THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_EXISTS_THM; REAL_NOT_LE] THEN + DISCH_THEN(X_CHOOSE_TAC `M0:num`) THEN + (* V bounded => V converges *) + SUBGOAL_THEN + `?V_inf. ((\n. sum(0..n) (v:num->real)) ---> V_inf) sequentially` + (X_CHOOSE_TAC `V_inf:real`) THENL + [MATCH_MP_TAC CONVERGENT_REAL_BOUNDED_MONOTONE THEN CONJ_TAC THENL + [REWRITE_TAC[real_bounded; FORALL_IN_IMAGE; IN_UNIV] THEN + EXISTS_TAC `&M0` THEN GEN_TAC THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= x /\ x < M ==> abs x <= M`) THEN + ASM_SIMP_TAC[SUM_POS_LE_NUMSEG]; + DISJ1_TAC THEN GEN_TAC THEN + REWRITE_TAC[SUM_CLAUSES_NUMSEG; LE_0] THEN + UNDISCH_TAC `!k. &0 <= (v:num->real) k` THEN + DISCH_THEN(MP_TAC o SPEC `SUC n`) THEN REAL_ARITH_TAC]; ALL_TAC] THEN + (* Abel: sum(a_k*(1+V_k)) converges *) + SUBGOAL_THEN + `?M_inf. ((\n. sum(0..n) (\k. (a:num->real) k * (&1 + sum(0..k) v))) + ---> M_inf) sequentially` + (X_CHOOSE_TAC `M_inf:real`) THENL + [MATCH_MP_TAC ABEL_SUMMATION_CONVERGENCE THEN + ASM_MESON_TAC[]; ALL_TAC] THEN + (* c + V + M bounded *) + MP_TAC(ISPECL [`\n:num. sum(0..n) (v:num->real)`; `V_inf:real`] + REAL_CONVERGENT_IMP_BOUNDED) THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[REAL_BOUNDED_POS; FORALL_IN_IMAGE; IN_UNIV] THEN + DISCH_THEN(X_CHOOSE_THEN `Cv:real` STRIP_ASSUME_TAC) THEN + MP_TAC(ISPECL [`\n:num. sum(0..n) + (\k. (a:num->real) k * (&1 + sum(0..k) v))`; `M_inf:real`] + REAL_CONVERGENT_IMP_BOUNDED) THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[REAL_BOUNDED_POS; FORALL_IN_IMAGE; IN_UNIV] THEN + DISCH_THEN(X_CHOOSE_THEN `Cm:real` STRIP_ASSUME_TAC) THEN + MP_TAC(SPEC `c + Cv + Cm + &1` REAL_ARCH_SIMPLE) THEN + DISCH_THEN(X_CHOOSE_TAC `M1:num`) THEN + EXISTS_TAC `M1:num` THEN GEN_TAC THEN + MATCH_MP_TAC(REAL_ARITH + `abs(v) <= Cv /\ abs(m) <= Cm /\ c + Cv + Cm + &1 <= &M1 + ==> c + v + m < &M1`) THEN + ASM_REWRITE_TAC[]; + (* Forward: V unbounded => c+V+M unbounded (using Kronecker) *) + DISCH_TAC THEN + SUBGOAL_THEN `real_summable (from 0) (a:num->real)` ASSUME_TAC THENL + [REWRITE_TAC[real_summable; real_sums; FROM_INTER_NUMSEG; LE_0] THEN + ASM_MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `!m n. m <= n ==> sum(0..m) (v:num->real) <= sum(0..n) v` + (LABEL_TAC "V_MONO2") THENL + [MATCH_MP_TAC TRANSITIVE_STEPWISE_LE THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_LE_REFL]; CONJ_TAC THENL + [MESON_TAC[REAL_LE_TRANS]; ALL_TAC]] THEN + GEN_TAC THEN REWRITE_TAC[SUM_CLAUSES_NUMSEG; LE_0] THEN + UNDISCH_TAC `!k. &0 <= (v:num->real) k` THEN + DISCH_THEN(MP_TAC o SPEC `SUC n`) THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `!n. &0 < &1 + sum(0..n) (v:num->real)` (LABEL_TAC "VP") THENL + [GEN_TAC THEN MATCH_MP_TAC(REAL_ARITH `&0 <= s ==> &0 < &1 + s`) THEN + MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + (* Apply KRONECKER_RESCALED *) + MP_TAC(ISPECL [`a:num->real`; `v:num->real`] KRONECKER_RESCALED) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN + X_GEN_TAC `r:real` THEN + MP_TAC(SPEC `r:real` REAL_ARCH_SIMPLE) THEN + DISCH_THEN(X_CHOOSE_TAC `M1:num`) THEN + UNDISCH_TAC `!M:num. ?N:num. &M <= sum(0..N) (v:num->real)` THEN + DISCH_THEN(MP_TAC o SPEC `M1:num`) THEN + DISCH_THEN(X_CHOOSE_TAC `N1:num`) THEN + EXISTS_TAC `N1:num` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(0..N1) (v:num->real)` THEN CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(0..n) (v:num->real)` THEN CONJ_TAC THENL + [USE_THEN "V_MONO2" MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC(REAL_ARITH `&0 <= s ==> s <= &1 + s`) THEN + MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN ASM_REWRITE_TAC[]]]; + ALL_TAC] THEN + (* Kronecker: inv(1+V)*M -> 0 *) + REWRITE_TAC[REALLIM_SEQUENTIALLY; REAL_SUB_RZERO] THEN + DISCH_THEN(MP_TAC o SPEC `inv(&2)`) THEN + ANTS_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_TAC `N1:num`) THEN + X_GEN_TAC `M2:num` THEN + UNDISCH_TAC `!M:num. ?N. &M <= sum(0..N) (v:num->real)` THEN + DISCH_THEN(MP_TAC o SPEC `2 * M2 + 1`) THEN + DISCH_THEN(X_CHOOSE_TAC `N2:num`) THEN + ABBREV_TAC `N = N1 + N2:num` THEN EXISTS_TAC `N:num` THEN + SUBGOAL_THEN `&(2 * M2 + 1) <= sum(0..N) (v:num->real)` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(0..N2) (v:num->real)` THEN + ASM_REWRITE_TAC[] THEN USE_THEN "V_MONO2" MATCH_MP_TAC THEN + ASM_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `N1 <= N:num` ASSUME_TAC THENL + [ASM_ARITH_TAC; ALL_TAC] THEN + FIRST_X_ASSUM(fun th -> MP_TAC(MATCH_MP th (ASSUME `N1 <= N:num`))) THEN + USE_THEN "VP" (MP_TAC o SPEC `N:num`) THEN + ABBREV_TAC `W = &1 + sum(0..N) (v:num->real)` THEN + ABBREV_TAC `Mn = sum(0..N) + (\k. (a:num->real) k * (&1 + sum(0..k) v))` THEN + REPEAT STRIP_TAC THEN + (* Key: |inv(W)*Mn| < 1/2 ==> --(W/2) < Mn *) + SUBGOAL_THEN `--(W / &2) < Mn` ASSUME_TAC THENL + [SUBGOAL_THEN `--inv(&2) < inv(W) * Mn` ASSUME_TAC THENL + [UNDISCH_TAC `abs(inv W * Mn) < inv(&2)` THEN REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `~(W = &0)` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `W * --inv(&2) < W * inv W * Mn` MP_TAC THENL + [MATCH_MP_TAC REAL_LT_LMUL THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `W * inv W = &1` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_MUL_RINV THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN ASM_REWRITE_TAC[REAL_MUL_LID] THEN + REWRITE_TAC[real_div] THEN REAL_ARITH_TAC; ALL_TAC] THEN + (* c + V + Mn >= V/2 - 1/2 >= M2 *) + UNDISCH_TAC `--(W / &2) < Mn` THEN + UNDISCH_TAC `&1 + sum(0..N) (v:num->real) = W` THEN + UNDISCH_TAC `&(2 * M2 + 1) <= sum(0..N) (v:num->real)` THEN + UNDISCH_TAC `&0 <= c` THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN + REAL_ARITH_TAC]);; + + +(* ================================================================== *) +(* Infrastructure lemmas for RESCALED_INDICATOR_CONVERGENCE *) +(* ================================================================== *) + +(* Squaring preserves measurability *) +let MEASURABLE_WRT_POW2 = prove + (`!p:A prob_space G (f:A->real). + sub_sigma_algebra p G /\ measurable_wrt p G f + ==> measurable_wrt p G (\x. f x pow 2)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[measurable_wrt] THEN + X_GEN_TAC `v:real` THEN ASM_CASES_TAC `v < &0` THENL + [SUBGOAL_THEN + `{x:A | x IN prob_carrier p /\ f x pow 2 <= v} = {}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN + X_GEN_TAC `x:A` THEN DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + MP_TAC(SPEC `(f:A->real) x` REAL_LE_POW_2) THEN + UNDISCH_TAC `v < &0` THEN REAL_ARITH_TAC; + ASM_MESON_TAC[sub_sigma_algebra; SIGMA_ALGEBRA_EMPTY]]; + SUBGOAL_THEN `&0 <= v` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `{x:A | x IN prob_carrier p /\ f x pow 2 <= v} = + {x | x IN prob_carrier p /\ f x <= sqrt v} INTER + {x | x IN prob_carrier p /\ f x >= --(sqrt v)}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_INTER] THEN + X_GEN_TAC `x:A` THEN EQ_TAC THENL + [STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_RSQRT THEN ASM_REWRITE_TAC[]; + SUBGOAL_THEN `(--(f:A->real) x) pow 2 <= v` MP_TAC THENL + [REWRITE_TAC[REAL_POW_NEG; ARITH] THEN ASM_REWRITE_TAC[]; + DISCH_THEN(MP_TAC o MATCH_MP REAL_LE_RSQRT) THEN REAL_ARITH_TAC]]; + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `abs((f:A->real) x) <= sqrt v` MP_TAC THENL + [ASM_REAL_ARITH_TAC; + DISCH_TAC THEN + SUBGOAL_THEN `abs((f:A->real) x) pow 2 <= v` MP_TAC THENL + [MATCH_MP_TAC REAL_RSQRT_LE THEN ASM_REWRITE_TAC[REAL_ABS_POS]; + REWRITE_TAC[REAL_POW2_ABS]]]]; + SUBGOAL_THEN `sigma_algebra (G:(A->bool)->bool)` ASSUME_TAC THENL + [ASM_MESON_TAC[sub_sigma_algebra]; ALL_TAC] THEN + MATCH_MP_TAC SIGMA_ALGEBRA_INTER THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [UNDISCH_TAC `measurable_wrt (p:A prob_space) G (f:A->real)` THEN + REWRITE_TAC[measurable_wrt] THEN DISCH_THEN(MP_TAC o SPEC `sqrt v`) THEN + REWRITE_TAC[]; + MP_TAC(SPECL [`p:A prob_space`; `G:(A->bool)->bool`; `f:A->real`; + `--(sqrt v)`] MEASURABLE_WRT_GE) THEN + ASM_REWRITE_TAC[]]]]);; + +(* Product of measurable_wrt functions is measurable_wrt -- via polarization *) +let MEASURABLE_WRT_MUL = prove + (`!p:A prob_space G (f:A->real) (g:A->real). + sub_sigma_algebra p G /\ measurable_wrt p G f /\ measurable_wrt p G g + ==> measurable_wrt p G (\x. f x * g x)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN + `(\x:A. f x * g x) = + (\x. inv(&2) * ((f x + g x) pow 2 - f x pow 2 - g x pow 2))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; REAL_POW_2] THEN GEN_TAC THEN REAL_ARITH_TAC; + MATCH_MP_TAC MEASURABLE_WRT_CMUL THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MEASURABLE_WRT_SUB THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_WRT_SUB THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_WRT_POW2 THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MEASURABLE_WRT_ADD THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC MEASURABLE_WRT_POW2 THEN ASM_REWRITE_TAC[]]; + MATCH_MP_TAC MEASURABLE_WRT_POW2 THEN ASM_REWRITE_TAC[]]]);; + +(* ------------------------------------------------------------------------- *) +(* Taking out what is known: an affine G-measurable factor can be pulled out *) +(* of a conditional expectation. This extends the indicator-multiplier case *) +(* above to multipliers of the form c times an indicator plus a constant. *) +(* Three helper lemmas precede the main result. *) +(* ------------------------------------------------------------------------- *) + +(* An affine function of a G-indicator is G-measurable. *) +let MWRT_AFFINE = prove + (`!p:A prob_space G A c d. + sub_sigma_algebra p G /\ A IN G + ==> measurable_wrt p G (\x. c * indicator_fn A x + d)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `measurable_wrt (p:A prob_space) G (indicator_fn (A:A->bool))` ASSUME_TAC THENL + [ASM_SIMP_TAC[MEASURABLE_WRT_INDICATOR]; ALL_TAC] THEN + SUBGOAL_THEN `measurable_wrt (p:A prob_space) G (\x:A. c * indicator_fn A x)` ASSUME_TAC THENL + [MP_TAC(ISPECL [`p:A prob_space`; `G:(A->bool)->bool`; `indicator_fn (A:A->bool)`; `c:real`] + MEASURABLE_WRT_CMUL) THEN ASM_REWRITE_TAC[ETA_AX]; ALL_TAC] THEN + MP_TAC(BETA_RULE(ISPECL [`p:A prob_space`; `G:(A->bool)->bool`; + `\x:A. c * indicator_fn A x`; `\x:A. d:real`] MEASURABLE_WRT_ADD)) THEN + ASM_SIMP_TAC[MEASURABLE_WRT_CONST]);; + +(* An affine multiple of an indicator times an integrable X is integrable. *) +let INTEGRABLE_AFFINE_IND_MUL = prove + (`!p:A prob_space A X c d. + integrable p X /\ A IN prob_events p + ==> integrable p (\w. (c * indicator_fn A w + d) * X w)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(\w:A. (c * indicator_fn A w + d) * X w) = + (\w. c * (X w * indicator_fn A w) + d * X w)` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC INTEGRABLE_ADD THEN CONJ_TAC THEN MATCH_MP_TAC INTEGRABLE_CMUL THEN + ASM_SIMP_TAC[INTEGRABLE_MUL_INDICATOR_FN]);; + +(* The expectation of the affine multiplier times Z times an indicator splits *) +(* into the two pieces over the intersection and over the test set. *) +let EXP_AFFINE_DECOMP = prove + (`!p:A prob_space Z A A' c d. + integrable p Z /\ A IN prob_events p /\ A' IN prob_events p + ==> expectation p (\x. ((c * indicator_fn A x + d) * Z x) * indicator_fn A' x) = + c * expectation p (\x. Z x * indicator_fn (A INTER A') x) + + d * expectation p (\x. Z x * indicator_fn A' x)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `integrable p (\x:A. Z x * indicator_fn (A INTER A') x) /\ + integrable p (\x:A. Z x * indicator_fn A' x)` STRIP_ASSUME_TAC THENL + [CONJ_TAC THEN MATCH_MP_TAC INTEGRABLE_MUL_INDICATOR_FN THEN + ASM_SIMP_TAC[PROB_INTER_IN_EVENTS]; ALL_TAC] THEN + SUBGOAL_THEN + `(\x:A. ((c * indicator_fn A x + d) * Z x) * indicator_fn A' x) = + (\x. c * (Z x * indicator_fn (A INTER A') x) + d * (Z x * indicator_fn A' x))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; INDICATOR_FN_INTER] THEN REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPECL [`p:A prob_space`; + `\x:A. c * (Z x * indicator_fn (A INTER A') x)`; + `\x:A. d * (Z x * indicator_fn A' x)`] EXPECTATION_ADD) THEN + ASM_SIMP_TAC[INTEGRABLE_CMUL] THEN BETA_TAC THEN + DISCH_THEN SUBST1_TAC THEN + ASM_SIMP_TAC[EXPECTATION_CMUL]);; + +(* Take-out of an affine G-measurable factor. *) +let GEN_COND_EXP_TAKE_OUT_AFFINE = prove + (`!p:A prob_space G X A c d. + sub_sigma_algebra p G /\ A IN G /\ integrable p X + ==> almost_surely p + {x | gen_cond_exp p G (\w. (c * indicator_fn A w + d) * X w) x = + (c * indicator_fn A x + d) * gen_cond_exp p G X x}`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(A:A->bool) IN prob_events p` ASSUME_TAC THENL + [ASM_MESON_TAC[SUB_SIGMA_ALGEBRA_IN_EVENTS]; ALL_TAC] THEN + SUBGOAL_THEN `integrable p (\w:A. (c * indicator_fn A w + d) * X w)` ASSUME_TAC THENL + [ASM_SIMP_TAC[INTEGRABLE_AFFINE_IND_MUL]; ALL_TAC] THEN + SUBGOAL_THEN + `measurable_wrt p G (\x:A. (c * indicator_fn A x + d) * gen_cond_exp p G X x)` + ASSUME_TAC THENL + [MP_TAC(BETA_RULE(ISPECL [`p:A prob_space`; `G:(A->bool)->bool`; + `\x:A. c * indicator_fn A x + d`; `gen_cond_exp p G (X:A->real)`] + MEASURABLE_WRT_MUL)) THEN + ASM_SIMP_TAC[MWRT_AFFINE; GEN_COND_EXP_MEASURABLE_WRT]; ALL_TAC] THEN + SUBGOAL_THEN + `integrable p (\x:A. (c * indicator_fn A x + d) * gen_cond_exp p G X x)` + ASSUME_TAC THENL + [MP_TAC(ISPECL [`p:A prob_space`; `A:A->bool`; `gen_cond_exp p G (X:A->real)`; + `c:real`; `d:real`] INTEGRABLE_AFFINE_IND_MUL) THEN + ASM_SIMP_TAC[GEN_COND_EXP_INTEGRABLE]; ALL_TAC] THEN + MATCH_MP_TAC GEN_COND_EXP_AE_UNIQUE THEN EXISTS_TAC `G:(A->bool)->bool` THEN + ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[ETA_AX] THEN ASM_SIMP_TAC[GEN_COND_EXP_MEASURABLE_WRT]; + REWRITE_TAC[ETA_AX] THEN ASM_SIMP_TAC[GEN_COND_EXP_INTEGRABLE]; + ALL_TAC] THEN + X_GEN_TAC `A':A->bool` THEN DISCH_TAC THEN + SUBGOAL_THEN `(A':A->bool) IN prob_events p /\ A INTER A' IN G /\ A INTER A' IN prob_events p` + STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[SUB_SIGMA_ALGEBRA_IN_EVENTS; SIGMA_ALGEBRA_INTER; + sub_sigma_algebra]; ALL_TAC] THEN + MP_TAC(ISPECL [`p:A prob_space`; `G:(A->bool)->bool`; + `\w:A. (c * indicator_fn A w + d) * X w`; `A':A->bool`] GEN_COND_EXP_CONDITIONING) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + ASM_SIMP_TAC[EXP_AFFINE_DECOMP; GEN_COND_EXP_INTEGRABLE] THEN + MP_TAC(ISPECL [`p:A prob_space`; `gen_cond_exp p G (X:A->real)`; + `A:A->bool`; `A':A->bool`; `c:real`; `d:real`] EXP_AFFINE_DECOMP) THEN + ASM_SIMP_TAC[GEN_COND_EXP_INTEGRABLE] THEN DISCH_THEN SUBST1_TAC THEN + BINOP_TAC THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV THEN + MATCH_MP_TAC GEN_COND_EXP_CONDITIONING THEN ASM_REWRITE_TAC[]);; + +(* Integrability of h*g when h is integrable and g is bounded *) +let INTEGRABLE_MUL_BOUNDED = prove + (`!p:A prob_space (h:A->real) (g:A->real) K. + integrable p h /\ random_variable p g /\ &0 <= K /\ + (!x. x IN prob_carrier p ==> abs(g x) <= K) + ==> integrable p (\x. h x * g x)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC INTEGRABLE_DOMINATED THEN + EXISTS_TAC `\x:A. K * abs(h x)` THEN BETA_TAC THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC RANDOM_VARIABLE_MUL THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC INTEGRABLE_IMP_RANDOM_VARIABLE THEN ASM_REWRITE_TAC[]; + SUBGOAL_THEN `(\x:A. K * abs(h x)) = (\x. K * (\y. abs(h y)) x)` + SUBST1_TAC THENL + [REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC INTEGRABLE_CMUL_ALT THEN + MATCH_MP_TAC INTEGRABLE_ABS THEN ASM_REWRITE_TAC[]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_ABS] THEN + SUBGOAL_THEN `abs K = K` SUBST1_TAC THENL + [REWRITE_TAC[real_abs] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `K * abs((h:A->real) x) = abs(h x) * K` SUBST1_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN + ASM_SIMP_TAC[]]);; + +(* Taking out a SIMPLE G-measurable multiplier from gen_cond_exp: *) +(* E[Y*X | G] = Y * E[X|G] a.s., for Y simple and G-measurable. *) +(* Decompose Y over its finite range (SIMPLE_RV_SUM_INDICATOR) and verify the *) +(* defining integral test level-set by level-set (EXP_SIMPLE_MUL_DECOMP + *) +(* GEN_COND_EXP_CONDITIONING). *) +let GEN_COND_EXP_TAKE_OUT_SIMPLE = prove + (`!p:A prob_space G Y X. + sub_sigma_algebra p G /\ integrable p X /\ + measurable_wrt p G Y /\ simple_rv p Y /\ + integrable p (\w. Y w * X w) + ==> almost_surely p + {x | gen_cond_exp p G (\w. Y w * X w) x = + Y x * gen_cond_exp p G X x}`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `Y:A->real`] SIMPLE_RV_ABS_BOUNDED) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(X_CHOOSE_TAC `M:real`) THEN + SUBGOAL_THEN + `measurable_wrt p G (\x:A. Y x * gen_cond_exp p G (X:A->real) x)` + ASSUME_TAC THENL + [MP_TAC(BETA_RULE(ISPECL [`p:A prob_space`; `G:(A->bool)->bool`; + `Y:A->real`; `gen_cond_exp p G (X:A->real)`] MEASURABLE_WRT_MUL)) THEN + ASM_SIMP_TAC[GEN_COND_EXP_MEASURABLE_WRT]; ALL_TAC] THEN + SUBGOAL_THEN + `integrable p (\x:A. Y x * gen_cond_exp p G (X:A->real) x)` + ASSUME_TAC THENL + [SUBGOAL_THEN `&0 <= M` ASSUME_TAC THENL + [MP_TAC(ISPEC `p:A prob_space` PROB_CARRIER_NONEMPTY) THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN + DISCH_THEN(X_CHOOSE_TAC `a:A`) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `a:A`) THEN ASM_REWRITE_TAC[] THEN + REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `(\x:A. Y x * gen_cond_exp p G (X:A->real) x) = + (\x:A. gen_cond_exp p G (X:A->real) x * Y x)` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPECL [`p:A prob_space`; `gen_cond_exp p G (X:A->real)`; `Y:A->real`; + `M:real`] INTEGRABLE_MUL_BOUNDED) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC GEN_COND_EXP_INTEGRABLE THEN ASM_REWRITE_TAC[]; + ASM_MESON_TAC[simple_rv]]; + REWRITE_TAC[]]; ALL_TAC] THEN + MATCH_MP_TAC GEN_COND_EXP_AE_UNIQUE THEN EXISTS_TAC `G:(A->bool)->bool` THEN + ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[ETA_AX] THEN ASM_SIMP_TAC[GEN_COND_EXP_MEASURABLE_WRT]; + REWRITE_TAC[ETA_AX] THEN ASM_SIMP_TAC[GEN_COND_EXP_INTEGRABLE]; + ALL_TAC] THEN + X_GEN_TAC `A':A->bool` THEN DISCH_TAC THEN + SUBGOAL_THEN `(A':A->bool) IN prob_events p` ASSUME_TAC THENL + [ASM_MESON_TAC[SUB_SIGMA_ALGEBRA_IN_EVENTS]; ALL_TAC] THEN + MP_TAC(ISPECL [`p:A prob_space`; `G:(A->bool)->bool`; + `(\w. Y w * X w):A->real`; `A':A->bool`] GEN_COND_EXP_CONDITIONING) THEN + ASM_REWRITE_TAC[] THEN BETA_TAC THEN DISCH_THEN SUBST1_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `Y:A->real`; `X:A->real`; `A':A->bool`] + EXP_SIMPLE_MUL_DECOMP) THEN ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `Y:A->real`; `gen_cond_exp p G (X:A->real)`; + `A':A->bool`] EXP_SIMPLE_MUL_DECOMP) THEN + ASM_SIMP_TAC[GEN_COND_EXP_INTEGRABLE] THEN DISCH_THEN SUBST1_TAC THEN + MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `u:real` THEN DISCH_TAC THEN BETA_TAC THEN + AP_TERM_TAC THEN + SUBGOAL_THEN `{z:A | z IN prob_carrier p /\ (Y:A->real) z = u} INTER A' IN G` + ASSUME_TAC THENL + [MATCH_MP_TAC SIGMA_ALGEBRA_INTER THEN + CONJ_TAC THENL [ASM_MESON_TAC[sub_sigma_algebra]; ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_WRT_LEVEL_SET THEN ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + MP_TAC(ISPECL [`p:A prob_space`; `G:(A->bool)->bool`; `X:A->real`; + `{z:A | z IN prob_carrier p /\ (Y:A->real) z = u} INTER A'`] + GEN_COND_EXP_CONDITIONING) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN REFL_TAC);; + +(* ------------------------------------------------------------------ *) +(* Dyadic approximation of a bounded measurable function. These give *) +(* a sequence of simple, G-measurable functions Yn converging to Y *) +(* everywhere with abs(Yn) bounded by abs(Y)+1, used to lift the *) +(* simple-multiplier take-out to bounded measurable multipliers. *) +(* ------------------------------------------------------------------ *) + +let DYADIC_APPROX_BOUND = prove + (`!n y:real. abs(floor(&2 pow n * y) / &2 pow n - y) <= inv(&2 pow n)`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `&0 < &2 pow n` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_POW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(SPEC `&2 pow n * y` FLOOR) THEN STRIP_TAC THEN + SUBGOAL_THEN + `floor(&2 pow n * y) / &2 pow n - y = + (floor(&2 pow n * y) - &2 pow n * y) * inv(&2 pow n)` SUBST1_TAC THENL + [ASM_SIMP_TAC[REAL_FIELD `&0 < a ==> (f/a - y = (f - a*y)*inv a)`]; ALL_TAC] THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_INV] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < a ==> abs a = a`] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN + ASM_SIMP_TAC[REAL_LE_INV_EQ; REAL_LT_IMP_LE] THEN + ASM_REAL_ARITH_TAC);; + +let DYADIC_LEVEL = prove + (`!n y v:real. floor(&2 pow n * y) / &2 pow n <= v <=> + y < (floor(&2 pow n * v) + &1) / &2 pow n`, + REPEAT GEN_TAC THEN + SUBGOAL_THEN `&0 < &2 pow n` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_POW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `integer(floor(&2 pow n * v))` ASSUME_TAC THENL + [MESON_TAC[FLOOR]; ALL_TAC] THEN + SUBGOAL_THEN `integer(floor(&2 pow n * y))` ASSUME_TAC THENL + [MESON_TAC[FLOOR]; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LT_RDIV_EQ] THEN + SUBGOAL_THEN `v * &2 pow n = &2 pow n * v` SUBST1_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `y * &2 pow n = &2 pow n * y` SUBST1_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPECL [`&2 pow n * v`; `floor(&2 pow n * y)`] REAL_LE_FLOOR) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + MP_TAC(ISPECL [`&2 pow n * y`; `floor(&2 pow n * v)`] REAL_FLOOR_LE) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN REAL_ARITH_TAC);; + +let DYADIC_MEASURABLE = prove + (`!p:A prob_space G Y n. + sub_sigma_algebra p G /\ measurable_wrt p G Y + ==> measurable_wrt p G (\x. floor(&2 pow n * Y x) / &2 pow n)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[measurable_wrt] THEN X_GEN_TAC `v:real` THEN + BETA_TAC THEN + SUBGOAL_THEN + `{x:A | x IN prob_carrier p /\ floor(&2 pow n * Y x) / &2 pow n <= v} = + {x | x IN prob_carrier p /\ Y x < (floor(&2 pow n * v) + &1) / &2 pow n}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN GEN_TAC THEN + REWRITE_TAC[DYADIC_LEVEL]; ALL_TAC] THEN + MP_TAC(ISPECL [`p:A prob_space`; `G:(A->bool)->bool`; `Y:A->real`; + `(floor(&2 pow n * v) + &1) / &2 pow n`] MEASURABLE_WRT_STRICT_LT) THEN + ASM_REWRITE_TAC[]);; + +let DYADIC_SIMPLE = prove + (`!p:A prob_space G Y n K. + sub_sigma_algebra p G /\ measurable_wrt p G Y /\ + (!x. x IN prob_carrier p ==> abs(Y x) <= K) + ==> simple_rv p (\x. floor(&2 pow n * Y x) / &2 pow n)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[simple_rv] THEN CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_WRT_IMP_RV THEN + EXISTS_TAC `G:(A->bool)->bool` THEN ASM_SIMP_TAC[DYADIC_MEASURABLE]; + ALL_TAC] THEN + MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `IMAGE (\m:real. m / &2 pow n) + {m | integer m /\ --(&2 pow n * K + &1) <= m /\ m <= &2 pow n * K + &1}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC FINITE_IMAGE THEN REWRITE_TAC[FINITE_INTSEG]; ALL_TAC] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_IMAGE] THEN + X_GEN_TAC `r:real` THEN + DISCH_THEN(X_CHOOSE_THEN `x:A` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `floor(&2 pow n * (Y:A->real) x)` THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `&0 < &2 pow n` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_POW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[CONJUNCT1(SPEC_ALL FLOOR)] THEN + MP_TAC(SPEC `&2 pow n * (Y:A->real) x` FLOOR) THEN STRIP_TAC THEN + SUBGOAL_THEN `abs(&2 pow n * (Y:A->real) x) <= &2 pow n * K` MP_TAC THENL + [REWRITE_TAC[REAL_ABS_MUL] THEN + ASM_SIMP_TAC[REAL_ARITH `&0 < a ==> abs a = a`] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN ASM_SIMP_TAC[REAL_LT_IMP_LE]; + ASM_REAL_ARITH_TAC]);; + +let DYADIC_CONV = prove + (`!Y:A->real x. ((\n. floor(&2 pow n * Y x) / &2 pow n) ---> Y x) sequentially`, + REPEAT GEN_TAC THEN ONCE_REWRITE_TAC[REALLIM_NULL] THEN + MATCH_MP_TAC REALLIM_NULL_COMPARISON THEN + EXISTS_TAC `\n. inv(&2 pow n)` THEN CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `0` THEN + REPEAT STRIP_TAC THEN BETA_TAC THEN REWRITE_TAC[DYADIC_APPROX_BOUND]; + REWRITE_TAC[REAL_INV_POW] THEN MATCH_MP_TAC REALLIM_POWN THEN + REWRITE_TAC[REAL_ABS_INV] THEN REAL_ARITH_TAC]);; + +let DYADIC_BOUND = prove + (`!Y:A->real x K n. abs(Y x) <= K + ==> abs(floor(&2 pow n * Y x) / &2 pow n) <= K + &1`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`n:num`; `(Y:A->real) x`] DYADIC_APPROX_BOUND) THEN + SUBGOAL_THEN `inv(&2 pow n) <= &1` MP_TAC THENL + [MATCH_MP_TAC REAL_INV_LE_1 THEN + MATCH_MP_TAC REAL_POW_LE_1 THEN REAL_ARITH_TAC; + ASM_REAL_ARITH_TAC]);; + +(* Take-out of a bounded G-measurable multiplier: for measurable_wrt p G Y *) +(* with abs(Y) bounded, E[Y * X | G] = Y * E[X | G] a.s. Proved by dyadic *) +(* approximation, the simple-multiplier take-out per level, and conditional *) +(* dominated convergence (the dominator is (K+1)*abs(X)). *) +let GEN_COND_EXP_TAKE_OUT_BOUNDED = prove + (`!p:A prob_space G Y X K. + sub_sigma_algebra p G /\ integrable p X /\ + measurable_wrt p G Y /\ (!x. x IN prob_carrier p ==> abs(Y x) <= K) + ==> almost_surely p + {x | gen_cond_exp p G (\w. Y w * X w) x = + Y x * gen_cond_exp p G X x}`, + REPEAT STRIP_TAC THEN + ABBREV_TAC `Yn = \n:num. \x:A. floor(&2 pow n * Y x) / &2 pow n` THEN + SUBGOAL_THEN `integrable p (\x:A. (K + &1) * abs(X x))` ASSUME_TAC THENL + [MATCH_MP_TAC INTEGRABLE_CMUL_ALT THEN MATCH_MP_TAC INTEGRABLE_ABS THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `&0 <= K` ASSUME_TAC THENL + [MP_TAC(ISPEC `p:A prob_space` PROB_CARRIER_NONEMPTY) THEN + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN DISCH_THEN(X_CHOOSE_TAC `a:A`) THEN + FIRST_X_ASSUM(MP_TAC o SPEC `a:A`) THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `integrable p (\w:A. Y w * X w)` ASSUME_TAC THENL + [ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + MP_TAC(ISPECL [`p:A prob_space`; `X:A->real`; `Y:A->real`; `K:real`] + INTEGRABLE_MUL_BOUNDED) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN MATCH_MP_TAC MEASURABLE_WRT_IMP_RV THEN + EXISTS_TAC `G:(A->bool)->bool` THEN ASM_REWRITE_TAC[]; REWRITE_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN `!n. integrable p (\w:A. (Yn:num->A->real) n w * X w)` + ASSUME_TAC THENL + [GEN_TAC THEN ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN + MP_TAC(ISPECL [`p:A prob_space`; `X:A->real`; `(Yn:num->A->real) n`; `K + &1`] + INTEGRABLE_MUL_BOUNDED) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_WRT_IMP_RV THEN EXISTS_TAC `G:(A->bool)->bool` THEN + EXPAND_TAC "Yn" THEN BETA_TAC THEN ASM_SIMP_TAC[DYADIC_MEASURABLE]; + ASM_REAL_ARITH_TAC; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN EXPAND_TAC "Yn" THEN BETA_TAC THEN + MATCH_MP_TAC DYADIC_BOUND THEN ASM_SIMP_TAC[]]; + REWRITE_TAC[]]; ALL_TAC] THEN + SUBGOAL_THEN + `!n. almost_surely p + {x:A | gen_cond_exp p G (\w. (Yn:num->A->real) n w * X w) x = + Yn n x * gen_cond_exp p G X x}` + ASSUME_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC GEN_COND_EXP_TAKE_OUT_SIMPLE THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [EXPAND_TAC "Yn" THEN BETA_TAC THEN ASM_SIMP_TAC[DYADIC_MEASURABLE]; + EXPAND_TAC "Yn" THEN BETA_TAC THEN MATCH_MP_TAC DYADIC_SIMPLE THEN + MAP_EVERY EXISTS_TAC [`G:(A->bool)->bool`; `K:real`] THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN + `almost_surely p + {x:A | ((\n. gen_cond_exp p G (\w. (Yn:num->A->real) n w * X w) x) ---> + gen_cond_exp p G (\w. Y w * X w) x) sequentially}` + ASSUME_TAC THENL + [MP_TAC(ISPECL [`p:A prob_space`; `G:(A->bool)->bool`; + `(\n:num. \w:A. (Yn:num->A->real) n w * X w)`; + `(\w:A. (Y:A->real) w * X w)`; `(\x:A. (K + &1) * abs((X:A->real) x))`] + GEN_COND_EXP_DCT) THEN + BETA_TAC THEN ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + REPEAT CONJ_TAC THENL + [MAP_EVERY X_GEN_TAC [`n:num`;`x:A`] THEN DISCH_TAC THEN + REWRITE_TAC[REAL_ABS_MUL] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN + EXPAND_TAC "Yn" THEN BETA_TAC THEN + MATCH_MP_TAC DYADIC_BOUND THEN ASM_SIMP_TAC[]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN REWRITE_TAC[REAL_ABS_MUL] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:A`) THEN ASM_REWRITE_TAC[] THEN + REAL_ARITH_TAC; + MATCH_MP_TAC ALMOST_SURELY_SUBSET THEN + EXISTS_TAC `prob_carrier (p:A prob_space)` THEN + REWRITE_TAC[ALMOST_SURELY_CARRIER] THEN + X_GEN_TAC `x:A` THEN DISCH_TAC THEN DISCH_TAC THEN + REWRITE_TAC[IN_ELIM_THM] THEN + MATCH_MP_TAC REALLIM_MUL THEN REWRITE_TAC[REALLIM_CONST] THEN + EXPAND_TAC "Yn" THEN BETA_TAC THEN REWRITE_TAC[DYADIC_CONV]]; + ALL_TAC] THEN + MATCH_MP_TAC ALMOST_SURELY_SUBSET THEN + EXISTS_TAC + `(prob_carrier (p:A prob_space)) INTER + (INTERS {{x:A | gen_cond_exp p G (\w. (Yn:num->A->real) n w * X w) x = + Yn n x * gen_cond_exp p G X x} | n IN (:num)}) INTER + {x:A | ((\n. gen_cond_exp p G (\w. (Yn:num->A->real) n w * X w) x) ---> + gen_cond_exp p G (\w. Y w * X w) x) sequentially}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC ALMOST_SURELY_INTER THEN CONJ_TAC THENL + [REWRITE_TAC[ALMOST_SURELY_CARRIER]; + MATCH_MP_TAC ALMOST_SURELY_INTER THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC ALMOST_SURELY_COUNTABLE_INTER THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + REWRITE_TAC[IN_INTER; IN_INTERS; IN_ELIM_THM; FORALL_IN_GSPEC; IN_UNIV] THEN + STRIP_TAC THEN + MATCH_MP_TAC (ISPECL [`sequentially`; + `\n:num. (Yn:num->A->real) n x * gen_cond_exp p G X x`; + `gen_cond_exp p G (\w. (Y:A->real) w * X w) x`; + `(Y:A->real) x * gen_cond_exp p G X x`] REALLIM_UNIQUE) THEN + REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN CONJ_TAC THENL + [SUBGOAL_THEN + `(\n. (Yn:num->A->real) n x * gen_cond_exp p G X x) = + (\n. gen_cond_exp p G (\w. Yn n w * X w) x)` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN + ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC REALLIM_MUL THEN REWRITE_TAC[REALLIM_CONST] THEN + EXPAND_TAC "Yn" THEN BETA_TAC THEN REWRITE_TAC[DYADIC_CONV]]);; + +(* ------------------------------------------------------------------ *) +(* Conditional Cauchy-Schwarz inequality. *) +(* *) +(* The proof is the discriminant argument done conditionally: for each *) +(* rational q, E[(X - qY)^2|G] >= 0 a.s., which expands by linearity to *) +(* a nonneg quadratic in q. On the conull set where this holds for all *) +(* rationals (a countable intersection), density and the discriminant *) +(* test give E[XY|G]^2 <= E[X^2|G]*E[Y^2|G]. *) +(* ------------------------------------------------------------------ *) + +(* Nonneg quadratic (all real t) ==> discriminant <= 0. *) +let DISCRIMINANT_NONNEG = prove + (`!a b c:real. &0 <= a /\ (!t. &0 <= a * t pow 2 - &2 * b * t + c) + ==> b pow 2 <= a * c`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + ASM_CASES_TAC `a = &0` THENL + [FIRST_X_ASSUM SUBST_ALL_TAC THEN + RULE_ASSUM_TAC(REWRITE_RULE[REAL_MUL_LZERO; REAL_ADD_LID]) THEN + SUBGOAL_THEN `b = &0` SUBST_ALL_TAC THENL + [ASM_CASES_TAC `b = &0` THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `(c + &1) / (&2 * b)`) THEN + ASM_SIMP_TAC[REAL_FIELD `~(b = &0) ==> &2 * b * (c + &1)/(&2 * b) = c + &1`] THEN + REAL_ARITH_TAC; + REWRITE_TAC[] THEN REAL_ARITH_TAC]; + SUBGOAL_THEN `&0 < a` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `b / a:real`) THEN + ASM_SIMP_TAC[REAL_FIELD + `&0 < a ==> a * (b/a) pow 2 - &2 * b * (b/a) + c = c - b pow 2 / a`] THEN + DISCH_TAC THEN + SUBGOAL_THEN `b pow 2 / a <= c` MP_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ] THEN REAL_ARITH_TAC]);; + +(* Nonneg quadratic on the rationals ==> nonneg everywhere (density). *) +let RATIONAL_DISCRIMINANT_DENSITY = prove + (`!A B C:real. (!q. rational q ==> &0 <= A * q pow 2 - &2 * B * q + C) + ==> (!t. &0 <= A * t pow 2 - &2 * B * t + C)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `?r:num->real. !n. rational(r n) /\ abs(r n - t) < inv(&n + &1)` + (X_CHOOSE_THEN `r:num->real` STRIP_ASSUME_TAC) THENL + [REWRITE_TAC[GSYM SKOLEM_THM] THEN GEN_TAC THEN + MATCH_MP_TAC RATIONAL_APPROXIMATION THEN + MATCH_MP_TAC REAL_LT_INV THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `((r:num->real) ---> t) sequentially` ASSUME_TAC THENL + [REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(SPEC `e:real` REAL_ARCH_INV) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `N:num` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN STRIP_TAC THEN + MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `inv(&n + &1)` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `inv(&N)` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INV2 THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_LT] THEN ASM_ARITH_TAC; + REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE] THEN ASM_ARITH_TAC]; + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN + `((\n. A * (r:num->real) n pow 2 - &2 * B * r n + C) ---> + (A * t pow 2 - &2 * B * t + C)) sequentially` ASSUME_TAC THENL + [MATCH_MP_TAC REALLIM_ADD THEN REWRITE_TAC[REALLIM_CONST] THEN + MATCH_MP_TAC REALLIM_SUB THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_POW_2] THEN MATCH_MP_TAC REALLIM_LMUL THEN + MATCH_MP_TAC REALLIM_MUL THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[GSYM REAL_MUL_ASSOC] THEN MATCH_MP_TAC REALLIM_LMUL THEN + MATCH_MP_TAC REALLIM_LMUL THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + MP_TAC(ISPECL + [`sequentially`; + `\n. A * (r:num->real) n pow 2 - &2 * B * r n + C`; + `A * t pow 2 - &2 * B * t + C`; `&0:real`] REALLIM_LBOUND) THEN + ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN DISCH_THEN MATCH_MP_TAC THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `0` THEN + REPEAT STRIP_TAC THEN BETA_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[]);; + +(* Combined: nonneg on rationals + a >= 0 ==> discriminant <= 0. *) +let RATIONAL_DISCRIMINANT = prove + (`!A B C:real. &0 <= A /\ + (!q. rational q ==> &0 <= A * q pow 2 - &2 * B * q + C) + ==> B pow 2 <= A * C`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC DISCRIMINANT_NONNEG THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC RATIONAL_DISCRIMINANT_DENSITY THEN + ASM_REWRITE_TAC[]);; + +(* Conditional expectation of an affine combination f - c*g + d*h. *) +let GEN_COND_EXP_LINEAR3 = prove + (`!p:A prob_space G f g h c d. + sub_sigma_algebra p G /\ integrable p f /\ integrable p g /\ integrable p h + ==> almost_surely p + {x | gen_cond_exp p G (\w. f w - c * g w + d * h w) x = + gen_cond_exp p G f x - c * gen_cond_exp p G g x + + d * gen_cond_exp p G h x}`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `integrable p (\w:A. c * g w)` ASSUME_TAC THENL + [MATCH_MP_TAC INTEGRABLE_CMUL THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `integrable p (\w:A. d * h w)` ASSUME_TAC THENL + [MATCH_MP_TAC INTEGRABLE_CMUL THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `integrable p (\w:A. f w - c * g w)` ASSUME_TAC THENL + [MATCH_MP_TAC INTEGRABLE_SUB THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MP_TAC(BETA_RULE(ISPECL [`p:A prob_space`; `G:(A->bool)->bool`; + `(\u:A. (f:A->real) u - (c:real) * (g:A->real) u)`; + `(\u:A. (d:real) * (h:A->real) u)`] GEN_COND_EXP_ADD)) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `G:(A->bool)->bool`; + `f:A->real`; `(\u:A. (c:real) * (g:A->real) u)`] GEN_COND_EXP_SUB) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `G:(A->bool)->bool`; + `g:A->real`; `c:real`] GEN_COND_EXP_CMUL) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `G:(A->bool)->bool`; + `h:A->real`; `d:real`] GEN_COND_EXP_CMUL) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; + `{x:A | gen_cond_exp p G (\w. f w - c * g w + d * h w) x = + gen_cond_exp p G (\u:A. f u - c * g u) x + + gen_cond_exp p G (\u:A. d * h u) x}`; + `{x:A | gen_cond_exp p G (\w. f w - c * g w) x = + gen_cond_exp p G f x - gen_cond_exp p G (\u:A. c * g u) x}`] + ALMOST_SURELY_INTER) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; + `{x:A | gen_cond_exp p G (\w. c * g w) x = c * gen_cond_exp p G g x}`; + `{x:A | gen_cond_exp p G (\w. d * h w) x = d * gen_cond_exp p G h x}`] + ALMOST_SURELY_INTER) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MATCH_MP_TAC ALMOST_SURELY_SUBSET THEN + EXISTS_TAC + `({x:A | gen_cond_exp p G (\w. f w - c * g w + d * h w) x = + gen_cond_exp p G (\u:A. f u - c * g u) x + + gen_cond_exp p G (\u:A. d * h u) x} INTER + {x:A | gen_cond_exp p G (\w. f w - c * g w) x = + gen_cond_exp p G f x - gen_cond_exp p G (\u:A. c * g u) x}) INTER + ({x:A | gen_cond_exp p G (\w. c * g w) x = c * gen_cond_exp p G g x} INTER + {x:A | gen_cond_exp p G (\w. d * h w) x = d * gen_cond_exp p G h x})` THEN + REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN CONJ_TAC THENL + [MATCH_MP_TAC ALMOST_SURELY_INTER THEN ASM_REWRITE_TAC[]; + GEN_TAC THEN DISCH_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + REAL_ARITH_TAC]);; + +let GEN_COND_EXP_CAUCHY_SCHWARZ = prove + (`!p:A prob_space G X Y. + sub_sigma_algebra p G /\ + integrable p (\x. X x pow 2) /\ integrable p (\x. Y x pow 2) /\ + integrable p (\x. X x * Y x) + ==> almost_surely p + {x | gen_cond_exp p G (\w. X w * Y w) x pow 2 <= + gen_cond_exp p G (\w. X w pow 2) x * + gen_cond_exp p G (\w. Y w pow 2) x}`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `!q. almost_surely p + {x:A | &0 <= gen_cond_exp p G (\w. X w pow 2) x - + &2 * q * gen_cond_exp p G (\w. X w * Y w) x + + q pow 2 * gen_cond_exp p G (\w. Y w pow 2) x}` + ASSUME_TAC THENL + [GEN_TAC THEN + SUBGOAL_THEN `integrable p (\w:A. (X w - q * Y w) pow 2)` ASSUME_TAC THENL + [SUBGOAL_THEN + `(\w:A. (X w - q * Y w) pow 2) = + (\w. (\w. X w pow 2) w - (\w. (&2 * q) * (\w. X w * Y w) w) w + + (\w. (q pow 2) * (\w. Y w pow 2) w) w)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN BETA_TAC THEN CONV_TAC REAL_RING; + ALL_TAC] THEN + MATCH_MP_TAC INTEGRABLE_ADD THEN CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_SUB THEN BETA_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC INTEGRABLE_CMUL THEN ASM_REWRITE_TAC[]; + BETA_TAC THEN MATCH_MP_TAC INTEGRABLE_CMUL THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + MP_TAC(ISPECL [`p:A prob_space`; `G:(A->bool)->bool`; + `(\w:A. ((X:A->real) w - q * (Y:A->real) w) pow 2)`] + GEN_COND_EXP_NONNEG) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_LE_POW_2]; ALL_TAC] THEN + DISCH_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `G:(A->bool)->bool`; + `(\w:A. (X:A->real) w pow 2)`; `(\w:A. (X:A->real) w * (Y:A->real) w)`; + `(\w:A. (Y:A->real) w pow 2)`; `(&2 * q)`; `(q:real) pow 2`] + GEN_COND_EXP_LINEAR3) THEN + ASM_REWRITE_TAC[] THEN BETA_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN + `(\w:A. ((X:A->real) w - q * (Y:A->real) w) pow 2) = + (\w. X w pow 2 - (&2 * q) * X w * Y w + q pow 2 * Y w pow 2)` + ASSUME_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN CONV_TAC REAL_RING; ALL_TAC] THEN + RULE_ASSUM_TAC(REWRITE_RULE[ASSUME + `(\w:A. ((X:A->real) w - q * (Y:A->real) w) pow 2) = + (\w. X w pow 2 - (&2 * q) * X w * Y w + q pow 2 * Y w pow 2)`]) THEN + MP_TAC(ISPECL [`p:A prob_space`; + `{x:A | &0 <= gen_cond_exp p G + (\w. (X:A->real) w pow 2 - (&2 * q) * X w * Y w + q pow 2 * Y w pow 2) x}`; + `{x:A | gen_cond_exp p G + (\w. (X:A->real) w pow 2 - (&2 * q) * X w * Y w + q pow 2 * Y w pow 2) x = + gen_cond_exp p G (\w. X w pow 2) x - + (&2 * q) * gen_cond_exp p G (\w. X w * Y w) x + + q pow 2 * gen_cond_exp p G (\w. Y w pow 2) x}`] + ALMOST_SURELY_INTER) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MATCH_MP_TAC ALMOST_SURELY_SUBSET THEN + FIRST_X_ASSUM(fun th -> EXISTS_TAC (rand(concl th)) THEN + CONJ_TAC THENL [ACCEPT_TAC th; ALL_TAC]) THEN + REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN + GEN_TAC THEN DISCH_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `almost_surely p {x:A | &0 <= gen_cond_exp p G (\w. Y w pow 2) x}` + ASSUME_TAC THENL + [MP_TAC(ISPECL [`p:A prob_space`; `G:(A->bool)->bool`; + `(\w:A. (Y:A->real) w pow 2)`] GEN_COND_EXP_NONNEG) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + REPEAT STRIP_TAC THEN REWRITE_TAC[REAL_LE_POW_2]; ALL_TAC] THEN + MP_TAC(ISPEC `rational` COUNTABLE_AS_IMAGE) THEN + REWRITE_TAC[COUNTABLE_RATIONAL] THEN ANTS_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `&0:real` THEN + REWRITE_TAC[IN] THEN MESON_TAC[RATIONAL_NUM]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_TAC `enum:num->real`) THEN + MP_TAC(ISPECL [`p:A prob_space`; + `\n. {x:A | &0 <= gen_cond_exp p G (\w. X w pow 2) x - + &2 * ((enum:num->real) n) * gen_cond_exp p G (\w. X w * Y w) x + + ((enum:num->real) n) pow 2 * gen_cond_exp p G (\w. Y w pow 2) x}`] + ALMOST_SURELY_COUNTABLE_INTER) THEN + ASM_SIMP_TAC[] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; + `{x:A | &0 <= gen_cond_exp p G (\w. Y w pow 2) x}`; + `INTERS {{x:A | &0 <= gen_cond_exp p G (\w. X w pow 2) x - + &2 * ((enum:num->real) n) * gen_cond_exp p G (\w. X w * Y w) x + + ((enum:num->real) n) pow 2 * gen_cond_exp p G (\w. Y w pow 2) x} | + n IN (:num)}`] + ALMOST_SURELY_INTER) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MATCH_MP_TAC ALMOST_SURELY_SUBSET THEN + EXISTS_TAC + `{x:A | &0 <= gen_cond_exp p G (\w. Y w pow 2) x} INTER + INTERS {{x:A | &0 <= gen_cond_exp p G (\w. X w pow 2) x - + &2 * ((enum:num->real) n) * gen_cond_exp p G (\w. X w * Y w) x + + ((enum:num->real) n) pow 2 * gen_cond_exp p G (\w. Y w pow 2) x} | + n IN (:num)}` THEN + CONJ_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + REWRITE_TAC[IN_INTER; IN_INTERS; IN_ELIM_THM; FORALL_IN_GSPEC; IN_UNIV] THEN + STRIP_TAC THEN GEN_REWRITE_TAC RAND_CONV [REAL_MUL_SYM] THEN + MATCH_MP_TAC RATIONAL_DISCRIMINANT THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + X_GEN_TAC `q:real` THEN DISCH_TAC THEN + SUBGOAL_THEN `?n. q = (enum:num->real) n` (X_CHOOSE_THEN `n:num` SUBST1_TAC) THENL + [SUBGOAL_THEN `(q:real) IN rational` MP_TAC THENL + [ASM_REWRITE_TAC[IN]; ALL_TAC] THEN + ASM_REWRITE_TAC[IN_IMAGE; IN_UNIV] THEN MESON_TAC[]; + FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN REAL_ARITH_TAC]]);; + +(* ------------------------------------------------------------------ *) +(* Conditional Jensen's inequality: f(E[X|G]) <= E[f(X)|G] a.s. for *) +(* convex f. Built from the supporting-line / affine-minorant *) +(* representation of a convex function on R. *) +(* ------------------------------------------------------------------ *) + +(* Three-slopes (secant monotonicity), multiplicative form. *) +let THREE_SLOPES = prove + (`!f:real->real. + (!a b x. a IN (:real) /\ b IN (:real) /\ x IN real_segment[a,b] + ==> (f x - f a) * abs(b - a) <= (f b - f a) * abs(x - a)) + ==> !u m v. u < m /\ m < v + ==> (f m - f u) * (v - m) <= (f v - f m) * (m - u)`, + REPEAT GEN_TAC THEN DISCH_TAC THEN REPEAT GEN_TAC THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`u:real`; `v:real`; `m:real`]) THEN + REWRITE_TAC[IN_UNIV; REAL_SEGMENT_INTERVAL] THEN + COND_CASES_TAC THENL [ALL_TAC; ASM_REAL_ARITH_TAC] THEN + REWRITE_TAC[IN_REAL_INTERVAL] THEN ANTS_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `abs(v - u) = v - u /\ abs(m - u) = m - u` + STRIP_ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(REAL_ARITH + `(fv - fu) * (m - u) - (fm - fu) * (v - u) = + (fv - fm) * (m - u) - (fm - fu) * (v - m) + ==> (fm - fu) * (v - u) <= (fv - fu) * (m - u) + ==> (fm - fu) * (v - m) <= (fv - fm) * (m - u)`) THEN + REAL_ARITH_TAC);; + +(* Supporting line for a convex function on R: at every point m there is a + slope s with f(m) + s*(y-m) <= f(y) for all y. Slope = right derivative, + built as the infimum of right-secant slopes. *) +let REAL_CONVEX_SUPPORTING_LINE = prove + (`!f:real->real. f real_convex_on (:real) + ==> !m. ?s. !y. f m + s * (y - m) <= f y`, + GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN + `!u m v. u < m /\ m < v + ==> (f m - f u) * (v - m) <= (f v - f m) * (m - u)` + ASSUME_TAC THENL + [MATCH_MP_TAC THREE_SLOPES THEN + ASM_REWRITE_TAC[GSYM REAL_CONVEX_ON_LEFT_SECANT_MUL]; ALL_TAC] THEN + GEN_TAC THEN + EXISTS_TAC `inf {((f:real->real) v - f m) / (v - m) | v | (m:real) < v}` THEN + SUBGOAL_THEN + `~({((f:real->real) v - f m) / (v - m) | v | (m:real) < v} = {})` + ASSUME_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM] THEN + MAP_EVERY EXISTS_TAC + [`((f:real->real)(m + &1) - f m) / ((m + &1) - m)`; `(m:real) + &1`] THEN + REWRITE_TAC[] THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `!z. z IN {((f:real->real) v - f m) / (v - m) | v | (m:real) < v} + ==> f m - f(m - &1) <= z` + ASSUME_TAC THENL + [REWRITE_TAC[IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `&0 < v - m` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ] THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`m - &1:real`; `m:real`; `v:real`]) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_ARITH `m - (m - &1) = &1`] THEN REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPEC `{((f:real->real) v - f m) / (v - m) | v | (m:real) < v}` INF) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [EXISTS_TAC `(f:real->real) m - f(m - &1)` THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + ABBREV_TAC `s = inf {((f:real->real) v - f m) / (v - m) | v | (m:real) < v}` THEN + STRIP_TAC THEN + X_GEN_TAC `y:real` THEN + REPEAT_TCL DISJ_CASES_THEN ASSUME_TAC (REAL_ARITH `y < m \/ y = m \/ m < y`) THENL + [SUBGOAL_THEN `(f m - f y) / (m - y) <= s` MP_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN X_GEN_TAC `z:real` THEN + REWRITE_TAC[IN_ELIM_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `v:real` STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `&0 < v - m /\ &0 < m - y` STRIP_ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `(f m - f y) * (v - m) <= (f v - f m) * (m - y)` MP_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPECL [`y:real`; `m:real`; `v:real`]) THEN + ANTS_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_TAC THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ; REAL_LE_RDIV_EQ] THEN + ASM_SIMP_TAC[REAL_FIELD `&0 < a ==> (x / a * b = x * b / a)`; + REAL_FIELD `&0 < a ==> (b * x / a = (b * x) / a)`] THEN + ASM_SIMP_TAC[REAL_LE_RDIV_EQ] THEN ASM_REAL_ARITH_TAC; + SUBGOAL_THEN `&0 < m - y` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_TAC THEN + SUBGOAL_THEN `f m - f y <= s * (m - y)` MP_TAC THENL + [ASM_SIMP_TAC[GSYM REAL_LE_LDIV_EQ]; ALL_TAC] THEN + REWRITE_TAC[REAL_SUB_LDISTRIB] THEN REAL_ARITH_TAC]; + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + SUBGOAL_THEN `s <= (f y - f m) / (y - m)` MP_TAC THENL + [FIRST_X_ASSUM MATCH_MP_TAC THEN REWRITE_TAC[IN_ELIM_THM] THEN + EXISTS_TAC `y:real` THEN ASM_REWRITE_TAC[]; + SUBGOAL_THEN `&0 < y - m` ASSUME_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + DISCH_TAC THEN + SUBGOAL_THEN `s * (y - m) <= f y - f m` MP_TAC THENL + [ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ]; ALL_TAC] THEN + REWRITE_TAC[REAL_SUB_LDISTRIB] THEN REAL_ARITH_TAC]]);; + +(* Slope function with both secant bounds (SKOLEMized supporting line). *) +let SUPPORTING_SLOPE = prove + (`!f:real->real. f real_convex_on (:real) + ==> ?sl. (!m y. f m + sl m * (y - m) <= f y) /\ + (!m. sl m <= f(m + &1) - f m) /\ + (!m. f m - f(m - &1) <= sl m)`, + REPEAT STRIP_TAC THEN + MP_TAC(MATCH_MP REAL_CONVEX_SUPPORTING_LINE (ASSUME `f real_convex_on (:real)`)) THEN + REWRITE_TAC[SKOLEM_THM] THEN + DISCH_THEN(X_CHOOSE_THEN `sl:real->real` ASSUME_TAC) THEN + EXISTS_TAC `sl:real->real` THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THEN GEN_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPECL [`m:real`; `m + &1:real`]) THEN REAL_ARITH_TAC; + FIRST_X_ASSUM(MP_TAC o SPECL [`m:real`; `m - &1:real`]) THEN REAL_ARITH_TAC]);; + +(* Continuity of a convex function at every real point. *) +let CONVEX_CONT_AT = prove + (`!f:real->real. f real_convex_on (:real) ==> !w. f real_continuous atreal w`, + GEN_TAC THEN DISCH_TAC THEN + MP_TAC(ISPECL [`f:real->real`; `(:real)`] + REAL_CONTINUOUS_ON_EQ_REAL_CONTINUOUS_AT) THEN + REWRITE_TAC[REAL_OPEN_UNIV; IN_UNIV] THEN DISCH_THEN(SUBST1_TAC o SYM) THEN + MATCH_MP_TAC REAL_CONVEX_ON_CONTINUOUS THEN ASM_REWRITE_TAC[REAL_OPEN_UNIV]);; + +(* Continuous function applied to a convergent sequence. *) +let CONTINUOUS_COMPOSE_SEQ = prove + (`!f z q:num->real. f real_continuous atreal z /\ (q ---> z) sequentially + ==> ((\n. f(q n)) ---> f z) sequentially`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC REALLIM_REAL_CONTINUOUS_FUNCTION THEN ASM_REWRITE_TAC[]);; + +(* abs is continuous; abs of a convergent sequence converges. *) +let ABS_CONT = prove + (`!L:real. abs real_continuous atreal L`, + GEN_TAC THEN + MP_TAC(ISPECL [`atreal L`; `\x:real. x`] REAL_CONTINUOUS_ABS) THEN + REWRITE_TAC[REAL_CONTINUOUS_AT_ID; ETA_AX]);; + +let ABS_LIM = prove + (`!a L. (a ---> L) sequentially ==> ((\n. abs(a n)) ---> abs L) sequentially`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`abs`; `sequentially`; `a:num->real`; `L:real`] + REALLIM_REAL_CONTINUOUS_FUNCTION) THEN + REWRITE_TAC[ABS_CONT] THEN ASM_REWRITE_TAC[]);; + +(* Affine-minorant representation: if every supporting-line value at rational + base points is <= C, then f z <= C. (Density of rationals + continuity.) *) +let CONVEX_AFFINE_MINORANT_SUP = prove + (`!f sl:real->real. f real_convex_on (:real) /\ + (!m. sl m <= f(m + &1) - f m) /\ (!m. f m - f(m - &1) <= sl m) + ==> !z C. (!q. rational q ==> f q + sl q * (z - q) <= C) ==> f z <= C`, + REPEAT GEN_TAC THEN STRIP_TAC THEN REPEAT GEN_TAC THEN DISCH_TAC THEN + SUBGOAL_THEN `!w:real. f real_continuous atreal w` ASSUME_TAC THENL + [MATCH_MP_TAC CONVEX_CONT_AT THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `?q:num->real. !n. rational(q n) /\ abs(q n - z) < inv(&n + &1)` + (X_CHOOSE_THEN `q:num->real` STRIP_ASSUME_TAC) THENL + [REWRITE_TAC[GSYM SKOLEM_THM] THEN GEN_TAC THEN + MATCH_MP_TAC RATIONAL_APPROXIMATION THEN + MATCH_MP_TAC REAL_LT_INV THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `((q:num->real) ---> z) sequentially` ASSUME_TAC THENL + [REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + MP_TAC(SPEC `e:real` REAL_ARCH_INV) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `N:num` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN STRIP_TAC THEN + MATCH_MP_TAC REAL_LT_TRANS THEN EXISTS_TAC `inv(&n + &1)` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `inv(&N)` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INV2 THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_OF_NUM_LT] THEN ASM_ARITH_TAC; + REWRITE_TAC[REAL_OF_NUM_ADD; REAL_OF_NUM_LE] THEN ASM_ARITH_TAC]; + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN `((\n. f((q:num->real) n)) ---> f z) sequentially` ASSUME_TAC THENL + [MATCH_MP_TAC CONTINUOUS_COMPOSE_SEQ THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `((\n. f((q:num->real) n + &1)) ---> f(z + &1)) sequentially` + ASSUME_TAC THENL + [MATCH_MP_TAC CONTINUOUS_COMPOSE_SEQ THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REALLIM_ADD THEN ASM_REWRITE_TAC[REALLIM_CONST]; ALL_TAC] THEN + SUBGOAL_THEN `((\n. f((q:num->real) n - &1)) ---> f(z - &1)) sequentially` + ASSUME_TAC THENL + [MATCH_MP_TAC CONTINUOUS_COMPOSE_SEQ THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REALLIM_SUB THEN ASM_REWRITE_TAC[REALLIM_CONST]; ALL_TAC] THEN + SUBGOAL_THEN `((\n. sl((q:num->real) n) * (z - q n)) ---> &0) sequentially` + ASSUME_TAC THENL + [MATCH_MP_TAC REALLIM_NULL_COMPARISON THEN + EXISTS_TAC + `\n. (abs(f((q:num->real) n + &1) - f(q n)) + + abs(f(q n - &1) - f(q n))) * abs(z - q n)` THEN + CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `0` THEN + REPEAT STRIP_TAC THEN BETA_TAC THEN REWRITE_TAC[REAL_ABS_MUL] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN + UNDISCH_TAC `!m. (sl:real->real) m <= f(m + &1) - f m` THEN + DISCH_THEN(MP_TAC o SPEC `(q:num->real) n`) THEN + UNDISCH_TAC `!m. f m - f(m - &1) <= (sl:real->real) m` THEN + DISCH_THEN(MP_TAC o SPEC `(q:num->real) n`) THEN + ASM_REAL_ARITH_TAC; + SUBGOAL_THEN + `&0 = (abs(f(z + &1) - f z) + abs(f(z - &1) - f z)) * abs(z - z)` + SUBST1_TAC THENL + [REWRITE_TAC[REAL_SUB_REFL; REAL_ABS_NUM] THEN REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REALLIM_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REALLIM_ADD THEN CONJ_TAC THEN MATCH_MP_TAC ABS_LIM THEN + MATCH_MP_TAC REALLIM_SUB THEN ASM_REWRITE_TAC[REALLIM_CONST]; + MATCH_MP_TAC ABS_LIM THEN MATCH_MP_TAC REALLIM_SUB THEN + ASM_REWRITE_TAC[REALLIM_CONST]]]; + ALL_TAC] THEN + SUBGOAL_THEN + `((\n. f((q:num->real) n) + sl(q n) * (z - q n)) ---> f z) sequentially` + ASSUME_TAC THENL + [SUBGOAL_THEN `(f:real->real) z = f z + &0` SUBST1_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REALLIM_ADD THEN ASM_REWRITE_TAC[REAL_ADD_RID]; ALL_TAC] THEN + MATCH_MP_TAC(ISPECL + [`sequentially`; `\n. f((q:num->real) n) + sl(q n) * (z - q n)`; + `(f:real->real) z`; `C:real`] REALLIM_UBOUND) THEN + ASM_REWRITE_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `0` THEN + REPEAT STRIP_TAC THEN BETA_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_MESON_TAC[]);; + +(* E[a*X + b | G] = a*E[X|G] + b a.s. *) +let GEN_COND_EXP_AFFINE = prove + (`!p:A prob_space G X a b. + sub_sigma_algebra p G /\ integrable p X + ==> almost_surely p + {x | gen_cond_exp p G (\w. a * X w + b) x = + a * gen_cond_exp p G X x + b}`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `integrable p (\w:A. a * X w)` ASSUME_TAC THENL + [MATCH_MP_TAC INTEGRABLE_CMUL THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `integrable p (\w:A. b:real)` ASSUME_TAC THENL + [REWRITE_TAC[INTEGRABLE_CONST]; ALL_TAC] THEN + MP_TAC(BETA_RULE(ISPECL [`p:A prob_space`; `G:(A->bool)->bool`; + `(\w:A. a * (X:A->real) w)`; `(\w:A. b:real)`] GEN_COND_EXP_ADD)) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `G:(A->bool)->bool`; `X:A->real`; `a:real`] + GEN_COND_EXP_CMUL) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `G:(A->bool)->bool`; `b:real`] + GEN_COND_EXP_CONST) THEN ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; + `{x:A | gen_cond_exp p G (\w. a * X w + b) x = + gen_cond_exp p G (\w. a * X w) x + gen_cond_exp p G (\w. b) x}`; + `{x:A | gen_cond_exp p G (\w. a * X w) x = a * gen_cond_exp p G X x}`] + ALMOST_SURELY_INTER) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; + `({x:A | gen_cond_exp p G (\w. a * X w + b) x = + gen_cond_exp p G (\w. a * X w) x + gen_cond_exp p G (\w. b) x} INTER + {x:A | gen_cond_exp p G (\w. a * X w) x = a * gen_cond_exp p G X x})`; + `{x:A | gen_cond_exp p G (\w. b) x = b}`] + ALMOST_SURELY_INTER) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MATCH_MP_TAC ALMOST_SURELY_SUBSET THEN + FIRST_X_ASSUM(fun th -> EXISTS_TAC (rand(concl th)) THEN + CONJ_TAC THENL [ACCEPT_TAC th; ALL_TAC]) THEN + REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN + GEN_TAC THEN DISCH_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + REAL_ARITH_TAC);; + +(* Conditional Jensen's inequality. *) +let GEN_COND_EXP_JENSEN = prove + (`!p:A prob_space G X f. + sub_sigma_algebra p G /\ integrable p X /\ + integrable p (\x. f(X x)) /\ f real_convex_on (:real) + ==> almost_surely p + {x | f(gen_cond_exp p G X x) <= gen_cond_exp p G (\w. f(X w)) x}`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(X_CHOOSE_THEN `sl:real->real` STRIP_ASSUME_TAC o + MATCH_MP SUPPORTING_SLOPE) THEN + SUBGOAL_THEN + `!q. almost_surely p + {x:A | sl q * gen_cond_exp p G X x + (f q - sl q * q) <= + gen_cond_exp p G (\w. f(X w)) x}` + ASSUME_TAC THENL + [GEN_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `G:(A->bool)->bool`; `X:A->real`; + `(sl:real->real) q`; `(f:real->real) q - sl q * q`] GEN_COND_EXP_AFFINE) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `G:(A->bool)->bool`; + `(\w:A. (sl:real->real) q * (X:A->real) w + ((f:real->real) q - sl q * q))`; + `(\w:A. (f:real->real)((X:A->real) w))`] GEN_COND_EXP_MONOTONE) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_ADD THEN CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_CMUL THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[INTEGRABLE_CONST]]; + X_GEN_TAC `w:A` THEN DISCH_TAC THEN + MP_TAC(SPECL [`q:real`; `(X:A->real) w`] + (ASSUME `!m y. f m + sl m * (y - m) <= f y`)) THEN + REAL_ARITH_TAC]; + ALL_TAC] THEN + DISCH_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; + `{x:A | gen_cond_exp p G (\w. sl q * X w + (f q - sl q * q)) x = + sl q * gen_cond_exp p G X x + (f q - sl q * q)}`; + `{x:A | gen_cond_exp p G (\w. sl q * X w + (f q - sl q * q)) x <= + gen_cond_exp p G (\w. f(X w)) x}`] + ALMOST_SURELY_INTER) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MATCH_MP_TAC ALMOST_SURELY_SUBSET THEN + FIRST_X_ASSUM(fun th -> EXISTS_TAC (rand(concl th)) THEN + CONJ_TAC THENL [ACCEPT_TAC th; ALL_TAC]) THEN + REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN + GEN_TAC THEN DISCH_TAC THEN STRIP_TAC THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(ISPEC `rational` COUNTABLE_AS_IMAGE) THEN + REWRITE_TAC[COUNTABLE_RATIONAL] THEN ANTS_TAC THENL + [REWRITE_TAC[GSYM MEMBER_NOT_EMPTY] THEN EXISTS_TAC `&0:real` THEN + REWRITE_TAC[IN] THEN MESON_TAC[RATIONAL_NUM]; ALL_TAC] THEN + DISCH_THEN(X_CHOOSE_TAC `enum:num->real`) THEN + MP_TAC(ISPECL [`p:A prob_space`; + `\n. {x:A | (sl:real->real)((enum:num->real) n) * gen_cond_exp p G X x + + (f(enum n) - sl(enum n) * (enum n)) <= + gen_cond_exp p G (\w. f(X w)) x}`] + ALMOST_SURELY_COUNTABLE_INTER) THEN + ASM_SIMP_TAC[] THEN DISCH_TAC THEN + MATCH_MP_TAC ALMOST_SURELY_SUBSET THEN + FIRST_X_ASSUM(fun th -> EXISTS_TAC (rand(concl th)) THEN + CONJ_TAC THENL [ACCEPT_TAC th; ALL_TAC]) THEN + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + REWRITE_TAC[IN_INTERS; IN_ELIM_THM; FORALL_IN_GSPEC; IN_UNIV] THEN + DISCH_TAC THEN + MP_TAC(ISPECL [`f:real->real`; `sl:real->real`] CONVEX_AFFINE_MINORANT_SUP) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPECL + [`gen_cond_exp p G (X:A->real) x`; + `gen_cond_exp p G (\w. f((X:A->real) w)) x`]) THEN + ANTS_TAC THENL + [X_GEN_TAC `q:real` THEN DISCH_TAC THEN + SUBGOAL_THEN `?n. q = (enum:num->real) n` (X_CHOOSE_THEN `n:num` SUBST1_TAC) THENL + [SUBGOAL_THEN `(q:real) IN rational` MP_TAC THENL + [ASM_REWRITE_TAC[IN]; ALL_TAC] THEN + ASM_REWRITE_TAC[IN_IMAGE; IN_UNIV] THEN MESON_TAC[]; ALL_TAC] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN REAL_ARITH_TAC; + REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------ *) +(* Corollaries of conditional Jensen. *) +(* ------------------------------------------------------------------ *) + +(* x^2 is convex on the whole line (second-derivative test). *) +let X2_CONVEX = prove + (`(\x:real. x pow 2) real_convex_on (:real)`, + MP_TAC(ISPECL [`\x:real. x pow 2`; `\x:real. &2 * x`; `\x:real. &2`; `(:real)`] + REAL_CONVEX_ON_SECOND_DERIVATIVE) THEN + REWRITE_TAC[IS_REALINTERVAL_UNIV; IN_UNIV] THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [REWRITE_TAC[EXTENSION; IN_UNIV; IN_SING] THEN MESON_TAC[REAL_ARITH `~(&0 = &1)`]; + CONJ_TAC THEN GEN_TAC THEN REAL_DIFF_TAC THEN + CONV_TAC NUM_REDUCE_CONV THEN REWRITE_TAC[REAL_POW_1] THEN REAL_ARITH_TAC]; + DISCH_THEN SUBST1_TAC THEN REAL_ARITH_TAC]);; + +(* Conditional L2 contraction: E[X|G]^2 <= E[X^2|G] a.s. (Jensen, f = x^2.) *) +let GEN_COND_EXP_L2_CONTRACTION = prove + (`!p:A prob_space G X. + sub_sigma_algebra p G /\ integrable p X /\ integrable p (\x. X x pow 2) + ==> almost_surely p + {x | gen_cond_exp p G X x pow 2 <= gen_cond_exp p G (\w. X w pow 2) x}`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `G:(A->bool)->bool`; `X:A->real`; + `\x:real. x pow 2`] GEN_COND_EXP_JENSEN) THEN + ASM_REWRITE_TAC[X2_CONVEX] THEN BETA_TAC THEN REWRITE_TAC[]);; + +(* Conditional Jensen for exp: exp(E[X|G]) <= E[exp X|G] a.s. *) +let GEN_COND_EXP_JENSEN_EXP = prove + (`!p:A prob_space G X. + sub_sigma_algebra p G /\ integrable p X /\ integrable p (\x. exp(X x)) + ==> almost_surely p + {x | exp(gen_cond_exp p G X x) <= gen_cond_exp p G (\w. exp(X w)) x}`, + REPEAT STRIP_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `G:(A->bool)->bool`; `X:A->real`; + `exp`] GEN_COND_EXP_JENSEN) THEN + ASM_REWRITE_TAC[REAL_CONVEX_ON_EXP; ETA_AX]);; + +(* Conditional triangle inequality: E[|X+Y| |G] <= E[|X| |G] + E[|Y| |G] a.s. *) +let GEN_COND_EXP_TRIANGLE = prove + (`!p:A prob_space G X Y. + sub_sigma_algebra p G /\ integrable p X /\ integrable p Y + ==> almost_surely p + {x | gen_cond_exp p G (\w. abs(X w + Y w)) x <= + gen_cond_exp p G (\w. abs(X w)) x + + gen_cond_exp p G (\w. abs(Y w)) x}`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `integrable p (\w:A. abs(X w))` ASSUME_TAC THENL + [MATCH_MP_TAC INTEGRABLE_ABS THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `integrable p (\w:A. abs(Y w))` ASSUME_TAC THENL + [MATCH_MP_TAC INTEGRABLE_ABS THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `integrable p (\w:A. abs(X w + Y w))` ASSUME_TAC THENL + [MATCH_MP_TAC INTEGRABLE_ABS THEN MATCH_MP_TAC INTEGRABLE_ADD THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + MP_TAC(BETA_RULE(ISPECL [`p:A prob_space`; `G:(A->bool)->bool`; + `(\w:A. abs((X:A->real) w))`; `(\w:A. abs((Y:A->real) w))`] + GEN_COND_EXP_ADD)) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `G:(A->bool)->bool`; + `(\w:A. abs((X:A->real) w + Y w))`; + `(\w:A. abs((X:A->real) w) + abs(Y w))`] GEN_COND_EXP_MONOTONE) THEN + ASM_REWRITE_TAC[] THEN ANTS_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_ADD THEN ASM_REWRITE_TAC[]; + REPEAT STRIP_TAC THEN REAL_ARITH_TAC]; + ALL_TAC] THEN + DISCH_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; + `{x:A | gen_cond_exp p G (\w. abs(X w + Y w)) x <= + gen_cond_exp p G (\w. abs(X w) + abs(Y w)) x}`; + `{x:A | gen_cond_exp p G (\w. abs(X w) + abs(Y w)) x = + gen_cond_exp p G (\w. abs(X w)) x + gen_cond_exp p G (\w. abs(Y w)) x}`] + ALMOST_SURELY_INTER) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + MATCH_MP_TAC ALMOST_SURELY_SUBSET THEN + FIRST_X_ASSUM(fun th -> EXISTS_TAC (rand(concl th)) THEN + CONJ_TAC THENL [ACCEPT_TAC th; ALL_TAC]) THEN + REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN + GEN_TAC THEN DISCH_TAC THEN STRIP_TAC THEN ASM_REAL_ARITH_TAC);; + +(* Integrability of h * phi * indicator_fn A when phi bounded on A *) +let INTEGRABLE_PRODUCT_INDICATOR = prove + (`!p:A prob_space G (h:A->real) (phi:A->real) (A:A->bool) K. + sub_sigma_algebra p G /\ integrable p h /\ + measurable_wrt p G phi /\ A IN G /\ &0 <= K /\ + (!x. x IN prob_carrier p /\ x IN A ==> abs(phi x) <= K) + ==> integrable p (\x. h x * phi x * indicator_fn A x)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `(\x:A. h x * phi x * indicator_fn A x) = + (\x. h x * (phi x * indicator_fn A x))` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; REAL_MUL_ASSOC]; ALL_TAC] THEN + MATCH_MP_TAC INTEGRABLE_MUL_BOUNDED THEN + EXISTS_TAC `K:real` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [SUBGOAL_THEN `(\x:A. phi x * indicator_fn A x) = + (\x. indicator_fn A x * phi x)` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC MEASURABLE_WRT_IMP_RV THEN + EXISTS_TAC `G:(A->bool)->bool` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MEASURABLE_WRT_MUL_INDICATOR THEN ASM_REWRITE_TAC[]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN REWRITE_TAC[indicator_fn] THEN + COND_CASES_TAC THENL + [REWRITE_TAC[REAL_MUL_RID] THEN FIRST_X_ASSUM MATCH_MP_TAC THEN + ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_MUL_RZERO; REAL_ABS_NUM] THEN ASM_REAL_ARITH_TAC]]);; + +(* Integrability of |h| * indicator *) +let INTEGRABLE_ABS_INDICATOR = prove + (`!p:A prob_space (h:A->real) (A:A->bool). + integrable p h /\ A IN prob_events p + ==> integrable p (\x. abs(h x) * indicator_fn A x)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `(\x:A. abs(h x) * indicator_fn A x) = + (\x. (\y. abs(h y)) x * indicator_fn A x)` SUBST1_TAC THENL + [REWRITE_TAC[]; + MATCH_MP_TAC INTEGRABLE_MUL_INDICATOR_FN THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC INTEGRABLE_ABS THEN ASM_REWRITE_TAC[]]);; + +(* Binary halving: quantitative bound for zero-integral bounded measurable *) +let EXPECTATION_ZERO_HALVING = prove + (`!p G (h:A->real). + sub_sigma_algebra p G /\ integrable p h /\ + (!B. B IN G ==> + expectation p (\x. h x * indicator_fn B x) = &0) + ==> !n K phi A. + measurable_wrt p G phi /\ A IN G /\ &0 <= K /\ + (!x. x IN prob_carrier p /\ x IN A ==> abs(phi x) <= K) + ==> abs(expectation p (\x. h x * phi x * indicator_fn A x)) + <= K / &2 pow n * + expectation p (\x. abs(h x) * indicator_fn A x)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `sigma_algebra (G:(A->bool)->bool)` ASSUME_TAC THENL + [ASM_MESON_TAC[sub_sigma_algebra]; ALL_TAC] THEN + INDUCT_TAC THEN REPEAT STRIP_TAC THENL + [(* Base case: n = 0. Goal: |E[h*phi*1_A]| <= K * E[|h|*1_A] *) + REWRITE_TAC[real_pow; REAL_DIV_1] THEN + SUBGOAL_THEN `(A:A->bool) IN prob_events p` ASSUME_TAC THENL + [MATCH_MP_TAC SUB_SIGMA_ALGEBRA_IN_EVENTS THEN + EXISTS_TAC `G:(A->bool)->bool` THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `integrable p (\x:A. h x * phi x * indicator_fn A x)` + ASSUME_TAC THENL + [MATCH_MP_TAC INTEGRABLE_PRODUCT_INDICATOR THEN + EXISTS_TAC `G:(A->bool)->bool` THEN EXISTS_TAC `K:real` THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `integrable p (\x:A. abs(h x) * indicator_fn A x)` + ASSUME_TAC THENL + [MATCH_MP_TAC INTEGRABLE_ABS_INDICATOR THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `expectation p (\x:A. abs(h x * phi x * indicator_fn A x))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC EXPECTATION_ABS_BOUND THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `K * expectation p (\x:A. abs(h x) * indicator_fn A x) = + expectation p (\x. K * (abs(h x) * indicator_fn A x))` + SUBST1_TAC THENL + [ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN + MATCH_MP_TAC EXPECTATION_CMUL THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC EXPECTATION_MONO THEN CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_ABS THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + CONJ_TAC THENL + [SUBGOAL_THEN `(\x:A. K * (abs(h x) * indicator_fn A x)) = + (\x. K * (\y. abs(h y) * indicator_fn A y) x)` + SUBST1_TAC THENL + [REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC INTEGRABLE_CMUL_ALT THEN ASM_REWRITE_TAC[]; + BETA_TAC THEN X_GEN_TAC `x:A` THEN DISCH_TAC THEN + REWRITE_TAC[REAL_ABS_MUL] THEN + SUBGOAL_THEN `abs(indicator_fn A (x:A)) = indicator_fn A x` + SUBST1_TAC THENL + [REWRITE_TAC[indicator_fn] THEN COND_CASES_TAC THEN + REWRITE_TAC[REAL_ABS_NUM]; ALL_TAC] THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN + REWRITE_TAC[indicator_fn] THEN COND_CASES_TAC THENL + [REWRITE_TAC[REAL_MUL_RID] THEN + SUBGOAL_THEN `K * abs((h:A->real) x) = abs(h x) * K` SUBST1_TAC THENL + [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN REWRITE_TAC[REAL_ABS_POS] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `x:A`) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; REAL_ARITH_TAC]; + REWRITE_TAC[REAL_MUL_RZERO; REAL_LE_REFL]]]; + + (* Induction step: n -> SUC n *) + (* Define Apos = A INTER {phi >= 0}, Aneg = A INTER {phi < 0} *) + ABBREV_TAC + `Apos = (A:A->bool) INTER {x | x IN prob_carrier p /\ phi x >= &0}` THEN + ABBREV_TAC + `Aneg = (A:A->bool) INTER {x:A | x IN prob_carrier p /\ phi x < &0}` THEN + SUBGOAL_THEN `(Apos:A->bool) IN G` ASSUME_TAC THENL + [EXPAND_TAC "Apos" THEN MATCH_MP_TAC SIGMA_ALGEBRA_INTER THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MEASURABLE_WRT_GE THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `(Aneg:A->bool) IN G` ASSUME_TAC THENL + [EXPAND_TAC "Aneg" THEN MATCH_MP_TAC SIGMA_ALGEBRA_INTER THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MEASURABLE_WRT_LT THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `(A:A->bool) IN prob_events p` ASSUME_TAC THENL + [MATCH_MP_TAC SUB_SIGMA_ALGEBRA_IN_EVENTS THEN + EXISTS_TAC `G:(A->bool)->bool` THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `(A:A->bool) SUBSET prob_carrier p` ASSUME_TAC THENL + [REWRITE_TAC[prob_carrier; SUBSET; IN_UNIONS] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `(Apos:A->bool) IN prob_events p` ASSUME_TAC THENL + [MATCH_MP_TAC SUB_SIGMA_ALGEBRA_IN_EVENTS THEN + EXISTS_TAC `G:(A->bool)->bool` THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `(Aneg:A->bool) IN prob_events p` ASSUME_TAC THENL + [MATCH_MP_TAC SUB_SIGMA_ALGEBRA_IN_EVENTS THEN + EXISTS_TAC `G:(A->bool)->bool` THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + (* Bounds on shifted functions *) + SUBGOAL_THEN `!x:A. x IN prob_carrier p /\ x IN Apos + ==> abs(phi x - K / &2) <= K / &2` ASSUME_TAC THENL + [X_GEN_TAC `x:A` THEN STRIP_TAC THEN + SUBGOAL_THEN `(x:A) IN A /\ phi x >= &0` STRIP_ASSUME_TAC THENL + [UNDISCH_TAC `(x:A) IN Apos` THEN EXPAND_TAC "Apos" THEN + REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `abs((phi:A->real) x) <= K` ASSUME_TAC THENL + [UNDISCH_TAC `!x:A. x IN prob_carrier p /\ x IN A ==> abs(phi x) <= K` THEN + DISCH_THEN(MP_TAC o SPEC `x:A`) THEN ASM_REWRITE_TAC[]; + UNDISCH_TAC `(phi:A->real) x >= &0` THEN + UNDISCH_TAC `abs((phi:A->real) x) <= K` THEN REAL_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN `!x:A. x IN prob_carrier p /\ x IN Aneg + ==> abs(phi x + K / &2) <= K / &2` ASSUME_TAC THENL + [X_GEN_TAC `x:A` THEN STRIP_TAC THEN + SUBGOAL_THEN `(x:A) IN A /\ phi x < &0` STRIP_ASSUME_TAC THENL + [UNDISCH_TAC `(x:A) IN Aneg` THEN EXPAND_TAC "Aneg" THEN + REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN ASM_MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `abs((phi:A->real) x) <= K` ASSUME_TAC THENL + [UNDISCH_TAC `!x:A. x IN prob_carrier p /\ x IN A ==> abs(phi x) <= K` THEN + DISCH_THEN(MP_TAC o SPEC `x:A`) THEN ASM_REWRITE_TAC[]; + UNDISCH_TAC `(phi:A->real) x < &0` THEN + UNDISCH_TAC `abs((phi:A->real) x) <= K` THEN REAL_ARITH_TAC]; + ALL_TAC] THEN + (* Measurability of shifted functions *) + SUBGOAL_THEN `measurable_wrt p G (\x:A. phi x - K / &2)` ASSUME_TAC THENL + [MATCH_MP_TAC MEASURABLE_WRT_SUB THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MEASURABLE_WRT_CONST THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `measurable_wrt p G (\x:A. phi x + K / &2)` ASSUME_TAC THENL + [MATCH_MP_TAC MEASURABLE_WRT_ADD THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MEASURABLE_WRT_CONST THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + (* Integrability of the key terms *) + SUBGOAL_THEN `integrable p (\x:A. h x * phi x * indicator_fn A x)` + ASSUME_TAC THENL + [MATCH_MP_TAC INTEGRABLE_PRODUCT_INDICATOR THEN + EXISTS_TAC `G:(A->bool)->bool` THEN EXISTS_TAC `K:real` THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `integrable p (\x:A. h x * (phi x - K / &2) * indicator_fn Apos x)` + ASSUME_TAC THENL + [MATCH_MP_TAC INTEGRABLE_PRODUCT_INDICATOR THEN + EXISTS_TAC `G:(A->bool)->bool` THEN EXISTS_TAC `K / &2` THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `integrable p (\x:A. h x * (phi x + K / &2) * indicator_fn Aneg x)` + ASSUME_TAC THENL + [MATCH_MP_TAC INTEGRABLE_PRODUCT_INDICATOR THEN + EXISTS_TAC `G:(A->bool)->bool` THEN EXISTS_TAC `K / &2` THEN + ASM_REWRITE_TAC[] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `integrable p (\x:A. abs(h x) * indicator_fn A x)` + ASSUME_TAC THENL + [MATCH_MP_TAC INTEGRABLE_ABS_INDICATOR THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `integrable p (\x:A. abs(h x) * indicator_fn Apos x)` + ASSUME_TAC THENL + [MATCH_MP_TAC INTEGRABLE_ABS_INDICATOR THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `integrable p (\x:A. abs(h x) * indicator_fn Aneg x)` + ASSUME_TAC THENL + [MATCH_MP_TAC INTEGRABLE_ABS_INDICATOR THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + (* E[h * 1_Apos] = 0, E[h * 1_Aneg] = 0 *) + SUBGOAL_THEN `expectation p (\x:A. h x * indicator_fn Apos x) = &0` + ASSUME_TAC THENL + [UNDISCH_TAC `!B:A->bool. B IN G ==> + expectation p (\x. h x * indicator_fn B x) = &0` THEN + DISCH_THEN(MP_TAC o SPEC `Apos:A->bool`) THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `expectation p (\x:A. h x * indicator_fn Aneg x) = &0` + ASSUME_TAC THENL + [UNDISCH_TAC `!B:A->bool. B IN G ==> + expectation p (\x. h x * indicator_fn B x) = &0` THEN + DISCH_THEN(MP_TAC o SPEC `Aneg:A->bool`) THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + (* Key identity: E[h*phi*1_A] = E[h*(phi-K/2)*1_Apos] + E[h*(phi+K/2)*1_Aneg] + because E[h*1_Apos] = E[h*1_Aneg] = 0 *) + SUBGOAL_THEN + `expectation p (\x:A. h x * phi x * indicator_fn A x) = + expectation p (\x. h x * (phi x - K / &2) * indicator_fn Apos x) + + expectation p (\x. h x * (phi x + K / &2) * indicator_fn Aneg x)` + SUBST1_TAC THENL + [SUBGOAL_THEN `integrable p (\x:A. h x * indicator_fn Apos x)` + ASSUME_TAC THENL + [SUBGOAL_THEN `(\x:A. h x * indicator_fn Apos x) = + (\x. h x * indicator_fn Apos x)` SUBST1_TAC THENL + [REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC INTEGRABLE_MUL_INDICATOR_FN THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `integrable p (\x:A. h x * indicator_fn Aneg x)` + ASSUME_TAC THENL + [MATCH_MP_TAC INTEGRABLE_MUL_INDICATOR_FN THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + (* E[h*phi*1_A] = E[h*phi*1_Apos] + E[h*phi*1_Aneg] + since 1_A = 1_Apos + 1_Aneg on prob_carrier *) + SUBGOAL_THEN `!x:A. x IN prob_carrier p /\ x IN Apos ==> abs(phi x) <= K` + ASSUME_TAC THENL + [X_GEN_TAC `x:A` THEN STRIP_TAC THEN + UNDISCH_TAC `!x:A. x IN prob_carrier p /\ x IN A ==> abs(phi x) <= K` THEN + DISCH_THEN(MP_TAC o SPEC `x:A`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN MATCH_MP_TAC THEN + UNDISCH_TAC `(x:A) IN Apos` THEN EXPAND_TAC "Apos" THEN + REWRITE_TAC[IN_INTER] THEN MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `!x:A. x IN prob_carrier p /\ x IN Aneg ==> abs(phi x) <= K` + ASSUME_TAC THENL + [X_GEN_TAC `x:A` THEN STRIP_TAC THEN + UNDISCH_TAC `!x:A. x IN prob_carrier p /\ x IN A ==> abs(phi x) <= K` THEN + DISCH_THEN(MP_TAC o SPEC `x:A`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN MATCH_MP_TAC THEN + UNDISCH_TAC `(x:A) IN Aneg` THEN EXPAND_TAC "Aneg" THEN + REWRITE_TAC[IN_INTER] THEN MESON_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `integrable p (\x:A. h x * phi x * indicator_fn Apos x)` + ASSUME_TAC THENL + [MATCH_MP_TAC INTEGRABLE_PRODUCT_INDICATOR THEN + EXISTS_TAC `G:(A->bool)->bool` THEN EXISTS_TAC `K:real` THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `integrable p (\x:A. h x * phi x * indicator_fn Aneg x)` + ASSUME_TAC THENL + [MATCH_MP_TAC INTEGRABLE_PRODUCT_INDICATOR THEN + EXISTS_TAC `G:(A->bool)->bool` THEN EXISTS_TAC `K:real` THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + (* Now the identity via expectation algebra *) + (* E[h*phi*1_A] = E[h*phi*1_Apos] + E[h*phi*1_Aneg] *) + SUBGOAL_THEN + `expectation p (\x:A. h x * phi x * indicator_fn A x) = + expectation p (\x. h x * phi x * indicator_fn Apos x) + + expectation p (\x. h x * phi x * indicator_fn Aneg x)` + SUBST1_TAC THENL + [SUBGOAL_THEN + `(\x:A. h x * phi x * indicator_fn A x) = + (\x. h x * phi x * indicator_fn Apos x + + h x * phi x * indicator_fn Aneg x)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:A` THEN + REWRITE_TAC[GSYM REAL_ADD_LDISTRIB] THEN + AP_TERM_TAC THEN AP_TERM_TAC THEN + EXPAND_TAC "Apos" THEN EXPAND_TAC "Aneg" THEN + REWRITE_TAC[indicator_fn; IN_INTER; IN_ELIM_THM] THEN + ASM_CASES_TAC `(x:A) IN A` THEN ASM_REWRITE_TAC[] THENL + [ASM_CASES_TAC `(x:A) IN prob_carrier p` THEN ASM_REWRITE_TAC[] THENL + [ASM_CASES_TAC `(phi:A->real) x >= &0` THEN ASM_REWRITE_TAC[] THENL + [SUBGOAL_THEN `~((phi:A->real) x < &0)` (fun th -> REWRITE_TAC[th]) THENL + [ASM_REAL_ARITH_TAC; REAL_ARITH_TAC]; + SUBGOAL_THEN `(phi:A->real) x < &0` (fun th -> REWRITE_TAC[th]) THENL + [ASM_REAL_ARITH_TAC; REAL_ARITH_TAC]]; + ASM_MESON_TAC[SUBSET]]; + REAL_ARITH_TAC]; + MATCH_MP_TAC EXPECTATION_ADD THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + (* Prove E[h*phi*1_Apos] = E[h*(phi-K/2)*1_Apos] using E[h*1_Apos]=0 *) + SUBGOAL_THEN + `expectation p (\x:A. h x * phi x * indicator_fn Apos x) = + expectation p (\x. h x * (phi x - K / &2) * indicator_fn Apos x)` + SUBST1_TAC THENL + [SUBGOAL_THEN + `(\x:A. h x * phi x * indicator_fn Apos x) = + (\x. h x * (phi x - K / &2) * indicator_fn Apos x + + K / &2 * (h x * indicator_fn Apos x))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPECL [`p:A prob_space`; + `\x:A. h x * (phi x - K / &2) * indicator_fn Apos x`; + `\x:A. K / &2 * (h:A->real) x * indicator_fn (Apos:A->bool) x`] + EXPECTATION_ADD) THEN + CONV_TAC(ONCE_DEPTH_CONV BETA_CONV) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN MATCH_MP_TAC INTEGRABLE_CMUL_ALT THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `K / &2`; + `\x:A. (h:A->real) x * indicator_fn (Apos:A->bool) x`] + EXPECTATION_CMUL) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + CONV_TAC(ONCE_DEPTH_CONV BETA_CONV) THEN + DISCH_THEN SUBST1_TAC THEN + ASM_REWRITE_TAC[REAL_MUL_RZERO; REAL_ADD_RID]; ALL_TAC] THEN + (* Prove E[h*phi*1_Aneg] = E[h*(phi+K/2)*1_Aneg] using E[h*1_Aneg]=0 *) + SUBGOAL_THEN + `expectation p (\x:A. h x * phi x * indicator_fn Aneg x) = + expectation p (\x. h x * (phi x + K / &2) * indicator_fn Aneg x)` + SUBST1_TAC THENL + [SUBGOAL_THEN + `(\x:A. h x * phi x * indicator_fn Aneg x) = + (\x. h x * (phi x + K / &2) * indicator_fn Aneg x + + --(K / &2) * (h x * indicator_fn Aneg x))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPECL [`p:A prob_space`; + `\x:A. h x * (phi x + K / &2) * indicator_fn Aneg x`; + `\x:A. --(K / &2) * (h:A->real) x * indicator_fn (Aneg:A->bool) x`] + EXPECTATION_ADD) THEN + CONV_TAC(ONCE_DEPTH_CONV BETA_CONV) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN MATCH_MP_TAC INTEGRABLE_CMUL_ALT THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `--(K / &2)`; + `\x:A. (h:A->real) x * indicator_fn (Aneg:A->bool) x`] + EXPECTATION_CMUL) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + CONV_TAC(ONCE_DEPTH_CONV BETA_CONV) THEN + DISCH_THEN SUBST1_TAC THEN + ASM_REWRITE_TAC[REAL_MUL_RZERO; REAL_ADD_RID]; ALL_TAC] THEN + REAL_ARITH_TAC; + ALL_TAC] THEN + (* Now apply triangle inequality, then IH *) + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `abs(expectation p (\x:A. h x * (phi x - K / &2) * indicator_fn Apos x)) + + abs(expectation p (\x. h x * (phi x + K / &2) * indicator_fn Aneg x))` THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + (* Apply IH to each term *) + SUBGOAL_THEN + `abs(expectation p (\x:A. h x * (phi x - K / &2) * indicator_fn Apos x)) <= + (K / &2) / &2 pow n * + expectation p (\x. abs(h x) * indicator_fn Apos x)` + ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPECL [`K / &2`; `\x:A. phi x - K / &2`; + `Apos:A->bool`]) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `abs(expectation p (\x:A. h x * (phi x + K / &2) * indicator_fn Aneg x)) <= + (K / &2) / &2 pow n * + expectation p (\x. abs(h x) * indicator_fn Aneg x)` + ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPECL [`K / &2`; `\x:A. phi x + K / &2`; + `Aneg:A->bool`]) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `(K / &2) / &2 pow n * + expectation p (\x:A. abs(h x) * indicator_fn Apos x) + + (K / &2) / &2 pow n * + expectation p (\x. abs(h x) * indicator_fn Aneg x)` THEN + CONJ_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[GSYM REAL_ADD_LDISTRIB] THEN + (* E[|h|*1_Apos] + E[|h|*1_Aneg] = E[|h|*1_A] *) + SUBGOAL_THEN + `expectation p (\x:A. abs(h x) * indicator_fn Apos x) + + expectation p (\x. abs(h x) * indicator_fn Aneg x) = + expectation p (\x. abs(h x) * indicator_fn A x)` SUBST1_TAC THENL + [ONCE_REWRITE_TAC[EQ_SYM_EQ] THEN + SUBGOAL_THEN + `(\x:A. abs(h x) * indicator_fn A x) = + (\x. abs(h x) * indicator_fn Apos x + + abs(h x) * indicator_fn Aneg x)` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:A` THEN + REWRITE_TAC[GSYM REAL_ADD_LDISTRIB] THEN AP_TERM_TAC THEN + EXPAND_TAC "Apos" THEN EXPAND_TAC "Aneg" THEN + REWRITE_TAC[indicator_fn; IN_INTER; IN_ELIM_THM] THEN + ASM_CASES_TAC `(x:A) IN A` THEN ASM_REWRITE_TAC[] THENL + [ASM_CASES_TAC `(x:A) IN prob_carrier p` THEN ASM_REWRITE_TAC[] THENL + [ASM_CASES_TAC `(phi:A->real) x >= &0` THEN ASM_REWRITE_TAC[] THENL + [SUBGOAL_THEN `~((phi:A->real) x < &0)` (fun th -> REWRITE_TAC[th]) THENL + [ASM_REAL_ARITH_TAC; REAL_ARITH_TAC]; + SUBGOAL_THEN `(phi:A->real) x < &0` (fun th -> REWRITE_TAC[th]) THENL + [ASM_REAL_ARITH_TAC; REAL_ARITH_TAC]]; + ASM_MESON_TAC[SUBSET]]; + REAL_ARITH_TAC]; + MATCH_MP_TAC EXPECTATION_ADD THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + (* (K/2)/2^n * E[|h|*1_A] <= K/2^{SUC n} * E[|h|*1_A] *) + SUBGOAL_THEN `(K / &2) / &2 pow n = K / &2 pow (SUC n)` + SUBST1_TAC THENL + [REWRITE_TAC[real_pow; real_div; REAL_INV_MUL] THEN REAL_ARITH_TAC; + REAL_ARITH_TAC]]);; + +(* Archimedean shrinking: if abs x <= K/2^n * C for all n and C >= 0, then x = 0 *) +let POW2_SHRINK_ZERO = prove + (`(!n. abs x <= K / &2 pow n * C) /\ &0 <= C ==> x = &0`, + STRIP_TAC THEN + ASM_CASES_TAC `abs(x:real) = &0` THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `&0 < abs(x:real)` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `&0 < K * C` ASSUME_TAC THENL + [FIRST_ASSUM(MP_TAC o SPEC `0`) THEN + REWRITE_TAC[real_pow; REAL_DIV_1] THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + MP_TAC(ISPEC `K * C * inv(abs(x:real))` REAL_ARCH_POW2) THEN + DISCH_THEN(X_CHOOSE_TAC `N:num`) THEN + FIRST_ASSUM(MP_TAC o SPEC `N:num`) THEN DISCH_TAC THEN + SUBGOAL_THEN `~(&2 pow N = &0)` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_POW_NZ THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `K / &2 pow N * &2 pow N = K` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_DIV_RMUL THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `&0 < &2 pow N` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_POW_LT THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `abs(x:real) * &2 pow N <= (K / &2 pow N * C) * &2 pow N` + MP_TAC THENL + [MATCH_MP_TAC REAL_LE_RMUL THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `(K / &2 pow N * C) * &2 pow N = K * C` + SUBST1_TAC THENL + [ONCE_REWRITE_TAC[REAL_ARITH `(a * c) * b = (a * b) * c:real`] THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + DISCH_TAC THEN + SUBGOAL_THEN `(K * C * inv(abs(x:real))) * abs x < &2 pow N * abs x` + MP_TAC THENL + [MATCH_MP_TAC REAL_LT_RMUL THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `(K * C * inv(abs(x:real))) * abs x = K * C` + SUBST1_TAC THENL + [ONCE_REWRITE_TAC[REAL_ARITH `(a * (b * c)) * d = (a * b) * (c * d):real`] THEN + SUBGOAL_THEN `inv(abs(x:real)) * abs x = &1` SUBST1_TAC THENL + [MATCH_MP_TAC REAL_MUL_LINV THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[REAL_MUL_RID]]; ALL_TAC] THEN + DISCH_TAC THEN + UNDISCH_TAC `abs(x:real) * &2 pow N <= K * C` THEN + ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN ASM_REAL_ARITH_TAC);; + +(* Corollary: if E[h*1_B] = 0 for all B in G, then E[h*phi] = 0 + for bounded G-measurable phi *) +let EXPECTATION_ZERO_BOUNDED_MEASURABLE = prove + (`!p:A prob_space G (h:A->real) (phi:A->real) K. + sub_sigma_algebra p G /\ integrable p h /\ + (!B. B IN G ==> expectation p (\x. h x * indicator_fn B x) = &0) /\ + measurable_wrt p G phi /\ &0 <= K /\ + (!x. x IN prob_carrier p ==> abs(phi x) <= K) + ==> expectation p (\x. h x * phi x) = &0`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MP_TAC(INST [`expectation p (\x:A. (h:A->real) x * (phi:A->real) x)`, + `x:real`; + `expectation p (\x:A. abs((h:A->real) x))`, `C:real`] + POW2_SHRINK_ZERO) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [GEN_TAC THEN + MP_TAC(SPECL [`p:A prob_space`; `G:(A->bool)->bool`; `h:A->real`] + EXPECTATION_ZERO_HALVING) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPECL [`n:num`; `K:real`; `phi:A->real`; + `prob_carrier(p:A prob_space)`]) THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `prob_carrier(p:A prob_space) IN G` ASSUME_TAC THENL + [MATCH_MP_TAC SUB_SIGMA_ALGEBRA_CARRIER_IN THEN ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]] THEN + SUBGOAL_THEN + `expectation p (\x:A. h x * phi x * indicator_fn (prob_carrier p) x) = + expectation p (\x. h x * phi x)` + (fun th -> REWRITE_TAC[th]) THENL + [MATCH_MP_TAC EXPECTATION_EXT THEN X_GEN_TAC `x:A` THEN DISCH_TAC THEN + REWRITE_TAC[indicator_fn] THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `expectation p (\x:A. abs(h x) * indicator_fn (prob_carrier p) x) = + expectation p (\x. abs(h x))` + (fun th -> REWRITE_TAC[th]) THEN + MATCH_MP_TAC EXPECTATION_EXT THEN X_GEN_TAC `x:A` THEN DISCH_TAC THEN + REWRITE_TAC[indicator_fn] THEN ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + MATCH_MP_TAC EXPECTATION_POS THEN CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_ABS THEN ASM_REWRITE_TAC[]; + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[REAL_ABS_POS]]]; + SIMP_TAC[]]);; + + +(* ================================================================== *) +(* L2 CONTRACTION AND CONDITIONAL VARIANCE *) +(* ================================================================== *) + +(* L2 contraction: E[(cond_exp X)^2] <= E[X^2] *) +let COND_EXP_L2_CONTRACTION = prove + (`!p:A prob_space G (X:A->real). + sub_sigma_algebra p G /\ FINITE G /\ + integrable p X /\ integrable p (\x. X x pow 2) + ==> expectation p (\x. cond_exp p G X x pow 2) <= + expectation p (\x. X x pow 2)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `simple_rv p (cond_exp p G (X:A->real))` ASSUME_TAC THENL + [MATCH_MP_TAC COND_EXP_SIMPLE_RV THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `integrable p (cond_exp p G (X:A->real))` ASSUME_TAC THENL + [MATCH_MP_TAC INTEGRABLE_SIMPLE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `measurable_wrt p G (cond_exp p G (X:A->real))` ASSUME_TAC THENL + [MATCH_MP_TAC COND_EXP_MEASURABLE_WRT THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + (* Get abs bound for cond_exp *) + SUBGOAL_THEN + `?K. &0 <= K /\ !z:A. z IN prob_carrier p + ==> abs(cond_exp p G (X:A->real) z) <= K` + (X_CHOOSE_THEN `K:real` STRIP_ASSUME_TAC) THENL + [MP_TAC(SPECL [`p:A prob_space`; + `\x:A. abs(cond_exp p G (X:A->real) x)`] SIMPLE_RV_BOUNDED) THEN + ANTS_TAC THENL + [MATCH_MP_TAC SIMPLE_RV_ABS THEN ASM_REWRITE_TAC[ETA_AX]; ALL_TAC] THEN + BETA_TAC THEN DISCH_THEN(X_CHOOSE_TAC `M:real`) THEN + EXISTS_TAC `max M (&0)` THEN CONJ_TAC THENL + [REAL_ARITH_TAC; + ASM_MESON_TAC[REAL_ARITH `x <= M ==> x <= max M (&0)`]]; + ALL_TAC] THEN + (* Orthogonality: E[(X - cond_exp X) * cond_exp X] = 0 *) + SUBGOAL_THEN + `expectation p + (\x:A. ((X:A->real) x - cond_exp p G X x) * cond_exp p G X x) = &0` + (LABEL_TAC "orth") THENL + [MATCH_MP_TAC EXPECTATION_ZERO_BOUNDED_MEASURABLE THEN + EXISTS_TAC `G:(A->bool)->bool` THEN EXISTS_TAC `K:real` THEN + ASM_REWRITE_TAC[ETA_AX] THEN CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_SUB THEN ASM_REWRITE_TAC[ETA_AX]; ALL_TAC] THEN + X_GEN_TAC `B:A->bool` THEN DISCH_TAC THEN + SUBGOAL_THEN `B IN prob_events (p:A prob_space)` ASSUME_TAC THENL + [ASM_MESON_TAC[sub_sigma_algebra; SUBSET]; ALL_TAC] THEN + SUBGOAL_THEN + `(\x:A. ((X:A->real) x - cond_exp p G X x) * indicator_fn B x) = + (\x. X x * indicator_fn B x - cond_exp p G X x * indicator_fn B x)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPECL [`p:A prob_space`; + `\x:A. (X:A->real) x * indicator_fn (B:A->bool) x`; + `\x:A. cond_exp p G (X:A->real) x * indicator_fn (B:A->bool) x`] + EXPECTATION_SUB) THEN + ANTS_TAC THENL + [CONJ_TAC THEN MATCH_MP_TAC INTEGRABLE_MUL_INDICATOR_FN THEN + ASM_REWRITE_TAC[ETA_AX]; + BETA_TAC THEN DISCH_THEN SUBST1_TAC THEN + MP_TAC(SPECL [`p:A prob_space`; `G:(A->bool)->bool`; + `X:A->real`; `B:A->bool`] COND_EXP_CONDITIONING) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC]; + ALL_TAC] THEN + (* Main inequality via non-negativity of squared difference *) + MATCH_MP_TAC(REAL_ARITH `&0 <= a - b ==> b <= a`) THEN + SUBGOAL_THEN `integrable p (\x:A. cond_exp p G (X:A->real) x pow 2)` + ASSUME_TAC THENL + [MATCH_MP_TAC INTEGRABLE_SIMPLE THEN MATCH_MP_TAC SIMPLE_RV_SQUARE THEN + ASM_REWRITE_TAC[ETA_AX]; ALL_TAC] THEN + MP_TAC(ISPECL [`p:A prob_space`; + `\x:A. (X:A->real) x pow 2`; + `\x:A. cond_exp p G (X:A->real) x pow 2`] EXPECTATION_SUB) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + BETA_TAC THEN DISCH_THEN(SUBST1_TAC o GSYM) THEN + SUBGOAL_THEN + `(\x:A. (X:A->real) x pow 2 - cond_exp p G X x pow 2) = + (\x. (X x - cond_exp p G X x) pow 2 + + &2 * (X x - cond_exp p G X x) * cond_exp p G X x)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `w:A` THEN + REWRITE_TAC[REAL_POW_2] THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `integrable p (\x:A. ((X:A->real) x - cond_exp p G X x) pow 2)` + ASSUME_TAC THENL + [MATCH_MP_TAC INTEGRABLE_DOMINATED THEN + EXISTS_TAC `\x:A. &2 * ((X:A->real) x pow 2 + + cond_exp p G X x pow 2)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC RANDOM_VARIABLE_SQUARE THEN + MATCH_MP_TAC RANDOM_VARIABLE_SUB THEN CONJ_TAC THENL + [ASM_MESON_TAC[integrable]; + MATCH_MP_TAC MEASURABLE_WRT_IMP_RV THEN + EXISTS_TAC `G:(A->bool)->bool` THEN ASM_REWRITE_TAC[ETA_AX]]; + ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_CMUL THEN MATCH_MP_TAC INTEGRABLE_ADD THEN + ASM_REWRITE_TAC[]; + X_GEN_TAC `w:A` THEN DISCH_TAC THEN BETA_TAC THEN + MATCH_MP_TAC(REAL_ARITH + `&0 <= a /\ a <= b /\ &0 <= b ==> abs a <= abs b`) THEN + REWRITE_TAC[REAL_LE_POW_2] THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_POW_2] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 <= (x + c) * (x + c) /\ &0 <= (x - c) * (x - c) + ==> (x - c) * (x - c) <= &2 * (x * x + c * c)`) THEN + REWRITE_TAC[REAL_LE_SQUARE]; + MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LE_ADD THEN REWRITE_TAC[REAL_LE_POW_2]]]]; + ALL_TAC] THEN + SUBGOAL_THEN + `integrable p (\x:A. ((X:A->real) x - cond_exp p G X x) * + cond_exp p G X x)` ASSUME_TAC THENL + [MATCH_MP_TAC INTEGRABLE_MUL_BOUNDED THEN + EXISTS_TAC `K:real` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_SUB THEN ASM_REWRITE_TAC[ETA_AX]; ALL_TAC] THEN + MATCH_MP_TAC MEASURABLE_WRT_IMP_RV THEN + EXISTS_TAC `G:(A->bool)->bool` THEN ASM_REWRITE_TAC[ETA_AX]; + ALL_TAC] THEN + MP_TAC(ISPECL [`p:A prob_space`; + `\x:A. ((X:A->real) x - cond_exp p G X x) pow 2`; + `\x:A. &2 * ((X:A->real) x - cond_exp p G X x) * cond_exp p G X x`] + EXPECTATION_ADD) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN MATCH_MP_TAC INTEGRABLE_CMUL THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + BETA_TAC THEN DISCH_THEN SUBST1_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `&2`; + `\x:A. ((X:A->real) x - cond_exp p G X x) * cond_exp p G X x`] + EXPECTATION_CMUL) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + BETA_TAC THEN DISCH_THEN SUBST1_TAC THEN + ASM_REWRITE_TAC[REAL_MUL_RZERO; REAL_ADD_RID] THEN + MATCH_MP_TAC EXPECTATION_POS THEN ASM_REWRITE_TAC[] THEN + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[REAL_LE_POW_2]);; + +(* Conditional variance definition *) +let cond_variance = new_definition + `cond_variance (p:A prob_space) (G:(A->bool)->bool) (X:A->real) = + cond_exp p G (\x. (X x - cond_exp p G X x) pow 2)`;; + +(* Law of total variance: Var(X) = E[Var(X|G)] + Var(E[X|G]) *) +let LAW_OF_TOTAL_VARIANCE = prove + (`!p:A prob_space G (X:A->real). + sub_sigma_algebra p G /\ FINITE G /\ + integrable p X /\ integrable p (\x. X x pow 2) + ==> variance p X = + expectation p (cond_variance p G X) + + variance p (cond_exp p G X)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `simple_rv p (cond_exp p G (X:A->real))` ASSUME_TAC THENL + [MATCH_MP_TAC COND_EXP_SIMPLE_RV THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `integrable p (cond_exp p G (X:A->real))` ASSUME_TAC THENL + [MATCH_MP_TAC INTEGRABLE_SIMPLE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `integrable p (\x:A. cond_exp p G (X:A->real) x pow 2)` + ASSUME_TAC THENL + [MATCH_MP_TAC INTEGRABLE_SIMPLE THEN MATCH_MP_TAC SIMPLE_RV_SQUARE THEN + ASM_REWRITE_TAC[ETA_AX]; ALL_TAC] THEN + (* E[cond_exp X] = E[X] by tower property *) + SUBGOAL_THEN + `expectation p (cond_exp p G (X:A->real)) = expectation p X` + (LABEL_TAC "tower") THENL + [MATCH_MP_TAC COND_EXP_TOWER THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + (* E[Var(X|G)] = E[(X - cond_exp X)^2] by cond_exp tower *) + SUBGOAL_THEN + `integrable p (\x:A. ((X:A->real) x - cond_exp p G X x) pow 2)` + ASSUME_TAC THENL + [MATCH_MP_TAC INTEGRABLE_DOMINATED THEN + EXISTS_TAC `\x:A. &2 * ((X:A->real) x pow 2 + + cond_exp p G X x pow 2)` THEN + SUBGOAL_THEN `measurable_wrt p G (cond_exp p G (X:A->real))` ASSUME_TAC + THENL + [MATCH_MP_TAC COND_EXP_MEASURABLE_WRT THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC RANDOM_VARIABLE_SQUARE THEN + MATCH_MP_TAC RANDOM_VARIABLE_SUB THEN CONJ_TAC THENL + [ASM_MESON_TAC[integrable]; + MATCH_MP_TAC MEASURABLE_WRT_IMP_RV THEN + EXISTS_TAC `G:(A->bool)->bool` THEN ASM_REWRITE_TAC[ETA_AX]]; + MATCH_MP_TAC INTEGRABLE_CMUL THEN MATCH_MP_TAC INTEGRABLE_ADD THEN + ASM_REWRITE_TAC[]; + X_GEN_TAC `w:A` THEN DISCH_TAC THEN BETA_TAC THEN + MATCH_MP_TAC(REAL_ARITH + `&0 <= a /\ a <= b /\ &0 <= b ==> abs a <= abs b`) THEN + REWRITE_TAC[REAL_LE_POW_2] THEN CONJ_TAC THENL + [REWRITE_TAC[REAL_POW_2] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 <= (x + c) * (x + c) /\ &0 <= (x - c) * (x - c) + ==> (x - c) * (x - c) <= &2 * (x * x + c * c)`) THEN + REWRITE_TAC[REAL_LE_SQUARE]; + MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC THENL + [REAL_ARITH_TAC; + MATCH_MP_TAC REAL_LE_ADD THEN REWRITE_TAC[REAL_LE_POW_2]]]]; + ALL_TAC] THEN + SUBGOAL_THEN + `expectation p (cond_variance p G (X:A->real)) = + expectation p (\x. (X x - cond_exp p G X x) pow 2)` + SUBST1_TAC THENL + [REWRITE_TAC[cond_variance] THEN + MATCH_MP_TAC COND_EXP_TOWER THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + (* E[(X - ce)^2] = E[X^2] - E[ce^2] by orthogonality *) + SUBGOAL_THEN + `expectation p (\x:A. ((X:A->real) x - cond_exp p G X x) pow 2) = + expectation p (\x. X x pow 2) - + expectation p (\x. cond_exp p G X x pow 2)` + SUBST1_TAC THENL + [MP_TAC(SPECL [`p:A prob_space`; `G:(A->bool)->bool`; `X:A->real`] + COND_EXP_L2_CONTRACTION) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + (* This follows from orthogonality, same as L2 contraction proof *) + SUBGOAL_THEN `measurable_wrt p G (cond_exp p G (X:A->real))` ASSUME_TAC + THENL + [MATCH_MP_TAC COND_EXP_MEASURABLE_WRT THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `?K. &0 <= K /\ !z:A. z IN prob_carrier p + ==> abs(cond_exp p G (X:A->real) z) <= K` + (X_CHOOSE_THEN `K:real` STRIP_ASSUME_TAC) THENL + [MP_TAC(SPECL [`p:A prob_space`; + `\x:A. abs(cond_exp p G (X:A->real) x)`] SIMPLE_RV_BOUNDED) THEN + ANTS_TAC THENL + [MATCH_MP_TAC SIMPLE_RV_ABS THEN ASM_REWRITE_TAC[ETA_AX]; ALL_TAC] THEN + BETA_TAC THEN DISCH_THEN(X_CHOOSE_TAC `M:real`) THEN + EXISTS_TAC `max M (&0)` THEN CONJ_TAC THENL + [REAL_ARITH_TAC; + ASM_MESON_TAC[REAL_ARITH `x <= M ==> x <= max M (&0)`]]; + ALL_TAC] THEN + SUBGOAL_THEN + `expectation p + (\x:A. ((X:A->real) x - cond_exp p G X x) * cond_exp p G X x) = &0` + (LABEL_TAC "orth") THENL + [MATCH_MP_TAC EXPECTATION_ZERO_BOUNDED_MEASURABLE THEN + EXISTS_TAC `G:(A->bool)->bool` THEN EXISTS_TAC `K:real` THEN + ASM_REWRITE_TAC[ETA_AX] THEN CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_SUB THEN ASM_REWRITE_TAC[ETA_AX]; ALL_TAC] THEN + X_GEN_TAC `B:A->bool` THEN DISCH_TAC THEN + SUBGOAL_THEN `B IN prob_events (p:A prob_space)` ASSUME_TAC THENL + [ASM_MESON_TAC[sub_sigma_algebra; SUBSET]; ALL_TAC] THEN + SUBGOAL_THEN + `(\x:A. ((X:A->real) x - cond_exp p G X x) * indicator_fn B x) = + (\x. X x * indicator_fn B x - cond_exp p G X x * indicator_fn B x)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPECL [`p:A prob_space`; + `\x:A. (X:A->real) x * indicator_fn (B:A->bool) x`; + `\x:A. cond_exp p G (X:A->real) x * indicator_fn (B:A->bool) x`] + EXPECTATION_SUB) THEN + ANTS_TAC THENL + [CONJ_TAC THEN MATCH_MP_TAC INTEGRABLE_MUL_INDICATOR_FN THEN + ASM_REWRITE_TAC[ETA_AX]; + BETA_TAC THEN DISCH_THEN SUBST1_TAC THEN + MP_TAC(SPECL [`p:A prob_space`; `G:(A->bool)->bool`; + `X:A->real`; `B:A->bool`] COND_EXP_CONDITIONING) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC]; + ALL_TAC] THEN + (* E[(X - ce)^2] = E[X^2 - 2*X*ce + ce^2] = E[X^2] - 2*E[X*ce] + E[ce^2] + E[(X - ce)*ce] = 0 means E[X*ce] = E[ce^2] + So E[(X - ce)^2] = E[X^2] - 2*E[ce^2] + E[ce^2] = E[X^2] - E[ce^2] *) + SUBGOAL_THEN + `integrable p (\x:A. ((X:A->real) x - cond_exp p G X x) * + cond_exp p G X x)` ASSUME_TAC THENL + [MATCH_MP_TAC INTEGRABLE_MUL_BOUNDED THEN + EXISTS_TAC `K:real` THEN ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_SUB THEN ASM_REWRITE_TAC[ETA_AX]; ALL_TAC] THEN + MATCH_MP_TAC MEASURABLE_WRT_IMP_RV THEN + EXISTS_TAC `G:(A->bool)->bool` THEN ASM_REWRITE_TAC[ETA_AX]; + ALL_TAC] THEN + SUBGOAL_THEN + `(\x:A. ((X:A->real) x - cond_exp p G X x) pow 2) = + (\x. X x pow 2 - &2 * (X x - cond_exp p G X x) * cond_exp p G X x - + cond_exp p G X x pow 2)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `w:A` THEN + REWRITE_TAC[REAL_POW_2] THEN REAL_ARITH_TAC; ALL_TAC] THEN + MP_TAC(ISPECL [`p:A prob_space`; + `\x:A. (X:A->real) x pow 2 - + &2 * (X x - cond_exp p G X x) * cond_exp p G X x`; + `\x:A. cond_exp p G (X:A->real) x pow 2`] EXPECTATION_SUB) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_SUB THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC INTEGRABLE_CMUL THEN ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]]; + BETA_TAC THEN DISCH_THEN SUBST1_TAC] THEN + MP_TAC(ISPECL [`p:A prob_space`; + `\x:A. (X:A->real) x pow 2`; + `\x:A. &2 * ((X:A->real) x - cond_exp p G X x) * cond_exp p G X x`] + EXPECTATION_SUB) THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN MATCH_MP_TAC INTEGRABLE_CMUL THEN + ASM_REWRITE_TAC[]; + BETA_TAC THEN DISCH_THEN SUBST1_TAC] THEN + MP_TAC(ISPECL [`p:A prob_space`; `&2`; + `\x:A. ((X:A->real) x - cond_exp p G X x) * cond_exp p G X x`] + EXPECTATION_CMUL) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + BETA_TAC THEN DISCH_THEN SUBST1_TAC THEN + ASM_REWRITE_TAC[REAL_MUL_RZERO] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + (* Use VARIANCE_ALT: Var(Z) = E[Z^2] - (E[Z])^2, then tower + arith *) + MP_TAC(ISPECL [`p:A prob_space`; `X:A->real`] VARIANCE_ALT) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN SUBST1_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `cond_exp p G (X:A->real)`] + VARIANCE_ALT) THEN + ASM_REWRITE_TAC[ETA_AX] THEN DISCH_THEN SUBST1_TAC THEN + USE_THEN "tower" (fun th -> REWRITE_TAC[th]) THEN + REAL_ARITH_TAC);; + + +(* ================================================================== *) +(* Helper lemmas for RESCALED_INDICATOR_CONVERGENCE *) +(* ================================================================== *) + +(* Shifting a filtration by one step preserves the filtration property *) +let SHIFTED_FILTRATION = prove + (`!p:A prob_space FF. + filtration p FF ==> filtration p (\n. FF(SUC n))`, + REWRITE_TAC[filtration] THEN REPEAT STRIP_TAC THENL + [ASM_SIMP_TAC[]; + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC]);; + +(* max of a measurable function and a constant is measurable *) +let MEASURABLE_WRT_MAX_CONST = prove + (`!p:A prob_space G f c. + sub_sigma_algebra p G /\ measurable_wrt p G f + ==> measurable_wrt p G (\x. max (f x) c)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[measurable_wrt] THEN + X_GEN_TAC `v:real` THEN ASM_CASES_TAC `v < c` THENL + [SUBGOAL_THEN + `{x:A | x IN prob_carrier p /\ max (f x) c <= v} = {}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY; REAL_MAX_LE] THEN + GEN_TAC THEN ASM_REAL_ARITH_TAC; + ASM_MESON_TAC[sub_sigma_algebra; SIGMA_ALGEBRA_EMPTY]]; + SUBGOAL_THEN + `{x:A | x IN prob_carrier p /\ max (f x) c <= v} = + {x | x IN prob_carrier p /\ f x <= v}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; REAL_MAX_LE] THEN + GEN_TAC THEN EQ_TAC THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC; + UNDISCH_TAC `measurable_wrt (p:A prob_space) G (f:A->real)` THEN + REWRITE_TAC[measurable_wrt] THEN + DISCH_THEN(MP_TAC o SPEC `v:real`) THEN REWRITE_TAC[]]]);; + +(* Inverse of a measurable function that is >= 1 on the carrier is measurable *) +let MEASURABLE_WRT_INV_GE_ONE = prove + (`!p:A prob_space G f. + sub_sigma_algebra p G /\ measurable_wrt p G f /\ + (!x. x IN prob_carrier p ==> &1 <= f x) + ==> measurable_wrt p G (\x. inv(f x))`, + REPEAT GEN_TAC THEN STRIP_TAC THEN REWRITE_TAC[measurable_wrt] THEN + X_GEN_TAC `v:real` THEN ASM_CASES_TAC `v <= &0` THENL + [SUBGOAL_THEN + `{x:A | x IN prob_carrier p /\ inv(f x) <= v} = {}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; NOT_IN_EMPTY] THEN + X_GEN_TAC `x:A` THEN STRIP_TAC THEN + SUBGOAL_THEN `&0 < inv((f:A->real) x)` MP_TAC THENL + [MATCH_MP_TAC REAL_LT_INV THEN + MATCH_MP_TAC REAL_LTE_TRANS THEN EXISTS_TAC `&1` THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ASM_SIMP_TAC[]]; + ASM_REAL_ARITH_TAC]; + ASM_MESON_TAC[sub_sigma_algebra; SIGMA_ALGEBRA_EMPTY]]; + SUBGOAL_THEN `&0 < v` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_CASES_TAC `&1 <= v` THENL + [SUBGOAL_THEN + `{x:A | x IN prob_carrier p /\ inv(f x) <= v} = + prob_carrier p` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN + X_GEN_TAC `x:A` THEN EQ_TAC THENL + [SIMP_TAC[]; + DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&1` THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC REAL_INV_LE_1 THEN + ASM_SIMP_TAC[]]; + ASM_MESON_TAC[SUB_SIGMA_ALGEBRA_CARRIER_IN]]; + (* 0 < v < 1: {x | inv(f x) <= v} = {x | f x >= inv v} *) + SUBGOAL_THEN + `{x:A | x IN prob_carrier p /\ inv(f x) <= v} = + {x | x IN prob_carrier p /\ f x >= inv v}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; real_ge] THEN + X_GEN_TAC `x:A` THEN EQ_TAC THENL + [STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_LINV THEN + CONJ_TAC THENL + [ASM_MESON_TAC[REAL_LTE_TRANS; REAL_LT_01]; + ASM_REWRITE_TAC[]]; + STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_LE_LINV THEN ASM_REWRITE_TAC[]]; + MATCH_MP_TAC MEASURABLE_WRT_GE THEN ASM_REWRITE_TAC[]]]]);; + +(* L1 bound from L2 bound: E[|f|] <= (E[f^2] + 1) / 2 *) +(* This uses the elementary inequality |x| <= (x^2 + 1)/2 *) +let EXPECTATION_ABS_FROM_SQUARE = prove + (`!p:A prob_space f. + integrable p f /\ integrable p (\x. f x pow 2) + ==> expectation p (\x. abs(f x)) <= + (expectation p (\x. f x pow 2) + &1) / &2`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC + `expectation (p:A prob_space) (\x:A. ((f:A->real) x pow 2 + &1) / &2)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC EXPECTATION_MONO THEN + CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_ABS THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + CONJ_TAC THENL + [SUBGOAL_THEN + `(\x:A. ((f:A->real) x pow 2 + &1) / &2) = + (\x. inv(&2) * (f x pow 2 + &1))` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN REAL_ARITH_TAC; + MATCH_MP_TAC INTEGRABLE_CMUL THEN + MATCH_MP_TAC INTEGRABLE_ADD THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[INTEGRABLE_CONST]]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + MP_TAC(SPEC `abs((f:A->real) x) - &1` REAL_LE_POW_2) THEN + REWRITE_TAC[REAL_POW2_ABS] THEN REAL_ARITH_TAC]; + SUBGOAL_THEN + `(\x:A. ((f:A->real) x pow 2 + &1) / &2) = + (\x. inv(&2) * (f x pow 2 + &1))` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `expectation (p:A prob_space) (\x. inv(&2) * ((f:A->real) x pow 2 + &1)) = + inv(&2) * expectation p (\x. f x pow 2 + &1)` SUBST1_TAC THENL + [MATCH_MP_TAC EXPECTATION_CMUL THEN + MATCH_MP_TAC INTEGRABLE_ADD THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[INTEGRABLE_CONST]; ALL_TAC] THEN + SUBGOAL_THEN + `expectation (p:A prob_space) (\x. (f:A->real) x pow 2 + &1) = + expectation p (\x. f x pow 2) + &1` SUBST1_TAC THENL + [SUBGOAL_THEN + `expectation (p:A prob_space) (\x. (f:A->real) x pow 2 + &1) = + expectation p (\x. f x pow 2) + expectation p (\x:A. &1)` + SUBST1_TAC THENL + [MATCH_MP_TAC EXPECTATION_ADD THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[INTEGRABLE_CONST]; + REWRITE_TAC[EXPECTATION_CONST]]; + REAL_ARITH_TAC]]);; + +(* If f = 0 a.e. and is integrable, then E[f] = 0 *) +let EXPECTATION_AE_ZERO = prove + (`!p:A prob_space f. + integrable p f /\ almost_surely p {x | f x = &0} + ==> expectation p f = &0`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [almost_surely]) THEN + REWRITE_TAC[null_event; IN_ELIM_THM] THEN + STRIP_TAC THEN + SUBGOAL_THEN + `expectation (p:A prob_space) (f:A->real) = + expectation p (\x. f x * indicator_fn (n:A->bool) x)` SUBST1_TAC THENL + [MATCH_MP_TAC EXPECTATION_EXT THEN X_GEN_TAC `x:A` THEN DISCH_TAC THEN + REWRITE_TAC[indicator_fn] THEN + ASM_CASES_TAC `(f:A->real) x = &0` THENL + [ASM_REWRITE_TAC[REAL_MUL_LZERO]; ALL_TAC] THEN + SUBGOAL_THEN `(x:A) IN n` ASSUME_TAC THENL + [UNDISCH_TAC `{x:A | x IN prob_carrier p /\ ~(f x = &0)} SUBSET n` THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[REAL_MUL_RID]]; + MATCH_MP_TAC EXPECTATION_MUL_INDICATOR_ZERO_PROB THEN + ASM_REWRITE_TAC[]]);; + +(* a.e. version of EXPECTATION_ZERO_BOUNDED_MEASURABLE: *) +(* E[h * phi] = 0 when phi is G-measurable and a.e. bounded *) +let EXPECTATION_ZERO_AE_BOUNDED_MEASURABLE = prove + (`!p:A prob_space G (h:A->real) (phi:A->real) K. + sub_sigma_algebra p G /\ integrable p h /\ + (!B. B IN G ==> expectation p (\x. h x * indicator_fn B x) = &0) /\ + measurable_wrt p G phi /\ + integrable p (\x. h x * phi x) /\ + &0 <= K /\ almost_surely p {x | abs(phi x) <= K} + ==> expectation p (\x. h x * phi x) = &0`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + ABBREV_TAC `phi_K = \x:A. max (min ((phi:A->real) x) K) (--K)` THEN + SUBGOAL_THEN `measurable_wrt (p:A prob_space) G (phi_K:A->real)` ASSUME_TAC THENL + [EXPAND_TAC "phi_K" THEN MATCH_MP_TAC MEASURABLE_WRT_MAX_CONST THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `(\x:A. min ((phi:A->real) x) K) = (\x. --(max (--phi x) (--K)))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC MEASURABLE_WRT_NEG THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MEASURABLE_WRT_MAX_CONST THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MEASURABLE_WRT_NEG THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `!x:A. x IN prob_carrier p ==> abs((phi_K:A->real) x) <= K` + ASSUME_TAC THENL + [EXPAND_TAC "phi_K" THEN GEN_TAC THEN DISCH_TAC THEN + MATCH_MP_TAC(REAL_ARITH + `--K <= max (min (phi:real) K) (--K) /\ + max (min phi K) (--K) <= K + ==> abs(max (min phi K) (--K)) <= K`) THEN + CONJ_TAC THENL + [REAL_ARITH_TAC; + MATCH_MP_TAC(REAL_ARITH `a <= K /\ --K <= K ==> max a (--K) <= K`) THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ASM_REAL_ARITH_TAC]]; + ALL_TAC] THEN + SUBGOAL_THEN + `expectation (p:A prob_space) (\x. (h:A->real) x * (phi_K:A->real) x) = &0` + ASSUME_TAC THENL + [MATCH_MP_TAC EXPECTATION_ZERO_BOUNDED_MEASURABLE THEN + EXISTS_TAC `G:(A->bool)->bool` THEN EXISTS_TAC `K:real` THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `expectation (p:A prob_space) + (\x. (h:A->real) x * (phi:A->real) x - h x * (phi_K:A->real) x) = &0` + MP_TAC THENL + [MATCH_MP_TAC EXPECTATION_AE_ZERO THEN CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_SUB THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC INTEGRABLE_MUL_BOUNDED THEN + EXISTS_TAC `K:real` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MEASURABLE_WRT_IMP_RV THEN + EXISTS_TAC `G:(A->bool)->bool` THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[] THEN + MATCH_MP_TAC ALMOST_SURELY_SUBSET THEN + EXISTS_TAC `{x:A | abs((phi:A->real) x) <= K}` THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `x:A` THEN + REPEAT DISCH_TAC THEN EXPAND_TAC "phi_K" THEN + UNDISCH_TAC `abs((phi:A->real) x) <= K` THEN + REWRITE_TAC[REAL_ABS_BOUNDS] THEN STRIP_TAC THEN + SUBGOAL_THEN `min ((phi:A->real) x) K = phi x` SUBST1_TAC THENL + [REWRITE_TAC[real_min] THEN COND_CASES_TAC THEN ASM_REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `max ((phi:A->real) x) (--K) = phi x` SUBST1_TAC THENL + [REWRITE_TAC[real_max] THEN COND_CASES_TAC THEN ASM_REAL_ARITH_TAC; + REAL_ARITH_TAC]]; + DISCH_TAC THEN + SUBGOAL_THEN + `expectation (p:A prob_space) (\x. (h:A->real) x * (phi:A->real) x) = + expectation p (\x. h x * (phi_K:A->real) x) + + expectation p (\x. h x * phi x - h x * phi_K x)` SUBST1_TAC THENL + [SUBGOAL_THEN + `expectation (p:A prob_space) (\x. (h:A->real) x * (phi:A->real) x) = + expectation p (\x. h x * (phi_K:A->real) x + + (h x * phi x - h x * phi_K x))` + SUBST1_TAC THENL + [MATCH_MP_TAC EXPECTATION_EXT THEN GEN_TAC THEN DISCH_TAC THEN + REAL_ARITH_TAC; + MATCH_MP_TAC EXPECTATION_ADD THEN CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_MUL_BOUNDED THEN + EXISTS_TAC `K:real` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MEASURABLE_WRT_IMP_RV THEN + EXISTS_TAC `G:(A->bool)->bool` THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC INTEGRABLE_SUB THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC INTEGRABLE_MUL_BOUNDED THEN + EXISTS_TAC `K:real` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MEASURABLE_WRT_IMP_RV THEN + EXISTS_TAC `G:(A->bool)->bool` THEN ASM_REWRITE_TAC[]]]; + ASM_REAL_ARITH_TAC]]);; + +(* a.e. monotonicity of expectation *) +let EXPECTATION_MONO_AE = prove + (`!p:A prob_space f g. + integrable p f /\ integrable p g /\ + almost_surely p {x | f x <= g x} + ==> expectation p f <= expectation p g`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN + `&0 <= expectation (p:A prob_space) (\x. (g:A->real) x - (f:A->real) x)` + MP_TAC THENL + [ALL_TAC; + MP_TAC(ISPECL [`p:A prob_space`; `g:A->real`; `f:A->real`] EXPECTATION_SUB) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC] THEN + SUBGOAL_THEN `integrable (p:A prob_space) (\x. (g:A->real) x - (f:A->real) x)` + ASSUME_TAC THENL + [MATCH_MP_TAC INTEGRABLE_SUB THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + ABBREV_TAC `h = \x:A. (g:A->real) x - (f:A->real) x` THEN + SUBGOAL_THEN `integrable (p:A prob_space) (\x. max (--(h:A->real) x) (&0))` + ASSUME_TAC THENL + [MATCH_MP_TAC INTEGRABLE_MAX THEN CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_NEG THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[INTEGRABLE_CONST]]; ALL_TAC] THEN + SUBGOAL_THEN `integrable (p:A prob_space) (\x. max ((h:A->real) x) (&0))` + ASSUME_TAC THENL + [MATCH_MP_TAC INTEGRABLE_MAX THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + REWRITE_TAC[INTEGRABLE_CONST]]; ALL_TAC] THEN + SUBGOAL_THEN + `expectation (p:A prob_space) (h:A->real) = + expectation p (\x. max (h x) (&0)) - + expectation p (\x. max (--h x) (&0))` + SUBST1_TAC THENL + [SUBGOAL_THEN + `expectation (p:A prob_space) (h:A->real) = + expectation p (\x. max (h x) (&0) - max (--h x) (&0))` + SUBST1_TAC THENL + [MATCH_MP_TAC EXPECTATION_EXT THEN GEN_TAC THEN DISCH_TAC THEN + REAL_ARITH_TAC; + MATCH_MP_TAC EXPECTATION_SUB THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN + `expectation (p:A prob_space) (\x. max (--(h:A->real) x) (&0)) = &0` + SUBST1_TAC THENL + [MATCH_MP_TAC EXPECTATION_AE_ZERO THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC ALMOST_SURELY_SUBSET THEN + EXISTS_TAC `{x:A | (f:A->real) x <= (g:A->real) x}` THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN + GEN_TAC THEN EXPAND_TAC "h" THEN REAL_ARITH_TAC; + ALL_TAC] THEN + REWRITE_TAC[REAL_SUB_RZERO] THEN + MATCH_MP_TAC EXPECTATION_POS THEN ASM_REWRITE_TAC[] THEN + GEN_TAC THEN DISCH_TAC THEN REAL_ARITH_TAC);; + +(* gen_cond_exp of indicator is in [0,1] a.e. *) +let COND_EXP_INDICATOR_BOUNDED_AE = prove + (`!p FF (B:num->A->bool). + filtration p FF /\ (!n. B n IN prob_events p) /\ + (!n. B n SUBSET prob_carrier p) /\ (!n. B n IN FF n) + ==> !k. almost_surely p + {x | &0 <= gen_cond_exp p (FF k) (\y. indicator_fn (B (SUC k)) y) x /\ + gen_cond_exp p (FF k) (\y. indicator_fn (B (SUC k)) y) x <= &1}`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `sub_sigma_algebra p ((FF:num->(A->bool)->bool) k)` ASSUME_TAC THENL + [ASM_MESON_TAC[filtration]; ALL_TAC] THEN + SUBGOAL_THEN `integrable p (\y:A. indicator_fn ((B:num->A->bool) (SUC k)) y)` + ASSUME_TAC THENL + [REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC INTEGRABLE_INDICATOR THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC ALMOST_SURELY_SUBSET THEN + EXISTS_TAC `{x:A | &0 <= gen_cond_exp p ((FF:num->(A->bool)->bool) k) + (\y. indicator_fn (B (SUC k)) y) x} INTER + ({x | gen_cond_exp p (FF k) (\y. indicator_fn (B (SUC k)) y) x <= + gen_cond_exp p (FF k) (\w:A. &1) x} INTER + {x | gen_cond_exp p (FF k) (\w. &1) x = &1})` THEN + CONJ_TAC THENL + [REPEAT(MATCH_MP_TAC ALMOST_SURELY_INTER THEN CONJ_TAC) THENL + [MATCH_MP_TAC GEN_COND_EXP_NONNEG THEN ASM_REWRITE_TAC[] THEN + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[indicator_fn] THEN + COND_CASES_TAC THEN REAL_ARITH_TAC; + MATCH_MP_TAC GEN_COND_EXP_MONOTONE THEN + ASM_REWRITE_TAC[INTEGRABLE_CONST] THEN + GEN_TAC THEN DISCH_TAC THEN REWRITE_TAC[indicator_fn] THEN + COND_CASES_TAC THEN REAL_ARITH_TAC; + MATCH_MP_TAC GEN_COND_EXP_CONST THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN + REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN + X_GEN_TAC `x:A` THEN DISCH_TAC THEN STRIP_TAC THEN + FIRST_ASSUM(SUBST1_TAC o SYM) THEN ASM_REWRITE_TAC[]);; + +(* min preserves measurability *) +let MEASURABLE_WRT_MIN_CONST = prove + (`!p G (f:A->real) c. + sub_sigma_algebra p G /\ measurable_wrt p G f + ==> measurable_wrt p G (\x. min (f x) c)`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(\x:A. min ((f:A->real) x) c) = + (\x. --(max (--f x) (--c)))` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `(\x:A. --(max (--(f:A->real) x) (--c))) = + (\x. &0 - max (&0 - f x) (--c))` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC MEASURABLE_WRT_SUB THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_WRT_CONST THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC MEASURABLE_WRT_MAX_CONST THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MEASURABLE_WRT_SUB THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MEASURABLE_WRT_CONST THEN ASM_REWRITE_TAC[]);; + +(* The rescaled martingale T_n = sum(d_k/(1+V_k)) converges a.e. *) +(* Strategy: T' with max(1+V_k,1) denominator is a martingale with *) +(* bounded L1 norm; apply SUBMARTINGALE_CONVERGENCE_L1_BOUNDED. Since *) +(* v_k >= 0 a.e., max(1+V_k,1) = 1+V_k a.e., so T' = T a.e. *) + +(* Martingale difference d_k = f - E[f|G] is orthogonal to G *) +let MARTINGALE_DIFF_ORTHOGONAL = prove + (`!p:A prob_space G f. + sub_sigma_algebra p G /\ integrable p f + ==> !A. A IN G ==> + expectation p (\x. (f x - gen_cond_exp p G f x) * + indicator_fn A x) = &0`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `(A:A->bool) IN prob_events p` ASSUME_TAC THENL + [ASM_MESON_TAC[SUB_SIGMA_ALGEBRA_IN_EVENTS]; ALL_TAC] THEN + SUBGOAL_THEN `integrable (p:A prob_space) (gen_cond_exp p G (f:A->real))` + ASSUME_TAC THENL + [MATCH_MP_TAC GEN_COND_EXP_INTEGRABLE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `(\x:A. ((f:A->real) x - gen_cond_exp p G f x) * indicator_fn A x) = + (\x. f x * indicator_fn A x - + gen_cond_exp p G f x * indicator_fn A x)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN + `expectation (p:A prob_space) (\x. (f:A->real) x * indicator_fn A x - + gen_cond_exp p G f x * indicator_fn A x) = + expectation p (\x. f x * indicator_fn A x) - + expectation p (\x. gen_cond_exp p G f x * indicator_fn A x)` + SUBST1_TAC THENL + [MATCH_MP_TAC EXPECTATION_SUB THEN CONJ_TAC THEN + MATCH_MP_TAC INTEGRABLE_MUL_INDICATOR_FN THEN + ASM_REWRITE_TAC[ETA_AX]; ALL_TAC] THEN + MP_TAC(ISPECL [`p:A prob_space`; `G:(A->bool)->bool`; + `f:A->real`; `A:A->bool`] GEN_COND_EXP_CONDITIONING) THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC);; + +(* Helper: T' is a martingale w.r.t. shifted filtration *) +let RESCALED_MAX_MARTINGALE = prove + (`!p FF (B:num->A->bool). + filtration p FF /\ (!n. B n IN prob_events p) /\ + (!n. B n SUBSET prob_carrier p) /\ (!n. B n IN FF n) + ==> martingale p (\n. FF(SUC n)) + (\n x. sum(0..n) + (\k. (indicator_fn (B (SUC k)) x - + gen_cond_exp p (FF k) + (\y. indicator_fn (B (SUC k)) y) x) / + max (&1 + sum(0..k) + (\j. gen_cond_exp p (FF j) + (\y. indicator_fn (B (SUC j)) y) x)) (&1)))`, + REWRITE_TAC[martingale] THEN REPEAT GEN_TAC THEN STRIP_TAC THEN + (* Establish useful facts *) + SUBGOAL_THEN `!k. sub_sigma_algebra p ((FF:num->(A->bool)->bool) k)` + ASSUME_TAC THENL [ASM_MESON_TAC[filtration]; ALL_TAC] THEN + SUBGOAL_THEN `!k:num. integrable p (indicator_fn ((B:num->A->bool) (SUC k)))` + ASSUME_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC INTEGRABLE_INDICATOR THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN + `!k. measurable_wrt p ((FF:num->(A->bool)->bool) k) + (gen_cond_exp p (FF k) (indicator_fn ((B:num->A->bool) (SUC k))))` + ASSUME_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC GEN_COND_EXP_MEASURABLE_WRT THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `!k. integrable p + (gen_cond_exp p ((FF:num->(A->bool)->bool) k) + (indicator_fn ((B:num->A->bool) (SUC k))))` + ASSUME_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC GEN_COND_EXP_INTEGRABLE THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + REPEAT CONJ_TAC THENL + [(* 1. Shifted filtration *) + MATCH_MP_TAC SHIFTED_FILTRATION THEN ASM_REWRITE_TAC[]; + (* 2. Adapted: T'_n is FF(SUC n)-measurable *) + REWRITE_TAC[adapted] THEN X_GEN_TAC `n:num` THEN REWRITE_TAC[] THEN + MATCH_MP_TAC MEASURABLE_WRT_SUM THEN + CONJ_TAC THENL [ASM_MESON_TAC[filtration]; ALL_TAC] THEN + X_GEN_TAC `k:num` THEN DISCH_TAC THEN + REWRITE_TAC[real_div] THEN + MATCH_MP_TAC MEASURABLE_WRT_MUL THEN + CONJ_TAC THENL [ASM_MESON_TAC[filtration]; ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_WRT_SUB THEN + CONJ_TAC THENL [ASM_MESON_TAC[filtration]; ALL_TAC] THEN + CONJ_TAC THENL + [REWRITE_TAC[ETA_AX] THEN + MATCH_MP_TAC MEASURABLE_WRT_MONO THEN + EXISTS_TAC `(FF:num->(A->bool)->bool) (SUC k)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_WRT_INDICATOR THEN ASM_REWRITE_TAC[]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [filtration]) THEN + STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC]; + REWRITE_TAC[ETA_AX] THEN + MATCH_MP_TAC MEASURABLE_WRT_MONO THEN + EXISTS_TAC `(FF:num->(A->bool)->bool) k` THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [filtration]) THEN + STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC]]; + MATCH_MP_TAC MEASURABLE_WRT_INV_GE_ONE THEN + CONJ_TAC THENL [ASM_MESON_TAC[filtration]; ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_WRT_MAX_CONST THEN + CONJ_TAC THENL [ASM_MESON_TAC[filtration]; ALL_TAC] THEN + MATCH_MP_TAC MEASURABLE_WRT_ADD THEN + CONJ_TAC THENL [ASM_MESON_TAC[filtration]; ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_WRT_CONST THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC MEASURABLE_WRT_SUM THEN + CONJ_TAC THENL [ASM_MESON_TAC[filtration]; ALL_TAC] THEN + X_GEN_TAC `j:num` THEN DISCH_TAC THEN + REWRITE_TAC[ETA_AX] THEN + MATCH_MP_TAC MEASURABLE_WRT_MONO THEN + EXISTS_TAC `(FF:num->(A->bool)->bool) j` THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [filtration]) THEN + STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC]]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN REAL_ARITH_TAC]]; + (* 3. Integrable *) + X_GEN_TAC `n:num` THEN REWRITE_TAC[] THEN + MATCH_MP_TAC INTEGRABLE_SUM THEN X_GEN_TAC `k:num` THEN DISCH_TAC THEN + REWRITE_TAC[real_div] THEN + MATCH_MP_TAC INTEGRABLE_MUL_BOUNDED THEN EXISTS_TAC `&1` THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_SUB THEN REWRITE_TAC[ETA_AX] THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC MEASURABLE_WRT_IMP_RV THEN + EXISTS_TAC `(FF:num->(A->bool)->bool) (SUC n)` THEN + CONJ_TAC THENL [ASM_MESON_TAC[filtration]; ALL_TAC] THEN + REWRITE_TAC[ETA_AX] THEN + MATCH_MP_TAC MEASURABLE_WRT_INV_GE_ONE THEN + CONJ_TAC THENL [ASM_MESON_TAC[filtration]; ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_WRT_MAX_CONST THEN + CONJ_TAC THENL [ASM_MESON_TAC[filtration]; ALL_TAC] THEN + MATCH_MP_TAC MEASURABLE_WRT_ADD THEN + CONJ_TAC THENL [ASM_MESON_TAC[filtration]; ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_WRT_CONST THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC MEASURABLE_WRT_SUM THEN + CONJ_TAC THENL [ASM_MESON_TAC[filtration]; ALL_TAC] THEN + X_GEN_TAC `j:num` THEN DISCH_TAC THEN + REWRITE_TAC[ETA_AX] THEN + MATCH_MP_TAC MEASURABLE_WRT_MONO THEN + EXISTS_TAC `(FF:num->(A->bool)->bool) j` THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [filtration]) THEN + STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC]]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN REAL_ARITH_TAC]; + REAL_ARITH_TAC; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + REWRITE_TAC[REAL_ABS_INV] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(&1)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INV2 THEN + CONJ_TAC THENL [REAL_ARITH_TAC; REWRITE_TAC[real_abs] THEN + REAL_ARITH_TAC]; + REWRITE_TAC[REAL_INV_1] THEN REAL_ARITH_TAC]]; + (* 4. Increment property: E[T'(SUC n)*1_a] = E[T'(n)*1_a] *) + X_GEN_TAC `n:num` THEN X_GEN_TAC `a:A->bool` THEN DISCH_TAC THEN + SUBGOAL_THEN `(a:A->bool) IN prob_events p` ASSUME_TAC THENL + [ASM_MESON_TAC[SUB_SIGMA_ALGEBRA_IN_EVENTS; filtration]; ALL_TAC] THEN + (* Rewrite sum(0..SUC n) as sum(0..n) + last term *) + REWRITE_TAC[SUM_CLAUSES_NUMSEG; LE_0] THEN + REWRITE_TAC[ETA_AX] THEN + (* Distribute multiplication over addition *) + SUBGOAL_THEN + `!x:A. (sum (0..n) + (\k. (indicator_fn ((B:num->A->bool) (SUC k)) x - + gen_cond_exp p (FF k) (indicator_fn (B (SUC k))) x) / + max (&1 + sum (0..k) + (\j. gen_cond_exp p (FF j) (indicator_fn (B (SUC j))) x)) + (&1)) + + (indicator_fn (B (SUC (SUC n))) x - + gen_cond_exp p (FF (SUC n)) (indicator_fn (B (SUC (SUC n)))) x) / + max (&1 + sum (0..n) + (\j. gen_cond_exp p (FF j) (indicator_fn (B (SUC j))) x) + + gen_cond_exp p (FF (SUC n)) (indicator_fn (B (SUC (SUC n)))) x) + (&1)) * indicator_fn a x = + sum (0..n) + (\k. (indicator_fn (B (SUC k)) x - + gen_cond_exp p (FF k) (indicator_fn (B (SUC k))) x) / + max (&1 + sum (0..k) + (\j. gen_cond_exp p (FF j) (indicator_fn (B (SUC j))) x)) + (&1)) * indicator_fn a x + + (indicator_fn (B (SUC (SUC n))) x - + gen_cond_exp p (FF (SUC n)) (indicator_fn (B (SUC (SUC n)))) x) / + max (&1 + sum (0..n) + (\j. gen_cond_exp p (FF j) (indicator_fn (B (SUC j))) x) + + gen_cond_exp p (FF (SUC n)) (indicator_fn (B (SUC (SUC n)))) x) + (&1) * indicator_fn a x` + (fun th -> REWRITE_TAC[th]) THENL + [GEN_TAC THEN REAL_ARITH_TAC; ALL_TAC] THEN + (* d_{SUC n} is integrable *) + SUBGOAL_THEN + `integrable p (\x:A. indicator_fn ((B:num->A->bool) (SUC (SUC n))) x - + gen_cond_exp p (FF (SUC n)) (indicator_fn (B (SUC (SUC n)))) x)` + ASSUME_TAC THENL + [MATCH_MP_TAC INTEGRABLE_SUB THEN REWRITE_TAC[ETA_AX] THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + (* E[inc * 1_a] = 0 via EXPECTATION_ZERO_BOUNDED_MEASURABLE *) + SUBGOAL_THEN + `expectation p (\x:A. + (indicator_fn ((B:num->A->bool) (SUC (SUC n))) x - + gen_cond_exp p (FF (SUC n)) (indicator_fn (B (SUC (SUC n)))) x) / + max (&1 + sum (0..n) + (\j. gen_cond_exp p (FF j) (indicator_fn (B (SUC j))) x) + + gen_cond_exp p (FF (SUC n)) (indicator_fn (B (SUC (SUC n)))) x) + (&1) * indicator_fn a x) = &0` + ASSUME_TAC THENL + [REWRITE_TAC[real_div] THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN + MP_TAC(ISPECL + [`p:A prob_space`; + `(FF:num->(A->bool)->bool) (SUC n)`; + `\x:A. indicator_fn ((B:num->A->bool) (SUC (SUC n))) x - + gen_cond_exp p ((FF:num->(A->bool)->bool) (SUC n)) + (indicator_fn (B (SUC (SUC n)))) x`; + `\x:A. inv(max (&1 + sum (0..n) + (\j. gen_cond_exp p ((FF:num->(A->bool)->bool) j) + (indicator_fn ((B:num->A->bool) (SUC j))) x) + + gen_cond_exp p (FF (SUC n)) (indicator_fn (B (SUC (SUC n)))) x) + (&1)) * indicator_fn (a:A->bool) x`; + `&1`] + EXPECTATION_ZERO_BOUNDED_MEASURABLE) THEN + REWRITE_TAC[REAL_MUL_ASSOC] THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [(* sub_sigma_algebra p (FF (SUC n)) *) + ASM_MESON_TAC[filtration]; + (* integrable p d *) + ASM_REWRITE_TAC[]; + (* E[d * 1_B'] = 0 for B' in FF(SUC n) *) + X_GEN_TAC `B':A->bool` THEN DISCH_TAC THEN + MP_TAC(ISPECL + [`p:A prob_space`; + `(FF:num->(A->bool)->bool) (SUC n)`; + `indicator_fn ((B:num->A->bool) (SUC (SUC n)))`] + MARTINGALE_DIFF_ORTHOGONAL) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `B':A->bool`) THEN + ASM_REWRITE_TAC[]; + (* measurable_wrt phi *) + MATCH_MP_TAC MEASURABLE_WRT_MUL THEN + CONJ_TAC THENL [ASM_MESON_TAC[filtration]; ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_WRT_INV_GE_ONE THEN + CONJ_TAC THENL [ASM_MESON_TAC[filtration]; ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_WRT_MAX_CONST THEN + CONJ_TAC THENL [ASM_MESON_TAC[filtration]; ALL_TAC] THEN + MATCH_MP_TAC MEASURABLE_WRT_ADD THEN + CONJ_TAC THENL [ASM_MESON_TAC[filtration]; ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_WRT_CONST THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC MEASURABLE_WRT_ADD THEN + CONJ_TAC THENL [ASM_MESON_TAC[filtration]; ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_WRT_SUM THEN + CONJ_TAC THENL [ASM_MESON_TAC[filtration]; ALL_TAC] THEN + X_GEN_TAC `j:num` THEN DISCH_TAC THEN + REWRITE_TAC[ETA_AX] THEN + MATCH_MP_TAC MEASURABLE_WRT_MONO THEN + EXISTS_TAC `(FF:num->(A->bool)->bool) j` THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [filtration]) THEN + STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC]; + REWRITE_TAC[ETA_AX] THEN ASM_REWRITE_TAC[]]]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN REAL_ARITH_TAC]; + REWRITE_TAC[ETA_AX] THEN + MATCH_MP_TAC MEASURABLE_WRT_INDICATOR THEN ASM_REWRITE_TAC[]]; + (* &0 <= K *) + REAL_ARITH_TAC; + (* |phi| <= 1 *) + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + REWRITE_TAC[REAL_ABS_MUL] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&1 * &1` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN + CONJ_TAC THENL + [REWRITE_TAC[REAL_ABS_INV] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(&1)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INV2 THEN + CONJ_TAC THENL [REAL_ARITH_TAC; REWRITE_TAC[real_abs] THEN + REAL_ARITH_TAC]; + REWRITE_TAC[REAL_INV_1] THEN REAL_ARITH_TAC]; + REWRITE_TAC[indicator_fn] THEN COND_CASES_TAC THEN REAL_ARITH_TAC]; + REAL_ARITH_TAC]]; + REWRITE_TAC[]]; + ALL_TAC] THEN + (* Integrability of sum * 1_a *) + SUBGOAL_THEN + `integrable p (\x:A. + sum (0..n) + (\k. (indicator_fn ((B:num->A->bool) (SUC k)) x - + gen_cond_exp p (FF k) (indicator_fn (B (SUC k))) x) / + max (&1 + sum (0..k) + (\j. gen_cond_exp p (FF j) (indicator_fn (B (SUC j))) x)) + (&1)) * indicator_fn a x)` + ASSUME_TAC THENL + [MATCH_MP_TAC INTEGRABLE_MUL_BOUNDED THEN EXISTS_TAC `&1` THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_SUM THEN X_GEN_TAC `k:num` THEN DISCH_TAC THEN + REWRITE_TAC[real_div] THEN + MATCH_MP_TAC INTEGRABLE_MUL_BOUNDED THEN EXISTS_TAC `&1` THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_SUB THEN REWRITE_TAC[ETA_AX] THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC MEASURABLE_WRT_IMP_RV THEN + EXISTS_TAC `(FF:num->(A->bool)->bool) (SUC n)` THEN + CONJ_TAC THENL [ASM_MESON_TAC[filtration]; ALL_TAC] THEN + REWRITE_TAC[ETA_AX] THEN + MATCH_MP_TAC MEASURABLE_WRT_INV_GE_ONE THEN + CONJ_TAC THENL [ASM_MESON_TAC[filtration]; ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_WRT_MAX_CONST THEN + CONJ_TAC THENL [ASM_MESON_TAC[filtration]; ALL_TAC] THEN + MATCH_MP_TAC MEASURABLE_WRT_ADD THEN + CONJ_TAC THENL [ASM_MESON_TAC[filtration]; ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_WRT_CONST THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC MEASURABLE_WRT_SUM THEN + CONJ_TAC THENL [ASM_MESON_TAC[filtration]; ALL_TAC] THEN + X_GEN_TAC `j:num` THEN DISCH_TAC THEN + REWRITE_TAC[ETA_AX] THEN + MATCH_MP_TAC MEASURABLE_WRT_MONO THEN + EXISTS_TAC `(FF:num->(A->bool)->bool) j` THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [filtration]) THEN + STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC]]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN REAL_ARITH_TAC]; + REAL_ARITH_TAC; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + REWRITE_TAC[REAL_ABS_INV] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(&1)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INV2 THEN + CONJ_TAC THENL [REAL_ARITH_TAC; REWRITE_TAC[real_abs] THEN + REAL_ARITH_TAC]; + REWRITE_TAC[REAL_INV_1] THEN REAL_ARITH_TAC]]; + REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC INTEGRABLE_IMP_RANDOM_VARIABLE THEN + MATCH_MP_TAC INTEGRABLE_INDICATOR THEN ASM_REWRITE_TAC[]; + REAL_ARITH_TAC; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + REWRITE_TAC[indicator_fn] THEN COND_CASES_TAC THEN REAL_ARITH_TAC]; + ALL_TAC] THEN + (* Integrability of inc * 1_a *) + SUBGOAL_THEN + `integrable p (\x:A. + (indicator_fn ((B:num->A->bool) (SUC (SUC n))) x - + gen_cond_exp p (FF (SUC n)) (indicator_fn (B (SUC (SUC n)))) x) / + max (&1 + sum (0..n) + (\j. gen_cond_exp p (FF j) (indicator_fn (B (SUC j))) x) + + gen_cond_exp p (FF (SUC n)) (indicator_fn (B (SUC (SUC n)))) x) + (&1) * indicator_fn a x)` + ASSUME_TAC THENL + [MATCH_MP_TAC INTEGRABLE_MUL_BOUNDED THEN EXISTS_TAC `&1` THEN + REPEAT CONJ_TAC THENL + [REWRITE_TAC[real_div] THEN + MATCH_MP_TAC INTEGRABLE_MUL_BOUNDED THEN EXISTS_TAC `&1` THEN + REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + MATCH_MP_TAC MEASURABLE_WRT_IMP_RV THEN + EXISTS_TAC `(FF:num->(A->bool)->bool) (SUC n)` THEN + CONJ_TAC THENL [ASM_MESON_TAC[filtration]; ALL_TAC] THEN + MATCH_MP_TAC MEASURABLE_WRT_INV_GE_ONE THEN + CONJ_TAC THENL [ASM_MESON_TAC[filtration]; ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_WRT_MAX_CONST THEN + CONJ_TAC THENL [ASM_MESON_TAC[filtration]; ALL_TAC] THEN + MATCH_MP_TAC MEASURABLE_WRT_ADD THEN + CONJ_TAC THENL [ASM_MESON_TAC[filtration]; ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_WRT_CONST THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC MEASURABLE_WRT_ADD THEN + CONJ_TAC THENL [ASM_MESON_TAC[filtration]; ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_WRT_SUM THEN + CONJ_TAC THENL [ASM_MESON_TAC[filtration]; ALL_TAC] THEN + X_GEN_TAC `j:num` THEN DISCH_TAC THEN + REWRITE_TAC[ETA_AX] THEN + MATCH_MP_TAC MEASURABLE_WRT_MONO THEN + EXISTS_TAC `(FF:num->(A->bool)->bool) j` THEN + CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [filtration]) THEN + STRIP_TAC THEN FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_ARITH_TAC]; + REWRITE_TAC[ETA_AX] THEN ASM_REWRITE_TAC[]]]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN REAL_ARITH_TAC]; + REAL_ARITH_TAC; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + REWRITE_TAC[REAL_ABS_INV] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `inv(&1)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_INV2 THEN + CONJ_TAC THENL [REAL_ARITH_TAC; REWRITE_TAC[real_abs] THEN + REAL_ARITH_TAC]; + REWRITE_TAC[REAL_INV_1] THEN REAL_ARITH_TAC]]; + REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC INTEGRABLE_IMP_RANDOM_VARIABLE THEN + MATCH_MP_TAC INTEGRABLE_INDICATOR THEN ASM_REWRITE_TAC[]; + REAL_ARITH_TAC; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + REWRITE_TAC[indicator_fn] THEN COND_CASES_TAC THEN REAL_ARITH_TAC]; + ALL_TAC] THEN + (* Combine: E[f + g] = E[f] + E[g] = E[f] + 0 = E[f] *) + SUBGOAL_THEN + `expectation (p:A prob_space) + (\x. sum (0..n) + (\k. (indicator_fn ((B:num->A->bool) (SUC k)) x - + gen_cond_exp p (FF k) (indicator_fn (B (SUC k))) x) / + max (&1 + sum (0..k) + (\j. gen_cond_exp p (FF j) (indicator_fn (B (SUC j))) x)) + (&1)) * indicator_fn a x + + (indicator_fn (B (SUC (SUC n))) x - + gen_cond_exp p (FF (SUC n)) (indicator_fn (B (SUC (SUC n)))) x) / + max (&1 + sum (0..n) + (\j. gen_cond_exp p (FF j) (indicator_fn (B (SUC j))) x) + + gen_cond_exp p (FF (SUC n)) (indicator_fn (B (SUC (SUC n)))) x) + (&1) * indicator_fn a x) = + expectation p + (\x. sum (0..n) + (\k. (indicator_fn (B (SUC k)) x - + gen_cond_exp p (FF k) (indicator_fn (B (SUC k))) x) / + max (&1 + sum (0..k) + (\j. gen_cond_exp p (FF j) (indicator_fn (B (SUC j))) x)) + (&1)) * indicator_fn a x) + + expectation p + (\x. (indicator_fn (B (SUC (SUC n))) x - + gen_cond_exp p (FF (SUC n)) (indicator_fn (B (SUC (SUC n)))) x) / + max (&1 + sum (0..n) + (\j. gen_cond_exp p (FF j) (indicator_fn (B (SUC j))) x) + + gen_cond_exp p (FF (SUC n)) (indicator_fn (B (SUC (SUC n)))) x) + (&1) * indicator_fn a x)` + SUBST1_TAC THENL + [MATCH_MP_TAC EXPECTATION_ADD THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC]);; + +(* Truncated martingale difference has zero expectation against bounded *) +(* measurable functions *) +let TRUNCATED_DIFF_EXPECTATION_ZERO = prove + (`!p FF (B:num->A->bool) k phi K. + filtration p FF /\ (!n. B n IN prob_events p) /\ + (!n. B n SUBSET prob_carrier p) /\ (!n. B n IN FF n) /\ + integrable p phi /\ + measurable_wrt p (FF k) phi /\ + &0 <= K /\ + (!x. x IN prob_carrier p ==> abs(phi x) <= K) + ==> expectation p + (\x. (indicator_fn (B (SUC k)) x - + max (min (gen_cond_exp p (FF k) + (\y. indicator_fn (B (SUC k)) y) x) (&1)) (&0)) * + phi x) = &0`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + ABBREV_TAC `v = gen_cond_exp p ((FF:num->(A->bool)->bool) k) + (\y. indicator_fn ((B:num->A->bool) (SUC k)) y)` THEN + SUBGOAL_THEN `sub_sigma_algebra p ((FF:num->(A->bool)->bool) k)` ASSUME_TAC THENL + [ASM_MESON_TAC[filtration]; ALL_TAC] THEN + SUBGOAL_THEN `integrable p (\y:A. indicator_fn ((B:num->A->bool) (SUC k)) y)` + ASSUME_TAC THENL + [REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC INTEGRABLE_INDICATOR THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC EXPECTATION_ZERO_BOUNDED_MEASURABLE THEN + EXISTS_TAC `(FF:num->(A->bool)->bool) k` THEN + EXISTS_TAC `K:real` THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [(* Integrability of h = 1_B - max(min(v,1),0) *) + MATCH_MP_TAC INTEGRABLE_SUB THEN CONJ_TAC THENL + [REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC INTEGRABLE_INDICATOR THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC INTEGRABLE_BOUNDED THEN EXISTS_TAC `&1` THEN + CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_WRT_IMP_RV THEN + EXISTS_TAC `(FF:num->(A->bool)->bool) k` THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MEASURABLE_WRT_MAX_CONST THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MEASURABLE_WRT_MIN_CONST THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[GEN_COND_EXP_MEASURABLE_WRT]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN REAL_ARITH_TAC]; + ALL_TAC] THEN + (* E[h * 1_A] = 0 for A in FF k *) + X_GEN_TAC `A:A->bool` THEN DISCH_TAC THEN + (* Split: h = (1_B - v) + (v - max(min(v,1),0)) *) + SUBGOAL_THEN + `(\x:A. (indicator_fn ((B:num->A->bool) (SUC k)) x - + max (min (v x) (&1)) (&0)) * indicator_fn (A:A->bool) x) = + (\x. (indicator_fn (B (SUC k)) x - v x) * indicator_fn A x + + (v x - max (min (v x) (&1)) (&0)) * indicator_fn A x)` + (fun th -> REWRITE_TAC[th]) THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `(A:A->bool) IN prob_events p` ASSUME_TAC THENL + [ASM_MESON_TAC[SUB_SIGMA_ALGEBRA_IN_EVENTS]; ALL_TAC] THEN + SUBGOAL_THEN + `expectation p + (\x:A. (indicator_fn ((B:num->A->bool) (SUC k)) x - v x) * + indicator_fn (A:A->bool) x + + (v x - max (min (v x) (&1)) (&0)) * indicator_fn A x) = + expectation p (\x. (indicator_fn (B (SUC k)) x - v x) * + indicator_fn A x) + + expectation p (\x. (v x - max (min (v x) (&1)) (&0)) * + indicator_fn A x)` + SUBST1_TAC THENL + [MATCH_MP_TAC EXPECTATION_ADD THEN CONJ_TAC THEN + MATCH_MP_TAC INTEGRABLE_MUL_INDICATOR_FN THEN + ASM_REWRITE_TAC[ETA_AX] THENL + [MATCH_MP_TAC INTEGRABLE_SUB THEN CONJ_TAC THENL + [REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC INTEGRABLE_INDICATOR THEN + ASM_REWRITE_TAC[]; + EXPAND_TAC "v" THEN MATCH_MP_TAC GEN_COND_EXP_INTEGRABLE THEN + ASM_REWRITE_TAC[]]; + MATCH_MP_TAC INTEGRABLE_SUB THEN CONJ_TAC THENL + [EXPAND_TAC "v" THEN MATCH_MP_TAC GEN_COND_EXP_INTEGRABLE THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC INTEGRABLE_BOUNDED THEN EXISTS_TAC `&1` THEN + CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_WRT_IMP_RV THEN + EXISTS_TAC `(FF:num->(A->bool)->bool) k` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MEASURABLE_WRT_MAX_CONST THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MEASURABLE_WRT_MIN_CONST THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[GEN_COND_EXP_MEASURABLE_WRT]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN REAL_ARITH_TAC]]]; + ALL_TAC] THEN + (* First term: E[(1_B - v) * 1_A] = 0 by MARTINGALE_DIFF_ORTHOGONAL *) + SUBGOAL_THEN + `expectation p (\x:A. (indicator_fn ((B:num->A->bool) (SUC k)) x - v x) * + indicator_fn (A:A->bool) x) = &0` SUBST1_TAC THENL + [MP_TAC(ISPECL [`p:A prob_space`; `(FF:num->(A->bool)->bool) k`; + `\y:A. indicator_fn ((B:num->A->bool) (SUC k)) y`] + MARTINGALE_DIFF_ORTHOGONAL) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `A:A->bool`) THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC(TAUT `(a = b) ==> a ==> b`) THEN + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN + X_GEN_TAC `x:A` THEN EXPAND_TAC "v" THEN REFL_TAC; + ALL_TAC] THEN + REWRITE_TAC[REAL_ADD_LID] THEN + (* Second term: E[(v - max(min(v,1),0)) * 1_A] = 0 since v = v' a.e. *) + MATCH_MP_TAC EXPECTATION_AE_ZERO THEN + CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_MUL_INDICATOR_FN THEN ASM_REWRITE_TAC[ETA_AX] THEN + MATCH_MP_TAC INTEGRABLE_SUB THEN CONJ_TAC THENL + [EXPAND_TAC "v" THEN MATCH_MP_TAC GEN_COND_EXP_INTEGRABLE THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC INTEGRABLE_BOUNDED THEN EXISTS_TAC `&1` THEN + CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_WRT_IMP_RV THEN + EXISTS_TAC `(FF:num->(A->bool)->bool) k` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MEASURABLE_WRT_MAX_CONST THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MEASURABLE_WRT_MIN_CONST THEN ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[GEN_COND_EXP_MEASURABLE_WRT]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN REAL_ARITH_TAC]]; + ALL_TAC] THEN + (* v = max(min(v,1),0) a.e. by COND_EXP_INDICATOR_BOUNDED_AE *) + MATCH_MP_TAC ALMOST_SURELY_SUBSET THEN + EXISTS_TAC `{x:A | &0 <= v x /\ v x <= &1}` THEN + CONJ_TAC THENL + [MP_TAC(ISPECL [`p:A prob_space`; `FF:num->(A->bool)->bool`; + `B:num->A->bool`] COND_EXP_INDICATOR_BOUNDED_AE) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPEC `k:num`) THEN + ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `x:A` THEN + STRIP_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `max (min (v (x:A)) (&1)) (&0) = v x` SUBST1_TAC THENL + [MATCH_MP_TAC(REAL_ARITH + `&0 <= x /\ x <= &1 ==> max (min x (&1)) (&0) = x`) THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[REAL_SUB_REFL; REAL_MUL_LZERO]]);; + +(* E[(1_B - v')^2 * phi] <= E[v' * phi] for non-negative F_k-meas phi *) +let TRUNCATED_DIFF_SQ_BOUND = prove + (`!p FF (B:num->A->bool) k phi (K:real). + filtration p FF /\ (!n. B n IN prob_events p) /\ + (!n. B n SUBSET prob_carrier p) /\ (!n. B n IN FF n) /\ + integrable p phi /\ measurable_wrt p (FF k) phi /\ + &0 <= K /\ (!x:A. x IN prob_carrier p ==> abs(phi x) <= K) /\ + (!x:A. x IN prob_carrier p ==> &0 <= phi x) + ==> expectation p + (\x. (indicator_fn (B (SUC k)) x - + max (min (gen_cond_exp p (FF k) + (\y. indicator_fn (B (SUC k)) y) x) (&1)) (&0)) pow 2 * + phi x) <= + expectation p + (\x. max (min (gen_cond_exp p (FF k) + (\y. indicator_fn (B (SUC k)) y) x) (&1)) (&0) * + phi x)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + ABBREV_TAC `v' = \x:A. max (min (gen_cond_exp p ((FF:num->(A->bool)->bool) k) + (\y. indicator_fn ((B:num->A->bool) (SUC k)) y) x) (&1)) (&0)` THEN + SUBGOAL_THEN `!x:A. max (min (gen_cond_exp p ((FF:num->(A->bool)->bool) k) + (\y. indicator_fn ((B:num->A->bool) (SUC k)) y) x) (&1)) (&0) = + (v':A->real) x` ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `!x:A. &0 <= (v':A->real) x /\ v' x <= &1` ASSUME_TAC THENL + [GEN_TAC THEN EXPAND_TAC "v'" THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `sub_sigma_algebra p ((FF:num->(A->bool)->bool) k)` ASSUME_TAC + THENL [ASM_MESON_TAC[filtration]; ALL_TAC] THEN + SUBGOAL_THEN `random_variable p (v':A->real)` ASSUME_TAC THENL + [SUBGOAL_THEN `(v':A->real) = + (\x. max (min (gen_cond_exp p ((FF:num->(A->bool)->bool) k) + (\y. indicator_fn ((B:num->A->bool) (SUC k)) y) x) (&1)) (&0))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN ASM_MESON_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC RANDOM_VARIABLE_MAX THEN CONJ_TAC THENL + [MATCH_MP_TAC RANDOM_VARIABLE_MIN THEN CONJ_TAC THENL + [REWRITE_TAC[ETA_AX] THEN + MATCH_MP_TAC INTEGRABLE_IMP_RANDOM_VARIABLE THEN + MATCH_MP_TAC GEN_COND_EXP_INTEGRABLE THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[ETA_AX] THEN + MATCH_MP_TAC INTEGRABLE_INDICATOR THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[RANDOM_VARIABLE_CONST]]; + REWRITE_TAC[RANDOM_VARIABLE_CONST]]; ALL_TAC] THEN + SUBGOAL_THEN `measurable_wrt p ((FF:num->(A->bool)->bool) k) (v':A->real)` + ASSUME_TAC THENL + [SUBGOAL_THEN `(v':A->real) = + (\x. max (min (gen_cond_exp p ((FF:num->(A->bool)->bool) k) + (\y. indicator_fn ((B:num->A->bool) (SUC k)) y) x) (&1)) (&0))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN ASM_MESON_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC MEASURABLE_WRT_MAX_CONST THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MEASURABLE_WRT_MIN_CONST THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[ETA_AX] THEN + MATCH_MP_TAC GEN_COND_EXP_MEASURABLE_WRT THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC INTEGRABLE_INDICATOR THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + (* Algebraic identity: (1_B-v')^2*phi = (1_B-v')*(1-2v')*phi + v'*(1-v')*phi *) + SUBGOAL_THEN `!x:A. (indicator_fn ((B:num->A->bool) (SUC k)) x - + (v':A->real) x) pow 2 * phi x = + (indicator_fn (B (SUC k)) x - v' x) * (&1 - &2 * v' x) * phi x + + v' x * (&1 - v' x) * phi x` + (fun th -> REWRITE_TAC[th]) THENL + [X_GEN_TAC `x:A` THEN + REWRITE_TAC[indicator_fn] THEN COND_CASES_TAC THEN REAL_ARITH_TAC; + ALL_TAC] THEN + (* By TRUNCATED_DIFF: E[(1_B-v')*(1-2v')*phi] = 0 *) + SUBGOAL_THEN `expectation p (\x:A. (indicator_fn ((B:num->A->bool) (SUC k)) x - + (v':A->real) x) * (&1 - &2 * v' x) * (phi:A->real) x) = &0` + ASSUME_TAC THENL + [MP_TAC(ISPECL [`p:A prob_space`; `FF:num->(A->bool)->bool`; + `B:num->A->bool`; `k:num`; + `\x:A. (&1 - &2 * (v':A->real) x) * (phi:A->real) x`; + `K:real`] TRUNCATED_DIFF_EXPECTATION_ZERO) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN MATCH_MP_TAC THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_MUL_BOUNDED THEN + EXISTS_TAC `K:real` THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_BOUNDED THEN EXISTS_TAC `&1` THEN CONJ_TAC THENL + [MATCH_MP_TAC RANDOM_VARIABLE_SUB THEN CONJ_TAC THENL + [REWRITE_TAC[RANDOM_VARIABLE_CONST]; ALL_TAC] THEN + MATCH_MP_TAC RANDOM_VARIABLE_CMUL THEN ASM_REWRITE_TAC[]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN BETA_TAC THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= v /\ v <= &1 ==> abs(&1 - &2 * v) <= &1`) THEN + ASM_MESON_TAC[]]; + MATCH_MP_TAC INTEGRABLE_IMP_RANDOM_VARIABLE THEN ASM_REWRITE_TAC[]]; + MATCH_MP_TAC MEASURABLE_WRT_MUL THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MEASURABLE_WRT_SUB THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_WRT_CONST THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC MEASURABLE_WRT_CMUL THEN ASM_REWRITE_TAC[]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + REWRITE_TAC[REAL_ABS_MUL] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&1 * K` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN + CONJ_TAC THENL + [MATCH_MP_TAC(REAL_ARITH `&0 <= v /\ v <= &1 ==> abs(&1 - &2 * v) <= &1`) THEN + ASM_MESON_TAC[]; + ASM_MESON_TAC[]]; + ASM_REAL_ARITH_TAC]]; ALL_TAC] THEN + (* Integrability of both parts *) + SUBGOAL_THEN `integrable p (\x:A. (indicator_fn ((B:num->A->bool) (SUC k)) x - + (v':A->real) x) * (&1 - &2 * v' x) * (phi:A->real) x)` ASSUME_TAC THENL + [MATCH_MP_TAC INTEGRABLE_BOUNDED THEN EXISTS_TAC `K:real` THEN CONJ_TAC THENL + [MATCH_MP_TAC RANDOM_VARIABLE_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC RANDOM_VARIABLE_SUB THEN CONJ_TAC THENL + [REWRITE_TAC[ETA_AX] THEN + MATCH_MP_TAC INTEGRABLE_IMP_RANDOM_VARIABLE THEN + MATCH_MP_TAC INTEGRABLE_INDICATOR THEN ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]]; + MATCH_MP_TAC RANDOM_VARIABLE_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC RANDOM_VARIABLE_SUB THEN CONJ_TAC THENL + [REWRITE_TAC[RANDOM_VARIABLE_CONST]; + MATCH_MP_TAC RANDOM_VARIABLE_CMUL THEN ASM_REWRITE_TAC[]]; + MATCH_MP_TAC INTEGRABLE_IMP_RANDOM_VARIABLE THEN ASM_REWRITE_TAC[]]]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `abs((indicator_fn ((B:num->A->bool) (SUC k)) (x:A) - + (v':A->real) x) * (&1 - &2 * v' x) * (phi:A->real) x)` THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + ONCE_REWRITE_TAC[REAL_MUL_ASSOC] THEN REWRITE_TAC[REAL_ABS_MUL] THEN + SUBGOAL_THEN `abs(indicator_fn ((B:num->A->bool) (SUC k)) (x:A) - + (v':A->real) x) * abs(&1 - &2 * v' x) <= &1` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&1 * &1` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN CONJ_TAC THENL + [REWRITE_TAC[indicator_fn] THEN COND_CASES_TAC THENL + [MATCH_MP_TAC(REAL_ARITH `&0 <= v /\ v <= &1 ==> abs(&1 - v) <= &1`) THEN + ASM_MESON_TAC[]; + MATCH_MP_TAC(REAL_ARITH `&0 <= v /\ v <= &1 ==> abs(&0 - v) <= &1`) THEN + ASM_MESON_TAC[]]; + MATCH_MP_TAC(REAL_ARITH `&0 <= v /\ v <= &1 ==> abs(&1 - &2 * v) <= &1`) THEN + ASM_MESON_TAC[]]; + REAL_ARITH_TAC]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&1 * K` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[REAL_ABS_POS] THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_ABS_POS]; + ASM_MESON_TAC[]]; + ASM_REAL_ARITH_TAC]]; ALL_TAC] THEN + SUBGOAL_THEN `integrable p (\x:A. (v':A->real) x * (&1 - v' x) * + (phi:A->real) x)` ASSUME_TAC THENL + [MATCH_MP_TAC INTEGRABLE_BOUNDED THEN EXISTS_TAC `K:real` THEN CONJ_TAC THENL + [MATCH_MP_TAC RANDOM_VARIABLE_MUL THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + MATCH_MP_TAC RANDOM_VARIABLE_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC RANDOM_VARIABLE_SUB THEN CONJ_TAC THENL + [REWRITE_TAC[RANDOM_VARIABLE_CONST]; + ASM_REWRITE_TAC[]]; + MATCH_MP_TAC INTEGRABLE_IMP_RANDOM_VARIABLE THEN ASM_REWRITE_TAC[]]]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `abs((v':A->real) x * (&1 - v' x) * (phi:A->real) x)` THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + ONCE_REWRITE_TAC[REAL_MUL_ASSOC] THEN REWRITE_TAC[REAL_ABS_MUL] THEN + SUBGOAL_THEN `abs((v':A->real) x) * abs(&1 - v' x) <= &1` ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&1 * &1` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL2 THEN REWRITE_TAC[REAL_ABS_POS] THEN CONJ_TAC THENL + [MATCH_MP_TAC(REAL_ARITH `&0 <= v /\ v <= &1 ==> abs v <= &1`) THEN + ASM_MESON_TAC[]; + MATCH_MP_TAC(REAL_ARITH `&0 <= v /\ v <= &1 ==> abs(&1 - v) <= &1`) THEN + ASM_MESON_TAC[]]; + REAL_ARITH_TAC]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&1 * K` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL2 THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[REAL_ABS_POS] THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_ABS_POS]; + ASM_MESON_TAC[]]; + ASM_REAL_ARITH_TAC]]; ALL_TAC] THEN + (* Use EXPECTATION_ADD to split *) + MP_TAC(ISPECL [`p:A prob_space`; + `\x:A. (indicator_fn ((B:num->A->bool) (SUC k)) x - (v':A->real) x) * + (&1 - &2 * v' x) * (phi:A->real) x`; + `\x:A. (v':A->real) x * (&1 - v' x) * (phi:A->real) x`] + EXPECTATION_ADD) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN + ASM_REWRITE_TAC[REAL_ADD_LID] THEN + (* Now: E[v'*(1-v')*phi] <= E[v'*phi] *) + MATCH_MP_TAC EXPECTATION_MONO THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_MUL_BOUNDED THEN + EXISTS_TAC `K:real` THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_BOUNDED THEN EXISTS_TAC `&1` THEN + ASM_REWRITE_TAC[] THEN + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= v /\ v <= &1 ==> abs(v) <= &1`) THEN + ASM_MESON_TAC[]; + MATCH_MP_TAC INTEGRABLE_IMP_RANDOM_VARIABLE THEN ASM_REWRITE_TAC[]]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN BETA_TAC THEN + SUBGOAL_THEN `&0 <= (v':A->real) x /\ v' x <= &1` STRIP_ASSUME_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `&0 <= (phi:A->real) x` ASSUME_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_LMUL THEN ASM_REWRITE_TAC[] THEN + GEN_REWRITE_TAC RAND_CONV [GSYM REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LE_RMUL THEN ASM_REWRITE_TAC[] THEN + ASM_REAL_ARITH_TAC]]);; + +(* Division by a positive random variable preserves measurability *) +let RANDOM_VARIABLE_DIV_POS = prove + (`!p (f:A->real) g. random_variable p f /\ random_variable p g /\ + (!x:A. x IN prob_carrier p ==> &0 < g x) ==> + random_variable p (\x. f x / g x)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[real_div] THEN + MATCH_MP_TAC RANDOM_VARIABLE_MUL THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[random_variable] THEN X_GEN_TAC `a:real` THEN + ASM_CASES_TAC `a <= &0` THENL + [SUBGOAL_THEN `{x:A | x IN prob_carrier p /\ inv(g x) <= a} = + {x | x IN prob_carrier p /\ (g:A->real) x <= &0}` + (fun th -> REWRITE_TAC[th]) THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `x:A` THEN + ASM_CASES_TAC `(x:A) IN prob_carrier p` THEN ASM_REWRITE_TAC[] THEN + EQ_TAC THEN STRIP_TAC THENL + [SUBGOAL_THEN `&0 < inv((g:A->real) x)` MP_TAC THENL + [ASM_SIMP_TAC[REAL_LT_INV]; ASM_REAL_ARITH_TAC]; + SUBGOAL_THEN `&0 < (g:A->real) x` MP_TAC THENL + [ASM_MESON_TAC[]; ASM_REAL_ARITH_TAC]]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [random_variable]) THEN + DISCH_THEN(MP_TAC o SPEC `&0`) THEN REWRITE_TAC[]]; + SUBGOAL_THEN `&0 < a` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `{x:A | x IN prob_carrier p /\ inv(g x) <= a} = + {x | x IN prob_carrier p /\ (g:A->real) x >= inv a}` + (fun th -> REWRITE_TAC[th]) THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN X_GEN_TAC `x:A` THEN + ASM_CASES_TAC `(x:A) IN prob_carrier p` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `&0 < (g:A->real) x` ASSUME_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + REWRITE_TAC[real_ge] THEN + EQ_TAC THEN STRIP_TAC THENL + [MP_TAC(SPECL [`inv((g:A->real) x)`; `a:real`] REAL_LE_INV2) THEN + ASM_SIMP_TAC[REAL_LT_INV; REAL_INV_INV]; + MP_TAC(SPECL [`inv(a:real)`; `(g:A->real) x`] REAL_LE_INV2) THEN + ASM_SIMP_TAC[REAL_LT_INV; REAL_INV_INV]]; + MP_TAC(ISPECL [`p:A prob_space`; `g:A->real`; `inv(a:real)`] + RV_PREIMAGE_GE) THEN + ASM_REWRITE_TAC[]]]);; + +let REAL_DIV_ABS_LE_1 = prove( + `!a b. abs a <= &1 /\ &1 <= b ==> abs a / abs b <= &1`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `&0 < abs b` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ] THEN + ASM_REAL_ARITH_TAC);; + +let REAL_ABS_DIV_LE = prove( + `abs s <= t /\ &1 <= abs d ==> abs s / abs d <= t`, + STRIP_TAC THEN + SUBGOAL_THEN `&0 < abs d` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `t * &1` THEN + CONJ_TAC THENL + [REWRITE_TAC[REAL_MUL_RID] THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC REAL_LE_LMUL THEN + ASM_REAL_ARITH_TAC]);; + +(* E[(f+g)^2] = E[f^2] + E[g^2] when E[f*g] = 0 *) +let EXPECTATION_SQ_ORTHOGONAL = prove + (`!p (f:A->real) g. + integrable p f /\ integrable p g /\ + integrable p (\x. f x pow 2) /\ integrable p (\x. g x pow 2) /\ + integrable p (\x. f x * g x) /\ + expectation p (\x. f x * g x) = &0 + ==> expectation p (\x. (f x + g x) pow 2) = + expectation p (\x. f x pow 2) + expectation p (\x. g x pow 2)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `(\x:A. ((f:A->real) x + g x) pow 2) = + (\x. f x pow 2 + g x pow 2 + &2 * f x * g x)` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN GEN_TAC THEN CONV_TAC REAL_RING; + ALL_TAC] THEN + SUBGOAL_THEN `integrable p (\x:A. (f:A->real) x pow 2 + g x pow 2)` + ASSUME_TAC THENL + [MATCH_MP_TAC INTEGRABLE_ADD THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `integrable p (\x:A. &2 * (f:A->real) x * g x)` + ASSUME_TAC THENL + [MATCH_MP_TAC INTEGRABLE_CMUL THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL [`p:A prob_space`; + `\x:A. (f:A->real) x pow 2`; + `\x:A. (g:A->real) x pow 2 + &2 * f x * g x`] EXPECTATION_ADD) THEN + BETA_TAC THEN + ANTS_TAC THENL + [ASM_REWRITE_TAC[] THEN MATCH_MP_TAC INTEGRABLE_ADD THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN AP_TERM_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; + `\x:A. (g:A->real) x pow 2`; + `\x:A. &2 * (f:A->real) x * g x`] EXPECTATION_ADD) THEN + BETA_TAC THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN SUBST1_TAC THEN + MP_TAC(ISPECL [`p:A prob_space`; `&2`; + `\x:A. (f:A->real) x * (g:A->real) x`] EXPECTATION_CMUL) THEN + BETA_TAC THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN SUBST1_TAC THEN REAL_ARITH_TAC);; + +(* L2 bound for truncated rescaled sum: E[T''^2] <= 1 *) +(* Uses cross term orthogonality + diagonal bound + telescoping *) +let RESCALED_TRUNCATED_L2 = prove + (`!p FF (B:num->A->bool). + filtration p FF /\ (!n. B n IN prob_events p) /\ + (!n. B n SUBSET prob_carrier p) /\ (!n. B n IN FF n) + ==> !n. expectation p + (\x. (sum(0..n) + (\k. (indicator_fn (B (SUC k)) x - + max (min (gen_cond_exp p (FF k) + (\y. indicator_fn (B (SUC k)) y) x) (&1)) (&0)) / + (&1 + sum(0..k) + (\j. max (min (gen_cond_exp p (FF j) + (\y. indicator_fn (B (SUC j)) y) x) (&1)) (&0))))) pow 2) + <= &1`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + ABBREV_TAC `v = \k x:A. gen_cond_exp p (FF k) + (\y. indicator_fn (B (SUC k)) y) x` THEN + SUBGOAL_THEN `!k (x:A). gen_cond_exp p (FF k) + (\y. indicator_fn (B (SUC k)) y) x = (v:num->A->real) k x` + ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + ABBREV_TAC `v' = \k (x:A). max (min ((v:num->A->real) k x) (&1)) (&0)` THEN + SUBGOAL_THEN `!k (x:A). max (min ((v:num->A->real) k x) (&1)) (&0) = + (v':num->A->real) k x` ASSUME_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `!k (x:A). &0 <= (v':num->A->real) k x /\ v' k x <= &1` + ASSUME_TAC THENL + [REPEAT GEN_TAC THEN EXPAND_TAC "v'" THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `!n. sub_sigma_algebra p ((FF:num->(A->bool)->bool) n)` + ASSUME_TAC THENL [ASM_MESON_TAC[filtration]; ALL_TAC] THEN + SUBGOAL_THEN `!k. integrable p (\y:A. indicator_fn + ((B:num->A->bool) (SUC k)) y)` ASSUME_TAC THENL + [GEN_TAC THEN REWRITE_TAC[ETA_AX] THEN + MATCH_MP_TAC INTEGRABLE_INDICATOR THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `!k:num. random_variable p ((v':num->A->real) k)` ASSUME_TAC + THENL + [GEN_TAC THEN + SUBGOAL_THEN `(v':num->A->real) k = + (\x. max (min ((v:num->A->real) k x) (&1)) (&0))` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN ASM_MESON_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC RANDOM_VARIABLE_MAX THEN CONJ_TAC THENL + [MATCH_MP_TAC RANDOM_VARIABLE_MIN THEN CONJ_TAC THENL + [SUBGOAL_THEN `(\x:A. (v:num->A->real) k x) = + gen_cond_exp p ((FF:num->(A->bool)->bool) k) + (\y. indicator_fn ((B:num->A->bool) (SUC k)) y)` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN ASM_MESON_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC INTEGRABLE_IMP_RANDOM_VARIABLE THEN + MATCH_MP_TAC GEN_COND_EXP_INTEGRABLE THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[RANDOM_VARIABLE_CONST]]; + REWRITE_TAC[RANDOM_VARIABLE_CONST]]; + ALL_TAC] THEN + SUBGOAL_THEN `!k:num. measurable_wrt p ((FF:num->(A->bool)->bool) k) + ((v':num->A->real) k)` ASSUME_TAC THENL + [GEN_TAC THEN + SUBGOAL_THEN `(v':num->A->real) k = + (\x. max (min ((v:num->A->real) k x) (&1)) (&0))` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN ASM_MESON_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC MEASURABLE_WRT_MAX_CONST THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MEASURABLE_WRT_MIN_CONST THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `(\x:A. (v:num->A->real) k x) = + gen_cond_exp p ((FF:num->(A->bool)->bool) k) + (\y. indicator_fn ((B:num->A->bool) (SUC k)) y)` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN ASM_MESON_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC GEN_COND_EXP_MEASURABLE_WRT THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + (* Stronger invariant: E[S_n^2] <= E[sum v'_k/(1+V'_k)^2] *) + SUBGOAL_THEN `!n:num. expectation p + (\x:A. (sum (0..n) (\k. (indicator_fn ((B:num->A->bool) (SUC k)) x - + (v':num->A->real) k x) / + (&1 + sum (0..k) (\j. v' j x)))) pow 2) <= + expectation p + (\x. sum (0..n) (\k. v' k x / + (&1 + sum (0..k) (\j. v' j x)) pow 2))` + ASSUME_TAC THENL + [INDUCT_TAC THENL + [(* Base case: n = 0 *) + REWRITE_TAC[SUM_SING_NUMSEG; REAL_POW_DIV; real_div; + REAL_POW_MUL; REAL_POW_INV] THEN + MP_TAC(ISPECL [`p:A prob_space`; `FF:num->(A->bool)->bool`; + `B:num->A->bool`; `0`; + `\x:A. inv((&1 + (v':num->A->real) 0 x) pow 2)`; + `&1`] TRUNCATED_DIFF_SQ_BOUND) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(fun th -> MATCH_MP_TAC(BETA_RULE th)) THEN + REWRITE_TAC[REAL_POS] THEN REPEAT CONJ_TAC THENL + [(* integrable phi *) + MATCH_MP_TAC INTEGRABLE_BOUNDED THEN EXISTS_TAC `&1` THEN CONJ_TAC THENL + [SUBGOAL_THEN `(\x:A. inv((&1 + (v':num->A->real) 0 x) pow 2)) = + (\x. &1 / (&1 + v' 0 x) pow 2)` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; real_div; REAL_MUL_LID]; ALL_TAC] THEN + MATCH_MP_TAC RANDOM_VARIABLE_DIV_POS THEN CONJ_TAC THENL + [REWRITE_TAC[RANDOM_VARIABLE_CONST]; ALL_TAC] THEN CONJ_TAC THENL + [MATCH_MP_TAC RANDOM_VARIABLE_POW THEN + MATCH_MP_TAC RANDOM_VARIABLE_ADD THEN CONJ_TAC THENL + [REWRITE_TAC[RANDOM_VARIABLE_CONST]; + REWRITE_TAC[ETA_AX] THEN ASM_REWRITE_TAC[]]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_POW_LT THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= v ==> &0 < &1 + v`) THEN + ASM_MESON_TAC[]]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN BETA_TAC THEN + REWRITE_TAC[REAL_ABS_INV; REAL_ABS_POW] THEN + MATCH_MP_TAC REAL_INV_LE_1 THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&1 pow 2` THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_POW_LE2 THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= v ==> &1 <= abs(&1 + v)`) THEN + ASM_MESON_TAC[]]; + (* measurable_wrt phi *) + MATCH_MP_TAC MEASURABLE_WRT_INV_GE_ONE THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_WRT_POW2 THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MEASURABLE_WRT_ADD THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[ETA_AX] THEN CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_WRT_CONST THEN ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&1 pow 2` THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_POW_LE2 THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= v ==> &1 <= &1 + v`) THEN + ASM_MESON_TAC[]]; + (* abs bound *) + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + REWRITE_TAC[REAL_ABS_INV; REAL_ABS_POW] THEN + MATCH_MP_TAC REAL_INV_LE_1 THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&1 pow 2` THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_POW_LE2 THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= v ==> &1 <= abs(&1 + v)`) THEN + ASM_MESON_TAC[]; + (* nonneg *) + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LE_INV THEN MATCH_MP_TAC REAL_POW_LE THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= v ==> &0 <= &1 + v`) THEN + ASM_MESON_TAC[]]; + (* Inductive step *) + REWRITE_TAC[SUM_CLAUSES_NUMSEG; LE_0] THEN + (* Shared: inner denominators positive *) + SUBGOAL_THEN `!k (x:A). x IN prob_carrier p + ==> &0 < &1 + sum(0..k) (\j. (v':num->A->real) j x)` + ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= s ==> &0 < &1 + s`) THEN + MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN GEN_TAC THEN STRIP_TAC THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + (* Shared: outer denominator positive *) + SUBGOAL_THEN `!(x:A). x IN prob_carrier p + ==> &0 < &1 + sum(0..n) (\j. (v':num->A->real) j x) + + v' (SUC n) x` ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN + MATCH_MP_TAC(REAL_ARITH + `&0 <= s /\ &0 <= t ==> &0 < &1 + s + t`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN GEN_TAC THEN STRIP_TAC THEN + ASM_MESON_TAC[]; + ASM_MESON_TAC[]]; + ALL_TAC] THEN + (* Shared: integrable v' k *) + SUBGOAL_THEN `!k:num. integrable p ((v':num->A->real) k)` + ASSUME_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC INTEGRABLE_BOUNDED THEN + EXISTS_TAC `&1` THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + MATCH_MP_TAC(REAL_ARITH + `&0 <= y /\ y <= &1 ==> abs(y) <= &1`) THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + (* Shared: |1_B - v'| <= 1 *) + SUBGOAL_THEN `!k (x:A). x IN prob_carrier p + ==> abs(indicator_fn ((B:num->A->bool) (SUC k)) x - + (v':num->A->real) k x) <= &1` ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN + MATCH_MP_TAC(REAL_ARITH + `&0 <= i /\ i <= &1 /\ &0 <= v /\ v <= &1 + ==> abs(i - v) <= &1`) THEN + REWRITE_TAC[indicator_fn] THEN + CONJ_TAC THENL [COND_CASES_TAC THEN REAL_ARITH_TAC; ALL_TAC] THEN + CONJ_TAC THENL [COND_CASES_TAC THEN REAL_ARITH_TAC; ALL_TAC] THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + (* Step 1: Cross-term E[(1_B - v') * Sn / Dn] = 0 *) + SUBGOAL_THEN `expectation p + (\x:A. (indicator_fn ((B:num->A->bool) (SUC (SUC n))) x - + (v':num->A->real) (SUC n) x) * + (sum (0..n) + (\k. (indicator_fn (B (SUC k)) x - v' k x) / + (&1 + sum (0..k) (\j. v' j x))) / + (&1 + sum (0..n) (\j. v' j x) + v' (SUC n) x))) = &0` + ASSUME_TAC THENL + [MP_TAC(ISPECL [`p:A prob_space`; `FF:num->(A->bool)->bool`; + `B:num->A->bool`; `SUC n`; + `\x:A. sum (0..n) + (\k. (indicator_fn ((B:num->A->bool) (SUC k)) x - + (v':num->A->real) k x) / + (&1 + sum (0..k) (\j. v' j x))) / + (&1 + sum (0..n) (\j. v' j x) + v' (SUC n) x)`; + `&(SUC n)`] TRUNCATED_DIFF_EXPECTATION_ZERO) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(fun th -> + MATCH_MP_TAC(BETA_RULE(REWRITE_RULE[IMP_IMP] th))) THEN + REWRITE_TAC[REAL_POS] THEN REPEAT CONJ_TAC THENL + [(* integrable Sn/Dn *) + MATCH_MP_TAC INTEGRABLE_BOUNDED THEN EXISTS_TAC `&(SUC n)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC RANDOM_VARIABLE_DIV_POS THEN CONJ_TAC THENL + [MATCH_MP_TAC RANDOM_VARIABLE_SUM THEN + X_GEN_TAC `i:num` THEN DISCH_TAC THEN BETA_TAC THEN + MATCH_MP_TAC RANDOM_VARIABLE_DIV_POS THEN CONJ_TAC THENL + [MATCH_MP_TAC RANDOM_VARIABLE_SUB THEN CONJ_TAC THENL + [SUBGOAL_THEN `(\x:A. indicator_fn ((B:num->A->bool) (SUC i)) x) = + indicator_fn (B (SUC i))` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; ETA_AX]; ALL_TAC] THEN + MATCH_MP_TAC INTEGRABLE_IMP_RANDOM_VARIABLE THEN + MATCH_MP_TAC INTEGRABLE_INDICATOR THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[ETA_AX] THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN CONJ_TAC THENL + [MATCH_MP_TAC RANDOM_VARIABLE_ADD THEN CONJ_TAC THENL + [REWRITE_TAC[RANDOM_VARIABLE_CONST]; + MATCH_MP_TAC RANDOM_VARIABLE_SUM THEN GEN_TAC THEN DISCH_TAC THEN + BETA_TAC THEN REWRITE_TAC[ETA_AX] THEN ASM_REWRITE_TAC[]]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN ASM_MESON_TAC[]]; + ALL_TAC] THEN CONJ_TAC THENL + [MATCH_MP_TAC RANDOM_VARIABLE_ADD THEN CONJ_TAC THENL + [REWRITE_TAC[RANDOM_VARIABLE_CONST]; + MATCH_MP_TAC RANDOM_VARIABLE_ADD THEN CONJ_TAC THENL + [MATCH_MP_TAC RANDOM_VARIABLE_SUM THEN GEN_TAC THEN DISCH_TAC THEN + BETA_TAC THEN REWRITE_TAC[ETA_AX] THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[ETA_AX] THEN ASM_REWRITE_TAC[]]]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN ASM_MESON_TAC[]]; + (* bound: |Sn/Dn| <= SUC n *) + X_GEN_TAC `x:A` THEN DISCH_TAC THEN BETA_TAC THEN + REWRITE_TAC[REAL_ABS_DIV] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(0..n) (\k:num. &1)` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_ABS_DIV_LE THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(0..n) + (\k. abs((indicator_fn ((B:num->A->bool) (SUC k)) x - + (v':num->A->real) k x) / + (&1 + sum (0..k) (\j. v' j x))))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_ABS_LE THEN REWRITE_TAC[FINITE_NUMSEG] THEN + SIMP_TAC[IN_NUMSEG; REAL_LE_REFL]; ALL_TAC] THEN + MATCH_MP_TAC SUM_LE_NUMSEG THEN X_GEN_TAC `k:num` THEN + STRIP_TAC THEN BETA_TAC THEN REWRITE_TAC[REAL_ABS_DIV] THEN + MATCH_MP_TAC REAL_DIV_ABS_LE_1 THEN + CONJ_TAC THENL [ASM_MESON_TAC[]; + MATCH_MP_TAC(REAL_ARITH `&0 <= s ==> &1 <= &1 + s`) THEN + MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN GEN_TAC THEN STRIP_TAC THEN + ASM_MESON_TAC[]]; + MATCH_MP_TAC(REAL_ARITH + `&0 <= s /\ &0 <= t ==> &1 <= abs(&1 + s + t)`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN GEN_TAC THEN STRIP_TAC THEN + ASM_MESON_TAC[]; + ASM_MESON_TAC[]]]; + REWRITE_TAC[SUM_CONST_NUMSEG; SUB_0] THEN + REWRITE_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_MUL; MULT_CLAUSES] THEN + ARITH_TAC]]; + (* measurable_wrt Sn/Dn wrt FF(SUC n) *) + REWRITE_TAC[real_div] THEN + MATCH_MP_TAC MEASURABLE_WRT_MUL THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_WRT_SUM THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `k:num` THEN DISCH_TAC THEN + REWRITE_TAC[real_div] THEN BETA_TAC THEN + MATCH_MP_TAC MEASURABLE_WRT_MUL THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_WRT_SUB THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[ETA_AX] THEN CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_WRT_MONO THEN + EXISTS_TAC `(FF:num->(A->bool)->bool) (SUC k)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_WRT_INDICATOR THEN ASM_REWRITE_TAC[]; + SUBGOAL_THEN `SUC k <= SUC (n:num)` ASSUME_TAC THENL + [UNDISCH_TAC `k:num <= n` THEN ARITH_TAC; ALL_TAC] THEN + ASM_MESON_TAC[filtration]]; + MATCH_MP_TAC MEASURABLE_WRT_MONO THEN + EXISTS_TAC `(FF:num->(A->bool)->bool) k` THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `k:num <= SUC n` ASSUME_TAC THENL + [UNDISCH_TAC `k:num <= n` THEN ARITH_TAC; ALL_TAC] THEN + ASM_MESON_TAC[filtration]]; + MATCH_MP_TAC MEASURABLE_WRT_INV_GE_ONE THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_WRT_ADD THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_WRT_CONST THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC MEASURABLE_WRT_SUM THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `j:num` THEN DISCH_TAC THEN + REWRITE_TAC[ETA_AX] THEN + MATCH_MP_TAC MEASURABLE_WRT_MONO THEN + EXISTS_TAC `(FF:num->(A->bool)->bool) j` THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `j:num <= SUC n` ASSUME_TAC THENL + [UNDISCH_TAC `j:num <= k` THEN UNDISCH_TAC `k:num <= n` THEN + ARITH_TAC; ALL_TAC] THEN + ASM_MESON_TAC[filtration]]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= s ==> &1 <= &1 + s`) THEN + MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN GEN_TAC THEN STRIP_TAC THEN + ASM_MESON_TAC[]]]; + MATCH_MP_TAC MEASURABLE_WRT_INV_GE_ONE THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_WRT_ADD THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_WRT_CONST THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC MEASURABLE_WRT_ADD THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_WRT_SUM THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `j:num` THEN DISCH_TAC THEN + REWRITE_TAC[ETA_AX] THEN + MATCH_MP_TAC MEASURABLE_WRT_MONO THEN + EXISTS_TAC `(FF:num->(A->bool)->bool) j` THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `j:num <= SUC n` ASSUME_TAC THENL + [UNDISCH_TAC `j:num <= n` THEN ARITH_TAC; ALL_TAC] THEN + ASM_MESON_TAC[filtration]; + REWRITE_TAC[ETA_AX] THEN + MATCH_MP_TAC MEASURABLE_WRT_MONO THEN + EXISTS_TAC `(FF:num->(A->bool)->bool) (SUC n)` THEN + ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[filtration; LE_REFL]]]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + MATCH_MP_TAC(REAL_ARITH + `&0 <= s /\ &0 <= t ==> &1 <= &1 + s + t`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN GEN_TAC THEN STRIP_TAC THEN + ASM_MESON_TAC[]; + ASM_MESON_TAC[]]]]; + (* |Sn/Dn| <= SUC n *) + X_GEN_TAC `x:A` THEN DISCH_TAC THEN BETA_TAC THEN + REWRITE_TAC[REAL_ABS_DIV] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(0..n) (\k:num. &1)` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_ABS_DIV_LE THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(0..n) + (\k. abs((indicator_fn ((B:num->A->bool) (SUC k)) x - + (v':num->A->real) k x) / + (&1 + sum (0..k) (\j. v' j x))))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_ABS_LE THEN REWRITE_TAC[FINITE_NUMSEG] THEN + SIMP_TAC[IN_NUMSEG; REAL_LE_REFL]; ALL_TAC] THEN + MATCH_MP_TAC SUM_LE_NUMSEG THEN X_GEN_TAC `k:num` THEN + STRIP_TAC THEN BETA_TAC THEN REWRITE_TAC[REAL_ABS_DIV] THEN + MATCH_MP_TAC REAL_DIV_ABS_LE_1 THEN + CONJ_TAC THENL [ASM_MESON_TAC[]; + MATCH_MP_TAC(REAL_ARITH `&0 <= s ==> &1 <= &1 + s`) THEN + MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN GEN_TAC THEN STRIP_TAC THEN + ASM_MESON_TAC[]]; + MATCH_MP_TAC(REAL_ARITH + `&0 <= s /\ &0 <= t ==> &1 <= abs(&1 + s + t)`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN GEN_TAC THEN STRIP_TAC THEN + ASM_MESON_TAC[]; + ASM_MESON_TAC[]]]; + REWRITE_TAC[SUM_CONST_NUMSEG; SUB_0] THEN + REWRITE_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_MUL; MULT_CLAUSES] THEN + ARITH_TAC]]; + ALL_TAC] THEN + (* Step 2: Main inequality via REAL_LE_TRANS *) + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `expectation p + (\x:A. sum (0..n) + (\k. (indicator_fn ((B:num->A->bool) (SUC k)) x - + (v':num->A->real) k x) / + (&1 + sum (0..k) (\j. v' j x))) pow 2) + + expectation p + (\x. (indicator_fn (B (SUC (SUC n))) x - v' (SUC n) x) pow 2 * + inv ((&1 + sum (0..n) (\j. v' j x) + v' (SUC n) x) pow 2))` THEN + CONJ_TAC THENL + [(* E[(S+d)^2] <= E[S^2] + E[d^2] using cross-term = 0 *) + MATCH_MP_TAC(REAL_ARITH `a = b ==> a <= b`) THEN + (* Algebraic identity: (S + d/D)^2 = S^2 + d^2/D^2 + 2*(d*(S/D)) *) + SUBGOAL_THEN + `(\x:A. (sum (0..n) + (\k. (indicator_fn ((B:num->A->bool) (SUC k)) x - + (v':num->A->real) k x) / + (&1 + sum (0..k) (\j. v' j x))) + + (indicator_fn (B (SUC (SUC n))) x - v' (SUC n) x) / + (&1 + sum (0..n) (\j. v' j x) + v' (SUC n) x)) pow 2) = + (\x. sum (0..n) + (\k. (indicator_fn (B (SUC k)) x - v' k x) / + (&1 + sum (0..k) (\j. v' j x))) pow 2 + + (indicator_fn (B (SUC (SUC n))) x - v' (SUC n) x) pow 2 * + inv ((&1 + sum (0..n) (\j. v' j x) + v' (SUC n) x) pow 2) + + &2 * ((indicator_fn (B (SUC (SUC n))) x - v' (SUC n) x) * + (sum (0..n) + (\k. (indicator_fn (B (SUC k)) x - v' k x) / + (&1 + sum (0..k) (\j. v' j x))) / + (&1 + sum (0..n) (\j. v' j x) + v' (SUC n) x))))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN X_GEN_TAC `x:A` THEN BETA_TAC THEN + SPEC_TAC(`sum (0..n) + (\k. (indicator_fn ((B:num->A->bool) (SUC k)) (x:A) - + (v':num->A->real) k x) / + (&1 + sum (0..k) (\j. v' j x)))`, `s:real`) THEN + SPEC_TAC(`indicator_fn ((B:num->A->bool) (SUC (SUC n))) (x:A) - + (v':num->A->real) (SUC n) x`, `dd:real`) THEN + SPEC_TAC(`&1 + sum (0..n) (\j. (v':num->A->real) j (x:A)) + + v' (SUC n) x`, `cc:real`) THEN + REPEAT GEN_TAC THEN + REWRITE_TAC[real_div; REAL_POW_MUL; GSYM REAL_POW_INV] THEN + CONV_TAC REAL_RING; + ALL_TAC] THEN + (* Integrable: each term (ind-v')/(1+V_k) *) + SUBGOAL_THEN `!i:num. i <= n + ==> integrable p (\x:A. (indicator_fn ((B:num->A->bool) (SUC i)) x - + (v':num->A->real) i x) / + (&1 + sum (0..i) (\j. v' j x)))` ASSUME_TAC THENL + [REPEAT STRIP_TAC THEN + ONCE_REWRITE_TAC[real_div] THEN + MATCH_MP_TAC INTEGRABLE_MUL_BOUNDED THEN EXISTS_TAC `&1` THEN + CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_SUB THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + REWRITE_TAC[ETA_AX] THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN CONJ_TAC THENL + [SUBGOAL_THEN `(\x:A. inv(&1 + sum (0..i) + (\j. (v':num->A->real) j x))) = + (\x. &1 / (&1 + sum (0..i) (\j. v' j x)))` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; real_div; REAL_MUL_LID]; ALL_TAC] THEN + MATCH_MP_TAC RANDOM_VARIABLE_DIV_POS THEN CONJ_TAC THENL + [REWRITE_TAC[RANDOM_VARIABLE_CONST]; ALL_TAC] THEN CONJ_TAC THENL + [MATCH_MP_TAC RANDOM_VARIABLE_ADD THEN CONJ_TAC THENL + [REWRITE_TAC[RANDOM_VARIABLE_CONST]; + MATCH_MP_TAC RANDOM_VARIABLE_SUM THEN GEN_TAC THEN DISCH_TAC THEN + BETA_TAC THEN REWRITE_TAC[ETA_AX] THEN ASM_REWRITE_TAC[]]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN ASM_MESON_TAC[]]; + ALL_TAC] THEN CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + X_GEN_TAC `x:A` THEN DISCH_TAC THEN BETA_TAC THEN + REWRITE_TAC[REAL_ABS_INV] THEN + MATCH_MP_TAC REAL_INV_LE_1 THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= s ==> &1 <= abs(&1 + s)`) THEN + MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN GEN_TAC THEN STRIP_TAC THEN + ASM_MESON_TAC[]; + ALL_TAC] THEN + (* Integrable S_n *) + SUBGOAL_THEN `integrable p + (\x:A. sum (0..n) (\k. + (indicator_fn ((B:num->A->bool) (SUC k)) x - + (v':num->A->real) k x) / + (&1 + sum (0..k) (\j. v' j x))))` ASSUME_TAC THENL + [MATCH_MP_TAC INTEGRABLE_SUM THEN + X_GEN_TAC `i:num` THEN DISCH_TAC THEN BETA_TAC THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + (* |S_n| <= SUC n *) + SUBGOAL_THEN `!x:A. x IN prob_carrier p + ==> abs(sum (0..n) (\k. + (indicator_fn ((B:num->A->bool) (SUC k)) x - + (v':num->A->real) k x) / + (&1 + sum (0..k) (\j. v' j x)))) <= &(SUC n)` ASSUME_TAC THENL + [X_GEN_TAC `x:A` THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(0..n) (\k:num. &1)` THEN CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(0..n) + (\k. abs((indicator_fn ((B:num->A->bool) (SUC k)) x - + (v':num->A->real) k x) / + (&1 + sum (0..k) (\j. v' j x))))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_ABS_LE THEN REWRITE_TAC[FINITE_NUMSEG] THEN + SIMP_TAC[IN_NUMSEG; REAL_LE_REFL]; ALL_TAC] THEN + MATCH_MP_TAC SUM_LE_NUMSEG THEN X_GEN_TAC `k:num` THEN + STRIP_TAC THEN BETA_TAC THEN REWRITE_TAC[REAL_ABS_DIV] THEN + MATCH_MP_TAC REAL_DIV_ABS_LE_1 THEN + CONJ_TAC THENL [ASM_MESON_TAC[]; + MATCH_MP_TAC(REAL_ARITH `&0 <= s ==> &1 <= &1 + s`) THEN + MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN GEN_TAC THEN STRIP_TAC THEN + ASM_MESON_TAC[]]; + REWRITE_TAC[SUM_CONST_NUMSEG; SUB_0] THEN + REWRITE_TAC[REAL_OF_NUM_LE; REAL_OF_NUM_MUL; MULT_CLAUSES] THEN + ARITH_TAC]; + ALL_TAC] THEN + (* Integrable S_n^2 *) + SUBGOAL_THEN `integrable p + (\x:A. sum (0..n) (\k. + (indicator_fn ((B:num->A->bool) (SUC k)) x - + (v':num->A->real) k x) / + (&1 + sum (0..k) (\j. v' j x))) pow 2)` ASSUME_TAC THENL + [MATCH_MP_TAC INTEGRABLE_BOUNDED THEN + EXISTS_TAC `(&(SUC n)) pow 2` THEN CONJ_TAC THENL + [MATCH_MP_TAC RANDOM_VARIABLE_POW THEN + MATCH_MP_TAC INTEGRABLE_IMP_RANDOM_VARIABLE THEN ASM_REWRITE_TAC[]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN BETA_TAC THEN + REWRITE_TAC[REAL_ABS_POW] THEN + MATCH_MP_TAC REAL_POW_LE2 THEN + REWRITE_TAC[REAL_ABS_POS] THEN ASM_MESON_TAC[]]; + ALL_TAC] THEN + (* Integrable d^2 * inv(D^2) *) + SUBGOAL_THEN `integrable p + (\x:A. (indicator_fn ((B:num->A->bool) (SUC (SUC n))) x - + (v':num->A->real) (SUC n) x) pow 2 * + inv ((&1 + sum (0..n) (\j. v' j x) + v' (SUC n) x) pow 2))` + ASSUME_TAC THENL + [MATCH_MP_TAC INTEGRABLE_BOUNDED THEN EXISTS_TAC `&1` THEN + CONJ_TAC THENL + [MATCH_MP_TAC RANDOM_VARIABLE_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC RANDOM_VARIABLE_POW THEN + MATCH_MP_TAC RANDOM_VARIABLE_SUB THEN CONJ_TAC THENL + [SUBGOAL_THEN `(\x:A. indicator_fn + ((B:num->A->bool) (SUC (SUC n))) x) = + indicator_fn (B (SUC (SUC n)))` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; ETA_AX]; ALL_TAC] THEN + MATCH_MP_TAC INTEGRABLE_IMP_RANDOM_VARIABLE THEN + MATCH_MP_TAC INTEGRABLE_INDICATOR THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[ETA_AX] THEN ASM_REWRITE_TAC[]]; + SUBGOAL_THEN `(\x:A. inv((&1 + sum (0..n) + (\j. (v':num->A->real) j x) + v' (SUC n) x) pow 2)) = + (\x. &1 / (&1 + sum (0..n) (\j. v' j x) + v' (SUC n) x) pow 2)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; real_div; REAL_MUL_LID]; ALL_TAC] THEN + MATCH_MP_TAC RANDOM_VARIABLE_DIV_POS THEN CONJ_TAC THENL + [REWRITE_TAC[RANDOM_VARIABLE_CONST]; ALL_TAC] THEN CONJ_TAC THENL + [MATCH_MP_TAC RANDOM_VARIABLE_POW THEN + MATCH_MP_TAC RANDOM_VARIABLE_ADD THEN CONJ_TAC THENL + [REWRITE_TAC[RANDOM_VARIABLE_CONST]; + MATCH_MP_TAC RANDOM_VARIABLE_ADD THEN CONJ_TAC THENL + [MATCH_MP_TAC RANDOM_VARIABLE_SUM THEN GEN_TAC THEN DISCH_TAC THEN + BETA_TAC THEN REWRITE_TAC[ETA_AX] THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[ETA_AX] THEN ASM_REWRITE_TAC[]]]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_POW_LT THEN ASM_MESON_TAC[]]]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN BETA_TAC THEN + REWRITE_TAC[REAL_ABS_MUL; REAL_ABS_POW; REAL_ABS_INV] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&1 * &1` THEN + CONJ_TAC THENL + [MATCH_MP_TAC REAL_LE_MUL2 THEN + REPEAT CONJ_TAC THENL + [MATCH_MP_TAC REAL_POW_LE THEN REWRITE_TAC[REAL_ABS_POS]; + MATCH_MP_TAC REAL_POW_1_LE THEN REWRITE_TAC[REAL_ABS_POS] THEN + ASM_MESON_TAC[]; + MATCH_MP_TAC REAL_LE_INV THEN MATCH_MP_TAC REAL_POW_LE THEN + REWRITE_TAC[REAL_ABS_POS]; + MATCH_MP_TAC REAL_INV_LE_1 THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&1 pow 2` THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_POW_LE2 THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 <= s /\ &0 <= t ==> &1 <= abs(&1 + s + t)`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN GEN_TAC THEN STRIP_TAC THEN + ASM_MESON_TAC[]; + ASM_MESON_TAC[]]]; + REAL_ARITH_TAC]]; + ALL_TAC] THEN + (* Integrable cross-term d * (S/D) *) + SUBGOAL_THEN `integrable p + (\x:A. (indicator_fn ((B:num->A->bool) (SUC (SUC n))) x - + (v':num->A->real) (SUC n) x) * + (sum (0..n) (\k. (indicator_fn (B (SUC k)) x - v' k x) / + (&1 + sum (0..k) (\j. v' j x))) / + (&1 + sum (0..n) (\j. v' j x) + v' (SUC n) x)))` + ASSUME_TAC THENL + [MATCH_MP_TAC INTEGRABLE_MUL_BOUNDED THEN + EXISTS_TAC `&(SUC n)` THEN CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_SUB THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + REWRITE_TAC[ETA_AX] THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_IMP_RANDOM_VARIABLE THEN + ONCE_REWRITE_TAC[real_div] THEN + MATCH_MP_TAC INTEGRABLE_MUL_BOUNDED THEN + EXISTS_TAC `&1` THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[]; ALL_TAC] THEN CONJ_TAC THENL + [SUBGOAL_THEN `(\x:A. inv(&1 + sum (0..n) + (\j. (v':num->A->real) j x) + v' (SUC n) x)) = + (\x. &1 / (&1 + sum (0..n) (\j. v' j x) + v' (SUC n) x))` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; real_div; REAL_MUL_LID]; ALL_TAC] THEN + MATCH_MP_TAC RANDOM_VARIABLE_DIV_POS THEN CONJ_TAC THENL + [REWRITE_TAC[RANDOM_VARIABLE_CONST]; ALL_TAC] THEN CONJ_TAC THENL + [MATCH_MP_TAC RANDOM_VARIABLE_ADD THEN CONJ_TAC THENL + [REWRITE_TAC[RANDOM_VARIABLE_CONST]; + MATCH_MP_TAC RANDOM_VARIABLE_ADD THEN CONJ_TAC THENL + [MATCH_MP_TAC RANDOM_VARIABLE_SUM THEN GEN_TAC THEN DISCH_TAC THEN + BETA_TAC THEN REWRITE_TAC[ETA_AX] THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[ETA_AX] THEN ASM_REWRITE_TAC[]]]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN ASM_MESON_TAC[]]; + ALL_TAC] THEN CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + X_GEN_TAC `x:A` THEN DISCH_TAC THEN BETA_TAC THEN + REWRITE_TAC[REAL_ABS_INV] THEN + MATCH_MP_TAC REAL_INV_LE_1 THEN + MATCH_MP_TAC(REAL_ARITH + `&0 <= s /\ &0 <= t ==> &1 <= abs(&1 + s + t)`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN GEN_TAC THEN STRIP_TAC THEN + ASM_MESON_TAC[]; + ASM_MESON_TAC[]]; + ALL_TAC] THEN CONJ_TAC THENL [REWRITE_TAC[REAL_POS]; ALL_TAC] THEN + X_GEN_TAC `x:A` THEN DISCH_TAC THEN BETA_TAC THEN + REWRITE_TAC[REAL_ABS_DIV] THEN + MATCH_MP_TAC REAL_ABS_DIV_LE THEN + CONJ_TAC THENL + [ASM_MESON_TAC[]; + MATCH_MP_TAC(REAL_ARITH + `&0 <= s /\ &0 <= t ==> &1 <= abs(&1 + s + t)`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN GEN_TAC THEN STRIP_TAC THEN + ASM_MESON_TAC[]; + ASM_MESON_TAC[]]]; + ALL_TAC] THEN + (* First EXPECTATION_ADD: split E[S^2 + (d^2/D^2 + 2*cross)] *) + MP_TAC(ISPECL [`p:A prob_space`; + `\x:A. sum (0..n) + (\k. (indicator_fn ((B:num->A->bool) (SUC k)) x - + (v':num->A->real) k x) / + (&1 + sum (0..k) (\j. v' j x))) pow 2`; + `\x:A. (indicator_fn ((B:num->A->bool) (SUC (SUC n))) x - + (v':num->A->real) (SUC n) x) pow 2 * + inv ((&1 + sum (0..n) (\j. v' j x) + v' (SUC n) x) pow 2) + + &2 * ((indicator_fn (B (SUC (SUC n))) x - v' (SUC n) x) * + (sum (0..n) (\k. (indicator_fn (B (SUC k)) x - v' k x) / + (&1 + sum (0..k) (\j. v' j x))) / + (&1 + sum (0..n) (\j. v' j x) + v' (SUC n) x)))`] + EXPECTATION_ADD) THEN + BETA_TAC THEN ANTS_TAC THENL + [CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + MATCH_MP_TAC INTEGRABLE_ADD THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + MATCH_MP_TAC INTEGRABLE_CMUL THEN ASM_REWRITE_TAC[]]]; + ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN + AP_TERM_TAC THEN + (* Second EXPECTATION_ADD: split E[d^2/D^2 + 2*cross] *) + MP_TAC(ISPECL [`p:A prob_space`; + `\x:A. (indicator_fn ((B:num->A->bool) (SUC (SUC n))) x - + (v':num->A->real) (SUC n) x) pow 2 * + inv ((&1 + sum (0..n) (\j. v' j x) + v' (SUC n) x) pow 2)`; + `\x:A. &2 * ((indicator_fn ((B:num->A->bool) (SUC (SUC n))) x - + (v':num->A->real) (SUC n) x) * + (sum (0..n) (\k. (indicator_fn (B (SUC k)) x - v' k x) / + (&1 + sum (0..k) (\j. v' j x))) / + (&1 + sum (0..n) (\j. v' j x) + v' (SUC n) x)))`] + EXPECTATION_ADD) THEN + BETA_TAC THEN ANTS_TAC THENL + [CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + MATCH_MP_TAC INTEGRABLE_CMUL THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + DISCH_THEN SUBST1_TAC THEN + (* E[2 * cross] = 2 * E[cross] = 0 *) + MP_TAC(ISPECL [`p:A prob_space`; `&2`; + `\x:A. (indicator_fn ((B:num->A->bool) (SUC (SUC n))) x - + (v':num->A->real) (SUC n) x) * + (sum (0..n) (\k. (indicator_fn (B (SUC k)) x - v' k x) / + (&1 + sum (0..k) (\j. v' j x))) / + (&1 + sum (0..n) (\j. v' j x) + v' (SUC n) x))`] + EXPECTATION_CMUL) THEN + BETA_TAC THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN SUBST1_TAC THEN REAL_ARITH_TAC; + ALL_TAC] THEN + (* Step 3: E[S^2] + E[d^2] <= E[sum + v'/D^2] *) + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `expectation p + (\x:A. sum (0..n) (\k. (v':num->A->real) k x / + (&1 + sum (0..k) (\j. v' j x)) pow 2)) + + expectation p + (\x. v' (SUC n) x * + inv ((&1 + sum (0..n) (\j. v' j x) + v' (SUC n) x) pow 2))` THEN + CONJ_TAC THENL + [(* IH + TRUNCATED_DIFF_SQ_BOUND *) + MATCH_MP_TAC REAL_LE_ADD2 THEN CONJ_TAC THENL + [FIRST_X_ASSUM MATCH_ACCEPT_TAC; + MP_TAC(ISPECL [`p:A prob_space`; `FF:num->(A->bool)->bool`; + `B:num->A->bool`; `SUC n`; + `\x:A. inv((&1 + sum (0..n) (\j. (v':num->A->real) j x) + + v' (SUC n) x) pow 2)`; + `&1`] TRUNCATED_DIFF_SQ_BOUND) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(fun th -> + MATCH_MP_TAC(BETA_RULE(REWRITE_RULE[IMP_IMP] th))) THEN + REWRITE_TAC[REAL_POS] THEN REPEAT CONJ_TAC THENL + [(* integrable inv(D^2) *) + MATCH_MP_TAC INTEGRABLE_BOUNDED THEN EXISTS_TAC `&1` THEN + CONJ_TAC THENL + [SUBGOAL_THEN `(\x:A. inv((&1 + sum (0..n) + (\j. (v':num->A->real) j x) + v' (SUC n) x) pow 2)) = + (\x. &1 / (&1 + sum (0..n) (\j. v' j x) + v' (SUC n) x) pow 2)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; real_div; REAL_MUL_LID]; ALL_TAC] THEN + MATCH_MP_TAC RANDOM_VARIABLE_DIV_POS THEN CONJ_TAC THENL + [REWRITE_TAC[RANDOM_VARIABLE_CONST]; ALL_TAC] THEN CONJ_TAC THENL + [MATCH_MP_TAC RANDOM_VARIABLE_POW THEN + MATCH_MP_TAC RANDOM_VARIABLE_ADD THEN CONJ_TAC THENL + [REWRITE_TAC[RANDOM_VARIABLE_CONST]; + MATCH_MP_TAC RANDOM_VARIABLE_ADD THEN CONJ_TAC THENL + [MATCH_MP_TAC RANDOM_VARIABLE_SUM THEN GEN_TAC THEN + DISCH_TAC THEN BETA_TAC THEN + REWRITE_TAC[ETA_AX] THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[ETA_AX] THEN ASM_REWRITE_TAC[]]]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_POW_LT THEN ASM_MESON_TAC[]]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN BETA_TAC THEN + REWRITE_TAC[REAL_ABS_INV; REAL_ABS_POW] THEN + MATCH_MP_TAC REAL_INV_LE_1 THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&1 pow 2` THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_POW_LE2 THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 <= s /\ &0 <= t ==> &1 <= abs(&1 + s + t)`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN GEN_TAC THEN STRIP_TAC THEN + ASM_MESON_TAC[]; + ASM_MESON_TAC[]]]; + (* measurable_wrt inv(D^2) *) + MATCH_MP_TAC MEASURABLE_WRT_INV_GE_ONE THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_WRT_POW2 THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MEASURABLE_WRT_ADD THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_WRT_CONST THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC MEASURABLE_WRT_ADD THEN ASM_REWRITE_TAC[] THEN + CONJ_TAC THENL + [MATCH_MP_TAC MEASURABLE_WRT_SUM THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `j:num` THEN DISCH_TAC THEN + REWRITE_TAC[ETA_AX] THEN + MATCH_MP_TAC MEASURABLE_WRT_MONO THEN + EXISTS_TAC `(FF:num->(A->bool)->bool) j` THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `j:num <= SUC n` ASSUME_TAC THENL + [UNDISCH_TAC `j:num <= n` THEN ARITH_TAC; ALL_TAC] THEN + ASM_MESON_TAC[filtration]; + REWRITE_TAC[ETA_AX] THEN + MATCH_MP_TAC MEASURABLE_WRT_MONO THEN + EXISTS_TAC `(FF:num->(A->bool)->bool) (SUC n)` THEN + ASM_REWRITE_TAC[] THEN + ASM_MESON_TAC[filtration; LE_REFL]]]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&1 pow 2` THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_POW_LE2 THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 <= s /\ &0 <= t ==> &1 <= &1 + s + t`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN GEN_TAC THEN STRIP_TAC THEN + ASM_MESON_TAC[]; + ASM_MESON_TAC[]]]; + (* |inv(D^2)| <= 1 *) + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + REWRITE_TAC[REAL_ABS_INV; REAL_ABS_POW] THEN + MATCH_MP_TAC REAL_INV_LE_1 THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&1 pow 2` THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_POW_LE2 THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 <= s /\ &0 <= t ==> &1 <= abs(&1 + s + t)`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN GEN_TAC THEN STRIP_TAC THEN + ASM_MESON_TAC[]; + ASM_MESON_TAC[]]; + (* nonneg: 0 <= inv(D^2) *) + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_LE_INV THEN MATCH_MP_TAC REAL_POW_LE THEN + MATCH_MP_TAC(REAL_ARITH + `&0 <= s /\ &0 <= t ==> &0 <= &1 + s + t`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN GEN_TAC THEN STRIP_TAC THEN + ASM_MESON_TAC[]; + ASM_MESON_TAC[]]]]; + (* E[sum] + E[v'*inv(D^2)] = E[sum + v'/D^2] *) + REWRITE_TAC[real_div] THEN + MATCH_MP_TAC(REAL_ARITH `a = b ==> a <= b`) THEN + MATCH_MP_TAC(GSYM EXPECTATION_ADD) THEN + CONJ_TAC THENL + [(* integrable sum v'_k * inv(D_k^2) *) + MATCH_MP_TAC INTEGRABLE_SUM THEN + X_GEN_TAC `i:num` THEN DISCH_TAC THEN BETA_TAC THEN + MATCH_MP_TAC INTEGRABLE_MUL_BOUNDED THEN + EXISTS_TAC `&1` THEN CONJ_TAC THENL + [REWRITE_TAC[ETA_AX] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN CONJ_TAC THENL + [SUBGOAL_THEN `(\x:A. inv((&1 + sum (0..i) + (\j. (v':num->A->real) j x)) pow 2)) = + (\x. &1 / (&1 + sum (0..i) (\j. v' j x)) pow 2)` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; real_div; REAL_MUL_LID]; ALL_TAC] THEN + MATCH_MP_TAC RANDOM_VARIABLE_DIV_POS THEN CONJ_TAC THENL + [REWRITE_TAC[RANDOM_VARIABLE_CONST]; ALL_TAC] THEN CONJ_TAC THENL + [MATCH_MP_TAC RANDOM_VARIABLE_POW THEN + MATCH_MP_TAC RANDOM_VARIABLE_ADD THEN CONJ_TAC THENL + [REWRITE_TAC[RANDOM_VARIABLE_CONST]; + MATCH_MP_TAC RANDOM_VARIABLE_SUM THEN GEN_TAC THEN DISCH_TAC THEN + BETA_TAC THEN REWRITE_TAC[ETA_AX] THEN ASM_REWRITE_TAC[]]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_POW_LT THEN ASM_MESON_TAC[]]; + CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + X_GEN_TAC `x:A` THEN DISCH_TAC THEN BETA_TAC THEN + REWRITE_TAC[REAL_ABS_INV; REAL_ABS_POW] THEN + MATCH_MP_TAC REAL_INV_LE_1 THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&1 pow 2` THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_POW_LE2 THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= s ==> &1 <= abs(&1 + s)`) THEN + MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN GEN_TAC THEN STRIP_TAC THEN + ASM_MESON_TAC[]]; + (* integrable v'(SUC n) * inv(D^2) *) + MATCH_MP_TAC INTEGRABLE_MUL_BOUNDED THEN + EXISTS_TAC `&1` THEN CONJ_TAC THENL + [REWRITE_TAC[ETA_AX] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN CONJ_TAC THENL + [SUBGOAL_THEN `(\x:A. inv((&1 + sum (0..n) + (\j. (v':num->A->real) j x) + v' (SUC n) x) pow 2)) = + (\x. &1 / (&1 + sum (0..n) (\j. v' j x) + + v' (SUC n) x) pow 2)` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM; real_div; REAL_MUL_LID]; ALL_TAC] THEN + MATCH_MP_TAC RANDOM_VARIABLE_DIV_POS THEN CONJ_TAC THENL + [REWRITE_TAC[RANDOM_VARIABLE_CONST]; ALL_TAC] THEN CONJ_TAC THENL + [MATCH_MP_TAC RANDOM_VARIABLE_POW THEN + MATCH_MP_TAC RANDOM_VARIABLE_ADD THEN CONJ_TAC THENL + [REWRITE_TAC[RANDOM_VARIABLE_CONST]; + MATCH_MP_TAC RANDOM_VARIABLE_ADD THEN CONJ_TAC THENL + [MATCH_MP_TAC RANDOM_VARIABLE_SUM THEN GEN_TAC THEN DISCH_TAC THEN + BETA_TAC THEN REWRITE_TAC[ETA_AX] THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[ETA_AX] THEN ASM_REWRITE_TAC[]]]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_POW_LT THEN ASM_MESON_TAC[]]; + CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + X_GEN_TAC `x:A` THEN DISCH_TAC THEN BETA_TAC THEN + REWRITE_TAC[REAL_ABS_INV; REAL_ABS_POW] THEN + MATCH_MP_TAC REAL_INV_LE_1 THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&1 pow 2` THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_POW_LE2 THEN + CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC(REAL_ARITH + `&0 <= s /\ &0 <= t ==> &1 <= abs(&1 + s + t)`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN GEN_TAC THEN STRIP_TAC THEN + ASM_MESON_TAC[]; + ASM_MESON_TAC[]]]]]]; + ALL_TAC] THEN + (* Final: E[sum v'/(1+V')^2] <= 1 by telescoping *) + GEN_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `expectation p + (\x:A. sum (0..n) (\k. (v':num->A->real) k x / + (&1 + sum (0..k) (\j. v' j x)) pow 2))` THEN + CONJ_TAC THENL [FIRST_X_ASSUM MATCH_ACCEPT_TAC; ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `expectation p (\x:A. &1)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC EXPECTATION_MONO THEN + CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_BOUNDED THEN EXISTS_TAC `&1` THEN CONJ_TAC THENL + [MATCH_MP_TAC RANDOM_VARIABLE_SUM THEN GEN_TAC THEN DISCH_TAC THEN + BETA_TAC THEN + MATCH_MP_TAC RANDOM_VARIABLE_DIV_POS THEN CONJ_TAC THENL + [REWRITE_TAC[ETA_AX] THEN ASM_REWRITE_TAC[]; + CONJ_TAC THENL + [MATCH_MP_TAC RANDOM_VARIABLE_POW THEN + MATCH_MP_TAC RANDOM_VARIABLE_ADD THEN + REWRITE_TAC[RANDOM_VARIABLE_CONST] THEN + MATCH_MP_TAC RANDOM_VARIABLE_SUM THEN GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[ETA_AX] THEN ASM_REWRITE_TAC[]; + GEN_TAC THEN DISCH_TAC THEN MATCH_MP_TAC REAL_POW_LT THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= s ==> &0 < &1 + s`) THEN + MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN GEN_TAC THEN STRIP_TAC THEN + ASM_MESON_TAC[]]]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN BETA_TAC THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= t /\ t <= &1 ==> abs t <= &1`) THEN + CONJ_TAC THENL + [MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN GEN_TAC THEN STRIP_TAC THEN + BETA_TAC THEN MATCH_MP_TAC REAL_LE_DIV THEN CONJ_TAC THENL + [ASM_MESON_TAC[]; REWRITE_TAC[REAL_LE_POW_2]]; + MP_TAC(ISPECL [`\k:num. (v':num->A->real) k (x:A)`; `n:num`] + TELESCOPING_VARIANCE_BOUND_SIMPLE) THEN + REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + GEN_TAC THEN ASM_MESON_TAC[]]]; + ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_BOUNDED THEN EXISTS_TAC `&1` THEN + CONJ_TAC THENL [REWRITE_TAC[RANDOM_VARIABLE_CONST]; ALL_TAC] THEN + X_GEN_TAC `x:A` THEN DISCH_TAC THEN BETA_TAC THEN + REWRITE_TAC[REAL_ABS_NUM] THEN REAL_ARITH_TAC; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN BETA_TAC THEN + MATCH_MP_TAC TELESCOPING_VARIANCE_BOUND_SIMPLE THEN + GEN_TAC THEN ASM_MESON_TAC[]]; + REWRITE_TAC[EXPECTATION_CONST; REAL_LE_REFL]]);; + +(* Helper: T' has bounded L1 norm *) +let RESCALED_MAX_L2_BOUNDED = prove + (`!p FF (B:num->A->bool). + filtration p FF /\ (!n. B n IN prob_events p) /\ + (!n. B n SUBSET prob_carrier p) /\ (!n. B n IN FF n) + ==> !n. expectation p + (\x. abs(sum(0..n) + (\k. (indicator_fn (B (SUC k)) x - + gen_cond_exp p (FF k) + (\y. indicator_fn (B (SUC k)) y) x) / + max (&1 + sum(0..k) + (\j. gen_cond_exp p (FF j) + (\y. indicator_fn (B (SUC j)) y) x)) (&1)))) <= &1`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + ABBREV_TAC `v = \k x:A. gen_cond_exp p (FF k) + (\y. indicator_fn (B (SUC k)) y) x` THEN + SUBGOAL_THEN `!k (x:A). gen_cond_exp p (FF k) + (\y. indicator_fn (B (SUC k)) y) x = (v:num->A->real) k x` + ASSUME_TAC THENL [ASM_MESON_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `!n. sub_sigma_algebra p ((FF:num->(A->bool)->bool) n)` + ASSUME_TAC THENL [ASM_MESON_TAC[filtration]; ALL_TAC] THEN + SUBGOAL_THEN `!k. integrable p (\y:A. indicator_fn + ((B:num->A->bool) (SUC k)) y)` ASSUME_TAC THENL + [GEN_TAC THEN REWRITE_TAC[ETA_AX] THEN + MATCH_MP_TAC INTEGRABLE_INDICATOR THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + ABBREV_TAC `v' = \k (x:A). max (min ((v:num->A->real) k x) (&1)) (&0)` THEN + SUBGOAL_THEN `!k (x:A). &0 <= (v':num->A->real) k x /\ v' k x <= &1` + ASSUME_TAC THENL + [REPEAT GEN_TAC THEN EXPAND_TAC "v'" THEN REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `!k. random_variable p (\x:A. (v:num->A->real) k x)` + (LABEL_TAC "RV_V") THENL + [GEN_TAC THEN + SUBGOAL_THEN `(\x:A. (v:num->A->real) k x) = + gen_cond_exp p ((FF:num->(A->bool)->bool) k) + (\y. indicator_fn ((B:num->A->bool) (SUC k)) y)` SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC MEASURABLE_WRT_IMP_RV THEN + EXISTS_TAC `(FF:num->(A->bool)->bool) k` THEN + ASM_MESON_TAC[GEN_COND_EXP_MEASURABLE_WRT]; + ALL_TAC] THEN + (* v = v' a.e. for all k simultaneously *) + SUBGOAL_THEN `almost_surely p + {x:A | !k. (v:num->A->real) k x = (v':num->A->real) k x}` + (LABEL_TAC "VV") THENL + [MATCH_MP_TAC ALMOST_SURELY_SUBSET THEN + EXISTS_TAC `INTERS {(\k. {x:A | &0 <= (v:num->A->real) k x /\ + v k x <= &1}) n | n IN (:num)}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC ALMOST_SURELY_COUNTABLE_INTER THEN GEN_TAC THEN + BETA_TAC THEN + SUBGOAL_THEN `{x:A | &0 <= (v:num->A->real) n x /\ v n x <= &1} = + {x | &0 <= gen_cond_exp p (FF n) (\y. indicator_fn (B (SUC n)) y) x /\ + gen_cond_exp p (FF n) (\y. indicator_fn (B (SUC n)) y) x <= &1}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL [`p:A prob_space`; `FF:num->(A->bool)->bool`; + `B:num->A->bool`] COND_EXP_INDICATOR_BOUNDED_AE) THEN + ASM_REWRITE_TAC[] THEN DISCH_THEN(MP_TAC o SPEC `n:num`) THEN + REWRITE_TAC[]; + REWRITE_TAC[IN_INTERS; IN_ELIM_THM; IN_UNIV] THEN + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + DISCH_TAC THEN X_GEN_TAC `k:num` THEN + SUBGOAL_THEN `&0 <= (v:num->A->real) k x /\ v k x <= &1` MP_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC + `{x:A | &0 <= (v:num->A->real) k x /\ v k x <= &1}`) THEN + REWRITE_TAC[IN_ELIM_THM] THEN ANTS_TAC THENL + [EXISTS_TAC `k:num` THEN REWRITE_TAC[]; SIMP_TAC[]]; ALL_TAC] THEN + EXPAND_TAC "v'" THEN REAL_ARITH_TAC]; ALL_TAC] THEN + (* On the a.e. set, v = v' implies T' = T'' *) + SUBGOAL_THEN `!n:num. almost_surely p + {x:A | sum (0..n) (\k. (indicator_fn (B (SUC k)) x - (v:num->A->real) k x) / + max (&1 + sum (0..k) (\j. v j x)) (&1)) = + sum (0..n) (\k. (indicator_fn (B (SUC k)) x - (v':num->A->real) k x) / + (&1 + sum (0..k) (\j. v' j x)))}` + (LABEL_TAC "EQ") THENL + [GEN_TAC THEN MATCH_MP_TAC ALMOST_SURELY_SUBSET THEN + EXISTS_TAC `{x:A | !k. (v:num->A->real) k x = (v':num->A->real) k x}` THEN + CONJ_TAC THENL [REMOVE_THEN "VV" (fun th -> REWRITE_TAC[th]); ALL_TAC] THEN + REWRITE_TAC[IN_ELIM_THM] THEN X_GEN_TAC `x:A` THEN DISCH_TAC THEN + DISCH_TAC THEN + MATCH_MP_TAC SUM_EQ_NUMSEG THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN + SUBGOAL_THEN `(v:num->A->real) k x = (v':num->A->real) k x` ASSUME_TAC THENL + [ASM_MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `sum (0..k) (\j. (v:num->A->real) j x) = + sum (0..k) (\j. (v':num->A->real) j x)` ASSUME_TAC THENL + [MATCH_MP_TAC SUM_EQ_NUMSEG THEN ASM_MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `&0 <= sum (0..k) (\j. (v':num->A->real) j x)` ASSUME_TAC THENL + [MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN ASM_MESON_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN AP_TERM_TAC THEN MATCH_MP_TAC(REAL_ARITH + `&0 <= s ==> max (&1 + s) (&1) = &1 + s`) THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + (* The original |T'| is integrable (from martingale property) *) + SUBGOAL_THEN `!n:num. integrable p (\x:A. abs(sum (0..n) + (\k. (indicator_fn ((B:num->A->bool) (SUC k)) x - + (v:num->A->real) k x) / + max (&1 + sum (0..k) (\j. v j x)) (&1))))` (LABEL_TAC "INT") THENL + [GEN_TAC THEN MATCH_MP_TAC INTEGRABLE_ABS THEN + MP_TAC(ISPECL [`p:A prob_space`; `FF:num->(A->bool)->bool`; + `B:num->A->bool`] RESCALED_MAX_MARTINGALE) THEN + ASM_REWRITE_TAC[] THEN REWRITE_TAC[martingale; submartingale] THEN + ASM_REWRITE_TAC[] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + (* L2 bound for truncated version *) + SUBGOAL_THEN `!n:num. expectation p + (\x:A. (sum (0..n) (\k. (indicator_fn (B (SUC k)) x - + (v':num->A->real) k x) / + (&1 + sum (0..k) (\j. v' j x)))) pow 2) <= &1` + (LABEL_TAC "L2") THENL + [MP_TAC(ISPECL [`p:A prob_space`; `FF:num->(A->bool)->bool`; + `B:num->A->bool`] RESCALED_TRUNCATED_L2) THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `!k (x:A). max (min (gen_cond_exp p ((FF:num->(A->bool)->bool) k) + (\y. indicator_fn ((B:num->A->bool) (SUC k)) y) x) (&1)) (&0) = + (v':num->A->real) k x` (fun th -> REWRITE_TAC[th]) THEN + REPEAT GEN_TAC THEN EXPAND_TAC "v'" THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + (* T'' is bounded everywhere *) + SUBGOAL_THEN `!n (x:A). abs(sum (0..n) (\k. (indicator_fn + ((B:num->A->bool) (SUC k)) x - (v':num->A->real) k x) / + (&1 + sum (0..k) (\j. v' j x)))) <= &(SUC n)` (LABEL_TAC "BD") THENL + [REPEAT GEN_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum (0..n) (\k:num. abs((indicator_fn + ((B:num->A->bool) (SUC k)) x - (v':num->A->real) k x) / + (&1 + sum (0..k) (\j. v' j x))))` THEN + REWRITE_TAC[SUM_ABS_NUMSEG] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum (0..n) (\k:num. &1)` THEN CONJ_TAC THENL + [MATCH_MP_TAC SUM_LE_NUMSEG THEN X_GEN_TAC `k:num` THEN STRIP_TAC THEN + REWRITE_TAC[REAL_ABS_DIV] THEN + SUBGOAL_THEN `&0 < abs(&1 + sum(0..k) (\j. (v':num->A->real) j x))` + ASSUME_TAC THENL + [MATCH_MP_TAC(REAL_ARITH `&0 <= s ==> &0 < abs(&1 + s)`) THEN + MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN ASM_MESON_TAC[]; ALL_TAC] THEN + ASM_SIMP_TAC[REAL_LE_LDIV_EQ] THEN + REWRITE_TAC[REAL_MUL_LID] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN EXISTS_TAC `&1` THEN CONJ_TAC THENL + [REWRITE_TAC[indicator_fn] THEN COND_CASES_TAC THEN ASM_MESON_TAC[REAL_ARITH + `&0 <= v /\ v <= &1 ==> abs(&1 - v) <= &1 /\ abs(&0 - v) <= &1`]; + MATCH_MP_TAC(REAL_ARITH `&0 <= s ==> &1 <= abs(&1 + s)`) THEN + MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN ASM_MESON_TAC[]]; + REWRITE_TAC[SUM_CONST_NUMSEG; SUB_0; ADD1; REAL_MUL_RID] THEN + REAL_ARITH_TAC]; ALL_TAC] THEN + (* T'' pow 2 is integrable *) + SUBGOAL_THEN `!n:num. integrable p (\x:A. (sum (0..n) + (\k. (indicator_fn ((B:num->A->bool) (SUC k)) x - + (v':num->A->real) k x) / + (&1 + sum (0..k) (\j. v' j x)))) pow 2)` (LABEL_TAC "I2") THENL + [X_GEN_TAC `m:num` THEN MATCH_MP_TAC INTEGRABLE_BOUNDED THEN + EXISTS_TAC `(&(SUC m)) pow 2` THEN CONJ_TAC THENL + [SUBGOAL_THEN `random_variable p (\x:A. sum (0..m) + (\k. (indicator_fn ((B:num->A->bool) (SUC k)) x - + (v':num->A->real) k x) / + (&1 + sum (0..k) (\j. v' j x))))` (fun rv_th -> + MP_TAC(SPEC `2` (MATCH_MP RANDOM_VARIABLE_POW rv_th)) THEN + REWRITE_TAC[]) THEN + MATCH_MP_TAC RANDOM_VARIABLE_SUM THEN REPEAT STRIP_TAC THEN + BETA_TAC THEN MATCH_MP_TAC RANDOM_VARIABLE_DIV_POS THEN CONJ_TAC THENL + [MATCH_MP_TAC RANDOM_VARIABLE_SUB THEN CONJ_TAC THENL + [REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC INTEGRABLE_IMP_RANDOM_VARIABLE THEN + MATCH_MP_TAC INTEGRABLE_INDICATOR THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN EXPAND_TAC "v'" THEN + MATCH_MP_TAC RANDOM_VARIABLE_MAX THEN CONJ_TAC THENL + [MATCH_MP_TAC RANDOM_VARIABLE_MIN THEN CONJ_TAC THENL + [USE_THEN "RV_V" MATCH_ACCEPT_TAC; + REWRITE_TAC[RANDOM_VARIABLE_CONST]]; + REWRITE_TAC[RANDOM_VARIABLE_CONST]]; ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC RANDOM_VARIABLE_ADD THEN CONJ_TAC THENL + [REWRITE_TAC[RANDOM_VARIABLE_CONST]; ALL_TAC] THEN + MATCH_MP_TAC RANDOM_VARIABLE_SUM THEN REPEAT STRIP_TAC THEN + BETA_TAC THEN + EXPAND_TAC "v'" THEN MATCH_MP_TAC RANDOM_VARIABLE_MAX THEN CONJ_TAC THENL + [MATCH_MP_TAC RANDOM_VARIABLE_MIN THEN CONJ_TAC THENL + [USE_THEN "RV_V" MATCH_ACCEPT_TAC; + REWRITE_TAC[RANDOM_VARIABLE_CONST]]; + REWRITE_TAC[RANDOM_VARIABLE_CONST]]; ALL_TAC] THEN + X_GEN_TAC `x:A` THEN DISCH_TAC THEN BETA_TAC THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= s ==> &0 < &1 + s`) THEN + MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN REWRITE_TAC[REAL_ABS_POW] THEN + MATCH_MP_TAC REAL_POW_LE2 THEN REWRITE_TAC[REAL_ABS_POS] THEN + USE_THEN "BD" (MP_TAC o SPECL [`m:num`; `x:A`]) THEN + ASM_REWRITE_TAC[]]; ALL_TAC] THEN + (* T'' is integrable *) + SUBGOAL_THEN `!n:num. integrable p (\x:A. sum (0..n) + (\k. (indicator_fn ((B:num->A->bool) (SUC k)) x - + (v':num->A->real) k x) / + (&1 + sum (0..k) (\j. v' j x))))` (LABEL_TAC "IT") THENL + [GEN_TAC THEN MATCH_MP_TAC INTEGRABLE_BOUNDED THEN + EXISTS_TAC `&(SUC n)` THEN CONJ_TAC THENL + [MATCH_MP_TAC RANDOM_VARIABLE_SUM THEN REPEAT STRIP_TAC THEN + BETA_TAC THEN MATCH_MP_TAC RANDOM_VARIABLE_DIV_POS THEN CONJ_TAC THENL + [MATCH_MP_TAC RANDOM_VARIABLE_SUB THEN CONJ_TAC THENL + [REWRITE_TAC[ETA_AX] THEN MATCH_MP_TAC INTEGRABLE_IMP_RANDOM_VARIABLE THEN + MATCH_MP_TAC INTEGRABLE_INDICATOR THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN EXPAND_TAC "v'" THEN + MATCH_MP_TAC RANDOM_VARIABLE_MAX THEN CONJ_TAC THENL + [MATCH_MP_TAC RANDOM_VARIABLE_MIN THEN CONJ_TAC THENL + [USE_THEN "RV_V" MATCH_ACCEPT_TAC; + REWRITE_TAC[RANDOM_VARIABLE_CONST]]; + REWRITE_TAC[RANDOM_VARIABLE_CONST]]; ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC RANDOM_VARIABLE_ADD THEN CONJ_TAC THENL + [REWRITE_TAC[RANDOM_VARIABLE_CONST]; ALL_TAC] THEN + MATCH_MP_TAC RANDOM_VARIABLE_SUM THEN REPEAT STRIP_TAC THEN + BETA_TAC THEN + EXPAND_TAC "v'" THEN MATCH_MP_TAC RANDOM_VARIABLE_MAX THEN CONJ_TAC THENL + [MATCH_MP_TAC RANDOM_VARIABLE_MIN THEN CONJ_TAC THENL + [USE_THEN "RV_V" MATCH_ACCEPT_TAC; + REWRITE_TAC[RANDOM_VARIABLE_CONST]]; + REWRITE_TAC[RANDOM_VARIABLE_CONST]]; ALL_TAC] THEN + X_GEN_TAC `x:A` THEN DISCH_TAC THEN BETA_TAC THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= s ==> &0 < &1 + s`) THEN + MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + USE_THEN "BD" (MP_TAC o SPECL [`n:num`; `x:A`]) THEN + ASM_REWRITE_TAC[]]; ALL_TAC] THEN + (* E[|T''|] <= 1 from L2 bound *) + SUBGOAL_THEN `!n:num. expectation p + (\x:A. abs(sum (0..n) (\k. (indicator_fn ((B:num->A->bool) (SUC k)) x - + (v':num->A->real) k x) / + (&1 + sum (0..k) (\j. v' j x))))) <= &1` (LABEL_TAC "L1T") THENL + [GEN_TAC THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `(expectation p (\x:A. (sum (0..n) + (\k. (indicator_fn ((B:num->A->bool) (SUC k)) x - + (v':num->A->real) k x) / + (&1 + sum (0..k) (\j. v' j x)))) pow 2) + &1) / &2` THEN + CONJ_TAC THENL + [MATCH_MP_TAC EXPECTATION_ABS_FROM_SQUARE THEN + CONJ_TAC THENL [ASM_REWRITE_TAC[]; ASM_REWRITE_TAC[]]; + MATCH_MP_TAC(REAL_ARITH `e <= &1 ==> (e + &1) / &2 <= &1`) THEN + ASM_REWRITE_TAC[]]; ALL_TAC] THEN + (* Conclusion: E[|T'|] <= E[|T''|] via a.e. equality *) + X_GEN_TAC `n:num` THEN MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `expectation p (\x:A. abs(sum (0..n) + (\k. (indicator_fn ((B:num->A->bool) (SUC k)) x - + (v':num->A->real) k x) / + (&1 + sum (0..k) (\j. v' j x)))))` THEN + CONJ_TAC THENL [ALL_TAC; ASM_REWRITE_TAC[]] THEN + MATCH_MP_TAC EXPECTATION_MONO_AE THEN CONJ_TAC THENL + [USE_THEN "INT" (fun th -> REWRITE_TAC[th]); ALL_TAC] THEN + CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_ABS THEN + USE_THEN "IT" (fun th -> REWRITE_TAC[th]); ALL_TAC] THEN + MATCH_MP_TAC ALMOST_SURELY_SUBSET THEN + EXISTS_TAC `{x:A | sum (0..n) (\k. (indicator_fn + ((B:num->A->bool) (SUC k)) x - (v:num->A->real) k x) / + max (&1 + sum (0..k) (\j. v j x)) (&1)) = + sum (0..n) (\k. (indicator_fn (B (SUC k)) x - (v':num->A->real) k x) / + (&1 + sum (0..k) (\j. v' j x)))}` THEN + CONJ_TAC THENL [USE_THEN "EQ" (fun th -> REWRITE_TAC[th]); ALL_TAC] THEN + REWRITE_TAC[IN_ELIM_THM] THEN + X_GEN_TAC `x:A` THEN DISCH_TAC THEN DISCH_TAC THEN + ASM_REWRITE_TAC[REAL_LE_REFL]);; + +(* Helper: T' with max denominator converges a.e. *) +let RESCALED_INDICATOR_CONVERGENCE_MAX = prove + (`!p FF (B:num->A->bool). + filtration p FF /\ (!n. B n IN prob_events p) /\ + (!n. B n SUBSET prob_carrier p) /\ (!n. B n IN FF n) + ==> almost_surely p + {x | ?L. ((\n. sum(0..n) + (\k. (indicator_fn (B (SUC k)) x - + gen_cond_exp p (FF k) + (\y. indicator_fn (B (SUC k)) y) x) / + max (&1 + sum(0..k) + (\j. gen_cond_exp p (FF j) + (\y. indicator_fn (B (SUC j)) y) x)) (&1))) + ---> L) sequentially}`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `martingale p (\n. (FF:num->(A->bool)->bool)(SUC n)) + (\n (x:A). sum(0..n) + (\k. (indicator_fn ((B:num->A->bool) (SUC k)) x - + gen_cond_exp p (FF k) + (\y. indicator_fn (B (SUC k)) y) x) / + max (&1 + sum(0..k) + (\j. gen_cond_exp p (FF j) + (\y. indicator_fn (B (SUC j)) y) x)) (&1)))` + (LABEL_TAC "MART") THENL + [MATCH_MP_TAC RESCALED_MAX_MARTINGALE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `!n. expectation (p:A prob_space) + (\x. abs(sum(0..n) + (\k. (indicator_fn ((B:num->A->bool) (SUC k)) x - + gen_cond_exp p (FF k) + (\y. indicator_fn (B (SUC k)) y) x) / + max (&1 + sum(0..k) + (\j. gen_cond_exp p (FF j) + (\y. indicator_fn (B (SUC j)) y) x)) (&1)))) <= &1` + (LABEL_TAC "L1") THENL + [MATCH_MP_TAC RESCALED_MAX_L2_BOUNDED THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL + [`p:A prob_space`; `\n:num. (FF:num->(A->bool)->bool)(SUC n)`; + `\n (x:A). sum(0..n) + (\k. (indicator_fn ((B:num->A->bool) (SUC k)) x - + gen_cond_exp p (FF k) + (\y. indicator_fn (B (SUC k)) y) x) / + max (&1 + sum(0..k) + (\j. gen_cond_exp p (FF j) + (\y. indicator_fn (B (SUC j)) y) x)) (&1))`; + `&1`] + SUBMARTINGALE_CONVERGENCE_L1_BOUNDED) THEN + REWRITE_TAC[] THEN + DISCH_THEN(fun th -> MATCH_MP_TAC th) THEN + CONJ_TAC THENL + [MATCH_MP_TAC MARTINGALE_IMP_SUBMARTINGALE THEN ASM_REWRITE_TAC[]; + ASM_REWRITE_TAC[]]);; + +let RESCALED_INDICATOR_CONVERGENCE = prove + (`!p FF (B:num->A->bool). + filtration p FF /\ (!n. B n IN prob_events p) /\ + (!n. B n SUBSET prob_carrier p) /\ (!n. B n IN FF n) + ==> almost_surely p + {x | ?L. ((\n. sum(0..n) + (\k. (indicator_fn (B (SUC k)) x - + gen_cond_exp p (FF k) + (\y. indicator_fn (B (SUC k)) y) x) / + (&1 + sum(0..k) + (\j. gen_cond_exp p (FF j) + (\y. indicator_fn (B (SUC j)) y) x)))) + ---> L) sequentially}`, + REPEAT STRIP_TAC THEN + (* Step 1: v_k >= 0 a.e. *) + SUBGOAL_THEN + `almost_surely p + (INTERS {{x:A | &0 <= + gen_cond_exp p (FF k) + (\y. indicator_fn ((B:num->A->bool) (SUC k)) y) x} | + k IN (:num)})` + (LABEL_TAC "NONNEG_AS") THENL + [MATCH_MP_TAC ALMOST_SURELY_COUNTABLE_INTER THEN + GEN_TAC THEN MATCH_MP_TAC GEN_COND_EXP_NONNEG THEN + REPEAT CONJ_TAC THENL + [ASM_MESON_TAC[filtration]; + REWRITE_TAC[ETA_AX] THEN + MATCH_MP_TAC INTEGRABLE_INDICATOR THEN ASM_REWRITE_TAC[]; + GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[indicator_fn; IN_ELIM_THM] THEN + COND_CASES_TAC THEN REAL_ARITH_TAC]; ALL_TAC] THEN + (* Step 2: T' with max denominator converges a.e. *) + SUBGOAL_THEN + `almost_surely p + {x:A | ?L. ((\n. sum(0..n) + (\k. (indicator_fn ((B:num->A->bool) (SUC k)) x - + gen_cond_exp p (FF k) + (\y. indicator_fn (B (SUC k)) y) x) / + max (&1 + sum(0..k) + (\j. gen_cond_exp p (FF j) + (\y. indicator_fn (B (SUC j)) y) x)) (&1))) + ---> L) sequentially}` + (LABEL_TAC "CONV_MAX") THENL + [MATCH_MP_TAC RESCALED_INDICATOR_CONVERGENCE_MAX THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + (* Step 3: Intersect the two a.e. sets *) + SUBGOAL_THEN + `almost_surely p + ((INTERS {{x:A | &0 <= + gen_cond_exp p (FF k) + (\y. indicator_fn ((B:num->A->bool) (SUC k)) y) x} | + k IN (:num)}) INTER + {x | ?L. ((\n. sum(0..n) + (\k. (indicator_fn (B (SUC k)) x - + gen_cond_exp p (FF k) + (\y. indicator_fn (B (SUC k)) y) x) / + max (&1 + sum(0..k) + (\j. gen_cond_exp p (FF j) + (\y. indicator_fn (B (SUC j)) y) x)) (&1))) + ---> L) sequentially})` + MP_TAC THENL + [MATCH_MP_TAC ALMOST_SURELY_INTER THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + DISCH_TAC THEN + (* Step 4: Use ALMOST_SURELY_SUBSET: on intersection T' = T *) + MATCH_MP_TAC ALMOST_SURELY_SUBSET THEN + EXISTS_TAC + `(INTERS {{x:A | &0 <= + gen_cond_exp p (FF k) + (\y. indicator_fn ((B:num->A->bool) (SUC k)) y) x} | + k IN (:num)}) INTER + {x | ?L. ((\n. sum(0..n) + (\k. (indicator_fn (B (SUC k)) x - + gen_cond_exp p (FF k) + (\y. indicator_fn (B (SUC k)) y) x) / + max (&1 + sum(0..k) + (\j. gen_cond_exp p (FF j) + (\y. indicator_fn (B (SUC j)) y) x)) (&1))) + ---> L) sequentially}` THEN + ASM_REWRITE_TAC[] THEN + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + REWRITE_TAC[IN_INTER; IN_INTERS; IN_ELIM_THM] THEN + REWRITE_TAC[FORALL_IN_GSPEC; IN_UNIV] THEN + STRIP_TAC THEN + SUBGOAL_THEN + `!k. &0 <= gen_cond_exp p (FF k) + (\y. indicator_fn ((B:num->A->bool) (SUC k)) y) (x:A)` ASSUME_TAC THENL + [GEN_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC + `{x:A | &0 <= gen_cond_exp p (FF k) + (\y. indicator_fn ((B:num->A->bool) (SUC k)) y) x}`) THEN + REWRITE_TAC[IN_ELIM_THM] THEN + DISCH_THEN MATCH_MP_TAC THEN + EXISTS_TAC `k:num` THEN REFL_TAC; ALL_TAC] THEN + EXISTS_TAC `L:real` THEN + MATCH_MP_TAC(ISPEC `sequentially` REALLIM_TRANSFORM_EVENTUALLY) THEN + EXISTS_TAC `\n. sum(0..n) + (\k. (indicator_fn ((B:num->A->bool) (SUC k)) (x:A) - + gen_cond_exp p (FF k) + (\y. indicator_fn (B (SUC k)) y) x) / + max (&1 + sum(0..k) + (\j. gen_cond_exp p (FF j) + (\y. indicator_fn (B (SUC j)) y) x)) (&1))` THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN + EXISTS_TAC `0` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + MATCH_MP_TAC SUM_EQ_NUMSEG THEN + X_GEN_TAC `k:num` THEN STRIP_TAC THEN BETA_TAC THEN + SUBGOAL_THEN + `max (&1 + sum(0..k) + (\j. gen_cond_exp p (FF j) + (\y. indicator_fn ((B:num->A->bool) (SUC j)) y) (x:A))) (&1) = + &1 + sum(0..k) + (\j. gen_cond_exp p (FF j) + (\y. indicator_fn (B (SUC j)) y) x)` + (fun th -> REWRITE_TAC[th]) THEN + REWRITE_TAC[REAL_ARITH `max a b = a <=> b <= a`] THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= s ==> &1 <= &1 + s`) THEN + MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN ASM_REWRITE_TAC[]);; + +(* ======================================================================== *) +(* Levy Conditional Borel-Cantelli Lemma: *) +(* For adapted events B_n in F_n, {B_n i.o.} iff sum E[1_{B_{n+1}}|F_n]=oo *) +(* ======================================================================== *) + +let LEVY_CONDITIONAL_BOREL_CANTELLI = prove + (`!p FF (B:num->A->bool). + filtration p FF /\ (!n. B n IN prob_events p) /\ + (!n. B n SUBSET prob_carrier p) /\ (!n. B n IN FF n) + ==> almost_surely p + {x | x IN limsup_events B <=> + (!M. ?N. &M <= sum(0..N) + (\k. gen_cond_exp p (FF k) + (\y. indicator_fn (B (SUC k)) y) x))}`, + REPEAT STRIP_TAC THEN + (* Step 1: v_k >= 0 a.e. *) + SUBGOAL_THEN + `almost_surely p + (INTERS {{x:A | &0 <= gen_cond_exp p (FF k) + (\y. indicator_fn ((B:num->A->bool) (SUC k)) y) x} | k IN (:num)})` + (LABEL_TAC "NONNEG_AS") THENL + [MATCH_MP_TAC ALMOST_SURELY_COUNTABLE_INTER THEN + GEN_TAC THEN MATCH_MP_TAC GEN_COND_EXP_NONNEG THEN + REPEAT CONJ_TAC THENL + [ASM_MESON_TAC[filtration]; + REWRITE_TAC[ETA_AX] THEN + MATCH_MP_TAC INTEGRABLE_INDICATOR THEN ASM_REWRITE_TAC[]; + GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[indicator_fn; IN_ELIM_THM] THEN + COND_CASES_TAC THEN REAL_ARITH_TAC]; ALL_TAC] THEN + (* Step 2: rescaled sum converges a.e. *) + SUBGOAL_THEN + `almost_surely p + {x:A | ?L. ((\n. sum(0..n) + (\k. (indicator_fn ((B:num->A->bool) (SUC k)) x - + gen_cond_exp p (FF k) + (\y. indicator_fn (B (SUC k)) y) x) / + (&1 + sum(0..k) + (\j. gen_cond_exp p (FF j) + (\y. indicator_fn (B (SUC j)) y) x)))) + ---> L) sequentially}` + (LABEL_TAC "CONV_AS") THENL + [MATCH_MP_TAC RESCALED_INDICATOR_CONVERGENCE THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + (* Step 3: intersect the a.e. sets *) + MATCH_MP_TAC ALMOST_SURELY_SUBSET THEN + EXISTS_TAC + `(INTERS {{x:A | &0 <= gen_cond_exp p (FF k) + (\y. indicator_fn ((B:num->A->bool) (SUC k)) y) x} | k IN (:num)}) + INTER + {x | ?L. ((\n. sum(0..n) + (\k. (indicator_fn (B (SUC k)) x - + gen_cond_exp p (FF k) + (\y. indicator_fn (B (SUC k)) y) x) / + (&1 + sum(0..k) + (\j. gen_cond_exp p (FF j) + (\y. indicator_fn (B (SUC j)) y) x)))) + ---> L) sequentially}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC ALMOST_SURELY_INTER THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[IN_INTER; IN_ELIM_THM; IN_INTERS] THEN + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (X_CHOOSE_THEN `L:real` ASSUME_TAC)) THEN + (* Step 4: extract pointwise nonnegativity *) + SUBGOAL_THEN + `!k. &0 <= gen_cond_exp p (FF k) + (\y:A. indicator_fn ((B:num->A->bool) (SUC k)) y) x` + (LABEL_TAC "NONNEG") THENL + [GEN_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC + `{x:A | &0 <= gen_cond_exp p (FF k) + (\y. indicator_fn ((B:num->A->bool) (SUC k)) y) x}`) THEN + REWRITE_TAC[IN_ELIM_THM] THEN DISCH_THEN MATCH_MP_TAC THEN + REWRITE_TAC[IN_ELIM_THM; IN_UNIV] THEN MESON_TAC[]; ALL_TAC] THEN + (* Step 5: abbreviate v, establish CONV2, then abbreviate a *) + ABBREV_TAC + `v = \k. gen_cond_exp p (FF k) + (\y:A. indicator_fn ((B:num->A->bool) (SUC k)) y) x` THEN + SUBGOAL_THEN + `((\n. sum(0..n) (\k:num. (indicator_fn ((B:num->A->bool) (SUC k)) x - + (v:num->real) k) / (&1 + sum(0..k) v))) ---> L) sequentially` + (LABEL_TAC "CONV2") THENL + [FIRST_X_ASSUM(fun th -> + if free_in `sequentially` (concl th) + then MP_TAC th else failwith "") THEN + EXPAND_TAC "v" THEN REWRITE_TAC[]; + ALL_TAC] THEN + ABBREV_TAC + `a = \k:num. (indicator_fn ((B:num->A->bool) (SUC k)) x - + (v:num->real) k) / + (&1 + sum(0..k) v)` THEN + (* Step 6: rewrite limsup with LIMSUP_EVENTS_IFF_SUM_UNBOUNDED *) + REWRITE_TAC[LIMSUP_EVENTS_IFF_SUM_UNBOUNDED] THEN + (* Step 7: reindex sum(0..N) to sum(0..SUC N) *) + SUBGOAL_THEN + `(!M:num. ?N. &M <= sum(0..N) (\k. indicator_fn ((B:num->A->bool) k) x)) + <=> (!M:num. ?N. &M <= sum(0..SUC N) + (\k. indicator_fn (B k) x))` + SUBST1_TAC THENL + [EQ_TAC THEN DISCH_TAC THEN X_GEN_TAC `M:num` THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `M:num`) THEN + DISCH_THEN(X_CHOOSE_TAC `N0:num`) THEN + EXISTS_TAC `N0:num` THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `sum(0..N0) (\k. indicator_fn ((B:num->A->bool) k) x)` THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC SUM_SUBSET_SIMPLE THEN + REWRITE_TAC[FINITE_NUMSEG; SUBSET; IN_NUMSEG] THEN CONJ_TAC THENL + [ARITH_TAC; + GEN_TAC THEN DISCH_TAC THEN + REWRITE_TAC[indicator_fn; IN_ELIM_THM] THEN + COND_CASES_TAC THEN REAL_ARITH_TAC]; + FIRST_X_ASSUM(MP_TAC o SPEC `M:num`) THEN + DISCH_THEN(X_CHOOSE_TAC `N0:num`) THEN + EXISTS_TAC `SUC N0` THEN ASM_REWRITE_TAC[]]; ALL_TAC] THEN + (* Step 8: v k >= 0 and 1 + V_k > 0 *) + SUBGOAL_THEN `!k. &0 <= (v:num->real) k` ASSUME_TAC THENL + [GEN_TAC THEN USE_THEN "NONNEG" (MP_TAC o SPEC `k:num`) THEN + EXPAND_TAC "v" THEN REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `!k. &0 < &1 + sum(0..k) (v:num->real)` + (LABEL_TAC "VP") THENL + [GEN_TAC THEN MATCH_MP_TAC(REAL_ARITH `&0 <= s ==> &0 < &1 + s`) THEN + MATCH_MP_TAC SUM_POS_LE_NUMSEG THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + (* Step 9: Algebraic identity *) + SUBGOAL_THEN + `!k. (a:num->real) k * (&1 + sum(0..k) v) = + indicator_fn ((B:num->A->bool) (SUC k)) x - v k` + ASSUME_TAC THENL + [GEN_TAC THEN + SUBGOAL_THEN `(a:num->real) k = + (indicator_fn ((B:num->A->bool) (SUC k)) x - v k) / + (&1 + sum(0..k) v)` SUBST1_TAC THENL + [EXPAND_TAC "a" THEN REWRITE_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC REAL_DIV_RMUL THEN + USE_THEN "VP" (MP_TAC o SPEC `k:num`) THEN REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN + `!N. sum(0..SUC N) (\k. indicator_fn ((B:num->A->bool) k) x) = + indicator_fn (B 0) x + sum(0..N) (v:num->real) + + sum(0..N) (\k. a k * (&1 + sum(0..k) v))` + (LABEL_TAC "IDENT") THENL + [ASM_REWRITE_TAC[] THEN GEN_TAC THEN + REWRITE_TAC[SUM_SUB_NUMSEG] THEN + MP_TAC(ISPECL [`\k:num. indicator_fn ((B:num->A->bool) k) x`; + `0`; `SUC N`] SUM_CLAUSES_LEFT) THEN + REWRITE_TAC[LE_0] THEN + DISCH_THEN(fun th -> REWRITE_TAC[th]) THEN + REWRITE_TAC[ARITH_RULE `0 + 1 = 1`] THEN + SUBGOAL_THEN + `sum(1..SUC N) (\k:num. indicator_fn ((B:num->A->bool) k) x) = + sum(0..N) (\k. indicator_fn (B (SUC k)) x)` SUBST1_TAC THENL + [MP_TAC(ISPECL [`1`; + `\k:num. indicator_fn ((B:num->A->bool) k) x`; + `0`; `N:num`] SUM_OFFSET) THEN + REWRITE_TAC[ADD1; ADD_CLAUSES]; ALL_TAC] THEN + REAL_ARITH_TAC; ALL_TAC] THEN + (* Step 10: Apply DECOMPOSITION_UNBOUNDED_IFF *) + USE_THEN "IDENT" (fun th -> REWRITE_TAC[th]) THEN + MP_TAC(ISPECL [`v:num->real`; `a:num->real`; + `indicator_fn ((B:num->A->bool) 0) x`] + DECOMPOSITION_UNBOUNDED_IFF) THEN + ANTS_TAC THENL + [REPEAT CONJ_TAC THENL + [ASM_REWRITE_TAC[]; + ASM_MESON_TAC[]; + REWRITE_TAC[indicator_fn; IN_ELIM_THM] THEN + COND_CASES_TAC THEN REAL_ARITH_TAC]; ALL_TAC] THEN + SIMP_TAC[]);; + +(* ==================================================================== *) +(* UI MARTINGALE CLOSURE THEOREM (Williams Ch 12-13) *) +(* ==================================================================== *) + +(* Key helper: pointwise truncation identity *) +let TRUNCATION_ABS_DIFF = prove + (`!x M. &0 <= M ==> abs(x - max (min x M) (--M)) = max (abs x - M) (&0)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[real_max; real_min] THEN + REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN ASM_REAL_ARITH_TAC);; + +(* Truncation preserves convergence: if X_n -> f then trunc(X_n) -> trunc(f) *) +let TRUNCATION_PRESERVES_LIMIT = prove + (`!f:num->real g M. + (f ---> g) sequentially /\ &0 <= M + ==> ((\n. max (min (f n) M) (--M)) ---> max (min g M) (--M)) sequentially`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN X_GEN_TAC `e:real` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REALLIM_SEQUENTIALLY]) THEN + DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC MONO_EXISTS THEN X_GEN_TAC `N:num` THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `n:num` THEN + MATCH_MP_TAC MONO_IMP THEN REWRITE_TAC[] THEN + REWRITE_TAC[real_max; real_min] THEN + REPEAT(COND_CASES_TAC THEN ASM_REWRITE_TAC[]) THEN ASM_REAL_ARITH_TAC);; + +(* Truncation is a random variable *) +let RANDOM_VARIABLE_TRUNCATION = prove + (`!p:A prob_space f M. + random_variable p f + ==> random_variable p (\x. max (min (f x) M) (--M))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC RANDOM_VARIABLE_MAX THEN + CONJ_TAC THENL + [MATCH_MP_TAC RANDOM_VARIABLE_MIN THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[RANDOM_VARIABLE_CONST]; + REWRITE_TAC[RANDOM_VARIABLE_CONST]]);; + +(* Truncation is integrable *) +let INTEGRABLE_TRUNCATION = prove + (`!p:A prob_space f M. + integrable p f + ==> integrable p (\x. max (min (f x) M) (--M))`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC INTEGRABLE_MAX THEN + CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_MIN THEN ASM_REWRITE_TAC[INTEGRABLE_CONST]; + REWRITE_TAC[INTEGRABLE_CONST]]);; + +(* INTEGRABLE_TAIL_VANISHES already in expectation.ml *) + +(* ---- Main theorem: Vitali convergence with a.e. convergence ---- *) + +let UI_POINTWISE_L1_AE = prove + (`!p:A prob_space (X:num->A->real) f. + uniformly_integrable p X /\ integrable p f /\ + almost_surely p {x | ((\n. X n x) ---> f x) sequentially} + ==> ((\n. expectation p (\x. abs(X n x - f x))) ---> &0) sequentially`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN `!n. integrable (p:A prob_space) ((X:num->A->real) n)` + ASSUME_TAC THENL + [UNDISCH_TAC `uniformly_integrable (p:A prob_space) (X:num->A->real)` THEN + REWRITE_TAC[uniformly_integrable] THEN STRIP_TAC THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `!n. random_variable (p:A prob_space) ((X:num->A->real) n)` + ASSUME_TAC THENL + [GEN_TAC THEN + UNDISCH_TAC `!n. integrable (p:A prob_space) ((X:num->A->real) n)` THEN + DISCH_THEN(MP_TAC o SPEC `n:num`) THEN + REWRITE_TAC[integrable] THEN STRIP_TAC THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `random_variable (p:A prob_space) (f:A->real)` ASSUME_TAC THENL + [UNDISCH_TAC `integrable (p:A prob_space) (f:A->real)` THEN + REWRITE_TAC[integrable] THEN STRIP_TAC THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + SUBGOAL_THEN `&0 < e / &3` ASSUME_TAC THENL + [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REWRITE_TAC[REAL_SUB_RZERO] THEN + SUBGOAL_THEN `!n:num. &0 <= expectation (p:A prob_space) + (\x:A. abs((X:num->A->real) n x - (f:A->real) x))` ASSUME_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC EXPECTATION_POS THEN CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_ABS THEN MATCH_MP_TAC INTEGRABLE_SUB THEN + REWRITE_TAC[ETA_AX] THEN ASM_REWRITE_TAC[]; + GEN_TAC THEN DISCH_TAC THEN REAL_ARITH_TAC]; + ALL_TAC] THEN + SUBGOAL_THEN `!n:num. abs(expectation (p:A prob_space) + (\x:A. abs((X:num->A->real) n x - (f:A->real) x))) = + expectation p (\x. abs(X n x - f x))` + (fun th -> REWRITE_TAC[th]) THENL + [GEN_TAC THEN MATCH_MP_TAC(REAL_ARITH `&0 <= x ==> abs x = x`) THEN + ASM_REWRITE_TAC[]; + ALL_TAC] THEN + (* Get K from UI and tail vanishes for f *) + UNDISCH_TAC `uniformly_integrable (p:A prob_space) (X:num->A->real)` THEN + REWRITE_TAC[uniformly_integrable] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `e / &3`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `K1:real`) THEN + MP_TAC(ISPECL [`p:A prob_space`; `f:A->real`] INTEGRABLE_TAIL_VANISHES) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o GEN_REWRITE_RULE I [REALLIM_SEQUENTIALLY]) THEN + DISCH_THEN(MP_TAC o SPEC `e / &3`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `N1:num`) THEN + ABBREV_TAC `K = max K1 (&N1)` THEN + SUBGOAL_THEN `&0 <= K` ASSUME_TAC THENL + [EXPAND_TAC "K" THEN REAL_ARITH_TAC; ALL_TAC] THEN + (* Tail bounds with K *) + SUBGOAL_THEN `!n:num. expectation (p:A prob_space) + (\x:A. max (abs((X:num->A->real) n x) - K) (&0)) < e / &3` + ASSUME_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `expectation (p:A prob_space) + (\x:A. max (abs((X:num->A->real) n x) - K1) (&0))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC EXPECTATION_MONO THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_MAX_SUB_CONST THEN + REWRITE_TAC[ETA_AX] THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC INTEGRABLE_MAX_SUB_CONST THEN + REWRITE_TAC[ETA_AX] THEN ASM_REWRITE_TAC[]; + GEN_TAC THEN DISCH_TAC THEN BETA_TAC THEN + SUBGOAL_THEN `K1 <= K` (fun th -> MP_TAC th THEN REAL_ARITH_TAC) THEN + EXPAND_TAC "K" THEN REAL_ARITH_TAC]; + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + SUBGOAL_THEN `expectation (p:A prob_space) + (\x:A. max (abs((f:A->real) x) - &N1) (&0)) < e / &3` + ASSUME_TAC THENL + [SUBGOAL_THEN `&0 <= expectation (p:A prob_space) + (\x:A. max (abs((f:A->real) x) - &N1) (&0))` MP_TAC THENL + [MATCH_MP_TAC EXPECTATION_TAIL_POS THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + UNDISCH_TAC `!n:num. N1 <= n ==> + abs(expectation (p:A prob_space) + (\x:A. max (abs((f:A->real) x) - &n) (&0)) - &0) < e / &3` THEN + DISCH_THEN(MP_TAC o SPEC `N1:num`) THEN + REWRITE_TAC[LE_REFL; REAL_SUB_RZERO] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + SUBGOAL_THEN `expectation (p:A prob_space) + (\x:A. max (abs((f:A->real) x) - K) (&0)) < e / &3` + ASSUME_TAC THENL + [MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `expectation (p:A prob_space) + (\x:A. max (abs((f:A->real) x) - &N1) (&0))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC EXPECTATION_MONO THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_MAX_SUB_CONST THEN + REWRITE_TAC[ETA_AX] THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC INTEGRABLE_MAX_SUB_CONST THEN + REWRITE_TAC[ETA_AX] THEN ASM_REWRITE_TAC[]; + GEN_TAC THEN DISCH_TAC THEN BETA_TAC THEN + SUBGOAL_THEN `&N1 <= K` (fun th -> MP_TAC th THEN REAL_ARITH_TAC) THEN + EXPAND_TAC "K" THEN REAL_ARITH_TAC]; + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + (* Bounded convergence via DOMINATED_CONVERGENCE_AE *) + SUBGOAL_THEN + `((\n. expectation (p:A prob_space) (\x:A. min (abs((X:num->A->real) n x - + (f:A->real) x)) (&2 * K))) ---> &0) sequentially` ASSUME_TAC THENL + [SUBGOAL_THEN `&0 = expectation (p:A prob_space) (\x:A. &0)` + SUBST1_TAC THENL + [REWRITE_TAC[EXPECTATION_CONST]; ALL_TAC] THEN + SUBGOAL_THEN + `integrable (p:A prob_space) (\x:A. &0) /\ + ((\n. expectation (p:A prob_space) (\x:A. min (abs((X:num->A->real) n x - + (f:A->real) x)) (&2 * K))) ---> + expectation p (\x:A. &0)) sequentially` MP_TAC THENL + [ALL_TAC; SIMP_TAC[]] THEN + MATCH_MP_TAC DOMINATED_CONVERGENCE_AE THEN + EXISTS_TAC `\x:A. &2 * K` THEN REPEAT CONJ_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC INTEGRABLE_MIN THEN CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_ABS THEN MATCH_MP_TAC INTEGRABLE_SUB THEN + REWRITE_TAC[ETA_AX] THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[INTEGRABLE_CONST]]; + REWRITE_TAC[INTEGRABLE_CONST]; + GEN_TAC THEN X_GEN_TAC `x:A` THEN DISCH_TAC THEN BETA_TAC THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= a /\ &0 <= M ==> abs(min a M) <= M`) THEN + ASM_SIMP_TAC[REAL_ABS_POS; REAL_LE_MUL; REAL_POS]; + REWRITE_TAC[RANDOM_VARIABLE_CONST]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN BETA_TAC THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= M ==> abs(&0) <= M`) THEN + MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_POS] THEN + ASM_REWRITE_TAC[]; + (* a.e. convergence of min(|X_n-f|, 2K) to 0 *) + BETA_TAC THEN + UNDISCH_TAC `almost_surely (p:A prob_space) + {x:A | ((\n. (X:num->A->real) n x) ---> (f:A->real) x) sequentially}` THEN + REWRITE_TAC[almost_surely] THEN + DISCH_THEN(X_CHOOSE_THEN `N:A->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `N:A->bool` THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC SUBSET_TRANS THEN + EXISTS_TAC `{x:A | x IN prob_carrier p /\ + ~(x IN {x | ((\n. (X:num->A->real) n x) ---> (f:A->real) x) + sequentially})}` THEN + ASM_REWRITE_TAC[] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN + X_GEN_TAC `x:A` THEN STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o check (is_neg o concl)) THEN + REWRITE_TAC[CONTRAPOS_THM] THEN DISCH_TAC THEN + SUBGOAL_THEN `((\n. (X:num->A->real) n x - (f:A->real) x) ---> &0) + sequentially` ASSUME_TAC THENL + [REWRITE_TAC[GSYM REALLIM_NULL] THEN ASM_SIMP_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `((\n:num. abs((X:num->A->real) n x - (f:A->real) x)) ---> &0) + sequentially` ASSUME_TAC THENL + [MP_TAC(ISPEC `sequentially` REALLIM_ABS) THEN + DISCH_THEN(MP_TAC o SPECL + [`\n:num. (X:num->A->real) n x - (f:A->real) x`; `&0`]) THEN + REWRITE_TAC[REAL_ABS_NUM] THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + SUBGOAL_THEN `&0 = min (&0) (&2 * K)` SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= M ==> min (&0) M = &0`) THEN + MATCH_MP_TAC REAL_LE_MUL THEN REWRITE_TAC[REAL_POS] THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC REALLIM_MIN THEN CONJ_TAC THENL + [ASM_REWRITE_TAC[]; REWRITE_TAC[REALLIM_CONST]]]]; + ALL_TAC] THEN + (* Combine: E[|X_n-f|] = E[min] + E[max], and bound both parts *) + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [REALLIM_SEQUENTIALLY]) THEN + DISCH_THEN(MP_TAC o SPEC `e / &3`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `N2:num`) THEN + EXISTS_TAC `N2:num` THEN X_GEN_TAC `n:num` THEN DISCH_TAC THEN + SUBGOAL_THEN `expectation (p:A prob_space) + (\x:A. min (abs((X:num->A->real) n x - (f:A->real) x)) (&2 * K)) < + e / &3` ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[REAL_SUB_RZERO] THEN + SUBGOAL_THEN `&0 <= expectation (p:A prob_space) + (\x:A. min (abs((X:num->A->real) n x - (f:A->real) x)) (&2 * K))` + MP_TAC THENL + [MATCH_MP_TAC EXPECTATION_POS THEN CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_MIN THEN CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_ABS THEN MATCH_MP_TAC INTEGRABLE_SUB THEN + REWRITE_TAC[ETA_AX] THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[INTEGRABLE_CONST]]; + GEN_TAC THEN DISCH_TAC THEN BETA_TAC THEN + MATCH_MP_TAC(REAL_ARITH `&0 <= a /\ &0 <= M ==> &0 <= min a M`) THEN + ASM_SIMP_TAC[REAL_ABS_POS; REAL_LE_MUL; REAL_POS]]; + REAL_ARITH_TAC]; + ALL_TAC] THEN + (* Split E[|X_n-f|] = E[min] + E[max] *) + SUBGOAL_THEN `expectation (p:A prob_space) + (\x:A. abs((X:num->A->real) n x - (f:A->real) x)) = + expectation p (\x. min (abs(X n x - f x)) (&2 * K)) + + expectation p (\x. max (abs(X n x - f x) - &2 * K) (&0))` + SUBST1_TAC THENL + [MP_TAC(BETA_RULE(ISPECL + [`p:A prob_space`; + `\x:A. min (abs((X:num->A->real) n x - (f:A->real) x)) (&2 * K)`; + `\x:A. max (abs((X:num->A->real) n x - (f:A->real) x) - &2 * K) (&0)`] + EXPECTATION_ADD)) THEN + ANTS_TAC THENL + [CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_MIN THEN CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_ABS THEN MATCH_MP_TAC INTEGRABLE_SUB THEN + REWRITE_TAC[ETA_AX] THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[INTEGRABLE_CONST]]; + MP_TAC(ISPECL [`p:A prob_space`; + `\x:A. (X:num->A->real) n x - (f:A->real) x`; `&2 * K`] + INTEGRABLE_MAX_SUB_CONST) THEN + ANTS_TAC THENL + [MATCH_MP_TAC INTEGRABLE_SUB THEN REWRITE_TAC[ETA_AX] THEN + ASM_REWRITE_TAC[]; + REWRITE_TAC[]]]; + DISCH_THEN(SUBST1_TAC o GSYM) THEN + MATCH_MP_TAC EXPECTATION_EXT THEN + GEN_TAC THEN DISCH_TAC THEN BETA_TAC THEN REAL_ARITH_TAC]; + ALL_TAC] THEN + (* Bound the tail via MAX_ABS_SUB_TRIANGLE *) + SUBGOAL_THEN `expectation (p:A prob_space) + (\x:A. max (abs((X:num->A->real) n x - (f:A->real) x) - &2 * K) (&0)) < + &2 * e / &3` MP_TAC THENL + [MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `expectation (p:A prob_space) + (\x:A. max (abs((X:num->A->real) n x) - K) (&0) + + max (abs((f:A->real) x) - K) (&0))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC EXPECTATION_MONO THEN REPEAT CONJ_TAC THENL + [MP_TAC(ISPECL [`p:A prob_space`; + `\x:A. (X:num->A->real) n x - (f:A->real) x`; `&2 * K`] + INTEGRABLE_MAX_SUB_CONST) THEN + ANTS_TAC THENL + [MATCH_MP_TAC INTEGRABLE_SUB THEN REWRITE_TAC[ETA_AX] THEN + ASM_REWRITE_TAC[]; + REWRITE_TAC[]]; + MP_TAC(BETA_RULE(ISPECL + [`p:A prob_space`; + `\x:A. max (abs((X:num->A->real) n x) - K) (&0)`; + `\x:A. max (abs((f:A->real) x) - K) (&0)`] + INTEGRABLE_ADD)) THEN + ANTS_TAC THENL + [CONJ_TAC THEN MATCH_MP_TAC INTEGRABLE_MAX_SUB_CONST THEN + REWRITE_TAC[ETA_AX] THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[]]; + GEN_TAC THEN DISCH_TAC THEN BETA_TAC THEN + MP_TAC(SPECL [`(X:num->A->real) n x`; `(f:A->real) x`; `K:real`] + MAX_ABS_SUB_TRIANGLE) THEN REAL_ARITH_TAC]; + SUBGOAL_THEN `expectation (p:A prob_space) + (\x:A. max (abs((X:num->A->real) n x) - K) (&0) + + max (abs((f:A->real) x) - K) (&0)) = + expectation p (\x. max (abs(X n x) - K) (&0)) + + expectation p (\x. max (abs(f x) - K) (&0))` SUBST1_TAC THENL + [MP_TAC(BETA_RULE(ISPECL + [`p:A prob_space`; + `\x:A. max (abs((X:num->A->real) n x) - K) (&0)`; + `\x:A. max (abs((f:A->real) x) - K) (&0)`] + EXPECTATION_ADD)) THEN + ANTS_TAC THENL + [CONJ_TAC THEN MATCH_MP_TAC INTEGRABLE_MAX_SUB_CONST THEN + REWRITE_TAC[ETA_AX] THEN ASM_REWRITE_TAC[]; + DISCH_THEN(fun th -> REWRITE_TAC[th])]; + UNDISCH_TAC `!n:num. expectation (p:A prob_space) + (\x:A. max (abs((X:num->A->real) n x) - K) (&0)) < e / &3` THEN + DISCH_THEN(MP_TAC o SPEC `n:num`) THEN + UNDISCH_TAC `expectation (p:A prob_space) + (\x:A. max (abs((f:A->real) x) - K) (&0)) < e / &3` THEN + REAL_ARITH_TAC]]; + UNDISCH_TAC `expectation (p:A prob_space) + (\x:A. min (abs((X:num->A->real) n x - (f:A->real) x)) (&2 * K)) < + e / &3` THEN + REAL_ARITH_TAC]);; + +(* Helper: equality from vanishing absolute difference *) +let REAL_EQ_EPSILON = prove + (`!x y:real. (!e. &0 < e ==> abs(x - y) <= e) ==> x = y`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC(REAL_ARITH + `~(&0 < abs(x - y)) ==> x = y`) THEN + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `abs(x - y) / &2`) THEN + ASM_REAL_ARITH_TAC);; + +(* ---- UI Martingale Closure: representation X_n = E[X_inf | F_n] ---- *) + +let UI_MARTINGALE_CLOSURE = prove + (`!p:A prob_space (FF:num->(A->bool)->bool) (X:num->A->real). + martingale p FF X /\ uniformly_integrable p X + ==> ?f. integrable p f /\ + almost_surely p {x | ((\n. X n x) ---> f x) sequentially} /\ + ((\n. expectation p (\x. abs(X n x - f x))) ---> &0) + sequentially /\ + (!n. almost_surely p + {x | X n x = gen_cond_exp p (FF n) f x})`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + (* Extract martingale components *) + SUBGOAL_THEN `filtration (p:A prob_space) (FF:num->(A->bool)->bool)` + ASSUME_TAC THENL + [UNDISCH_TAC `martingale (p:A prob_space) FF (X:num->A->real)` THEN + REWRITE_TAC[martingale] THEN MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `adapted (p:A prob_space) (FF:num->(A->bool)->bool) + (X:num->A->real)` ASSUME_TAC THENL + [UNDISCH_TAC `martingale (p:A prob_space) FF (X:num->A->real)` THEN + REWRITE_TAC[martingale] THEN MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `!n. integrable (p:A prob_space) ((X:num->A->real) n)` + ASSUME_TAC THENL + [UNDISCH_TAC `martingale (p:A prob_space) FF (X:num->A->real)` THEN + REWRITE_TAC[martingale] THEN MESON_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN `!n. sub_sigma_algebra (p:A prob_space) + ((FF:num->(A->bool)->bool) n)` ASSUME_TAC THENL + [UNDISCH_TAC `filtration (p:A prob_space) FF` THEN + REWRITE_TAC[filtration] THEN MESON_TAC[]; ALL_TAC] THEN + (* Step 1: a.s. convergence via UI_SUBMARTINGALE_CONVERGENCE_AS *) + SUBGOAL_THEN `submartingale (p:A prob_space) FF (X:num->A->real)` + ASSUME_TAC THENL + [MATCH_MP_TAC MARTINGALE_IMP_SUBMARTINGALE THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + MP_TAC(ISPECL [`p:A prob_space`; `FF:num->(A->bool)->bool`; + `X:num->A->real`] UI_SUBMARTINGALE_CONVERGENCE_AS) THEN + ASM_REWRITE_TAC[] THEN DISCH_TAC THEN + (* Step 2: Extract null set and construct measurable limit function *) + FIRST_X_ASSUM(MP_TAC o REWRITE_RULE[almost_surely]) THEN + DISCH_THEN(X_CHOOSE_THEN `N0:A->bool` STRIP_ASSUME_TAC) THEN + SUBGOAL_THEN `prob_carrier (p:A prob_space) DIFF (N0:A->bool) + IN prob_events p` ASSUME_TAC THENL + [MATCH_MP_TAC SIGMA_ALGEBRA_DIFF THEN + REWRITE_TAC[PROB_SPACE_SIGMA_ALGEBRA] THEN CONJ_TAC THENL + [MP_TAC(ISPEC `p:A prob_space` PROB_SPACE_SIGMA_ALGEBRA) THEN + REWRITE_TAC[sigma_algebra] THEN + REWRITE_TAC[GSYM prob_carrier] THEN MESON_TAC[]; + UNDISCH_TAC `null_event (p:A prob_space) (N0:A->bool)` THEN + REWRITE_TAC[null_event] THEN MESON_TAC[]]; + ALL_TAC] THEN + EXISTS_TAC `\x:A. if x IN prob_carrier p DIFF N0 + then reallim sequentially (\n. (X:num->A->real) n x) else &0` THEN + ABBREV_TAC `f = \x:A. if x IN prob_carrier p DIFF N0 + then reallim sequentially (\n. (X:num->A->real) n x) else &0` THEN + (* Step 3: Integrability via pointwise limit of UI-dominated sequence *) + SUBGOAL_THEN `integrable (p:A prob_space) (f:A->real)` ASSUME_TAC THENL + [MATCH_MP_TAC INTEGRABLE_POINTWISE_LIMIT_UI THEN + EXISTS_TAC `\n (x:A). (X:num->A->real) n x * + indicator_fn (prob_carrier (p:A prob_space) DIFF N0) x` THEN + CONJ_TAC THENL + [(* Uniform integrability of X_n * 1_{carrier\N0} *) + REWRITE_TAC[uniformly_integrable] THEN CONJ_TAC THENL + [GEN_TAC THEN REWRITE_TAC[GSYM ETA_AX] THEN + MATCH_MP_TAC INTEGRABLE_MUL_INDICATOR_FN THEN + ASM_REWRITE_TAC[ETA_AX]; + ALL_TAC] THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + UNDISCH_TAC `uniformly_integrable (p:A prob_space) (X:num->A->real)` THEN + REWRITE_TAC[uniformly_integrable] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC (MP_TAC o SPEC `e:real`)) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_TAC `K:real`) THEN + EXISTS_TAC `K:real` THEN X_GEN_TAC `n:num` THEN + MATCH_MP_TAC REAL_LET_TRANS THEN + EXISTS_TAC `expectation (p:A prob_space) + (\x. max (abs((X:num->A->real) n x) - K) (&0))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC EXPECTATION_MONO THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_MAX_SUB_CONST THEN + REWRITE_TAC[GSYM ETA_AX] THEN + MATCH_MP_TAC INTEGRABLE_MUL_INDICATOR_FN THEN + ASM_REWRITE_TAC[ETA_AX]; + MATCH_MP_TAC INTEGRABLE_MAX_SUB_CONST THEN ASM_REWRITE_TAC[ETA_AX]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN BETA_TAC THEN + REWRITE_TAC[indicator_fn; REAL_ABS_MUL] THEN + COND_CASES_TAC THENL + [REWRITE_TAC[REAL_ABS_NUM; REAL_MUL_RID; REAL_LE_REFL]; + REWRITE_TAC[REAL_ABS_NUM; REAL_MUL_RZERO; REAL_ABS_NUM] THEN + REAL_ARITH_TAC]]; + ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + (* Pointwise convergence: X_n * 1_S -> f on carrier *) + X_GEN_TAC `x:A` THEN DISCH_TAC THEN BETA_TAC THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN BETA_TAC THEN + REWRITE_TAC[indicator_fn] THEN + ASM_CASES_TAC `(x:A) IN prob_carrier p DIFF N0` THENL + [ASM_REWRITE_TAC[REAL_MUL_RID] THEN + SUBGOAL_THEN `?L. ((\n. (X:num->A->real) n x) ---> L) sequentially` + MP_TAC THENL + [UNDISCH_TAC `{x:A | x IN prob_carrier p /\ + ~(x IN {x | ?L. ((\n. (X:num->A->real) n x) ---> L) sequentially})} + SUBSET N0` THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN + UNDISCH_TAC `(x:A) IN prob_carrier p DIFF N0` THEN + REWRITE_TAC[IN_DIFF] THEN MESON_TAC[]; + ALL_TAC] THEN + DISCH_THEN(fun th -> MP_TAC(SELECT_RULE th)) THEN + REWRITE_TAC[GSYM reallim]; + ASM_REWRITE_TAC[REAL_MUL_RZERO] THEN REWRITE_TAC[REALLIM_CONST]]; + ALL_TAC] THEN + (* Step 4: a.s. convergence to f *) + SUBGOAL_THEN + `almost_surely (p:A prob_space) + {x:A | ((\n. (X:num->A->real) n x) ---> (f:A->real) x) sequentially}` + ASSUME_TAC THENL + [REWRITE_TAC[almost_surely] THEN + EXISTS_TAC `N0:A->bool` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN + X_GEN_TAC `x:A` THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC MP_TAC) THEN + REWRITE_TAC[] THEN DISCH_TAC THEN + ASM_CASES_TAC `(x:A) IN prob_carrier p DIFF N0` THENL + [UNDISCH_TAC `~((\n. (X:num->A->real) n x) ---> (f:A->real) x) + sequentially` THEN REWRITE_TAC[] THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN BETA_TAC THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `?L. ((\n. (X:num->A->real) n x) ---> L) sequentially` + MP_TAC THENL + [UNDISCH_TAC `{x:A | x IN prob_carrier p /\ + ~(x IN {x | ?L. ((\n. (X:num->A->real) n x) ---> L) sequentially})} + SUBSET N0` THEN + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN + UNDISCH_TAC `(x:A) IN prob_carrier p DIFF N0` THEN + REWRITE_TAC[IN_DIFF] THEN MESON_TAC[]; + ALL_TAC] THEN + DISCH_THEN(fun th -> MP_TAC(SELECT_RULE th)) THEN + REWRITE_TAC[GSYM reallim] THEN MESON_TAC[]; + UNDISCH_TAC `(x:A) IN prob_carrier p` THEN + UNDISCH_TAC `~((x:A) IN prob_carrier p DIFF N0)` THEN + REWRITE_TAC[IN_DIFF] THEN MESON_TAC[]]; + ALL_TAC] THEN + (* Step 5: L1 convergence *) + SUBGOAL_THEN + `((\n. expectation (p:A prob_space) + (\x. abs((X:num->A->real) n x - (f:A->real) x))) ---> &0) + sequentially` ASSUME_TAC THENL + [MATCH_MP_TAC UI_POINTWISE_L1_AE THEN ASM_REWRITE_TAC[]; ALL_TAC] THEN + (* Step 6: Conditional expectation representation *) + SUBGOAL_THEN + `!n (a:A->bool). a IN (FF:num->(A->bool)->bool) n ==> + expectation (p:A prob_space) + (\x. (X:num->A->real) n x * indicator_fn a x) = + expectation p (\x. (f:A->real) x * indicator_fn a x)` + (LABEL_TAC "EQ_COND") THENL + [(* Key equality: E[X_n * 1_A] = E[f * 1_A] for A in FF_n *) + (* Proof: martingale property gives E[X_m * 1_A] = E[X_n * 1_A] for m>=n, + and L1 convergence gives |E[X_m * 1_A] - E[f * 1_A]| -> 0 *) + REPEAT STRIP_TAC THEN MATCH_MP_TAC REAL_EQ_EPSILON THEN + X_GEN_TAC `e:real` THEN DISCH_TAC THEN + (* From L1 convergence, get N with E[|X_m - f|] < e for m >= N *) + FIRST_X_ASSUM(MP_TAC o + GEN_REWRITE_RULE I [REALLIM_SEQUENTIALLY]) THEN + REWRITE_TAC[REAL_SUB_RZERO] THEN SIMP_TAC[] THEN + DISCH_THEN(MP_TAC o SPEC `e:real`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` ASSUME_TAC) THEN + (* Choose m = n + N (so m >= n and m >= N) *) + ABBREV_TAC `m = n + N:num` THEN + SUBGOAL_THEN `n <= (m:num) /\ N <= m` STRIP_ASSUME_TAC THENL + [EXPAND_TAC "m" THEN ARITH_TAC; ALL_TAC] THEN + (* From MARTINGALE_TOWER: E[X_m * 1_a] = E[X_n * 1_a] *) + SUBGOAL_THEN + `expectation (p:A prob_space) + (\x. (X:num->A->real) m x * indicator_fn (a:A->bool) x) = + expectation p (\x. X n x * indicator_fn a x)` ASSUME_TAC THENL + [MP_TAC(SPECL [`n:num`; `m:num`; `a:A->bool`] + (REWRITE_RULE[RIGHT_IMP_FORALL_THM; IMP_IMP] + (ISPECL [`p:A prob_space`; `FF:num->(A->bool)->bool`; + `X:num->A->real`] MARTINGALE_TOWER))) THEN + ASM_REWRITE_TAC[]; ALL_TAC] THEN + (* a IN prob_events p *) + SUBGOAL_THEN `(a:A->bool) IN prob_events (p:A prob_space)` ASSUME_TAC THENL + [SUBGOAL_THEN `sub_sigma_algebra (p:A prob_space) + ((FF:num->(A->bool)->bool) n)` MP_TAC THENL + [ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[sub_sigma_algebra] THEN + ASM_MESON_TAC[SUBSET]; ALL_TAC] THEN + (* Key chain: |E[X_n*1_a] - E[f*1_a]| = |E[X_m*1_a] - E[f*1_a]| + <= E[|X_m - f|] < e *) + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `expectation (p:A prob_space) + (\x. abs((X:num->A->real) m x - (f:A->real) x))` THEN + CONJ_TAC THENL + [(* |E[X_n * 1_a] - E[f * 1_a]| <= E[|X_m - f|] *) + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + SUBGOAL_THEN + `expectation (p:A prob_space) + (\x. (X:num->A->real) m x * indicator_fn (a:A->bool) x) - + expectation p (\x. (f:A->real) x * indicator_fn a x) = + expectation p (\x. (X m x - f x) * indicator_fn a x)` + SUBST1_TAC THENL + [MP_TAC(ISPECL [`p:A prob_space`; + `\x:A. (X:num->A->real) m x * indicator_fn (a:A->bool) x`; + `\x:A. (f:A->real) x * indicator_fn (a:A->bool) x`] + EXPECTATION_SUB) THEN + ASM_SIMP_TAC[INTEGRABLE_MUL_INDICATOR_FN; ETA_AX] THEN + DISCH_THEN(SUBST1_TAC o GSYM) THEN + AP_TERM_TAC THEN REWRITE_TAC[FUN_EQ_THM] THEN REAL_ARITH_TAC; + ALL_TAC] THEN + MATCH_MP_TAC REAL_LE_TRANS THEN + EXISTS_TAC `expectation (p:A prob_space) + (\x. abs(((X:num->A->real) m x - (f:A->real) x) * + indicator_fn (a:A->bool) x))` THEN + CONJ_TAC THENL + [MATCH_MP_TAC EXPECTATION_ABS_LE THEN + SUBGOAL_THEN + `(\x:A. ((X:num->A->real) m x - (f:A->real) x) * + indicator_fn (a:A->bool) x) = + (\x. X m x * indicator_fn a x - f x * indicator_fn a x)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC INTEGRABLE_SUB THEN + ASM_SIMP_TAC[INTEGRABLE_MUL_INDICATOR_FN; ETA_AX]; + ALL_TAC] THEN + MATCH_MP_TAC EXPECTATION_MONO THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC INTEGRABLE_ABS THEN + SUBGOAL_THEN + `(\x:A. ((X:num->A->real) m x - (f:A->real) x) * + indicator_fn (a:A->bool) x) = + (\x. X m x * indicator_fn a x - f x * indicator_fn a x)` + SUBST1_TAC THENL + [REWRITE_TAC[FUN_EQ_THM] THEN REAL_ARITH_TAC; ALL_TAC] THEN + MATCH_MP_TAC INTEGRABLE_SUB THEN + ASM_SIMP_TAC[INTEGRABLE_MUL_INDICATOR_FN; ETA_AX]; + MATCH_MP_TAC INTEGRABLE_ABS THEN + MATCH_MP_TAC INTEGRABLE_SUB THEN ASM_REWRITE_TAC[ETA_AX]; + X_GEN_TAC `x:A` THEN DISCH_TAC THEN + REWRITE_TAC[indicator_fn; REAL_ABS_MUL] THEN + COND_CASES_TAC THENL + [REWRITE_TAC[REAL_ABS_NUM; REAL_MUL_RID; REAL_LE_REFL]; + REWRITE_TAC[REAL_ABS_NUM; REAL_MUL_RZERO; REAL_ABS_POS]]]; + (* E[|X_m - f|] <= e from L1 convergence bound *) + MATCH_MP_TAC(REAL_ARITH `abs(x:real) < e ==> x <= e`) THEN + FIRST_X_ASSUM MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]; + ALL_TAC] THEN + (* Now prove the four conclusions *) + CONJ_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + CONJ_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + CONJ_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + (* Representation: X_n = E[f | F_n] a.s. *) + X_GEN_TAC `n:num` THEN + MATCH_MP_TAC GEN_COND_EXP_AE_UNIQUE THEN + EXISTS_TAC `(FF:num->(A->bool)->bool) n` THEN + REPEAT CONJ_TAC THENL + [(* sub_sigma_algebra p (FF n) *) + ASM_REWRITE_TAC[]; + (* measurable_wrt p (FF n) (X n) -- from adapted *) + REWRITE_TAC[ETA_AX] THEN + UNDISCH_TAC `adapted (p:A prob_space) FF (X:num->A->real)` THEN + REWRITE_TAC[adapted] THEN DISCH_THEN(MP_TAC o SPEC `n:num`) THEN + REWRITE_TAC[]; + (* integrable p (X n) *) + REWRITE_TAC[ETA_AX] THEN ASM_REWRITE_TAC[]; + (* measurable_wrt p (FF n) (gen_cond_exp p (FF n) f) *) + REWRITE_TAC[ETA_AX] THEN + MATCH_MP_TAC GEN_COND_EXP_MEASURABLE_WRT THEN ASM_REWRITE_TAC[]; + (* integrable p (gen_cond_exp p (FF n) f) *) + REWRITE_TAC[ETA_AX] THEN + MATCH_MP_TAC GEN_COND_EXP_INTEGRABLE THEN ASM_REWRITE_TAC[]; + (* !A. A IN FF n ==> E[X_n * 1_A] = E[gen_cond_exp * 1_A] *) + X_GEN_TAC `a:A->bool` THEN DISCH_TAC THEN + (* E[gen_cond_exp p (FF n) f * 1_a] = E[f * 1_a] by conditioning *) + SUBGOAL_THEN + `expectation (p:A prob_space) + (\x. gen_cond_exp p ((FF:num->(A->bool)->bool) n) (f:A->real) x * + indicator_fn (a:A->bool) x) = + expectation p (\x. f x * indicator_fn a x)` SUBST1_TAC THENL + [MATCH_MP_TAC GEN_COND_EXP_CONDITIONING THEN ASM_REWRITE_TAC[]; + ALL_TAC] THEN + (* Now use our established equality *) + REMOVE_THEN "EQ_COND" (MP_TAC o SPECL [`n:num`; `a:A->bool`]) THEN + ASM_REWRITE_TAC[]]);; diff --git a/Probability/martingales.ml b/Probability/martingales.ml index 755d4245..721b0807 100644 --- a/Probability/martingales.ml +++ b/Probability/martingales.ml @@ -1513,7 +1513,7 @@ let SIMPLE_DOOB_MAXIMAL_INEQUALITY_STRONG = prove SUBGOAL_THEN `{y:A | y IN prob_carrier p /\ X 0 y >= c} IN prob_events p` ASSUME_TAC THENL - [MATCH_MP_TAC RANDOM_VARIABLE_GE THEN REWRITE_TAC[ETA_AX] THEN + [MATCH_MP_TAC RV_PREIMAGE_GE THEN REWRITE_TAC[ETA_AX] THEN FIRST_ASSUM(fun th -> ACCEPT_TAC(CONJUNCT1(REWRITE_RULE[simple_rv](SPEC `0` th)))); ALL_TAC] THEN MATCH_MP_TAC REAL_LE_TRANS THEN @@ -1578,7 +1578,7 @@ let SIMPLE_DOOB_MAXIMAL_INEQUALITY_STRONG = prove SUBGOAL_THEN `(B:A->bool) IN prob_events p` ASSUME_TAC THENL [EXPAND_TAC "B" THEN MATCH_MP_TAC PROB_DIFF_IN_EVENTS THEN ASM_REWRITE_TAC[] THEN - MATCH_MP_TAC RANDOM_VARIABLE_GE THEN REWRITE_TAC[ETA_AX] THEN + MATCH_MP_TAC RV_PREIMAGE_GE THEN REWRITE_TAC[ETA_AX] THEN FIRST_ASSUM(fun th -> ACCEPT_TAC(CONJUNCT1(REWRITE_RULE[simple_rv](SPEC `SUC n` th)))); ALL_TAC] THEN SUBGOAL_THEN diff --git a/Probability/measure.ml b/Probability/measure.ml index 4f378274..b2802f07 100644 --- a/Probability/measure.ml +++ b/Probability/measure.ml @@ -122,6 +122,56 @@ let SIGMA_ALGEBRA_INTERS_FINITE = prove ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; ASM_SIMP_TAC[FINITE_IMAGE]]);; +(* Closure under countable (non-empty) intersection: the De Morgan dual of *) +(* SIGMA_ALGEBRA_UNION_COUNTABLE, mirroring SIGMA_ALGEBRA_INTERS_FINITE. *) +let SIGMA_ALGEBRA_INTERS_COUNTABLE = prove + (`!(f:(A->bool)->bool) s. + sigma_algebra f /\ s SUBSET f /\ COUNTABLE s /\ ~(s = {}) + ==> INTERS s IN f`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + SUBGOAL_THEN + `INTERS s :A->bool = UNIONS f DIFF UNIONS (IMAGE (\a. UNIONS f DIFF a) s)` + SUBST1_TAC THENL + [MATCH_MP_TAC INTERS_COMPL_UNIONS THEN + ASM_REWRITE_TAC[] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC SIGMA_ALGEBRA_SUBSET THEN + ASM SET_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC SIGMA_ALGEBRA_COMPL THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC SIGMA_ALGEBRA_UNION_COUNTABLE THEN + ASM_REWRITE_TAC[] THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC SIGMA_ALGEBRA_COMPL THEN + ASM_REWRITE_TAC[] THEN ASM SET_TAC[]; + ASM_SIMP_TAC[COUNTABLE_IMAGE]]);; + +(* Closure under symmetric difference. *) +let SIGMA_ALGEBRA_SYM_DIFF = prove + (`!(f:(A->bool)->bool) a b. + sigma_algebra f /\ a IN f /\ b IN f + ==> ((a DIFF b) UNION (b DIFF a)) IN f`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC SIGMA_ALGEBRA_UNION THEN + ASM_SIMP_TAC[SIGMA_ALGEBRA_DIFF]);; + +(* The Borel sets of any topology form a sigma-algebra (in the sense of this *) +(* development). borel_in and its theory now live in Multivariate/metric.ml; *) +(* this connection to our sigma_algebra predicate stays here since *) +(* sigma_algebra is defined above. *) + +let BOREL_IN_SIGMA_ALGEBRA = prove + (`!top:A topology. sigma_algebra {s | borel_in top s}`, + GEN_TAC THEN REWRITE_TAC[sigma_algebra; IN_ELIM_THM] THEN + SUBGOAL_THEN `UNIONS {s:A->bool | borel_in top s} = topspace top` + (fun th -> REWRITE_TAC[th]) THENL + [MATCH_MP_TAC SUBSET_ANTISYM THEN CONJ_TAC THENL + [REWRITE_TAC[UNIONS_SUBSET; IN_ELIM_THM; BOREL_IN_SUBSET_TOPSPACE]; + MATCH_MP_TAC(SET_RULE `(x:A->bool) IN s ==> x SUBSET UNIONS s`) THEN + REWRITE_TAC[IN_ELIM_THM; BOREL_IN_TOPSPACE]]; + REWRITE_TAC[BOREL_IN_TOPSPACE; borel_in_RULES] THEN + REPEAT STRIP_TAC THEN MATCH_MP_TAC BOREL_IN_UNIONS THEN + ASM_REWRITE_TAC[] THEN + RULE_ASSUM_TAC(REWRITE_RULE[SUBSET; IN_ELIM_THM]) THEN + ASM_MESON_TAC[]]);; (* ------------------------------------------------------------------------- *) (* Probability Spaces as a new type *) diff --git a/Probability/random_variables.ml b/Probability/random_variables.ml index ec4351cf..c208d419 100644 --- a/Probability/random_variables.ml +++ b/Probability/random_variables.ml @@ -40,77 +40,368 @@ let indicator_fn = new_definition `indicator_fn (a:A->bool) (x:A) = if x IN a then &1 else &0`;; +(* ------------------------------------------------------------------------- *) +(* Borel-preimage characterization of random variables. *) +(* *) +(* A function X is a random variable (defined via the half-lines *) +(* {X <= a} being events) iff the preimage X^-1(B) of EVERY Borel set B of *) +(* the real line is an event. This is Williams "Probability with *) +(* Martingales" 3.1-3.2: the half-lines generate the Borel sigma-algebra, *) +(* so the two notions coincide. We use borel_in euclideanreal (from *) +(* borel.ml) for the Borel sets of the reals. *) +(* ------------------------------------------------------------------------- *) + +(* The < half-line preimage as a countable union of <= half-lines. *) +let RV_PREIMAGE_LT_EQ_UNIONS = prove + (`!p (X:A->real) a. + {x | x IN prob_carrier p /\ X x < a} = + UNIONS {{x | x IN prob_carrier p /\ X x <= a - inv(&n + &1)} | n IN (:num)}`, + REPEAT GEN_TAC THEN + REWRITE_TAC[UNIONS_GSPEC; EXTENSION; IN_ELIM_THM; IN_UNIV] THEN + X_GEN_TAC `y:A` THEN EQ_TAC THENL + [STRIP_TAC THEN + MP_TAC(SPEC `a - X(y:A):real` REAL_ARCH_INV) THEN + ASM_REWRITE_TAC[REAL_SUB_LT] THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `n:num` THEN ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `inv(&n + &1) <= inv(&n)` MP_TAC THENL + [MATCH_MP_TAC REAL_LE_INV2 THEN + REWRITE_TAC[REAL_OF_NUM_LT; REAL_OF_NUM_LE; REAL_OF_NUM_ADD] THEN + ASM_ARITH_TAC; + ASM_REAL_ARITH_TAC]; + DISCH_THEN(X_CHOOSE_THEN `n:num` STRIP_ASSUME_TAC) THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `&0 < inv(&n + &1)` MP_TAC THENL + [REWRITE_TAC[REAL_LT_INV_EQ] THEN REAL_ARITH_TAC; + ASM_REAL_ARITH_TAC]]);; + +(* Half-line and interval preimages are events, for a random variable. *) +let RV_PREIMAGE_LE = prove + (`!p (X:A->real) a. + random_variable p X + ==> {x | x IN prob_carrier p /\ X x <= a} IN prob_events p`, + SIMP_TAC[random_variable]);; + +let RV_PREIMAGE_LT = prove + (`!p (X:A->real) a. + random_variable p X + ==> {x | x IN prob_carrier p /\ X x < a} IN prob_events p`, + REPEAT STRIP_TAC THEN REWRITE_TAC[RV_PREIMAGE_LT_EQ_UNIONS] THEN + MATCH_MP_TAC PROB_COUNTABLE_UNION_IN_EVENTS THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; IN_UNIV] THEN + GEN_TAC THEN FIRST_X_ASSUM(MP_TAC o REWRITE_RULE[random_variable]) THEN + DISCH_THEN(MP_TAC o SPEC `a - inv(&n + &1)`) THEN REWRITE_TAC[]; + REWRITE_TAC[SIMPLE_IMAGE] THEN MATCH_MP_TAC COUNTABLE_IMAGE THEN + REWRITE_TAC[NUM_COUNTABLE]]);; + +let RV_PREIMAGE_GE = prove + (`!p (X:A->real) a. + random_variable p X + ==> {x | x IN prob_carrier p /\ X x >= a} IN prob_events p`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `{x:A | x IN prob_carrier p /\ X x >= a} = + prob_carrier p DIFF {x | x IN prob_carrier p /\ X x < a}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_DIFF; IN_ELIM_THM] THEN + X_GEN_TAC `y:A` THEN ASM_CASES_TAC `(y:A) IN prob_carrier p` THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + MATCH_MP_TAC PROB_COMPL_IN_EVENTS THEN + ASM_SIMP_TAC[RV_PREIMAGE_LT]]);; + +let RV_PREIMAGE_GT = prove + (`!p (X:A->real) a. + random_variable p X + ==> {x | x IN prob_carrier p /\ X x > a} IN prob_events p`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `{x:A | x IN prob_carrier p /\ X x > a} = + prob_carrier p DIFF {x | x IN prob_carrier p /\ X x <= a}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_DIFF; IN_ELIM_THM] THEN + X_GEN_TAC `y:A` THEN ASM_CASES_TAC `(y:A) IN prob_carrier p` THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + MATCH_MP_TAC PROB_COMPL_IN_EVENTS THEN + ASM_SIMP_TAC[RV_PREIMAGE_LE]]);; + +let RV_PREIMAGE_REAL_INTERVAL = prove + (`!p (X:A->real) a b. + random_variable p X + ==> {x | x IN prob_carrier p /\ X x IN real_interval(a,b)} IN prob_events p`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `{x:A | x IN prob_carrier p /\ X x IN real_interval(a,b)} = + {x | x IN prob_carrier p /\ X x > a} INTER + {x | x IN prob_carrier p /\ X x < b}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM; IN_REAL_INTERVAL] THEN + X_GEN_TAC `y:A` THEN ASM_CASES_TAC `(y:A) IN prob_carrier p` THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + MATCH_MP_TAC PROB_INTER_IN_EVENTS THEN + ASM_SIMP_TAC[RV_PREIMAGE_GT; RV_PREIMAGE_LT]]);; + +(* Every real-open set is a countable union of open intervals (real line). *) +let REAL_OPEN_COUNTABLE_UNION_REAL_INTERVAL = prove + (`!s:real->bool. + real_open s + ==> ?D. COUNTABLE D /\ + (!i. i IN D ==> i SUBSET s /\ ?a b. i = real_interval(a,b)) /\ + UNIONS D = s`, + GEN_TAC THEN REWRITE_TAC[REAL_OPEN] THEN DISCH_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP OPEN_COUNTABLE_UNION_OPEN_INTERVALS) THEN + DISCH_THEN(X_CHOOSE_THEN `D:(real^1->bool)->bool` STRIP_ASSUME_TAC) THEN + EXISTS_TAC `IMAGE (IMAGE drop) D` THEN + ASM_SIMP_TAC[COUNTABLE_IMAGE] THEN CONJ_TAC THENL + [REWRITE_TAC[FORALL_IN_IMAGE] THEN X_GEN_TAC `j:real^1->bool` THEN + DISCH_TAC THEN FIRST_X_ASSUM(MP_TAC o SPEC `j:real^1->bool`) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(CONJUNCTS_THEN2 ASSUME_TAC + (X_CHOOSE_THEN `a:real^1` (X_CHOOSE_THEN `b:real^1` SUBST_ALL_TAC))) THEN + REWRITE_TAC[IMAGE_DROP_INTERVAL] THEN CONJ_TAC THENL + [FIRST_X_ASSUM(MP_TAC o MATCH_MP (SET_RULE + `j SUBSET IMAGE lift s + ==> IMAGE drop j SUBSET IMAGE drop (IMAGE lift s)`)) THEN + REWRITE_TAC[IMAGE_DROP_INTERVAL; GSYM IMAGE_o; o_DEF; LIFT_DROP; IMAGE_ID]; + MESON_TAC[]]; + REWRITE_TAC[GSYM IMAGE_UNIONS] THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[GSYM IMAGE_o; o_DEF; LIFT_DROP; IMAGE_ID]]);; + +(* The open base case: preimage of any real-open set is an event. *) +let RV_PREIMAGE_REAL_OPEN = prove + (`!p (X:A->real) t. + random_variable p X /\ real_open t + ==> {x | x IN prob_carrier p /\ X x IN t} IN prob_events p`, + REPEAT STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o MATCH_MP REAL_OPEN_COUNTABLE_UNION_REAL_INTERVAL) THEN + DISCH_THEN(X_CHOOSE_THEN `D:(real->bool)->bool` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN + SUBGOAL_THEN + `{x:A | x IN prob_carrier p /\ X x IN UNIONS D} = + UNIONS (IMAGE (\i:real->bool. {x:A | x IN prob_carrier p /\ X x IN i}) D)` + SUBST1_TAC THENL + [REWRITE_TAC[UNIONS_IMAGE; UNIONS_GSPEC; EXTENSION; IN_ELIM_THM] THEN + SET_TAC[]; + ALL_TAC] THEN + MATCH_MP_TAC PROB_COUNTABLE_UNION_IN_EVENTS THEN + ASM_SIMP_TAC[COUNTABLE_IMAGE] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN + X_GEN_TAC `i:real->bool` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `i:real->bool`) THEN ASM_REWRITE_TAC[] THEN + DISCH_THEN(MP_TAC o CONJUNCT2) THEN + DISCH_THEN(X_CHOOSE_THEN `a:real` (X_CHOOSE_THEN `b:real` SUBST1_TAC)) THEN + ASM_SIMP_TAC[RV_PREIMAGE_REAL_INTERVAL]);; + +(* Main characterization: random variable iff all Borel preimages are events.*) +let RANDOM_VARIABLE_PREIMAGE_BOREL_IN = prove + (`!p (X:A->real). + random_variable p X <=> + !b. borel_in euclideanreal b + ==> {x | x IN prob_carrier p /\ X x IN b} IN prob_events p`, + REPEAT GEN_TAC THEN EQ_TAC THENL + [DISCH_TAC THEN MATCH_MP_TAC borel_in_INDUCT THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[GSYM REAL_OPEN_IN] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC RV_PREIMAGE_REAL_OPEN THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[TOPSPACE_EUCLIDEANREAL] THEN X_GEN_TAC `s:real->bool` THEN + DISCH_TAC THEN + SUBGOAL_THEN + `{x:A | x IN prob_carrier p /\ X x IN (:real) DIFF s} = + prob_carrier p DIFF {x | x IN prob_carrier p /\ X x IN s}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_DIFF; IN_UNIV; IN_ELIM_THM] THEN SET_TAC[]; + MATCH_MP_TAC PROB_COMPL_IN_EVENTS THEN ASM_REWRITE_TAC[]]; + X_GEN_TAC `u:(real->bool)->bool` THEN STRIP_TAC THEN + SUBGOAL_THEN + `{x:A | x IN prob_carrier p /\ X x IN UNIONS u} = + UNIONS (IMAGE (\s:real->bool. {x:A | x IN prob_carrier p /\ X x IN s}) u)` + SUBST1_TAC THENL + [REWRITE_TAC[UNIONS_IMAGE; UNIONS_GSPEC; EXTENSION; IN_ELIM_THM] THEN + SET_TAC[]; + MATCH_MP_TAC PROB_COUNTABLE_UNION_IN_EVENTS THEN + ASM_SIMP_TAC[COUNTABLE_IMAGE] THEN + REWRITE_TAC[SUBSET; FORALL_IN_IMAGE] THEN ASM_SIMP_TAC[]]]; + DISCH_TAC THEN REWRITE_TAC[random_variable] THEN X_GEN_TAC `a:real` THEN + FIRST_X_ASSUM(MP_TAC o SPEC `{y:real | y <= a}`) THEN + ANTS_TAC THENL + [MATCH_MP_TAC CLOSED_IMP_BOREL_IN THEN + REWRITE_TAC[GSYM REAL_CLOSED_IN; REAL_CLOSED_HALFSPACE_LE]; + REWRITE_TAC[IN_ELIM_THM]]]);; + +(* Payoff: a Borel-measurable function of a random variable is a random *) +(* variable (Williams "Probability with Martingales" 3.8). This is the *) +(* natural general form: the preimage of a Borel set under g is itself Borel *) +(* (directly from the definition of borel_measurable_map), and the preimage *) +(* of THAT under X is an event by RANDOM_VARIABLE_PREIMAGE_BOREL_IN. *) +let RANDOM_VARIABLE_BOREL_MEASURABLE_COMPOSE = prove + (`!p (X:A->real) g. + random_variable p X /\ + borel_measurable_map (euclideanreal,euclideanreal) g + ==> random_variable p (\x. g(X x))`, + REPEAT STRIP_TAC THEN + REWRITE_TAC[RANDOM_VARIABLE_PREIMAGE_BOREL_IN] THEN + X_GEN_TAC `b:real->bool` THEN DISCH_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [borel_measurable_map]) THEN + REWRITE_TAC[TOPSPACE_EUCLIDEANREAL] THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `b:real->bool`) THEN ASM_REWRITE_TAC[] THEN + DISCH_TAC THEN + SUBGOAL_THEN + `{x:A | x IN prob_carrier p /\ (g:real->real) (X x) IN b} = + {x:A | x IN prob_carrier p /\ X x IN {y:real | y IN (:real) /\ g y IN b}}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM; IN_UNIV]; + UNDISCH_TAC `random_variable p (X:A->real)` THEN + REWRITE_TAC[RANDOM_VARIABLE_PREIMAGE_BOREL_IN] THEN + DISCH_THEN MATCH_MP_TAC THEN ASM_REWRITE_TAC[]]);; + +(* A continuous function of a random variable is a random variable -- now an *) +(* immediate corollary, since continuous maps are Borel measurable. *) +let RANDOM_VARIABLE_CONTINUOUS_MAP_COMPOSE = prove + (`!p (X:A->real) g. + random_variable p X /\ continuous_map (euclideanreal,euclideanreal) g + ==> random_variable p (\x. g(X x))`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC RANDOM_VARIABLE_BOREL_MEASURABLE_COMPOSE THEN + ASM_SIMP_TAC[CONTINUOUS_IMP_BOREL_MEASURABLE_MAP]);; + +(* ------------------------------------------------------------------------- *) +(* Closure under pointwise sequential limits. *) +(* *) +(* If X n is a random variable for each n and X n x -> L x pointwise on the *) +(* carrier, then L is a random variable. The level set {L > a} is expressed *) +(* through countable set operations on the {X n >= a + 1/(j+1)} events *) +(* (Williams "Probability with Martingales" 3.x). *) +(* ------------------------------------------------------------------------- *) + +(* Characterization by open rays: it suffices that every {X > a} is an event. *) +(* (Named _SUFFICIENT to distinguish from the forward RV_PREIMAGE_GT.) *) +let RANDOM_VARIABLE_GT_SUFFICIENT = prove + (`!p (X:A->real). + (!a. {x | x IN prob_carrier p /\ X x > a} IN prob_events p) + ==> random_variable p X`, + REPEAT STRIP_TAC THEN REWRITE_TAC[random_variable] THEN X_GEN_TAC `a:real` THEN + SUBGOAL_THEN + `{x:A | x IN prob_carrier p /\ X x <= a} = + prob_carrier p DIFF {x | x IN prob_carrier p /\ X x > a}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_DIFF; IN_ELIM_THM] THEN + X_GEN_TAC `y:A` THEN ASM_CASES_TAC `(y:A) IN prob_carrier p` THEN + ASM_REWRITE_TAC[] THEN REAL_ARITH_TAC; + MATCH_MP_TAC PROB_COMPL_IN_EVENTS THEN ASM_SIMP_TAC[]]);; + +(* The level set of a pointwise limit, via countable unions/intersections. *) +let RV_LIMIT_GT_EQ = prove + (`!p (X:num->A->real) L a. + (!x. x IN prob_carrier p ==> ((\n. X n x) ---> L x) sequentially) + ==> {x | x IN prob_carrier p /\ L x > a} = + UNIONS {INTERS {{x | x IN prob_carrier p /\ X n x >= a + inv(&j + &1)} + | n IN from N} | j,N | T}`, + REPEAT STRIP_TAC THEN REWRITE_TAC[EXTENSION] THEN X_GEN_TAC `y:A` THEN + REWRITE_TAC[IN_ELIM_THM; UNIONS_GSPEC; INTERS_GSPEC; IN_FROM] THEN + REWRITE_TAC[IN_ELIM_THM] THEN EQ_TAC THENL + [STRIP_TAC THEN + FIRST_ASSUM(MP_TAC o ISPEC `y:A`) THEN + ANTS_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + REWRITE_TAC[REALLIM_SEQUENTIALLY] THEN BETA_TAC THEN + DISCH_THEN(LABEL_TAC "lim") THEN + SUBGOAL_THEN `?j. ~(j = 0) /\ &0 < inv(&j) /\ inv(&j) < L(y:A) - a` + STRIP_ASSUME_TAC THENL + [REWRITE_TAC[GSYM REAL_ARCH_INV] THEN ASM_REAL_ARITH_TAC; ALL_TAC] THEN + SUBGOAL_THEN `&0 < L(y:A) - (a + inv(&j + &1))` ASSUME_TAC THENL + [SUBGOAL_THEN `inv(&j + &1) <= inv(&j)` MP_TAC THENL + [MATCH_MP_TAC REAL_LE_INV2 THEN + REWRITE_TAC[REAL_OF_NUM_LT; REAL_OF_NUM_LE; REAL_OF_NUM_ADD] THEN + ASM_ARITH_TAC; + ASM_REAL_ARITH_TAC]; + ALL_TAC] THEN + REMOVE_THEN "lim" (MP_TAC o SPEC `L(y:A) - (a + inv(&j + &1))`) THEN + ASM_REWRITE_TAC[] THEN + DISCH_THEN(X_CHOOSE_THEN `N:num` (LABEL_TAC "ev")) THEN + MAP_EVERY EXISTS_TAC [`j:num`; `N:num`] THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN ASM_REWRITE_TAC[] THEN + REMOVE_THEN "ev" (MP_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[] THEN + REAL_ARITH_TAC; + DISCH_THEN(X_CHOOSE_THEN `j:num` (X_CHOOSE_THEN `N:num` ASSUME_TAC)) THEN + SUBGOAL_THEN `y:A IN prob_carrier p` ASSUME_TAC THENL + [FIRST_X_ASSUM(MP_TAC o SPEC `N:num`) THEN REWRITE_TAC[LE_REFL] THEN + SIMP_TAC[]; ALL_TAC] THEN + ASM_REWRITE_TAC[] THEN + SUBGOAL_THEN `a + inv(&j + &1) <= L(y:A)` MP_TAC THENL + [MATCH_MP_TAC(ISPEC `sequentially` REALLIM_LBOUND) THEN + EXISTS_TAC `\n:num. (X:num->A->real) n y` THEN + ASM_SIMP_TAC[TRIVIAL_LIMIT_SEQUENTIALLY] THEN + REWRITE_TAC[EVENTUALLY_SEQUENTIALLY] THEN EXISTS_TAC `N:num` THEN + X_GEN_TAC `n:num` THEN DISCH_TAC THEN BETA_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `n:num`) THEN ASM_REWRITE_TAC[] THEN + REAL_ARITH_TAC; + MATCH_MP_TAC(REAL_ARITH + `&0 < inv(&j + &1) ==> a + inv(&j + &1) <= L ==> L > a`) THEN + REWRITE_TAC[REAL_LT_INV_EQ] THEN REAL_ARITH_TAC]]);; + +let RANDOM_VARIABLE_LIMIT = prove + (`!p (X:num->A->real) L. + (!n. random_variable p (X n)) /\ + (!x. x IN prob_carrier p ==> ((\n. X n x) ---> L x) sequentially) + ==> random_variable p L`, + REPEAT STRIP_TAC THEN MATCH_MP_TAC RANDOM_VARIABLE_GT_SUFFICIENT THEN + X_GEN_TAC `a:real` THEN ASM_SIMP_TAC[RV_LIMIT_GT_EQ] THEN + MATCH_MP_TAC PROB_COUNTABLE_UNION_IN_EVENTS THEN CONJ_TAC THENL + [REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC PROB_COUNTABLE_INTERS_IN_EVENTS THEN REPEAT CONJ_TAC THENL + [REWRITE_TAC[SUBSET; FORALL_IN_GSPEC; IN_FROM] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC RV_PREIMAGE_GE THEN REWRITE_TAC[ETA_AX] THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC COUNTABLE_SUBSET THEN + EXISTS_TAC `IMAGE (\n. {x:A | x IN prob_carrier p /\ + (X:num->A->real) n x >= a + inv(&j + &1)}) (:num)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC COUNTABLE_IMAGE THEN REWRITE_TAC[NUM_COUNTABLE]; + REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_IMAGE; IN_UNIV] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN ASM_MESON_TAC[]]; + REWRITE_TAC[GSYM MEMBER_NOT_EMPTY; IN_ELIM_THM; IN_FROM] THEN + MAP_EVERY EXISTS_TAC + [`{x:A | x IN prob_carrier p /\ (X:num->A->real) N x >= a + inv(&j + &1)}`; + `N:num`] THEN + REWRITE_TAC[LE_REFL]]; + MATCH_MP_TAC COUNTABLE_SUBSET THEN + EXISTS_TAC `IMAGE (\(j,N). INTERS {{x:A | x IN prob_carrier p /\ + X n x >= a + inv(&j + &1)} | n IN from N}) (:num#num)` THEN + CONJ_TAC THENL + [MATCH_MP_TAC COUNTABLE_IMAGE THEN + REWRITE_TAC[GSYM CROSS_UNIV] THEN MATCH_MP_TAC COUNTABLE_CROSS THEN + REWRITE_TAC[NUM_COUNTABLE]; + REWRITE_TAC[SUBSET; IN_ELIM_THM; IN_IMAGE; IN_UNIV] THEN + REPEAT STRIP_TAC THEN ASM_REWRITE_TAC[] THEN + EXISTS_TAC `(j:num,N:num)` THEN REWRITE_TAC[]]]);; + (* ------------------------------------------------------------------------- *) (* Random variable properties *) (* ------------------------------------------------------------------------- *) +(* NEG and SCALE are instances of "continuous function of a random variable *) +(* is a random variable" (RANDOM_VARIABLE_CONTINUOUS_MAP_COMPOSE above, via *) +(* the Borel-preimage characterization): negation and scaling are continuous *) +(* maps euclideanreal->euclideanreal. *) + let RANDOM_VARIABLE_NEG = prove (`!p:A prob_space X. random_variable p X ==> random_variable p (\x. --(X x))`, REPEAT STRIP_TAC THEN - FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [random_variable]) THEN - REWRITE_TAC[random_variable] THEN - TRY BETA_TAC THEN DISCH_TAC THEN - X_GEN_TAC `a:real` THEN - SUBGOAL_THEN - `{x:A | x IN prob_carrier p /\ --X x <= a} = - prob_carrier p DIFF - UNIONS (IMAGE (\n. {x | x IN prob_carrier p /\ X x <= --a - inv(&n + &1)}) - (:num))` - SUBST1_TAC THENL - [GEN_REWRITE_TAC I [EXTENSION] THEN - X_GEN_TAC `y:A` THEN - REWRITE_TAC[IN_DIFF; UNIONS_IMAGE; IN_UNIV] THEN - TRY BETA_TAC THEN - REWRITE_TAC[IN_ELIM_THM] THEN - ASM_CASES_TAC `(y:A) IN prob_carrier p` THEN ASM_REWRITE_TAC[] THEN - REWRITE_TAC[NOT_EXISTS_THM; REAL_NOT_LE] THEN - EQ_TAC THENL - [DISCH_TAC THEN X_GEN_TAC `n:num` THEN - MATCH_MP_TAC(REAL_ARITH `--x <= a /\ &0 < e ==> --a - e < x`) THEN - CONJ_TAC THENL - [FIRST_ASSUM ACCEPT_TAC; - REWRITE_TAC[REAL_LT_INV_EQ] THEN REAL_ARITH_TAC]; - DISCH_TAC THEN - REWRITE_TAC[GSYM REAL_NOT_LT] THEN DISCH_TAC THEN - SUBGOAL_THEN `&0 < --a - (X:A->real) y` MP_TAC THENL - [POP_ASSUM MP_TAC THEN REAL_ARITH_TAC; ALL_TAC] THEN - GEN_REWRITE_TAC LAND_CONV [REAL_ARCH_INV] THEN - DISCH_THEN(X_CHOOSE_THEN `k:num` STRIP_ASSUME_TAC) THEN - SUBGOAL_THEN `?j:num. k = SUC j` (X_CHOOSE_TAC `j:num`) THENL - [EXISTS_TAC `k - 1` THEN ASM_ARITH_TAC; ALL_TAC] THEN - SUBGOAL_THEN `inv(&j + &1) < --a - (X:A->real) y` ASSUME_TAC THENL - [ASM_MESON_TAC[REAL_OF_NUM_SUC]; ALL_TAC] THEN - FIRST_X_ASSUM(MP_TAC o SPEC `j:num`) THEN - POP_ASSUM MP_TAC THEN REAL_ARITH_TAC]; - ALL_TAC] THEN - MATCH_MP_TAC PROB_COMPL_IN_EVENTS THEN - MATCH_MP_TAC PROB_COUNTABLE_UNION_IN_EVENTS THEN - CONJ_TAC THENL - [REWRITE_TAC[SUBSET; FORALL_IN_IMAGE; IN_UNIV] THEN - X_GEN_TAC `n:num` THEN - CONV_TAC(ONCE_DEPTH_CONV BETA_CONV) THEN - FIRST_X_ASSUM MATCH_ACCEPT_TAC; - MATCH_MP_TAC COUNTABLE_IMAGE THEN REWRITE_TAC[NUM_COUNTABLE]]);; + MP_TAC(ISPECL [`p:A prob_space`; `X:A->real`; `\y:real. --y`] + RANDOM_VARIABLE_CONTINUOUS_MAP_COMPOSE) THEN + REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_MAP_REAL_NEG THEN + REWRITE_TAC[CONTINUOUS_MAP_ID]);; let RANDOM_VARIABLE_SCALE = prove (`!p:A prob_space X c. random_variable p X /\ &0 < c ==> random_variable p (\x. c * X x)`, REPEAT STRIP_TAC THEN - FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [random_variable]) THEN - REWRITE_TAC[random_variable] THEN - TRY BETA_TAC THEN DISCH_TAC THEN - X_GEN_TAC `a:real` THEN - SUBGOAL_THEN - `{x:A | x IN prob_carrier p /\ c * X x <= a} = - {x | x IN prob_carrier p /\ X x <= a / c}` - SUBST1_TAC THENL - [REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN GEN_TAC THEN - ASM_CASES_TAC `(x:A) IN prob_carrier p` THEN ASM_REWRITE_TAC[] THEN - ONCE_REWRITE_TAC[REAL_MUL_SYM] THEN - ASM_SIMP_TAC[GSYM REAL_LE_RDIV_EQ]; - FIRST_X_ASSUM MATCH_ACCEPT_TAC]);; + MP_TAC(ISPECL [`p:A prob_space`; `X:A->real`; `\y:real. c * y`] + RANDOM_VARIABLE_CONTINUOUS_MAP_COMPOSE) THEN + REWRITE_TAC[] THEN DISCH_THEN MATCH_MP_TAC THEN + ASM_REWRITE_TAC[] THEN MATCH_MP_TAC CONTINUOUS_MAP_REAL_LMUL THEN + REWRITE_TAC[CONTINUOUS_MAP_ID]);; (* ------------------------------------------------------------------------- *) @@ -422,3 +713,125 @@ let PROB_CONTINUITY_FROM_ABOVE = prove ASM_REWRITE_TAC[REAL_ARITH `(a - x) - (a - y):real = --(x - y)`; REAL_ABS_NEG]);; +(* ------------------------------------------------------------------------- *) +(* The distribution (law / pushforward measure) of a random variable. *) +(* *) +(* distribution p X b = P(X IN b) for a Borel set b -- the pushforward of the *) +(* probability measure along X. It is a probability measure on the real Borel *) +(* sets: nonneg, total mass 1, countably additive. This is the "law of X" *) +(* (Williams "Probability with Martingales" Ch 3); its restriction to the *) +(* half-lines is the distribution function distribution_fn (CDF, expectation.ml).*) +(* ------------------------------------------------------------------------- *) + +let distribution = new_definition + `distribution (p:A prob_space) (X:A->real) (b:real->bool) = + prob p {x | x IN prob_carrier p /\ X x IN b}`;; + +(* The preimage of a Borel set under a random variable is an event. *) +let DISTRIBUTION_IN_EVENTS = prove + (`!p (X:A->real) b. + random_variable p X /\ borel_in euclideanreal b + ==> {x | x IN prob_carrier p /\ X x IN b} IN prob_events p`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + FIRST_ASSUM(fun th -> + MP_TAC(SPEC `b:real->bool` + (REWRITE_RULE[RANDOM_VARIABLE_PREIMAGE_BOREL_IN] th))) THEN + ASM_REWRITE_TAC[]);; + +let DISTRIBUTION_POS = prove + (`!p (X:A->real) b. + random_variable p X /\ borel_in euclideanreal b + ==> &0 <= distribution p X b`, + REPEAT STRIP_TAC THEN REWRITE_TAC[distribution] THEN + MATCH_MP_TAC PROB_POSITIVE THEN MATCH_MP_TAC DISTRIBUTION_IN_EVENTS THEN + ASM_REWRITE_TAC[]);; + +let DISTRIBUTION_LE_1 = prove + (`!p (X:A->real) b. + random_variable p X /\ borel_in euclideanreal b + ==> distribution p X b <= &1`, + REPEAT STRIP_TAC THEN REWRITE_TAC[distribution] THEN + MATCH_MP_TAC PROB_LE_1 THEN MATCH_MP_TAC DISTRIBUTION_IN_EVENTS THEN + ASM_REWRITE_TAC[]);; + +let DISTRIBUTION_UNIV = prove + (`!p (X:A->real). distribution p X (:real) = &1`, + REPEAT GEN_TAC THEN REWRITE_TAC[distribution; IN_UNIV] THEN + SUBGOAL_THEN `{x:A | x IN prob_carrier p} = prob_carrier p` SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_ELIM_THM]; REWRITE_TAC[PROB_SPACE]]);; + +let DISTRIBUTION_EMPTY = prove + (`!p (X:A->real). distribution p X {} = &0`, + REPEAT GEN_TAC THEN + REWRITE_TAC[distribution; NOT_IN_EMPTY; EMPTY_GSPEC; PROB_EMPTY]);; + +let DISTRIBUTION_MONO = prove + (`!p (X:A->real) b c. + random_variable p X /\ borel_in euclideanreal b /\ + borel_in euclideanreal c /\ b SUBSET c + ==> distribution p X b <= distribution p X c`, + REPEAT STRIP_TAC THEN REWRITE_TAC[distribution] THEN + MATCH_MP_TAC PROB_MONO THEN REPEAT CONJ_TAC THENL + [MATCH_MP_TAC DISTRIBUTION_IN_EVENTS THEN ASM_REWRITE_TAC[]; + MATCH_MP_TAC DISTRIBUTION_IN_EVENTS THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN ASM SET_TAC[]]);; + +(* Countable additivity: the law is a probability measure on the Borel sets. *) +let DISTRIBUTION_COUNTABLY_ADDITIVE = prove + (`!p (X:A->real) B. + random_variable p X /\ (!n. borel_in euclideanreal (B n)) /\ + (!i j. ~(i = j) ==> DISJOINT (B i) (B j)) + ==> ((\n. distribution p X (B n)) real_sums + distribution p X (UNIONS {B n | n IN (:num)})) (from 0)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[distribution] THEN + SUBGOAL_THEN + `{x:A | x IN prob_carrier p /\ X x IN UNIONS {(B:num->real->bool) n | n IN (:num)}} = + UNIONS {{x:A | x IN prob_carrier p /\ X x IN B n} | n IN (:num)}` + SUBST1_TAC THENL + [REWRITE_TAC[UNIONS_GSPEC; EXTENSION; IN_ELIM_THM] THEN SET_TAC[]; ALL_TAC] THEN + MP_TAC(ISPECL [`p:A prob_space`; + `\n:num. {x:A | x IN prob_carrier p /\ X x IN (B:num->real->bool) n}`] + PROB_COUNTABLY_ADDITIVE) THEN + BETA_TAC THEN ANTS_TAC THENL + [CONJ_TAC THENL + [GEN_TAC THEN MATCH_MP_TAC DISTRIBUTION_IN_EVENTS THEN ASM_REWRITE_TAC[]; + MAP_EVERY X_GEN_TAC [`i:num`; `j:num`] THEN DISCH_TAC THEN + REWRITE_TAC[DISJOINT; EXTENSION; IN_INTER; IN_ELIM_THM; NOT_IN_EMPTY] THEN + FIRST_X_ASSUM(MP_TAC o SPECL [`i:num`; `j:num`]) THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[DISJOINT; EXTENSION; IN_INTER; NOT_IN_EMPTY] THEN ASM SET_TAC[]]; + REWRITE_TAC[]]);; + +(* ------------------------------------------------------------------------- *) +(* Joint distribution function of a pair of random variables. *) +(* joint_distribution_fn p X Y a b = P(X <= a, Y <= b). *) +(* ------------------------------------------------------------------------- *) + +(* The rectangle preimage {X <= a, Y <= b} is an event. *) +let JOINT_RECTANGLE_IN_EVENTS = prove + (`!p (X:A->real) Y a b. + random_variable p X /\ random_variable p Y + ==> {w | w IN prob_carrier p /\ X w <= a /\ Y w <= b} IN prob_events p`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `{w:A | w IN prob_carrier p /\ X w <= a /\ Y w <= b} = + {w | w IN prob_carrier p /\ X w <= a} INTER + {w | w IN prob_carrier p /\ Y w <= b}` + SUBST1_TAC THENL + [REWRITE_TAC[EXTENSION; IN_INTER; IN_ELIM_THM] THEN MESON_TAC[]; ALL_TAC] THEN + MATCH_MP_TAC PROB_INTER_IN_EVENTS THEN + CONJ_TAC THEN + FIRST_X_ASSUM(fun th -> MP_TAC th THEN + FIRST_X_ASSUM(fun th2 -> MP_TAC th2)) THEN + REWRITE_TAC[random_variable] THEN MESON_TAC[]);; + +let joint_distribution_fn = new_definition + `joint_distribution_fn (p:A prob_space) (X:A->real) (Y:A->real) + (a:real) (b:real) = + prob p {w | w IN prob_carrier p /\ X w <= a /\ Y w <= b}`;; + +(* Symmetry of the joint distribution function. *) +let JOINT_DISTRIBUTION_SYM = prove + (`!p (X:A->real) Y a b. + joint_distribution_fn p X Y a b = joint_distribution_fn p Y X b a`, + REPEAT GEN_TAC THEN REWRITE_TAC[joint_distribution_fn] THEN + AP_TERM_TAC THEN REWRITE_TAC[EXTENSION; IN_ELIM_THM] THEN MESON_TAC[]);; diff --git a/TacticTrace/Makefile b/TacticTrace/Makefile index bdb0f8ae..4ef4778a 100644 --- a/TacticTrace/Makefile +++ b/TacticTrace/Makefile @@ -10,6 +10,14 @@ TYPES_OBJECTS = $(TYPES_SOURCES:.ml=.cmo) # Set the HOLLIGHT_DIR to /.. HOLLIGHT_DIR?=$(dir $(abspath $(lastword $(MAKEFILE_LIST))))/.. +# If a local OPAM switch exists at $(HOLLIGHT_DIR)/_opam, prepend its bin +# directory to PATH so that ocamlfind, ocamlc, etc. are picked up even when +# this Makefile is invoked from an environment that has not run +# `eval $(opam env)`. +ifneq ($(wildcard $(HOLLIGHT_DIR)/_opam/bin),) + export PATH := $(abspath $(HOLLIGHT_DIR)/_opam/bin):$(PATH) +endif + TESTS =\ examples/tactic.ml \ examples/conv.ml diff --git a/unit_tests.ml b/UnitTests/basic_tests.ml similarity index 100% rename from unit_tests.ml rename to UnitTests/basic_tests.ml diff --git a/UnitTests/printer_tests.ml b/UnitTests/printer_tests.ml new file mode 100644 index 00000000..02daf7f1 --- /dev/null +++ b/UnitTests/printer_tests.ml @@ -0,0 +1,340 @@ +(* ========================================================================= *) +(* HOL Light printer tests *) +(* *) +(* Verifies that pp_print_term produces the expected text for a corpus of *) +(* representative term shapes. Each case exercises a specific code path in *) +(* printer.ml: phase A (numerals, lists, strings, gabs), phase B (name *) +(* dispatch on EMPTY/UNIV/INSERT/GSPEC/LET/DECIMAL/_MATCH/_FUNCTION/COND), *) +(* phase C (prefix/binder/infix), phase D (atoms and generic application). *) +(* *) +(* Run via: *) +(* make UnitTests/printer_tests && ./UnitTests/printer_tests *) +(* ========================================================================= *) + +(* Set a wide margin so line-wrapping doesn't depend on tty width. *) +Format.set_margin 1000000;; + +let failures = ref 0;; +let total = ref 0;; + +let check label input expected = + incr total; + let actual = + try string_of_term (parse_term input) + with e -> + Printf.sprintf "<>" (Printexc.to_string e) in + if actual <> expected then + (incr failures; + Printf.printf "FAIL %s\n input = %s\n expected = %s\n actual = %s\n" + label input expected actual);; + +(* ------------------------------------------------------------------------- *) +(* Phase A: numerals, lists, strings, top-level gabs. *) +(* ------------------------------------------------------------------------- *) + +check "numeral.zero" "0:num" "0";; +check "numeral.large" "12345:num" "12345";; +check "list.nil" "[]:num list" "[]";; +check "list.three" "[1;2;3]:num list" "[1; 2; 3]";; +check "list.nested" "[[1;2];[3;4]]:(num list)list" + "[[1; 2]; [3; 4]]";; +check "list.tyvar" "[(x:A);(y:A);(z:A)]:A list" + "[x; y; z]";; +check "gabs.tuple" "(\\(x,y). x + y) ((1:num),(2:num))" + "(\\(x,y). x + y) (1,2)";; +check "gabs.tyvar" "\\((x:A),(y:B)). (x,y)" + "\\(x,y). x,y";; + +(* ------------------------------------------------------------------------- *) +(* Phase B: name dispatch. *) +(* ------------------------------------------------------------------------- *) + +check "univ.num" "(:num)" "(:num)";; +check "univ.bool" "(:bool)" "(:bool)";; +check "univ.tyvar" "(:A)" "(:A)";; +check "set.three" "{1,2,3}:num->bool" "{1, 2, 3}";; +check "set.compr" "{(x:num) | x > 0}" "{x | x > 0}";; +check "set.compr.pair" "{(x:num,y:num) | x + y = 1}" + "{x,y | x + y = 1}";; +check "let.simple" "let x = 1 in x + (2:num)" + "let x = 1 in x + 2";; +check "let.chained" "let x = 1 in let y = 2 in x + (y:num)" + "let x = 1 in let y = 2 in x + y";; +check "let.parallel" "let x = 1 and y = 2 in x + (y:num)" + "let x = 1 and y = 2 in x + y";; +check "decimal" "#1.5" "#1.5";; +check "match" "match (x:num) with 0 -> T | _ -> F" + "match x with 0 -> true | _ -> false";; +check "function" "function (0:num) -> T | _ -> F" + "function 0 -> true | _ -> false";; +check "cond.simple" "if (x:num) = 0 then 1 else 2" + "if x = 0 then 1 else 2";; +check "cond.cascade" + "if (a:num) = 0 then 1 else if a = 1 then 2 else if a = 2 then 3 else 4" + "if a = 0 then 1 else if a = 1 then 2 else if a = 2 then 3 else 4";; + +(* ------------------------------------------------------------------------- *) +(* Phase C: prefix, binder, infix. *) +(* ------------------------------------------------------------------------- *) + +check "prefix.neg" "~T" "~true";; +check "prefix.double" "~ (~T)" "~ ~true";; +check "prefix.real_neg" "-- &3" "-- &3";; +check "prefix.real_neg.parens" "-- (&3 + &4)" "--(&3 + &4)";; +check "infix.and" "T /\\ F" "true /\\ false";; +check "infix.implies" "p ==> q ==> r" "p ==> q ==> r";; +check "infix.add" "(x:num) + 1" "x + 1";; +check "infix.add.assoc" "(a:num) + b + c + d" "a + b + c + d";; +check "infix.sub.assoc" "(a:num) - b - c" "a - b - c";; +check "infix.mixed.prec" "(a:num) + b * c" "a + b * c";; + +(* Associativity tests. In HOL Light, +, *, /\, ==> are right-associative on + num/bool, so the natural right-grouping prints without parens but the + left-grouping prints with parens. Subtraction (-) is left-associative. + See arith.ml: parse_as_infix("+",(16,"right")) etc. *) + +(* + on num: right-associative. *) +check "infix.add.right_assoc" + "(x:num) + (y + z)" "x + y + z";; +check "infix.add.left_grouping" + "((x:num) + y) + z" "(x + y) + z";; +(* * on num: right-associative. *) +check "infix.mul.right_assoc" + "(x:num) * (y * z)" "x * y * z";; +check "infix.mul.left_grouping" + "((x:num) * y) * z" "(x * y) * z";; +(* - on num: left-associative. *) +check "infix.sub.left_assoc" + "((x:num) - y) - z" "x - y - z";; +check "infix.sub.right_grouping" + "(x:num) - (y - z)" "x - (y - z)";; +(* EXP on num: left-associative. *) +check "infix.exp.left_assoc" + "((x:num) EXP y) EXP z" "x EXP y EXP z";; +check "infix.exp.right_grouping" + "(x:num) EXP (y EXP z)" "x EXP (y EXP z)";; +(* DIV on num: left-associative. *) +check "infix.div.left_assoc" + "((x:num) DIV y) DIV z" "x DIV y DIV z";; +check "infix.div.right_grouping" + "(x:num) DIV (y DIV z)" "x DIV (y DIV z)";; +(* MOD on num: left-associative. *) +check "infix.mod.left_assoc" + "((x:num) MOD y) MOD z" "x MOD y MOD z";; +check "infix.mod.right_grouping" + "(x:num) MOD (y MOD z)" "x MOD (y MOD z)";; +(* ==> is right-associative. *) +check "infix.imp.right_assoc" + "p ==> (q ==> r)" "p ==> q ==> r";; +check "infix.imp.left_grouping" + "(p ==> q) ==> r" "(p ==> q) ==> r";; +(* /\ is right-associative. *) +check "infix.and.right_assoc" + "p /\\ (q /\\ r)" "p /\\ q /\\ r";; +check "infix.and.left_grouping" + "(p /\\ q) /\\ r" "(p /\\ q) /\\ r";; +(* Mixed precedence: * binds tighter than +, so a + b * c needs no parens + but (a + b) * c does. *) +check "infix.mix.add_then_mul" + "((a:num) + b) * c" "(a + b) * c";; +check "infix.mix.mul_then_add" + "(a:num) * b + c" "a * b + c";; +check "infix.mix.mul_then_add.parens" + "(a:num) * (b + c)" "a * (b + c)";; +(* Mixed +/- on num. + has prec 16 right-assoc; - has prec 18 left-assoc, so + - binds tighter than +. *) +check "infix.mix.add_sub.left" + "((x:num) + y) - z" "(x + y) - z";; +check "infix.mix.add_sub.right" + "(x:num) + (y - z)" "x + y - z";; +check "infix.mix.sub_add.left" + "((x:num) - y) + z" "x - y + z";; +check "infix.mix.sub_add.right" + "(x:num) - (y + z)" "x - (y + z)";; + +(* The same arithmetic operators on int and real, after prioritize_int / + prioritize_real. The interface remaps +,-,*,= to int_*/real_* but the + printer should still emit the symbolic infix. We restore via + prioritize_num() at the end so subsequent tests see the default state. *) + +prioritize_int();; +check "prioritize.int.add" + "(x:int) + y + z" "x + y + z";; +check "prioritize.int.add_sub" + "((x:int) + y) - z" "(x + y) - z";; +check "prioritize.int.mul_add" + "(x:int) * y + z" "x * y + z";; + +check "infix.int.div.left_assoc" + "((x:int) div y) div z" "x div y div z";; +check "infix.int.div.right_grouping" + "(x:int) div (y div z)" "x div (y div z)";; +check "infix.int.rem.left_assoc" + "((x:int) rem y) rem z" "x rem y rem z";; +check "infix.int.pow.left_assoc" + "((x:int) pow y) pow z" "x pow y pow z";; +check "infix.int.pow.right_grouping" + "(x:int) pow (y EXP z)" "x pow (y EXP z)";; + +prioritize_real();; +check "prioritize.real.add" + "(x:real) + y + z" "x + y + z";; +check "prioritize.real.add_sub" + "((x:real) + y) - z" "(x + y) - z";; +check "prioritize.real.mul_add" + "(x:real) * y + z" "x * y + z";; +check "prioritize.real.div" + "(x:real) / (y * z)" "x / (y * z)";; + +check "infix.real.div.left_assoc" + "((x:real) / y) / z" "x / y / z";; +check "infix.real.div.right_grouping" + "(x:real) / (y / z)" "x / (y / z)";; +check "infix.real.pow.left_assoc" + "((x:real) pow y) pow z" "x pow y pow z";; +check "infix.real.pow.right_grouping" + "(x:real) pow (y EXP z)" "x pow (y EXP z)";; +check "infix.real.zpow.left_assoc" + "((x:real) zpow y) zpow z" "x zpow y zpow z";; + +(* Restore default num-priority for subsequent tests. *) +prioritize_num();; +check "infix.real.add" "&1 + &2" "&1 + &2";; +check "infix.real.div" "&5 / &2" "&5 / &2";; +check "infix.real.dec" "#1.5 + #2.25" "#1.5 + #2.25";; +check "infix.eq" "(x:num) = (y:num)" "x = y";; +check "infix.iff" "(T <=> F)" "true <=> false";; +check "infix.append" "APPEND [1;2] [3;4]:num list" + "APPEND [1; 2] [3; 4]";; +check "binder.exists" "?x. x = (3:num)" "exists x. x = 3";; +check "binder.forall" "!x. x + 0 = x" "forall x. x + 0 = x";; +check "binder.lambda" "\\x. x + 1" "\\x. x + 1";; +check "binder.lambda.multi" + "\\x y z. x + y + (z:num)" + "\\x y z. x + y + z";; +check "binder.uexists" "?!x. x = (5:num)" "existsunique x. x = 5";; +check "binder.epsilon" "@x. x > (0:num)" "@x. x > 0";; +check "binder.forall.multi" + "!x y z. x + y + z = (z:num) + y + x" + "forall x y z. x + y + z = z + y + x";; + +(* ------------------------------------------------------------------------- *) +(* Phase D: atoms and generic applications. *) +(* ------------------------------------------------------------------------- *) + +check "app.curried" "(f:num->num->num->num) (a:num) (b:num) (c:num)" + "f a b c";; +check "app.deep" + "(f:num->num) ((g:num->num) ((h:num->num) ((i:num->num) ((j:num->num) (x:num)))))" + "f (g (h (i (j x))))";; +check "app.parens" "(f:num->num->num) ((a:num) + b) ((c:num) * d)" + "f (a + b) (c * d)";; + +(* Polymorphic atoms with user-named type variables — the printer should not + add type annotations because the types do not contain invented type + variables (their names start with letters, not '?'). *) +check "atom.tyvar.app" + "(f:A->A->A->A) (x:A) (y:A) (z:A)" + "f x y z";; +check "atom.tyvar.lambda" + "\\(x:A). x" + "\\x. x";; + +(* ------------------------------------------------------------------------- *) +(* print_types_of_subterms = 2: every constant and variable is annotated *) +(* with its type. See Help/print_types_of_subterms.hlp for details. *) +(* ------------------------------------------------------------------------- *) + +let saved_show_types = !print_types_of_subterms;; +print_types_of_subterms := 2;; + +check "show_types.var" + "(x:num)" "(x:num)";; +check "show_types.const" + "T" "(true:bool)";; +check "show_types.bool_const_F" + "F" "(false:bool)";; +check "show_types.app" + "(f:num->num) (x:num)" + "(f:num->num) (x:num)";; +check "show_types.infix" + "(x:num) + (y:num)" + "(x:num) + (y:num)";; +check "show_types.lambda" + "\\(x:num). x + (1:num)" + "\\(x:num). (x:num) + 1";; +check "show_types.binder" + "!(x:num). x = x" + "forall (x:num). (x:num) = (x:num)";; +check "show_types.tyvar" + "(f:A->A) (x:A)" + "(f:A->A) (x:A)";; +(* Numerals (phase A) are printed as bare digits regardless of + print_types_of_subterms — see print_numeral in printer.ml. *) +check "show_types.list_numerals" + "[(1:num); 2; 3]" + "[1; 2; 3]";; +check "show_types.cond" + "if (b:bool) then (1:num) else 2" + "if (b:bool) then 1 else 2";; +check "show_types.let" + "let (x:num) = 1 in x + 2" + "let (x:num) = 1 in (x:num) + 2";; + +check "show_types.real_of_num" + "&2" + "(& :num->real)2";; +check "show_types.real_neg" + "-- &2" + "-- (& :num->real)2";; +check "show_types.real_of_num.add" + "&1 + &2" + "(& :num->real)1 + (& :num->real)2";; + +print_types_of_subterms := saved_show_types;; + +(* ------------------------------------------------------------------------- *) +(* Round-trip of the symbolic-head fix: parse_term o string_of_term must be *) +(* the identity on the printed form even with print_types_of_subterms := 2. *) +(* Without the space before ":", "&:" lexes as a single Ident and the *) +(* re-parse would fail or misinterpret the term. *) +(* ------------------------------------------------------------------------- *) + +let check_roundtrip label tm = + incr total; + let printed = + let saved = !print_types_of_subterms in + print_types_of_subterms := 2; + let s = string_of_term tm in + print_types_of_subterms := saved; s in + let reparsed = + try parse_term printed + with e -> + incr failures; + Printf.printf "FAIL %s\n printed = %s\n parse error: %s\n" + label printed (Printexc.to_string e); + tm in + if not (aconv reparsed tm) then + (incr failures; + Printf.printf "FAIL %s\n printed = %s\n reparsed != original\n" + label printed);; + +let real_of_num_tm = mk_const("real_of_num",[]);; +let real_neg_tm = mk_const("real_neg",[]);; +let real_add_tm = mk_const("real_add",[]);; +let amp_2 = mk_comb(real_of_num_tm,mk_numeral(num 2));; +let amp_1 = mk_comb(real_of_num_tm,mk_numeral(num 1));; + +check_roundtrip "roundtrip.real_of_num" amp_2;; +check_roundtrip "roundtrip.real_neg" (mk_comb(real_neg_tm,amp_2));; +check_roundtrip "roundtrip.real_add" (mk_binop real_add_tm amp_1 amp_2);; + +(* ------------------------------------------------------------------------- *) +(* Summary. *) +(* ------------------------------------------------------------------------- *) + +(if !failures = 0 then + Printf.printf "OK: %d/%d printer tests passed\n" !total !total + else + (Printf.printf "FAILED: %d/%d printer tests failed\n" !failures !total; + exit 1));; diff --git a/WZ/README b/WZ/README new file mode 100644 index 00000000..aa3cecb0 --- /dev/null +++ b/WZ/README @@ -0,0 +1,58 @@ +HOL Light implementation of the Wilf-Zeilberger method +======================================================= + +This is the implementation associated with John Harrison, "Formal Proofs of +Hypergeometric Sums", Journal of Automated Reasoning 55 (2015), +DOI 10.1007/s10817-015-9338-0. + +The trusted implementation is in `wz.ml`. Its main entry point is + + WZ_PROVE ntm stm rtm ctm atm + +where `ntm` is the natural-number recurrence variable, `stm` is the sum, +`rtm` is the rational certificate, `ctm` is the list of recurrence +coefficients, and `atm` is a list of assumptions. The result is a theorem; +the function does not use or modify the interactive goal stack. + +`maxima.ml` provides the optional entry point + + WZ_MAXIMA_PROVE ntm stm atm + +It translates the hypergeometric summand to Maxima, asks Maxima's +`Zeilberger` function for `rtm` and `ctm`, and passes those terms to +`WZ_PROVE`. Maxima is an untrusted certificate generator: malformed or +incorrect output is rejected by the parser or by the HOL proof. + +`examples.ml` contains 42 completed examples. They are proved using +certificates generated by Maxima; their explicit certificates are retained in +comments for repeatability and for use on systems without Maxima. +`nonexamples.ml` separately preserves 31 incomplete or unsupported candidates; +it is documentation, not part of the executable regression suite. + +Load the implementation and examples with: + + loadt "WZ/make.ml";; + +This requires Maxima. To use only the trusted checker, load `WZ/wz.ml`; the +explicit certificates in `examples.ml` show how to call `WZ_PROVE` directly. + +The source abbreviations used in the example headings are: + + A = B + M. Petkovsek, H. S. Wilf and D. Zeilberger, "A = B", A K Peters, + 1996. + + Gould + H. W. Gould, "Combinatorial Identities: A Standardized Set of Tables + Listing 500 Binomial Coefficient Summations", 1972. + + Koepf + W. Koepf, "Hypergeometric Summation", Vieweg, 1998. + + Nemes et al. + I. Nemes, M. Petkovsek, H. S. Wilf and D. Zeilberger, "How to do your + monthly problems with your computer", American Mathematical Monthly 104 + (1997), 505-519. + + Riordan + J. Riordan, "Combinatorial Identities", Wiley, 1968. diff --git a/WZ/examples.ml b/WZ/examples.ml new file mode 100644 index 00000000..1804e88b --- /dev/null +++ b/WZ/examples.ml @@ -0,0 +1,922 @@ +(* ========================================================================= *) +(* Examples for the HOL Light implementation of the WZ method. *) +(* ========================================================================= *) + +needs "WZ/maxima.ml";; + +(* Each executable example obtains its certificate from Maxima and checks it *) +(* in HOL. The original explicit certificate is retained in a comment so *) +(* that the example can instead be run with WZ_PROVE when Maxima is absent. *) + +(* ------------------------------------------------------------------------- *) +(* Example 1. Binomial theorem. *) +(* ------------------------------------------------------------------------- *) + +let WZ_EXAMPLE_1 = + let ntm = `n:num` + and stm = `sum (0..n) (\k. &(binom (n,k)) / &2 spow &n)` + and atm = [] in + (* + let rtm = `&k / (&2 * (&n - &k + &1))` + and ctm = [`&1`; `-- &1`] in + WZ_PROVE ntm stm rtm ctm atm + *) + WZ_MAXIMA_PROVE ntm stm atm;; + +(* ------------------------------------------------------------------------- *) +(* Example 2. Chu-Vandermonde identity. *) +(* ------------------------------------------------------------------------- *) + +let WZ_EXAMPLE_2 = + let ntm = `n:num` + and stm = + `sum (0..n) + (\k. &(binom (n,k)) pow 2 / &(binom (2 * n,n)))` + and atm = [] in + (* + let rtm = + `--(&k pow 2 * (&3 * &n - &2 * &k + &3)) / + (&2 * (&n - &k + &1) pow 2 * (&2 * &n + &1))` + and ctm = [`-- &1`; `&1`] in + WZ_PROVE ntm stm rtm ctm atm + *) + WZ_MAXIMA_PROVE ntm stm atm;; + +(* ------------------------------------------------------------------------- *) +(* Example 3. Shifted Chu-Vandermonde identity. *) +(* ------------------------------------------------------------------------- *) + +let WZ_EXAMPLE_3 = + let ntm = `n:num` + and stm = + `sum (0..n) + (\k. &(binom (n,k)) * &(binom (m,k + p)) / + &(binom (n + m,n + p)))` + and atm = [`&p <= &m`] in + (* + let rtm = + `(&k * (&p + &k)) / ((&n - &k + &1) * (&n + &m + &1))` + and ctm = [`&1`; `-- &1`] in + WZ_PROVE ntm stm rtm ctm atm + *) + WZ_MAXIMA_PROVE ntm stm atm;; + +(* ------------------------------------------------------------------------- *) +(* Example 4. Gosper example from Nemes et al. *) +(* ------------------------------------------------------------------------- *) + +(* Shifting k and n avoids the pole at k = 0. *) + +let WZ_EXAMPLE_4 = + let ntm = `n:num` + and stm = + `sum (0..n + 1) + (\k. &(binom (n + 1,k + 1)) * (&k + &1) * (&k + &1) * + &(FACT k) / (&n + &1) spow (&k + &1))` + and atm = [] in + (* + let rtm = `--(&n + &1) / (&k + &1)` + and ctm = [`&1`] in + WZ_PROVE ntm stm rtm ctm atm + *) + WZ_MAXIMA_PROVE ntm stm atm;; + +(* ------------------------------------------------------------------------- *) +(* Example 5. Central-binomial identity. *) +(* ------------------------------------------------------------------------- *) + +let WZ_EXAMPLE_5 = + let ntm = `n:num` + and stm = + `sum (0..n) + (\k. (-- &1 spow &k * &(binom (n,k)) * + &(binom (2 * k,k)) * &4 spow &n / &4 spow &k) / + &(binom (2 * n,n)))` + and atm = [] in + (* + let rtm = + `(&2 * &k pow 2) / ((&n - &k + &1) * (&2 * &n + &1))` + and ctm = [`&1`; `-- &1`] in + WZ_PROVE ntm stm rtm ctm atm + *) + WZ_MAXIMA_PROVE ntm stm atm;; + +(* ------------------------------------------------------------------------- *) +(* Example 6. Alternating binomial sum. *) +(* ------------------------------------------------------------------------- *) + +let WZ_EXAMPLE_6 = + let ntm = `n:num` + and stm = + `sum (0..n + 1) (\k. -- &1 spow &k * &(binom (n + 1,k)))` + and atm = [] in + (* + let rtm = `-- &k / (&n + &1)` + and ctm = [`&1`] in + WZ_PROVE ntm stm rtm ctm atm + *) + WZ_MAXIMA_PROVE ntm stm atm;; + +(* ------------------------------------------------------------------------- *) +(* Example 7. Apery-number recurrence. *) +(* ------------------------------------------------------------------------- *) + +let WZ_EXAMPLE_7 = + let ntm = `n:num` + and stm = + `sum (0..n) + (\k. &(binom (n + k,k)) pow 2 * &(binom (n,k)) pow 2)` + and atm = [] in + (* + let rtm = + `(&4 * &k pow 4 * (&2 * &n + &3) * + (&4 * &n pow 2 + &12 * &n - &2 * &k pow 2 + &3 * &k + &8)) / + ((&n - &k + &1) pow 2 * (&n - &k + &2) pow 2)` + and ctm = + [`--((&n + &1) pow 3)`; + `(&2 * &n + &3) * (&17 * &n pow 2 + &51 * &n + &39)`; + `--((&n + &2) pow 3)`] in + WZ_PROVE ntm stm rtm ctm atm + *) + WZ_MAXIMA_PROVE ntm stm atm;; + +(* ------------------------------------------------------------------------- *) +(* Example 8. Dixon identity; A = B, Example 6.4.4. *) +(* ------------------------------------------------------------------------- *) + +let WZ_EXAMPLE_8 = + let ntm = `n:num` + and stm = + `sum (0..2 * n) + (\k. (-- &1 spow &k * &(binom (2 * n,k)) pow 3) / + (-- &1 spow &n * &(FACT (3 * n)) / &(FACT n) pow 3))` + and atm = [] in + (* + let rtm = + `(&k pow 3 * + (&448 * &n pow 5 - &624 * &k * &n pow 4 + &1760 * &n pow 4 + + &348 * &k pow 2 * &n pow 3 - &1932 * &k * &n pow 3 + + &2728 * &n pow 3 - &90 * &k pow 3 * &n pow 2 + + &792 * &k pow 2 * &n pow 2 - &2214 * &k * &n pow 2 + + &2084 * &n pow 2 + &9 * &k pow 4 * &n - + &132 * &k pow 3 * &n + &594 * &k pow 2 * &n - + &1113 * &k * &n + &784 * &n + &6 * &k pow 4 - + &48 * &k pow 3 + &147 * &k pow 2 - &207 * &k + &116)) / + (&3 * (&2 * &n - &k + &1) pow 3 * + (&2 * &n - &k + &2) pow 3 * (&3 * &n + &1) * + (&3 * &n + &2) * &2)` + and ctm = [`-- &1`; `&1`] in + WZ_PROVE ntm stm rtm ctm atm + *) + WZ_MAXIMA_PROVE ntm stm atm;; + +(* ------------------------------------------------------------------------- *) +(* Example 9. Franel-number recurrence; A = B, p. 20. *) +(* ------------------------------------------------------------------------- *) + +let WZ_EXAMPLE_9 = + let ntm = `n:num` + and stm = `sum (0..n) (\k. &(binom (n,k)) pow 3)` + and atm = [] in + (* + let rtm = + `(&k pow 3 * (&n + &1) pow 2 * + (&14 * &n pow 3 - &27 * &k * &n pow 2 + &74 * &n pow 2 + + &18 * &k pow 2 * &n - &93 * &k * &n + &128 * &n - + &4 * &k pow 3 + &30 * &k pow 2 - &78 * &k + &72)) / + ((&n - &k + &1) pow 3 * (&n - &k + &2) pow 3)` + and ctm = + [`&8 * (&n + &1) pow 2`; + `&7 * &n pow 2 + &21 * &n + &16`; + `--((&n + &2) pow 2)`] in + WZ_PROVE ntm stm rtm ctm atm + *) + WZ_MAXIMA_PROVE ntm stm atm;; + +(* ------------------------------------------------------------------------- *) +(* Example 10. A = B, p. 32. *) +(* ------------------------------------------------------------------------- *) + +let WZ_EXAMPLE_10 = + let ntm = `n:num` + and stm = + `sum (0..n) + (\k. (&1 - &2 * &n) * + (-- &1 spow &k * &(binom (n,k)) * &4 spow &k) / + &(binom (2 * k,k)))` + and atm = [] in + (* + let rtm = `(&1 - &2 * &k) / (&2 * &n - &1)` + and ctm = [`&1`] in + WZ_PROVE ntm stm rtm ctm atm + + The A = B exercise gives the alternative certificate + + let rtm = + `(&k * (&2 * &k - &1)) / + ((&2 * &n - &1) * (&k - &n - &1))` + and ctm = [`-- &1`; `&1`] in + WZ_PROVE ntm stm rtm ctm atm + *) + WZ_MAXIMA_PROVE ntm stm atm;; + +(* ------------------------------------------------------------------------- *) +(* Example 11. Laguerre-polynomial recurrence. *) +(* ------------------------------------------------------------------------- *) + +let WZ_EXAMPLE_11 = + let ntm = `n:num` + and stm = + `sum (0..n) + (\k. -- &1 spow &k * &(binom (n,k)) / &(FACT k))` + and atm = [] in + (* + let rtm = + `--(&k pow 2 * (&n + &1)) / + ((&n - &k + &1) * (&n - &k + &2))` + and ctm = [`&n + &1`; `-- &2 * (&n + &1)`; `&n + &2`] in + WZ_PROVE ntm stm rtm ctm atm + *) + WZ_MAXIMA_PROVE ntm stm atm;; + +(* ------------------------------------------------------------------------- *) +(* Example 12. Dixon variant; A = B, p. 55. *) +(* ------------------------------------------------------------------------- *) + +let WZ_EXAMPLE_12 = + let ntm = `n:num` + and stm = + `sum UNIV + (\k. -- &1 spow &k * + (&(binom (a + n,a + k)) * &(binom (a + c,c + k)) * + &(binom (n + c,n + k))) / + (&(FACT (a + n + c)) / + (&(FACT a) * &(FACT n) * &(FACT c))))` + and atm = [] in + (* + let rtm = + `((&k + &a) * (&k + &c)) / + ((&n + &c + &a + &1) * (&n - &k + &1))` + and ctm = [`&2`; `-- &2`] in + WZ_PROVE ntm stm rtm ctm atm + *) + WZ_MAXIMA_PROVE ntm stm atm;; + +(* ------------------------------------------------------------------------- *) +(* Example 13. Alternating Chu-Vandermonde; A = B, p. 44. *) +(* ------------------------------------------------------------------------- *) + +let WZ_EXAMPLE_13 = + let ntm = `n:num` + and stm = + `sum UNIV + (\k. (-- &1 spow &k * &(binom (2 * n,k)) pow 2) / + (-- &1 spow &n * &(binom (2 * n,n))))` + and atm = [] in + (* + let rtm = + `(--(&k pow 2) * + (&10 * &n pow 2 - &6 * &k * &n + &17 * &n + + &k pow 2 - &5 * &k + &7)) / + ((&2 * &n - &k + &1) pow 2 * + (&2 * &n - &k + &2) pow 2)` + and ctm = [`&2`; `-- &2`] in + WZ_PROVE ntm stm rtm ctm atm + *) + WZ_MAXIMA_PROVE ntm stm atm;; + +(* ------------------------------------------------------------------------- *) +(* Example 14. First binomial moment; A = B, p. 55. *) +(* ------------------------------------------------------------------------- *) + +let WZ_EXAMPLE_14 = + let ntm = `n:num` + and stm = + `sum (0..n + 1) + (\k. &k * &(binom (n + 1,k)) / + ((&n + &1) * &2 spow &n))` + and atm = [] in + (* + let rtm = `(&k - &1) / (&2 * (&n - &k + &2))` + and ctm = [`&1`; `-- &1`] in + WZ_PROVE ntm stm rtm ctm atm + *) + WZ_MAXIMA_PROVE ntm stm atm;; + +(* ------------------------------------------------------------------------- *) +(* Example 15. A = B, p. 115. *) +(* ------------------------------------------------------------------------- *) + +let WZ_EXAMPLE_15 = + let ntm = `n:num` + and stm = + `sum (0..n + 1) + (\k. &(binom (n + 1 + k,2 * k)) * &(binom (2 * k,k)) * + -- &1 spow &k / (&k + &1))` + and atm = [] in + (* + let rtm = + `(-- &k * (&k + &1)) / ((&n + &1) pow 2 + &n + &1)` + and ctm = [`&1`] in + WZ_PROVE ntm stm rtm ctm atm + *) + WZ_MAXIMA_PROVE ntm stm atm;; + +(* ------------------------------------------------------------------------- *) +(* Example 16. Nemes et al., Monthly problem example, p. 512. *) +(* ------------------------------------------------------------------------- *) + +let WZ_EXAMPLE_16 = + let ntm = `n:num` + and stm = + `sum UNIV + (\k. ((&n + &2) / (&2 * &k + &1)) * + &(binom (n,2 * k)) * &2 spow (&n - &2 * &k - &1) * + &(binom (2 * k + 1,k)) / &(binom (2 * n + 1,n)))` + and atm = [] in + (* + let rtm = + `(&4 * &k * (&k + &1)) / + ((&n - &2 * &k + &1) * (&2 * &n + &3))` + and ctm = [`&1`; `-- &1`] in + WZ_PROVE ntm stm rtm ctm atm + *) + WZ_MAXIMA_PROVE ntm stm atm;; + +(* ------------------------------------------------------------------------- *) +(* Example 17. Nemes et al., Monthly problem example, p. 518. *) +(* ------------------------------------------------------------------------- *) + +let WZ_EXAMPLE_17 = + let ntm = `n:num` + and stm = + `sum UNIV + (\k. &(binom (2 * n + 1,2 * k)) * + &3 spow &k / &2 spow &n)` + and atm = [] in + (* + let rtm = + `(-- &k * (&2 * &k - &1) * + (&2 * &n pow 2 + &4 * &k * &n + &n - + &4 * &k pow 2 + &14 * &k - &7)) / + (&4 * (&n - &k + &1) * (&n - &k + &2) * + (&2 * &n - &2 * &k + &3) * + (&2 * &n - &2 * &k + &5))` + and ctm = [`&1`; `-- &4`; `&1`] in + WZ_PROVE ntm stm rtm ctm atm + *) + WZ_MAXIMA_PROVE ntm stm atm;; + +(* ------------------------------------------------------------------------- *) +(* Example 18. Alternative Franel sum; Koepf, p. 58. *) +(* ------------------------------------------------------------------------- *) + +let WZ_EXAMPLE_18 = + let ntm = `n:num` + and stm = + `sum (0..n) + (\k. &(binom (n,k)) pow 2 * &(binom (2 * k,n)))` + and atm = [] in + (* + let rtm = + `(--(&k pow 2) * (&n + &1) * (&n - &2 * &k) * + (&n - &2 * &k + &1) * (&3 * &n - &2 * &k + &6)) / + ((&n - &k + &1) pow 2 * (&n - &k + &2) pow 2)` + and ctm = + [`-- &8 * (&n + &1) pow 2`; + `--(&7 * &n pow 2 + &21 * &n + &16)`; + `(&n + &2) pow 2`] in + WZ_PROVE ntm stm rtm ctm atm + *) + WZ_MAXIMA_PROVE ntm stm atm;; + +(* ------------------------------------------------------------------------- *) +(* Example 19. Koepf, Exercise 6.7(g), p. 91. *) +(* ------------------------------------------------------------------------- *) + +let WZ_EXAMPLE_19 = + let ntm = `n:num` + and stm = + `sum (0..n) + (\k. -- &1 spow &k * &(binom (n,k)) * + &(binom (n + x,n)) * &x / (&k + &x))` + and atm = [`~(&x = &0)`] in + (* + let rtm = + `(&k * (&x + &k)) / ((&n + &1) * (&n - &k + &1))` + and ctm = [`&1`; `-- &1`] in + WZ_PROVE ntm stm rtm ctm atm + *) + WZ_MAXIMA_PROVE ntm stm atm;; + +(* ------------------------------------------------------------------------- *) +(* Example 20. Factorial-binomial recurrence. *) +(* ------------------------------------------------------------------------- *) + +let WZ_EXAMPLE_20 = + let ntm = `n:num` + and stm = + `sum (0..n) + (\k. &(binom (n,k)) * &(FACT k) * &(FACT k))` + and atm = [] in + (* + let rtm = + `(--(&n + &1) * (&n + &2)) / + ((&n - &k + &1) * (&n - &k + &2))` + and ctm = + [`(&n + &1) * (&n + &2)`; + `--((&n + &2) pow 2)`; + `&1`] in + WZ_PROVE ntm stm rtm ctm atm + *) + WZ_MAXIMA_PROVE ntm stm atm;; + +(* ------------------------------------------------------------------------- *) +(* Example 21. Generalized binomial theorem. *) +(* ------------------------------------------------------------------------- *) + +let WZ_EXAMPLE_21 = + let ntm = `n:num` + and stm = + `sum (0..n) + (\k. &(binom (n,k)) * x spow &k / (x + &1) spow &n)` + and atm = [`~(x + &1 = &0)`] in + (* + let rtm = `&k / ((&n - &k + &1) * (x + &1))` + and ctm = [`&1`; `-- &1`] in + WZ_PROVE ntm stm rtm ctm atm + *) + WZ_MAXIMA_PROVE ntm stm atm;; + +(* ------------------------------------------------------------------------- *) +(* Example 22. Gould, identity 1.89. *) +(* ------------------------------------------------------------------------- *) + +let WZ_EXAMPLE_22 = + let ntm = `n:num` + and stm = + `sum (0..n) (\k. &(binom (n,2 * k)) * &2 / &2 spow &n)` + and atm = [`~(n = 0)`] in + (* + let rtm = + `(&k * (&2 * &k - &1)) / (&n * (&n - &2 * &k + &1))` + and ctm = [`&1`; `-- &1`] in + WZ_PROVE ntm stm rtm ctm atm + *) + WZ_MAXIMA_PROVE ntm stm atm;; + +(* ------------------------------------------------------------------------- *) +(* Example 23. Gould, identity 1.91. *) +(* ------------------------------------------------------------------------- *) + +let WZ_EXAMPLE_23 = + let ntm = `n:num` + and stm = + `sum (0..n) + (\k. &(binom (2 * n + 1,2 * k + 1)) / + &2 spow (&2 * &n + &1))` + and atm = [] in + (* + let rtm = + `(-- &k * (&2 * &k + &1) * (&6 * &n - &4 * &k + &5)) / + (&4 * (&2 * &n + &1) * (&n - &k + &1) * + (&2 * &n - &2 * &k + &1))` + and ctm = [`-- &1`; `&1`] in + WZ_PROVE ntm stm rtm ctm atm + *) + WZ_MAXIMA_PROVE ntm stm atm;; + +(* ------------------------------------------------------------------------- *) +(* Example 24. Gould, identity 3.99. *) +(* ------------------------------------------------------------------------- *) + +let WZ_EXAMPLE_24 = + let ntm = `n:num` + and stm = + `sum (0..n) + (\k. (&(binom (n,2 * k)) * &(binom (2 * k,k)) * + &2 spow &n) / + (&4 spow &k * &(binom (2 * n,n))))` + and atm = [] in + (* + let rtm = + `(&4 * &k pow 2) / + ((&n - &2 * &k + &1) * (&2 * &n + &1))` + and ctm = [`&1`; `-- &1`] in + WZ_PROVE ntm stm rtm ctm atm + *) + WZ_MAXIMA_PROVE ntm stm atm;; + +(* ------------------------------------------------------------------------- *) +(* Example 25. Gould, identity 6.30. *) +(* ------------------------------------------------------------------------- *) + +let WZ_EXAMPLE_25 = + let ntm = `n:num` + and stm = + `sum (0..n) + (\k. &(binom (n,k)) pow 2 * &(binom (p + k,2 * n)) / + &(binom (p,n)) pow 2)` + and atm = [`n:num < p`] in + (* + let rtm = + `(--(&k pow 2) * (&p - &2 * &n + &k) * + (&3 * &n * &p - &2 * &k * &p + &3 * &p - + &4 * &n pow 2 + &3 * &k * &n - &5 * &n + &k - &1)) / + (&2 * (&n - &k + &1) pow 2 * (&2 * &n + &1) * + (&p - &n) pow 2)` + and ctm = [`-- &1`; `&1`] in + WZ_PROVE ntm stm rtm ctm atm + *) + WZ_MAXIMA_PROVE ntm stm atm;; + +(* ------------------------------------------------------------------------- *) +(* Example 26. Fourth-order Franel recurrence; Gould X.14. *) +(* ------------------------------------------------------------------------- *) + +let WZ_EXAMPLE_26 = + let ntm = `n:num` + and stm = `sum (0..n) (\k. &(binom (n,k)) pow 4)` + and atm = [] in + (* + let rtm = + `--(&k pow 4 * (&n + &1) * + (&75 * &n pow 6 - &260 * &k * &n pow 5 + &725 * &n pow 5 + + &374 * &k pow 2 * &n pow 4 - &2056 * &k * &n pow 4 + + &2885 * &n pow 4 - &276 * &k pow 3 * &n pow 3 + + &2314 * &k pow 2 * &n pow 3 - &6420 * &k * &n pow 3 + + &6045 * &n pow 3 + &104 * &k pow 4 * &n pow 2 - + &1244 * &k pow 3 * &n pow 2 + + &5298 * &k pow 2 * &n pow 2 - &9892 * &k * &n pow 2 + + &7030 * &n pow 2 - &16 * &k pow 5 * &n + + &298 * &k pow 4 * &n - &1844 * &k pow 3 * &n + + &5322 * &k pow 2 * &n - &7520 * &k * &n + &4300 * &n - + &20 * &k pow 5 + &210 * &k pow 4 - &900 * &k pow 3 + + &1980 * &k pow 2 - &2256 * &k + &1080)) / + ((&n - &k + &1) pow 4 * (&n - &k + &2) pow 4)` + and ctm = + [`-- &4 * (&n + &1) * (&4 * &n + &3) * (&4 * &n + &5)`; + `-- &2 * (&2 * &n + &3) * + (&3 * &n pow 2 + &9 * &n + &7)`; + `(&n + &2) pow 3`] in + WZ_PROVE ntm stm rtm ctm atm + *) + WZ_MAXIMA_PROVE ntm stm atm;; + +(* ------------------------------------------------------------------------- *) +(* Example 27. Bruckman identity, following Gould. *) +(* ------------------------------------------------------------------------- *) + +let WZ_EXAMPLE_27 = + let ntm = `n:num` + and stm = + `sum (0..n) + (\k. ((&2 * &n + &1) / &4 spow &n) * + &(binom (2 * n,n)) * -- &1 spow &k * + &(binom (n,k)) * &2 spow &k / (&2 * &k + &1))` + and atm = [] in + (* + let rtm = + `(&k * (&2 * &k + &1) * (&2 * &n + &3)) / + (&2 * (&n - &k + &1) * (&n - &k + &2))` + and ctm = [`&2 * &n + &3`; `&1`; `-- &2 * (&n + &2)`] in + WZ_PROVE ntm stm rtm ctm atm + *) + WZ_MAXIMA_PROVE ntm stm atm;; + +(* ------------------------------------------------------------------------- *) +(* Example 28. Sury, Corollary 2.2. *) +(* ------------------------------------------------------------------------- *) + +let WZ_EXAMPLE_28 = + let ntm = `n:num` + and stm = + `sum (0..n) + (\k. (&n + &m + &1) * &(binom (n + m,m)) * + -- &1 spow &k * &(binom (n,k)) / (&m + &k + &1))` + and atm = [] in + (* + let rtm = + `(&k * (&m + &k + &1)) / + ((&n - &k + &1) * (&n + &1))` + and ctm = [`&1`; `-- &1`] in + WZ_PROVE ntm stm rtm ctm atm + *) + WZ_MAXIMA_PROVE ntm stm atm;; + +(* ------------------------------------------------------------------------- *) +(* Example 29. Amdeberhan and De Angelis identity. *) +(* ------------------------------------------------------------------------- *) + +let WZ_EXAMPLE_29 = + let ntm = `n:num` + and stm = + `sum (0..n) + (\k. (&(binom (2 * n + 1,2 * k)) * + &(binom (2 * k,k)) / &4 spow &k) / + (&(binom (4 * n + 1,2 * n)) / &4 spow &n))` + and atm = [] in + (* + let rtm = + `(-- &2 * &k pow 2 * + (&12 * &n pow 2 - &8 * &k * &n + &30 * &n - + &10 * &k + &19)) / + ((&n - &k + &1) * (&2 * &n - &2 * &k + &3) * + (&4 * &n + &3) * (&4 * &n + &5))` + and ctm = [`-- &1`; `&1`] in + WZ_PROVE ntm stm rtm ctm atm + *) + WZ_MAXIMA_PROVE ntm stm atm;; + +(* ------------------------------------------------------------------------- *) +(* Example 30. Binomial convolution. *) +(* ------------------------------------------------------------------------- *) + +let WZ_EXAMPLE_30 = + let ntm = `n:num` + and stm = + `sum (0..n) + (\k. &(binom (n,k)) * &(binom (k,j)) / + (&(binom (n,j)) * &2 spow (&n - &j)))` + and atm = [`j:num <= n`] in + (* + let rtm = `(&k - &j) / (&2 * (&n - &k + &1))` + and ctm = [`&1`; `-- &1`] in + WZ_PROVE ntm stm rtm ctm atm + *) + WZ_MAXIMA_PROVE ntm stm atm;; + +(* ------------------------------------------------------------------------- *) +(* Example 31. Polya-Szego identity; Riordan, p. 5. *) +(* ------------------------------------------------------------------------- *) + +let WZ_EXAMPLE_31 = + let ntm = `n:num` + and stm = + `sum (0..n) + (\k. (-- &1 spow (&n - &k) * &4 spow &k * + &(binom (n + k + 1,2 * k + 1))) / (&n + &1))` + and atm = [] in + (* + let rtm = + `(&k * (&2 * &k + &1)) / + ((&n + &2) * (&n - &k + &1))` + and ctm = [`-- &1`; `&1`] in + WZ_PROVE ntm stm rtm ctm atm + *) + WZ_MAXIMA_PROVE ntm stm atm;; + +(* ------------------------------------------------------------------------- *) +(* Example 32. Riordan, p. 10. *) +(* ------------------------------------------------------------------------- *) + +let WZ_EXAMPLE_32 = + let ntm = `n:num` + and stm = + `sum (0..n) + (\k. -- &1 spow (&k + &d) * &(binom (d,k)) * + &(binom (n + k,p + k)) / &(binom (n,p + d)))` + and atm = [`p + d:num <= n`] in + (* + let rtm = + `(-- &k * (&p + &k)) / ((&n + &1) * (&p - &n - &1))` + and ctm = [`-- &1`; `&1`] in + WZ_PROVE ntm stm rtm ctm atm + *) + WZ_MAXIMA_PROVE ntm stm atm;; + +(* ------------------------------------------------------------------------- *) +(* Example 33. Riordan, p. 15, identity (10). *) +(* ------------------------------------------------------------------------- *) + +let WZ_EXAMPLE_33 = + let ntm = `n:num` + and stm = + `sum UNIV + (\k. &(binom (p,k)) * &(binom (q,k)) * + &(binom (n + k,p + q)) / + (&(binom (n,p)) * &(binom (n,q))))` + and atm = [`p:num <= n`; `q:num <= n`] in + (* + let rtm = `&k pow 2 / (&n + &1) pow 2` + and ctm = [`-- &1`; `&1`] in + WZ_PROVE ntm stm rtm ctm atm + *) + WZ_MAXIMA_PROVE ntm stm atm;; + +(* ------------------------------------------------------------------------- *) +(* Example 34. Riordan, p. 36. *) +(* ------------------------------------------------------------------------- *) + +let WZ_EXAMPLE_34 = + let ntm = `n:num` + and stm = + `sum (0..n) + (\k. &(binom (2 * n + 1,2 * k)) * + &(binom (m + k,2 * n)) / + &(binom (2 * m + 1,2 * n)))` + and atm = [`n:num < m`] in + (* + let rtm = + `(&k * (&2 * &k - &1) * (&2 * &n - &m - &k) * + (&8 * &n pow 2 - &6 * &m * &n - &6 * &k * &n + + &10 * &n + &4 * &k * &m - &7 * &m - &k + &1)) / + (&2 * (&n - &k + &1) * (&n - &m) * + (&2 * &n - &2 * &k + &3) * (&2 * &n - &2 * &m - &1) * + (&2 * &n + &1))` + and ctm = [`&1`; `-- &1`] in + WZ_PROVE ntm stm rtm ctm atm + *) + WZ_MAXIMA_PROVE ntm stm atm;; + +(* ------------------------------------------------------------------------- *) +(* Example 35. Gould, identity 1.45. *) +(* ------------------------------------------------------------------------- *) + +let WZ_EXAMPLE_35 = + let ntm = `n:num` + and stm = + `sum UNIV + (\k. -- &1 spow (&k + &1) * + &(binom (n,k + 1)) / (&k + &1))` + and atm = [`~(&n = &0)`] in + (* + let rtm = `(&k + &1) pow 2 / (&n - &k)` + and ctm = [`&n + &1`; `--(&n + &1)`] in + WZ_PROVE ntm stm rtm ctm atm + *) + WZ_MAXIMA_PROVE ntm stm atm;; + +(* ------------------------------------------------------------------------- *) +(* Example 36. Gould, identity 1.94. *) +(* ------------------------------------------------------------------------- *) + +let WZ_EXAMPLE_36 = + let ntm = `n:num` + and stm = + `sum (0..n) + (\k. -- &1 spow &k * &(binom (2 * n + 1,2 * k)))` + and atm = [] in + (* + let rtm = + `(-- &k * (&2 * &k - &1) * + (&10 * &n pow 2 - &12 * &k * &n + &37 * &n + + &4 * &k pow 2 - &22 * &k + &33)) / + ((&n - &k + &1) * (&n - &k + &2) * + (&2 * &n - &2 * &k + &3) * + (&2 * &n - &2 * &k + &5))` + and ctm = [`&4`; `&0`; `&1`] in + WZ_PROVE ntm stm rtm ctm atm + *) + WZ_MAXIMA_PROVE ntm stm atm;; + +(* ------------------------------------------------------------------------- *) +(* Example 37. Gould, identity 1.100. *) +(* ------------------------------------------------------------------------- *) + +let WZ_EXAMPLE_37 = + let ntm = `n:num` + and stm = + `sum (0..n) + (\k. &(binom (2 * n + 1,2 * k + 1)) * &k / + ((&2 * &n - &1) * &4 spow (&n - &1)))` + and atm = [] in + (* + let rtm = + `((&k - &1) * (&2 * &k + &1) * + (&6 * &n pow 2 - &4 * &k * &n + &7 * &n - + &2 * &k + &1)) / + (&4 * (&n - &k + &1) * (&2 * &n + &1) * + (&2 * &n - &2 * &k + &1))` + and ctm = [`&n`; `-- &n`] in + WZ_PROVE ntm stm rtm ctm atm + *) + WZ_MAXIMA_PROVE ntm stm atm;; + +(* ------------------------------------------------------------------------- *) +(* Example 38. Gould, identity 3.34. *) +(* ------------------------------------------------------------------------- *) + +let WZ_EXAMPLE_38 = + let ntm = `n:num` + and stm = + `sum (:num) + (\k. (-- &1 spow &k * &(binom (x,k)) * + rbinom (&x,&2 * &n - &k)) / + (-- &1 spow &n * &(binom (x,n))))` + and atm = [`n:num < x`] in + (* + let rtm = + `(&k * (&x + &1) * (&x - &2 * &n + &k)) / + ((&2 * &n - &k + &1) * (&2 * &n - &k + &2) * + (&x - &n))` + and ctm = [`-- &2`; `&2`] in + WZ_PROVE ntm stm rtm ctm atm + *) + WZ_MAXIMA_PROVE ntm stm atm;; + +(* ------------------------------------------------------------------------- *) +(* Example 39. Gould, identity 7.12. *) +(* ------------------------------------------------------------------------- *) + +let WZ_EXAMPLE_39 = + let ntm = `n:num` + and stm = + `sum (0..n) + (\k. (&n * -- &1 spow &k * &(binom (n,k)) * + &(binom (n + k,k)) * &4 spow &k) / + (-- &1 spow &n * &(binom (2 * k,k)) * + (&n + &k)))` + and atm = [`0 < n`] in + (* + let rtm = + `(&k * (&2 * &k - &1)) / (&n * (&n - &k + &1))` + and ctm = [`-- &1`; `&1`] in + WZ_PROVE ntm stm rtm ctm atm + *) + WZ_MAXIMA_PROVE ntm stm atm;; + +(* ------------------------------------------------------------------------- *) +(* Example 40. Gould, identity 3.106. *) +(* ------------------------------------------------------------------------- *) + +let WZ_EXAMPLE_40 = + let ntm = `n:num` + and stm = + `sum (0..2 * n) + (\k. (-- &1 spow &k * &(binom (2 * n,k)) * + &(binom (2 * n + 2 * k,n + k)) * + &2 spow (&2 * &n - &k)) / + &(binom (2 * n,n)))` + and atm = [] in + (* + let rtm = + `--(&32 * &k * (&n + &1) pow 2 * + (&250 * &k * &n pow 4 - &250 * &n pow 4 + + &270 * &k pow 2 * &n pow 3 + &1015 * &k * &n pow 3 - + &1275 * &n pow 3 + &15 * &k pow 3 * &n pow 2 + + &1016 * &k pow 2 * &n pow 2 + + &1393 * &k * &n pow 2 - &2385 * &n pow 2 - + &5 * &k pow 4 * &n + &57 * &k pow 3 * &n + + &1195 * &k pow 2 * &n + &737 * &k * &n - &1940 * &n - + &9 * &k pow 4 + &54 * &k pow 3 + &431 * &k pow 2 + + &112 * &k - &576)) / + ((&n + &k + &1) * (&2 * &n - &k + &1) * + (&2 * &n - &k + &2) * (&2 * &n - &k + &3) * + (&2 * &n - &k + &4))` + and ctm = + [`&32 * (&n + &1) pow 2 * (&5 * &n + &9)`; + `--(&4 * + (&145 * &n pow 3 + &551 * &n pow 2 + &665 * &n + &256))`; + `&3 * (&3 * &n + &4) * (&3 * &n + &5) * (&5 * &n + &4)`] in + WZ_PROVE ntm stm rtm ctm atm + *) + WZ_MAXIMA_PROVE ntm stm atm;; + +(* ------------------------------------------------------------------------- *) +(* Example 41. Gould, identity 3.48. *) +(* ------------------------------------------------------------------------- *) + +let WZ_EXAMPLE_41 = + let ntm = `n:num` + and stm = + `sum (0..n) + (\k. (-- &1 spow &k * &(binom (n,k)) * + &(binom (x + k,r + k))) / + (-- &1 spow &n * &(binom (x,n + r))))` + and atm = [`n + r:num < x`] in + (* + let rtm = + `(&k * (&r + &k)) / + ((&n - &k + &1) * (&x - &r - &n))` + and ctm = [`-- &1`; `&1`] in + WZ_PROVE ntm stm rtm ctm atm + *) + WZ_MAXIMA_PROVE ntm stm atm;; + +(* ------------------------------------------------------------------------- *) +(* Example 42. Gould, identity 6.37. *) +(* ------------------------------------------------------------------------- *) + +let WZ_EXAMPLE_42 = + let ntm = `n:num` + and stm = + `sum (0..n) + (\k. (&(binom (n,k)) pow 2 * + &(binom (3 * n + k,2 * n))) / + &(binom (3 * n,n)) pow 2)` + and atm = [] in + (* + let rtm = + `--(&k pow 2 * + (&207 * &n pow 4 + &66 * &k * &n pow 3 + + &468 * &n pow 3 - &145 * &k pow 2 * &n pow 2 + + &294 * &k * &n pow 2 + &340 * &n pow 2 - + &186 * &k pow 2 * &n + &294 * &k * &n + &78 * &n - + &59 * &k pow 2 + &84 * &k - &1)) / + (&9 * (&n - &k + &1) pow 2 * (&3 * &n + &1) pow 2 * + (&3 * &n + &2) pow 2)` + and ctm = [`-- &1`; `&1`] in + WZ_PROVE ntm stm rtm ctm atm + *) + WZ_MAXIMA_PROVE ntm stm atm;; diff --git a/WZ/make.ml b/WZ/make.ml new file mode 100644 index 00000000..b914f6a8 --- /dev/null +++ b/WZ/make.ml @@ -0,0 +1,7 @@ +(* ========================================================================= *) +(* Load the HOL Light implementation of the Wilf-Zeilberger method. *) +(* ========================================================================= *) + +loadt "WZ/wz.ml";; +loadt "WZ/maxima.ml";; +loadt "WZ/examples.ml";; diff --git a/WZ/maxima.ml b/WZ/maxima.ml new file mode 100644 index 00000000..14ebb777 --- /dev/null +++ b/WZ/maxima.ml @@ -0,0 +1,254 @@ +(* ========================================================================= *) +(* Untrusted Maxima certificate generation for the WZ method. *) +(* ========================================================================= *) + +needs "WZ/wz.ml";; + +(* ------------------------------------------------------------------------- *) +(* Translate the supported fragment of HOL terms to Maxima syntax. *) +(* ------------------------------------------------------------------------- *) + +let wz_maxima_binops = + [(`(+):num->num->num`,"+"); + (`(-):num->num->num`,"-"); + (`( * ):num->num->num`,"*"); + (`(+):real->real->real`,"+"); + (`(-):real->real->real`,"-"); + (`( * ):real->real->real`,"*"); + (`(/):real->real->real`,"/"); + (`(EXP):num->num->num`,"^"); + (`(pow):real->num->real`,"^"); + (`(spow):real->real->real`,"^")];; + +let wz_maxima_real_of_num = `(&):num->real` +and wz_maxima_neg = `(--) :real->real` +and wz_maxima_binom = `binom:num#num->num` +and wz_maxima_rbinom = `rbinom:real#real->real` +and wz_maxima_fact = `FACT:num->num`;; + +let wz_maxima_name s = + if s <> "" && + forall (fun c -> isalnum c || c = "_") (explode s) && + not(isnum(hd(explode s))) + then s + else failwith("wz_maxima_name: unsupported variable name " ^ s);; + +let rec wz_maxima_string_of_term tm = + if is_ratconst tm then + "(" ^ string_of_num(rat_of_term tm) ^ ")" + else if is_numeral tm then + string_of_num(dest_numeral tm) + else if is_var tm then + wz_maxima_name(fst(dest_var tm)) + else if is_comb tm && rator tm = wz_maxima_real_of_num then + wz_maxima_string_of_term(rand tm) + else if is_comb tm && rator tm = wz_maxima_neg then + "-(" ^ wz_maxima_string_of_term(rand tm) ^ ")" + else if is_comb tm && rator tm = wz_maxima_fact then + "factorial(" ^ wz_maxima_string_of_term(rand tm) ^ ")" + else if is_comb tm && rator tm = wz_maxima_binom then + let l,r = dest_pair(rand tm) in + "binomial(" ^ wz_maxima_string_of_term l ^ "," ^ + wz_maxima_string_of_term r ^ ")" + else if is_comb tm && rator tm = wz_maxima_rbinom then + let l,r = dest_pair(rand tm) in + "binomial(" ^ wz_maxima_string_of_term l ^ "," ^ + wz_maxima_string_of_term r ^ ")" + else + tryfind + (fun (op,s) -> + let l,r = dest_binop op tm in + "(" ^ wz_maxima_string_of_term l ^ s ^ + wz_maxima_string_of_term r ^ ")") + wz_maxima_binops;; + +(* ------------------------------------------------------------------------- *) +(* Parse Maxima rational expressions and lists into HOL terms. *) +(* ------------------------------------------------------------------------- *) + +type wz_maxima_object = + Wzterm of term + | Wzlist of wz_maxima_object list;; + +let wz_maxima_tokens s = + map (function Ident s -> s | Resword s -> s) (lex(explode s));; + +let wz_maxima_mk_pow x y = + try + let op,n = dest_comb y in + if op = wz_maxima_real_of_num && is_numeral n + then mk_binop `(pow):real->num->real` x n + else fail() + with Failure _ -> + failwith "wz_maxima_mk_pow: non-natural exponent";; + +let wz_maxima_mk_neg x = + try + let l,r = dest_binop `(/):real->real->real` x in + mk_binop `(/):real->real->real` (mk_comb(wz_maxima_neg,l)) r + with Failure _ -> mk_comb(wz_maxima_neg,x);; + +let rec wz_maxima_parse_expression inp = + wz_maxima_parse_sum inp +and wz_maxima_parse_sum inp = + let x,rst = wz_maxima_parse_difference inp in + match rst with + "+"::rst' -> + let y,rst'' = wz_maxima_parse_sum rst' in + mk_binop `(+):real->real->real` x y,rst'' + | _ -> x,rst +and wz_maxima_parse_difference inp = + let x,rst = wz_maxima_parse_product inp in + wz_maxima_parse_difference_tail x rst +and wz_maxima_parse_difference_tail x inp = + match inp with + "-"::rst -> + let y,rst' = wz_maxima_parse_product rst in + wz_maxima_parse_difference_tail + (mk_binop `(-):real->real->real` x y) rst' + | _ -> x,inp +and wz_maxima_parse_product inp = + let x,rst = wz_maxima_parse_quotient inp in + match rst with + "*"::rst' -> + let y,rst'' = wz_maxima_parse_product rst' in + mk_binop `( * ):real->real->real` x y,rst'' + | _ -> x,rst +and wz_maxima_parse_quotient inp = + let x,rst = wz_maxima_parse_unary inp in + wz_maxima_parse_quotient_tail x rst +and wz_maxima_parse_quotient_tail x inp = + match inp with + "/"::rst -> + let y,rst' = wz_maxima_parse_unary rst in + wz_maxima_parse_quotient_tail + (mk_binop `(/):real->real->real` x y) rst' + | _ -> x,inp +and wz_maxima_parse_unary inp = + match inp with + "-"::rst -> + let x,rst' = wz_maxima_parse_unary rst in + wz_maxima_mk_neg x,rst' + | _ -> wz_maxima_parse_power inp +and wz_maxima_parse_power inp = + let x,rst = wz_maxima_parse_atom inp in + match rst with + "^"::rst' -> + let y,rst'' = wz_maxima_parse_unary rst' in + wz_maxima_mk_pow x y,rst'' + | _ -> x,rst +and wz_maxima_parse_atom inp = + match inp with + "("::rst -> + let x,rst' = wz_maxima_parse_expression rst in + (match rst' with + ")"::rst'' -> x,rst'' + | _ -> failwith "wz_maxima_parse_atom: expected )") + | s::rst when s <> "" && forall isnum (explode s) -> + term_of_rat(num_of_string s),rst + | s::rst when s <> "" && + forall (fun c -> isalnum c || c = "_") (explode s) -> + mk_var(wz_maxima_name s,`:real`),rst + | _ -> failwith "wz_maxima_parse_atom: expression expected";; + +let rec wz_maxima_parse_object inp = + match inp with + "["::"]"::rst -> Wzlist [],rst + | "["::rst -> + let x,rst' = wz_maxima_parse_object rst in + wz_maxima_parse_list [x] rst' + | _ -> + let x,rst = wz_maxima_parse_expression inp in + Wzterm x,rst +and wz_maxima_parse_list acc inp = + match inp with + ","::rst -> + let x,rst' = wz_maxima_parse_object rst in + wz_maxima_parse_list (x::acc) rst' + | "]"::rst -> Wzlist(rev acc),rst + | _ -> failwith "wz_maxima_parse_list: expected , or ]";; + +let wz_maxima_certificate_of_string s = + let obj,rst = wz_maxima_parse_object(wz_maxima_tokens s) in + if rst <> [] then failwith "wz_maxima_certificate_of_string: trailing input" + else + match obj with + Wzlist + (Wzlist + [Wzterm r; + Wzlist cs]::_) -> + let dest = function + Wzterm c -> c + | _ -> failwith + "wz_maxima_certificate_of_string: bad coefficient" in + r,map dest cs + | _ -> failwith "wz_maxima_certificate_of_string: bad result";; + +(* ------------------------------------------------------------------------- *) +(* Run Maxima and extract the marked certificate output. *) +(* ------------------------------------------------------------------------- *) + +let wz_maxima_executable = ref "maxima";; + +let wz_maxima_output input = + let marker = "__HOL_LIGHT_WZ_RESULT__" in + let infile = Filename.temp_file "hol_wz" ".mac" + and outfile = Filename.temp_file "hol_wz" ".out" in + let cleanup () = + if Sys.file_exists infile then Sys.remove infile; + if Sys.file_exists outfile then Sys.remove outfile in + let marker_length = String.length marker in + let rec extract = function + [] -> failwith "wz_maxima_output: output marker not found" + | h::t -> + if String.length h >= marker_length && + String.sub h 0 marker_length = marker + then String.sub h marker_length (String.length h - marker_length) + else extract t in + try + file_of_string infile + ("display2d:false$\n" ^ + "linel:100000$\n" ^ + "load(zeilberger)$\n" ^ + "printf(true,\"" ^ marker ^ "~a~%\"," ^ input ^ ")$\n" ^ + "quit()$\n"); + let command = + Filename.quote !wz_maxima_executable ^ + " --very-quiet --batch=" ^ Filename.quote infile ^ + " >" ^ Filename.quote outfile ^ " 2>&1" in + if Sys.command command <> 0 then + let output = string_of_file outfile in + failwith("wz_maxima_output: Maxima failed\n" ^ output) + else + let output = extract(strings_of_file outfile) in + cleanup(); output + with exn -> cleanup(); raise exn;; + +(* ------------------------------------------------------------------------- *) +(* Generate a certificate, then prove the recurrence using the HOL checker. *) +(* ------------------------------------------------------------------------- *) + +let WZ_MAXIMA_CERTIFICATE ntm stm = + let ktm,bod = dest_abs(rand stm) in + let command = + "Zeilberger(" ^ wz_maxima_string_of_term bod ^ "," ^ + wz_maxima_string_of_term ktm ^ "," ^ + wz_maxima_string_of_term ntm ^ ")" in + let rtm,ctm = + wz_maxima_certificate_of_string(wz_maxima_output command) in + let variables = setify(ktm::frees stm) in + let instantiations = + map + (fun v -> + let name,ty = dest_var v in + let replacement = + if ty = `:num` then mk_comb(wz_maxima_real_of_num,v) + else if ty = `:real` then v + else failwith "WZ_MAXIMA_CERTIFICATE: unsupported variable type" in + replacement,mk_var(name,`:real`)) + variables in + subst instantiations rtm,map (subst instantiations) ctm;; + +let WZ_MAXIMA_PROVE ntm stm atm = + let rtm,ctm = WZ_MAXIMA_CERTIFICATE ntm stm in + WZ_PROVE ntm stm rtm ctm atm;; diff --git a/WZ/nonexamples.ml b/WZ/nonexamples.ml new file mode 100644 index 00000000..caf51a3a --- /dev/null +++ b/WZ/nonexamples.ml @@ -0,0 +1,408 @@ +(* ========================================================================= *) +(* Incomplete or unsupported examples for the HOL Light WZ implementation. *) +(* ========================================================================= *) + +(* These are possible future extensions, not executable regression tests. *) +(* The reasons they are not handled are recorded with each candidate. *) + +(* ------------------------------------------------------------------------- *) +(* Nonexample 1. A = B, p. 78. *) +(* ------------------------------------------------------------------------- *) + +(* The summand (&4 * &k + &1) * &(FACT k) / &(FACT (2 * k + 1)) does not *) +(* have finite support, so the original certificate was not passed to the *) +(* checker. *) + +(* ------------------------------------------------------------------------- *) +(* Nonexample 2. Nemes et al., Monthly problem example, p. 518. *) +(* ------------------------------------------------------------------------- *) + +(* The original checker run deliberately stops before theorem extraction: *) +(* The quotient below does not have finite support over UNIV. *) +(* +let stm = + `sum UNIV + (\k. -- &1 spow &k * + &(binom (4 * n,2 * k)) / &(binom (2 * n,k)))` +and rtm = `(&1 - &2 * &k) / (&4 * &n - &2)` +and ctm = [`&1`];; +*) + +(* ------------------------------------------------------------------------- *) +(* Nonexample 3. Gould, identity 2.8. *) +(* ------------------------------------------------------------------------- *) + +(* The original certificate has a pole at k = 0 and was not submitted to *) +(* the checker. *) +(* +let stm = + `sum (0..n) + (\k. -- &1 spow &k * &k / &(binom (2 * n,k)) * + (&n + &1) / &n)` +and rtm = + `((&2 * &n - &k + &1) * + ((&2 * &n + &3) - + &k * (&4 * &n pow 2 + &10 * &n + &6))) / + ((&4 * &n pow 2 + &10 * &n + &6) * + (&2 * &n + &3) * &k)` +and ctm = [`&1`];; +*) + +(* ------------------------------------------------------------------------- *) +(* Nonexample 4. Gould, identity 4.9. *) +(* ------------------------------------------------------------------------- *) + +(* The denominator binomial can vanish inside the intended range, so the *) +(* original side-condition proof was left unfinished. *) +(* +let stm = + `sum (0..n + 1) + (\k. &(binom (n + 1,k)) / &(binom (2 * n + 1,k)))` +and rtm = `(&k - &2 * &n - &2) / (&n + &1)` +and ctm = [`&1`];; +*) + +(* ------------------------------------------------------------------------- *) +(* Nonexample 5. Gould, identity 22.2. *) +(* ------------------------------------------------------------------------- *) + +(* This very large certificate was used only for initial reduction in the *) +(* original. A binomial in the denominator can vanish, and completing the *) +(* side conditions was both unsupported and prohibitively expensive. *) +(* +let stm = + `sum (0..2 * n) + (\k. (-- &1 spow &k * &(binom (2 * n,k)) pow 4 * + &(binom (3 * n + k,k)) / &(binom (5 * n,k))) / + (-- &1 spow &n * &(binom (3 * n,n)) pow 3 * + (&(FACT (4 * n)) * &(FACT (2 * n))) / + (&(FACT (5 * n)) * &(FACT n))))`;; +*) + +(* ------------------------------------------------------------------------- *) +(* Nonexample 6. Riordan, p. 42. *) +(* ------------------------------------------------------------------------- *) + +(* The original asks how to prove that this sum is zero after obtaining a *) +(* recurrence; no HOL summand or certificate was recorded. *) +(* + Zeilberger((-1)^k * binomial(2 * n + 1,k)^3,k,n); +*) + +(* ------------------------------------------------------------------------- *) +(* Nonexample 7. Riordan, p. 144. *) +(* ------------------------------------------------------------------------- *) + +(* The first formulation has a binomial with a subtractive upper argument. *) +(* The change of variables below avoids it, but the original checker run was *) +(* still left inside an unfinished experiment. *) +(* +let stm = + `sum (0..n) + (\k. &(binom (n,k)) pow 2 * &(binom (2 * n + k,2 * n)) / + &(binom (2 * n,n)) pow 2)` +and rtm = + `--(&k pow 3 * + (&30 * &n pow 2 - &21 * &k * &n + &49 * &n - + &13 * &k + &19)) / + (&8 * (&n - &k + &1) pow 2 * (&2 * &n + &1) pow 3)` +and ctm = [`-- &1`; `&1`];; +*) + +(* ------------------------------------------------------------------------- *) +(* Nonexample 8. Generalized Apery recurrence (Strehl). *) +(* ------------------------------------------------------------------------- *) + +(* Maxima did not find the expected order-six recurrence. *) +(* + Zeilberger(binomial(n,k)^3 * binomial(n + k,k)^3,k,n); +*) + +(* ------------------------------------------------------------------------- *) +(* Nonexample 9. Srivastava, generalization of a Vietoris identity. *) +(* ------------------------------------------------------------------------- *) + +(* The proposed formulation uses rbinom to express a subtractive argument, *) +(* so it is outside the fragment translated by maxima.ml. *) +(* +let stm = + `sum UNIV + (\k. &(binom (p + k,k)) * + rbinom (&m + &n - &p - &k - &1,&n - &k) / + &(binom (m + n,n)))` +and rtm = + `(&k * (&p - &n - &m + &k)) / + ((&n - &k + &1) * (&n + &m + &1))` +and ctm = [`-- &1`; `&1`];; +*) + +(* ------------------------------------------------------------------------- *) +(* Nonexample 10. Gould, identity 1.59. *) +(* ------------------------------------------------------------------------- *) + +(* Initial reduction succeeded for a third-order recurrence, but the side *) +(* conditions were too slow and no theorem was obtained. *) +(* +let stm = + `sum (0..n) (\k. &(binom (4 * n,4 * k)) / &4 spow &k)`;; +*) + +(* ------------------------------------------------------------------------- *) +(* Nonexample 11. A = B, Quick Start. *) +(* ------------------------------------------------------------------------- *) + +(* The proposed identity has unresolved finite-support and subtraction *) +(* issues; the original contains only the Maxima input. *) +(* + Zeilberger((-1)^k * binomial(x - k + 1,k) * + binomial(x - 2 * k,n - k),k,n); +*) + +(* ------------------------------------------------------------------------- *) +(* Nonexample 12. A = B, Exercise 2.7(2c). *) +(* ------------------------------------------------------------------------- *) + +(* This proposed normalization did not produce the expected identity. *) +(* + Zeilberger(binomial(x + 1,2 * k + 1) * + binomial(x - 2 * k,n - k) / + binomial(2 * x + 2,2 * n + 1),k,n); +*) + +(* ------------------------------------------------------------------------- *) +(* Nonexample 13. A = B, Example 3.6.2. *) +(* ------------------------------------------------------------------------- *) + +(* Maxima can generate a recurrence, but finite support was not established. *) +(* + Zeilberger((-1)^k * binomial(2 * n,k) * binomial(2 * k,k) * + binomial(4 * n - 2 * k,2 * n - k) / + binomial(2 * n,n)^2,k,n); +*) + +(* ------------------------------------------------------------------------- *) +(* Nonexample 14. A = B, Example 6.4.3. *) +(* ------------------------------------------------------------------------- *) + +(* Initial reduction succeeds, but the side-condition tactic does not finish *) +(* the proof because of the subtractive rbinom argument. *) +(* +let stm = + `sum (0..n + 1) + (\k. -- &1 spow &k * &(binom (n + 1,k)) * + rbinom (&2 * &n + &1 - &2 * &k,&n))` +and rtm = + `--(&2 * &k * (&n - &k + &1) * + (&2 * &n - &2 * &k + &3) * + (&3 * &n - &2 * &k + &6)) / + ((&n + &1) * (&n - &2 * &k + &2) * (&n - &k + &2))` +and ctm = [`--(&n + &2)`; `&n + &2`];; +*) + +(* ------------------------------------------------------------------------- *) +(* Nonexample 15. A = B, Exercise 6.6(1e). *) +(* ------------------------------------------------------------------------- *) + +(* Only Maxima input was recorded; natural subtraction prevents a direct *) +(* encoding in the supported fragment. *) +(* + Zeilberger((-1)^k * binomial(n - k,k) * + 2^(n - 2 * k) / (n + 1),k,n); +*) + +(* ------------------------------------------------------------------------- *) +(* Nonexample 16. A = B, pp. 130-131. *) +(* ------------------------------------------------------------------------- *) + +(* This companion identity needs support for a quotient whose summation *) +(* range is not represented by the current tactic. *) +(* + Zeilberger((binomial(k,n) / binomial(k + a + 1,k)) / + ((a + 1) / ((n + 1) * binomial(a,n + 1))),k,n); +*) + +(* ------------------------------------------------------------------------- *) +(* Nonexample 17. Non-proper hypergeometric pattern. *) +(* ------------------------------------------------------------------------- *) + +(* The generic summand, and the concrete specialization tried in the *) +(* original, are rejected as non-proper hypergeometric terms. *) +(* + Zeilberger(binomial(t * k + r,k) * + binomial(t * (n - k) + s,n - k) * + (r / (t * k + r)) / + binomial(t * n + r + s,n),k,n); + + Zeilberger((binomial(3 * k + 1,k) * + binomial(3 * n - 3 * k,n - k) / (3 * k + 1)) / + binomial(3 * n + 1,n),k,n); +*) + +(* ------------------------------------------------------------------------- *) +(* Nonexample 18. AMM 103, p. 702, Problem 10332. *) +(* ------------------------------------------------------------------------- *) + +(* Only the proposed Maxima input was recorded. *) +(* + Zeilberger(2^(n - m - 2 * k) * binomial(n,k) * + binomial(n - k,k + m) / + binomial(2 * n,m + n),k,n); +*) + +(* ------------------------------------------------------------------------- *) +(* Nonexample 19. AMM 102, p. 70, Problem 10424. *) +(* ------------------------------------------------------------------------- *) + +(* Maxima gives a high-order recurrence, but the intended WZ normalization *) +(* and the subtractive arguments were not resolved. *) +(* + Zeilberger(2^k * (n / (n - k)) * + binomial(n - k,2 * k),k,n); +*) + +(* ------------------------------------------------------------------------- *) +(* Nonexample 20. Finite Pascal sum. *) +(* ------------------------------------------------------------------------- *) + +(* This identity needs explicit summation limits rather than the finite- *) +(* support argument used by the current implementation. *) +(* + !n. sum (0..n) (\k. &(binom (n + k,k)) / &2 pow (n + k)) = &1 +*) + +(* ------------------------------------------------------------------------- *) +(* Nonexample 21. Generalized finite Pascal sum. *) +(* ------------------------------------------------------------------------- *) + +(* This generalization of the preceding identity also needs explicit limits. *) +(* + !n m. + sum (0..n) (\k. &(binom (m + n,m + k)) / &2 pow (m + n)) = + sum (0..n) + (\k. &(binom ((m + k) - 1,m - 1)) / &2 pow (m + k)) +*) + +(* ------------------------------------------------------------------------- *) +(* Nonexample 22. AMM 99, p. 63, Problem E3376. *) +(* ------------------------------------------------------------------------- *) + +(* This is a double sum requiring a separate adaptation of Zeilberger's *) +(* method; no single-sum certificate was recorded. *) +(* + !N. nsum (0..N) + (\i. nsum (0..N) + (\j. binom (i + j,j) EXP 2 * + binom (2 * N - 2 * i - 2 * j,2 * N - 2 * j))) = + (2 * N + 1) * binom (2 * N,N) pow 2 +*) + +(* ------------------------------------------------------------------------- *) +(* Nonexample 23. Abramov Gosper counterexample. *) +(* ------------------------------------------------------------------------- *) + +(* This deliberate Gosper counterexample does not have finite support. *) +(* +let stm = + `sum (0..n) (\k. &(binom (2 * k - 1,k)) / &4 spow &k)` +and rtm = `&2 * &k` +and ctm = [`&1`];; +*) + +(* ------------------------------------------------------------------------- *) +(* Nonexample 24. Abel binomial identity; Riordan, p. 18. *) +(* ------------------------------------------------------------------------- *) + +(* Maxima classifies Abel's binomial generalization as non-proper *) +(* hypergeometric. *) +(* + Zeilberger(binomial(n,k) * (x + k)^(k - 1) * + (y + n - k)^(n - k) * x / (x + y + n)^n,k,n); +*) + +(* ------------------------------------------------------------------------- *) +(* Nonexample 25. Riordan, p. 41, Exercise 22. *) +(* ------------------------------------------------------------------------- *) + +(* The original side-condition proof made substantial progress but did not *) +(* finish. *) +(* +let stm = + `sum (:num) + (\k. &(binom (p + k,q)) * &(binom (q,k)) * + &(binom (n,p + k)) / + (&(binom (n,p)) * &(binom (n,q))))` +and rtm = + `(&k * (&q - &p - &k)) / + ((&n + &1) * (&p - &n + &k - &1))` +and ctm = [`&1`; `-- &1`];; +*) + +(* ------------------------------------------------------------------------- *) +(* Nonexample 26. Gould, identity 1.14. *) +(* ------------------------------------------------------------------------- *) + +(* Maxima classifies this summand as non-proper hypergeometric. *) +(* + Zeilberger((-1)^k * binomial(n,k) * (x - k)^(n + 1) / + (factorial(n + 1) * (2 * x - n) / 2),k,n); +*) + +(* ------------------------------------------------------------------------- *) +(* Nonexample 27. Gould, identity 3.30. *) +(* ------------------------------------------------------------------------- *) + +(* Both original formulations leave unresolved denominator conditions. *) +(* +let stm = + `sum (0..n + 1) + (\k. &(binom (n + 1,k)) * &(binom (x,k)) * &k / + ((&n + &1) * &(binom (x + n,n + 1))))` +and rtm = + `((&k - &1) * &k) / + ((&n - &k + &2) * (&x + &n + &1))` +and ctm = [`&1`; `-- &1`];; +*) + +(* ------------------------------------------------------------------------- *) +(* Nonexample 28. Gould, identity 3.118. *) +(* ------------------------------------------------------------------------- *) + +(* This normalized binomial theorem also leaves unresolved side conditions. *) +(* +let stm = + `sum (0..n) + (\k. &(binom (n,k)) * &(binom (k,j)) * x pow k / + (&(binom (n,j)) * x spow &j * + (&1 + x) spow (&n - &j)))` +and rtm = `(&k - &j) / ((&n - &k + &1) * (x + &1))` +and ctm = [`&1`; `-- &1`];; +*) + +(* ------------------------------------------------------------------------- *) +(* Nonexample 29. Gould, identity 6.36. *) +(* ------------------------------------------------------------------------- *) + +(* Maxima produces an enormous certificate; it was not imported into HOL. *) +(* + Zeilberger((-1)^k * binomial(2 * n,k)^2 * + binomial(n + k,k)^2 / binomial(2 * n,n),k,n); +*) + +(* ------------------------------------------------------------------------- *) +(* Nonexample 30. Gould, p. 66. *) +(* ------------------------------------------------------------------------- *) + +(* The original only proposes comparing the two recurrences below. *) +(* + Zeilberger(binomial(n,k)^4 * k,k,n); + Zeilberger(binomial(n,k)^4 * n / 2,k,n); +*) + +(* ------------------------------------------------------------------------- *) +(* Nonexample 31. Chaundy-Bullard identity. *) +(* ------------------------------------------------------------------------- *) + +(* The Chaundy-Bullard identity is not directly hypergeometric and its WZ *) +(* proof needs explicit summation limits, which are not supported here. *) +(* The original notes "New proofs of the Chaundy-Bullard identity" and *) +(* "A Proof That Zeilberger Missed", arXiv:1112.1359. *) diff --git a/WZ/wz.ml b/WZ/wz.ml new file mode 100644 index 00000000..4622f407 --- /dev/null +++ b/WZ/wz.ml @@ -0,0 +1,1687 @@ +(* ========================================================================= *) +(* HOL Light implementation of Wilf-Zeilberger and related methods. *) +(* *) +(* See J. Harrison, "Formal Proofs of Hypergeometric Sums", Journal of *) +(* Automated Reasoning 55 (2015), DOI 10.1007/s10817-015-9338-0. *) +(* ========================================================================= *) + +needs "Multivariate/gamma.ml";; + +(* ------------------------------------------------------------------------- *) +(* An ad-hoc real power function with properties we want. *) +(* ------------------------------------------------------------------------- *) + +parse_as_infix("spow",(24,"left"));; + +let spow = new_definition + `x spow y = if x = &0 then &0 + else if x < &0 then cos(y * pi) * (--x) rpow y else x rpow y`;; + +let SPOW_STEP_UP = prove + (`!x y. x spow (y + &1) = x spow y * x`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `x = &0` THEN + ASM_SIMP_TAC[spow; REAL_LT_REFL; RPOW_ZERO; REAL_MUL_RZERO] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL + [ASM_SIMP_TAC[RPOW_ADD; REAL_NEG_GT0; RPOW_POW; REAL_POW_1] THEN + REWRITE_TAC[REAL_ARITH `(y + &1) * pi = y * pi + pi`] THEN + REWRITE_TAC[COS_ADD; SIN_PI; COS_PI] THEN REAL_ARITH_TAC; + ASM_SIMP_TAC[RPOW_ADD; REAL_ARITH `~(x = &0) /\ ~(x < &0) ==> &0 < x`] THEN + REWRITE_TAC[RPOW_POW; REAL_POW_1]]);; + +let SPOW_STEP_DOWN = prove + (`!x y. x spow (y - &1) = x spow y / x`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `x = &0` THEN + ASM_SIMP_TAC[spow; REAL_LT_REFL; RPOW_ZERO; REAL_ARITH `x / &0 = &0`] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[] THENL + [ASM_SIMP_TAC[RPOW_SUB; REAL_NEG_GT0; RPOW_POW; REAL_POW_1] THEN + REWRITE_TAC[REAL_ARITH `(y - &1) * pi = y * pi - pi`] THEN + REWRITE_TAC[COS_SUB; SIN_PI; COS_PI] THEN + REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD; + ASM_SIMP_TAC[RPOW_SUB; REAL_ARITH `~(x = &0) /\ ~(x < &0) ==> &0 < x`] THEN + REWRITE_TAC[RPOW_POW; REAL_POW_1]]);; + +let SPOW_EQ_0 = prove + (`!x y. x spow y = &0 <=> x = &0 \/ x < &0 /\ cos(y * pi) = &0`, + REPEAT GEN_TAC THEN REWRITE_TAC[spow] THEN + ASM_CASES_TAC `x = &0` THEN ASM_REWRITE_TAC[] THEN + COND_CASES_TAC THEN ASM_REWRITE_TAC[RPOW_EQ_0; REAL_ENTIRE] THEN + ASM_REAL_ARITH_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Version of REAL_FIELD where we conveniently have an implication with *) +(* nonzeroness of any inverted terms. *) +(* ------------------------------------------------------------------------- *) + +let SPECIAL_REAL_FIELD_TAC = + let is_inv = + let inv_tm = `inv:real->real` + and is_div = is_binop `(/):real->real->real` in + fun tm -> (is_div tm || (is_comb tm && rator tm = inv_tm)) && + not(is_ratconst(rand tm)) in + fun (asl,tm) -> + let ant,con = dest_imp tm in + let is_freeinv t = is_inv t && free_in t tm in + let ivtms = setify(find_terms is_freeinv con) in + let itms = setify(map rand (find_terms is_freeinv con)) in + let hyps = map (fun t -> SPEC t REAL_MUL_RINV) itms in + let aths = CONJUNCTS (ASSUME ant) in + let pths = map (fun th -> tryfind (MP th) aths) hyps in + let gvs = map (genvar o type_of) itms in + (DISCH_TAC THEN MAP_EVERY MP_TAC pths THEN + MAP_EVERY SPEC_TAC (zip ivtms gvs) THEN + CONV_TAC REAL_RING) (asl,tm);; + +(* ------------------------------------------------------------------------- *) +(* Generalizations of factorial and binomial coefficients to R. *) +(* ------------------------------------------------------------------------- *) + +let rfact = new_definition + `rfact x = gamma(x + &1)`;; + +let rbinom = new_definition + `rbinom(n,k) = rfact n / (rfact k * rfact (n - k))`;; + +let RFACT_STEP_UP = prove + (`!n. rfact(n + &1) = if n = --(&1) then &1 else (n + &1) * rfact n`, + GEN_TAC THEN REWRITE_TAC[rfact] THEN + GEN_REWRITE_TAC LAND_CONV [GAMMA_RECURRENCE] THEN + REWRITE_TAC[REAL_ARITH `x:real = -- &1 <=> x + &1 = &0`]);; + +let RFACT_STEP_DOWN = prove + (`!n. rfact(n - &1) = rfact n / n`, + GEN_TAC THEN REWRITE_TAC[rfact] THEN + GEN_REWRITE_TAC LAND_CONV [GAMMA_RECURRENCE_ALT] THEN + BINOP_TAC THEN TRY AP_TERM_TAC THEN REAL_ARITH_TAC);; + +let RBINOM_TOP_STEP = prove + (`!k n. ~(n + &1 = &0) /\ ~(n + &1 = k) + ==> rbinom(n + &1,k) = (n + &1) / (n - k + &1) * rbinom (n,k)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[rbinom] THEN + REWRITE_TAC[REAL_ARITH `(n + &1) - k = (n - k) + &1`] THEN + REWRITE_TAC[RFACT_STEP_UP] THEN + REPEAT(COND_CASES_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) THEN + REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD);; + +let RBINOM_BOTTOM_STEP = prove + (`!k n. ~(k + &1 = &0) + ==> rbinom(n,k + &1) = (n - k) / (k + &1) * rbinom(n,k)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[rbinom] THEN + REWRITE_TAC[REAL_ARITH `n - (k + &1) = (n - k) - &1`] THEN + REWRITE_TAC[RFACT_STEP_UP; RFACT_STEP_DOWN] THEN + COND_CASES_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC] THEN + REPEAT(POP_ASSUM MP_TAC) THEN CONV_TAC REAL_FIELD);; + +let RBINOM_TOP_STEP_DOWN = prove + (`!k n. rbinom(n - &1,k) = (n - k) / n * rbinom(n,k)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[rbinom] THEN + REWRITE_TAC[RFACT_STEP_DOWN; REAL_ARITH `n - &1 - k = n - k - &1`] THEN + REWRITE_TAC[real_div; REAL_INV_MUL; REAL_INV_INV] THEN REAL_ARITH_TAC);; + +let RBINOM_BOTTOM_STEP_DOWN = prove + (`!k n. ~(n + &1 = k) ==> rbinom(n,k - &1) = k / (n - k + &1) * rbinom(n,k)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[rbinom; RFACT_STEP_DOWN] THEN + ASM_SIMP_TAC[REAL_ARITH `n - (k - &1) = (n - k) + &1`; RFACT_STEP_UP] THEN + ASM_SIMP_TAC[REAL_ARITH `n - k = -- &1 <=> n + &1 = k`] THEN + REWRITE_TAC[real_div; REAL_INV_MUL; REAL_INV_INV] THEN REAL_ARITH_TAC);; + +let RBINOM_STEP_BOTH_UP = prove + (`!k n. ~(k + &1 = &0) /\ ~(n + &1 = &0) + ==> rbinom(n + &1,k + &1) = (n + &1) / (k + &1) * rbinom(n,k)`, + REWRITE_TAC[rbinom; REAL_ARITH `(n + &1) - (k + &1) = n - k`] THEN + SIMP_TAC[RFACT_STEP_UP; REAL_ARITH `n = --x <=> n + x = &0`] THEN + REWRITE_TAC[real_div; REAL_INV_MUL; REAL_INV_INV] THEN REAL_ARITH_TAC);; + +let RBINOM_STEP_BOTH_DOWN = prove + (`!k n. rbinom(n - &1,k - &1) = k / n * rbinom(n,k)`, + REWRITE_TAC[rbinom; REAL_ARITH `(n - &1) - (k - &1) = n - k`] THEN + REWRITE_TAC[RFACT_STEP_DOWN] THEN + REWRITE_TAC[real_div; REAL_INV_MUL; REAL_INV_INV] THEN REAL_ARITH_TAC);; + +let LIM_RFACT = prove + (`!net:(A)net nn n. + (nn ---> &n) net ==> ((\a. rfact(nn a)) ---> &(FACT n)) net`, + REPEAT STRIP_TAC THEN REWRITE_TAC[rfact; GSYM GAMMA_FACT] THEN + MATCH_MP_TAC(SPEC `gamma` REALLIM_REAL_CONTINUOUS_FUNCTION) THEN + ASM_SIMP_TAC[GSYM REAL_OF_NUM_ADD; REALLIM_ADD; REALLIM_CONST] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_GAMMA THEN REAL_ARITH_TAC);; + +let LIM_INV_RFACT = prove + (`!net:(A)net nn x. + integer x /\ x < &0 /\ (nn ---> x) net + ==> ((\a. inv(rfact(nn a))) ---> &0) net`, + REPEAT STRIP_TAC THEN + SUBGOAL_THEN `&0 = inv(gamma(x + &1))` SUBST1_TAC THENL + [CONV_TAC SYM_CONV THEN REWRITE_TAC[GAMMA_EQ_0; REAL_INV_EQ_0] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [is_int]) THEN + DISCH_THEN(X_CHOOSE_THEN `m:num` (DISJ_CASES_THEN SUBST_ALL_TAC)) THENL + [ASM_REAL_ARITH_TAC; EXISTS_TAC `m - 1`] THEN + REWRITE_TAC[REAL_ARITH `(--x + &1) + y = &0 <=> y = x - &1`] THEN + FIRST_X_ASSUM(MP_TAC o MATCH_MP (REAL_ARITH `--x < &0 ==> &0 < x`)) THEN + SIMP_TAC[REAL_OF_NUM_LT; REAL_OF_NUM_SUB; LE_1]; + REWRITE_TAC[rfact] THEN MATCH_MP_TAC(REWRITE_RULE[o_THM] + (SPEC `inv o gamma` REALLIM_REAL_CONTINUOUS_FUNCTION)) THEN + ASM_SIMP_TAC[REAL_CONTINUOUS_ATREAL_RECIP_GAMMA; + REALLIM_ADD; REALLIM_CONST]]);; + +let LIM_RBINOM = prove + (`!net:(A)net nn kk n k. + (nn ---> &n) net /\ (kk ---> &k) net + ==> ((\a. rbinom(nn a,kk a)) ---> &(binom(n,k))) net`, + REPEAT STRIP_TAC THEN REWRITE_TAC[rbinom; REAL_OF_NUM_BINOM] THEN + COND_CASES_TAC THENL + [MATCH_MP_TAC REALLIM_DIV THEN + ASM_SIMP_TAC[REAL_ENTIRE; REAL_OF_NUM_EQ; FACT_NZ; LIM_RFACT] THEN + GEN_REWRITE_TAC LAND_CONV [REAL_MUL_SYM] THEN + MATCH_MP_TAC REALLIM_MUL THEN + ASM_SIMP_TAC[REAL_OF_NUM_EQ; FACT_NZ; LIM_RFACT] THEN + MATCH_MP_TAC LIM_RFACT THEN + ASM_SIMP_TAC[REALLIM_SUB; GSYM REAL_OF_NUM_SUB]; + REWRITE_TAC[real_div; REAL_INV_MUL; REAL_MUL_ASSOC] THEN + SUBST1_TAC(REAL_ARITH `&0 = (&(FACT n) * inv(&(FACT k))) * &0`) THEN + MATCH_MP_TAC REALLIM_MUL THEN CONJ_TAC THENL + [MATCH_MP_TAC REALLIM_MUL THEN ASM_SIMP_TAC[LIM_RFACT] THEN + MATCH_MP_TAC REALLIM_INV THEN + ASM_SIMP_TAC[LIM_RFACT; REAL_OF_NUM_EQ; FACT_NZ]; + MATCH_MP_TAC LIM_INV_RFACT THEN EXISTS_TAC `&n - &k:real` THEN + ASM_SIMP_TAC[INTEGER_CLOSED; REALLIM_SUB] THEN + RULE_ASSUM_TAC(REWRITE_RULE[GSYM REAL_OF_NUM_LE]) THEN + ASM_REAL_ARITH_TAC]]);; + +let REALLIM_SPOW = prove + (`!net:A net f l. + (f ---> l) net ==> ((\x. t spow f x) ---> t spow l) net`, + REPEAT GEN_TAC THEN ASM_CASES_TAC `t = &0` THEN + ASM_REWRITE_TAC[spow; REALLIM_CONST] THEN DISCH_TAC THEN + ASM_CASES_TAC `t < &0` THEN ASM_REWRITE_TAC[] THEN + REPEAT(MATCH_MP_TAC REALLIM_MUL) THEN + ASM_SIMP_TAC[REALLIM_RPOW_COMPOSE; REALLIM_CONST; REAL_NEG_GT0; + REAL_ARITH `~(t = &0) /\ ~(t < &0) ==> &0 < t`] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (REWRITE_RULE[o_DEF] (ONCE_REWRITE_RULE[IMP_CONJ] + REALLIM_COMPOSE_AT))) THEN + REWRITE_TAC[EVENTUALLY_TRUE] THEN + MATCH_MP_TAC(ISPEC `cos` REALLIM_REAL_CONTINUOUS_FUNCTION) THEN + SIMP_TAC[REALLIM_RMUL; REALLIM_ATREAL_ID; REAL_CONTINUOUS_AT_COS]);; + +let REALLIM_SPOW_COMPOSE = prove + (`!net:A net f g l m. + (f ---> l) net /\ (g ---> m) net /\ ~(l = &0) + ==> ((\x. (f x) spow (g x)) ---> l spow m) net`, + REPEAT STRIP_TAC THEN FIRST_ASSUM(DISJ_CASES_THEN STRIP_ASSUME_TAC o MATCH_MP + (REAL_ARITH `~(x = &0) ==> &0 < x /\ ~(x < &0) \/ x < &0 /\ ~(&0 < x)`)) THEN + GEN_REWRITE_TAC LAND_CONV [spow] THEN ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REALLIM_TRANSFORM_EVENTUALLY THENL + [EXISTS_TAC `\x:A. (f x) rpow (g x)` THEN REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC EVENTUALLY_MONO THEN + EXISTS_TAC `\x. &0 < (f:A->real) x` THEN + SIMP_TAC[spow; REAL_ARITH `&0 < x ==> ~(x = &0) /\ ~(x < &0)`] THEN + MATCH_MP_TAC EVENTUALLY_MONO THEN + EXISTS_TAC `\x. abs((f:A->real) x - l) < l` THEN + REWRITE_TAC[] THEN CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[tendsto_real]) THEN + ASM_REWRITE_TAC[]; + MATCH_MP_TAC REALLIM_RPOW_COMPOSE THEN ASM_REWRITE_TAC[]]; + EXISTS_TAC `\x:A. cos(g x * pi) * (--f x) rpow (g x)` THEN + REWRITE_TAC[] THEN CONJ_TAC THENL + [MATCH_MP_TAC EVENTUALLY_MONO THEN + EXISTS_TAC `\x. (f:A->real) x < &0` THEN + SIMP_TAC[spow; REAL_ARITH `x < &0 ==> ~(x = &0)`] THEN + MATCH_MP_TAC EVENTUALLY_MONO THEN + EXISTS_TAC `\x. abs((f:A->real) x - l) < --l` THEN + REWRITE_TAC[] THEN CONJ_TAC THENL [REAL_ARITH_TAC; ALL_TAC] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o REWRITE_RULE[tendsto_real]) THEN + ASM_REWRITE_TAC[REAL_NEG_GT0]; + MATCH_MP_TAC REALLIM_MUL THEN + ASM_SIMP_TAC[REALLIM_RPOW_COMPOSE; REALLIM_NEG; REAL_NEG_GT0] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP + (REWRITE_RULE[o_DEF] (ONCE_REWRITE_RULE[IMP_CONJ] + REALLIM_COMPOSE_AT))) THEN + REWRITE_TAC[EVENTUALLY_TRUE] THEN + MATCH_MP_TAC(ISPEC `cos` REALLIM_REAL_CONTINUOUS_FUNCTION) THEN + SIMP_TAC[REALLIM_RMUL; REALLIM_ATREAL_ID; REAL_CONTINUOUS_AT_COS]]]);; + +let RFACT_EQ_0 = prove + (`!x. rfact x = &0 <=> integer x /\ x < &0`, + REWRITE_TAC[rfact; GAMMA_EQ_0; GSYM NONPOSITIVE_INTEGER_ALT] THEN + GEN_TAC THEN ASM_CASES_TAC `integer x` THENL + [ASM_SIMP_TAC[INTEGER_CLOSED; REAL_LT_INTEGERS]; + ASM_MESON_TAC[INTEGER_CLOSED; REAL_ARITH `(x + a) - a:real = x`]]);; + +let REAL_CONTINUOUS_AT_RFACT = prove + (`!x. ~(integer x /\ x <= -- &1) ==> rfact real_continuous atreal x`, + REPEAT STRIP_TAC THEN + GEN_REWRITE_TAC LAND_CONV [GSYM ETA_AX] THEN + REWRITE_TAC[rfact] THEN + GEN_REWRITE_TAC LAND_CONV [GSYM o_DEF] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_COMPOSE THEN + SIMP_TAC[REAL_CONTINUOUS_ADD; REAL_CONTINUOUS_CONST; + REAL_CONTINUOUS_AT_ID] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_GAMMA THEN GEN_TAC THEN + DISCH_THEN(fun th -> POP_ASSUM MP_TAC THEN ASSUME_TAC th) THEN + FIRST_ASSUM(SUBST1_TAC o MATCH_MP (REAL_ARITH + `(x + &1) + n = &0 ==> x = --(n + &1)`)) THEN + SIMP_TAC[INTEGER_CLOSED] THEN REAL_ARITH_TAC);; + +let REAL_CONTINUOUS_AT_INV_RFACT = prove + (`!x. (inv o rfact) real_continuous atreal x`, + GEN_TAC THEN GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM ETA_AX] THEN + REWRITE_TAC[rfact] THEN + GEN_REWRITE_TAC (LAND_CONV o RAND_CONV) [GSYM o_DEF] THEN + REWRITE_TAC[o_ASSOC] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_COMPOSE THEN + SIMP_TAC[REAL_CONTINUOUS_ADD; REAL_CONTINUOUS_CONST; + REAL_CONTINUOUS_AT_ID; REAL_CONTINUOUS_ATREAL_RECIP_GAMMA]);; + +let REAL_CONTINUOUS_RFACT_COMPOSE_WITHIN = prove + (`!nn s z:real^N. + nn real_continuous (at z within s) /\ + ~(integer(nn z) /\ nn z <= -- &1) + ==> (\x. rfact(nn x)) real_continuous (at z within s)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM o_DEF] THEN + MATCH_MP_TAC REAL_CONTINUOUS_WITHIN_COMPOSE THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_WITHINREAL THEN + ASM_SIMP_TAC[REAL_CONTINUOUS_AT_RFACT]);; + +let REAL_CONTINUOUS_INV_RFACT_COMPOSE_WITHIN = prove + (`!nn s z:real^N. + nn real_continuous (at z within s) + ==> (\x. inv(rfact(nn x))) real_continuous (at z within s)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[GSYM o_DEF; o_ASSOC] THEN + MATCH_MP_TAC REAL_CONTINUOUS_WITHIN_COMPOSE THEN + ASM_REWRITE_TAC[] THEN + MATCH_MP_TAC REAL_CONTINUOUS_ATREAL_WITHINREAL THEN + REWRITE_TAC[REAL_CONTINUOUS_AT_INV_RFACT]);; + +let REAL_CONTINUOUS_RBINOM_COMPOSE_WITHIN = prove + (`!nn kk s a:real^N. + nn real_continuous (at a within s) /\ + kk real_continuous (at a within s) /\ + ~(integer(nn a) /\ nn a <= -- &1) + ==> (\x. rbinom (nn x,kk x)) real_continuous (at a within s)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[rbinom; real_div; REAL_INV_MUL] THEN + MATCH_MP_TAC REAL_CONTINUOUS_MUL THEN CONJ_TAC THENL + [ASM_SIMP_TAC[REAL_CONTINUOUS_RFACT_COMPOSE_WITHIN]; + ASM_SIMP_TAC[REAL_CONTINUOUS_INV_RFACT_COMPOSE_WITHIN; + REAL_CONTINUOUS_MUL; REAL_CONTINUOUS_SUB]]);; + +(* ------------------------------------------------------------------------- *) +(* Representation (using functions) of polynomials w.r.t. an N-indexed *) +(* family of variables over the rational numbers. *) +(* ------------------------------------------------------------------------- *) + +let ratpoly = new_definition + `ratpoly p <=> + (!m. rational(p m)) /\ + FINITE {m | ~(p m = &0)} /\ + (!m. ~(p m = &0) ==> FINITE {i:num | ~(m i = 0)})`;; + +let COUNTABLE_RATPOLY = prove + (`COUNTABLE ratpoly`, + GEN_REWRITE_TAC RAND_CONV [GSYM ETA_AX] THEN REWRITE_TAC[ratpoly] THEN + REWRITE_TAC[COUNTABLE; ge_c] THEN MP_TAC(ISPEC + `{m | FINITE {i:num | ~(m i = 0)}} CROSS rational` CARD_EQ_LIST_GEN) THEN + SUBGOAL_THEN `{m | FINITE {i:num | ~(m i = 0)}} CROSS rational =_c (:num)` + ASSUME_TAC THENL + [REWRITE_TAC[CROSS; GSYM mul_c] THEN + TRANS_TAC CARD_EQ_TRANS `(:num) *_c (:num)` THEN + REWRITE_TAC[CARD_SQUARE_NUM] THEN + MATCH_MP_TAC CARD_MUL_CONG THEN REWRITE_TAC[CARD_EQ_RATIONAL] THEN + REWRITE_TAC[GSYM CARD_LE_ANTISYM] THEN CONJ_TAC THENL + [TRANS_TAC CARD_LE_TRANS `(:(num#num)list)` THEN CONJ_TAC THENL + [REWRITE_TAC[le_c; IN_ELIM_THM; IN_UNIV] THEN EXISTS_TAC + `\m. list_of_set (IMAGE (\i:num. (i,m i)) {i | ~(m i = 0)})` THEN + MAP_EVERY X_GEN_TAC [`m1:num->num`; `m2:num->num`] THEN + REWRITE_TAC[] THEN STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o AP_TERM + `set_of_list:(num#num)list->num#num->bool`) THEN + ASM_SIMP_TAC[SET_OF_LIST_OF_SET; FINITE_IMAGE] THEN + GEN_REWRITE_TAC RAND_CONV [FUN_EQ_THM] THEN + REWRITE_TAC[EXTENSION; IN_IMAGE; EXISTS_PAIR_THM; + PAIR_EQ; FORALL_PAIR_THM; IN_ELIM_THM] THEN + DISCH_TAC THEN X_GEN_TAC `i:num` THEN + ASM_CASES_TAC `m2(i:num) = 0` THEN + FIRST_X_ASSUM(MP_TAC o SPEC `i:num`) THEN + ASM_REWRITE_TAC[GSYM CONJ_ASSOC; UNWIND_THM1] THEN ASM_MESON_TAC[]; + MATCH_MP_TAC CARD_EQ_IMP_LE THEN + W(MP_TAC o PART_MATCH (lhand o rand) CARD_EQ_LIST o lhand o snd) THEN + REWRITE_TAC[GSYM MUL_C_UNIV; INFINITE; CARD_MUL_FINITE_EQ] THEN + REWRITE_TAC[UNIV_NOT_EMPTY; GSYM INFINITE; num_INFINITE] THEN + MATCH_MP_TAC(ONCE_REWRITE_RULE[IMP_CONJ_ALT] CARD_EQ_TRANS) THEN + REWRITE_TAC[CARD_SQUARE_NUM]]; + REWRITE_TAC[LE_C; IN_UNIV; IN_ELIM_THM] THEN + EXISTS_TAC `\m:num->num. m 0` THEN X_GEN_TAC `j:num` THEN + EXISTS_TAC `\i. if i = 0 then j else 0` THEN REWRITE_TAC[MESON[] + `~((if x = a then c else z) = z) <=> x = a /\ ~(c = z)`] THEN + REWRITE_TAC[SET_RULE `{x | x = a /\ P x} = {x | x IN {a} /\ P x}`] THEN + SIMP_TAC[FINITE_RESTRICT; FINITE_SING]]; + FIRST_ASSUM(MP_TAC o MATCH_MP CARD_INFINITE_CONG) THEN + SIMP_TAC[num_INFINITE] THEN DISCH_THEN(K ALL_TAC) THEN + POP_ASSUM MP_TAC THEN REWRITE_TAC[GSYM IMP_CONJ_ALT] THEN + DISCH_THEN(MP_TAC o MATCH_MP CARD_EQ_TRANS) THEN + DISCH_THEN(MP_TAC o MATCH_MP CARD_EQ_IMP_LE) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ] CARD_LE_TRANS)] THEN + REWRITE_TAC[le_c; IN_ELIM_THM] THEN EXISTS_TAC + `\p. list_of_set (IMAGE (\m. (m,p m)) {m:num->num | ~(p m = &0)})` THEN + SIMP_TAC[MEM_LIST_OF_SET; FINITE_IMAGE] THEN + REWRITE_TAC[FORALL_IN_IMAGE; IN_CROSS; IN_ELIM_THM] THEN + CONJ_TAC THENL [SIMP_TAC[IN]; ALL_TAC] THEN + MAP_EVERY X_GEN_TAC [`p:(num->num)->real`; `q:(num->num)->real`] THEN + STRIP_TAC THEN FIRST_X_ASSUM(MP_TAC o AP_TERM + `set_of_list:((num->num)#real)list->(num->num)#real->bool`) THEN + ASM_SIMP_TAC[SET_OF_LIST_OF_SET; FINITE_IMAGE] THEN + GEN_REWRITE_TAC RAND_CONV [FUN_EQ_THM] THEN + REWRITE_TAC[EXTENSION; IN_IMAGE; EXISTS_PAIR_THM; + PAIR_EQ; FORALL_PAIR_THM; IN_ELIM_THM] THEN + DISCH_TAC THEN X_GEN_TAC `f:num->num` THEN + ASM_CASES_TAC `p(f:num->num) = &0` THEN + FIRST_X_ASSUM(MP_TAC o SPEC `f:num->num`) THEN + ASM_REWRITE_TAC[GSYM CONJ_ASSOC; UNWIND_THM1] THEN ASM_MESON_TAC[]);; + +let poly_eval = new_definition + `poly_eval p x = + sum (:num->num) (\m. p m * product (:num) (\i. x i pow m i))`;; + +let POLY_EVAL_RATPOLY = prove + (`!p x. ratpoly p + ==> poly_eval p x = + sum {m | ~(p m = &0)} + (\m. p m * product {i | ~(m i = 0)} (\i. x i pow m i))`, + REWRITE_TAC[ratpoly] THEN REPEAT STRIP_TAC THEN REWRITE_TAC[poly_eval] THEN + MATCH_MP_TAC SUM_EQ_SUPERSET THEN + ASM_SIMP_TAC[SUBSET_UNIV; IN_ELIM_THM; REAL_MUL_LZERO] THEN + X_GEN_TAC `m:num->num` THEN DISCH_TAC THEN AP_TERM_TAC THEN + MATCH_MP_TAC PRODUCT_SUPERSET THEN + SIMP_TAC[IN_ELIM_THM; SUBSET_UNIV; real_pow]);; + +(* ------------------------------------------------------------------------- *) +(* Hence polynomial functions of two real variables over the rationals *) +(* plus a finite set of parameters. *) +(* ------------------------------------------------------------------------- *) + +let ratpolyfun = new_definition + `ratpolyfun s f <=> + ?p. ratpoly p /\ + f = \(x,y). poly_eval p (\i. EL i (CONS x (CONS y (list_of_set s))))`;; + +let COUNTABLE_RATPOLYFUN = prove + (`!s. COUNTABLE(ratpolyfun s)`, + GEN_TAC THEN MP_TAC(ISPEC + `\p (x,y). poly_eval p (\i. EL i (CONS x (CONS y (list_of_set s))))` + (MATCH_MP COUNTABLE_IMAGE COUNTABLE_RATPOLY)) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] COUNTABLE_SUBSET) THEN + REWRITE_TAC[SUBSET; IN_IMAGE] THEN REWRITE_TAC[IN] THEN + REWRITE_TAC[IN] THEN REWRITE_TAC[ratpolyfun] THEN MESON_TAC[]);; + +let RATPOLYFUN_CONST = prove + (`!s c. rational c ==> ratpolyfun s (\(x,y). c)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[ratpolyfun; ratpoly] THEN + EXISTS_TAC `\m. if m = \i:num. 0 then c else &0` THEN + REWRITE_TAC[] THEN REPEAT CONJ_TAC THENL + [GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[RATIONAL_CLOSED]; + MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `{(\i:num. 0)}` THEN + REWRITE_TAC[FINITE_SING; SUBSET; IN_ELIM_THM; IN_SING] THEN + GEN_TAC THEN COND_CASES_TAC THEN ASM_REWRITE_TAC[]; + GEN_TAC THEN COND_CASES_TAC THEN + ASM_REWRITE_TAC[EMPTY_GSPEC; FINITE_EMPTY]; + GEN_REWRITE_TAC I [FUN_EQ_THM] THEN + REWRITE_TAC[poly_eval; FORALL_PAIR_THM] THEN + REWRITE_TAC[COND_RAND; COND_RATOR; REAL_MUL_LZERO] THEN + SIMP_TAC[SUM_DELTA; IN_UNIV; real_pow; PRODUCT_ONE; REAL_MUL_RID]]);; + +let RATPOLYFUN_VAR = prove + (`!s. ratpolyfun s (\(n,k). n) /\ ratpolyfun s (\(n,k). k)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[ratpolyfun; ratpoly] THENL + [EXISTS_TAC `\m. if m = \i. if i = 0 then 1 else 0 then &1 else &0`; + EXISTS_TAC `\m. if m = \i. if i = 1 then 1 else 0 then &1 else &0`] THEN + REWRITE_TAC[] THEN ONCE_REWRITE_TAC[COND_RAND] THEN + REWRITE_TAC[RATIONAL_CLOSED; COND_ID] THEN + ONCE_REWRITE_TAC[COND_RATOR] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[MESON[] `~(if p then F else T) <=> p`] THEN + REWRITE_TAC[SING_GSPEC; FINITE_SING] THEN SIMP_TAC[] THEN + ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN + CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[MESON[] `~(if p then F else T) <=> p`] THEN + REWRITE_TAC[SING_GSPEC; FINITE_SING] THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN + REWRITE_TAC[poly_eval; FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC [`x:real`; `y:real`] THEN + REWRITE_TAC[COND_RAND; COND_RATOR; REAL_MUL_LZERO] THEN + SIMP_TAC[SUM_DELTA; IN_UNIV; REAL_MUL_LID] THEN + ONCE_REWRITE_TAC[COND_RAND] THEN REWRITE_TAC[real_pow; REAL_POW_1] THEN + SIMP_TAC[PRODUCT_DELTA; IN_UNIV; EL; HD] THEN + REWRITE_TAC[num_CONV `1`; EL; HD; TL]);; + +let RATPOLYFUN_PARAMETER = prove + (`!s a. FINITE s /\ a IN s ==> ratpolyfun s (\(x,y). a)`, + REPEAT STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o SPEC `a:real` o MATCH_MP MEM_LIST_OF_SET) THEN + ASM_REWRITE_TAC[MEM_EXISTS_EL] THEN + DISCH_THEN(X_CHOOSE_THEN `n:num` (STRIP_ASSUME_TAC o GSYM)) THEN + REWRITE_TAC[ratpolyfun; ratpoly] THEN + EXISTS_TAC `\m. if m = \i. if i = n + 2 then 1 else 0 then &1 else &0` THEN + REWRITE_TAC[] THEN ONCE_REWRITE_TAC[COND_RAND] THEN + REWRITE_TAC[RATIONAL_CLOSED; COND_ID] THEN + ONCE_REWRITE_TAC[COND_RATOR] THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[MESON[] `~(if p then F else T) <=> p`] THEN + REWRITE_TAC[SING_GSPEC; FINITE_SING] THEN SIMP_TAC[] THEN + ONCE_REWRITE_TAC[COND_RAND] THEN ONCE_REWRITE_TAC[COND_RATOR] THEN + CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[MESON[] `~(if p then F else T) <=> p`] THEN + REWRITE_TAC[SING_GSPEC; FINITE_SING] THEN GEN_REWRITE_TAC I [FUN_EQ_THM] THEN + REWRITE_TAC[poly_eval; FORALL_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC [`x:real`; `y:real`] THEN + REWRITE_TAC[COND_RAND; COND_RATOR; REAL_MUL_LZERO] THEN + SIMP_TAC[SUM_DELTA; IN_UNIV; REAL_MUL_LID] THEN + ONCE_REWRITE_TAC[COND_RAND] THEN REWRITE_TAC[real_pow; REAL_POW_1] THEN + SIMP_TAC[PRODUCT_DELTA; IN_UNIV] THEN + ASM_REWRITE_TAC[ARITH_RULE `n + 2 = SUC(SUC n)`; EL; HD; TL]);; + +let RATPOLYFUN_NEG = prove + (`!p s. ratpolyfun s (\(n,k). p n k) ==> ratpolyfun s (\(n,k). --(p n k))`, + MAP_EVERY X_GEN_TAC [`f:real->real->real`; `s:real->bool`] THEN + REWRITE_TAC[ratpolyfun; FUN_EQ_THM; FORALL_PAIR_THM] THEN + SIMP_TAC[LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `p:(num->num)->real` THEN DISCH_THEN(ASSUME_TAC o CONJUNCT1) THEN + SUBGOAL_THEN + `?r. ratpoly r /\ !xs. --(poly_eval p xs) = poly_eval r xs` + MP_TAC THENL [ALL_TAC; MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[]] THEN + EXISTS_TAC `(\m. --(p m)):(num->num)->real` THEN + REWRITE_TAC[poly_eval; REAL_MUL_LNEG; SUM_NEG] THEN + RULE_ASSUM_TAC(REWRITE_RULE[ratpoly]) THEN REWRITE_TAC[ratpoly] THEN + ASM_SIMP_TAC[RATIONAL_CLOSED; REAL_NEG_EQ_0]);; + +let RATPOLYFUN_ADD = prove + (`!p q s. ratpolyfun s (\(n,k). p n k) /\ ratpolyfun s (\(n,k). q n k) + ==> ratpolyfun s (\(n,k). p n k + q n k)`, + MAP_EVERY X_GEN_TAC + [`f:real->real->real`; `g:real->real->real`; `s:real->bool`] THEN + REWRITE_TAC[ratpolyfun] THEN DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `p:(num->num)->real` STRIP_ASSUME_TAC) + (X_CHOOSE_THEN `q:(num->num)->real` STRIP_ASSUME_TAC)) THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [FUN_EQ_THM])) THEN + SIMP_TAC[FUN_EQ_THM; FORALL_PAIR_THM] THEN REPEAT(DISCH_THEN(K ALL_TAC)) THEN + SUBGOAL_THEN + `?r. ratpoly r /\ !xs. poly_eval p xs + poly_eval q xs = poly_eval r xs` + MP_TAC THENL [ALL_TAC; MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[]] THEN + EXISTS_TAC `\m. (p:(num->num)->real) m + q m` THEN CONJ_TAC THENL + [REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[ratpoly] THEN + REPEAT STRIP_TAC THEN ASM_SIMP_TAC[RATIONAL_CLOSED] THENL + [MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `{m:num->num | ~(p m = &0)} UNION {m | ~(q m = &0)}` THEN + ASM_REWRITE_TAC[FINITE_UNION; SUBSET; IN_UNION; IN_ELIM_THM] THEN + REAL_ARITH_TAC; + FIRST_X_ASSUM(DISJ_CASES_TAC o MATCH_MP (REAL_ARITH + `~(x + y = &0) ==> ~(x = &0) \/ ~(y = &0)`)) THEN + ASM_SIMP_TAC[]]; + GEN_TAC THEN REWRITE_TAC[poly_eval; REAL_ADD_RDISTRIB] THEN + CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_ADD_GEN THEN + RULE_ASSUM_TAC(REWRITE_RULE[ratpoly]) THEN + REWRITE_TAC[REAL_ENTIRE; IN_UNIV; DE_MORGAN_THM] THEN + ONCE_REWRITE_TAC[SET_RULE + `{x | P x /\ Q x} = {x | x IN {y | P y} /\ Q x}`] THEN + ASM_SIMP_TAC[FINITE_RESTRICT]]);; + +let RATPOLYFUN_SUB = prove + (`!p q s. ratpolyfun s (\(n,k). p n k) /\ ratpolyfun s (\(n,k). q n k) + ==> ratpolyfun s (\(n,k). p n k - q n k)`, + SIMP_TAC[real_sub; RATPOLYFUN_ADD; RATPOLYFUN_NEG]);; + +let RATPOLYFUN_MUL = prove + (`!p q s. ratpolyfun s (\(n,k). p n k) /\ ratpolyfun s (\(n,k). q n k) + ==> ratpolyfun s (\(n,k). p n k * q n k)`, + MAP_EVERY X_GEN_TAC + [`f:real->real->real`; `g:real->real->real`; `s:real->bool`] THEN + REWRITE_TAC[ratpolyfun] THEN DISCH_THEN(CONJUNCTS_THEN2 + (X_CHOOSE_THEN `p:(num->num)->real` STRIP_ASSUME_TAC) + (X_CHOOSE_THEN `q:(num->num)->real` STRIP_ASSUME_TAC)) THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [FUN_EQ_THM])) THEN + SIMP_TAC[FUN_EQ_THM; FORALL_PAIR_THM] THEN REPEAT(DISCH_THEN(K ALL_TAC)) THEN + SUBGOAL_THEN + `?r. ratpoly r /\ !xs. poly_eval p xs * poly_eval q xs = poly_eval r xs` + MP_TAC THENL [ALL_TAC; MATCH_MP_TAC MONO_EXISTS THEN SIMP_TAC[]] THEN + EXISTS_TAC `\m. sum {(k,l) | (\i. k i + l i) = m} + (\(k:num->num,l). p k * q l)` THEN + CONJ_TAC THENL + [REPEAT(POP_ASSUM MP_TAC) THEN REWRITE_TAC[ratpoly] THEN + REPEAT STRIP_TAC THENL + [MATCH_MP_TAC RATIONAL_SUM THEN REWRITE_TAC[FORALL_IN_GSPEC] THEN + ASM_SIMP_TAC[RATIONAL_CLOSED]; + MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `IMAGE (\(k:num->num,l) i. k i + l i) + {k,l | ~(p k * q l = &0)}` THEN + CONJ_TAC THENL + [MATCH_MP_TAC FINITE_IMAGE THEN REWRITE_TAC[REAL_ENTIRE] THEN + REWRITE_TAC[SET_RULE + `{k,l | ~(P k \/ Q l)} = + {k,l | k IN {x | ~P x} /\ l IN {x | ~Q x}}`] THEN + MATCH_MP_TAC FINITE_PRODUCT_DEPENDENT THEN ASM_REWRITE_TAC[]; + REWRITE_TAC[SUBSET; IN_ELIM_THM] THEN X_GEN_TAC `m:num->num` THEN + DISCH_THEN(MP_TAC o MATCH_MP (ONCE_REWRITE_RULE[GSYM CONTRAPOS_THM] + SUM_EQ_0)) THEN + REWRITE_TAC[FORALL_IN_GSPEC; IN_IMAGE; EXISTS_PAIR_THM] THEN + REWRITE_TAC[IN_ELIM_PAIR_THM] THEN SET_TAC[]]; + FIRST_ASSUM(MP_TAC o MATCH_MP + (ONCE_REWRITE_RULE[GSYM CONTRAPOS_THM] SUM_EQ_0)) THEN + REWRITE_TAC[FORALL_IN_GSPEC] THEN + REWRITE_TAC[NOT_FORALL_THM; NOT_IMP; LEFT_IMP_EXISTS_THM] THEN + MAP_EVERY X_GEN_TAC [`k:num->num`; `l:num->num`] THEN + REWRITE_TAC[DE_MORGAN_THM; REAL_ENTIRE] THEN + DISCH_THEN(CONJUNCTS_THEN2 (SUBST1_TAC o SYM) STRIP_ASSUME_TAC) THEN + ASM_SIMP_TAC[ADD_EQ_0; FINITE_UNION; SET_RULE + `{x | ~(P x /\ Q x)} = {x | ~P x} UNION {x | ~Q x}`]]; + GEN_TAC THEN REWRITE_TAC[poly_eval] THEN + GEN_REWRITE_TAC (LAND_CONV o BINOP_CONV) [GSYM SUM_SUPPORT] THEN + REWRITE_TAC[GSYM SUM_RMUL] THEN REWRITE_TAC[GSYM SUM_LMUL] THEN + W(MP_TAC o PART_MATCH (lhand o rand) SUM_SUM_PRODUCT o lhand o snd) THEN + REWRITE_TAC[support; IN_UNIV; NEUTRAL_REAL_ADD; IN_ELIM_THM] THEN + ANTS_TAC THENL + [RULE_ASSUM_TAC(REWRITE_RULE[ratpoly]) THEN + REWRITE_TAC[REAL_ENTIRE; IN_UNIV; DE_MORGAN_THM] THEN + ONCE_REWRITE_TAC[SET_RULE + `{x | P x /\ Q x} = {x | x IN {y | P y} /\ Q x}`] THEN + ASM_SIMP_TAC[FINITE_RESTRICT]; + DISCH_THEN SUBST1_TAC] THEN + MP_TAC(ISPECL + [`\(k:num->num,l) i. k i + l i`; `(:num->num)`] + (ONCE_REWRITE_RULE[MESON[] + `(!f g s t. P f g s t) <=> (!f t g s. P f g s t)`] SUM_GROUP)) THEN + DISCH_THEN(fun th -> + W(MP_TAC o PART_MATCH (rand o rand) th o lhand o snd)) THEN + REWRITE_TAC[SUBSET_UNIV] THEN ANTS_TAC THENL + [MATCH_MP_TAC(REWRITE_RULE[IN] FINITE_PRODUCT_DEPENDENT) THEN + REWRITE_TAC[REAL_ENTIRE; IN_UNIV; DE_MORGAN_THM] THEN + ONCE_REWRITE_TAC[SET_RULE + `(\x. P x /\ Q x) = {x | x IN {y | P y} /\ Q x}`] THEN + RULE_ASSUM_TAC(REWRITE_RULE[ratpoly]) THEN + ASM_SIMP_TAC[FINITE_RESTRICT]; + DISCH_THEN(SUBST1_TAC o SYM)] THEN + MATCH_MP_TAC SUM_EQ THEN X_GEN_TAC `m:num->num` THEN + REWRITE_TAC[IN_UNIV] THEN GEN_REWRITE_TAC RAND_CONV [GSYM SUM_SUPPORT] THEN + REWRITE_TAC[support; IN_UNIV; NEUTRAL_REAL_ADD] THEN + REWRITE_TAC[SET_RULE `{x | x IN {a,b | P a b} /\ Q x} = + {a,b | P a b /\ Q(a,b)}`] THEN + MATCH_MP_TAC(MESON[SUM_EQ] + `s = t /\ (!x. x IN s ==> f x = g x) ==> sum s f = sum t g`) THEN + REWRITE_TAC[FORALL_IN_GSPEC] THEN CONJ_TAC THENL + [REWRITE_TAC[EXTENSION; FORALL_PAIR_THM; IN_ELIM_PAIR_THM] THEN + MAP_EVERY X_GEN_TAC [`m1:num->num`; `m2:num->num`] THEN + MATCH_MP_TAC(TAUT + `(r ==> (p <=> q)) ==> (p /\ r <=> r /\ q)`) THEN + DISCH_THEN(SUBST1_TAC o SYM) THEN + REWRITE_TAC[REAL_ENTIRE; DE_MORGAN_THM] THEN + ASM_CASES_TAC `(p:(num->num)->real) m1 = &0` THEN ASM_REWRITE_TAC[] THEN + ASM_CASES_TAC `(q:(num->num)->real) m2 = &0` THEN ASM_REWRITE_TAC[] THEN + REWRITE_TAC[GSYM DE_MORGAN_THM; GSYM REAL_ENTIRE; REAL_POW_ADD] THEN + AP_TERM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN CONV_TAC SYM_CONV; + MAP_EVERY X_GEN_TAC [`m1:num->num`; `m2:num->num`] THEN + REWRITE_TAC[REAL_ENTIRE; DE_MORGAN_THM] THEN STRIP_TAC THEN + MATCH_MP_TAC(REAL_RING + `z:real = x * y ==> (p * x) * q * y = (p * q) * z`) THEN + FIRST_X_ASSUM(SUBST1_TAC o SYM) THEN REWRITE_TAC[REAL_POW_ADD]] THEN + MATCH_MP_TAC PRODUCT_MUL_GEN THEN + REWRITE_TAC[REAL_POW_EQ_1; SET_RULE + `{i | i IN UNIV /\ ~(p i \/ q i)} = {i | i IN {j | ~q j} /\ ~p i}`] THEN + RULE_ASSUM_TAC(REWRITE_RULE[ratpoly]) THEN + ASM_SIMP_TAC[FINITE_RESTRICT]]);; + +let RATPOLYFUN_POW = prove + (`!p r s. ratpolyfun s (\(n,k). p n k) + ==> ratpolyfun s (\(n,k). (p n k) pow r)`, + GEN_TAC THEN ONCE_REWRITE_TAC[SWAP_FORALL_THM] THEN GEN_TAC THEN + REWRITE_TAC[RIGHT_FORALL_IMP_THM] THEN DISCH_TAC THEN + INDUCT_TAC THEN SIMP_TAC[real_pow; RATPOLYFUN_CONST; RATIONAL_CLOSED] THEN + ASM_SIMP_TAC[RATPOLYFUN_MUL]);; + +let RATPOLYFUN_TAC = + REPEAT((MATCH_MP_TAC RATPOLYFUN_NEG) ORELSE + (MATCH_MP_TAC RATPOLYFUN_POW) ORELSE + (MATCH_MP_TAC RATPOLYFUN_ADD THEN CONJ_TAC) ORELSE + (MATCH_MP_TAC RATPOLYFUN_SUB THEN CONJ_TAC) ORELSE + (MATCH_MP_TAC RATPOLYFUN_MUL THEN CONJ_TAC)) THEN + REWRITE_TAC[RATPOLYFUN_VAR] THEN + ((MATCH_MP_TAC RATPOLYFUN_PARAMETER THEN + REWRITE_TAC[FINITE_INSERT; FINITE_EMPTY; IN_INSERT] THEN + NO_TAC) ORELSE + (MATCH_MP_TAC RATPOLYFUN_CONST THEN + ASM_SIMP_TAC[RATIONAL_CLOSED]));; + +(* ------------------------------------------------------------------------- *) +(* The magical set avoiding all rational algebraic varieties. *) +(* ------------------------------------------------------------------------- *) + +let ratty = new_definition + `ratty s t <=> ?p. ratpolyfun s p /\ p t = &0 /\ ~(!w. p w = &0)`;; + +let magical_set = new_definition + `magical_set s = + INTERS { {z | ~((FST p)(FST(SND p) + Re z,SND(SND p) + Im z) = &0)} | + p IN (ratpolyfun s DELETE (\x. &0)) CROSS + (integer CROSS integer)}`;; + +let IN_MAGICAL_SET_IMP_NOT_RATTY = prove + (`!s d e n k. integer k /\ complex(d,e) IN magical_set s + ==> ~ratty s (&n + d,k + e)`, + REPEAT GEN_TAC THEN STRIP_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [magical_set]) THEN + REWRITE_TAC[INTERS_GSPEC; IN_ELIM_THM; FORALL_PAIR_THM; IN_CROSS] THEN + REWRITE_TAC[ratty; NOT_EXISTS_THM] THEN + MATCH_MP_TAC MONO_FORALL THEN X_GEN_TAC `p:real#real->real` THEN + DISCH_THEN(MP_TAC o SPECL [`&n:real`; `k:real`]) THEN + REWRITE_TAC[IN_DELETE] THEN ASM_SIMP_TAC[IN; INTEGER_CLOSED] THEN + ONCE_REWRITE_TAC[GSYM CONTRAPOS_THM] THEN REWRITE_TAC[] THEN STRIP_TAC THEN + ASM_REWRITE_TAC[FUN_EQ_THM; IM; RE]);; + +let DENSE_MAGICAL_SET = prove + (`closure (magical_set s) = (:complex)`, + REWRITE_TAC[SET_RULE `s = UNIV <=> UNIV DIFF s = {}`] THEN + REWRITE_TAC[GSYM INTERIOR_COMPLEMENT] THEN + REWRITE_TAC[magical_set; INTERS_UNIONS] THEN + REWRITE_TAC[SET_RULE `UNIV DIFF (UNIV DIFF s) = s`] THEN + MATCH_MP_TAC NOWHERE_DENSE_COUNTABLE_UNIONS THEN CONJ_TAC THENL + [REWRITE_TAC[SIMPLE_IMAGE] THEN MATCH_MP_TAC COUNTABLE_IMAGE THEN + MATCH_MP_TAC COUNTABLE_IMAGE THEN + MATCH_MP_TAC COUNTABLE_CROSS THEN + SIMP_TAC[COUNTABLE_CROSS; COUNTABLE_INTEGER; COUNTABLE_RATPOLYFUN; + COUNTABLE_DELETE]; + ALL_TAC] THEN + REWRITE_TAC[FORALL_IN_GSPEC; SET_RULE + `UNIV DIFF {z | ~P z} = {x | P x}`] THEN + REWRITE_TAC[FORALL_PAIR_THM; IN_CROSS; IN_DELETE] THEN + MAP_EVERY X_GEN_TAC [`p:real#real->real`; `n:real`; `k:real`] THEN + REWRITE_TAC[IN] THEN STRIP_TAC THEN + ABBREV_TAC `q:complex->real = \z. p(n + Re z,k + Im z)` THEN + SUBGOAL_THEN `real_polynomial_function (q:complex->real)` ASSUME_TAC THENL + [ALL_TAC; + MATCH_MP_TAC NOWHERE_DENSE_ALGEBRAIC_VARIETY THEN + ASM_REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o check (is_neg o concl)) THEN + REWRITE_TAC[CONTRAPOS_THM; FORALL_PAIR_THM; FUN_EQ_THM] THEN + DISCH_TAC THEN + MAP_EVERY X_GEN_TAC [`x:real`; `y:real`] THEN + FIRST_X_ASSUM(MP_TAC o SPEC `complex(x - n,y - k)`) THEN + REWRITE_TAC[RE; IM; REAL_SUB_ADD2]] THEN + SUBGOAL_THEN + `q:complex->real = (\z. p(Re z,Im z)) o (\z. complex(n,k) + z)` + SUBST1_TAC THENL + [EXPAND_TAC "q" THEN + REWRITE_TAC[o_DEF; FUN_EQ_THM; RE; IM; RE_ADD; IM_ADD]; + MATCH_MP_TAC REAL_VECTOR_POLYNOMIAL_FUNCTION_o] THEN + SIMP_TAC[VECTOR_POLYNOMIAL_FUNCTION_ADD; VECTOR_POLYNOMIAL_FUNCTION_ID; + VECTOR_POLYNOMIAL_FUNCTION_CONST] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [ratpolyfun]) THEN + DISCH_THEN(X_CHOOSE_THEN `q:(num->num)->real` STRIP_ASSUME_TAC) THEN + FIRST_X_ASSUM SUBST1_TAC THEN REWRITE_TAC[] THEN + ASM_SIMP_TAC[POLY_EVAL_RATPOLY] THEN + MATCH_MP_TAC REAL_POLYNOMIAL_FUNCTION_SUM THEN + RULE_ASSUM_TAC(REWRITE_RULE[ratpoly]) THEN ASM_REWRITE_TAC[] THEN + X_GEN_TAC `m:num->num` THEN REWRITE_TAC[IN_ELIM_THM] THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_POLYNOMIAL_FUNCTION_MUL THEN + REWRITE_TAC[real_polynomial_function_RULES] THEN + MATCH_MP_TAC REAL_POLYNOMIAL_FUNCTION_PRODUCT THEN + ASM_SIMP_TAC[IN_ELIM_THM] THEN X_GEN_TAC `i:num` THEN DISCH_TAC THEN + MATCH_MP_TAC REAL_POLYNOMIAL_FUNCTION_POW THEN + SPEC_TAC(`i:num`,`j:num`) THEN MATCH_MP_TAC num_INDUCTION THEN + SIMP_TAC[RE_DEF; real_polynomial_function_RULES; DIMINDEX_2; ARITH; + EL; HD; TL; IM_DEF] THEN + MATCH_MP_TAC num_INDUCTION THEN + SIMP_TAC[real_polynomial_function_RULES; DIMINDEX_2; ARITH; EL; HD; TL]);; + +let APPROACHABLE_WITHIN_AUGMENTED_MAGICAL_SET = prove + (`!p s. open s /\ Cx(&0) limit_point_of s + ==> ~trivial_limit (at(Cx(&0)) within (s INTER magical_set p))`, + REWRITE_TAC[TRIVIAL_LIMIT_WITHIN; GSYM IN_CLOSURE_DELETE] THEN + REWRITE_TAC[SET_RULE `(s INTER t) DELETE a = (s DELETE a) INTER t`] THEN + ASM_SIMP_TAC[CLOSURE_OPEN_INTER_SUPERSET; DENSE_MAGICAL_SET; SUBSET_UNIV; + OPEN_DELETE]);; + +(* ------------------------------------------------------------------------- *) +(* The key theorem supporting the WZ method. *) +(* ------------------------------------------------------------------------- *) + +let ZEILBERGER_GEN = prove + (`!P e f h ff hh p q s. + open s /\ Cx(&0) limit_point_of (s INTER {z | &0 < Re z}) /\ + ((!n. FINITE {k | ~(f n k = &0)}) /\ + (!n. FINITE {k | ~(h n k = &0)})) /\ + ((!n k. P n ==> (ff ---> f n k) (at(complex(&n,&k)) within + { complex(&n,&k) + x | x IN s})) /\ + (!n k. P n ==> (hh ---> h n k) (at(complex(&n,&k)) + within { complex(&n,&k) + x | x IN s}))) /\ + (ratpolyfun e p /\ ratpolyfun e q) /\ + (!n. P n ==> ~(q(&n,&0) = &0)) /\ + (!n k. ~ratty e (n,k) /\ &0 < n + ==> hh(complex(n,k)) = + p(n,k + &1) / q(n,k + &1) * ff(complex(n,k + &1)) - + p(n,k) / q(n,k) * ff(complex(n,k))) + ==> !n. P n + ==> sum (:num) (\k. h n k) = --(p(&n,&0) / q(&n,&0) * f n 0)`, + let lemma = prove + (`(f ---> l) (at a within {a + z | z IN s}) <=> + ((\w. f(a + w)) ---> l) (at (Cx(&0)) within s)`, + REWRITE_TAC[REALLIM_WITHIN] THEN + REWRITE_TAC[IMP_CONJ; FORALL_IN_GSPEC] THEN + REWRITE_TAC[dist; COMPLEX_SUB_RZERO; VECTOR_ARITH + `(a + z) - a:complex = z`]) in + REWRITE_TAC[lemma] THEN REPEAT STRIP_TAC THEN + REPEAT(FIRST_X_ASSUM(MP_TAC o SPEC `n:num`)) THEN + ASM_REWRITE_TAC[] THEN UNDISCH_THEN `(P:num->bool) n` (K ALL_TAC) THEN + REPEAT STRIP_TAC THEN + SUBGOAL_THEN + `?m. ~(q(&n,&m + &1) = &0) /\ + (!k. ~(f n k = &0) ==> k < m) /\ + (!k. ~(h n k = &0) ==> k < m)` + STRIP_ASSUME_TAC THENL + [SUBGOAL_THEN + `FINITE {k | ~((f:num->num->real) n k = &0)} /\ + FINITE {k | ~((h:num->num->real) n k = &0)}` + MP_TAC THENL [ASM_REWRITE_TAC[]; ALL_TAC] THEN + SUBGOAL_THEN + `FINITE {k | (q:real#real->real)(&n,&k) = &0}` + MP_TAC THENL + [REWRITE_TAC[SET_RULE + `{k | (q:real#real->real)(&n,&k) = &0} = + {k | &k IN {x | (q:real#real->real)(&n,x) = &0}}`] THEN + MATCH_MP_TAC FINITE_IMAGE_INJ THEN REWRITE_TAC[REAL_OF_NUM_EQ] THEN + W(MP_TAC o PART_MATCH (lhs o rand) + POLYNOMIAL_FUNCTION_FINITE_ROOTS o snd) THEN + ANTS_TAC THENL [ALL_TAC; ASM_MESON_TAC[]] THEN + UNDISCH_TAC `ratpolyfun e q` THEN + REWRITE_TAC[ratpolyfun; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `s:(num->num)->real` THEN STRIP_TAC THEN + ASM_SIMP_TAC[POLY_EVAL_RATPOLY] THEN + MATCH_MP_TAC POLYNOMIAL_FUNCTION_SUM THEN + RULE_ASSUM_TAC(REWRITE_RULE[ratpoly]) THEN + ASM_REWRITE_TAC[IN_ELIM_THM; REAL_MUL_ASSOC] THEN + REPEAT STRIP_TAC THEN + MATCH_MP_TAC POLYNOMIAL_FUNCTION_MUL THEN + REWRITE_TAC[POLYNOMIAL_FUNCTION_CONST] THEN + MATCH_MP_TAC POLYNOMIAL_FUNCTION_PRODUCT THEN + ASM_SIMP_TAC[IN_ELIM_THM] THEN + X_GEN_TAC `i:num` THEN DISCH_TAC THEN + MATCH_MP_TAC POLYNOMIAL_FUNCTION_POW THEN + SPEC_TAC(`i:num`,`j:num`) THEN MATCH_MP_TAC num_INDUCTION THEN + REWRITE_TAC[EL; HD; POLYNOMIAL_FUNCTION_CONST] THEN + MATCH_MP_TAC num_INDUCTION THEN + REWRITE_TAC[EL; HD; POLYNOMIAL_FUNCTION_CONST; TL] THEN + REWRITE_TAC[POLYNOMIAL_FUNCTION_ID]; + ALL_TAC] THEN + REWRITE_TAC[IMP_IMP; GSYM FINITE_UNION] THEN DISCH_THEN + (MP_TAC o SPEC `\i:num. i` o MATCH_MP UPPER_BOUND_FINITE_SET) THEN + REWRITE_TAC[FORALL_IN_UNION; IN_ELIM_THM] THEN + MATCH_MP_TAC(MESON[] + `(!a. P a ==> Q(a + 1)) ==> ((?a. P a) ==> (?b. Q b))`) THEN + SIMP_TAC[REAL_OF_NUM_ADD; ARITH_RULE `m < n + 1 <=> m <= n`] THEN + MESON_TAC[ARITH_RULE `~((a + 1) + 1 <= a)`]; + ALL_TAC] THEN + MATCH_MP_TAC(ISPEC `at (Cx(&0)) within + ((s INTER {z | &0 < Re z}) INTER magical_set e)` + REALLIM_UNIQUE) THEN + EXISTS_TAC `\z. sum (0..m) (\k. hh(complex(&n,&k) + z))` THEN + ASM_SIMP_TAC[APPROACHABLE_WITHIN_AUGMENTED_MAGICAL_SET; + OPEN_INTER; REWRITE_RULE[real_gt] OPEN_HALFSPACE_RE_GT] THEN + CONJ_TAC THENL + [SUBGOAL_THEN + `sum (:num) (\k. (h:num->num->real) n k) = + sum (0..m) (\k. (h:num->num->real) n k)` + SUBST1_TAC THENL + [MATCH_MP_TAC SUM_SUPERSET THEN + REWRITE_TAC[SUBSET_UNIV; IN_UNIV; IN_NUMSEG; LE_0] THEN + ASM_MESON_TAC[LT_IMP_LE]; + MATCH_MP_TAC REALLIM_SUM THEN + REWRITE_TAC[FINITE_NUMSEG; IN_NUMSEG] THEN X_GEN_TAC `k:num` THEN + STRIP_TAC THEN MATCH_MP_TAC REALLIM_WITHIN_SUBSET THEN + EXISTS_TAC `s:complex->bool` THEN ASM_REWRITE_TAC[] THEN SET_TAC[]]; + MATCH_MP_TAC REALLIM_TRANSFORM_EVENTUALLY THEN + EXISTS_TAC + `\z. sum (0..m) + (\k. p(&n + Re z,(&k + &1) + Im z) / + q(&n + Re z,(&k + &1) + Im z) * + ff(complex (&n,&k + &1) + z) - + p(&n + Re z,&k + Im z) / + q(&n + Re z,&k + Im z) * + ff(complex (&n,&k) + z))` THEN + REWRITE_TAC[] THEN CONJ_TAC THENL + [REWRITE_TAC[EVENTUALLY_WITHIN] THEN EXISTS_TAC `&1` THEN + REWRITE_TAC[REAL_LT_01; GSYM DIST_NZ] THEN X_GEN_TAC `w:complex` THEN + STRIP_TAC THEN REWRITE_TAC[complex_add; RE; IM] THEN + MATCH_MP_TAC SUM_EQ THEN REWRITE_TAC[FINITE_INTSEG] THEN + X_GEN_TAC `k:num` THEN REWRITE_TAC[IN_ELIM_THM] THEN STRIP_TAC THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD; REAL_ARITH + `(x + &1) + y = (x + y) + &1`] THEN + CONV_TAC SYM_CONV THEN FIRST_X_ASSUM MATCH_MP_TAC THEN CONJ_TAC THENL + [MATCH_MP_TAC IN_MAGICAL_SET_IMP_NOT_RATTY THEN + ASM_REWRITE_TAC[COMPLEX; INTEGER_CLOSED] THEN ASM SET_TAC[]; + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE I [IN_INTER]) THEN + REWRITE_TAC[IN_INTER; IN_ELIM_THM] THEN REAL_ARITH_TAC]; + ALL_TAC] THEN + REWRITE_TAC[REAL_OF_NUM_ADD; SUM_DIFFS_ALT; LE_0] THEN + SUBGOAL_THEN + `--(p (&n,&0) / q (&n,&0) * f n 0):real = + p(&n,&(m + 1)) / q(&n,&(m + 1)) * f n (m + 1) - + p(&n,&0) / q(&n,&0) * f n 0` + SUBST1_TAC THENL + [MATCH_MP_TAC(REAL_RING `b = &0 ==> --y = a * b - y`) THEN + ASM_MESON_TAC[ARITH_RULE `~(m + 1 < m)`]; + ALL_TAC] THEN + MATCH_MP_TAC REALLIM_SUB THEN CONJ_TAC THEN + MATCH_MP_TAC REALLIM_MUL THEN + (CONJ_TAC THENL + [ALL_TAC; + MATCH_MP_TAC REALLIM_WITHIN_SUBSET THEN + EXISTS_TAC `s:complex->bool` THEN ASM_REWRITE_TAC[] THEN + ASM SET_TAC[]]) THEN + MATCH_MP_TAC(MESON[REAL_CONTINUOUS_AT_WITHIN; REAL_CONTINUOUS_WITHIN] + `f real_continuous at z /\ f z = l ==> (f ---> l) (at z within s)`) THEN + REWRITE_TAC[IM_CX; RE_CX; REAL_ADD_RID] THEN + MATCH_MP_TAC REAL_CONTINUOUS_DIV_AT THEN + ASM_REWRITE_TAC[RE_CX; IM_CX; REAL_ADD_RID; GSYM REAL_OF_NUM_ADD] THEN + (CONJ_TAC THENL + [UNDISCH_TAC `ratpolyfun e p`; UNDISCH_TAC `ratpolyfun e q`]) THEN + REWRITE_TAC[ratpolyfun; LEFT_IMP_EXISTS_THM] THEN + X_GEN_TAC `s:(num->num)->real` THEN STRIP_TAC THEN + ASM_SIMP_TAC[POLY_EVAL_RATPOLY] THEN + MATCH_MP_TAC REAL_CONTINUOUS_SUM THEN + RULE_ASSUM_TAC(REWRITE_RULE[ratpoly]) THEN + ASM_REWRITE_TAC[IN_ELIM_THM] THEN REPEAT STRIP_TAC THEN + MATCH_MP_TAC REAL_CONTINUOUS_LMUL THEN + MATCH_MP_TAC REAL_CONTINUOUS_PRODUCT THEN + ASM_SIMP_TAC[IN_ELIM_THM] THEN X_GEN_TAC `i:num` THEN + DISCH_TAC THEN MATCH_MP_TAC REAL_CONTINUOUS_POW THEN + SPEC_TAC(`i:num`,`j:num`) THEN + REPLICATE_TAC 2 (TRY(MATCH_MP_TAC num_INDUCTION THEN + REWRITE_TAC[EL; HD; TL] THEN CONJ_TAC)) THEN + REWRITE_TAC[REAL_CONTINUOUS_CONST] THEN + REPEAT(DISCH_THEN(K ALL_TAC)) THEN + MATCH_MP_TAC REAL_CONTINUOUS_ADD THEN + REWRITE_TAC[REAL_CONTINUOUS_CONST] THEN + REWRITE_TAC[REAL_CONTINUOUS_COMPLEX_COMPONENTS_AT]]);; + +(* ------------------------------------------------------------------------- *) +(* The basic case that we normally use. *) +(* ------------------------------------------------------------------------- *) + +let ZEILBERGER = prove + (`!P e f h ff hh p q. + ((!n. FINITE {k | ~(f n k = &0)}) /\ + (!n. FINITE {k | ~(h n k = &0)})) /\ + ((!n k. P n ==> (ff ---> f n k) (at(complex(&n,&k)))) /\ + (!n k. P n ==> (hh ---> h n k) (at(complex(&n,&k))))) /\ + (ratpolyfun e p /\ ratpolyfun e q) /\ + (!n. P n ==> ~(q(&n,&0) = &0)) /\ + (!n k. ~ratty e (n,k) /\ &0 < n + ==> hh(complex(n,k)) = + p(n,k + &1) / q(n,k + &1) * ff(complex(n,k + &1)) - + p(n,k) / q(n,k) * ff(complex(n,k))) + ==> !n. P n + ==> sum (:num) (\k. h n k) = --(p(&n,&0) / q(&n,&0) * f n 0)`, + MP_TAC ZEILBERGER_GEN THEN + REPLICATE_TAC 8 (MATCH_MP_TAC MONO_FORALL THEN GEN_TAC) THEN + DISCH_THEN(MP_TAC o SPEC `(:complex)`) THEN + REWRITE_TAC[OPEN_UNIV; INTER_UNIV] THEN + GEN_REWRITE_TAC LAND_CONV [IMP_CONJ] THEN ANTS_TAC THENL + [REWRITE_TAC[GSYM IN_CLOSURE_DELETE] THEN SIMP_TAC[SET_RULE + `~(a IN s) ==> s DELETE a = s`; IN_ELIM_THM; RE_CX; REAL_LT_REFL] THEN + REWRITE_TAC[RE_DEF; GSYM real_gt; CLOSURE_HALFSPACE_COMPONENT_GT] THEN + REWRITE_TAC[GSYM RE_DEF; RE_CX; IN_ELIM_THM] THEN REAL_ARITH_TAC; + SUBGOAL_THEN + `!w. {w + z | z IN (:complex)} = (:complex)` + (fun th -> REWRITE_TAC[th; WITHIN_UNIV]) THEN + GEN_TAC THEN REWRITE_TAC[SIMPLE_IMAGE] THEN + MATCH_MP_TAC SURJECTIVE_IMAGE_EQ THEN + REWRITE_TAC[IN_UNIV; COMPLEX_RING `w + z:complex = y <=> z = y - w`] THEN + REWRITE_TAC[EXISTS_REFL]]);; + +(* ------------------------------------------------------------------------- *) +(* Finite-support preprocessing for summands over the natural numbers. *) +(* ------------------------------------------------------------------------- *) + +let FINITE_SUPPORT_BINOM = prove + (`!m n. (!k. k <= m k) ==> FINITE {k | ~(binom(n,m k) = 0)}`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC FINITE_SUBSET THEN EXISTS_TAC `0..n` THEN + REWRITE_TAC[FINITE_NUMSEG; BINOM_EQ_0; SUBSET; IN_ELIM_THM; IN_NUMSEG] THEN + X_GEN_TAC `k:num` THEN FIRST_X_ASSUM(MP_TAC o SPEC `k:num`) THEN ARITH_TAC);; + +let FINITE_SUPPORT_ADD = prove + (`!f g:A->num. + FINITE {k | ~(f k = 0)} /\ FINITE {k | ~(g k = 0)} + ==> FINITE {k | ~(f k + g k = 0)}`, + REPEAT GEN_TAC THEN REWRITE_TAC[GSYM FINITE_UNION] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET) THEN + REWRITE_TAC[SUBSET; IN_UNION; IN_ELIM_THM] THEN ARITH_TAC);; + +let FINITE_SUPPORT_MUL = prove + (`!f g:A->num. + FINITE {k | ~(f k = 0)} \/ FINITE {k | ~(g k = 0)} + ==> FINITE {k | ~(f k * g k = 0)}`, + REPEAT GEN_TAC THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET) THEN + REWRITE_TAC[SUBSET; IN_INTER; IN_ELIM_THM] THEN CONV_TAC NUM_RING);; + +let rec FINITE_SUPPORT_TAC gl = + ((MATCH_MP_TAC FINITE_SUPPORT_BINOM THEN ARITH_TAC) ORELSE + (MATCH_MP_TAC FINITE_SUPPORT_ADD THEN + CONJ_TAC THEN FINITE_SUPPORT_TAC) ORELSE + (MATCH_MP_TAC FINITE_SUPPORT_MUL THEN + ((DISJ1_TAC THEN FINITE_SUPPORT_TAC) ORELSE + (DISJ2_TAC THEN FINITE_SUPPORT_TAC)))) gl;; + +(* ------------------------------------------------------------------------- *) +(* A variant over the reals that devolves to the above at the base. *) +(* ------------------------------------------------------------------------- *) + +let FINITE_SUPPORT_REAL_ADD = prove + (`!f g:A->real. + FINITE {k | ~(f k = &0)} /\ FINITE {k | ~(g k = &0)} + ==> FINITE {k | ~(f k + g k = &0)}`, + REPEAT GEN_TAC THEN REWRITE_TAC[GSYM FINITE_UNION] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET) THEN + REWRITE_TAC[SUBSET; IN_UNION; IN_ELIM_THM] THEN REAL_ARITH_TAC);; + +let FINITE_SUPPORT_REAL_SUB = prove + (`!f g:A->real. + FINITE {k | ~(f k = &0)} /\ FINITE {k | ~(g k = &0)} + ==> FINITE {k | ~(f k - g k = &0)}`, + REPEAT GEN_TAC THEN REWRITE_TAC[GSYM FINITE_UNION] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET) THEN + REWRITE_TAC[SUBSET; IN_UNION; IN_ELIM_THM] THEN REAL_ARITH_TAC);; + +let FINITE_SUPPORT_REAL_INV = prove + (`!f:A->real. + FINITE {k | ~(f k = &0)} ==> FINITE {k | ~(inv(f k) = &0)}`, + REWRITE_TAC[REAL_INV_EQ_0]);; + +let FINITE_SUPPORT_REAL_POW = prove + (`!f:A->real n. + FINITE {k | ~(f k = &0)} /\ ~(n = 0) + ==> FINITE {k | ~(f k pow n = &0)}`, + SIMP_TAC[REAL_POW_EQ_0] THEN SET_TAC[]);; + +let FINITE_SUPPORT_SPOW = prove + (`!f:A->real y. + FINITE {k | ~(f k = &0)} /\ ~(y = &0) + ==> FINITE {k | ~(f k spow y = &0)}`, + REPEAT GEN_TAC THEN SIMP_TAC[SPOW_EQ_0] THEN + DISCH_THEN(MP_TAC o CONJUNCT1) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET) THEN + SET_TAC[]);; + +let FINITE_SUPPORT_REAL_MUL = prove + (`!f g:A->real. + FINITE {k | ~(f k = &0)} \/ FINITE {k | ~(g k = &0)} + ==> FINITE {k | ~(f k * g k = &0)}`, + REPEAT GEN_TAC THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET) THEN + REWRITE_TAC[REAL_ENTIRE] THEN SET_TAC[]);; + +let FINITE_SUPPORT_REAL_DIV = prove + (`!f g:A->real. + FINITE {k | ~(f k = &0)} \/ FINITE {k | ~(g k = &0)} + ==> FINITE {k | ~(f k / g k = &0)}`, + REPEAT GEN_TAC THEN DISCH_THEN(DISJ_CASES_THEN MP_TAC) THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET) THEN + REWRITE_TAC[REAL_DIV_EQ_0] THEN SET_TAC[]);; + +let FINITE_SUPPORT_REAL_OF_NUM = prove + (`!f:A->num. + FINITE {k | ~(f k = 0)} ==> FINITE {k | ~(&(f k) = &0)}`, + REWRITE_TAC[REAL_OF_NUM_EQ]);; + +let rec REAL_FINITE_SUPPORT_TAC gl = + ((MATCH_MP_TAC FINITE_SUPPORT_REAL_OF_NUM THEN FINITE_SUPPORT_TAC) ORELSE + (MATCH_MP_TAC FINITE_SUPPORT_REAL_INV THEN + REAL_FINITE_SUPPORT_TAC) ORELSE + (MATCH_MP_TAC FINITE_SUPPORT_REAL_POW THEN + CONJ_TAC THENL [REAL_FINITE_SUPPORT_TAC; ARITH_TAC]) ORELSE + (MATCH_MP_TAC FINITE_SUPPORT_SPOW THEN + CONJ_TAC THENL [REAL_FINITE_SUPPORT_TAC; REAL_ARITH_TAC]) ORELSE + ((MATCH_MP_TAC FINITE_SUPPORT_REAL_ADD ORELSE + MATCH_MP_TAC FINITE_SUPPORT_REAL_SUB) THEN + CONJ_TAC THEN FINITE_SUPPORT_TAC) ORELSE + ((MATCH_MP_TAC FINITE_SUPPORT_REAL_MUL ORELSE + MATCH_MP_TAC FINITE_SUPPORT_REAL_DIV) THEN + ((DISJ1_TAC THEN REAL_FINITE_SUPPORT_TAC) ORELSE + (DISJ2_TAC THEN REAL_FINITE_SUPPORT_TAC)))) gl;; + +(* ------------------------------------------------------------------------- *) +(* Establish support containment, universalization and finite support. *) +(* ------------------------------------------------------------------------- *) + +let support_containment = + let dummy = prove + (`(!n k. ~(k IN s n) ==> f n k = &0) + ==> !n. sum (s n) (f n) = sum (s n) (f n)`, + REWRITE_TAC[]) in + fun ntm tm -> + let th = PART_MATCH rand dummy (mk_forall(ntm,mk_eq(tm,tm))) in + let tm' = lhand(concl th) in + let th' = funpow 2 BINDER_CONV + (RAND_CONV (LAND_CONV(TRY_CONV BETA_CONV))) tm' in + rand(concl th');; + +let finite_support = + let dummy = prove + (`(!n. FINITE {k | ~(f n k = &0)}) + ==> !n. sum (s n) (f n) = sum (s n) (f n)`, + REWRITE_TAC[]) in + fun ntm tm -> + let th = PART_MATCH rand dummy (mk_forall(ntm,mk_eq(tm,tm))) in + let tm' = lhand(concl th) in + let th' = + BINDER_CONV (RAND_CONV (RAND_CONV (ABS_CONV (BINDER_CONV + (LAND_CONV (RAND_CONV (LAND_CONV (TRY_CONV BETA_CONV)))))))) tm' in + rand(concl th');; + +let SUPPORT_CONTAINMENT_TAC = + REWRITE_TAC[IN_NUMSEG; REAL_ENTIRE; REAL_DIV_EQ_0; REAL_OF_NUM_EQ; + BINOM_EQ_0; SPOW_EQ_0; REAL_POW_EQ_0; ARITH_EQ; FACT_NZ; + REAL_NEG_EQ_0; IN_UNIV; IN_ELIM_THM; NOT_IN_EMPTY] THEN + ASM_ARITH_TAC;; + +let SUPPORT_CONTAINMENT_IMP_UNIVERSALIZE = prove + (`(!n k. ~(k IN s n) ==> f n k = &0) + ==> !n:num. sum (s n) (f n) = sum (:num) (f n)`, + REPEAT STRIP_TAC THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC SUM_SUPERSET THEN + ASM SET_TAC[]);; + +let SUPPORT_CONTAINMENT_IMP_FINITE = prove + (`(!n k. ~(k IN a n..b n) ==> f n k = &0) + ==> !n:num. FINITE {k | ~(f n k = &0)}`, + REPEAT STRIP_TAC THEN + MATCH_MP_TAC FINITE_SUBSET THEN + EXISTS_TAC `a(n:num)..b n` THEN + REWRITE_TAC[FINITE_NUMSEG] THEN ASM SET_TAC[]);; + +let SUPPORT_RULE ntm tm = + let cth = prove(support_containment ntm tm,SUPPORT_CONTAINMENT_TAC) in + let eth = + CONV_RULE (BINDER_CONV (BINOP_CONV (RAND_CONV (TRY_CONV BETA_CONV)))) + (MATCH_MP SUPPORT_CONTAINMENT_IMP_UNIVERSALIZE cth) in + let fth = + try MATCH_MP SUPPORT_CONTAINMENT_IMP_FINITE cth + with Failure _ -> + prove(finite_support ntm tm,GEN_TAC THEN REAL_FINITE_SUPPORT_TAC) in + cth,eth,fth;; + +(* ------------------------------------------------------------------------- *) +(* Convert core term into its limit variant. *) +(* ------------------------------------------------------------------------- *) + +let pats = + [`&(binom(p,q))`,`rbinom(&p,&q)`; + `&(FACT p)`,`rfact(&p)`; + `&(p + q)`,`&p + &q`; + `&(p - q)`,`&p - &q`; + `&(p * q)`,`&p * &q`; + `&(p EXP n)`,`&p pow n`];; + +let repper tm = + tryfind (fun (ptm,qtm) -> instantiate (term_match [] ptm tm) qtm) + pats;; + +let ron_tm = `(&):num->real`;; + +let real_ty = `:real`;; + +let rec limit_variant ktm ntm tm = + let tm' = try repper tm with Failure _ -> tm in + if is_comb tm' then + let ltm,rtm = dest_comb tm' in + if ltm = ron_tm && (rtm = ktm || rtm = ntm) + then mk_var(fst(dest_var rtm),real_ty) + else mk_comb(limit_variant ktm ntm ltm,limit_variant ktm ntm rtm) + else tm';; + +(* ------------------------------------------------------------------------- *) +(* Convert the initial problem to the three key theorems. *) +(* ------------------------------------------------------------------------- *) + +let add_tm = `(+):num->num->num`;; + +let pth_mult = prove + (`(!k. ~(k IN s) ==> f k = &0) /\ + sum s (\k. f k) = sum (:num) (\k. f k) /\ + FINITE {k | ~(f k = &0)} + ==> !c. (!k. ~(k IN s) ==> c * f k = &0) /\ + c * sum s (\k. f k) = sum (:num) (\k. c * f k) /\ + FINITE {k | ~(c * f k = &0)}`, + REPEAT GEN_TAC THEN REWRITE_TAC[ETA_AX] THEN + STRIP_TAC THEN GEN_TAC THEN REPEAT CONJ_TAC THEN + ASM_REWRITE_TAC[SUM_LMUL] THEN ASM_SIMP_TAC[REAL_ENTIRE] THEN + FIRST_X_ASSUM(MATCH_MP_TAC o MATCH_MP (REWRITE_RULE[IMP_CONJ] + FINITE_SUBSET)) THEN + SIMP_TAC[SUBSET; IN_ELIM_THM; CONTRAPOS_THM]);; + +let pth_add = prove + (`((!k. ~(k IN s) ==> f' k = &0) /\ + f = sum (:num) (\k. f' k) /\ + FINITE {k | ~(f' k = &0)}) /\ + ((!k. ~(k IN t) ==> g' k = &0) /\ + g = sum (:num) (\k. g' k) /\ + FINITE {k | ~(g' k = &0)}) + ==> ((!k. ~(k IN s UNION t) ==> f' k + g' k = &0) /\ + f + g = + sum (:num) (\k. f' k + g' k) /\ + FINITE {k | ~(f' k + g' k = &0)})`, + SIMP_TAC[IN_UNION; DE_MORGAN_THM; REAL_ADD_LID] THEN + SIMP_TAC[SUM_ADD_GEN; IN_UNIV; ETA_AX] THEN + DISCH_THEN(CONJUNCTS_THEN (MP_TAC o last o CONJUNCTS)) THEN + REWRITE_TAC[IMP_IMP; GSYM FINITE_UNION] THEN + MATCH_MP_TAC(REWRITE_RULE[IMP_CONJ_ALT] FINITE_SUBSET) THEN + REWRITE_TAC[SUBSET; IN_UNION; IN_ELIM_THM] THEN REAL_ARITH_TAC);; + +let OUTPUT_SIMP_CONV = + REWRITE_CONV[real_div; REAL_INV_MUL; REAL_INV_POW; REAL_INV_INV] THENC + NUM_REDUCE_CONV THENC REWRITE_CONV[ADD_CLAUSES; MULT_CLAUSES] THENC + REWRITE_CONV[CONJUNCT1 binom; BINOM_REFL] THENC + REAL_RAT_REDUCE_CONV THENC + REWRITE_CONV[REAL_MUL_LZERO; REAL_INV_0; REAL_MUL_RZERO] THENC + REAL_RAT_REDUCE_CONV THENC + REWRITE_CONV[REAL_MUL_LZERO; REAL_INV_0; REAL_MUL_RZERO] THENC + REAL_RAT_REDUCE_CONV;; + +let WZ_INITIAL_REDUCTIONS ntm stm rtm ctm atm = + let ktm,bod = dest_abs (rand stm) in + let parms = + filter (fun t -> type_of t = `:real`) + (map (fun t -> if type_of t = `:num` then mk_comb(`real_of_num`,t) + else t) + (subtract (frees stm) [ntm])) in + let nntm = mk_var(fst(dest_var ntm),real_ty) + and kktm = mk_var(fst(dest_var ktm),real_ty) in + + let cth0,eth0,fth0 = SUPPORT_RULE ntm stm in + let cmbth0 = + GEN ntm (CONJ (SPEC ntm cth0) (CONJ (SPEC ntm eth0) (SPEC ntm fth0))) in + let cths = + map (fun (c,i) -> + let ntm' = if i = 0 then ntm + else mk_comb(mk_comb(add_tm,ntm),mk_small_numeral i) in + SPEC c (MATCH_MP pth_mult (SPEC ntm' cmbth0))) + (zip ctm (0--(length ctm-1))) in + let efth1 = + CONJUNCT2 + (end_itlist (fun th1 th2 -> MATCH_MP pth_add (CONJ th1 th2)) cths) in + let eth1 = CONJUNCT1 efth1 + and fth1 = CONJUNCT2 efth1 in + let eth = GEN ntm eth1 + and fth = GEN ntm fth1 in + + let hbod = body(rand(rand(concl eth1))) + and rtm' = subst [nntm,mk_comb(ron_tm,ntm); kktm,mk_comb(ron_tm,ktm)] + rtm in + let ptm = if atm = [] then concl TRUTH + else list_mk_conj atm in + let pth = + (REWRITE_CONV[REAL_OF_NUM_EQ; REAL_OF_NUM_LT; + REAL_OF_NUM_LE; REAL_OF_NUM_GT; + REAL_OF_NUM_GE; REAL_OF_NUM_SUC; + REAL_OF_NUM_ADD; REAL_OF_NUM_MUL; + REAL_OF_NUM_POW] THENC + REWRITE_CONV[GSYM LE_SUC_LT; + ARITH_RULE `~(m = n) <=> m + 1 <= n \/ n + 1 <= m`] THENC + REWRITE_CONV[GSYM REAL_OF_NUM_EQ; GSYM REAL_OF_NUM_LT; + GSYM REAL_OF_NUM_LE; GSYM REAL_OF_NUM_GT; + GSYM REAL_OF_NUM_GE; GSYM REAL_OF_NUM_SUC; + GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL; + GSYM REAL_OF_NUM_POW]) ptm in + + let th0 = + PURE_REWRITE_RULE[RE; IM] + (CONV_RULE (TOP_DEPTH_CONV GEN_BETA_CONV) + (SPECL [mk_abs(ntm,rand(concl pth)); + mk_setenum(parms,`:real`); + list_mk_abs([ntm;ktm],bod); + list_mk_abs([ntm;ktm],hbod); + mk_abs(`z:complex`, + subst [`Re z`,nntm; `Im z`,kktm] + (limit_variant ktm ntm bod)); + mk_abs(`z:complex`, + subst [`Re z`,nntm; `Im z`,kktm] + (limit_variant ktm ntm hbod)); + mk_gabs(mk_pair(nntm,kktm),lhand rtm'); + mk_gabs(mk_pair(nntm,kktm),rand rtm')] + ZEILBERGER)) in + let th1 = + MP (GEN_REWRITE_RULE I [IMP_CONJ] th0) + (CONJ fth0 fth) in + let th2 = GEN_REWRITE_RULE (RAND_CONV o BINDER_CONV o RAND_CONV o LAND_CONV) + [GSYM eth] th1 in + let th3 = GEN_REWRITE_RULE (RAND_CONV o BINDER_CONV o LAND_CONV) + [SYM pth] th2 in + let th4 = PURE_REWRITE_RULE[CONJUNCT1(SPEC_ALL IMP_CLAUSES)] th3 in + + let atms = filter (fun a -> not(free_in ntm a)) atm in + + atms,th4;; + +(* ------------------------------------------------------------------------- *) +(* Normalize terms to separate out non-constant part (usually linear form). *) +(* ------------------------------------------------------------------------- *) + +let SEPARATE_CONSTANT_CONV = + let pth = prove + (`x + &(SUC n) = (x + &1) + &n /\ + x + -- &(SUC n) = (x - &1) + -- &n`, + REWRITE_TAC[GSYM REAL_OF_NUM_SUC] THEN REAL_ARITH_TAC) in + let conv0 = GEN_REWRITE_CONV I [REAL_ADD_RID; REAL_ARITH `x + -- &0 = x`] + and conv1 = + (RAND_CONV(RAND_CONV num_CONV) THENC + GEN_REWRITE_CONV I [CONJUNCT1 pth]) ORELSEC + (RAND_CONV(RAND_CONV(RAND_CONV num_CONV)) THENC + GEN_REWRITE_CONV I [CONJUNCT2 pth]) in + REAL_POLY_CONV THENC + PURE_REWRITE_CONV[REAL_ADD_ASSOC] THENC + REPEATC conv1 THENC TRY_CONV conv0;; + +(* ------------------------------------------------------------------------- *) +(* Apply conv to rbinom, rfact, RHS argument of spow. *) +(* ------------------------------------------------------------------------- *) + +let pat_rfact = `rfact x` +and pat_rbinom = `rbinom(x,y)` +and pat_spow = `x spow y`;; + +let APPLY_FBPOW_CONV conv tm = + if can (term_match [] pat_rfact) tm || + can (term_match [] pat_spow) tm + then RAND_CONV conv tm + else if can (term_match [] pat_rbinom) tm + then RAND_CONV(BINOP_CONV conv) tm + else failwith "APPLY_FBPOW_CONV";; + +(* ------------------------------------------------------------------------- *) +(* Expand `rfact(n + &1)` and `rfact(n - &1)` *) +(* ------------------------------------------------------------------------- *) + +let pth_up = prove + (`~ratty e (n,k) + ==> ratpolyfun e (\(n,k). p n k) /\ ~(!n k. p n k + &1 = &0) + ==> rfact(p n k + &1) = (p n k + &1) * rfact(p n k)`, + REPEAT STRIP_TAC THEN REWRITE_TAC[RFACT_STEP_UP] THEN + COND_CASES_TAC THEN REWRITE_TAC[] THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [ratty]) THEN + REWRITE_TAC[NOT_EXISTS_THM] THEN + DISCH_THEN(MP_TAC o SPEC `(\(n,k). p n k + &1):real#real->real`) THEN + ASM_REWRITE_TAC[REAL_ADD_LINV] THEN + ASM_SIMP_TAC[RATPOLYFUN_ADD; RATPOLYFUN_CONST; RATIONAL_CLOSED] THEN + ASM_REWRITE_TAC[FORALL_PAIR_THM]);; + +let pth_down = prove + (`~ratty e (n,k) ==> rfact(p n k - &1) = rfact(p n k) / p n k`, + REWRITE_TAC[RFACT_STEP_DOWN]);; + +let RFACT_STEP_CONV nrth = + let pth_down' = MATCH_MP pth_down nrth + and pth_up' = MATCH_MP pth_up nrth in + fun tm -> + try PART_MATCH lhs pth_down' tm with Failure _ -> + let th = PART_MATCH (lhs o rand) pth_up' tm in + let sth = prove(lhand(concl th), + CONJ_TAC THENL [RATPOLYFUN_TAC; ALL_TAC] THEN + DISCH_THEN(MP_TAC o SPECL [`&1 / &12345`; `&7 / &44`]) THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN REAL_ARITH_TAC) in + MP th sth;; + +(* ------------------------------------------------------------------------- *) +(* Expand `rbinom(n +/- &1,k)`, `rbinom(n,k +/- &1)` *) +(* ------------------------------------------------------------------------- *) + +let pth_top_down = prove + (`~ratty e (n,k) + ==> rbinom(p n k - &1,q n k) = + (p n k - q n k) / p n k * rbinom(p n k,q n k)`, + REWRITE_TAC[RBINOM_TOP_STEP_DOWN]);; + +let pth_both_down = prove + (`~ratty e (n,k) + ==> rbinom(p n k - &1,q n k - &1) = + q n k / p n k * rbinom(p n k,q n k)`, + REWRITE_TAC[RBINOM_STEP_BOTH_DOWN]);; + +let pth_both_up,pth_top_up,pth_bottom_up,pth_bottom_down = + let ths = (CONJUNCTS o prove) + (`(~ratty e (n,k) + ==> (ratpolyfun e (\(n,k). p n k) /\ ratpolyfun e (\(n,k). q n k)) /\ + ~(!n k. p n k + &1 = &0) /\ ~(!n k. q n k + &1 = &0) + ==> rbinom(p n k + &1,q n k + &1) = + (p n k + &1) / (q n k + &1) * rbinom(p n k,q n k)) /\ + (~ratty e (n,k) + ==> (ratpolyfun e (\(n,k). p n k) /\ ratpolyfun e (\(n,k). q n k)) /\ + (~(!n k. p n k + &1 = &0) /\ ~(!n k. p n k + &1 = q n k)) + ==> rbinom(p n k + &1,q n k) = + (p n k + &1) / (p n k - q n k + &1) * rbinom (p n k,q n k)) /\ + (~ratty e (n,k) + ==> (ratpolyfun e (\(n,k). p n k) /\ ratpolyfun e (\(n,k). q n k)) /\ + ~(!n k. q n k + &1 = &0) + ==> rbinom(p n k,q n k + &1) = + (p n k - q n k) / (q n k + &1) * rbinom(p n k,q n k)) /\ + (~ratty e (n,k) + ==> (ratpolyfun e (\(n,k). p n k) /\ ratpolyfun e (\(n,k). q n k)) /\ + ~(!n k. p n k + &1 = q n k) + ==> rbinom(p n k,q n k - &1) = + q n k / (p n k - q n k + &1) * rbinom(p n k,q n k))`, + REPEAT STRIP_TAC THENL + [MATCH_MP_TAC RBINOM_STEP_BOTH_UP; + MATCH_MP_TAC RBINOM_TOP_STEP; + MATCH_MP_TAC RBINOM_BOTTOM_STEP; + MATCH_MP_TAC RBINOM_BOTTOM_STEP_DOWN] THEN + REPEAT CONJ_TAC THEN + FIRST_X_ASSUM(MP_TAC o GEN_REWRITE_RULE RAND_CONV [ratty]) THEN + REWRITE_TAC[NOT_EXISTS_THM] THEN + GEN_REWRITE_TAC (RAND_CONV o RAND_CONV) [GSYM REAL_SUB_0] THEN + DISCH_THEN(fun th -> W(fun (asl,w) -> + MP_TAC(SPEC (mk_gabs(`(n:real,k:real)`,lhand(rand w))) th))) THEN + REWRITE_TAC[] THEN + MATCH_MP_TAC(TAUT `p /\ ~r ==> ~(p /\ q /\ ~r) ==> ~q`) THEN + ASM_REWRITE_TAC[FORALL_PAIR_THM] THEN + ASM_SIMP_TAC[RATPOLYFUN_SUB; RATPOLYFUN_ADD; RATPOLYFUN_CONST; + RATIONAL_CLOSED; REAL_SUB_RZERO] THEN + ASM_REWRITE_TAC[REAL_SUB_0]) in + el 0 ths,el 1 ths,el 2 ths,el 3 ths;; + +let RBINOM_STEP_CONV nrth = + let ths = + map (C MATCH_MP nrth) + [pth_top_down; pth_both_down; pth_both_up; + pth_top_up; pth_bottom_up; pth_bottom_down] in + let pth_top_down' = el 0 ths + and pth_both_down' = el 1 ths + and pth_both_up' = el 2 ths + and pth_top_up' = el 3 ths + and pth_bottom_up' = el 4 ths + and pth_bottom_down' = el 5 ths in + fun tm -> + try PART_MATCH lhs pth_both_down' tm with Failure _ -> + try PART_MATCH lhs pth_top_down' tm with Failure _ -> + let th = try PART_MATCH (lhs o rand) pth_both_up' tm with Failure _ -> + try PART_MATCH (lhs o rand) pth_top_up' tm with Failure _ -> + try PART_MATCH (lhs o rand) pth_bottom_up' tm with Failure _ -> + PART_MATCH (lhs o rand) pth_bottom_down' tm in + let sth = prove(lhand(concl th), + CONJ_TAC THENL [REPEAT CONJ_TAC THEN RATPOLYFUN_TAC; ALL_TAC] THEN + REPEAT CONJ_TAC THEN TRY REAL_ARITH_TAC THEN DISCH_THEN(fun th -> + MP_TAC( SPECL [`&1 / &12345`; `&7 / &44`] th) THEN + MP_TAC( SPECL [`-- &99 / &12`; `&3 / &4`] th) THEN + MP_TAC( SPECL [`&0`; `&55`] th)) THEN CONV_TAC REAL_RING) in + MP th sth;; + +(* ------------------------------------------------------------------------- *) +(* And the trivial thing for spow. *) +(* ------------------------------------------------------------------------- *) + +let SPOW_STEP_CONV = + GEN_REWRITE_CONV I [SPOW_STEP_UP; SPOW_STEP_DOWN];; + +(* ------------------------------------------------------------------------- *) +(* Discharge nonzeroness conditions away from rational varieties. *) +(* ------------------------------------------------------------------------- *) + +let pth_zero = prove + (`!x. ~rational x ==> ~(x = &0)`, + MESON_TAC[RATIONAL_CLOSED]);; + +let pth_rfact = prove + (`!x. ~(rational x /\ x <= -- &1) ==> ~(rfact x = &0)`, + GEN_TAC THEN REWRITE_TAC[RFACT_EQ_0] THEN + ASM_CASES_TAC `integer x` THEN ASM_SIMP_TAC[RATIONAL_CLOSED] THEN + ASM_SIMP_TAC[INTEGER_CLOSED; REAL_LT_INTEGERS] THEN REAL_ARITH_TAC);; + +let pth_rbinom = prove + (`!x y. ~(rational x /\ x <= -- &1) /\ + ~(rational y /\ y <= -- &1) /\ + ~(rational(x - y) /\ x - y <= -- &1) + ==> ~(rbinom(x,y) = &0)`, + SIMP_TAC[rbinom; REAL_DIV_EQ_0; REAL_ENTIRE; pth_rfact]);; + +let pth_spow = prove + (`~(x = &0) /\ ~rational y ==> ~(x spow y = &0)`, + STRIP_TAC THEN ASM_REWRITE_TAC[SPOW_EQ_0; COS_EQ_0] THEN + REWRITE_TAC[REAL_EQ_MUL_RCANCEL; PI_NZ] THEN + ASM_MESON_TAC[RATIONAL_CLOSED]);; + +let pth_main = prove + (`~ratty e (n,k) + ==> ratpolyfun e (\(n,k). p n k) /\ ~(?c. !n k. p n k = c) + ==> ~rational(p n k)`, + GEN_REWRITE_TAC I [GSYM CONTRAPOS_THM] THEN + REWRITE_TAC[NOT_IMP] THEN STRIP_TAC THEN + REWRITE_TAC[ratty] THEN + EXISTS_TAC `\(x,y). (p:real->real->real) x y - p n k` THEN + ASM_SIMP_TAC[RATPOLYFUN_SUB; RATPOLYFUN_CONST; REAL_SUB_REFL] THEN + REWRITE_TAC[FORALL_PAIR_THM; REAL_SUB_0] THEN ASM_MESON_TAC[]);; + +let NONZERO_RATTY_TAC = + REPEAT CONJ_TAC THEN TRY ASM_REAL_ARITH_TAC THEN + REWRITE_TAC[REAL_POW_EQ_0; REAL_NEG_EQ_0] THEN + CONV_TAC NUM_REDUCE_CONV THEN + TRY(GEN_REWRITE_TAC RAND_CONV [SPOW_EQ_0] THEN + DISCH_THEN(MP_TAC o CONJUNCT1)) THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + (MATCH_MP_TAC pth_rfact ORELSE + (MATCH_MP_TAC pth_spow THEN + CONJ_TAC THENL [ASM_REAL_ARITH_TAC; ALL_TAC]) ORELSE + (MATCH_MP_TAC pth_rbinom THEN + CONJ_TAC THENL [ALL_TAC; CONJ_TAC]) ORELSE + MATCH_MP_TAC pth_zero) THEN + TRY(DISCH_THEN(MP_TAC o CONJUNCT2) THEN ASM_REAL_ARITH_TAC) THEN + TRY(DISCH_THEN(MP_TAC o CONJUNCT1)) THEN REWRITE_TAC[] THEN + FIRST_ASSUM(MATCH_MP_TAC o MATCH_MP pth_main) THEN + (CONJ_TAC THENL [RATPOLYFUN_TAC; ALL_TAC]) THEN + DISCH_THEN(CHOOSE_THEN (fun th -> + MP_TAC (SPECL [`&1 / &12345`; `&7 / &44`] th) THEN + MP_TAC (SPECL [`-- &99 / &12`; `&3 / &4`] th) THEN + MP_TAC (SPECL [`&0`; `&55`] th))) THEN + CONV_TAC REAL_RING;; + +let TACTIC_4 (asl,w) = + let nrth = + snd(find (can (term_match [] `~ratty e (n,k)` o concl o snd)) asl) in + (CONV_TAC(ONCE_DEPTH_CONV(APPLY_FBPOW_CONV SEPARATE_CONSTANT_CONV)) THEN + CONV_TAC(TOP_DEPTH_CONV + (RFACT_STEP_CONV nrth ORELSEC RBINOM_STEP_CONV nrth ORELSEC + SPOW_STEP_CONV)) THEN + CONV_TAC(ONCE_DEPTH_CONV(APPLY_FBPOW_CONV REAL_POLY_CONV)) THEN + REWRITE_TAC[real_div; REAL_INV_MUL; REAL_INV_INV; REAL_INV_POW] THEN + CONV_TAC REAL_RAT_REDUCE_CONV THEN + W(fun (asl,w) -> + let itms = find_terms + (fun t -> is_comb t && rator t = `real_inv`) w in + SUBGOAL_THEN + (list_mk_conj (map (fun t -> mk_neg(mk_eq(rand t,`&0`))) itms)) + MP_TAC) + THENL [NONZERO_RATTY_TAC; SPECIAL_REAL_FIELD_TAC]) (asl,w);; + +(* ------------------------------------------------------------------------- *) +(* Arithmetic side conditions. *) +(* ------------------------------------------------------------------------- *) + +let pth = REAL_ARITH `(&0 <= x /\ &0 <= y) /\ + (~(x = &0) \/ ~(y = &0)) ==> ~(x + y = &0)` +and real_add_tm = `real_add` +and real_mul_tm = `real_mul`;; + +let NONZERO_DIVIS_TAC = + CONV_TAC(RAND_CONV(LAND_CONV REAL_POLY_CONV)) THEN + REWRITE_TAC[REAL_ADD_ASSOC] THEN + DISCH_THEN(MP_TAC o MATCH_MP (REAL_FIELD + `a + b = &0 ==> --(inv(b) * a) = inv(b) * b`)) THEN + REWRITE_TAC[] THEN + CONV_TAC(RAND_CONV + (COMB2_CONV (RAND_CONV REAL_POLY_CONV) REAL_RAT_REDUCE_CONV)) THEN + W(fun (asl,w) -> + let ts = map lhand (striplist (dest_binop real_add_tm) (lhand(rand w))) in + let cc = abs_num(num_1 // end_itlist gcd_num (map rat_of_term ts)) in + DISCH_THEN(MP_TAC o AP_TERM (mk_comb(real_mul_tm,term_of_rat cc)))) THEN + REWRITE_TAC[] THEN + CONV_TAC(RAND_CONV + (COMB2_CONV (RAND_CONV REAL_POLY_CONV) REAL_RAT_REDUCE_CONV)) THEN + MATCH_MP_TAC(MESON[] `integer a /\ ~(integer b) ==> ~(a = b)`) THEN + CONJ_TAC THENL [ASM_SIMP_TAC[INTEGER_CLOSED]; ALL_TAC] THEN + REWRITE_TAC[INTEGER_DIV] THEN CONV_TAC NUM_REDUCE_CONV THEN + REWRITE_TAC[divides] THEN + GEN_REWRITE_TAC (RAND_CONV o BINDER_CONV) [EQ_SYM_EQ] THEN + REWRITE_TAC[MULT_EQ_1] THEN CONV_TAC NUM_REDUCE_CONV;; + +let rec NONZERO_INEQ_TAC gl = + (REWRITE_TAC[REAL_POW_EQ_0; REAL_ENTIRE; DE_MORGAN_THM; ARITH_EQ] THEN + REPEAT CONJ_TAC THEN + TRY ASM_REAL_ARITH_TAC THEN + TRY NONZERO_DIVIS_TAC THEN + TRY (MATCH_MP_TAC pth THEN CONJ_TAC THENL + [CONJ_TAC THEN + REPEAT(ASM_ARITH_TAC ORELSE + (MATCH_MP_TAC REAL_LE_ADD THEN CONJ_TAC) ORELSE + (MATCH_MP_TAC REAL_LE_MUL THEN CONJ_TAC) ORELSE + (MATCH_MP_TAC REAL_POW_LE THEN CONV_TAC NUM_REDUCE_CONV)) THEN + NO_TAC; + ((DISJ1_TAC THEN NONZERO_INEQ_TAC) ORELSE + (DISJ2_TAC THEN NONZERO_INEQ_TAC))]) THEN + NONZERO_DIVIS_TAC) gl;; + +let NONZERO_ADHOC_TAC = + REWRITE_TAC[REAL_POW_EQ_0; REAL_ENTIRE; DE_MORGAN_THM; ARITH_EQ] THEN + REPEAT CONJ_TAC THEN + CONV_TAC(RAND_CONV(LAND_CONV REAL_POLY_CONV)) THEN + TRY NONZERO_INEQ_TAC;; + +let REAL_CONTINUOUS_ADHOC_TAC = + REPEAT + (MATCH_MP_TAC REAL_CONTINUOUS_POW ORELSE + MATCH_MP_TAC REAL_CONTINUOUS_NEG ORELSE + (MATCH_MP_TAC REAL_CONTINUOUS_ADD THEN CONJ_TAC) ORELSE + (MATCH_MP_TAC REAL_CONTINUOUS_SUB THEN CONJ_TAC) ORELSE + (MATCH_MP_TAC REAL_CONTINUOUS_MUL THEN CONJ_TAC)) THEN + REWRITE_TAC[REAL_CONTINUOUS_COMPLEX_COMPONENTS_AT; + REAL_CONTINUOUS_COMPLEX_COMPONENTS_WITHIN] THEN + REWRITE_TAC[REAL_CONTINUOUS_CONST];; + +let REALLIM_NONZERO_TAC = + REWRITE_TAC[RE; IM] THEN + REWRITE_TAC[rbinom; RFACT_EQ_0; REAL_ENTIRE; REAL_DIV_EQ_0; + SPOW_EQ_0; REAL_POW_EQ_0] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + ASM_REAL_ARITH_TAC;; + +let REALLIM_INEQ_TAC = + REWRITE_TAC[RE; IM] THEN ASM_REAL_ARITH_TAC;; + +let REALLIM_CONTINUOUS_TAC = + REPEAT + (MATCH_MP_TAC REAL_CONTINUOUS_INV_RFACT_COMPOSE_WITHIN ORELSE + (MATCH_MP_TAC REAL_CONTINUOUS_INV_WITHIN THEN CONJ_TAC THENL + [ALL_TAC; REALLIM_NONZERO_TAC]) ORELSE + (MATCH_MP_TAC(REWRITE_RULE[CONJ_ASSOC] + REAL_CONTINUOUS_RPOW_COMPOSE_WITHIN) THEN + CONJ_TAC THENL [CONJ_TAC; REALLIM_NONZERO_TAC]) ORELSE + (MATCH_MP_TAC REAL_CONTINUOUS_MUL THEN CONJ_TAC) ORELSE + (MATCH_MP_TAC REAL_CONTINUOUS_ADD THEN CONJ_TAC) ORELSE + (MATCH_MP_TAC REAL_CONTINUOUS_SUB THEN CONJ_TAC) ORELSE + (MATCH_MP_TAC REAL_CONTINUOUS_NEG) ORELSE + (MATCH_MP_TAC REAL_CONTINUOUS_POW) ORELSE + (MATCH_MP_TAC REAL_CONTINUOUS_RFACT_COMPOSE_WITHIN THEN CONJ_TAC THENL + [ALL_TAC; + DISCH_THEN(MP_TAC o CONJUNCT2) THEN + REALLIM_INEQ_TAC]) ORELSE + (MATCH_MP_TAC + (REWRITE_RULE[CONJ_ASSOC] REAL_CONTINUOUS_RBINOM_COMPOSE_WITHIN) THEN + CONJ_TAC THENL + [CONJ_TAC; + DISCH_THEN(MP_TAC o CONJUNCT2) THEN + REALLIM_INEQ_TAC]) + ) THEN + REWRITE_TAC[REAL_CONTINUOUS_COMPLEX_COMPONENTS_WITHIN; + REAL_CONTINUOUS_CONST] THEN + NO_TAC;; + +let TACTIC_1 = + REPEAT STRIP_TAC THEN + REPEAT + (MATCH_MP_TAC REALLIM_POW ORELSE + (MATCH_MP_TAC REALLIM_MUL THEN CONJ_TAC) ORELSE + (MATCH_MP_TAC REALLIM_ADD THEN CONJ_TAC) ORELSE + (MATCH_MP_TAC REALLIM_SUB THEN CONJ_TAC) ORELSE + (MATCH_MP_TAC REALLIM_SPOW) ORELSE + ((MATCH_MP_TAC REALLIM_DIV ORELSE + MATCH_MP_TAC REALLIM_SPOW_COMPOSE) THEN + GEN_REWRITE_TAC I [CONJ_ASSOC] THEN CONJ_TAC THENL + [CONJ_TAC; + REWRITE_TAC[REAL_OF_NUM_ADD] THEN + REWRITE_TAC[SPOW_EQ_0; REAL_POW_EQ_0; REAL_ENTIRE; REAL_DIV_EQ_0; + COS_NPI; REAL_POW_EQ_0; REAL_NEG_EQ_0] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[REAL_OF_NUM_EQ; BINOM_EQ_0; FACT_NZ] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_LT; GSYM REAL_OF_NUM_LT; + GSYM REAL_OF_NUM_EQ; GSYM REAL_OF_NUM_ADD; + GSYM REAL_OF_NUM_MUL; GSYM REAL_OF_NUM_POW] THEN + TRY ASM_REAL_ARITH_TAC THEN + NONZERO_ADHOC_TAC]) ORELSE + (MATCH_MP_TAC REALLIM_SPOW_COMPOSE THEN + ONCE_REWRITE_TAC[CONJ_ASSOC] THEN CONJ_TAC THENL + [CONJ_TAC; + REWRITE_TAC[GSYM REAL_OF_NUM_MUL; GSYM REAL_OF_NUM_ADD] THEN + ASM_REAL_ARITH_TAC]) ORELSE + ((MATCH_MP_TAC LIM_RBINOM THEN CONJ_TAC) ORELSE + (MATCH_MP_TAC LIM_RFACT) ORELSE + (MATCH_MP_TAC REALLIM_SPOW_COMPOSE THEN REPEAT CONJ_TAC THENL + [ALL_TAC; ALL_TAC; + REWRITE_TAC[RE; IM] THEN NONZERO_ADHOC_TAC]) THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL])) THEN + REWRITE_TAC[REALLIM_CONST] THEN + MATCH_MP_TAC(MESON[REAL_CONTINUOUS_AT] + `f x = y /\ f real_continuous at x ==> (f ---> y) (at x)`) THEN + REWRITE_TAC[REAL_CONTINUOUS_COMPLEX_COMPONENTS_AT; RE; IM] THEN + TRY(GEN_REWRITE_TAC RAND_CONV [GSYM WITHIN_UNIV] THEN + REALLIM_CONTINUOUS_TAC);; + +(* ------------------------------------------------------------------------- *) +(* Assemble the side conditions for ZEILBERGER. *) +(* ------------------------------------------------------------------------- *) + +let SIDECOND_TAC = + CONJ_TAC THENL + [CONJ_TAC THEN REPEAT GEN_TAC THEN TRY DISCH_TAC THENL + [ALL_TAC; + REWRITE_TAC[GSYM REAL_OF_NUM_ADD] THEN + REPEAT(MATCH_MP_TAC REALLIM_ADD THEN CONJ_TAC) THEN + MATCH_MP_TAC REALLIM_MUL THEN + (CONJ_TAC THENL + [MATCH_MP_TAC(MESON[REAL_CONTINUOUS_AT] + `f x = y /\ f real_continuous at x ==> (f ---> y) (at x)`) THEN + (CONJ_TAC THENL [REWRITE_TAC[RE; IM] THEN REFL_TAC; ALL_TAC]) THEN + REAL_CONTINUOUS_ADHOC_TAC; + ALL_TAC])] THEN + TRY TACTIC_1; + + CONJ_TAC THENL + [CONJ_TAC THEN RATPOLYFUN_TAC; + CONJ_TAC THENL + [REPEAT CONJ_TAC THEN TRY(X_GEN_TAC `n:num`) THEN + REWRITE_TAC[REAL_ENTIRE; REAL_POW_EQ_0; REAL_ENTIRE; REAL_DIV_EQ_0; + REAL_OF_NUM_EQ; FACT_NZ; BINOM_EQ_0] THEN + CONV_TAC NUM_REDUCE_CONV THEN CONV_TAC REAL_RAT_REDUCE_CONV THEN + REWRITE_TAC[GSYM REAL_OF_NUM_EQ; GSYM REAL_OF_NUM_LT] THEN + REWRITE_TAC[GSYM REAL_OF_NUM_ADD; GSYM REAL_OF_NUM_MUL] THEN + TRY(DISCH_TAC o check (is_imp o snd)) THEN + TRY NONZERO_ADHOC_TAC; + + TRY(REPEAT STRIP_TAC THEN TACTIC_4)]]];; + +(* ------------------------------------------------------------------------- *) +(* Prove a WZ recurrence from an explicit rational certificate. *) +(* ------------------------------------------------------------------------- *) + +let WZ_PROVE ntm stm rtm ctm atm = + if ctm = [] then failwith "WZ_PROVE: empty coefficient list"; + let atms,th = WZ_INITIAL_REDUCTIONS ntm stm rtm ctm atm in + let th' = + prove + (rand(concl th), + MAP_EVERY + (fun a -> + ASM_CASES_TAC a THENL + [ALL_TAC; ASM_REWRITE_TAC[] THEN NO_TAC]) + atms THEN + MATCH_MP_TAC th THEN + SIDECOND_TAC) in + CONV_RULE + (ONCE_DEPTH_CONV(BINDER_CONV(RAND_CONV OUTPUT_SIMP_CONV))) th';; diff --git a/holtest.mk b/holtest.mk index 2cc41e33..0c5ae6b1 100644 --- a/holtest.mk +++ b/holtest.mk @@ -2,6 +2,7 @@ HOLLIGHT:=./hol.sh STANDALONE_EXAMPLES:=\ Library/agm \ + Library/apery \ Library/bdd \ Examples/bdd_examples \ Library/binary \ @@ -14,6 +15,7 @@ STANDALONE_EXAMPLES:=\ Examples/borsuk \ Examples/brunn_minkowski \ Library/card \ + Autoformalization/carleson \ Examples/combin \ Examples/complexpolygon \ Examples/cong \ @@ -24,6 +26,7 @@ STANDALONE_EXAMPLES:=\ Examples/dlo \ Examples/doomsday \ Library/fieldtheory \ + Autoformalization/fifteen_theorem \ Library/floor \ Examples/forster \ Examples/gcdrecurrence \ @@ -62,12 +65,14 @@ STANDALONE_EXAMPLES:=\ Examples/rectypes \ Library/ringtheory \ Examples/safetyliveness \ + Autoformalization/sarkovskii \ Examples/schnirelmann \ Examples/solovay \ Examples/sos \ Examples/ste \ Examples/sylvester_gallai \ Library/symmetric_group \ + Autoformalization/three_squares \ Examples/vitali \ Library/wo \ Library/words \ @@ -106,6 +111,7 @@ EXTENDED_EXAMPLES:=\ RichterHilbertAxiomGeometry/HilbertAxiom_read \ Rqe/make \ Unity/make \ + WZ/make \ Multivariate/cross \ Multivariate/cvectors \ Multivariate/flyspeck \ @@ -278,9 +284,9 @@ $(LOGDIR)/TacticTrace/make-test.ready: @mkdir -p $(LOGDIR)/$$(dirname TacticTrace/make-test) @echo '### Running TacticTrace/Makefile' @$(MAKE) clean --quiet -C TacticTrace - @$(MAKE) --quiet -C TacticTrace - @cd TacticTrace && ./build-hol-kernel.sh - @$(MAKE) test --quiet -C TacticTrace > $(LOGDIR)/TacticTrace/make-test 2>&1 + @$(MAKE) --quiet -C TacticTrace > $(LOGDIR)/TacticTrace/make-test 2>&1 + @export HOLLIGHT_DIR=`$(HOLLIGHT) -dir` && cd TacticTrace && ./build-hol-kernel.sh >> $(LOGDIR)/TacticTrace/make-test 2>&1 + @$(MAKE) test --quiet -C TacticTrace >> $(LOGDIR)/TacticTrace/make-test 2>&1 @cat TacticTrace/examples/*.hollog >> $(LOGDIR)/TacticTrace/make-test @touch $(LOGDIR)/TacticTrace/make-test.ready diff --git a/iterate.ml b/iterate.ml index 98f19bd3..3cd20c5a 100644 --- a/iterate.ml +++ b/iterate.ml @@ -1920,22 +1920,29 @@ let th = prove (* Thanks to finite sums, we can express cardinality of finite union. *) (* ------------------------------------------------------------------------- *) -let CARD_UNIONS = prove - (`!s:(A->bool)->bool. - FINITE s /\ (!t. t IN s ==> FINITE t) /\ - (!t u. t IN s /\ u IN s /\ ~(t = u) ==> t INTER u = {}) - ==> CARD(UNIONS s) = nsum s CARD`, - ONCE_REWRITE_TAC[IMP_CONJ] THEN - MATCH_MP_TAC FINITE_INDUCT_STRONG THEN +let CARD_UNIONS_IMAGE = prove + (`!(f:K->A->bool) s. + FINITE s /\ (!t. t IN s ==> FINITE(f t)) /\ + (!t u. t IN s /\ u IN s /\ ~(t = u) ==> f t INTER f u = {}) + ==> CARD(UNIONS(IMAGE f s)) = nsum s (\i. CARD(f i))`, + GEN_TAC THEN ONCE_REWRITE_TAC[IMP_CONJ] THEN + MATCH_MP_TAC FINITE_INDUCT_STRONG THEN REWRITE_TAC[IMAGE_CLAUSES] THEN REWRITE_TAC[UNIONS_0; UNIONS_INSERT; NOT_IN_EMPTY; IN_INSERT] THEN - REWRITE_TAC[CARD_CLAUSES; NSUM_CLAUSES] THEN - MAP_EVERY X_GEN_TAC [`t:A->bool`; `f:(A->bool)->bool`] THEN + REWRITE_TAC[CARD_CLAUSES; NSUM_CLAUSES] THEN REPEAT GEN_TAC THEN DISCH_THEN(fun th -> STRIP_TAC THEN MP_TAC th) THEN ASM_SIMP_TAC[NSUM_CLAUSES] THEN DISCH_THEN(CONJUNCTS_THEN2 (SUBST1_TAC o SYM) STRIP_ASSUME_TAC) THEN CONV_TAC SYM_CONV THEN MATCH_MP_TAC CARD_UNION_EQ THEN - ASM_SIMP_TAC[FINITE_UNIONS; FINITE_UNION; INTER_UNIONS] THEN - REWRITE_TAC[EMPTY_UNIONS; IN_ELIM_THM] THEN ASM MESON_TAC[]);; + ASM_SIMP_TAC[FINITE_IMAGE; FINITE_UNIONS; FINITE_UNION; INTER_UNIONS] THEN + ASM SET_TAC[]);; + +let CARD_UNIONS = prove + (`!s:(A->bool)->bool. + FINITE s /\ (!t. t IN s ==> FINITE t) /\ + (!t u. t IN s /\ u IN s /\ ~(t = u) ==> t INTER u = {}) + ==> CARD(UNIONS s) = nsum s CARD`, + MP_TAC(ISPEC `\x:A->bool. x` CARD_UNIONS_IMAGE) THEN + REWRITE_TAC[IMAGE_ID; ETA_AX]);; (* ------------------------------------------------------------------------- *) (* Expand "nsum (m..n) f" where m and n are numerals. *) diff --git a/mcp/make_checkpoint.py b/mcp/make_checkpoint.py index 9faf8a94..9d7e18fc 100644 --- a/mcp/make_checkpoint.py +++ b/mcp/make_checkpoint.py @@ -1,6 +1,11 @@ #!/usr/bin/env python3 """Create a DMTCP checkpoint of HOL Light. +Each extra positional argument must be a single OCaml expression +(e.g. 'needs "foo.ml"'). Expressions are wrapped in try/with to +detect exceptions; multi-phrase inputs containing ';;' are not +supported — place them in a file and load with needs or loadt. + Examples: python3 mcp/make_checkpoint.py # base HOL Light python3 mcp/make_checkpoint.py --name s2n \\ @@ -17,6 +22,7 @@ HOL_DIR = os.path.dirname(os.path.dirname(os.path.abspath(__file__))) SENTINEL = "HOL_MCP_CKPT_READY" +ERROR_SENTINEL = "HOL_MCP_LOAD_ERROR" def fatal(msg): @@ -27,8 +33,11 @@ def fatal(msg): def parse_args(): p = argparse.ArgumentParser( description="Create a DMTCP checkpoint of HOL Light.", - epilog="Extra positional arguments are OCaml expressions evaluated after HOL Light loads " - "(e.g., 'needs \"arm/proofs/base.ml\"').", + epilog="Extra positional arguments are single OCaml expressions evaluated " + "after HOL Light loads (e.g., 'needs \"arm/proofs/base.ml\"'). " + "Each expression is wrapped in try/with to detect exceptions. " + "Multi-phrase inputs containing ';;' are not supported; place " + "them in a file and load with needs or loadt.", ) p.add_argument("--name", default="base", help="Checkpoint name (creates hol-.ckpt/). Default: base") @@ -60,21 +69,52 @@ def build_env(): return env -def wait_for_line(proc, marker, error_msg): - """Read stdout until a line contains marker. Dies on EOF.""" +def wait_for_line(proc, marker, error_msg, error_marker=None): + """Read stdout until a line contains marker. Dies on EOF. + + If error_marker is set, treat any line containing it as a fatal + error from the OCaml toplevel.""" while True: line = proc.stdout.readline() if not line: fatal(error_msg) + if error_marker and error_marker in line: + # Extract the exception description after the sentinel + detail = line.strip() + idx = detail.find(error_marker) + if idx >= 0: + detail = detail[idx + len(error_marker):].lstrip(":").strip() + fatal(f"OCaml exception: {detail}") if marker in line: return def send_and_wait(proc, code, error_msg): - """Send OCaml code and wait for sentinel.""" - proc.stdin.write(f'{code};;\nPrintf.printf "{SENTINEL}\\n%!";;\n') + """Send OCaml code wrapped in try/with and wait for sentinel. + + The OCaml toplevel recovers from exceptions and continues to the + next phrase, so a bare sentinel would appear even after a failure. + Wrapping in try/with catches the exception and emits an error + sentinel that wait_for_line detects. + + Only single toplevel expressions are supported. Multi-phrase + inputs containing ';;' will be rejected with a helpful message.""" + clean = code.rstrip().rstrip(";") + if ";;" in clean: + fatal( + f"Expression contains ';;' (multiple toplevel phrases):\n" + f" {code}\n" + f"Only single expressions can be error-checked. Place composite\n" + f"inputs in a file and use: needs \"file.ml\"" + ) + proc.stdin.write( + f'(try ({clean}) with e -> ' + f'Printf.printf "{ERROR_SENTINEL}:%s\\n%!" ' + f'(Printexc.to_string e));;\n' + f'Printf.printf "{SENTINEL}\\n%!";;\n' + ) proc.stdin.flush() - wait_for_line(proc, SENTINEL, error_msg) + wait_for_line(proc, SENTINEL, error_msg, error_marker=ERROR_SENTINEL) def main(): diff --git a/mcp/uv.lock b/mcp/uv.lock index 0f131ddf..2ad883eb 100644 --- a/mcp/uv.lock +++ b/mcp/uv.lock @@ -259,11 +259,11 @@ wheels = [ [[package]] name = "idna" -version = "3.11" +version = "3.15" source = { registry = "https://pypi.org/simple" } -sdist = { url = "https://files.pythonhosted.org/packages/6f/6d/0703ccc57f3a7233505399edb88de3cbd678da106337b9fcde432b65ed60/idna-3.11.tar.gz", hash = "sha256:795dafcc9c04ed0c1fb032c2aa73654d8e8c5023a7df64a53f39190ada629902", size = 194582, upload-time = "2025-10-12T14:55:20.501Z" } +sdist = { url = "https://files.pythonhosted.org/packages/82/77/7b3966d0b9d1d31a36ddf1746926a11dface89a83409bf1483f0237aa758/idna-3.15.tar.gz", hash = "sha256:ca962446ea538f7092a95e057da437618e886f4d349216d2b1e294abfdb65fdc", size = 199245, upload-time = "2026-05-12T22:45:57.011Z" } wheels = [ - { url = "https://files.pythonhosted.org/packages/0e/61/66938bbb5fc52dbdf84594873d5b51fb1f7c7794e9c0f5bd885f30bc507b/idna-3.11-py3-none-any.whl", hash = "sha256:771a87f49d9defaf64091e6e6fe9c18d4833f140bd19464795bc32d966ca37ea", size = 71008, upload-time = "2025-10-12T14:55:18.883Z" }, + { url = "https://files.pythonhosted.org/packages/d2/23/408243171aa9aaba178d3e2559159c24c1171a641aa83b67bdd3394ead8e/idna-3.15-py3-none-any.whl", hash = "sha256:048adeaf8c2d788c40fee287673ccaa74c24ffd8dcf09ffa555a2fbb59f10ac8", size = 72340, upload-time = "2026-05-12T22:45:55.733Z" }, ] [[package]] @@ -530,11 +530,11 @@ wheels = [ [[package]] name = "python-multipart" -version = "0.0.24" +version = "0.0.27" source = { registry = "https://pypi.org/simple" } -sdist = { url = "https://files.pythonhosted.org/packages/8a/45/e23b5dc14ddb9918ae4a625379506b17b6f8fc56ca1d82db62462f59aea6/python_multipart-0.0.24.tar.gz", hash = "sha256:9574c97e1c026e00bc30340ef7c7d76739512ab4dfd428fec8c330fa6a5cc3c8", size = 37695, upload-time = "2026-04-05T20:49:13.829Z" } +sdist = { url = "https://files.pythonhosted.org/packages/69/9b/f23807317a113dc36e74e75eb265a02dd1a4d9082abc3c1064acd22997c4/python_multipart-0.0.27.tar.gz", hash = "sha256:9870a6a8c5a20a5bf4f07c017bd1489006ff8836cff097b6933355ee2b49b602", size = 44043, upload-time = "2026-04-27T10:51:26.649Z" } wheels = [ - { url = "https://files.pythonhosted.org/packages/a3/73/89930efabd4da63cea44a3f438aeb753d600123570e6d6264e763617a9ce/python_multipart-0.0.24-py3-none-any.whl", hash = "sha256:9b110a98db707df01a53c194f0af075e736a770dc5058089650d70b4a182f950", size = 24420, upload-time = "2026-04-05T20:49:12.555Z" }, + { url = "https://files.pythonhosted.org/packages/99/78/4126abcbdbd3c559d43e0db7f7b9173fc6befe45d39a2856cc0b8ec2a5a6/python_multipart-0.0.27-py3-none-any.whl", hash = "sha256:6fccfad17a27334bd0193681b369f476eda3409f17381a2d65aa7df3f7275645", size = 29254, upload-time = "2026-04-27T10:51:24.997Z" }, ] [[package]] diff --git a/nets.ml b/nets.ml index f4444c21..05b6d506 100644 --- a/nets.ml +++ b/nets.ml @@ -23,20 +23,64 @@ type term_label = Vnet (* variable (instantiable) *) | Cnet of (string * int) (* constant *) | Lnet of int;; (* lambda term (abstraction) *) -type 'a net = Netnode of (term_label * 'a net) list * 'a list;; +(* ------------------------------------------------------------------------- *) +(* Edges out of a net node are split by label kind. The Vnet edge is unique *) +(* (so it's a direct field, looked up in O(1)); the others are persistent *) +(* balanced trees keyed by (string * int) or int with monomorphic *) +(* comparators. This gives O(log n) per-edge lookup. *) +(* *) +(* Cake.Map.empty takes a comparator, so using it directly in empty_net *) +(* would make empty_net monomorphic under CakeML's value restriction. None *) +(* represents an empty map here; the Cake.Map is allocated on first insert. *) +(* ------------------------------------------------------------------------- *) + +type 'a net = + Netnode of + 'a net option * + ((string * int),'a net) map option * + ((string * int),'a net) map option * + (int,'a net) map option * + 'a list;; + +let si_compare = + Cake.Pair.compare Cake.String.compare Cake.Int.compare;; (* ------------------------------------------------------------------------- *) (* The empty net. *) (* ------------------------------------------------------------------------- *) -let empty_net = Netnode([],[]);; +let empty_net = Netnode(None,None,None,None,[]);; + +let net_map_lookup k m = + match m with + None -> None + | Some m -> Cake.Map.lookup m k;; + +let net_map_update cmp k upd m = + match m with + None -> + Some (Cake.Map.singleton cmp k (upd empty_net)) + | Some m -> + let child0 = + match Cake.Map.lookup m k with + None -> empty_net + | Some child -> child in + Some (Cake.Map.insert m k (upd child0));; + +let net_map_merge merge m1 m2 = + match m1,m2 with + None,None -> None + | Some _,None -> m1 + | None,Some _ -> m2 + | Some m1,Some m2 -> + Some (Cake.Map.unionWith (fun n1 n2 -> merge(n1,n2)) m1 m2);; (* ------------------------------------------------------------------------- *) (* Insert a new element into a net. *) (* ------------------------------------------------------------------------- *) -let enter lconsts = - let label_to_store lconsts tm = +let enter lconsts (tm,elem) net = + let label_to_store (lconsts:term list) (tm:term) : term_label * term list = let op,args = strip_comb tm in if is_const op then Cnet(fst(dest_const op),length args),args else if is_abs op then @@ -46,50 +90,77 @@ let enter lconsts = Lnet(length args),bod'::args else if mem op lconsts then Lcnet(fst(dest_var op),length args),args else Vnet,[] in - let rec net_update lconsts (elem,tms,Netnode(edges,tips)) = + let rec net_update (lconsts:term list) elem + (tms:term list) net = + let Netnode(vnet,cnets,lcnets,lnets,tips) = net in match tms with - [] -> Netnode(edges,tips @ [elem]) + [] -> Netnode(vnet,cnets,lcnets,lnets,tips @ [elem]) | (tm::rtms) -> - let label,ntms = label_to_store lconsts tm in - let child,others = - try (snd F_F I) (remove (fun (x,y) -> x = label) edges) - with Failure _ -> (empty_net,edges) in - let new_child = net_update lconsts (elem,ntms@rtms,child) in - Netnode ((label,new_child)::others,tips) in - fun (tm,elem) net -> net_update lconsts (elem,[tm],net);; + let label,ntms = label_to_store lconsts tm in + let upd child = net_update lconsts elem (ntms@rtms) child in + match (label:term_label) with + Vnet -> + let child0 = + match vnet with Some c -> c | None -> empty_net in + Netnode(Some(upd child0),cnets,lcnets,lnets,tips) + | Cnet k -> + Netnode(vnet,net_map_update si_compare k upd cnets, + lcnets,lnets,tips) + | Lcnet k -> + Netnode(vnet,cnets, + net_map_update si_compare k upd lcnets, + lnets,tips) + | Lnet k -> + Netnode(vnet,cnets,lcnets, + net_map_update Cake.Int.compare k upd lnets,tips) in + net_update lconsts elem [tm] net;; (* ------------------------------------------------------------------------- *) (* Look up a term in a net and return possible matches. *) (* ------------------------------------------------------------------------- *) -let lookup tm = - let label_for_lookup tm = +let lookup tm net = + let label_for_lookup (tm:term) : term_label * term list = let op,args = strip_comb tm in if is_const op then Cnet(fst(dest_const op),length args),args else if is_abs op then Lnet(length args),(body op)::args else Lcnet(fst(dest_var op),length args),args in - let rec follow (tms,Netnode(edges,tips)) = + let rec follow (tms:term list) net = + let Netnode(vnet,cnets,lcnets,lnets,tips) = net in match tms with [] -> tips | (tm::rtms) -> - let label,ntms = label_for_lookup tm in - let collection = - try let child = assoc label edges in - follow(ntms @ rtms, child) - with Failure _ -> [] in - if label = Vnet then collection else - try collection @ follow(rtms,assoc Vnet edges) - with Failure _ -> collection in - fun net -> follow([tm],net);; + let label,ntms = label_for_lookup tm in + let collection = + let child = + match (label:term_label) with + Cnet k -> net_map_lookup k cnets + | Lcnet k -> net_map_lookup k lcnets + | Lnet k -> net_map_lookup k lnets + | Vnet -> None in + match child with + None -> [] + | Some vchild -> follow (ntms@rtms) vchild in + match vnet with + None -> collection + | Some vchild -> collection @ follow rtms vchild in + follow [tm] net;; (* ------------------------------------------------------------------------- *) (* Function to merge two nets (code from Don Syme's hol-lite). *) (* ------------------------------------------------------------------------- *) -let rec merge_nets (Netnode(l1,data1),Netnode(l2,data2)) = - let add_node ((lab,net) as p) l = - try let (lab',net'),rest = remove (fun (x,y) -> x = lab) l in - (lab',merge_nets (net,net'))::rest - with Failure _ -> p::l in - Netnode(itlist add_node l2 (itlist add_node l1 []), - data1 @ data2);; +let rec merge_nets (n1,n2) = + let Netnode(vnet1,cnets1,lcnets1,lnets1,tips1) = n1 + and Netnode(vnet2,cnets2,lcnets2,lnets2,tips2) = n2 in + let merge_opt a b = + match a,b with + Some x, Some y -> Some (merge_nets (x,y)) + | Some _, None -> a + | None, _ -> b in + Netnode + (merge_opt vnet1 vnet2, + net_map_merge merge_nets cnets1 cnets2, + net_map_merge merge_nets lcnets1 lcnets2, + net_map_merge merge_nets lnets1 lnets2, + tips1 @ tips2);; diff --git a/pa_j/chooser.sh b/pa_j/chooser.sh index 5ec8d007..de5c8c8e 100755 --- a/pa_j/chooser.sh +++ b/pa_j/chooser.sh @@ -20,7 +20,7 @@ CAMLP5_FULL_VERSION=`camlp5 -v 2>&1 | cut -f3 -d' ' | cut -f1-3 -d'.' | cut -f1 if test ${OCAML_BINARY_VERSION} = "3.0" then echo "pa_j_${OCAML_VERSION}.ml" -elif test ${CAMLP5_FULL_VERSION} = "8.04.00" +elif test ${CAMLP5_BINARY_VERSION} = "8.04" -o ${CAMLP5_BINARY_VERSION} = "8.05" then if test ${OCAML_BINARY_VERSION} = "5.4" then echo "pa_j_5.4_8.04.00.ml" diff --git a/printer.ml b/printer.ml index 021ee52b..f197f577 100755 --- a/printer.ml +++ b/printer.ml @@ -84,7 +84,8 @@ let unparse_as_prefix,parse_as_prefix,is_prefix,prefixes = let unparse_as_infix,parse_as_infix,get_infix_status,infixes = let cmp (s,(x,a)) (t,(y,b)) = - x < y || x = y && Cake.String.(>) a b || x = y && a = b && Cake.String.(<) s t in + x < y || x = y && Cake.String.(>) a b || + x = y && a = b && Cake.String.(<) s t in let infix_list = ref ([]:(string * (int * string)) list) in (fun n -> infix_list := filter (((<>) n) o fst) (!infix_list)), (fun (n,d) -> infix_list := sort cmp @@ -366,223 +367,274 @@ let pp_print_term,pp_print_colored_term = let print_colored_term (use_color:bool) fmt = let color_switch pp = if use_color then pp else pp_print_string in + + (* ----- Phase A: shape-based handlers (run before strip_comb). Each + prints on success or raises Failure to fall through. ----- *) + + let try_user_printers tm = + if use_color then + try try_user_color_printer fmt tm + with _ -> try_user_printer fmt tm + else + try_user_printer fmt tm in + + let print_numeral tm = + pp_print_string fmt (string_of_num(dest_numeral tm)) in + let rec print_term prec tm = - try - if use_color then - try try_user_color_printer fmt tm - with _ -> try_user_printer fmt tm - else - try_user_printer fmt tm - with Failure _ -> - try pp_print_string fmt (string_of_num(dest_numeral tm)) - with Failure _ -> - try (let tms = dest_list tm in - try if fst(dest_type(hd(snd(dest_type(type_of tm))))) <> "char" - then fail() else - let ccs = map (String.make 1 o Char.chr o code_of_term) tms in - let s = "\"" ^ String.escaped (implode ccs) ^ "\"" in - pp_print_string fmt s - with Failure _ -> - pp_open_box fmt 0; pp_print_string fmt "["; - pp_open_box fmt 0; print_term_sequence true ";" 0 tms; - pp_close_box fmt (); pp_print_string fmt "]"; - pp_close_box fmt ()) - with Failure _ -> + try try_user_printers tm with Failure _ -> + try print_numeral tm with Failure _ -> + try print_string_or_list tm with Failure _ -> if is_gabs tm then print_binder prec tm else let hop,args = strip_comb tm in - let s0 = name_of hop - and ty0 = type_of hop in - let s = reverse_interface (s0,ty0) in - try if s = "EMPTY" && is_const tm && args = [] then - pp_print_string fmt "{}" else fail() - with Failure _ -> - try if s = "UNIV" && !typify_universal_set && is_const tm && args = [] - then - let ty = fst(dest_fun_ty(type_of tm)) in - (pp_print_string fmt "(:"; - pp_print_type fmt ty; - pp_print_string fmt ")") - else fail() - with Failure _ -> - try if s <> "INSERT" then fail() else - let mems,oth = splitlist (dest_binary "INSERT") tm in - if is_const oth && fst(dest_const oth) = "EMPTY" then - (pp_open_box fmt 0; pp_print_string fmt "{"; pp_open_box fmt 0; - print_term_sequence true "," 14 mems; - pp_close_box fmt (); pp_print_string fmt "}"; pp_close_box fmt ()) - else fail() - with Failure _ -> - try if not (s = "GSPEC") then fail() else - let evs,bod = strip_exists(body(rand tm)) in - let bod1,fabs = dest_comb bod in - let bod2,babs = dest_comb bod1 in - let c = rator bod2 in - if fst(dest_const c) <> "SETSPEC" then fail() else - pp_print_string fmt "{"; - print_term 0 fabs; - pp_print_string fmt " | "; - (let fvs = frees fabs and bvs = frees babs in - if not(!print_unambiguous_comprehensions) && - set_eq evs - (if (length fvs <= 1 || bvs = []) then fvs - else intersect fvs bvs) - then () - else (print_term_sequence false "," 14 evs; - pp_print_string fmt " | ")); - print_term 0 babs; - pp_print_string fmt "}" + let s = reverse_interface (name_of hop, type_of hop) in + (* ----- Phase B: name-keyed handlers. ----- *) + try print_empty_set s tm args with Failure _ -> + try print_universal_set s tm args with Failure _ -> + try print_finite_set s tm with Failure _ -> + try print_set_comprehension s tm with Failure _ -> + try print_let_term s prec tm with Failure _ -> + try print_decimal s args with Failure _ -> + try print_match s prec args with Failure _ -> + try print_function s prec args with Failure _ -> + try print_cond s prec tm args with Failure _ -> + (* ----- Phase C: parser-status-based handlers. ----- *) + try print_prefix_app s prec args with Failure _ -> + try print_binder_app s prec tm args with Failure _ -> + try print_infix_app s prec tm hop args with Failure _ -> + (* ----- Phase D: leaf or generic application. ----- *) + if (is_const hop || is_var hop) && args = [] then + print_atom hop s + else + print_generic_app prec tm + + and print_string_or_list tm = + let tms = dest_list tm in + try if fst(dest_type(hd(snd(dest_type(type_of tm))))) <> "char" + then fail() else + let ccs = map (String.make 1 o Char.chr o code_of_term) tms in + let s = "\"" ^ String.escaped (implode ccs) ^ "\"" in + pp_print_string fmt s with Failure _ -> - try let eqs,bod = dest_let tm in - (if prec = 0 then pp_open_hvbox fmt 0 - else (pp_open_hvbox fmt 1; pp_print_string fmt "("); - color_switch pp_print_colored_resword fmt "let "; - print_term 0 (mk_eq(hd eqs)); - do_list (fun (v,t) -> - pp_print_break fmt 1 0; - color_switch pp_print_colored_resword fmt "and "; - print_term 0 (mk_eq(v,t))) - (tl eqs); - color_switch pp_print_colored_resword fmt " in"; + pp_open_box fmt 0; pp_print_string fmt "["; + pp_open_box fmt 0; print_term_sequence true ";" 0 tms; + pp_close_box fmt (); pp_print_string fmt "]"; + pp_close_box fmt () + + and print_empty_set s tm args = + if s = "EMPTY" && is_const tm && args = [] then + pp_print_string fmt "{}" + else fail() + + and print_universal_set s tm args = + if s = "UNIV" && !typify_universal_set && is_const tm && args = [] then + let ty = fst(dest_fun_ty(type_of tm)) in + (pp_print_string fmt "(:"; + pp_print_type fmt ty; + pp_print_string fmt ")") + else fail() + + and print_finite_set s tm = + if s <> "INSERT" then fail() else + let mems,oth = splitlist (dest_binary "INSERT") tm in + if is_const oth && fst(dest_const oth) = "EMPTY" then + (pp_open_box fmt 0; pp_print_string fmt "{"; pp_open_box fmt 0; + print_term_sequence true "," 14 mems; + pp_close_box fmt (); pp_print_string fmt "}"; pp_close_box fmt ()) + else fail() + + and print_set_comprehension s tm = + if s <> "GSPEC" then fail() else + let evs,bod = strip_exists(body(rand tm)) in + let bod1,fabs = dest_comb bod in + let bod2,babs = dest_comb bod1 in + let c = rator bod2 in + if fst(dest_const c) <> "SETSPEC" then fail() else + pp_print_string fmt "{"; + print_term 0 fabs; + pp_print_string fmt " | "; + (let fvs = frees fabs and bvs = frees babs in + if not(!print_unambiguous_comprehensions) && + set_eq evs + (if (length fvs <= 1 || bvs = []) then fvs + else intersect fvs bvs) + then () + else (print_term_sequence false "," 14 evs; + pp_print_string fmt " | ")); + print_term 0 babs; + pp_print_string fmt "}" + + and print_let_term s prec tm = + if s <> "LET" then fail() else + let eqs,bod = dest_let tm in + (if prec = 0 then pp_open_hvbox fmt 0 + else (pp_open_hvbox fmt 1; pp_print_string fmt "("); + color_switch pp_print_colored_resword fmt "let "; + print_term 0 (mk_eq(hd eqs)); + do_list (fun (v,t) -> pp_print_break fmt 1 0; - print_term 0 bod; - if prec = 0 then () else pp_print_string fmt ")"; - pp_close_box fmt ()) - with Failure _ -> try - if s <> "DECIMAL" then fail() else - let n_num = dest_numeral (hd args) - and n_den = dest_numeral (hd(tl args)) in - if not(powerof10 n_den) then fail() else - let s_num = string_of_num(quo_num n_num n_den) in - let s_den = implode(tl(explode(string_of_num - (n_den +/ (mod_num n_num n_den))))) in - pp_print_string fmt - ("#"^s_num^(if n_den =/ num 1 then "" else ".")^s_den) - with Failure _ -> try - if s <> "_MATCH" || length args <> 2 then failwith "" else - let cls = dest_clauses(hd(tl args)) in - (if prec = 0 then () else pp_print_string fmt "("; - pp_open_hvbox fmt 0; - color_switch pp_print_colored_resword fmt "match "; - print_term 0 (hd args); - color_switch pp_print_colored_resword fmt " with"; - pp_print_break fmt 1 2; - print_clauses cls; - pp_close_box fmt (); - if prec = 0 then () else pp_print_string fmt ")") - with Failure _ -> try - if s <> "_FUNCTION" || length args <> 1 then failwith "" else - let cls = dest_clauses(hd args) in - (if prec = 0 then () else pp_print_string fmt "("; - pp_open_hvbox fmt 0; - color_switch pp_print_colored_resword fmt "function"; - pp_print_break fmt 1 2; - print_clauses cls; - pp_close_box fmt (); - if prec = 0 then () else pp_print_string fmt ")") - with Failure _ -> - if s = "COND" && length args = 3 then - ((if prec = 0 then () else pp_print_string fmt "("); - pp_open_hvbox fmt (~-1); - (let ccls,ecl = splitlist pdest_cond tm in - if length ccls <= 4 then - (color_switch pp_print_colored_resword fmt "if "; - print_term 0 (hd args); - pp_print_break fmt 0 0; - color_switch pp_print_colored_resword fmt " then "; - print_term 0 (hd(tl args)); - pp_print_break fmt 0 0; - color_switch pp_print_colored_resword fmt " else "; - print_term 0 (hd(tl(tl args))) - ) - else - (color_switch pp_print_colored_resword fmt "if "; - print_term 0 (fst(hd ccls)); + color_switch pp_print_colored_resword fmt "and "; + print_term 0 (mk_eq(v,t))) + (tl eqs); + color_switch pp_print_colored_resword fmt " in"; + pp_print_break fmt 1 0; + print_term 0 bod; + if prec = 0 then () else pp_print_string fmt ")"; + pp_close_box fmt ()) + + and print_decimal s args = + if s <> "DECIMAL" then fail() else + let n_num = dest_numeral (hd args) + and n_den = dest_numeral (hd(tl args)) in + if not(powerof10 n_den) then fail() else + let s_num = string_of_num(quo_num n_num n_den) in + let s_den = implode(tl(explode(string_of_num + (n_den +/ (mod_num n_num n_den))))) in + pp_print_string fmt + ("#"^s_num^(if n_den =/ num 1 then "" else ".")^s_den) + + and print_match s prec args = + if s <> "_MATCH" || length args <> 2 then fail() else + let cls = dest_clauses(hd(tl args)) in + (if prec = 0 then () else pp_print_string fmt "("; + pp_open_hvbox fmt 0; + color_switch pp_print_colored_resword fmt "match "; + print_term 0 (hd args); + color_switch pp_print_colored_resword fmt " with"; + pp_print_break fmt 1 2; + print_clauses cls; + pp_close_box fmt (); + if prec = 0 then () else pp_print_string fmt ")") + + and print_function s prec args = + if s <> "_FUNCTION" || length args <> 1 then fail() else + let cls = dest_clauses(hd args) in + (if prec = 0 then () else pp_print_string fmt "("; + pp_open_hvbox fmt 0; + color_switch pp_print_colored_resword fmt "function"; + pp_print_break fmt 1 2; + print_clauses cls; + pp_close_box fmt (); + if prec = 0 then () else pp_print_string fmt ")") + + and print_cond s prec tm args = + if s <> "COND" || length args <> 3 then fail() else + ((if prec = 0 then () else pp_print_string fmt "("); + pp_open_hvbox fmt (-1); + (let ccls,ecl = splitlist pdest_cond tm in + if length ccls <= 4 then + (color_switch pp_print_colored_resword fmt "if "; + print_term 0 (hd args); + pp_print_break fmt 0 0; + color_switch pp_print_colored_resword fmt " then "; + print_term 0 (hd(tl args)); + pp_print_break fmt 0 0; + color_switch pp_print_colored_resword fmt " else "; + print_term 0 (hd(tl(tl args))) + ) + else + (color_switch pp_print_colored_resword fmt "if "; + print_term 0 (fst(hd ccls)); + color_switch pp_print_colored_resword fmt " then "; + print_term 0 (snd(hd ccls)); + pp_print_break fmt 0 0; + do_list (fun (i,t) -> + color_switch pp_print_colored_resword fmt " else if "; + print_term 0 i; color_switch pp_print_colored_resword fmt " then "; - print_term 0 (snd(hd ccls)); - pp_print_break fmt 0 0; - do_list (fun (i,t) -> - color_switch pp_print_colored_resword fmt " else if "; - print_term 0 i; - color_switch pp_print_colored_resword fmt " then "; - print_term 0 t; - pp_print_break fmt 0 0) (tl ccls); - color_switch pp_print_colored_resword fmt " else "; - print_term 0 ecl)); - pp_close_box fmt (); - (if prec = 0 then () else pp_print_string fmt ")")) - else if is_prefix s && length args = 1 then - (if prec = 1000 then pp_print_string fmt "(" else (); - color_switch pp_print_colored_prefix fmt s; - (if isalnum s || - s = "--" && - length args = 1 && - (try let l,r = dest_comb(hd args) in - let s0 = name_of l and ty0 = type_of l in - reverse_interface (s0,ty0) = "--" || - mem (fst(dest_const l)) ["real_of_num"; "int_of_num"] - with Failure _ -> false) || - s = "~" && length args = 1 && is_neg(hd args) - then pp_print_string fmt " " else ()); - print_term 999 (hd args); - if prec = 1000 then pp_print_string fmt ")" else ()) - else if parses_as_binder s && length args = 1 && is_gabs (hd args) then - print_binder prec tm - else if can get_infix_status s && length args = 2 then - let bargs = - if ARIGHT s then - let tms,tmt = splitlist (DEST_BINARY hop) tm in tms@[tmt] - else - let tmt,tms = rev_splitlist (DEST_BINARY hop) tm in tmt::tms in - let newprec = fst(get_infix_status s) in - (if newprec <= prec then - (pp_open_hvbox fmt 1; pp_print_string fmt "(") - else pp_open_hvbox fmt 0; - print_term newprec (hd bargs); - do_list (fun x -> if mem s (!unspaced_binops) then () - else if mem s (!prebroken_binops) - then pp_print_break fmt 1 0 - else pp_print_string fmt " "; - color_switch pp_print_colored_infix fmt s; - if mem s (!unspaced_binops) - then pp_print_break fmt 0 0 - else if mem s (!prebroken_binops) - then pp_print_string fmt " " - else pp_print_break fmt 1 0; - print_term newprec x) (tl bargs); - if newprec <= prec then pp_print_string fmt ")" else (); - pp_close_box fmt ()) - else if (is_const hop || is_var hop) && args = [] then - let s' = if parses_as_binder s || can get_infix_status s || is_prefix s - then "("^s^")" else s in - let rec has_invented_typevar (ty:hol_type): bool = - if is_vartype ty then String.get (dest_vartype ty) 0 = '?' - else List.exists has_invented_typevar (snd (dest_type ty)) in - if !print_types_of_subterms = 2 || - (!print_types_of_subterms = 1 && has_invented_typevar (type_of hop)) - then - (pp_open_box fmt 0; - pp_print_string fmt "("; - (if (is_const hop) then color_switch pp_print_colored_const fmt s' - else pp_print_string fmt s'); - pp_print_string fmt ":"; - (if use_color then pp_print_colored_type else pp_print_type) - fmt (type_of hop); - pp_print_string fmt ")"; - pp_close_box fmt ()) + print_term 0 t; + pp_print_break fmt 0 0) (tl ccls); + color_switch pp_print_colored_resword fmt " else "; + print_term 0 ecl)); + pp_close_box fmt (); + (if prec = 0 then () else pp_print_string fmt ")")) + + and print_prefix_app s prec args = + if not (is_prefix s && length args = 1) then fail() else + (if prec = 1000 then pp_print_string fmt "(" else (); + color_switch pp_print_colored_prefix fmt s; + (if isalnum s || + s = "--" && + length args = 1 && + (try let l,_ = dest_comb(hd args) in + let s0 = name_of l and ty0 = type_of l in + reverse_interface (s0,ty0) = "--" || + mem (fst(dest_const l)) ["real_of_num"; "int_of_num"] + with Failure _ -> false) || + s = "~" && length args = 1 && is_neg(hd args) + then pp_print_string fmt " " else ()); + print_term 999 (hd args); + if prec = 1000 then pp_print_string fmt ")" else ()) + + and print_binder_app s prec tm args = + if not (parses_as_binder s && length args = 1 && is_gabs (hd args)) + then fail() else + print_binder prec tm + + and print_infix_app s prec tm hop args = + if length args <> 2 || not (can get_infix_status s) then fail() else + let bargs = + if ARIGHT s then + let tms,tmt = splitlist (DEST_BINARY hop) tm in tms@[tmt] else - (if (is_const hop) then color_switch pp_print_colored_const fmt s' - else pp_print_string fmt s') + let tmt,tms = rev_splitlist (DEST_BINARY hop) tm in tmt::tms in + let newprec = fst(get_infix_status s) in + (if newprec <= prec then + (pp_open_hvbox fmt 1; pp_print_string fmt "(") + else pp_open_hvbox fmt 0; + print_term newprec (hd bargs); + do_list (fun x -> if mem s (!unspaced_binops) then () + else if mem s (!prebroken_binops) + then pp_print_break fmt 1 0 + else pp_print_string fmt " "; + color_switch pp_print_colored_infix fmt s; + if mem s (!unspaced_binops) + then pp_print_break fmt 0 0 + else if mem s (!prebroken_binops) + then pp_print_string fmt " " + else pp_print_break fmt 1 0; + print_term newprec x) (tl bargs); + if newprec <= prec then pp_print_string fmt ")" else (); + pp_close_box fmt ()) + + and print_atom hop s = + let s' = if parses_as_binder s || can get_infix_status s || is_prefix s + then "("^s^")" else s in + let rec has_invented_typevar (ty:hol_type): bool = + if is_vartype ty then (dest_vartype ty).[0] = '?' + else List.exists has_invented_typevar (snd (dest_type ty)) in + if !print_types_of_subterms = 2 || + (!print_types_of_subterms = 1 && has_invented_typevar (type_of hop)) + then + (pp_open_box fmt 0; + pp_print_string fmt "("; + (if (is_const hop) then color_switch pp_print_colored_const fmt s' + else pp_print_string fmt s'); + (* If s' ends in a symbolic character, juxtaposing ":" would lex as a + single identifier (e.g. "&:" is one Ident), so insert a space. *) + (if String.length s' > 0 && + issymb (String.sub s' (String.length s' - 1) 1) + then pp_print_string fmt " " else ()); + pp_print_string fmt ":"; + (if use_color then pp_print_colored_type else pp_print_type) + fmt (type_of hop); + pp_print_string fmt ")"; + pp_close_box fmt ()) else - let l,r = dest_comb tm in - (pp_open_hvbox fmt 0; - if prec = 1000 then pp_print_string fmt "(" else (); - print_term 999 l; - (if try mem (fst(dest_const l)) ["real_of_num"; "int_of_num"] - with Failure _ -> false - then () else pp_print_space fmt ()); - print_term 1000 r; - if prec = 1000 then pp_print_string fmt ")" else (); - pp_close_box fmt ()) + (if (is_const hop) then color_switch pp_print_colored_const fmt s' + else pp_print_string fmt s') + + and print_generic_app prec tm = + let l,r = dest_comb tm in + (pp_open_hvbox fmt 0; + if prec = 1000 then pp_print_string fmt "(" else (); + print_term 999 l; + (if try mem (fst(dest_const l)) ["real_of_num"; "int_of_num"] + with Failure _ -> false + then () else pp_print_space fmt ()); + print_term 1000 r; + if prec = 1000 then pp_print_string fmt ")" else (); + pp_close_box fmt ()) and print_term_sequence break sep prec tms = if tms = [] then () else